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     $debug && warn "@query";
 209     my $sth = $dbh->prepare("@query");
 210     $sth->execute(@sql_params);
 211     my @results;
 212
 213     # add status as field
 214     while ( my $data = $sth->fetchrow_hashref ) {
 215         $data->{ $data->{STATUS} } = 1;
 216         push( @results, $data );
 217     }
 218
 219     return ( \@results );
 220 }
 221
 222 =head2 GetSuggestion
 223
 224 \%sth = &GetSuggestion($suggestionid)
 225
 226 this function get the detail of the suggestion $suggestionid (input arg)
 227
 228 return :
 229     the result of the SQL query as a hash : $sth->fetchrow_hashref.
 230
 231 =cut
 232
 233 sub GetSuggestion {
 234     my ($suggestionid) = @_;
 235     my $dbh           = C4::Context->dbh;
 236     my $query         = q{
 237         SELECT *
 238         FROM   suggestions
 239         WHERE  suggestionid=?
 240     };
 241     my $sth = $dbh->prepare($query);
 242     $sth->execute($suggestionid);
 243     return ( $sth->fetchrow_hashref );
 244 }
 245
 246 =head2 GetSuggestionFromBiblionumber
 247
 248 $ordernumber = &GetSuggestionFromBiblionumber($biblionumber)
 249
 250 Get a suggestion from it's biblionumber.
 251
 252 return :
 253 the id of the suggestion which is related to the biblionumber given on input args.
 254
 255 =cut
 256
 257 sub GetSuggestionFromBiblionumber {
 258     my ($biblionumber) = @_;
 259     my $query = q{
 260         SELECT suggestionid
 261         FROM   suggestions
 262         WHERE  biblionumber=? LIMIT 1
 263     };
 264     my $dbh = C4::Context->dbh;
 265     my $sth = $dbh->prepare($query);
 266     $sth->execute($biblionumber);
 267     my ($suggestionid) = $sth->fetchrow;
 268     return $suggestionid;
 269 }
 270
 271 =head2 GetSuggestionInfoFromBiblionumber
 272
 273 Get a suggestion and borrower's informations from it's biblionumber.
 274
 275 return :
 276 all informations (suggestion and borrower) of the suggestion which is related to the biblionumber given.
 277
 278 =cut
 279
 280 sub GetSuggestionInfoFromBiblionumber {
 281     my ($biblionumber) = @_;
 282     my $query = q{
 283         SELECT suggestions.*,
 284             U1.surname          AS surnamesuggestedby,
 285             U1.firstname        AS firstnamesuggestedby,
 286             U1.borrowernumber   AS borrnumsuggestedby
 287         FROM suggestions
 288             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 289         WHERE biblionumber=?
 290         LIMIT 1
 291     };
 292     my $dbh = C4::Context->dbh;
 293     my $sth = $dbh->prepare($query);
 294     $sth->execute($biblionumber);
 295     return $sth->fetchrow_hashref;
 296 }
 297
 298 =head2 GetSuggestionInfo
 299
 300 Get a suggestion and borrower's informations from it's suggestionid
 301
 302 return :
 303 all informations (suggestion and borrower) of the suggestion which is related to the suggestionid given.
 304
 305 =cut
 306
 307 sub GetSuggestionInfo {
 308     my ($suggestionid) = @_;
 309     my $query = q{
 310         SELECT suggestions.*,
 311             U1.surname          AS surnamesuggestedby,
 312             U1.firstname        AS firstnamesuggestedby,
 313             U1.borrowernumber   AS borrnumsuggestedby
 314         FROM suggestions
 315             LEFT JOIN borrowers AS U1 ON suggestedby=U1.borrowernumber
 316         WHERE suggestionid=?
 317         LIMIT 1
 318     };
 319     my $dbh = C4::Context->dbh;
 320     my $sth = $dbh->prepare($query);
 321     $sth->execute($suggestionid);
 322     return $sth->fetchrow_hashref;
 323 }
 324
 325 =head2 GetSuggestionByStatus
 326
 327 $aqorders = &GetSuggestionByStatus($status,[$branchcode])
 328
 329 Get a suggestion from it's status
 330
 331 return :
 332 all the suggestion with C<$status>
 333
 334 =cut
 335
 336 sub GetSuggestionByStatus {
 337     my $status     = shift;
 338     my $branchcode = shift;
 339     my $dbh        = C4::Context->dbh;
 340     my @sql_params = ($status);
 341     my $query      = q{
 342         SELECT suggestions.*,
 343             U1.surname          AS surnamesuggestedby,
 344             U1.firstname        AS firstnamesuggestedby,
 345             U1.branchcode       AS branchcodesuggestedby,
 346             B1.branchname       AS branchnamesuggestedby,
 347             U1.borrowernumber   AS borrnumsuggestedby,
 348             U1.categorycode     AS categorycodesuggestedby,
 349             C1.description      AS categorydescriptionsuggestedby,
 350             U2.surname          AS surnamemanagedby,
 351             U2.firstname        AS firstnamemanagedby,
 352             U2.borrowernumber   AS borrnummanagedby
 353         FROM suggestions
 354             LEFT JOIN borrowers     AS U1 ON suggestedby=U1.borrowernumber
 355             LEFT JOIN borrowers     AS U2 ON managedby=U2.borrowernumber
 356             LEFT JOIN categories    AS C1 ON C1.categorycode=U1.categorycode
 357             LEFT JOIN branches      AS B1 on B1.branchcode=U1.branchcode
 358         WHERE status = ?
 359         ORDER BY suggestionid
 360     };
 361
 362     # filter on branch
 363     if ( C4::Context->preference("IndependentBranches") || $branchcode ) {
 364         my $userenv = C4::Context->userenv;
 365         if ($userenv) {
 366             unless ( C4::Context->IsSuperLibrarian() ) {
 367                 push @sql_params, $userenv->{branch};
 368                 $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 369             }
 370         }
 371         if ($branchcode) {
 372             push @sql_params, $branchcode;
 373             $query .= q{ AND (U1.branchcode = ? OR U1.branchcode ='') };
 374         }
 375     }
 376
 377     my $sth = $dbh->prepare($query);
 378     $sth->execute(@sql_params);
 379     my $results;
 380     $results = $sth->fetchall_arrayref( {} );
 381     return $results;
 382 }
 383
 384 =head2 CountSuggestion
 385
 386 &CountSuggestion($status)
 387
 388 Count the number of aqorders with the status given on input argument.
 389 the arg status can be :
 390
 391 =over 2
 392
 393 =item * ASKED : asked by the user, not dealed by the librarian
 394
 395 =item * ACCEPTED : accepted by the librarian, but not yet ordered
 396
 397 =item * REJECTED : rejected by the librarian (definitive status)
 398
 399 =item * ORDERED : ordered by the librarian (acquisition module)
 400
 401 =back
 402
 403 return :
 404 the number of suggestion with this status.
 405
 406 =cut
 407
 408 sub CountSuggestion {
 409     my ($status) = @_;
 410     my $dbh = C4::Context->dbh;
 411     my $sth;
 412     my $userenv = C4::Context->userenv;
 413     if ( C4::Context->preference("IndependentBranches")
 414         && !C4::Context->IsSuperLibrarian() )
 415     {
 416         my $query = q{
 417             SELECT count(*)
 418             FROM suggestions
 419                 LEFT JOIN borrowers ON borrowers.borrowernumber=suggestions.suggestedby
 420             WHERE STATUS=?
 421                 AND (suggestions.branchcode='' OR suggestions.branchcode=?)
 422         };
 423         $sth = $dbh->prepare($query);
 424         $sth->execute( $status, $userenv->{branch} );
 425     }
 426     else {
 427         my $query = q{
 428             SELECT count(*)
 429             FROM suggestions
 430             WHERE STATUS=?
 431         };
 432         $sth = $dbh->prepare($query);
 433         $sth->execute($status);
 434     }
 435     my ($result) = $sth->fetchrow;
 436     return $result;
 437 }
 438
 439 =head2 NewSuggestion
 440
 441
 442 &NewSuggestion($suggestion);
 443
 444 Insert a new suggestion on database with value given on input arg.
 445
 446 =cut
 447
 448 sub NewSuggestion {
 449     my ($suggestion) = @_;
 450
 451     $suggestion->{STATUS} = "ASKED" unless $suggestion->{STATUS};
 452
 453     $suggestion->{suggesteddate} = dt_from_string unless $suggestion->{suggesteddate};
 454
 455     delete $suggestion->{branchcode} if $suggestion->{branchcode} eq '';
 456
 457     my $suggestion_object = Koha::Suggestion->new( $suggestion )->store;
 458     my $suggestion_id = $suggestion_object->suggestionid;
 459
 460     my $emailpurchasesuggestions = C4::Context->preference("EmailPurchaseSuggestions");
 461     if ($emailpurchasesuggestions) {
 462         my $full_suggestion = GetSuggestion( $suggestion_id); # We should not need to refetch it!
 463         if (
 464             my $letter = C4::Letters::GetPreparedLetter(
 465                 module      => 'suggestions',
 466                 letter_code => 'NEW_SUGGESTION',
 467                 tables      => {
 468                     'branches'    => $full_suggestion->{branchcode},
 469                     'borrowers'   => $full_suggestion->{suggestedby},
 470                     'suggestions' => $full_suggestion,
 471                 },
 472             )
 473         ){
 474
 475             my $toaddress;
 476             if ( $emailpurchasesuggestions eq "BranchEmailAddress" ) {
 477                 my $library =
 478                   Koha::Libraries->find( $full_suggestion->{branchcode} );
 479                 $toaddress = $library->inbound_email_address;
 480             }
 481             elsif ( $emailpurchasesuggestions eq "KohaAdminEmailAddress" ) {
 482                 $toaddress = C4::Context->preference('ReplytoDefault')
 483                   || C4::Context->preference('KohaAdminEmailAddress');
 484             }
 485             else {
 486                 $toaddress =
 487                      C4::Context->preference($emailpurchasesuggestions)
 488                   || C4::Context->preference('ReplytoDefault')
 489                   || C4::Context->preference('KohaAdminEmailAddress');
 490             }
 491
 492             C4::Letters::EnqueueLetter(
 493                 {
 494                     letter         => $letter,
 495                     borrowernumber => $full_suggestion->{suggestedby},
 496                     suggestionid   => $full_suggestion->{suggestionid},
 497                     to_address     => $toaddress,
 498                     message_transport_type => 'email',
 499                 }
 500             ) or warn "can't enqueue letter $letter";
 501         }
 502     }
 503
 504     return $suggestion_id;
 505 }
 506
 507 =head2 ModSuggestion
 508
 509 &ModSuggestion($suggestion)
 510
 511 Modify the suggestion according to the hash passed by ref.
 512 The hash HAS to contain suggestionid
 513 Data not defined is not updated unless it is a note or sort1
 514 Send a mail to notify the user that did the suggestion.
 515
 516 Note that there is no function to modify a suggestion.
 517
 518 =cut
 519
 520 sub ModSuggestion {
 521     my ($suggestion) = @_;
 522     return unless( $suggestion and defined($suggestion->{suggestionid}) );
 523
 524     my $suggestion_object = Koha::Suggestions->find( $suggestion->{suggestionid} );
 525     eval { # FIXME Must raise an exception instead
 526         $suggestion_object->set($suggestion)->store;
 527     };
 528     return 0 if $@;
 529
 530     if ( $suggestion->{STATUS} ) {
 531
 532         # fetch the entire updated suggestion so that we can populate the letter
 533         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 534         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
 535
 536         my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
 537
 538         if (
 539             my $letter = C4::Letters::GetPreparedLetter(
 540                 module      => 'suggestions',
 541                 letter_code => $full_suggestion->{STATUS},
 542                 branchcode  => $full_suggestion->{branchcode},
 543                 lang        => $patron->lang,
 544                 tables      => {
 545                     'branches'    => $full_suggestion->{branchcode},
 546                     'borrowers'   => $full_suggestion->{suggestedby},
 547                     'suggestions' => $full_suggestion,
 548                     'biblio'      => $full_suggestion->{biblionumber},
 549                 },
 550             )
 551           )
 552         {
 553             C4::Letters::EnqueueLetter(
 554                 {
 555                     letter         => $letter,
 556                     borrowernumber => $full_suggestion->{suggestedby},
 557                     suggestionid   => $full_suggestion->{suggestionid},
 558                     LibraryName    => C4::Context->preference("LibraryName"),
 559                     message_transport_type => $transport,
 560                 }
 561             ) or warn "can't enqueue letter $letter";
 562         }
 563     }
 564     return 1; # No useful if the exception is raised earlier
 565 }
 566
 567 =head2 ConnectSuggestionAndBiblio
 568
 569 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 570
 571 connect a suggestion to an existing biblio
 572
 573 =cut
 574
 575 sub ConnectSuggestionAndBiblio {
 576     my ( $suggestionid, $biblionumber ) = @_;
 577     my $dbh   = C4::Context->dbh;
 578     my $query = q{
 579         UPDATE suggestions
 580         SET    biblionumber=?
 581         WHERE  suggestionid=?
 582     };
 583     my $sth = $dbh->prepare($query);
 584     $sth->execute( $biblionumber, $suggestionid );
 585 }
 586
 587 =head2 DelSuggestion
 588
 589 &DelSuggestion($borrowernumber,$ordernumber)
 590
 591 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 592
 593 =cut
 594
 595 sub DelSuggestion {
 596     my ( $borrowernumber, $suggestionid, $type ) = @_;
 597     my $dbh = C4::Context->dbh;
 598
 599     # check that the suggestion comes from the suggestor
 600     my $query = q{
 601         SELECT suggestedby
 602         FROM   suggestions
 603         WHERE  suggestionid=?
 604     };
 605     my $sth = $dbh->prepare($query);
 606     $sth->execute($suggestionid);
 607     my ($suggestedby) = $sth->fetchrow;
 608     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 609         my $queryDelete = q{
 610             DELETE FROM suggestions
 611             WHERE suggestionid=?
 612         };
 613         $sth = $dbh->prepare($queryDelete);
 614         my $suggestiondeleted = $sth->execute($suggestionid);
 615         return $suggestiondeleted;
 616     }
 617 }
 618
 619 =head2 DelSuggestionsOlderThan
 620     &DelSuggestionsOlderThan($days)
 621
 622     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 623     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
 624
 625 =cut
 626
 627 sub DelSuggestionsOlderThan {
 628     my ($days) = @_;
 629     return unless $days && $days > 0;
 630     my $dbh = C4::Context->dbh;
 631     my $sth = $dbh->prepare(
 632         q{
 633         DELETE FROM suggestions
 634         WHERE STATUS<>'ASKED'
 635             AND date < ADDDATE(NOW(), ?)
 636     }
 637     );
 638     $sth->execute("-$days");
 639 }
 640
 641 sub GetUnprocessedSuggestions {
 642     my ( $number_of_days_since_the_last_modification ) = @_;
 643
 644     $number_of_days_since_the_last_modification ||= 0;
 645
 646     my $dbh = C4::Context->dbh;
 647
 648     my $s = $dbh->selectall_arrayref(q|
 649         SELECT *
 650         FROM suggestions
 651         WHERE STATUS = 'ASKED'
 652             AND budgetid IS NOT NULL
 653             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
 654     |, { Slice => {} }, $number_of_days_since_the_last_modification );
 655     return $s;
 656 }
 657
 658 =head2 MarcRecordFromNewSuggestion
 659
 660     $record = MarcRecordFromNewSuggestion ( $suggestion )
 661
 662 This function build a marc record object from a suggestion
 663
 664 =cut
 665
 666 sub MarcRecordFromNewSuggestion {
 667     my ($suggestion) = @_;
 668     my $record = MARC::Record->new();
 669
 670     my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
 671     $record->append_fields(
 672         MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
 673     );
 674
 675     my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
 676     if ($record->field( $author_tag )) {
 677         $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
 678     }
 679     else {
 680         $record->append_fields(
 681             MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
 682         );
 683     }
 684
 685     my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
 686     if ($record->field( $it_tag )) {
 687         $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
 688     }
 689     else {
 690         $record->append_fields(
 691             MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
 692         );
 693     }
 694
 695     return $record;
 696 }
 697
 698 1;
 699 __END__
 700
 701
 702 =head1 AUTHOR
 703
 704 Koha Development Team <http://koha-community.org/>
 705
 706 =cut
 707