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