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::Debug;
  27 use C4::Letters;
  28 use C4::Biblio qw( GetMarcFromKohaField );
  29 use Koha::DateUtils;
  30 use Koha::Suggestions;
  31
  32 use List::MoreUtils qw(any);
  33 use base qw(Exporter);
  34
  35 our @EXPORT  = qw(
  36   ConnectSuggestionAndBiblio
  37   CountSuggestion
  38   DelSuggestion
  39   GetSuggestion
  40   GetSuggestionByStatus
  41   GetSuggestionFromBiblionumber
  42   GetSuggestionInfoFromBiblionumber
  43   GetSuggestionInfo
  44   ModStatus
  45   ModSuggestion
  46   NewSuggestion
  47   SearchSuggestion
  48   DelSuggestionsOlderThan
  49   GetUnprocessedSuggestions
  50   MarcRecordFromNewSuggestion
  51 );
  52
  53 =head1 NAME
  54
  55 C4::Suggestions - Some useful functions for dealings with aqorders.
  56
  57 =head1 SYNOPSIS
  58
  59 use C4::Suggestions;
  60
  61 =head1 DESCRIPTION
  62
  63 The functions in this module deal with the aqorders in OPAC and in librarian interface
  64
  65 A suggestion is done in the OPAC. It has the status "ASKED"
  66
  67 When a librarian manages the suggestion, they can set the status to "REJECTED" or "ACCEPTED".
  68
  69 When the book is ordered, the suggestion status becomes "ORDERED"
  70
  71 When a book is ordered and arrived in the library, the status becomes "AVAILABLE"
  72
  73 All aqorders of a borrower can be seen by the borrower itself.
  74 Suggestions done by other borrowers can be seen when not "AVAILABLE"
  75
  76 =head1 FUNCTIONS
  77
  78 =head2 SearchSuggestion
  79
  80 (\@array) = &SearchSuggestion($suggestionhashref_to_search)
  81
  82 searches for a suggestion
  83
  84 return :
  85 C<\@array> : the aqorders found. Array of hash.
  86 Note the status is stored twice :
  87 * in the status field
  88 * as parameter ( for example ASKED => 1, or REJECTED => 1) . This is for template & translation purposes.
  89
  90 =cut
  91
  92 sub SearchSuggestion {
  93     my ($suggestion) = @_;
  94     my $dbh = C4::Context->dbh;
  95     my @sql_params;
  96     my @query = (
  97         q{
  98         SELECT suggestions.*,
  99             U1.branchcode       AS branchcodesuggestedby,
 100             B1.branchname       AS branchnamesuggestedby,
 101             U1.surname          AS surnamesuggestedby,
 102             U1.firstname        AS firstnamesuggestedby,
 103             U1.cardnumber       AS cardnumbersuggestedby,
 104             U1.email            AS emailsuggestedby,
 105             U1.borrowernumber   AS borrnumsuggestedby,
 106             U1.categorycode     AS categorycodesuggestedby,
 107             C1.description      AS categorydescriptionsuggestedby,
 108             U2.surname          AS surnamemanagedby,
 109             U2.firstname        AS firstnamemanagedby,
 110             B2.branchname       AS branchnamesuggestedby,
 111             U2.email            AS emailmanagedby,
 112             U2.branchcode       AS branchcodemanagedby,
 113             U2.borrowernumber   AS borrnummanagedby,
 114             U3.surname          AS surnamelastmodificationby,
 115             U3.firstname        AS firstnamelastmodificationby,
 116             BU.budget_name      AS budget_name
 117         FROM suggestions
 118             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 119             LEFT JOIN branches      AS B1 ON B1.branchcode=U1.branchcode
 120             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 121             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 122             LEFT JOIN branches      AS B2 ON B2.branchcode=U2.branchcode
 123             LEFT JOIN categories    AS C2 ON C2.categorycode=U2.categorycode
 124             LEFT JOIN borrowers     AS U3 ON lastmodificationby=U3.borrowernumber
 125             LEFT JOIN aqbudgets     AS BU ON budgetid=BU.budget_id
 126         WHERE 1=1
 127     }
 128     );
 129
 130     # filter on biblio informations
 131     foreach my $field (
 132         qw( title author isbn publishercode copyrightdate collectiontitle ))
 133     {
 134         if ( $suggestion->{$field} ) {
 135             push @sql_params, '%' . $suggestion->{$field} . '%';
 136             push @query,      qq{ AND suggestions.$field LIKE ? };
 137         }
 138     }
 139
 140     # filter on user branch
 141     if (   C4::Context->preference('IndependentBranches')
 142         && !C4::Context->IsSuperLibrarian() )
 143     {
 144         # If IndependentBranches is set and the logged in user is not superlibrarian
 145         # Then we want to filter by the user's library (i.e. cannot see suggestions from other libraries)
 146         my $userenv = C4::Context->userenv;
 147         if ($userenv) {
 148             {
 149                 push @sql_params, $$userenv{branch};
 150                 push @query,      q{
 151                     AND (suggestions.branchcode=? OR suggestions.branchcode='')
 152                 };
 153             }
 154         }
 155     }
 156     elsif (defined $suggestion->{branchcode}
 157         && $suggestion->{branchcode}
 158         && $suggestion->{branchcode} ne '__ANY__' )
 159     {
 160         # If IndependentBranches is not set OR the logged in user is not superlibrarian
 161         # AND the branchcode filter is passed and not '__ANY__'
 162         # Then we want to filter using this parameter
 163         push @sql_params, $suggestion->{branchcode};
 164         push @query,      qq{ AND suggestions.branchcode=? };
 165     }
 166
 167     # filter on nillable fields
 168     foreach my $field (
 169         qw( STATUS itemtype suggestedby managedby acceptedby budgetid biblionumber )
 170       )
 171     {
 172         if ( exists $suggestion->{$field}
 173                 and defined $suggestion->{$field}
 174                 and $suggestion->{$field} ne '__ANY__'
 175                 and (
 176                     $suggestion->{$field} ne q||
 177                         or $field eq 'STATUS'
 178                 )
 179         ) {
 180             if ( $suggestion->{$field} eq '__NONE__' ) {
 181                 push @query, qq{ AND (suggestions.$field = '' OR suggestions.$field IS NULL) };
 182             }
 183             else {
 184                 push @sql_params, $suggestion->{$field};
 185                 push @query, qq{ AND suggestions.$field = ? };
 186             }
 187         }
 188     }
 189
 190     # filter on date fields
 191     foreach my $field (qw( suggesteddate manageddate accepteddate )) {
 192         my $from = $field . "_from";
 193         my $to   = $field . "_to";
 194         my $from_dt;
 195         $from_dt = eval { dt_from_string( $suggestion->{$from} ) } if ( $suggestion->{$from} );
 196         my $from_sql = '0000-00-00';
 197         $from_sql = output_pref({ dt => $from_dt, dateformat => 'iso', dateonly => 1 })
 198             if ($from_dt);
 199         $debug && warn "SQL for start date ($field): $from_sql";
 200         if ( $suggestion->{$from} || $suggestion->{$to} ) {
 201             push @query, qq{ AND suggestions.$field BETWEEN ? AND ? };
 202             push @sql_params, $from_sql;
 203             push @sql_params,
 204               output_pref({ dt => dt_from_string( $suggestion->{$to} ), dateformat => 'iso', dateonly => 1 }) || output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
 205         }
 206     }
 207
 208     # By default do not search for archived suggestions
 209     unless ( exists $suggestion->{archived} && $suggestion->{archived} ) {
 210         push @query, q{ AND suggestions.archived = 0 };
 211     }
 212
 213     $debug && warn "@query";
 214     my $sth = $dbh->prepare("@query");
 215     $sth->execute(@sql_params);
 216     my @results;
 217
 218     # add status as field
 219     while ( my $data = $sth->fetchrow_hashref ) {
 220         $data->{ $data->{STATUS} } = 1;
 221         push( @results, $data );
 222     }
 223
 224     return ( \@results );
 225 }
 226
 227 =head2 GetSuggestion
 228
 229 \%sth = &GetSuggestion($suggestionid)
 230
 231 this function get the detail of the suggestion $suggestionid (input arg)
 232
 233 return :
 234     the result of the SQL query as a hash : $sth->fetchrow_hashref.
 235
 236 =cut
 237
 238 sub GetSuggestion {
 239     my ($suggestionid) = @_;
 240     my $dbh           = C4::Context->dbh;
 241     my $query         = q{
 242         SELECT *
 243         FROM   suggestions
 244         WHERE  suggestionid=?
 245     };
 246     my $sth = $dbh->prepare($query);
 247     $sth->execute($suggestionid);
 248     return ( $sth->fetchrow_hashref );
 249 }
 250
 251 =head2 GetSuggestionFromBiblionumber
 252
 253 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
 254
 255 Get a suggestion from it's biblionumber.
 256
 257 return :
 258 the id of the suggestion which is related to the biblionumber given on input args.
 259
 260 =cut
 261
 262 sub GetSuggestionFromBiblionumber {
 263     my ($biblionumber) = @_;
 264     my $query = q{
 265         SELECT suggestionid
 266         FROM   suggestions
 267         WHERE  biblionumber=? LIMIT 1
 268     };
 269     my $dbh = C4::Context->dbh;
 270     my $sth = $dbh->prepare($query);
 271     $sth->execute($biblionumber);
 272     my ($suggestionid) = $sth->fetchrow;
 273     return $suggestionid;
 274 }
 275
 276 =head2 GetSuggestionInfoFromBiblionumber
 277
 278 Get a suggestion and borrower's informations from it's biblionumber.
 279
 280 return :
 281 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
 282
 283 =cut
 284
 285 sub GetSuggestionInfoFromBiblionumber {
 286     my ($biblionumber) = @_;
 287     my $query = q{
 288         SELECT suggestions.*,
 289             U1.surname          AS surnamesuggestedby,
 290             U1.firstname        AS firstnamesuggestedby,
 291             U1.borrowernumber   AS borrnumsuggestedby
 292         FROM suggestions
 293             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 294         WHERE biblionumber=?
 295         LIMIT 1
 296     };
 297     my $dbh = C4::Context->dbh;
 298     my $sth = $dbh->prepare($query);
 299     $sth->execute($biblionumber);
 300     return $sth->fetchrow_hashref;
 301 }
 302
 303 =head2 GetSuggestionInfo
 304
 305 Get a suggestion and borrower's informations from it's suggestionid
 306
 307 return :
 308 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
 309
 310 =cut
 311
 312 sub GetSuggestionInfo {
 313     my ($suggestionid) = @_;
 314     my $query = q{
 315         SELECT suggestions.*,
 316             U1.surname          AS surnamesuggestedby,
 317             U1.firstname        AS firstnamesuggestedby,
 318             U1.borrowernumber   AS borrnumsuggestedby
 319         FROM suggestions
 320             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 321         WHERE suggestionid=?
 322         LIMIT 1
 323     };
 324     my $dbh = C4::Context->dbh;
 325     my $sth = $dbh->prepare($query);
 326     $sth->execute($suggestionid);
 327     return $sth->fetchrow_hashref;
 328 }
 329
 330 =head2 GetSuggestionByStatus
 331
 332 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
 333
 334 Get a suggestion from it's status
 335
 336 return :
 337 all the suggestion with C<$status>
 338
 339 =cut
 340
 341 sub GetSuggestionByStatus {
 342     my $status     = shift;
 343     my $branchcode = shift;
 344     my $dbh        = C4::Context->dbh;
 345     my @sql_params = ($status);
 346     my $query      = q{
 347         SELECT suggestions.*,
 348             U1.surname          AS surnamesuggestedby,
 349             U1.firstname        AS firstnamesuggestedby,
 350             U1.branchcode       AS branchcodesuggestedby,
 351             B1.branchname       AS branchnamesuggestedby,
 352             U1.borrowernumber   AS borrnumsuggestedby,
 353             U1.categorycode     AS categorycodesuggestedby,
 354             C1.description      AS categorydescriptionsuggestedby,
 355             U2.surname          AS surnamemanagedby,
 356             U2.firstname        AS firstnamemanagedby,
 357             U2.borrowernumber   AS borrnummanagedby
 358         FROM suggestions
 359             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 360             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 361             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 362             LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
 363         WHERE status = ?
 364         ORDER BY suggestionid
 365     };
 366
 367     # filter on branch
 368     if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
 369         my $userenv = C4::Context->userenv;
 370         if ($userenv) {
 371             unless ( C4::Context->IsSuperLibrarian() ) {
 372                 push @sql_params, $userenv->{branch};
 373                 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 374             }
 375         }
 376         if ($branchcode) {
 377             push @sql_params, $branchcode;
 378             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 379         }
 380     }
 381
 382     my $sth = $dbh->prepare($query);
 383     $sth->execute(@sql_params);
 384     my $results;
 385     $results = $sth->fetchall_arrayref( {} );
 386     return $results;
 387 }
 388
 389 =head2 CountSuggestion
 390
 391 &CountSuggestion($status)
 392
 393 Count the number of aqorders with the status given on input argument.
 394 the arg status can be :
 395
 396 =over 2
 397
 398 =item * ASKED : asked by the user, not dealed by the librarian
 399
 400 =item * ACCEPTED : accepted by the librarian, but not yet ordered
 401
 402 =item * REJECTED : rejected by the librarian (definitive status)
 403
 404 =item * ORDERED : ordered by the librarian (acquisition module)
 405
 406 =back
 407
 408 return :
 409 the number of suggestion with this status.
 410
 411 =cut
 412
 413 sub CountSuggestion {
 414     my ($status) = @_;
 415     my $dbh = C4::Context->dbh;
 416     my $sth;
 417     my $userenv = C4::Context->userenv;
 418     if ( C4::Context->preference("IndependentBranches")
 419         && !C4::Context->IsSuperLibrarian() )
 420     {
 421         my $query = q{
 422             SELECT count(*)
 423             FROM suggestions
 424                 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
 425             WHERE STATUS=?
 426                 AND (suggestions.branchcode='' OR suggestions.branchcode=?)
 427         };
 428         $sth = $dbh->prepare($query);
 429         $sth->execute( $status, $userenv->{branch} );
 430     }
 431     else {
 432         my $query = q{
 433             SELECT count(*)
 434             FROM suggestions
 435             WHERE STATUS=?
 436         };
 437         $sth = $dbh->prepare($query);
 438         $sth->execute($status);
 439     }
 440     my ($result) = $sth->fetchrow;
 441     return $result;
 442 }
 443
 444 =head2 NewSuggestion
 445
 446
 447 &NewSuggestion($suggestion);
 448
 449 Insert a new suggestion on database with value given on input arg.
 450
 451 =cut
 452
 453 sub NewSuggestion {
 454     my ($suggestion) = @_;
 455
 456     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 457
 458     $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
 459
 460     delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
 461
 462     my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
 463     my $suggestion_id = $suggestion_object->suggestionid;
 464
 465     my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
 466     if ($emailpurchasesuggestions) {
 467         my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
 468         if (
 469             my $letter = C4::Letters::GetPreparedLetter(
 470                 module      => 'suggestions',
 471                 letter_code => 'NEW_SUGGESTION',
 472                 tables      => {
 473                     'branches'    => $full_suggestion->{branchcode},
 474                     'borrowers'   => $full_suggestion->{suggestedby},
 475                     'suggestions' => $full_suggestion,
 476                 },
 477             )
 478         ){
 479
 480             my $toaddress;
 481             if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
 482                 my $library =
 483                   Koha::Libraries->find( $full_suggestion->{branchcode} );
 484                 $toaddress = $library->inbound_email_address;
 485             }
 486             elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
 487                 $toaddress = C4::Context->preference('ReplytoDefault')
 488                   || C4::Context->preference('KohaAdminEmailAddress');
 489             }
 490             else {
 491                 $toaddress =
 492                      C4::Context->preference($emailpurchasesuggestions)
 493                   || C4::Context->preference('ReplytoDefault')
 494                   || C4::Context->preference('KohaAdminEmailAddress');
 495             }
 496
 497             C4::Letters::EnqueueLetter(
 498                 {
 499                     letter         => $letter,
 500                     borrowernumber => $full_suggestion->{suggestedby},
 501                     suggestionid   => $full_suggestion->{suggestionid},
 502                     to_address     => $toaddress,
 503                     message_transport_type => 'email',
 504                 }
 505             ) or warn "can't enqueue letter $letter";
 506         }
 507     }
 508
 509     return $suggestion_id;
 510 }
 511
 512 =head2 ModSuggestion
 513
 514 &ModSuggestion($suggestion)
 515
 516 Modify the suggestion according to the hash passed by ref.
 517 The hash HAS to contain suggestionid
 518 Data not defined is not updated unless it is a note or sort1
 519 Send a mail to notify the user that did the suggestion.
 520
 521 Note that there is no function to modify a suggestion.
 522
 523 =cut
 524
 525 sub ModSuggestion {
 526     my ($suggestion) = @_;
 527     return unless( $suggestion and defined($suggestion->{suggestionid}) );
 528
 529     my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
 530     eval { # FIXME Must raise an exception instead
 531         $suggestion_object->set($suggestion)->store;
 532     };
 533     return 0 if $@;
 534
 535     if ( $suggestion->{STATUS} && $suggestion_object->suggestedby ) {
 536
 537         # fetch the entire updated suggestion so that we can populate the letter
 538         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 539
 540         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
 541
 542         my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
 543
 544         if (
 545             my $letter = C4::Letters::GetPreparedLetter(
 546                 module      => 'suggestions',
 547                 letter_code => $full_suggestion->{STATUS},
 548                 branchcode  => $full_suggestion->{branchcode},
 549                 lang        => $patron->lang,
 550                 tables      => {
 551                     'branches'    => $full_suggestion->{branchcode},
 552                     'borrowers'   => $full_suggestion->{suggestedby},
 553                     'suggestions' => $full_suggestion,
 554                     'biblio'      => $full_suggestion->{biblionumber},
 555                 },
 556             )
 557           )
 558         {
 559             C4::Letters::EnqueueLetter(
 560                 {
 561                     letter         => $letter,
 562                     borrowernumber => $full_suggestion->{suggestedby},
 563                     suggestionid   => $full_suggestion->{suggestionid},
 564                     LibraryName    => C4::Context->preference("LibraryName"),
 565                     message_transport_type => $transport,
 566                 }
 567             ) or warn "can't enqueue letter $letter";
 568         }
 569     }
 570     return 1; # No useful if the exception is raised earlier
 571 }
 572
 573 =head2 ConnectSuggestionAndBiblio
 574
 575 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 576
 577 connect a suggestion to an existing biblio
 578
 579 =cut
 580
 581 sub ConnectSuggestionAndBiblio {
 582     my ( $suggestionid, $biblionumber ) = @_;
 583     my $dbh   = C4::Context->dbh;
 584     my $query = q{
 585         UPDATE suggestions
 586         SET    biblionumber=?
 587         WHERE  suggestionid=?
 588     };
 589     my $sth = $dbh->prepare($query);
 590     $sth->execute( $biblionumber, $suggestionid );
 591 }
 592
 593 =head2 DelSuggestion
 594
 595 &DelSuggestion($borrowernumber,$ordernumber)
 596
 597 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 598
 599 =cut
 600
 601 sub DelSuggestion {
 602     my ( $borrowernumber, $suggestionid, $type ) = @_;
 603     my $dbh = C4::Context->dbh;
 604
 605     # check that the suggestion comes from the suggestor
 606     my $query = q{
 607         SELECT suggestedby
 608         FROM   suggestions
 609         WHERE  suggestionid=?
 610     };
 611     my $sth = $dbh->prepare($query);
 612     $sth->execute($suggestionid);
 613     my ($suggestedby) = $sth->fetchrow;
 614     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 615         my $queryDelete = q{
 616             DELETE FROM suggestions
 617             WHERE suggestionid=?
 618         };
 619         $sth = $dbh->prepare($queryDelete);
 620         my $suggestiondeleted = $sth->execute($suggestionid);
 621         return $suggestiondeleted;
 622     }
 623 }
 624
 625 =head2 DelSuggestionsOlderThan
 626     &DelSuggestionsOlderThan($days)
 627
 628     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 629     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
 630
 631 =cut
 632
 633 sub DelSuggestionsOlderThan {
 634     my ($days) = @_;
 635     return unless $days && $days > 0;
 636     my $dbh = C4::Context->dbh;
 637     my $sth = $dbh->prepare(
 638         q{
 639         DELETE FROM suggestions
 640         WHERE STATUS<>'ASKED'
 641             AND date < ADDDATE(NOW(), ?)
 642     }
 643     );
 644     $sth->execute("-$days");
 645 }
 646
 647 sub GetUnprocessedSuggestions {
 648     my ( $number_of_days_since_the_last_modification ) = @_;
 649
 650     $number_of_days_since_the_last_modification ||= 0;
 651
 652     my $dbh = C4::Context->dbh;
 653
 654     my $s = $dbh->selectall_arrayref(q|
 655         SELECT *
 656         FROM suggestions
 657         WHERE STATUS = 'ASKED'
 658             AND budgetid IS NOT NULL
 659             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
 660     |, { Slice => {} }, $number_of_days_since_the_last_modification );
 661     return $s;
 662 }
 663
 664 =head2 MarcRecordFromNewSuggestion
 665
 666     $record = MarcRecordFromNewSuggestion ( $suggestion )
 667
 668 This function build a marc record object from a suggestion
 669
 670 =cut
 671
 672 sub MarcRecordFromNewSuggestion {
 673     my ($suggestion) = @_;
 674     my $record = MARC::Record->new();
 675
 676     my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
 677     $record->append_fields(
 678         MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
 679     );
 680
 681     my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
 682     if ($record->field( $author_tag )) {
 683         $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
 684     }
 685     else {
 686         $record->append_fields(
 687             MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
 688         );
 689     }
 690
 691     my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
 692     if ($record->field( $it_tag )) {
 693         $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
 694     }
 695     else {
 696         $record->append_fields(
 697             MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
 698         );
 699     }
 700
 701     return $record;
 702 }
 703
 704 1;
 705 __END__
 706
 707
 708 =head1 AUTHOR
 709
 710 Koha Development Team <http://koha-community.org/>
 711
 712 =cut
 713