X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FSuggestions.pm;h=1a93f2ed73416c76312035058f26be4f726fd44d;hb=5ae3a3aa4f79f457605e03f53a4b385212d9d93e;hp=06fc9973b6573b0db35009750a3c4a9d73e5afde;hpb=7bd7c514e490e0034fcb7b272e5b49e2af231ed0;p=koha_gimpoz diff --git a/C4/Suggestions.pm b/C4/Suggestions.pm index 06fc9973b6..1a93f2ed73 100644 --- a/C4/Suggestions.pm +++ b/C4/Suggestions.pm @@ -1,8 +1,7 @@ package C4::Suggestions; -# $Id$ - # Copyright 2000-2002 Katipo Communications +# Parts Copyright Biblibre 2011 # # This file is part of Koha. # @@ -15,226 +14,457 @@ package C4::Suggestions; # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + use strict; -require Exporter; -use DBI; +#use warnings; FIXME - Bug 2505 +use CGI; + use C4::Context; use C4::Output; -use Mail::Sendmail; -# use C4::Interface::CGI::Output; -use vars qw($VERSION @ISA @EXPORT); - -# set the version for version checking -$VERSION = 0.01; +use C4::Dates qw(format_date format_date_in_iso); +use C4::SQLHelper qw(:all); +use C4::Debug; +use C4::Letters; +use List::MoreUtils qw; +use C4::Dates qw(format_date_in_iso); +use base qw(Exporter); +our $VERSION = 3.01; +our @EXPORT = qw< + ConnectSuggestionAndBiblio + CountSuggestion + DelSuggestion + GetSuggestion + GetSuggestionByStatus + GetSuggestionFromBiblionumber + ModStatus + ModSuggestion + NewSuggestion + SearchSuggestion + DelSuggestionsOlderThan +>; =head1 NAME -C4::Accounts - Functions for dealing with Koha authorities +C4::Suggestions - Some useful functions for dealings with aqorders. =head1 SYNOPSIS - use C4::Suggestions; +use C4::Suggestions; =head1 DESCRIPTION -The functions in this module deal with the suggestions : -* in OPAC -* in librarian interface +The functions in this module deal with the aqorders in OPAC and in librarian interface A suggestion is done in the OPAC. It has the status "ASKED" -When a librarian manages the suggestion, he can set the status to "REJECTED" or "ORDERED". -When a book is ordered and arrived in the library, the status becomes "AVAILABLE" -All suggestions of a borrower by the borrower itself. -Suggestions done by other can be seen when not "AVAILABLE" -=head1 FUNCTIONS +When a librarian manages the suggestion, he can set the status to "REJECTED" or "ACCEPTED". -=over 2 +When the book is ordered, the suggestion status becomes "ORDERED" -=cut +When a book is ordered and arrived in the library, the status becomes "AVAILABLE" -@ISA = qw(Exporter); -@EXPORT = qw( &newsuggestion - &searchsuggestion - &getsuggestion - &delsuggestion - &countsuggestion - &changestatus - ); +All aqorders of a borrower can be seen by the borrower itself. +Suggestions done by other borrowers can be seen when not "AVAILABLE" -=item SearchSuggestion +=head1 FUNCTIONS - (\@array) = &SearchSuggestion($user) +=head2 SearchSuggestion - searches for a suggestion +(\@array) = &SearchSuggestion($suggestionhashref_to_search) -C<$user> is the user code (used as suggestor filter) +searches for a suggestion return : -C<\@array> : the suggestions found. Array of hash. +C<\@array> : the aqorders found. Array of hash. Note the status is stored twice : * in the status field * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes. =cut -sub searchsuggestion { - my ($user,$author,$title,$publishercode,$status,$suggestedbyme)=@_; - my $dbh = C4::Context->dbh; - my $query="Select suggestions.*, - U1.surname as surnamesuggestedby,U1.firstname as firstnamesuggestedby, - U2.surname as surnamemanagedby,U2.firstname as firstnamemanagedby - from suggestions - left join borrowers as U1 on suggestedby=U1.borrowernumber - left join borrowers as U2 on managedby=U2.borrowernumber - where 1=1"; - my @sql_params; - if ($author) { - push @sql_params,"%".$author."%"; - $query .= " and author like ?"; - } - if ($title) { - push @sql_params,"%".$title."%"; - $query .= " and suggestions.title like ?"; - } - if ($publishercode) { - push @sql_params,"%".$publishercode."%"; - $query .= " and publishercode like ?"; - } - if ($status) { - push @sql_params,$status; - $query .= " and status=?"; - } - - if (C4::Context->preference("IndependantBranches")) { - my $userenv = C4::Context->userenv; - unless ($userenv->{flags} == 1){ - push @sql_params,$userenv->{branch}; - $query .= " and (U1.branchcode = ? or U1.branchcode ='')"; - } - } - if ($suggestedbyme) { - if ($suggestedbyme eq -1) { - } else { - push @sql_params,$user; - $query .= " and suggestedby=?"; - } - } else { - $query .= " and managedby is NULL"; - } - my $sth=$dbh->prepare($query); - $sth->execute(@sql_params); - my @results; - my $even=1; # the even variable is used to set even / odd lines, for highlighting - while (my $data=$sth->fetchrow_hashref){ - $data->{$data->{STATUS}} = 1; - if ($even) { - $even=0; - $data->{even}=1; - } else { - $even=1; - } - push(@results,$data); - } - return (\@results); + +sub SearchSuggestion { + my ($suggestion)=@_; + my $dbh = C4::Context->dbh; + my @sql_params; + my @query = ( + q{ SELECT suggestions.*, + U1.branchcode AS branchcodesuggestedby, + B1.branchname AS branchnamesuggestedby, + U1.surname AS surnamesuggestedby, + U1.firstname AS firstnamesuggestedby, + U1.email AS emailsuggestedby, + U1.borrowernumber AS borrnumsuggestedby, + U1.categorycode AS categorycodesuggestedby, + C1.description AS categorydescriptionsuggestedby, + U2.surname AS surnamemanagedby, + U2.firstname AS firstnamemanagedby, + B2.branchname AS branchnamesuggestedby, + U2.email AS emailmanagedby, + U2.branchcode AS branchcodemanagedby, + U2.borrowernumber AS borrnummanagedby + FROM suggestions + LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber + LEFT JOIN branches AS B1 ON B1.branchcode=U1.branchcode + LEFT JOIN categories AS C1 ON C1.categorycode = U1.categorycode + LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber + LEFT JOIN branches AS B2 ON B2.branchcode=U2.branchcode + LEFT JOIN categories AS C2 ON C2.categorycode = U2.categorycode + WHERE STATUS NOT IN ('CLAIMED') + } , map { + if ( my $s = $suggestion->{$_} ) { + push @sql_params,'%'.$s.'%'; + " and suggestions.$_ like ? "; + } else { () } + } qw( title author isbn publishercode collectiontitle ) + ); + + my $userenv = C4::Context->userenv; + if (C4::Context->preference('IndependantBranches')) { + if ($userenv) { + if (($userenv->{flags} % 2) != 1 && !$suggestion->{branchcode}){ + push @sql_params,$$userenv{branch}; + push @query,q{ and (suggestions.branchcode = ? or suggestions.branchcode ='')}; + } + } + } + + foreach my $field (grep { my $fieldname=$_; + any {$fieldname eq $_ } qw< + STATUS branchcode itemtype suggestedby managedby acceptedby + bookfundid biblionumber + >} keys %$suggestion + ) { + if ($$suggestion{$field}){ + push @sql_params,$suggestion->{$field}; + push @query, " and suggestions.$field=?"; + } + else { + push @query, " and (suggestions.$field='' OR suggestions.$field IS NULL)"; + } + } + + my $today = C4::Dates->today('iso'); + + foreach ( qw( suggesteddate manageddate accepteddate ) ) { + my $from = $_ . "_from"; + my $to = $_ . "_to"; + if ($$suggestion{$from} || $$suggestion{$to}) { + push @query, " AND suggestions.suggesteddate BETWEEN '" + . (format_date_in_iso($$suggestion{$from}) || 0000-00-00) . "' AND '" . (format_date_in_iso($$suggestion{$to}) || $today) . "'"; + } + } + + $debug && warn "@query"; + my $sth=$dbh->prepare("@query"); + $sth->execute(@sql_params); + my @results; + while ( my $data=$sth->fetchrow_hashref ){ + $$data{$$data{STATUS}} = 1; + push(@results,$data); + } + return (\@results); +} + +=head2 GetSuggestion + +\%sth = &GetSuggestion($ordernumber) + +this function get the detail of the suggestion $ordernumber (input arg) + +return : + the result of the SQL query as a hash : $sth->fetchrow_hashref. + +=cut + +sub GetSuggestion { + my ($ordernumber) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT * + FROM suggestions + WHERE suggestionid=? + "; + my $sth = $dbh->prepare($query); + $sth->execute($ordernumber); + return($sth->fetchrow_hashref); +} + +=head2 GetSuggestionFromBiblionumber + +$ordernumber = &GetSuggestionFromBiblionumber($biblionumber) + +Get a suggestion from it's biblionumber. + +return : +the id of the suggestion which is related to the biblionumber given on input args. + +=cut + +sub GetSuggestionFromBiblionumber { + my ($biblionumber) = @_; + my $query = q{ + SELECT suggestionid + FROM suggestions + WHERE biblionumber=? + }; + my $dbh=C4::Context->dbh; + my $sth = $dbh->prepare($query); + $sth->execute($biblionumber); + my ($ordernumber) = $sth->fetchrow; + return $ordernumber; +} + +=head2 GetSuggestionByStatus + +$aqorders = &GetSuggestionByStatus($status,[$branchcode]) + +Get a suggestion from it's status + +return : +all the suggestion with C<$status> + +=cut + +sub GetSuggestionByStatus { + my $status = shift; + my $branchcode = shift; + my $dbh = C4::Context->dbh; + my @sql_params=($status); + my $query = qq(SELECT suggestions.*, + U1.surname AS surnamesuggestedby, + U1.firstname AS firstnamesuggestedby, + U1.branchcode AS branchcodesuggestedby, + B1.branchname AS branchnamesuggestedby, + U1.borrowernumber AS borrnumsuggestedby, + U1.categorycode AS categorycodesuggestedby, + C1.description AS categorydescriptionsuggestedby, + U2.surname AS surnamemanagedby, + U2.firstname AS firstnamemanagedby, + U2.borrowernumber AS borrnummanagedby + FROM suggestions + LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber + LEFT JOIN borrowers AS U2 ON managedby=U2.borrowernumber + LEFT JOIN categories AS C1 ON C1.categorycode=U1.categorycode + LEFT JOIN branches AS B1 on B1.branchcode = U1.branchcode + WHERE status = ?); + if (C4::Context->preference("IndependantBranches") || $branchcode) { + my $userenv = C4::Context->userenv; + if ($userenv) { + unless ($userenv->{flags} % 2 == 1){ + push @sql_params,$userenv->{branch}; + $query .= " and (U1.branchcode = ? or U1.branchcode ='')"; + } + } + if ($branchcode) { + push @sql_params,$branchcode; + $query .= " and (U1.branchcode = ? or U1.branchcode ='')"; + } + } + + my $sth = $dbh->prepare($query); + $sth->execute(@sql_params); + + my $results; + $results= $sth->fetchall_arrayref({}); + return $results; +} + +=head2 CountSuggestion + +&CountSuggestion($status) + +Count the number of aqorders with the status given on input argument. +the arg status can be : + +=over 2 + +=item * ASKED : asked by the user, not dealed by the librarian + +=item * ACCEPTED : accepted by the librarian, but not yet ordered + +=item * REJECTED : rejected by the librarian (definitive status) + +=item * ORDERED : ordered by the librarian (acquisition module) + +=back + +return : +the number of suggestion with this status. + +=cut + +sub CountSuggestion { + my ($status) = @_; + my $dbh = C4::Context->dbh; + my $sth; + if (C4::Context->preference("IndependantBranches")){ + my $userenv = C4::Context->userenv; + if ($userenv->{flags} % 2 == 1){ + my $query = qq | + SELECT count(*) + FROM suggestions + WHERE STATUS=? + |; + $sth = $dbh->prepare($query); + $sth->execute($status); + } + else { + my $query = qq | + SELECT count(*) + FROM suggestions LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby + WHERE STATUS=? + AND (borrowers.branchcode='' OR borrowers.branchcode =?) + |; + $sth = $dbh->prepare($query); + $sth->execute($status,$userenv->{branch}); + } + } + else { + my $query = qq | + SELECT count(*) + FROM suggestions + WHERE STATUS=? + |; + $sth = $dbh->prepare($query); + $sth->execute($status); + } + my ($result) = $sth->fetchrow; + return $result; } -sub newsuggestion { - my ($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("insert into suggestions (status,suggestedby,title,author,publishercode,note,copyrightdate,volumedesc,publicationyear,place,isbn,biblionumber) values ('ASKED',?,?,?,?,?,?,?,?,?,?,?)"); - $sth->execute($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber); +=head2 NewSuggestion + + +&NewSuggestion($suggestion); + +Insert a new suggestion on database with value given on input arg. + +=cut + +sub NewSuggestion { + my ($suggestion) = @_; + $suggestion->{STATUS}="ASKED" unless $suggestion->{STATUS}; + return InsertInTable("suggestions",$suggestion); } -sub getsuggestion { - my ($suggestionid) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select * from suggestions where suggestionid=?"); - $sth->execute($suggestionid); - return($sth->fetchrow_hashref); +=head2 ModSuggestion + +&ModSuggestion($suggestion) + +Modify the suggestion according to the hash passed by ref. +The hash HAS to contain suggestionid +Data not defined is not updated unless it is a note or sort1 +Send a mail to notify the user that did the suggestion. + +Note that there is no function to modify a suggestion. + +=cut + +sub ModSuggestion { + my ($suggestion)=@_; + my $status_update_table=UpdateInTable("suggestions", $suggestion); + + if ($suggestion->{STATUS}) { + # fetch the entire updated suggestion so that we can populate the letter + my $full_suggestion = GetSuggestion($suggestion->{suggestionid}); + my $letter = C4::Letters::getletter('suggestions', $full_suggestion->{STATUS}); + if ($letter) { + C4::Letters::parseletter($letter, 'branches', $full_suggestion->{branchcode}); + C4::Letters::parseletter($letter, 'borrowers', $full_suggestion->{suggestedby}); + C4::Letters::parseletter($letter, 'suggestions', $full_suggestion->{suggestionid}); + C4::Letters::parseletter($letter, 'biblio', $full_suggestion->{biblionumber}); + my $enqueued = C4::Letters::EnqueueLetter({ + letter => $letter, + borrowernumber => $full_suggestion->{suggestedby}, + suggestionid => $full_suggestion->{suggestionid}, + LibraryName => C4::Context->preference("LibraryName"), + message_transport_type => 'email', + }); + if (!$enqueued){warn "can't enqueue letter $letter";} + } + } + return $status_update_table; } -sub delsuggestion { - my ($borrowernumber,$suggestionid) = @_; - my $dbh = C4::Context->dbh; - # check that the suggestion comes from the suggestor - my $sth = $dbh->prepare("select suggestedby from suggestions where suggestionid=?"); - $sth->execute($suggestionid); - my ($suggestedby) = $sth->fetchrow; - if ($suggestedby eq $borrowernumber) { - $sth = $dbh->prepare("delete from suggestions where suggestionid=?"); - $sth->execute($suggestionid); - } +=head2 ConnectSuggestionAndBiblio + +&ConnectSuggestionAndBiblio($ordernumber,$biblionumber) + +connect a suggestion to an existing biblio + +=cut + +sub ConnectSuggestionAndBiblio { + my ($suggestionid,$biblionumber) = @_; + my $dbh=C4::Context->dbh; + my $query = " + UPDATE suggestions + SET biblionumber=? + WHERE suggestionid=? + "; + my $sth = $dbh->prepare($query); + $sth->execute($biblionumber,$suggestionid); } -sub countsuggestion { - my ($status) = @_; - my $dbh = C4::Context->dbh; - my $sth; - if (C4::Context->preference("IndependantBranches")){ - my $userenv = C4::Context->userenv; - if ($userenv->{flags} == 1){ - $sth = $dbh->prepare("select count(*) from suggestions where status=?"); - $sth->execute($status); - } else { - $sth = $dbh->prepare("select count(*) from suggestions,borrowers where status=? and borrowers.borrowernumber=suggestions.suggestedby and (borrowers.branchcode='' or borrowers.branchcode =?)"); - $sth->execute($status,$userenv->{branch}); - } - } else { - $sth = $dbh->prepare("select count(*) from suggestions where status=?"); - $sth->execute($status); - } - my ($result) = $sth->fetchrow; - return $result; +=head2 DelSuggestion + +&DelSuggestion($borrowernumber,$ordernumber) + +Delete a suggestion. A borrower can delete a suggestion only if he is its owner. + +=cut + +sub DelSuggestion { + my ($borrowernumber,$suggestionid,$type) = @_; + my $dbh = C4::Context->dbh; + # check that the suggestion comes from the suggestor + my $query = " + SELECT suggestedby + FROM suggestions + WHERE suggestionid=? + "; + my $sth = $dbh->prepare($query); + $sth->execute($suggestionid); + my ($suggestedby) = $sth->fetchrow; + if ($type eq "intranet" || $suggestedby eq $borrowernumber ) { + my $queryDelete = " + DELETE FROM suggestions + WHERE suggestionid=? + "; + $sth = $dbh->prepare($queryDelete); + my $suggestiondeleted=$sth->execute($suggestionid); + return $suggestiondeleted; + } } -sub changestatus { - my ($suggestionid,$status,$managedby) = @_; - my $dbh = C4::Context->dbh; - my $sth; - if ($managedby>0) { - $sth = $dbh->prepare("update suggestions set status=?,managedby=? where suggestionid=?"); - $sth->execute($status,$managedby,$suggestionid); - } else { - $sth = $dbh->prepare("update suggestions set status=? where suggestionid=?"); - $sth->execute($status,$suggestionid); - - } - # check mail sending. - $sth = $dbh->prepare("select suggestions.*, - boby.surname as bysurname, boby.firstname as byfirstname, boby.emailaddress as byemail, - lib.surname as libsurname,lib.firstname as libfirstname,lib.emailaddress as libemail - from suggestions left join borrowers as boby on boby.borrowernumber=suggestedby left join borrowers as lib on lib.borrowernumber=managedby where suggestionid=?"); - $sth->execute($suggestionid); - my $emailinfo = $sth->fetchrow_hashref; - my $template = gettemplate("suggestion/mail_suggestion_$status.tmpl","intranet"); -# query =>'', -# authnotrequired => 1, -# }); - $template->param(byemail => $emailinfo->{byemail}, - libemail => $emailinfo->{libemail}, - status => $emailinfo->{status}, - title => $emailinfo->{title}, - author =>$emailinfo->{author}, - libsurname => $emailinfo->{libsurname}, - libfirstname => $emailinfo->{libfirstname}, - byfirstname => $emailinfo->{byfirstname}, - bysurname => $emailinfo->{bysurname}, - ); - my %mail = ( To => $emailinfo->{byemail}, - From => $emailinfo->{libemail}, - Subject => 'Koha suggestion', - Message => "".$template->output - ); -sendmail(%mail); -# warn "sending email to $emailinfo->{byemail} from $emailinfo->{libemail} to notice new status $emailinfo->{status} for $emailinfo->{title} / $emailinfo->{author}"; +=head2 DelSuggestionsOlderThan + &DelSuggestionsOlderThan($days) + + Delete all suggestions older than TODAY-$days , that have be accepted or rejected. + +=cut +sub DelSuggestionsOlderThan { + my ($days) = @_; + return if not $days; + my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare(" + DELETE FROM suggestions WHERE STATUS <> 'ASKED' AND date < ADDDATE(NOW(), ?); + "); + $sth->execute("-$days"); } -=back +1; +__END__ + -=head1 SEE ALSO +=head1 AUTHOR + +Koha Development Team =cut +