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 use C4::Log qw(logaction);
  31
  32 use base qw(Exporter);
  33
  34 our @EXPORT = qw(
  35     ConnectSuggestionAndBiblio
  36     DelSuggestion
  37     GetSuggestion
  38     GetSuggestionByStatus
  39     GetSuggestionFromBiblionumber
  40     GetSuggestionInfoFromBiblionumber
  41     GetSuggestionInfo
  42     ModStatus
  43     ModSuggestion
  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 =
 267                ( C4::Context->preference("FallbackToSMSIfNoEmail") )
 268             && ( $patron->smsalertnumber )
 269             && ( !$patron->email ) ? 'sms' : 'email';
 270
 271         if (
 272             my $letter = C4::Letters::GetPreparedLetter(
 273                 module      => 'suggestions',
 274                 letter_code => $full_suggestion->{STATUS},
 275                 branchcode  => $full_suggestion->{branchcode},
 276                 lang        => $patron->lang,
 277                 tables      => {
 278                     'branches'    => $full_suggestion->{branchcode},
 279                     'borrowers'   => $full_suggestion->{suggestedby},
 280                     'suggestions' => $full_suggestion,
 281                     'biblio'      => $full_suggestion->{biblionumber},
 282                 },
 283             )
 284             )
 285         {
 286             C4::Letters::EnqueueLetter(
 287                 {
 288                     letter                 => $letter,
 289                     borrowernumber         => $full_suggestion->{suggestedby},
 290                     suggestionid           => $full_suggestion->{suggestionid},
 291                     LibraryName            => C4::Context->preference("LibraryName"),
 292                     message_transport_type => $transport,
 293                 }
 294             ) or warn "can't enqueue letter $letter";
 295         }
 296     }
 297
 298     return 1;    # No useful if the exception is raised earlier
 299 }
 300
 301 =head2 ConnectSuggestionAndBiblio
 302
 303 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 304
 305 connect a suggestion to an existing biblio
 306
 307 =cut
 308
 309 sub ConnectSuggestionAndBiblio {
 310     my ( $suggestionid, $biblionumber ) = @_;
 311     my $dbh   = C4::Context->dbh;
 312     my $query = q{
 313         UPDATE suggestions
 314         SET    biblionumber=?
 315         WHERE  suggestionid=?
 316     };
 317     my $sth = $dbh->prepare($query);
 318     $sth->execute( $biblionumber, $suggestionid );
 319 }
 320
 321 =head2 DelSuggestion
 322
 323 &DelSuggestion($borrowernumber,$ordernumber)
 324
 325 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 326
 327 =cut
 328
 329 sub DelSuggestion {
 330     my ( $borrowernumber, $suggestionid, $type ) = @_;
 331     my $dbh = C4::Context->dbh;
 332
 333     # check that the suggestion comes from the suggestor
 334     my $query = q{
 335         SELECT suggestedby
 336         FROM   suggestions
 337         WHERE  suggestionid=?
 338     };
 339     my $sth = $dbh->prepare($query);
 340     $sth->execute($suggestionid);
 341     my ($suggestedby) = $sth->fetchrow;
 342     $suggestedby    //= '';
 343     $borrowernumber //= '';
 344
 345     if ( defined $type && $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 346         my $queryDelete = q{
 347             DELETE FROM suggestions
 348             WHERE suggestionid=?
 349         };
 350         $sth = $dbh->prepare($queryDelete);
 351         my $suggestiondeleted = $sth->execute($suggestionid);
 352         if ( C4::Context->preference("SuggestionsLog") ) {
 353             logaction( 'SUGGESTION', 'DELETE', $suggestionid, '' );
 354         }
 355         return $suggestiondeleted;
 356     }
 357 }
 358
 359 =head2 DelSuggestionsOlderThan
 360     &DelSuggestionsOlderThan($days)
 361
 362     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 363     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
 364
 365 =cut
 366
 367 sub DelSuggestionsOlderThan {
 368     my ($days) = @_;
 369     return unless $days && $days > 0;
 370     my $dbh = C4::Context->dbh;
 371     my $sth = $dbh->prepare(
 372         q{
 373         DELETE FROM suggestions
 374         WHERE STATUS<>'ASKED'
 375             AND manageddate < ADDDATE(NOW(), ?)
 376     }
 377     );
 378     $sth->execute("-$days");
 379 }
 380
 381 sub GetUnprocessedSuggestions {
 382     my ($number_of_days_since_the_last_modification) = @_;
 383
 384     $number_of_days_since_the_last_modification ||= 0;
 385
 386     my $dbh = C4::Context->dbh;
 387
 388     my $s = $dbh->selectall_arrayref(
 389         q|
 390         SELECT *
 391         FROM suggestions
 392         WHERE STATUS = 'ASKED'
 393             AND budgetid IS NOT NULL
 394             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
 395     |, { Slice => {} }, $number_of_days_since_the_last_modification
 396     );
 397     return $s;
 398 }
 399
 400 =head2 MarcRecordFromNewSuggestion
 401
 402     $record = MarcRecordFromNewSuggestion ( $suggestion )
 403
 404 This function build a marc record object from a suggestion
 405
 406 =cut
 407
 408 sub MarcRecordFromNewSuggestion {
 409     my ($suggestion) = @_;
 410     my $record = MARC::Record->new();
 411
 412     if ( my $isbn = $suggestion->{isbn} ) {
 413         for my $field (qw(biblioitems.isbn biblioitems.issn)) {
 414             my ( $tag, $subfield ) = GetMarcFromKohaField($field);
 415             $record->append_fields( MARC::Field->new( $tag, ' ', ' ', $subfield => $isbn ) );
 416         }
 417     } else {
 418         my ( $title_tag, $title_subfield ) = GetMarcFromKohaField('biblio.title');
 419         $record->append_fields( MARC::Field->new( $title_tag, ' ', ' ', $title_subfield => $suggestion->{title} ) );
 420
 421         my ( $author_tag, $author_subfield ) = GetMarcFromKohaField('biblio.author');
 422         if ( $record->field($author_tag) ) {
 423             $record->field($author_tag)->add_subfields( $author_subfield => $suggestion->{author} );
 424         } else {
 425             $record->append_fields(
 426                 MARC::Field->new( $author_tag, ' ', ' ', $author_subfield => $suggestion->{author} ) );
 427         }
 428     }
 429
 430     my ( $it_tag, $it_subfield ) = GetMarcFromKohaField('biblioitems.itemtype');
 431     if ( $record->field($it_tag) ) {
 432         $record->field($it_tag)->add_subfields( $it_subfield => $suggestion->{itemtype} );
 433     } else {
 434         $record->append_fields( MARC::Field->new( $it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype} ) );
 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