3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 use C4::Dates qw(format_date format_date_in_iso);
24 use Date::Calc qw(:all);
25 use POSIX qw(strftime);
27 use C4::Log; # logaction
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33 $VERSION = 3.07.00.049; # set version for version checking
37 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
38 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
40 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
41 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
43 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
44 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
45 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
46 &GetSerialInformation &AddItem2Serial
47 &PrepareSerialsData &GetNextExpected &ModNextExpected
49 &UpdateClaimdateIssues
50 &GetSuppliersWithLateIssues &getsupplierbyserialid
51 &GetDistributedTo &SetDistributedTo
52 &getroutinglist &delroutingmember &addroutingmember
54 &check_routing &updateClaim &removeMissingIssue
57 &GetSubscriptionsFromBorrower
58 &subscriptionCurrentlyOnOrder
65 C4::Serials - Serials Module Functions
73 Functions for handling subscriptions, claims routing etc.
78 =head2 GetSuppliersWithLateIssues
80 $supplierlist = GetSuppliersWithLateIssues()
82 this function get all suppliers with late issues.
85 an array_ref of suppliers each entry is a hash_ref containing id and name
86 the array is in name order
90 sub GetSuppliersWithLateIssues {
91 my $dbh = C4::Context->dbh;
93 SELECT DISTINCT id, name
95 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
96 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
99 (planneddate < now() AND serial.status=1)
100 OR serial.STATUS = 3 OR serial.STATUS = 4
102 AND subscription.closed = 0
104 return $dbh->selectall_arrayref($query, { Slice => {} });
109 @issuelist = GetLateIssues($supplierid)
111 this function selects late issues from the database
114 the issuelist as an array. Each element of this array contains a hashi_ref containing
115 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
120 my ($supplierid) = @_;
121 my $dbh = C4::Context->dbh;
125 SELECT name,title,planneddate,serialseq,serial.subscriptionid
127 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
128 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
129 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
130 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
131 AND subscription.aqbooksellerid=?
132 AND subscription.closed = 0
135 $sth = $dbh->prepare($query);
136 $sth->execute($supplierid);
139 SELECT name,title,planneddate,serialseq,serial.subscriptionid
141 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
142 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
143 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
144 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
145 AND subscription.closed = 0
148 $sth = $dbh->prepare($query);
154 while ( my $line = $sth->fetchrow_hashref ) {
155 $odd++ unless $line->{title} eq $last_title;
156 $line->{title} = "" if $line->{title} eq $last_title;
157 $last_title = $line->{title} if ( $line->{title} );
158 $line->{planneddate} = format_date( $line->{planneddate} );
159 push @issuelist, $line;
164 =head2 GetSubscriptionHistoryFromSubscriptionId
166 $sth = GetSubscriptionHistoryFromSubscriptionId()
167 this function prepares the SQL request and returns the statement handle
168 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
172 sub GetSubscriptionHistoryFromSubscriptionId {
173 my $dbh = C4::Context->dbh;
176 FROM subscriptionhistory
177 WHERE subscriptionid = ?
179 return $dbh->prepare($query);
182 =head2 GetSerialStatusFromSerialId
184 $sth = GetSerialStatusFromSerialId();
185 this function returns a statement handle
186 After this function, don't forget to execute it by using $sth->execute($serialid)
188 $sth = $dbh->prepare($query).
192 sub GetSerialStatusFromSerialId {
193 my $dbh = C4::Context->dbh;
199 return $dbh->prepare($query);
202 =head2 GetSerialInformation
205 $data = GetSerialInformation($serialid);
206 returns a hash_ref containing :
207 items : items marcrecord (can be an array)
209 subscription table field
210 + information about subscription expiration
214 sub GetSerialInformation {
216 my $dbh = C4::Context->dbh;
218 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
219 if ( C4::Context->preference('IndependantBranches')
220 && C4::Context->userenv
221 && C4::Context->userenv->{'flags'} != 1
222 && C4::Context->userenv->{'branch'} ) {
224 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
227 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
230 my $rq = $dbh->prepare($query);
231 $rq->execute($serialid);
232 my $data = $rq->fetchrow_hashref;
234 # create item information if we have serialsadditems for this subscription
235 if ( $data->{'serialsadditems'} ) {
236 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
237 $queryitem->execute($serialid);
238 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
240 if ( scalar(@$itemnumbers) > 0 ) {
241 foreach my $itemnum (@$itemnumbers) {
243 #It is ASSUMED that GetMarcItem ALWAYS WORK...
244 #Maybe GetMarcItem should return values on failure
245 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
246 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
247 $itemprocessed->{'itemnumber'} = $itemnum->[0];
248 $itemprocessed->{'itemid'} = $itemnum->[0];
249 $itemprocessed->{'serialid'} = $serialid;
250 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
251 push @{ $data->{'items'} }, $itemprocessed;
254 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
255 $itemprocessed->{'itemid'} = "N$serialid";
256 $itemprocessed->{'serialid'} = $serialid;
257 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
258 $itemprocessed->{'countitems'} = 0;
259 push @{ $data->{'items'} }, $itemprocessed;
262 $data->{ "status" . $data->{'serstatus'} } = 1;
263 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
264 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
268 =head2 AddItem2Serial
270 $rows = AddItem2Serial($serialid,$itemnumber);
271 Adds an itemnumber to Serial record
272 returns the number of rows affected
277 my ( $serialid, $itemnumber ) = @_;
278 my $dbh = C4::Context->dbh;
279 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
280 $rq->execute( $serialid, $itemnumber );
284 =head2 UpdateClaimdateIssues
286 UpdateClaimdateIssues($serialids,[$date]);
288 Update Claimdate for issues in @$serialids list with date $date
293 sub UpdateClaimdateIssues {
294 my ( $serialids, $date ) = @_;
295 my $dbh = C4::Context->dbh;
296 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
298 UPDATE serial SET claimdate = ?, status = 7
299 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
300 my $rq = $dbh->prepare($query);
301 $rq->execute($date, @$serialids);
305 =head2 GetSubscription
307 $subs = GetSubscription($subscriptionid)
308 this function returns the subscription which has $subscriptionid as id.
310 a hashref. This hash containts
311 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
315 sub GetSubscription {
316 my ($subscriptionid) = @_;
317 my $dbh = C4::Context->dbh;
319 SELECT subscription.*,
320 subscriptionhistory.*,
321 aqbooksellers.name AS aqbooksellername,
322 biblio.title AS bibliotitle,
323 subscription.biblionumber as bibnum);
324 if ( C4::Context->preference('IndependantBranches')
325 && C4::Context->userenv
326 && C4::Context->userenv->{'flags'} != 1
327 && C4::Context->userenv->{'branch'} ) {
329 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
333 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
334 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
335 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
336 WHERE subscription.subscriptionid = ?
339 # if (C4::Context->preference('IndependantBranches') &&
340 # C4::Context->userenv &&
341 # C4::Context->userenv->{'flags'} != 1){
342 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
343 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
345 $debug and warn "query : $query\nsubsid :$subscriptionid";
346 my $sth = $dbh->prepare($query);
347 $sth->execute($subscriptionid);
348 return $sth->fetchrow_hashref;
351 =head2 GetFullSubscription
353 $array_ref = GetFullSubscription($subscriptionid)
354 this function reads the serial table.
358 sub GetFullSubscription {
359 my ($subscriptionid) = @_;
360 my $dbh = C4::Context->dbh;
362 SELECT serial.serialid,
365 serial.publisheddate,
367 serial.notes as notes,
368 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
369 aqbooksellers.name as aqbooksellername,
370 biblio.title as bibliotitle,
371 subscription.branchcode AS branchcode,
372 branches.branchname AS branchname,
373 subscription.subscriptionid AS subscriptionid |;
374 if ( C4::Context->preference('IndependantBranches')
375 && C4::Context->userenv
376 && C4::Context->userenv->{'flags'} != 1
377 && C4::Context->userenv->{'branch'} ) {
379 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
383 LEFT JOIN subscription ON
384 ( serial.subscriptionid = subscription.subscriptionid )
385 LEFT JOIN aqbooksellers ON
386 ( subscription.aqbooksellerid = aqbooksellers.id )
388 ( biblio.biblionumber = subscription.biblionumber )
389 LEFT JOIN branches ON
390 ( subscription.branchcode = branches.branchcode )
391 WHERE serial.subscriptionid = ?
393 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
394 serial.subscriptionid
396 $debug and warn "GetFullSubscription query: $query";
397 my $sth = $dbh->prepare($query);
398 $sth->execute($subscriptionid);
399 return $sth->fetchall_arrayref( {} );
402 =head2 PrepareSerialsData
404 $array_ref = PrepareSerialsData($serialinfomation)
405 where serialinformation is a hashref array
409 sub PrepareSerialsData {
415 my $aqbooksellername;
419 my $previousnote = "";
421 foreach my $subs (@{$lines}) {
422 for my $datefield ( qw(publisheddate planneddate) ) {
423 # handle both undef and undef returned as 0000-00-00
424 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
425 $subs->{$datefield} = 'XXX';
428 $subs->{$datefield} = format_date( $subs->{$datefield} );
431 $subs->{ "status" . $subs->{'status'} } = 1;
432 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
434 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
435 $year = $subs->{'year'};
439 if ( $tmpresults{$year} ) {
440 push @{ $tmpresults{$year}->{'serials'} }, $subs;
442 $tmpresults{$year} = {
444 'aqbooksellername' => $subs->{'aqbooksellername'},
445 'bibliotitle' => $subs->{'bibliotitle'},
446 'serials' => [$subs],
451 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
452 push @res, $tmpresults{$key};
457 =head2 GetSubscriptionsFromBiblionumber
459 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
460 this function get the subscription list. it reads the subscription table.
462 reference to an array of subscriptions which have the biblionumber given on input arg.
463 each element of this array is a hashref containing
464 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
468 sub GetSubscriptionsFromBiblionumber {
469 my ($biblionumber) = @_;
470 my $dbh = C4::Context->dbh;
472 SELECT subscription.*,
474 subscriptionhistory.*,
475 aqbooksellers.name AS aqbooksellername,
476 biblio.title AS bibliotitle
478 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
479 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
480 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
481 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
482 WHERE subscription.biblionumber = ?
484 my $sth = $dbh->prepare($query);
485 $sth->execute($biblionumber);
487 while ( my $subs = $sth->fetchrow_hashref ) {
488 $subs->{startdate} = format_date( $subs->{startdate} );
489 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
490 $subs->{histenddate} = format_date( $subs->{histenddate} );
491 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
492 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
493 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
494 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
495 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
496 $subs->{ "status" . $subs->{'status'} } = 1;
497 $subs->{'cannotedit'} =
498 ( C4::Context->preference('IndependantBranches')
499 && C4::Context->userenv
500 && C4::Context->userenv->{flags} % 2 != 1
501 && C4::Context->userenv->{branch}
502 && $subs->{branchcode}
503 && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
505 if ( $subs->{enddate} eq '0000-00-00' ) {
506 $subs->{enddate} = '';
508 $subs->{enddate} = format_date( $subs->{enddate} );
510 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
511 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
517 =head2 GetFullSubscriptionsFromBiblionumber
519 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
520 this function reads the serial table.
524 sub GetFullSubscriptionsFromBiblionumber {
525 my ($biblionumber) = @_;
526 my $dbh = C4::Context->dbh;
528 SELECT serial.serialid,
531 serial.publisheddate,
533 serial.notes as notes,
534 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
535 biblio.title as bibliotitle,
536 subscription.branchcode AS branchcode,
537 subscription.subscriptionid AS subscriptionid|;
538 if ( C4::Context->preference('IndependantBranches')
539 && C4::Context->userenv
540 && C4::Context->userenv->{'flags'} != 1
541 && C4::Context->userenv->{'branch'} ) {
543 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
548 LEFT JOIN subscription ON
549 (serial.subscriptionid=subscription.subscriptionid)
550 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
551 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
552 WHERE subscription.biblionumber = ?
554 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
555 serial.subscriptionid
557 my $sth = $dbh->prepare($query);
558 $sth->execute($biblionumber);
559 return $sth->fetchall_arrayref( {} );
562 =head2 GetSubscriptions
564 @results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
565 this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
567 a table of hashref. Each hash containt the subscription.
571 sub GetSubscriptions {
572 my ( $string, $issn, $ean, $biblionumber ) = @_;
574 #return unless $title or $ISSN or $biblionumber;
575 my $dbh = C4::Context->dbh;
578 SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber
580 LEFT JOIN subscriptionhistory USING(subscriptionid)
581 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
582 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
587 $sqlwhere = " WHERE biblio.biblionumber=?";
588 push @bind_params, $biblionumber;
592 my @strings_to_search;
593 @strings_to_search = map { "%$_%" } split( / /, $string );
594 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
595 push @bind_params, @strings_to_search;
596 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
597 $debug && warn "$tmpstring";
598 $tmpstring =~ s/^AND //;
599 push @sqlstrings, $tmpstring;
601 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
605 my @strings_to_search;
606 @strings_to_search = map { "%$_%" } split( / /, $issn );
607 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
608 push @bind_params, @strings_to_search;
609 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
610 $debug && warn "$tmpstring";
611 $tmpstring =~ s/^OR //;
612 push @sqlstrings, $tmpstring;
614 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
618 my @strings_to_search;
619 @strings_to_search = map { "$_" } split( / /, $ean );
620 foreach my $index ( qw(biblioitems.ean) ) {
621 push @bind_params, @strings_to_search;
622 my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
623 $debug && warn "$tmpstring";
624 $tmpstring =~ s/^OR //;
625 push @sqlstrings, $tmpstring;
627 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
630 $sql .= "$sqlwhere ORDER BY title";
631 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
632 $sth = $dbh->prepare($sql);
633 $sth->execute(@bind_params);
636 while ( my $line = $sth->fetchrow_hashref ) {
637 $line->{'cannotedit'} =
638 ( C4::Context->preference('IndependantBranches')
639 && C4::Context->userenv
640 && C4::Context->userenv->{flags} % 2 != 1
641 && C4::Context->userenv->{branch}
642 && $line->{branchcode}
643 && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
644 push @results, $line;
649 =head2 SearchSubscriptions
651 @results = SearchSubscriptions($args);
652 $args is a hashref. Its keys can be contained: title, issn, ean, publisher, bookseller and branchcode
654 this function gets all subscriptions which have title like $title, ISSN like $issn, EAN like $ean, publisher like $publisher, bookseller like $bookseller AND branchcode eq $branch.
657 a table of hashref. Each hash containt the subscription.
661 sub SearchSubscriptions {
666 subscription.notes AS publicnotes,
668 subscriptionhistory.*,
669 biblio.notes AS biblionotes,
674 LEFT JOIN subscriptionhistory USING(subscriptionid)
675 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
676 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
677 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
681 if( $args->{biblionumber} ) {
682 push @where_strs, "biblio.biblionumber = ?";
683 push @where_args, $args->{biblionumber};
685 if( $args->{title} ){
686 my @words = split / /, $args->{title};
688 foreach my $word (@words) {
689 push @strs, "biblio.title LIKE ?";
690 push @args, "%$word%";
693 push @where_strs, '(' . join (' AND ', @strs) . ')';
694 push @where_args, @args;
698 push @where_strs, "biblioitems.issn LIKE ?";
699 push @where_args, "%$args->{issn}%";
702 push @where_strs, "biblioitems.ean LIKE ?";
703 push @where_args, "%$args->{ean}%";
705 if( $args->{publisher} ){
706 push @where_strs, "biblioitems.publishercode LIKE ?";
707 push @where_args, "%$args->{publisher}%";
709 if( $args->{bookseller} ){
710 push @where_strs, "aqbooksellers.name LIKE ?";
711 push @where_args, "%$args->{bookseller}%";
713 if( $args->{branch} ){
714 push @where_strs, "subscription.branchcode = ?";
715 push @where_args, "$args->{branch}";
717 if( defined $args->{closed} ){
718 push @where_strs, "subscription.closed = ?";
719 push @where_args, "$args->{closed}";
722 $query .= " WHERE " . join(" AND ", @where_strs);
725 my $dbh = C4::Context->dbh;
726 my $sth = $dbh->prepare($query);
727 $sth->execute(@where_args);
728 my $results = $sth->fetchall_arrayref( {} );
737 ($totalissues,@serials) = GetSerials($subscriptionid);
738 this function gets every serial not arrived for a given subscription
739 as well as the number of issues registered in the database (all types)
740 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
742 FIXME: We should return \@serials.
747 my ( $subscriptionid, $count ) = @_;
748 my $dbh = C4::Context->dbh;
750 # status = 2 is "arrived"
752 $count = 5 unless ($count);
754 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
756 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
757 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
758 my $sth = $dbh->prepare($query);
759 $sth->execute($subscriptionid);
761 while ( my $line = $sth->fetchrow_hashref ) {
762 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
763 for my $datefield ( qw( planneddate publisheddate) ) {
764 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
765 $line->{$datefield} = format_date( $line->{$datefield});
767 $line->{$datefield} = q{};
770 push @serials, $line;
773 # OK, now add the last 5 issues arrives/missing
774 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
776 WHERE subscriptionid = ?
777 AND (status in (2,4,5))
778 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
780 $sth = $dbh->prepare($query);
781 $sth->execute($subscriptionid);
782 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
784 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
785 for my $datefield ( qw( planneddate publisheddate) ) {
786 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
787 $line->{$datefield} = format_date( $line->{$datefield});
789 $line->{$datefield} = q{};
793 push @serials, $line;
796 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
797 $sth = $dbh->prepare($query);
798 $sth->execute($subscriptionid);
799 my ($totalissues) = $sth->fetchrow;
800 return ( $totalissues, @serials );
805 @serials = GetSerials2($subscriptionid,$status);
806 this function returns every serial waited for a given subscription
807 as well as the number of issues registered in the database (all types)
808 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
813 my ( $subscription, $status ) = @_;
814 my $dbh = C4::Context->dbh;
816 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
818 WHERE subscriptionid=$subscription AND status IN ($status)
819 ORDER BY publisheddate,serialid DESC
821 $debug and warn "GetSerials2 query: $query";
822 my $sth = $dbh->prepare($query);
826 while ( my $line = $sth->fetchrow_hashref ) {
827 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
828 # Format dates for display
829 for my $datefield ( qw( planneddate publisheddate ) ) {
830 if ($line->{$datefield} =~m/^00/) {
831 $line->{$datefield} = q{};
834 $line->{$datefield} = format_date( $line->{$datefield} );
837 push @serials, $line;
842 =head2 GetLatestSerials
844 \@serials = GetLatestSerials($subscriptionid,$limit)
845 get the $limit's latest serials arrived or missing for a given subscription
847 a ref to an array which contains all of the latest serials stored into a hash.
851 sub GetLatestSerials {
852 my ( $subscriptionid, $limit ) = @_;
853 my $dbh = C4::Context->dbh;
855 # status = 2 is "arrived"
856 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
858 WHERE subscriptionid = ?
859 AND (status =2 or status=4)
860 ORDER BY publisheddate DESC LIMIT 0,$limit
862 my $sth = $dbh->prepare($strsth);
863 $sth->execute($subscriptionid);
865 while ( my $line = $sth->fetchrow_hashref ) {
866 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
867 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
868 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
869 push @serials, $line;
875 =head2 GetDistributedTo
877 $distributedto=GetDistributedTo($subscriptionid)
878 This function returns the field distributedto for the subscription matching subscriptionid
882 sub GetDistributedTo {
883 my $dbh = C4::Context->dbh;
885 my $subscriptionid = @_;
886 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
887 my $sth = $dbh->prepare($query);
888 $sth->execute($subscriptionid);
889 return ($distributedto) = $sth->fetchrow;
895 $val is a hashref containing all the attributes of the table 'subscription'
896 This function get the next issue for the subscription given on input arg
898 a list containing all the input params updated.
904 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
905 # $calculated = $val->{numberingmethod};
906 # # calculate the (expected) value of the next issue recieved.
907 # $newlastvalue1 = $val->{lastvalue1};
908 # # check if we have to increase the new value.
909 # $newinnerloop1 = $val->{innerloop1}+1;
910 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
911 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
912 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
913 # $calculated =~ s/\{X\}/$newlastvalue1/g;
915 # $newlastvalue2 = $val->{lastvalue2};
916 # # check if we have to increase the new value.
917 # $newinnerloop2 = $val->{innerloop2}+1;
918 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
919 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
920 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
921 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
923 # $newlastvalue3 = $val->{lastvalue3};
924 # # check if we have to increase the new value.
925 # $newinnerloop3 = $val->{innerloop3}+1;
926 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
927 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
928 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
929 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
930 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
935 my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
936 my $pattern = $val->{numberpattern};
937 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
938 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
939 $calculated = $val->{numberingmethod};
940 $newlastvalue1 = $val->{lastvalue1};
941 $newlastvalue2 = $val->{lastvalue2};
942 $newlastvalue3 = $val->{lastvalue3};
943 $newlastvalue1 = $val->{lastvalue1};
945 # check if we have to increase the new value.
946 $newinnerloop1 = $val->{innerloop1} + 1;
947 $newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} );
948 $newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 ); # <1 to be true when 0 or empty.
949 $newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} ); # reset counter if needed.
950 $calculated =~ s/\{X\}/$newlastvalue1/g;
952 $newlastvalue2 = $val->{lastvalue2};
954 # check if we have to increase the new value.
955 $newinnerloop2 = $val->{innerloop2} + 1;
956 $newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} );
957 $newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 ); # <1 to be true when 0 or empty.
958 $newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} ); # reset counter if needed.
959 if ( $pattern == 6 ) {
960 if ( $val->{hemisphere} == 2 ) {
961 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
962 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
964 my $newlastvalue2seq = $seasons[$newlastvalue2];
965 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
968 $calculated =~ s/\{Y\}/$newlastvalue2/g;
971 $newlastvalue3 = $val->{lastvalue3};
973 # check if we have to increase the new value.
974 $newinnerloop3 = $val->{innerloop3} + 1;
975 $newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} );
976 $newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 ); # <1 to be true when 0 or empty.
977 $newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} ); # reset counter if needed.
978 $calculated =~ s/\{Z\}/$newlastvalue3/g;
980 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
985 $calculated = GetSeq($val)
986 $val is a hashref containing all the attributes of the table 'subscription'
987 this function transforms {X},{Y},{Z} to 150,0,0 for example.
989 the sequence in integer format
995 my $pattern = $val->{numberpattern};
996 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
997 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
998 my $calculated = $val->{numberingmethod};
999 my $x = $val->{'lastvalue1'};
1000 $calculated =~ s/\{X\}/$x/g;
1001 my $newlastvalue2 = $val->{'lastvalue2'};
1003 if ( $pattern == 6 ) {
1004 if ( $val->{hemisphere} == 2 ) {
1005 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1006 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1008 my $newlastvalue2seq = $seasons[$newlastvalue2];
1009 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1012 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1014 my $z = $val->{'lastvalue3'};
1015 $calculated =~ s/\{Z\}/$z/g;
1019 =head2 GetExpirationDate
1021 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1023 this function return the next expiration date for a subscription given on input args.
1026 the enddate or undef
1030 sub GetExpirationDate {
1031 my ( $subscriptionid, $startdate ) = @_;
1032 my $dbh = C4::Context->dbh;
1033 my $subscription = GetSubscription($subscriptionid);
1036 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1037 $enddate = $startdate || $subscription->{startdate};
1038 my @date = split( /-/, $enddate );
1039 return if ( scalar(@date) != 3 || not check_date(@date) );
1040 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1043 if ( my $length = $subscription->{numberlength} ) {
1045 #calculate the date of the last issue.
1046 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1047 $enddate = GetNextDate( $enddate, $subscription );
1049 } elsif ( $subscription->{monthlength} ) {
1050 if ( $$subscription{startdate} ) {
1051 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1052 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1054 } elsif ( $subscription->{weeklength} ) {
1055 if ( $$subscription{startdate} ) {
1056 my @date = split( /-/, $subscription->{startdate} );
1057 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1058 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1067 =head2 CountSubscriptionFromBiblionumber
1069 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1070 this returns a count of the subscriptions for a given biblionumber
1072 the number of subscriptions
1076 sub CountSubscriptionFromBiblionumber {
1077 my ($biblionumber) = @_;
1078 my $dbh = C4::Context->dbh;
1079 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1080 my $sth = $dbh->prepare($query);
1081 $sth->execute($biblionumber);
1082 my $subscriptionsnumber = $sth->fetchrow;
1083 return $subscriptionsnumber;
1086 =head2 ModSubscriptionHistory
1088 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1090 this function modifies the history of a subscription. Put your new values on input arg.
1091 returns the number of rows affected
1095 sub ModSubscriptionHistory {
1096 my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_;
1097 my $dbh = C4::Context->dbh;
1098 my $query = "UPDATE subscriptionhistory
1099 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1100 WHERE subscriptionid=?
1102 my $sth = $dbh->prepare($query);
1103 $recievedlist =~ s/^; //;
1104 $missinglist =~ s/^; //;
1105 $opacnote =~ s/^; //;
1106 $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1110 =head2 ModSerialStatus
1112 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1114 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1115 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1119 sub ModSerialStatus {
1120 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1122 #It is a usual serial
1123 # 1st, get previous status :
1124 my $dbh = C4::Context->dbh;
1125 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1126 my $sth = $dbh->prepare($query);
1127 $sth->execute($serialid);
1128 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1130 # change status & update subscriptionhistory
1132 if ( $status == 6 ) {
1133 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1137 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1138 $sth = $dbh->prepare($query);
1139 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1140 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1141 $sth = $dbh->prepare($query);
1142 $sth->execute($subscriptionid);
1143 my $val = $sth->fetchrow_hashref;
1144 unless ( $val->{manualhistory} ) {
1145 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1146 $sth = $dbh->prepare($query);
1147 $sth->execute($subscriptionid);
1148 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1149 if ( $status == 2 ) {
1150 $recievedlist .= "; $serialseq"
1151 if $recievedlist!~/(^|;)\s*$serialseq(?=;|$)/;
1153 # in case serial has been previously marked as missing
1154 if (grep /$status/, (1,2,3,7)) {
1155 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1157 $missinglist .= "; $serialseq"
1158 if $status==4 && $missinglist!~/(^|;)\s*$serialseq(?=;|$)/;
1159 $missinglist .= "; not issued $serialseq"
1160 if $status==5 && $missinglist!~/(^|;)\s*$serialseq(?=;|$)/;
1162 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1163 $sth = $dbh->prepare($query);
1164 $recievedlist =~ s/^; //;
1165 $missinglist =~ s/^; //;
1166 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1170 # create new waited entry if needed (ie : was a "waited" and has changed)
1171 if ( $oldstatus == 1 && $status != 1 ) {
1172 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1173 $sth = $dbh->prepare($query);
1174 $sth->execute($subscriptionid);
1175 my $val = $sth->fetchrow_hashref;
1179 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1180 $newinnerloop1, $newinnerloop2, $newinnerloop3
1181 ) = GetNextSeq($val);
1183 # next date (calculated from actual date & frequency parameters)
1184 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1185 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate );
1186 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1187 WHERE subscriptionid = ?";
1188 $sth = $dbh->prepare($query);
1189 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1191 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1192 if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) {
1193 require C4::Letters;
1194 C4::Letters::SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1200 =head2 GetNextExpected
1202 $nextexpected = GetNextExpected($subscriptionid)
1204 Get the planneddate for the current expected issue of the subscription.
1210 planneddate => C4::Dates object
1215 sub GetNextExpected {
1216 my ($subscriptionid) = @_;
1217 my $dbh = C4::Context->dbh;
1218 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1220 # Each subscription has only one 'expected' issue, with serial.status==1.
1221 $sth->execute( $subscriptionid, 1 );
1222 my ( $nextissue ) = $sth->fetchrow_hashref;
1224 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1225 $sth->execute( $subscriptionid );
1226 $nextissue = $sth->fetchrow_hashref;
1228 if (!defined $nextissue->{planneddate}) {
1229 # or should this default to 1st Jan ???
1230 $nextissue->{planneddate} = strftime('%Y-%m-%d',localtime);
1232 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1237 =head2 ModNextExpected
1239 ModNextExpected($subscriptionid,$date)
1241 Update the planneddate for the current expected issue of the subscription.
1242 This will modify all future prediction results.
1244 C<$date> is a C4::Dates object.
1250 sub ModNextExpected {
1251 my ( $subscriptionid, $date ) = @_;
1252 my $dbh = C4::Context->dbh;
1254 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1255 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1257 # Each subscription has only one 'expected' issue, with serial.status==1.
1258 $sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 );
1263 =head2 ModSubscription
1265 this function modifies a subscription. Put all new values on input args.
1266 returns the number of rows affected
1270 sub ModSubscription {
1271 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1272 $dow, $irregularity, $numberpattern, $numberlength, $weeklength, $monthlength, $add1, $every1,
1273 $whenmorethan1, $setto1, $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2,
1274 $lastvalue2, $innerloop2, $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1275 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory,
1276 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid
1279 # warn $irregularity;
1280 my $dbh = C4::Context->dbh;
1281 my $query = "UPDATE subscription
1282 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1283 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1284 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1285 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1286 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1287 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?,
1288 letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
1289 staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1291 WHERE subscriptionid = ?";
1293 #warn "query :".$query;
1294 my $sth = $dbh->prepare($query);
1296 $auser, $branchcode, $aqbooksellerid, $cost,
1297 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1298 $dow, "$irregularity", $numberpattern, $numberlength,
1299 $weeklength, $monthlength, $add1, $every1,
1300 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1301 $add2, $every2, $whenmorethan2, $setto2,
1302 $lastvalue2, $innerloop2, $add3, $every3,
1303 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1304 $numberingmethod, $status, $biblionumber, $callnumber,
1305 $notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ),
1306 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1307 $graceperiod, $location, $enddate, $subscriptionid
1309 my $rows = $sth->rows;
1311 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1315 =head2 NewSubscription
1317 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1318 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1319 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1320 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1321 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1322 $numberingmethod, $status, $notes, $serialsadditems,
1323 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
1325 Create a new subscription with value given on input args.
1328 the id of this new subscription
1332 sub NewSubscription {
1333 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1334 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1335 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1336 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status,
1337 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1338 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1340 my $dbh = C4::Context->dbh;
1342 #save subscription (insert into database)
1344 INSERT INTO subscription
1345 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1346 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1347 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1348 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1349 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1350 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1351 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1352 staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
1353 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1355 my $sth = $dbh->prepare($query);
1357 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1358 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1359 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1360 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, "$status",
1361 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1362 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1365 my $subscriptionid = $dbh->{'mysql_insertid'};
1367 $enddate = GetExpirationDate($subscriptionid,$startdate);
1371 WHERE subscriptionid=?
1373 $sth = $dbh->prepare($query);
1374 $sth->execute( $enddate, $subscriptionid );
1376 #then create the 1st waited number
1378 INSERT INTO subscriptionhistory
1379 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1382 $sth = $dbh->prepare($query);
1383 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1385 # reread subscription to get a hash (for calculation of the 1st issue number)
1389 WHERE subscriptionid = ?
1391 $sth = $dbh->prepare($query);
1392 $sth->execute($subscriptionid);
1393 my $val = $sth->fetchrow_hashref;
1395 # calculate issue number
1396 my $serialseq = GetSeq($val);
1399 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1400 VALUES (?,?,?,?,?,?)
1402 $sth = $dbh->prepare($query);
1403 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1405 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1407 #set serial flag on biblio if not already set.
1408 my $bib = GetBiblio($biblionumber);
1409 if ( !$bib->{'serial'} ) {
1410 my $record = GetMarcBiblio($biblionumber);
1411 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1413 eval { $record->field($tag)->update( $subf => 1 ); };
1415 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1417 return $subscriptionid;
1420 =head2 ReNewSubscription
1422 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1424 this function renew a subscription with values given on input args.
1428 sub ReNewSubscription {
1429 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1430 my $dbh = C4::Context->dbh;
1431 my $subscription = GetSubscription($subscriptionid);
1435 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1436 WHERE biblio.biblionumber=?
1438 my $sth = $dbh->prepare($query);
1439 $sth->execute( $subscription->{biblionumber} );
1440 my $biblio = $sth->fetchrow_hashref;
1442 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1443 require C4::Suggestions;
1444 C4::Suggestions::NewSuggestion(
1445 { 'suggestedby' => $user,
1446 'title' => $subscription->{bibliotitle},
1447 'author' => $biblio->{author},
1448 'publishercode' => $biblio->{publishercode},
1449 'note' => $biblio->{note},
1450 'biblionumber' => $subscription->{biblionumber}
1455 # renew subscription
1458 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1459 WHERE subscriptionid=?
1461 $sth = $dbh->prepare($query);
1462 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1463 my $enddate = GetExpirationDate($subscriptionid);
1464 $debug && warn "enddate :$enddate";
1468 WHERE subscriptionid=?
1470 $sth = $dbh->prepare($query);
1471 $sth->execute( $enddate, $subscriptionid );
1473 UPDATE subscriptionhistory
1475 WHERE subscriptionid=?
1477 $sth = $dbh->prepare($query);
1478 $sth->execute( $enddate, $subscriptionid );
1480 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1486 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1488 Create a new issue stored on the database.
1489 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1490 returns the serial id
1495 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1496 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1498 my $dbh = C4::Context->dbh;
1501 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1502 VALUES (?,?,?,?,?,?,?)
1504 my $sth = $dbh->prepare($query);
1505 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1506 my $serialid = $dbh->{'mysql_insertid'};
1508 SELECT missinglist,recievedlist
1509 FROM subscriptionhistory
1510 WHERE subscriptionid=?
1512 $sth = $dbh->prepare($query);
1513 $sth->execute($subscriptionid);
1514 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1516 if ( $status == 2 ) {
1517 ### TODO Add a feature that improves recognition and description.
1518 ### As such count (serialseq) i.e. : N18,2(N19),N20
1519 ### Would use substr and index But be careful to previous presence of ()
1520 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1522 if ( $status == 4 ) {
1523 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1526 UPDATE subscriptionhistory
1527 SET recievedlist=?, missinglist=?
1528 WHERE subscriptionid=?
1530 $sth = $dbh->prepare($query);
1531 $recievedlist =~ s/^; //;
1532 $missinglist =~ s/^; //;
1533 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1537 =head2 ItemizeSerials
1539 ItemizeSerials($serialid, $info);
1540 $info is a hashref containing barcode branch, itemcallnumber, status, location
1541 $serialid the serialid
1543 1 if the itemize is a succes.
1544 0 and @error otherwise. @error containts the list of errors found.
1548 sub ItemizeSerials {
1549 my ( $serialid, $info ) = @_;
1550 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1552 my $dbh = C4::Context->dbh;
1558 my $sth = $dbh->prepare($query);
1559 $sth->execute($serialid);
1560 my $data = $sth->fetchrow_hashref;
1561 if ( C4::Context->preference("RoutingSerials") ) {
1563 # check for existing biblioitem relating to serial issue
1564 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1566 for ( my $i = 0 ; $i < $count ; $i++ ) {
1567 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1568 $bibitemno = $results[$i]->{'biblioitemnumber'};
1572 if ( $bibitemno == 0 ) {
1573 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1574 $sth->execute( $data->{'biblionumber'} );
1575 my $biblioitem = $sth->fetchrow_hashref;
1576 $biblioitem->{'volumedate'} = $data->{planneddate};
1577 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1578 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1582 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1583 if ( $info->{barcode} ) {
1585 if ( is_barcode_in_use( $info->{barcode} ) ) {
1586 push @errors, 'barcode_not_unique';
1588 my $marcrecord = MARC::Record->new();
1589 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1590 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1591 $marcrecord->insert_fields_ordered($newField);
1592 if ( $info->{branch} ) {
1593 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1595 #warn "items.homebranch : $tag , $subfield";
1596 if ( $marcrecord->field($tag) ) {
1597 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1599 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1600 $marcrecord->insert_fields_ordered($newField);
1602 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1604 #warn "items.holdingbranch : $tag , $subfield";
1605 if ( $marcrecord->field($tag) ) {
1606 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1608 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1609 $marcrecord->insert_fields_ordered($newField);
1612 if ( $info->{itemcallnumber} ) {
1613 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1615 if ( $marcrecord->field($tag) ) {
1616 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1618 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1619 $marcrecord->insert_fields_ordered($newField);
1622 if ( $info->{notes} ) {
1623 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1625 if ( $marcrecord->field($tag) ) {
1626 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1628 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1629 $marcrecord->insert_fields_ordered($newField);
1632 if ( $info->{location} ) {
1633 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1635 if ( $marcrecord->field($tag) ) {
1636 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1638 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1639 $marcrecord->insert_fields_ordered($newField);
1642 if ( $info->{status} ) {
1643 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1645 if ( $marcrecord->field($tag) ) {
1646 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1648 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1649 $marcrecord->insert_fields_ordered($newField);
1652 if ( C4::Context->preference("RoutingSerials") ) {
1653 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1654 if ( $marcrecord->field($tag) ) {
1655 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1657 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1658 $marcrecord->insert_fields_ordered($newField);
1662 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1665 return ( 0, @errors );
1669 =head2 HasSubscriptionStrictlyExpired
1671 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1673 the subscription has stricly expired when today > the end subscription date
1676 1 if true, 0 if false, -1 if the expiration date is not set.
1680 sub HasSubscriptionStrictlyExpired {
1682 # Getting end of subscription date
1683 my ($subscriptionid) = @_;
1684 my $dbh = C4::Context->dbh;
1685 my $subscription = GetSubscription($subscriptionid);
1686 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1688 # If the expiration date is set
1689 if ( $expirationdate != 0 ) {
1690 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1692 # Getting today's date
1693 my ( $nowyear, $nowmonth, $nowday ) = Today();
1695 # if today's date > expiration date, then the subscription has stricly expired
1696 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1703 # There are some cases where the expiration date is not set
1704 # As we can't determine if the subscription has expired on a date-basis,
1710 =head2 HasSubscriptionExpired
1712 $has_expired = HasSubscriptionExpired($subscriptionid)
1714 the subscription has expired when the next issue to arrive is out of subscription limit.
1717 0 if the subscription has not expired
1718 1 if the subscription has expired
1719 2 if has subscription does not have a valid expiration date set
1723 sub HasSubscriptionExpired {
1724 my ($subscriptionid) = @_;
1725 my $dbh = C4::Context->dbh;
1726 my $subscription = GetSubscription($subscriptionid);
1727 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1728 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1729 if (!defined $expirationdate) {
1730 $expirationdate = q{};
1733 SELECT max(planneddate)
1735 WHERE subscriptionid=?
1737 my $sth = $dbh->prepare($query);
1738 $sth->execute($subscriptionid);
1739 my ($res) = $sth->fetchrow;
1740 if (!$res || $res=~m/^0000/) {
1743 my @res = split( /-/, $res );
1744 my @endofsubscriptiondate = split( /-/, $expirationdate );
1745 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1747 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1751 if ( $subscription->{'numberlength'} ) {
1752 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1753 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1759 return 0; # Notice that you'll never get here.
1762 =head2 SetDistributedto
1764 SetDistributedto($distributedto,$subscriptionid);
1765 This function update the value of distributedto for a subscription given on input arg.
1769 sub SetDistributedto {
1770 my ( $distributedto, $subscriptionid ) = @_;
1771 my $dbh = C4::Context->dbh;
1775 WHERE subscriptionid=?
1777 my $sth = $dbh->prepare($query);
1778 $sth->execute( $distributedto, $subscriptionid );
1782 =head2 DelSubscription
1784 DelSubscription($subscriptionid)
1785 this function deletes subscription which has $subscriptionid as id.
1789 sub DelSubscription {
1790 my ($subscriptionid) = @_;
1791 my $dbh = C4::Context->dbh;
1792 $subscriptionid = $dbh->quote($subscriptionid);
1793 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1794 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1795 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1797 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1802 DelIssue($serialseq,$subscriptionid)
1803 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1805 returns the number of rows affected
1810 my ($dataissue) = @_;
1811 my $dbh = C4::Context->dbh;
1812 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1817 AND subscriptionid= ?
1819 my $mainsth = $dbh->prepare($query);
1820 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1822 #Delete element from subscription history
1823 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1824 my $sth = $dbh->prepare($query);
1825 $sth->execute( $dataissue->{'subscriptionid'} );
1826 my $val = $sth->fetchrow_hashref;
1827 unless ( $val->{manualhistory} ) {
1829 SELECT * FROM subscriptionhistory
1830 WHERE subscriptionid= ?
1832 my $sth = $dbh->prepare($query);
1833 $sth->execute( $dataissue->{'subscriptionid'} );
1834 my $data = $sth->fetchrow_hashref;
1835 my $serialseq = $dataissue->{'serialseq'};
1836 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1837 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1838 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1839 $sth = $dbh->prepare($strsth);
1840 $sth->execute( $dataissue->{'subscriptionid'} );
1843 return $mainsth->rows;
1846 =head2 GetLateOrMissingIssues
1848 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1850 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1853 the issuelist as an array of hash refs. Each element of this array contains
1854 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1858 sub GetLateOrMissingIssues {
1859 my ( $supplierid, $serialid, $order ) = @_;
1860 my $dbh = C4::Context->dbh;
1864 $byserial = "and serialid = " . $serialid;
1867 $order .= ", title";
1872 $sth = $dbh->prepare(
1874 serialid, aqbooksellerid, name,
1875 biblio.title, planneddate, serialseq,
1876 serial.status, serial.subscriptionid, claimdate,
1877 subscription.branchcode
1879 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1880 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1881 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1882 WHERE subscription.subscriptionid = serial.subscriptionid
1883 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1884 AND subscription.aqbooksellerid=$supplierid
1889 $sth = $dbh->prepare(
1891 serialid, aqbooksellerid, name,
1892 biblio.title, planneddate, serialseq,
1893 serial.status, serial.subscriptionid, claimdate,
1894 subscription.branchcode
1896 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1897 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1898 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1899 WHERE subscription.subscriptionid = serial.subscriptionid
1900 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1907 while ( my $line = $sth->fetchrow_hashref ) {
1909 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1910 $line->{planneddate} = format_date( $line->{planneddate} );
1912 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1913 $line->{claimdate} = format_date( $line->{claimdate} );
1915 $line->{"status".$line->{status}} = 1;
1916 push @issuelist, $line;
1921 =head2 removeMissingIssue
1923 removeMissingIssue($subscriptionid)
1925 this function removes an issue from being part of the missing string in
1926 subscriptionlist.missinglist column
1928 called when a missing issue is found from the serials-recieve.pl file
1932 sub removeMissingIssue {
1933 my ( $sequence, $subscriptionid ) = @_;
1934 my $dbh = C4::Context->dbh;
1935 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1936 $sth->execute($subscriptionid);
1937 my $data = $sth->fetchrow_hashref;
1938 my $missinglist = $data->{'missinglist'};
1939 my $missinglistbefore = $missinglist;
1941 # warn $missinglist." before";
1942 $missinglist =~ s/($sequence)//;
1944 # warn $missinglist." after";
1945 if ( $missinglist ne $missinglistbefore ) {
1946 $missinglist =~ s/\|\s\|/\|/g;
1947 $missinglist =~ s/^\| //g;
1948 $missinglist =~ s/\|$//g;
1949 my $sth2 = $dbh->prepare(
1950 "UPDATE subscriptionhistory
1952 WHERE subscriptionid = ?"
1954 $sth2->execute( $missinglist, $subscriptionid );
1961 &updateClaim($serialid)
1963 this function updates the time when a claim is issued for late/missing items
1965 called from claims.pl file
1970 my ($serialid) = @_;
1971 my $dbh = C4::Context->dbh;
1972 my $sth = $dbh->prepare(
1973 "UPDATE serial SET claimdate = now()
1977 $sth->execute($serialid);
1981 =head2 getsupplierbyserialid
1983 $result = getsupplierbyserialid($serialid)
1985 this function is used to find the supplier id given a serial id
1988 hashref containing serialid, subscriptionid, and aqbooksellerid
1992 sub getsupplierbyserialid {
1993 my ($serialid) = @_;
1994 my $dbh = C4::Context->dbh;
1995 my $sth = $dbh->prepare(
1996 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1998 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2002 $sth->execute($serialid);
2003 my $line = $sth->fetchrow_hashref;
2004 my $result = $line->{'aqbooksellerid'};
2008 =head2 check_routing
2010 $result = &check_routing($subscriptionid)
2012 this function checks to see if a serial has a routing list and returns the count of routingid
2013 used to show either an 'add' or 'edit' link
2018 my ($subscriptionid) = @_;
2019 my $dbh = C4::Context->dbh;
2020 my $sth = $dbh->prepare(
2021 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2022 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2023 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2026 $sth->execute($subscriptionid);
2027 my $line = $sth->fetchrow_hashref;
2028 my $result = $line->{'routingids'};
2032 =head2 addroutingmember
2034 addroutingmember($borrowernumber,$subscriptionid)
2036 this function takes a borrowernumber and subscriptionid and adds the member to the
2037 routing list for that serial subscription and gives them a rank on the list
2038 of either 1 or highest current rank + 1
2042 sub addroutingmember {
2043 my ( $borrowernumber, $subscriptionid ) = @_;
2045 my $dbh = C4::Context->dbh;
2046 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2047 $sth->execute($subscriptionid);
2048 while ( my $line = $sth->fetchrow_hashref ) {
2049 if ( $line->{'rank'} > 0 ) {
2050 $rank = $line->{'rank'} + 1;
2055 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2056 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2059 =head2 reorder_members
2061 reorder_members($subscriptionid,$routingid,$rank)
2063 this function is used to reorder the routing list
2065 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2066 - it gets all members on list puts their routingid's into an array
2067 - removes the one in the array that is $routingid
2068 - then reinjects $routingid at point indicated by $rank
2069 - then update the database with the routingids in the new order
2073 sub reorder_members {
2074 my ( $subscriptionid, $routingid, $rank ) = @_;
2075 my $dbh = C4::Context->dbh;
2076 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2077 $sth->execute($subscriptionid);
2079 while ( my $line = $sth->fetchrow_hashref ) {
2080 push( @result, $line->{'routingid'} );
2083 # To find the matching index
2085 my $key = -1; # to allow for 0 being a valid response
2086 for ( $i = 0 ; $i < @result ; $i++ ) {
2087 if ( $routingid == $result[$i] ) {
2088 $key = $i; # save the index
2093 # if index exists in array then move it to new position
2094 if ( $key > -1 && $rank > 0 ) {
2095 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2096 my $moving_item = splice( @result, $key, 1 );
2097 splice( @result, $new_rank, 0, $moving_item );
2099 for ( my $j = 0 ; $j < @result ; $j++ ) {
2100 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2106 =head2 delroutingmember
2108 delroutingmember($routingid,$subscriptionid)
2110 this function either deletes one member from routing list if $routingid exists otherwise
2111 deletes all members from the routing list
2115 sub delroutingmember {
2117 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2118 my ( $routingid, $subscriptionid ) = @_;
2119 my $dbh = C4::Context->dbh;
2121 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2122 $sth->execute($routingid);
2123 reorder_members( $subscriptionid, $routingid );
2125 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2126 $sth->execute($subscriptionid);
2131 =head2 getroutinglist
2133 @routinglist = getroutinglist($subscriptionid)
2135 this gets the info from the subscriptionroutinglist for $subscriptionid
2138 the routinglist as an array. Each element of the array contains a hash_ref containing
2139 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2143 sub getroutinglist {
2144 my ($subscriptionid) = @_;
2145 my $dbh = C4::Context->dbh;
2146 my $sth = $dbh->prepare(
2147 'SELECT routingid, borrowernumber, ranking, biblionumber
2149 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2150 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2152 $sth->execute($subscriptionid);
2153 my $routinglist = $sth->fetchall_arrayref({});
2154 return @{$routinglist};
2157 =head2 countissuesfrom
2159 $result = countissuesfrom($subscriptionid,$startdate)
2161 Returns a count of serial rows matching the given subsctiptionid
2162 with published date greater than startdate
2166 sub countissuesfrom {
2167 my ( $subscriptionid, $startdate ) = @_;
2168 my $dbh = C4::Context->dbh;
2172 WHERE subscriptionid=?
2173 AND serial.publisheddate>?
2175 my $sth = $dbh->prepare($query);
2176 $sth->execute( $subscriptionid, $startdate );
2177 my ($countreceived) = $sth->fetchrow;
2178 return $countreceived;
2183 $result = CountIssues($subscriptionid)
2185 Returns a count of serial rows matching the given subsctiptionid
2190 my ($subscriptionid) = @_;
2191 my $dbh = C4::Context->dbh;
2195 WHERE subscriptionid=?
2197 my $sth = $dbh->prepare($query);
2198 $sth->execute($subscriptionid);
2199 my ($countreceived) = $sth->fetchrow;
2200 return $countreceived;
2205 $result = HasItems($subscriptionid)
2207 returns a count of items from serial matching the subscriptionid
2212 my ($subscriptionid) = @_;
2213 my $dbh = C4::Context->dbh;
2215 SELECT COUNT(serialitems.itemnumber)
2217 LEFT JOIN serialitems USING(serialid)
2218 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2220 my $sth=$dbh->prepare($query);
2221 $sth->execute($subscriptionid);
2222 my ($countitems)=$sth->fetchrow_array();
2226 =head2 abouttoexpire
2228 $result = abouttoexpire($subscriptionid)
2230 this function alerts you to the penultimate issue for a serial subscription
2232 returns 1 - if this is the penultimate issue
2238 my ($subscriptionid) = @_;
2239 my $dbh = C4::Context->dbh;
2240 my $subscription = GetSubscription($subscriptionid);
2241 my $per = $subscription->{'periodicity'};
2242 if ($per && $per % 16 > 0){
2243 my $expirationdate = GetExpirationDate($subscriptionid);
2244 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2247 @res=split (/-/,$res);
2248 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2249 } else { # default an undefined value
2250 @res=Date::Calc::Today;
2252 my @endofsubscriptiondate=split(/-/,$expirationdate);
2253 my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 124, 0, 0);
2255 @datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2256 - (3 * $per_list[$per])) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2257 return 1 if ( @res &&
2259 Delta_Days($res[0],$res[1],$res[2],
2260 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2261 (@endofsubscriptiondate &&
2262 Delta_Days($res[0],$res[1],$res[2],
2263 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2265 } elsif ($subscription->{numberlength}>0) {
2266 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2271 sub in_array { # used in next sub down
2272 my ( $val, @elements ) = @_;
2273 foreach my $elem (@elements) {
2274 if ( $val == $elem ) {
2281 =head2 GetSubscriptionsFromBorrower
2283 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2285 this gets the info from subscriptionroutinglist for each $subscriptionid
2288 a count of the serial subscription routing lists to which a patron belongs,
2289 with the titles of those serial subscriptions as an array. Each element of the array
2290 contains a hash_ref with subscriptionID and title of subscription.
2294 sub GetSubscriptionsFromBorrower {
2295 my ($borrowernumber) = @_;
2296 my $dbh = C4::Context->dbh;
2297 my $sth = $dbh->prepare(
2298 "SELECT subscription.subscriptionid, biblio.title
2300 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2301 JOIN subscriptionroutinglist USING (subscriptionid)
2302 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2305 $sth->execute($borrowernumber);
2308 while ( my $line = $sth->fetchrow_hashref ) {
2310 push( @routinglist, $line );
2312 return ( $count, @routinglist );
2317 $resultdate = GetNextDate($planneddate,$subscription)
2319 this function it takes the planneddate and will return the next issue's date and will skip dates if there
2320 exists an irregularity
2321 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2322 skipped then the returned date will be 2007-05-10
2325 $resultdate - then next date in the sequence
2327 Return 0 if periodicity==0
2332 my ( $planneddate, $subscription ) = @_;
2333 my @irreg = split( /\,/, $subscription->{irregularity} );
2335 #date supposed to be in ISO.
2337 my ( $year, $month, $day ) = split( /-/, $planneddate );
2338 $month = 1 unless ($month);
2339 $day = 1 unless ($day);
2342 # warn "DOW $dayofweek";
2343 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2348 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2349 # renaming this pattern from 1/day to " n / week ".
2350 if ( $subscription->{periodicity} == 1 ) {
2351 my $dayofweek = eval { Day_of_Week( $year, $month, $day ) };
2352 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2354 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2355 $dayofweek = 0 if ( $dayofweek == 7 );
2356 if ( in_array( ( $dayofweek + 1 ), @irreg ) ) {
2357 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 );
2361 @resultdate = Add_Delta_Days( $year, $month, $day, 1 );
2366 if ( $subscription->{periodicity} == 2 ) {
2367 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2368 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2370 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2372 #FIXME: if two consecutive irreg, do we only skip one?
2373 if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) {
2374 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 );
2375 $wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 );
2378 @resultdate = Add_Delta_Days( $year, $month, $day, 7 );
2383 if ( $subscription->{periodicity} == 3 ) {
2384 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2385 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2387 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2388 if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) {
2389 ### BUGFIX was previously +1 ^
2390 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 );
2391 $wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 );
2394 @resultdate = Add_Delta_Days( $year, $month, $day, 14 );
2399 if ( $subscription->{periodicity} == 4 ) {
2400 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2401 if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; }
2403 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2404 if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) {
2405 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 );
2406 $wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 );
2409 @resultdate = Add_Delta_Days( $year, $month, $day, 21 );
2412 my $tmpmonth = $month;
2413 if ( $year && $month && $day ) {
2414 if ( $subscription->{periodicity} == 5 ) {
2415 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2416 if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) {
2417 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2418 $tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 );
2421 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2423 if ( $subscription->{periodicity} == 6 ) {
2424 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2425 if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) {
2426 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2427 $tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 );
2430 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2432 if ( $subscription->{periodicity} == 7 ) {
2433 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2434 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2435 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2436 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2439 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2441 if ( $subscription->{periodicity} == 8 ) {
2442 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2443 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2444 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2445 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2448 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2450 if ( $subscription->{periodicity} == 13 ) {
2451 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2452 if ( $irreg[$i] == ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 ) ) {
2453 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2454 $tmpmonth = ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 );
2457 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2459 if ( $subscription->{periodicity} == 9 ) {
2460 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2461 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2462 ### BUFIX Seems to need more Than One ?
2463 ( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 );
2464 $tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 );
2467 @resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 );
2469 if ( $subscription->{periodicity} == 10 ) {
2470 @resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 );
2472 if ( $subscription->{periodicity} == 11 ) {
2473 @resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 );
2476 my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] );
2478 return "$resultdate";
2481 =head2 is_barcode_in_use
2483 Returns number of occurence of the barcode in the items table
2484 Can be used as a boolean test of whether the barcode has
2485 been deployed as yet
2489 sub is_barcode_in_use {
2490 my $barcode = shift;
2491 my $dbh = C4::Context->dbh;
2492 my $occurences = $dbh->selectall_arrayref(
2493 'SELECT itemnumber from items where barcode = ?',
2498 return @{$occurences};
2501 =head2 CloseSubscription
2502 Close a subscription given a subscriptionid
2504 sub CloseSubscription {
2505 my ( $subscriptionid ) = @_;
2506 return unless $subscriptionid;
2507 my $dbh = C4::Context->dbh;
2508 my $sth = $dbh->prepare( qq{
2511 WHERE subscriptionid = ?
2513 $sth->execute( $subscriptionid );
2515 # Set status = missing when status = stopped
2516 $sth = $dbh->prepare( qq{
2519 WHERE subscriptionid = ?
2522 $sth->execute( $subscriptionid );
2525 =head2 ReopenSubscription
2526 Reopen a subscription given a subscriptionid
2528 sub ReopenSubscription {
2529 my ( $subscriptionid ) = @_;
2530 return unless $subscriptionid;
2531 my $dbh = C4::Context->dbh;
2532 my $sth = $dbh->prepare( qq{
2535 WHERE subscriptionid = ?
2537 $sth->execute( $subscriptionid );
2539 # Set status = expected when status = stopped
2540 $sth = $dbh->prepare( qq{
2543 WHERE subscriptionid = ?
2546 $sth->execute( $subscriptionid );
2549 =head2 subscriptionCurrentlyOnOrder
2551 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2553 Return 1 if subscription is currently on order else 0.
2557 sub subscriptionCurrentlyOnOrder {
2558 my ( $subscriptionid ) = @_;
2559 my $dbh = C4::Context->dbh;
2561 SELECT COUNT(*) FROM aqorders
2562 WHERE subscriptionid = ?
2563 AND datereceived IS NULL
2564 AND datecancellationprinted IS NULL
2566 my $sth = $dbh->prepare( $query );
2567 $sth->execute($subscriptionid);
2568 return $sth->fetchrow_array;
2576 Koha Development Team <http://koha-community.org/>