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