C4/Suggestions.pm

   1 package C4::Suggestions;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 # Parts Copyright Biblibre 2011
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use Modern::Perl;
  22 use CGI qw ( -utf8 );
  23
  24 use C4::Context;
  25 use C4::Output;
  26 use C4::Letters;
  27 use C4::Biblio qw( GetMarcFromKohaField );
  28 use Koha::DateUtils qw( dt_from_string );
  29 use Koha::Suggestions;
  30
  31 use base qw(Exporter);
  32
  33 our @EXPORT  = qw(
  34   ConnectSuggestionAndBiblio
  35   DelSuggestion
  36   GetSuggestion
  37   GetSuggestionByStatus
  38   GetSuggestionFromBiblionumber
  39   GetSuggestionInfoFromBiblionumber
  40   GetSuggestionInfo
  41   ModStatus
  42   ModSuggestion
  43   DelSuggestionsOlderThan
  44   GetUnprocessedSuggestions
  45   MarcRecordFromNewSuggestion
  46 );
  47
  48 =head1 NAME
  49
  50 C4::Suggestions - Some useful functions for dealings with aqorders.
  51
  52 =head1 SYNOPSIS
  53
  54 use C4::Suggestions;
  55
  56 =head1 DESCRIPTION
  57
  58 The functions in this module deal with the aqorders in OPAC and in staff interface
  59
  60 A suggestion is done in the OPAC. It has the status "ASKED"
  61
  62 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
  63
  64 When the book is ordered, the suggestion status becomes "ORDERED"
  65
  66 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
  67
  68 All aqorders of a borrower can be seen by the borrower itself.
  69 Suggestions done by other borrowers can be seen when not "AVAILABLE"
  70
  71 =head1 FUNCTIONS
  72
  73 =head2 GetSuggestion
  74
  75 \%sth = &GetSuggestion($suggestionid)
  76
  77 this function get the detail of the suggestion $suggestionid (input arg)
  78
  79 return :
  80     the result of the SQL query as a hash : $sth->fetchrow_hashref.
  81
  82 =cut
  83
  84 sub GetSuggestion {
  85     my ($suggestionid) = @_;
  86     my $dbh           = C4::Context->dbh;
  87     my $query         = q{
  88         SELECT *
  89         FROM   suggestions
  90         WHERE  suggestionid=?
  91     };
  92     my $sth = $dbh->prepare($query);
  93     $sth->execute($suggestionid);
  94     return ( $sth->fetchrow_hashref );
  95 }
  96
  97 =head2 GetSuggestionFromBiblionumber
  98
  99 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
 100
 101 Get a suggestion from it's biblionumber.
 102
 103 return :
 104 the id of the suggestion which is related to the biblionumber given on input args.
 105
 106 =cut
 107
 108 sub GetSuggestionFromBiblionumber {
 109     my ($biblionumber) = @_;
 110     my $query = q{
 111         SELECT suggestionid
 112         FROM   suggestions
 113         WHERE  biblionumber=? LIMIT 1
 114     };
 115     my $dbh = C4::Context->dbh;
 116     my $sth = $dbh->prepare($query);
 117     $sth->execute($biblionumber);
 118     my ($suggestionid) = $sth->fetchrow;
 119     return $suggestionid;
 120 }
 121
 122 =head2 GetSuggestionInfoFromBiblionumber
 123
 124 Get a suggestion and borrower's informations from it's biblionumber.
 125
 126 return :
 127 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
 128
 129 =cut
 130
 131 sub GetSuggestionInfoFromBiblionumber {
 132     my ($biblionumber) = @_;
 133     my $query = q{
 134         SELECT suggestions.*,
 135             U1.surname          AS surnamesuggestedby,
 136             U1.firstname        AS firstnamesuggestedby,
 137             U1.borrowernumber   AS borrnumsuggestedby
 138         FROM suggestions
 139             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 140         WHERE biblionumber=?
 141         LIMIT 1
 142     };
 143     my $dbh = C4::Context->dbh;
 144     my $sth = $dbh->prepare($query);
 145     $sth->execute($biblionumber);
 146     return $sth->fetchrow_hashref;
 147 }
 148
 149 =head2 GetSuggestionInfo
 150
 151 Get a suggestion and borrower's informations from it's suggestionid
 152
 153 return :
 154 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
 155
 156 =cut
 157
 158 sub GetSuggestionInfo {
 159     my ($suggestionid) = @_;
 160     my $query = q{
 161         SELECT suggestions.*,
 162             U1.surname          AS surnamesuggestedby,
 163             U1.firstname        AS firstnamesuggestedby,
 164             U1.borrowernumber   AS borrnumsuggestedby
 165         FROM suggestions
 166             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 167         WHERE suggestionid=?
 168         LIMIT 1
 169     };
 170     my $dbh = C4::Context->dbh;
 171     my $sth = $dbh->prepare($query);
 172     $sth->execute($suggestionid);
 173     return $sth->fetchrow_hashref;
 174 }
 175
 176 =head2 GetSuggestionByStatus
 177
 178 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
 179
 180 Get a suggestion from it's status
 181
 182 return :
 183 all the suggestion with C<$status>
 184
 185 =cut
 186
 187 sub GetSuggestionByStatus {
 188     my $status     = shift;
 189     my $branchcode = shift;
 190     my $dbh        = C4::Context->dbh;
 191     my @sql_params = ($status);
 192     my $query      = q{
 193         SELECT suggestions.*,
 194             U1.surname          AS surnamesuggestedby,
 195             U1.firstname        AS firstnamesuggestedby,
 196             U1.branchcode       AS branchcodesuggestedby,
 197             B1.branchname       AS branchnamesuggestedby,
 198             U1.borrowernumber   AS borrnumsuggestedby,
 199             U1.categorycode     AS categorycodesuggestedby,
 200             C1.description      AS categorydescriptionsuggestedby,
 201             U2.surname          AS surnamemanagedby,
 202             U2.firstname        AS firstnamemanagedby,
 203             U2.borrowernumber   AS borrnummanagedby
 204         FROM suggestions
 205             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 206             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 207             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 208             LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
 209         WHERE status = ?
 210         ORDER BY suggestionid
 211     };
 212
 213     # filter on branch
 214     if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
 215         my $userenv = C4::Context->userenv;
 216         if ($userenv) {
 217             unless ( C4::Context->IsSuperLibrarian() ) {
 218                 push @sql_params, $userenv->{branch};
 219                 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 220             }
 221         }
 222         if ($branchcode) {
 223             push @sql_params, $branchcode;
 224             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 225         }
 226     }
 227
 228     my $sth = $dbh->prepare($query);
 229     $sth->execute(@sql_params);
 230     my $results;
 231     $results = $sth->fetchall_arrayref( {} );
 232     return $results;
 233 }
 234
 235 =head2 ModSuggestion
 236
 237 &ModSuggestion($suggestion)
 238
 239 Modify the suggestion according to the hash passed by ref.
 240 The hash HAS to contain suggestionid
 241 Data not defined is not updated unless it is a note or sort1
 242 Send a mail to notify the user that did the suggestion.
 243
 244 Note that there is no function to modify a suggestion.
 245
 246 =cut
 247
 248 sub ModSuggestion {
 249     my ($suggestion) = @_;
 250     return unless( $suggestion and defined($suggestion->{suggestionid}) );
 251
 252     my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
 253     eval { # FIXME Must raise an exception instead
 254         $suggestion_object->set($suggestion)->store;
 255     };
 256     return 0 if $@;
 257
 258     if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
 259
 260         # fetch the entire updated suggestion so that we can populate the letter
 261         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 262
 263         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
 264
 265         my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
 266
 267         if (
 268             my $letter = C4::Letters::GetPreparedLetter(
 269                 module      => 'suggestions',
 270                 letter_code => $full_suggestion->{STATUS},
 271                 branchcode  => $full_suggestion->{branchcode},
 272                 lang        => $patron->lang,
 273                 tables      => {
 274                     'branches'    => $full_suggestion->{branchcode},
 275                     'borrowers'   => $full_suggestion->{suggestedby},
 276                     'suggestions' => $full_suggestion,
 277                     'biblio'      => $full_suggestion->{biblionumber},
 278                 },
 279             )
 280           )
 281         {
 282             C4::Letters::EnqueueLetter(
 283                 {
 284                     letter         => $letter,
 285                     borrowernumber => $full_suggestion->{suggestedby},
 286                     suggestionid   => $full_suggestion->{suggestionid},
 287                     LibraryName    => C4::Context->preference("LibraryName"),
 288                     message_transport_type => $transport,
 289                 }
 290             ) or warn "can't enqueue letter $letter";
 291         }
 292     }
 293     return 1; # No useful if the exception is raised earlier
 294 }
 295
 296 =head2 ConnectSuggestionAndBiblio
 297
 298 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 299
 300 connect a suggestion to an existing biblio
 301
 302 =cut
 303
 304 sub ConnectSuggestionAndBiblio {
 305     my ( $suggestionid, $biblionumber ) = @_;
 306     my $dbh   = C4::Context->dbh;
 307     my $query = q{
 308         UPDATE suggestions
 309         SET    biblionumber=?
 310         WHERE  suggestionid=?
 311     };
 312     my $sth = $dbh->prepare($query);
 313     $sth->execute( $biblionumber, $suggestionid );
 314 }
 315
 316 =head2 DelSuggestion
 317
 318 &DelSuggestion($borrowernumber,$ordernumber)
 319
 320 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 321
 322 =cut
 323
 324 sub DelSuggestion {
 325     my ( $borrowernumber, $suggestionid, $type ) = @_;
 326     my $dbh = C4::Context->dbh;
 327
 328     # check that the suggestion comes from the suggestor
 329     my $query = q{
 330         SELECT suggestedby
 331         FROM   suggestions
 332         WHERE  suggestionid=?
 333     };
 334     my $sth = $dbh->prepare($query);
 335     $sth->execute($suggestionid);
 336     my ($suggestedby) = $sth->fetchrow;
 337     $suggestedby //= '';
 338     $borrowernumber //= '';
 339     if ( defined $type && $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 340         my $queryDelete = q{
 341             DELETE FROM suggestions
 342             WHERE suggestionid=?
 343         };
 344         $sth = $dbh->prepare($queryDelete);
 345         my $suggestiondeleted = $sth->execute($suggestionid);
 346         return $suggestiondeleted;
 347     }
 348 }
 349
 350 =head2 DelSuggestionsOlderThan
 351     &DelSuggestionsOlderThan($days)
 352
 353     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 354     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
 355
 356 =cut
 357
 358 sub DelSuggestionsOlderThan {
 359     my ($days) = @_;
 360     return unless $days && $days > 0;
 361     my $dbh = C4::Context->dbh;
 362     my $sth = $dbh->prepare(
 363         q{
 364         DELETE FROM suggestions
 365         WHERE STATUS<>'ASKED'
 366             AND manageddate < ADDDATE(NOW(), ?)
 367     }
 368     );
 369     $sth->execute("-$days");
 370 }
 371
 372 sub GetUnprocessedSuggestions {
 373     my ( $number_of_days_since_the_last_modification ) = @_;
 374
 375     $number_of_days_since_the_last_modification ||= 0;
 376
 377     my $dbh = C4::Context->dbh;
 378
 379     my $s = $dbh->selectall_arrayref(q|
 380         SELECT *
 381         FROM suggestions
 382         WHERE STATUS = 'ASKED'
 383             AND budgetid IS NOT NULL
 384             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
 385     |, { Slice => {} }, $number_of_days_since_the_last_modification );
 386     return $s;
 387 }
 388
 389 =head2 MarcRecordFromNewSuggestion
 390
 391     $record = MarcRecordFromNewSuggestion ( $suggestion )
 392
 393 This function build a marc record object from a suggestion
 394
 395 =cut
 396
 397 sub MarcRecordFromNewSuggestion {
 398     my ($suggestion) = @_;
 399     my $record = MARC::Record->new();
 400
 401     if (my $isbn = $suggestion->{isbn}) {
 402         for my $field (qw(biblioitems.isbn biblioitems.issn)) {
 403             my ($tag, $subfield) = GetMarcFromKohaField($field);
 404             $record->append_fields(
 405                 MARC::Field->new($tag, ' ', ' ', $subfield => $isbn)
 406             );
 407         }
 408     }
 409     else {
 410         my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title');
 411         $record->append_fields(
 412             MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
 413         );
 414
 415         my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author');
 416         if ($record->field( $author_tag )) {
 417             $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
 418         }
 419         else {
 420             $record->append_fields(
 421                 MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
 422             );
 423         }
 424     }
 425
 426     my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype');
 427     if ($record->field( $it_tag )) {
 428         $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
 429     }
 430     else {
 431         $record->append_fields(
 432             MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
 433         );
 434     }
 435
 436     return $record;
 437 }
 438
 439 1;
 440 __END__
 441
 442
 443 =head1 AUTHOR
 444
 445 Koha Development Team <http://koha-community.org/>
 446
 447 =cut
 448