Bug 13952: Import and export authority types
[koha-ffzg.git] / C4 / Suggestions.pm
index c55968a..649fb96 100644 (file)
@@ -5,38 +5,33 @@ package C4::Suggestions;
 #
 # This file is part of Koha.
 #
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
 #
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY 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.,
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
 
-use strict;
-
-#use warnings; FIXME - Bug 2505
-use CGI;
+use Modern::Perl;
+use CGI qw ( -utf8 );
 
 use C4::Context;
 use C4::Output;
-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(any);
-use C4::Dates qw(format_date_in_iso);
+use C4::Biblio qw( GetMarcFromKohaField );
+use Koha::DateUtils qw( dt_from_string );
+use Koha::Suggestions;
+
 use base qw(Exporter);
 
-our $VERSION = 3.07.00.049;
 our @EXPORT  = qw(
   ConnectSuggestionAndBiblio
-  CountSuggestion
   DelSuggestion
   GetSuggestion
   GetSuggestionByStatus
@@ -48,6 +43,8 @@ our @EXPORT  = qw(
   NewSuggestion
   SearchSuggestion
   DelSuggestionsOlderThan
+  GetUnprocessedSuggestions
+  MarcRecordFromNewSuggestion
 );
 
 =head1 NAME
@@ -64,7 +61,7 @@ The functions in this module deal with the aqorders in OPAC and in librarian int
 
 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 "ACCEPTED".
+When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
 
 When the book is ordered, the suggestion status becomes "ORDERED"
 
@@ -100,6 +97,7 @@ sub SearchSuggestion {
             B1.branchname       AS branchnamesuggestedby,
             U1.surname          AS surnamesuggestedby,
             U1.firstname        AS firstnamesuggestedby,
+            U1.cardnumber       AS cardnumbersuggestedby,
             U1.email            AS emailsuggestedby,
             U1.borrowernumber   AS borrnumsuggestedby,
             U1.categorycode     AS categorycodesuggestedby,
@@ -109,7 +107,10 @@ sub SearchSuggestion {
             B2.branchname       AS branchnamesuggestedby,
             U2.email            AS emailmanagedby,
             U2.branchcode       AS branchcodemanagedby,
-            U2.borrowernumber   AS borrnummanagedby
+            U2.borrowernumber   AS borrnummanagedby,
+            U3.surname          AS surnamelastmodificationby,
+            U3.firstname        AS firstnamelastmodificationby,
+            BU.budget_name      AS budget_name
         FROM suggestions
             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
             LEFT JOIN branches      AS B1 ON B1.branchcode=U1.branchcode
@@ -117,6 +118,8 @@ sub SearchSuggestion {
             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
+            LEFT JOIN borrowers     AS U3 ON lastmodificationby=U3.borrowernumber
+            LEFT JOIN aqbudgets     AS BU ON budgetid=BU.budget_id
         WHERE 1=1
     }
     );
@@ -132,10 +135,13 @@ sub SearchSuggestion {
     }
 
     # filter on user branch
-    if ( C4::Context->preference('IndependantBranches') ) {
+    if (   C4::Context->preference('IndependentBranches')
+        && !C4::Context->IsSuperLibrarian() )
+    {
+        # If IndependentBranches is set and the logged in user is not superlibrarian
+        # Then we want to filter by the user's library (i.e. cannot see suggestions from other libraries)
         my $userenv = C4::Context->userenv;
         if ($userenv) {
-            if ( ( $userenv->{flags} % 2 ) != 1 && !$suggestion->{branchcode} )
             {
                 push @sql_params, $$userenv{branch};
                 push @query,      q{
@@ -143,13 +149,16 @@ sub SearchSuggestion {
                 };
             }
         }
-    } else {
-        if ( defined $suggestion->{branchcode} && $suggestion->{branchcode} ) {
-            unless ( $suggestion->{branchcode} eq '__ANY__' ) {
-                push @sql_params, $suggestion->{branchcode};
-                push @query,      qq{ AND suggestions.branchcode=? };
-            }
-        }
+    }
+    elsif (defined $suggestion->{branchcode}
+        && $suggestion->{branchcode}
+        && $suggestion->{branchcode} ne '__ANY__' )
+    {
+        # If IndependentBranches is not set OR the logged in user is not superlibrarian
+        # AND the branchcode filter is passed and not '__ANY__'
+        # Then we want to filter using this parameter
+        push @sql_params, $suggestion->{branchcode};
+        push @query,      qq{ AND suggestions.branchcode=? };
     }
 
     # filter on nillable fields
@@ -157,35 +166,48 @@ sub SearchSuggestion {
         qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
       )
     {
-        if ( exists $suggestion->{$field} ) {
-            if ( defined $suggestion->{$field} and $suggestion->{$field} ne '' )
-            {
-                push @sql_params, $suggestion->{$field};
-                push @query,      qq{ AND suggestions.$field=? };
+        if ( exists $suggestion->{$field}
+                and defined $suggestion->{$field}
+                and $suggestion->{$field} ne '__ANY__'
+                and (
+                    $suggestion->{$field} ne q||
+                        or $field eq 'STATUS'
+                )
+        ) {
+            if ( $suggestion->{$field} eq '__NONE__' ) {
+                push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
             }
             else {
-                push @query, qq{
-                    AND (suggestions.$field='' OR suggestions.$field IS NULL)
-                };
+                push @sql_params, $suggestion->{$field};
+                push @query, qq{ AND suggestions.$field = ? };
             }
         }
     }
 
     # filter on date fields
-    my $today = C4::Dates->today('iso');
+    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
     foreach my $field (qw( suggesteddate manageddate accepteddate )) {
         my $from = $field . "_from";
         my $to   = $field . "_to";
-        if ( $suggestion->{$from} || $suggestion->{$to} ) {
-            push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
-            push @sql_params,
-              format_date_in_iso( $suggestion->{$from} ) || '0000-00-00';
-            push @sql_params,
-              format_date_in_iso( $suggestion->{$to} ) || $today;
+        my $from_dt;
+        $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
+        my $to_dt;
+        $to_dt = eval { dt_from_string( $suggestion->{$to} ) } if ( $suggestion->{$to} );
+        if ( $from_dt ) {
+            push @query, qq{ AND suggestions.$field >= ?};
+            push @sql_params, $dtf->format_date($from_dt);
+        }
+        if ( $to_dt ) {
+            push @query, qq{ AND suggestions.$field <= ?};
+            push @sql_params, $dtf->format_date($to_dt);
         }
     }
 
-    $debug && warn "@query";
+    # By default do not search for archived suggestions
+    unless ( exists $suggestion->{archived} && $suggestion->{archived} ) {
+        push @query, q{ AND suggestions.archived = 0 };
+    }
+
     my $sth = $dbh->prepare("@query");
     $sth->execute(@sql_params);
     my @results;
@@ -201,9 +223,9 @@ sub SearchSuggestion {
 
 =head2 GetSuggestion
 
-\%sth = &GetSuggestion($ordernumber)
+\%sth = &GetSuggestion($suggestionid)
 
-this function get the detail of the suggestion $ordernumber (input arg)
+this function get the detail of the suggestion $suggestionid (input arg)
 
 return :
     the result of the SQL query as a hash : $sth->fetchrow_hashref.
@@ -211,7 +233,7 @@ return :
 =cut
 
 sub GetSuggestion {
-    my ($ordernumber) = @_;
+    my ($suggestionid) = @_;
     my $dbh           = C4::Context->dbh;
     my $query         = q{
         SELECT *
@@ -219,7 +241,7 @@ sub GetSuggestion {
         WHERE  suggestionid=?
     };
     my $sth = $dbh->prepare($query);
-    $sth->execute($ordernumber);
+    $sth->execute($suggestionid);
     return ( $sth->fetchrow_hashref );
 }
 
@@ -336,13 +358,14 @@ sub GetSuggestionByStatus {
             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
             LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
         WHERE status = ?
+        ORDER BY suggestionid
     };
 
     # filter on branch
-    if ( C4::Context->preference("IndependantBranches") || $branchcode ) {
+    if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
         my $userenv = C4::Context->userenv;
         if ($userenv) {
-            unless ( $userenv->{flags} % 2 == 1 ) {
+            unless ( C4::Context->IsSuperLibrarian() ) {
                 push @sql_params, $userenv->{branch};
                 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
             }
@@ -352,7 +375,7 @@ sub GetSuggestionByStatus {
             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
         }
     }
-    
+
     my $sth = $dbh->prepare($query);
     $sth->execute(@sql_params);
     my $results;
@@ -360,74 +383,72 @@ sub GetSuggestionByStatus {
     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
+=head2 NewSuggestion
 
-=item * ACCEPTED : accepted by the librarian, but not yet ordered
 
-=item * REJECTED : rejected by the librarian (definitive status)
+&NewSuggestion($suggestion);
 
-=item * ORDERED : ordered by the librarian (acquisition module)
+Insert a new suggestion on database with value given on input arg.
 
-=back
+=cut
 
-return :
-the number of suggestion with this status.
+sub NewSuggestion {
+    my ($suggestion) = @_;
 
-=cut
+    $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 
-sub CountSuggestion {
-    my ($status) = @_;
-    my $dbh = C4::Context->dbh;
-    my $sth;
-    my $userenv = C4::Context->userenv;
-    if ( C4::Context->preference("IndependantBranches")
-        && $userenv->{flags} % 2 != 1 )
-    {
-        my $query = q{
-            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 = q{
-            SELECT count(*)
-            FROM suggestions
-            WHERE STATUS=?
-        };
-        $sth = $dbh->prepare($query);
-        $sth->execute($status);
-    }
-    my ($result) = $sth->fetchrow;
-    return $result;
-}
+    $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
 
-=head2 NewSuggestion
+    delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
 
+    my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
+    my $suggestion_id = $suggestion_object->suggestionid;
 
-&NewSuggestion($suggestion);
+    my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
+    if ($emailpurchasesuggestions) {
+        my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
+        if (
+            my $letter = C4::Letters::GetPreparedLetter(
+                module      => 'suggestions',
+                letter_code => 'NEW_SUGGESTION',
+                tables      => {
+                    'branches'    => $full_suggestion->{branchcode},
+                    'borrowers'   => $full_suggestion->{suggestedby},
+                    'suggestions' => $full_suggestion,
+                },
+            )
+        ){
 
-Insert a new suggestion on database with value given on input arg.
+            my $toaddress;
+            if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
+                my $library =
+                  Koha::Libraries->find( $full_suggestion->{branchcode} );
+                $toaddress = $library->inbound_email_address;
+            }
+            elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
+                $toaddress = C4::Context->preference('ReplytoDefault')
+                  || C4::Context->preference('KohaAdminEmailAddress');
+            }
+            else {
+                $toaddress =
+                     C4::Context->preference($emailpurchasesuggestions)
+                  || C4::Context->preference('ReplytoDefault')
+                  || C4::Context->preference('KohaAdminEmailAddress');
+            }
 
-=cut
+            C4::Letters::EnqueueLetter(
+                {
+                    letter         => $letter,
+                    borrowernumber => $full_suggestion->{suggestedby},
+                    suggestionid   => $full_suggestion->{suggestionid},
+                    to_address     => $toaddress,
+                    message_transport_type => 'email',
+                }
+            ) or warn "can't enqueue letter $letter";
+        }
+    }
 
-sub NewSuggestion {
-    my ($suggestion) = @_;
-    $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
-    return InsertInTable( "suggestions", $suggestion );
+    return $suggestion_id;
 }
 
 =head2 ModSuggestion
@@ -436,26 +457,38 @@ sub NewSuggestion {
 
 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 
+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. 
+Note that there is no function to modify a suggestion.
 
 =cut
 
 sub ModSuggestion {
     my ($suggestion) = @_;
-    my $status_update_table = UpdateInTable( "suggestions", $suggestion );
+    return unless( $suggestion and defined($suggestion->{suggestionid}) );
 
-    if ( $suggestion->{STATUS} ) {
+    my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
+    eval { # FIXME Must raise an exception instead
+        $suggestion_object->set($suggestion)->store;
+    };
+    return 0 if $@;
+
+    if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
 
         # fetch the entire updated suggestion so that we can populate the letter
         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
+
+        my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
+
+        my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
+
         if (
             my $letter = C4::Letters::GetPreparedLetter(
                 module      => 'suggestions',
                 letter_code => $full_suggestion->{STATUS},
                 branchcode  => $full_suggestion->{branchcode},
+                lang        => $patron->lang,
                 tables      => {
                     'branches'    => $full_suggestion->{branchcode},
                     'borrowers'   => $full_suggestion->{suggestedby},
@@ -471,12 +504,12 @@ sub ModSuggestion {
                     borrowernumber => $full_suggestion->{suggestedby},
                     suggestionid   => $full_suggestion->{suggestionid},
                     LibraryName    => C4::Context->preference("LibraryName"),
-                    message_transport_type => 'email',
+                    message_transport_type => $transport,
                 }
             ) or warn "can't enqueue letter $letter";
         }
     }
-    return $status_update_table;
+    return 1; # No useful if the exception is raised earlier
 }
 
 =head2 ConnectSuggestionAndBiblio
@@ -503,7 +536,7 @@ sub ConnectSuggestionAndBiblio {
 
 &DelSuggestion($borrowernumber,$ordernumber)
 
-Delete a suggestion. A borrower can delete a suggestion only if he is its owner.
+Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 
 =cut
 
@@ -533,25 +566,83 @@ sub DelSuggestion {
 
 =head2 DelSuggestionsOlderThan
     &DelSuggestionsOlderThan($days)
-    
+
     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
-    
+    We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
+
 =cut
 
 sub DelSuggestionsOlderThan {
     my ($days) = @_;
-    return unless $days;
+    return unless $days && $days > 0;
     my $dbh = C4::Context->dbh;
     my $sth = $dbh->prepare(
         q{
         DELETE FROM suggestions
         WHERE STATUS<>'ASKED'
-            AND date < ADDDATE(NOW(), ?)
+            AND manageddate < ADDDATE(NOW(), ?)
     }
     );
     $sth->execute("-$days");
 }
 
+sub GetUnprocessedSuggestions {
+    my ( $number_of_days_since_the_last_modification ) = @_;
+
+    $number_of_days_since_the_last_modification ||= 0;
+
+    my $dbh = C4::Context->dbh;
+
+    my $s = $dbh->selectall_arrayref(q|
+        SELECT *
+        FROM suggestions
+        WHERE STATUS = 'ASKED'
+            AND budgetid IS NOT NULL
+            AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
+    |, { Slice => {} }, $number_of_days_since_the_last_modification );
+    return $s;
+}
+
+=head2 MarcRecordFromNewSuggestion
+
+    $record = MarcRecordFromNewSuggestion ( $suggestion )
+
+This function build a marc record object from a suggestion
+
+=cut
+
+sub MarcRecordFromNewSuggestion {
+    my ($suggestion) = @_;
+    my $record = MARC::Record->new();
+
+    my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
+    $record->append_fields(
+        MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
+    );
+
+    my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
+    if ($record->field( $author_tag )) {
+        $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
+    }
+    else {
+        $record->append_fields(
+            MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
+        );
+    }
+
+    my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
+    if ($record->field( $it_tag )) {
+        $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
+    }
+    else {
+        $record->append_fields(
+            MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
+        );
+    }
+
+    return $record;
+}
+
 1;
 __END__