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