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