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} && $suggestion_object->suggestedby ) {
 531
 532         # fetch the entire updated suggestion so that we can populate the letter
 533         my $full_suggestion = GetSuggestion( $suggestion->{suggestionid} );
 534
 535         my $patron = Koha::Patrons->find( $full_suggestion->{suggestedby} );
 536
 537         my $transport = (C4::Context->preference("FallbackToSMSIfNoEmail")) && ($patron->smsalertnumber) && (!$patron->email) ? 'sms' : 'email';
 538
 539         if (
 540             my $letter = C4::Letters::GetPreparedLetter(
 541                 module      => 'suggestions',
 542                 letter_code => $full_suggestion->{STATUS},
 543                 branchcode  => $full_suggestion->{branchcode},
 544                 lang        => $patron->lang,
 545                 tables      => {
 546                     'branches'    => $full_suggestion->{branchcode},
 547                     'borrowers'   => $full_suggestion->{suggestedby},
 548                     'suggestions' => $full_suggestion,
 549                     'biblio'      => $full_suggestion->{biblionumber},
 550                 },
 551             )
 552           )
 553         {
 554             C4::Letters::EnqueueLetter(
 555                 {
 556                     letter         => $letter,
 557                     borrowernumber => $full_suggestion->{suggestedby},
 558                     suggestionid   => $full_suggestion->{suggestionid},
 559                     LibraryName    => C4::Context->preference("LibraryName"),
 560                     message_transport_type => $transport,
 561                 }
 562             ) or warn "can't enqueue letter $letter";
 563         }
 564     }
 565     return 1; # No useful if the exception is raised earlier
 566 }
 567
 568 =head2 ConnectSuggestionAndBiblio
 569
 570 &ConnectSuggestionAndBiblio($ordernumber,$biblionumber)
 571
 572 connect a suggestion to an existing biblio
 573
 574 =cut
 575
 576 sub ConnectSuggestionAndBiblio {
 577     my ( $suggestionid, $biblionumber ) = @_;
 578     my $dbh   = C4::Context->dbh;
 579     my $query = q{
 580         UPDATE suggestions
 581         SET    biblionumber=?
 582         WHERE  suggestionid=?
 583     };
 584     my $sth = $dbh->prepare($query);
 585     $sth->execute( $biblionumber, $suggestionid );
 586 }
 587
 588 =head2 DelSuggestion
 589
 590 &DelSuggestion($borrowernumber,$ordernumber)
 591
 592 Delete a suggestion. A borrower can delete a suggestion only if they are its owner.
 593
 594 =cut
 595
 596 sub DelSuggestion {
 597     my ( $borrowernumber, $suggestionid, $type ) = @_;
 598     my $dbh = C4::Context->dbh;
 599
 600     # check that the suggestion comes from the suggestor
 601     my $query = q{
 602         SELECT suggestedby
 603         FROM   suggestions
 604         WHERE  suggestionid=?
 605     };
 606     my $sth = $dbh->prepare($query);
 607     $sth->execute($suggestionid);
 608     my ($suggestedby) = $sth->fetchrow;
 609     if ( $type eq 'intranet' || $suggestedby eq $borrowernumber ) {
 610         my $queryDelete = q{
 611             DELETE FROM suggestions
 612             WHERE suggestionid=?
 613         };
 614         $sth = $dbh->prepare($queryDelete);
 615         my $suggestiondeleted = $sth->execute($suggestionid);
 616         return $suggestiondeleted;
 617     }
 618 }
 619
 620 =head2 DelSuggestionsOlderThan
 621     &DelSuggestionsOlderThan($days)
 622
 623     Delete all suggestions older than TODAY-$days , that have be accepted or rejected.
 624     We do now allow a negative number. If you want to delete all suggestions, just use Koha::Suggestions->delete or so.
 625
 626 =cut
 627
 628 sub DelSuggestionsOlderThan {
 629     my ($days) = @_;
 630     return unless $days && $days > 0;
 631     my $dbh = C4::Context->dbh;
 632     my $sth = $dbh->prepare(
 633         q{
 634         DELETE FROM suggestions
 635         WHERE STATUS<>'ASKED'
 636             AND date < ADDDATE(NOW(), ?)
 637     }
 638     );
 639     $sth->execute("-$days");
 640 }
 641
 642 sub GetUnprocessedSuggestions {
 643     my ( $number_of_days_since_the_last_modification ) = @_;
 644
 645     $number_of_days_since_the_last_modification ||= 0;
 646
 647     my $dbh = C4::Context->dbh;
 648
 649     my $s = $dbh->selectall_arrayref(q|
 650         SELECT *
 651         FROM suggestions
 652         WHERE STATUS = 'ASKED'
 653             AND budgetid IS NOT NULL
 654             AND CAST(NOW() AS DATE) - INTERVAL ? DAY = CAST(suggesteddate AS DATE)
 655     |, { Slice => {} }, $number_of_days_since_the_last_modification );
 656     return $s;
 657 }
 658
 659 =head2 MarcRecordFromNewSuggestion
 660
 661     $record = MarcRecordFromNewSuggestion ( $suggestion )
 662
 663 This function build a marc record object from a suggestion
 664
 665 =cut
 666
 667 sub MarcRecordFromNewSuggestion {
 668     my ($suggestion) = @_;
 669     my $record = MARC::Record->new();
 670
 671     my ($title_tag, $title_subfield) = GetMarcFromKohaField('biblio.title', '');
 672     $record->append_fields(
 673         MARC::Field->new($title_tag, ' ', ' ', $title_subfield => $suggestion->{title})
 674     );
 675
 676     my ($author_tag, $author_subfield) = GetMarcFromKohaField('biblio.author', '');
 677     if ($record->field( $author_tag )) {
 678         $record->field( $author_tag )->add_subfields( $author_subfield => $suggestion->{author} );
 679     }
 680     else {
 681         $record->append_fields(
 682             MARC::Field->new($author_tag, ' ', ' ', $author_subfield => $suggestion->{author})
 683         );
 684     }
 685
 686     my ($it_tag, $it_subfield) = GetMarcFromKohaField('biblioitems.itemtype', '');
 687     if ($record->field( $it_tag )) {
 688         $record->field( $it_tag )->add_subfields( $it_subfield => $suggestion->{itemtype} );
 689     }
 690     else {
 691         $record->append_fields(
 692             MARC::Field->new($it_tag, ' ', ' ', $it_subfield => $suggestion->{itemtype})
 693         );
 694     }
 695
 696     return $record;
 697 }
 698
 699 1;
 700 __END__
 701
 702
 703 =head1 AUTHOR
 704
 705 Koha Development Team <http://koha-community.org/>
 706
 707 =cut
 708