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::Auth qw(haspermission);
25 use C4::Dates qw(format_date format_date_in_iso);
26 use Date::Calc qw(:all);
27 use POSIX qw(strftime setlocale LC_TIME);
29 use C4::Log; # logaction
31 use C4::Serials::Frequency;
32 use C4::Serials::Numberpattern;
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
37 $VERSION = 3.07.00.049; # set version for version checking
41 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
42 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
44 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
45 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
46 &GetSubscriptionHistoryFromSubscriptionId
48 &GetNextSeq &GetSeq &NewIssue &ItemizeSerials &GetSerials
49 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
50 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
51 &GetSerialInformation &AddItem2Serial
52 &PrepareSerialsData &GetNextExpected &ModNextExpected
54 &UpdateClaimdateIssues
55 &GetSuppliersWithLateIssues &getsupplierbyserialid
56 &GetDistributedTo &SetDistributedTo
57 &getroutinglist &delroutingmember &addroutingmember
59 &check_routing &updateClaim &removeMissingIssue
62 &GetSubscriptionsFromBorrower
63 &subscriptionCurrentlyOnOrder
70 C4::Serials - Serials Module Functions
78 Functions for handling subscriptions, claims routing etc.
83 =head2 GetSuppliersWithLateIssues
85 $supplierlist = GetSuppliersWithLateIssues()
87 this function get all suppliers with late issues.
90 an array_ref of suppliers each entry is a hash_ref containing id and name
91 the array is in name order
95 sub GetSuppliersWithLateIssues {
96 my $dbh = C4::Context->dbh;
98 SELECT DISTINCT id, name
100 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
101 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
104 (planneddate < now() AND serial.status=1)
105 OR serial.STATUS = 3 OR serial.STATUS = 4
107 AND subscription.closed = 0
109 return $dbh->selectall_arrayref($query, { Slice => {} });
114 @issuelist = GetLateIssues($supplierid)
116 this function selects late issues from the database
119 the issuelist as an array. Each element of this array contains a hashi_ref containing
120 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
125 my ($supplierid) = @_;
127 return unless ($supplierid);
129 my $dbh = C4::Context->dbh;
133 SELECT name,title,planneddate,serialseq,serial.subscriptionid
135 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
136 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
137 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
138 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
139 AND subscription.aqbooksellerid=?
140 AND subscription.closed = 0
143 $sth = $dbh->prepare($query);
144 $sth->execute($supplierid);
147 SELECT name,title,planneddate,serialseq,serial.subscriptionid
149 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
150 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
151 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
152 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
153 AND subscription.closed = 0
156 $sth = $dbh->prepare($query);
161 while ( my $line = $sth->fetchrow_hashref ) {
162 $line->{title} = "" if $last_title and $line->{title} eq $last_title;
163 $last_title = $line->{title} if ( $line->{title} );
164 $line->{planneddate} = format_date( $line->{planneddate} );
165 push @issuelist, $line;
170 =head2 GetSubscriptionHistoryFromSubscriptionId
172 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
174 This function returns the subscription history as a hashref
178 sub GetSubscriptionHistoryFromSubscriptionId {
179 my ($subscriptionid) = @_;
181 return unless $subscriptionid;
183 my $dbh = C4::Context->dbh;
186 FROM subscriptionhistory
187 WHERE subscriptionid = ?
189 my $sth = $dbh->prepare($query);
190 $sth->execute($subscriptionid);
191 my $results = $sth->fetchrow_hashref;
197 =head2 GetSerialStatusFromSerialId
199 $sth = GetSerialStatusFromSerialId();
200 this function returns a statement handle
201 After this function, don't forget to execute it by using $sth->execute($serialid)
203 $sth = $dbh->prepare($query).
207 sub GetSerialStatusFromSerialId {
208 my $dbh = C4::Context->dbh;
214 return $dbh->prepare($query);
217 =head2 GetSerialInformation
220 $data = GetSerialInformation($serialid);
221 returns a hash_ref containing :
222 items : items marcrecord (can be an array)
224 subscription table field
225 + information about subscription expiration
229 sub GetSerialInformation {
231 my $dbh = C4::Context->dbh;
233 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
234 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
237 my $rq = $dbh->prepare($query);
238 $rq->execute($serialid);
239 my $data = $rq->fetchrow_hashref;
241 # create item information if we have serialsadditems for this subscription
242 if ( $data->{'serialsadditems'} ) {
243 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
244 $queryitem->execute($serialid);
245 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
247 if ( scalar(@$itemnumbers) > 0 ) {
248 foreach my $itemnum (@$itemnumbers) {
250 #It is ASSUMED that GetMarcItem ALWAYS WORK...
251 #Maybe GetMarcItem should return values on failure
252 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
253 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
254 $itemprocessed->{'itemnumber'} = $itemnum->[0];
255 $itemprocessed->{'itemid'} = $itemnum->[0];
256 $itemprocessed->{'serialid'} = $serialid;
257 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
258 push @{ $data->{'items'} }, $itemprocessed;
261 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
262 $itemprocessed->{'itemid'} = "N$serialid";
263 $itemprocessed->{'serialid'} = $serialid;
264 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
265 $itemprocessed->{'countitems'} = 0;
266 push @{ $data->{'items'} }, $itemprocessed;
269 $data->{ "status" . $data->{'serstatus'} } = 1;
270 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
271 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
272 $data->{cannotedit} = not can_edit_subscription( $data );
276 =head2 AddItem2Serial
278 $rows = AddItem2Serial($serialid,$itemnumber);
279 Adds an itemnumber to Serial record
280 returns the number of rows affected
285 my ( $serialid, $itemnumber ) = @_;
287 return unless ($serialid and $itemnumber);
289 my $dbh = C4::Context->dbh;
290 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
291 $rq->execute( $serialid, $itemnumber );
295 =head2 UpdateClaimdateIssues
297 UpdateClaimdateIssues($serialids,[$date]);
299 Update Claimdate for issues in @$serialids list with date $date
304 sub UpdateClaimdateIssues {
305 my ( $serialids, $date ) = @_;
307 return unless ($serialids);
309 my $dbh = C4::Context->dbh;
310 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
312 UPDATE serial SET claimdate = ?, status = 7
313 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
314 my $rq = $dbh->prepare($query);
315 $rq->execute($date, @$serialids);
319 =head2 GetSubscription
321 $subs = GetSubscription($subscriptionid)
322 this function returns the subscription which has $subscriptionid as id.
324 a hashref. This hash containts
325 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
329 sub GetSubscription {
330 my ($subscriptionid) = @_;
331 my $dbh = C4::Context->dbh;
333 SELECT subscription.*,
334 subscriptionhistory.*,
335 aqbooksellers.name AS aqbooksellername,
336 biblio.title AS bibliotitle,
337 subscription.biblionumber as bibnum
339 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
340 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
341 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
342 WHERE subscription.subscriptionid = ?
345 $debug and warn "query : $query\nsubsid :$subscriptionid";
346 my $sth = $dbh->prepare($query);
347 $sth->execute($subscriptionid);
348 my $subscription = $sth->fetchrow_hashref;
349 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
350 return $subscription;
353 =head2 GetFullSubscription
355 $array_ref = GetFullSubscription($subscriptionid)
356 this function reads the serial table.
360 sub GetFullSubscription {
361 my ($subscriptionid) = @_;
363 return unless ($subscriptionid);
365 my $dbh = C4::Context->dbh;
367 SELECT serial.serialid,
370 serial.publisheddate,
372 serial.notes as notes,
373 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
374 aqbooksellers.name as aqbooksellername,
375 biblio.title as bibliotitle,
376 subscription.branchcode AS branchcode,
377 subscription.subscriptionid AS subscriptionid
379 LEFT JOIN subscription ON
380 (serial.subscriptionid=subscription.subscriptionid )
381 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
382 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
383 WHERE serial.subscriptionid = ?
385 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
386 serial.subscriptionid
388 $debug and warn "GetFullSubscription query: $query";
389 my $sth = $dbh->prepare($query);
390 $sth->execute($subscriptionid);
391 my $subscriptions = $sth->fetchall_arrayref( {} );
392 for my $subscription ( @$subscriptions ) {
393 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
395 return $subscriptions;
398 =head2 PrepareSerialsData
400 $array_ref = PrepareSerialsData($serialinfomation)
401 where serialinformation is a hashref array
405 sub PrepareSerialsData {
408 return unless ($lines);
414 my $aqbooksellername;
418 my $previousnote = "";
420 foreach my $subs (@{$lines}) {
421 for my $datefield ( qw(publisheddate planneddate) ) {
422 # handle both undef and undef returned as 0000-00-00
423 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
424 $subs->{$datefield} = 'XXX';
427 $subs->{ "status" . $subs->{'status'} } = 1;
428 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
430 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
431 $year = $subs->{'year'};
435 if ( $tmpresults{$year} ) {
436 push @{ $tmpresults{$year}->{'serials'} }, $subs;
438 $tmpresults{$year} = {
440 'aqbooksellername' => $subs->{'aqbooksellername'},
441 'bibliotitle' => $subs->{'bibliotitle'},
442 'serials' => [$subs],
447 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
448 push @res, $tmpresults{$key};
453 =head2 GetSubscriptionsFromBiblionumber
455 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
456 this function get the subscription list. it reads the subscription table.
458 reference to an array of subscriptions which have the biblionumber given on input arg.
459 each element of this array is a hashref containing
460 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
464 sub GetSubscriptionsFromBiblionumber {
465 my ($biblionumber) = @_;
467 return unless ($biblionumber);
469 my $dbh = C4::Context->dbh;
471 SELECT subscription.*,
473 subscriptionhistory.*,
474 aqbooksellers.name AS aqbooksellername,
475 biblio.title AS bibliotitle
477 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
478 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
479 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
480 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
481 WHERE subscription.biblionumber = ?
483 my $sth = $dbh->prepare($query);
484 $sth->execute($biblionumber);
486 while ( my $subs = $sth->fetchrow_hashref ) {
487 $subs->{startdate} = format_date( $subs->{startdate} );
488 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
489 $subs->{histenddate} = format_date( $subs->{histenddate} );
490 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
491 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
492 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
493 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
494 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
495 $subs->{ "status" . $subs->{'status'} } = 1;
497 if ( $subs->{enddate} eq '0000-00-00' ) {
498 $subs->{enddate} = '';
500 $subs->{enddate} = format_date( $subs->{enddate} );
502 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
503 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
504 $subs->{cannotedit} = not can_edit_subscription( $subs );
510 =head2 GetFullSubscriptionsFromBiblionumber
512 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
513 this function reads the serial table.
517 sub GetFullSubscriptionsFromBiblionumber {
518 my ($biblionumber) = @_;
519 my $dbh = C4::Context->dbh;
521 SELECT serial.serialid,
524 serial.publisheddate,
526 serial.notes as notes,
527 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
528 biblio.title as bibliotitle,
529 subscription.branchcode AS branchcode,
530 subscription.subscriptionid AS subscriptionid
532 LEFT JOIN subscription ON
533 (serial.subscriptionid=subscription.subscriptionid)
534 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
535 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
536 WHERE subscription.biblionumber = ?
538 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
539 serial.subscriptionid
541 my $sth = $dbh->prepare($query);
542 $sth->execute($biblionumber);
543 my $subscriptions = $sth->fetchall_arrayref( {} );
544 for my $subscription ( @$subscriptions ) {
545 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
547 return $subscriptions;
550 =head2 GetSubscriptions
552 @results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
553 this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
555 a table of hashref. Each hash containt the subscription.
559 sub GetSubscriptions {
560 my ( $string, $issn, $ean, $biblionumber ) = @_;
562 #return unless $title or $ISSN or $biblionumber;
563 my $dbh = C4::Context->dbh;
566 SELECT subscriptionhistory.*, subscription.*, biblio.title,biblioitems.issn,biblio.biblionumber
568 LEFT JOIN subscriptionhistory USING(subscriptionid)
569 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
570 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
575 $sqlwhere = " WHERE biblio.biblionumber=?";
576 push @bind_params, $biblionumber;
580 my @strings_to_search;
581 @strings_to_search = map { "%$_%" } split( / /, $string );
582 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
583 push @bind_params, @strings_to_search;
584 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
585 $debug && warn "$tmpstring";
586 $tmpstring =~ s/^AND //;
587 push @sqlstrings, $tmpstring;
589 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
593 my @strings_to_search;
594 @strings_to_search = map { "%$_%" } split( / /, $issn );
595 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
596 push @bind_params, @strings_to_search;
597 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
598 $debug && warn "$tmpstring";
599 $tmpstring =~ s/^OR //;
600 push @sqlstrings, $tmpstring;
602 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
606 my @strings_to_search;
607 @strings_to_search = map { "$_" } split( / /, $ean );
608 foreach my $index ( qw(biblioitems.ean) ) {
609 push @bind_params, @strings_to_search;
610 my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
611 $debug && warn "$tmpstring";
612 $tmpstring =~ s/^OR //;
613 push @sqlstrings, $tmpstring;
615 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
618 $sql .= "$sqlwhere ORDER BY title";
619 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
620 $sth = $dbh->prepare($sql);
621 $sth->execute(@bind_params);
622 my $subscriptions = $sth->fetchall_arrayref( {} );
623 for my $subscription ( @$subscriptions ) {
624 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
626 return @$subscriptions;
629 =head2 SearchSubscriptions
631 @results = SearchSubscriptions($args);
632 $args is a hashref. Its keys can be contained: title, issn, ean, publisher, bookseller and branchcode
634 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.
637 a table of hashref. Each hash containt the subscription.
641 sub SearchSubscriptions {
646 subscription.notes AS publicnotes,
648 subscriptionhistory.*,
649 biblio.notes AS biblionotes,
654 LEFT JOIN subscriptionhistory USING(subscriptionid)
655 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
656 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
657 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
661 if( $args->{biblionumber} ) {
662 push @where_strs, "biblio.biblionumber = ?";
663 push @where_args, $args->{biblionumber};
665 if( $args->{title} ){
666 my @words = split / /, $args->{title};
668 foreach my $word (@words) {
669 push @strs, "biblio.title LIKE ?";
670 push @args, "%$word%";
673 push @where_strs, '(' . join (' AND ', @strs) . ')';
674 push @where_args, @args;
678 push @where_strs, "biblioitems.issn LIKE ?";
679 push @where_args, "%$args->{issn}%";
682 push @where_strs, "biblioitems.ean LIKE ?";
683 push @where_args, "%$args->{ean}%";
685 if( $args->{publisher} ){
686 push @where_strs, "biblioitems.publishercode LIKE ?";
687 push @where_args, "%$args->{publisher}%";
689 if( $args->{bookseller} ){
690 push @where_strs, "aqbooksellers.name LIKE ?";
691 push @where_args, "%$args->{bookseller}%";
693 if( $args->{branch} ){
694 push @where_strs, "subscription.branchcode = ?";
695 push @where_args, "$args->{branch}";
697 if( defined $args->{closed} ){
698 push @where_strs, "subscription.closed = ?";
699 push @where_args, "$args->{closed}";
702 $query .= " WHERE " . join(" AND ", @where_strs);
705 my $dbh = C4::Context->dbh;
706 my $sth = $dbh->prepare($query);
707 $sth->execute(@where_args);
708 my $results = $sth->fetchall_arrayref( {} );
711 for my $subscription ( @$results ) {
712 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
713 $subscription->{cannotdisplay} =
714 ( C4::Context->preference("IndependentBranches") &&
715 C4::Context->userenv &&
716 $subscription->{branchcode} ne C4::Context->userenv->{'branch'} ) ? 1 : 0;
725 ($totalissues,@serials) = GetSerials($subscriptionid);
726 this function gets every serial not arrived for a given subscription
727 as well as the number of issues registered in the database (all types)
728 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
730 FIXME: We should return \@serials.
735 my ( $subscriptionid, $count ) = @_;
737 return unless $subscriptionid;
739 my $dbh = C4::Context->dbh;
741 # status = 2 is "arrived"
743 $count = 5 unless ($count);
745 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
747 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
748 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
749 my $sth = $dbh->prepare($query);
750 $sth->execute($subscriptionid);
752 while ( my $line = $sth->fetchrow_hashref ) {
753 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
754 for my $datefield ( qw( planneddate publisheddate) ) {
755 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
756 $line->{$datefield} = format_date( $line->{$datefield});
758 $line->{$datefield} = q{};
761 push @serials, $line;
764 # OK, now add the last 5 issues arrives/missing
765 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
767 WHERE subscriptionid = ?
768 AND (status in (2,4,5))
769 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
771 $sth = $dbh->prepare($query);
772 $sth->execute($subscriptionid);
773 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
775 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
776 for my $datefield ( qw( planneddate publisheddate) ) {
777 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
778 $line->{$datefield} = format_date( $line->{$datefield});
780 $line->{$datefield} = q{};
784 push @serials, $line;
787 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
788 $sth = $dbh->prepare($query);
789 $sth->execute($subscriptionid);
790 my ($totalissues) = $sth->fetchrow;
791 return ( $totalissues, @serials );
796 @serials = GetSerials2($subscriptionid,$status);
797 this function returns every serial waited for a given subscription
798 as well as the number of issues registered in the database (all types)
799 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
804 my ( $subscription, $status ) = @_;
806 return unless ($subscription and $status);
808 my $dbh = C4::Context->dbh;
810 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
812 WHERE subscriptionid=$subscription AND status IN ($status)
813 ORDER BY publisheddate,serialid DESC
815 $debug and warn "GetSerials2 query: $query";
816 my $sth = $dbh->prepare($query);
820 while ( my $line = $sth->fetchrow_hashref ) {
821 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
822 # Format dates for display
823 for my $datefield ( qw( planneddate publisheddate ) ) {
824 if ($line->{$datefield} =~m/^00/) {
825 $line->{$datefield} = q{};
828 $line->{$datefield} = format_date( $line->{$datefield} );
831 push @serials, $line;
836 =head2 GetLatestSerials
838 \@serials = GetLatestSerials($subscriptionid,$limit)
839 get the $limit's latest serials arrived or missing for a given subscription
841 a ref to an array which contains all of the latest serials stored into a hash.
845 sub GetLatestSerials {
846 my ( $subscriptionid, $limit ) = @_;
848 return unless ($subscriptionid and $limit);
850 my $dbh = C4::Context->dbh;
852 # status = 2 is "arrived"
853 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
855 WHERE subscriptionid = ?
856 AND (status =2 or status=4)
857 ORDER BY publisheddate DESC LIMIT 0,$limit
859 my $sth = $dbh->prepare($strsth);
860 $sth->execute($subscriptionid);
862 while ( my $line = $sth->fetchrow_hashref ) {
863 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
864 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
865 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
866 push @serials, $line;
872 =head2 GetDistributedTo
874 $distributedto=GetDistributedTo($subscriptionid)
875 This function returns the field distributedto for the subscription matching subscriptionid
879 sub GetDistributedTo {
880 my $dbh = C4::Context->dbh;
882 my ($subscriptionid) = @_;
884 return unless ($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 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
896 $newinnerloop1, $newinnerloop2, $newinnerloop3
897 ) = GetNextSeq( $subscription, $pattern, $planneddate );
899 $subscription is a hashref containing all the attributes of the table
901 $pattern is a hashref containing all the attributes of the table
902 'subscription_numberpatterns'.
903 $planneddate is a C4::Dates object.
904 This function get the next issue for the subscription given on input arg
909 my ($subscription, $pattern, $planneddate) = @_;
911 return unless ($subscription and $pattern);
913 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
914 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
917 if ($subscription->{'skip_serialseq'}) {
918 my @irreg = split /;/, $subscription->{'irregularity'};
920 my $irregularities = {};
921 $irregularities->{$_} = 1 foreach(@irreg);
922 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
923 while($irregularities->{$issueno}) {
930 my $numberingmethod = $pattern->{numberingmethod};
932 if ($numberingmethod) {
933 $calculated = $numberingmethod;
934 my $locale = $subscription->{locale};
935 $newlastvalue1 = $subscription->{lastvalue1} || 0;
936 $newlastvalue2 = $subscription->{lastvalue2} || 0;
937 $newlastvalue3 = $subscription->{lastvalue3} || 0;
938 $newinnerloop1 = $subscription->{innerloop1} || 0;
939 $newinnerloop2 = $subscription->{innerloop2} || 0;
940 $newinnerloop3 = $subscription->{innerloop3} || 0;
943 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
946 for(my $i = 0; $i < $count; $i++) {
948 # check if we have to increase the new value.
950 if ($newinnerloop1 >= $pattern->{every1}) {
952 $newlastvalue1 += $pattern->{add1};
954 # reset counter if needed.
955 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
958 # check if we have to increase the new value.
960 if ($newinnerloop2 >= $pattern->{every2}) {
962 $newlastvalue2 += $pattern->{add2};
964 # reset counter if needed.
965 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
968 # check if we have to increase the new value.
970 if ($newinnerloop3 >= $pattern->{every3}) {
972 $newlastvalue3 += $pattern->{add3};
974 # reset counter if needed.
975 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
979 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
980 $calculated =~ s/\{X\}/$newlastvalue1string/g;
983 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
984 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
987 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
988 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
993 $newlastvalue1, $newlastvalue2, $newlastvalue3,
994 $newinnerloop1, $newinnerloop2, $newinnerloop3);
999 $calculated = GetSeq($subscription, $pattern)
1000 $subscription is a hashref containing all the attributes of the table 'subscription'
1001 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
1002 this function transforms {X},{Y},{Z} to 150,0,0 for example.
1004 the sequence in string format
1009 my ($subscription, $pattern) = @_;
1011 return unless ($subscription and $pattern);
1013 my $locale = $subscription->{locale};
1015 my $calculated = $pattern->{numberingmethod};
1017 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
1018 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
1019 $calculated =~ s/\{X\}/$newlastvalue1/g;
1021 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1022 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1023 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1025 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1026 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1027 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1031 =head2 GetExpirationDate
1033 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1035 this function return the next expiration date for a subscription given on input args.
1038 the enddate or undef
1042 sub GetExpirationDate {
1043 my ( $subscriptionid, $startdate ) = @_;
1045 return unless ($subscriptionid);
1047 my $dbh = C4::Context->dbh;
1048 my $subscription = GetSubscription($subscriptionid);
1051 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1052 $enddate = $startdate || $subscription->{startdate};
1053 my @date = split( /-/, $enddate );
1054 return if ( scalar(@date) != 3 || not check_date(@date) );
1055 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1056 if ( $frequency and $frequency->{unit} ) {
1059 if ( my $length = $subscription->{numberlength} ) {
1061 #calculate the date of the last issue.
1062 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1063 $enddate = GetNextDate( $subscription, $enddate );
1065 } elsif ( $subscription->{monthlength} ) {
1066 if ( $$subscription{startdate} ) {
1067 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1068 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1070 } elsif ( $subscription->{weeklength} ) {
1071 if ( $$subscription{startdate} ) {
1072 my @date = split( /-/, $subscription->{startdate} );
1073 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1074 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1077 $enddate = $subscription->{enddate};
1081 return $subscription->{enddate};
1085 =head2 CountSubscriptionFromBiblionumber
1087 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1088 this returns a count of the subscriptions for a given biblionumber
1090 the number of subscriptions
1094 sub CountSubscriptionFromBiblionumber {
1095 my ($biblionumber) = @_;
1097 return unless ($biblionumber);
1099 my $dbh = C4::Context->dbh;
1100 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1101 my $sth = $dbh->prepare($query);
1102 $sth->execute($biblionumber);
1103 my $subscriptionsnumber = $sth->fetchrow;
1104 return $subscriptionsnumber;
1107 =head2 ModSubscriptionHistory
1109 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1111 this function modifies the history of a subscription. Put your new values on input arg.
1112 returns the number of rows affected
1116 sub ModSubscriptionHistory {
1117 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1119 return unless ($subscriptionid);
1121 my $dbh = C4::Context->dbh;
1122 my $query = "UPDATE subscriptionhistory
1123 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1124 WHERE subscriptionid=?
1126 my $sth = $dbh->prepare($query);
1127 $receivedlist =~ s/^; // if $receivedlist;
1128 $missinglist =~ s/^; // if $missinglist;
1129 $opacnote =~ s/^; // if $opacnote;
1130 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1134 # Update missinglist field, used by ModSerialStatus
1135 sub _update_missinglist {
1136 my $subscriptionid = shift;
1138 my $dbh = C4::Context->dbh;
1139 my @missingserials = GetSerials2($subscriptionid, "4,5");
1141 foreach (@missingserials) {
1142 if($_->{'status'} == 4) {
1143 $missinglist .= $_->{'serialseq'} . "; ";
1144 } elsif($_->{'status'} == 5) {
1145 $missinglist .= "not issued " . $_->{'serialseq'} . "; ";
1148 $missinglist =~ s/; $//;
1150 UPDATE subscriptionhistory
1152 WHERE subscriptionid = ?
1154 my $sth = $dbh->prepare($query);
1155 $sth->execute($missinglist, $subscriptionid);
1158 # Update recievedlist field, used by ModSerialStatus
1159 sub _update_receivedlist {
1160 my $subscriptionid = shift;
1162 my $dbh = C4::Context->dbh;
1163 my @receivedserials = GetSerials2($subscriptionid, "2");
1165 foreach (@receivedserials) {
1166 $receivedlist .= $_->{'serialseq'} . "; ";
1168 $receivedlist =~ s/; $//;
1170 UPDATE subscriptionhistory
1171 SET recievedlist = ?
1172 WHERE subscriptionid = ?
1174 my $sth = $dbh->prepare($query);
1175 $sth->execute($receivedlist, $subscriptionid);
1178 =head2 ModSerialStatus
1180 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1182 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1183 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1187 sub ModSerialStatus {
1188 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1190 return unless ($serialid);
1192 #It is a usual serial
1193 # 1st, get previous status :
1194 my $dbh = C4::Context->dbh;
1195 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1196 FROM serial, subscription
1197 WHERE serial.subscriptionid=subscription.subscriptionid
1199 my $sth = $dbh->prepare($query);
1200 $sth->execute($serialid);
1201 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1202 my $frequency = GetSubscriptionFrequency($periodicity);
1204 # change status & update subscriptionhistory
1206 if ( $status == 6 ) {
1207 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1210 unless ($frequency->{'unit'}) {
1211 if ( not $planneddate or $planneddate eq '0000-00-00' ) { $planneddate = C4::Dates->new()->output('iso') };
1212 if ( not $publisheddate or $publisheddate eq '0000-00-00' ) { $publisheddate = C4::Dates->new()->output('iso') };
1214 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1215 $sth = $dbh->prepare($query);
1216 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1217 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1218 $sth = $dbh->prepare($query);
1219 $sth->execute($subscriptionid);
1220 my $val = $sth->fetchrow_hashref;
1221 unless ( $val->{manualhistory} ) {
1222 if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) {
1223 _update_receivedlist($subscriptionid);
1225 if($status == 4 || $status == 5
1226 || ($oldstatus == 4 && $status != 4)
1227 || ($oldstatus == 5 && $status != 5)) {
1228 _update_missinglist($subscriptionid);
1233 # create new waited entry if needed (ie : was a "waited" and has changed)
1234 if ( $oldstatus == 1 && $status != 1 ) {
1235 my $subscription = GetSubscription($subscriptionid);
1236 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1240 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1241 $newinnerloop1, $newinnerloop2, $newinnerloop3
1243 = GetNextSeq( $subscription, $pattern, $publisheddate );
1245 # next date (calculated from actual date & frequency parameters)
1246 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1247 my $nextpubdate = $nextpublisheddate;
1248 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1249 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1250 WHERE subscriptionid = ?";
1251 $sth = $dbh->prepare($query);
1252 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1254 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1255 if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) {
1256 require C4::Letters;
1257 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1264 =head2 GetNextExpected
1266 $nextexpected = GetNextExpected($subscriptionid)
1268 Get the planneddate for the current expected issue of the subscription.
1274 planneddate => ISO date
1279 sub GetNextExpected {
1280 my ($subscriptionid) = @_;
1282 my $dbh = C4::Context->dbh;
1286 WHERE subscriptionid = ?
1290 my $sth = $dbh->prepare($query);
1292 # Each subscription has only one 'expected' issue, with serial.status==1.
1293 $sth->execute( $subscriptionid, 1 );
1294 my $nextissue = $sth->fetchrow_hashref;
1295 if ( !$nextissue ) {
1299 WHERE subscriptionid = ?
1300 ORDER BY publisheddate DESC
1303 $sth = $dbh->prepare($query);
1304 $sth->execute($subscriptionid);
1305 $nextissue = $sth->fetchrow_hashref;
1307 foreach(qw/planneddate publisheddate/) {
1308 if ( !defined $nextissue->{$_} ) {
1309 # or should this default to 1st Jan ???
1310 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1312 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1320 =head2 ModNextExpected
1322 ModNextExpected($subscriptionid,$date)
1324 Update the planneddate for the current expected issue of the subscription.
1325 This will modify all future prediction results.
1327 C<$date> is an ISO date.
1333 sub ModNextExpected {
1334 my ( $subscriptionid, $date ) = @_;
1335 my $dbh = C4::Context->dbh;
1337 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1338 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1340 # Each subscription has only one 'expected' issue, with serial.status==1.
1341 $sth->execute( $date, $date, $subscriptionid, 1 );
1346 =head2 GetSubscriptionIrregularities
1350 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1351 get the list of irregularities for a subscription
1357 sub GetSubscriptionIrregularities {
1358 my $subscriptionid = shift;
1360 return unless $subscriptionid;
1362 my $dbh = C4::Context->dbh;
1366 WHERE subscriptionid = ?
1368 my $sth = $dbh->prepare($query);
1369 $sth->execute($subscriptionid);
1371 my ($result) = $sth->fetchrow_array;
1372 my @irreg = split /;/, $result;
1377 =head2 ModSubscription
1379 this function modifies a subscription. Put all new values on input args.
1380 returns the number of rows affected
1384 sub ModSubscription {
1386 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1387 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1388 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1389 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1390 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1391 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1392 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1395 my $dbh = C4::Context->dbh;
1396 my $query = "UPDATE subscription
1397 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1398 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1399 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1400 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1401 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1402 callnumber=?, notes=?, letter=?, manualhistory=?,
1403 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1404 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1406 WHERE subscriptionid = ?";
1408 my $sth = $dbh->prepare($query);
1410 $auser, $branchcode, $aqbooksellerid, $cost,
1411 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1412 $irregularity, $numberpattern, $locale, $numberlength,
1413 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1414 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1415 $status, $biblionumber, $callnumber, $notes,
1416 $letter, ($manualhistory ? $manualhistory : 0),
1417 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1418 $graceperiod, $location, $enddate, $skip_serialseq,
1421 my $rows = $sth->rows;
1423 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1427 =head2 NewSubscription
1429 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1430 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1431 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1432 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1433 $callnumber, $hemisphere, $manualhistory, $internalnotes, $serialsadditems,
1434 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1436 Create a new subscription with value given on input args.
1439 the id of this new subscription
1443 sub NewSubscription {
1445 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1446 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1447 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1448 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1449 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1450 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1451 $location, $enddate, $skip_serialseq
1453 my $dbh = C4::Context->dbh;
1455 #save subscription (insert into database)
1457 INSERT INTO subscription
1458 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1459 biblionumber, startdate, periodicity, numberlength, weeklength,
1460 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1461 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1462 irregularity, numberpattern, locale, callnumber,
1463 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1464 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1465 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1467 my $sth = $dbh->prepare($query);
1469 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1470 $startdate, $periodicity, $numberlength, $weeklength,
1471 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1472 $lastvalue3, $innerloop3, $status, $notes, $letter,
1473 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1474 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1475 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1478 my $subscriptionid = $dbh->{'mysql_insertid'};
1480 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1484 WHERE subscriptionid=?
1486 $sth = $dbh->prepare($query);
1487 $sth->execute( $enddate, $subscriptionid );
1490 # then create the 1st expected number
1492 INSERT INTO subscriptionhistory
1493 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1496 $sth = $dbh->prepare($query);
1497 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1499 # reread subscription to get a hash (for calculation of the 1st issue number)
1500 my $subscription = GetSubscription($subscriptionid);
1501 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1503 # calculate issue number
1504 my $serialseq = GetSeq($subscription, $pattern);
1507 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1508 VALUES (?,?,?,?,?,?)
1510 $sth = $dbh->prepare($query);
1511 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1513 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1515 #set serial flag on biblio if not already set.
1516 my $bib = GetBiblio($biblionumber);
1517 if ( $bib and !$bib->{'serial'} ) {
1518 my $record = GetMarcBiblio($biblionumber);
1519 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1521 eval { $record->field($tag)->update( $subf => 1 ); };
1523 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1525 return $subscriptionid;
1528 =head2 ReNewSubscription
1530 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1532 this function renew a subscription with values given on input args.
1536 sub ReNewSubscription {
1537 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1538 my $dbh = C4::Context->dbh;
1539 my $subscription = GetSubscription($subscriptionid);
1543 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1544 WHERE biblio.biblionumber=?
1546 my $sth = $dbh->prepare($query);
1547 $sth->execute( $subscription->{biblionumber} );
1548 my $biblio = $sth->fetchrow_hashref;
1550 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1551 require C4::Suggestions;
1552 C4::Suggestions::NewSuggestion(
1553 { 'suggestedby' => $user,
1554 'title' => $subscription->{bibliotitle},
1555 'author' => $biblio->{author},
1556 'publishercode' => $biblio->{publishercode},
1557 'note' => $biblio->{note},
1558 'biblionumber' => $subscription->{biblionumber}
1563 # renew subscription
1566 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1567 WHERE subscriptionid=?
1569 $sth = $dbh->prepare($query);
1570 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1571 my $enddate = GetExpirationDate($subscriptionid);
1572 $debug && warn "enddate :$enddate";
1576 WHERE subscriptionid=?
1578 $sth = $dbh->prepare($query);
1579 $sth->execute( $enddate, $subscriptionid );
1581 UPDATE subscriptionhistory
1583 WHERE subscriptionid=?
1585 $sth = $dbh->prepare($query);
1586 $sth->execute( $enddate, $subscriptionid );
1588 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1594 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1596 Create a new issue stored on the database.
1597 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1598 returns the serial id
1603 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1604 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1606 return unless ($subscriptionid);
1608 my $dbh = C4::Context->dbh;
1611 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1612 VALUES (?,?,?,?,?,?,?)
1614 my $sth = $dbh->prepare($query);
1615 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1616 my $serialid = $dbh->{'mysql_insertid'};
1618 SELECT missinglist,recievedlist
1619 FROM subscriptionhistory
1620 WHERE subscriptionid=?
1622 $sth = $dbh->prepare($query);
1623 $sth->execute($subscriptionid);
1624 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1626 if ( $status == 2 ) {
1627 ### TODO Add a feature that improves recognition and description.
1628 ### As such count (serialseq) i.e. : N18,2(N19),N20
1629 ### Would use substr and index But be careful to previous presence of ()
1630 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1632 if ( $status == 4 ) {
1633 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1636 UPDATE subscriptionhistory
1637 SET recievedlist=?, missinglist=?
1638 WHERE subscriptionid=?
1640 $sth = $dbh->prepare($query);
1641 $recievedlist =~ s/^; //;
1642 $missinglist =~ s/^; //;
1643 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1647 =head2 ItemizeSerials
1649 ItemizeSerials($serialid, $info);
1650 $info is a hashref containing barcode branch, itemcallnumber, status, location
1651 $serialid the serialid
1653 1 if the itemize is a succes.
1654 0 and @error otherwise. @error containts the list of errors found.
1658 sub ItemizeSerials {
1659 my ( $serialid, $info ) = @_;
1661 return unless ($serialid);
1663 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1665 my $dbh = C4::Context->dbh;
1671 my $sth = $dbh->prepare($query);
1672 $sth->execute($serialid);
1673 my $data = $sth->fetchrow_hashref;
1674 if ( C4::Context->preference("RoutingSerials") ) {
1676 # check for existing biblioitem relating to serial issue
1677 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1679 for ( my $i = 0 ; $i < $count ; $i++ ) {
1680 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1681 $bibitemno = $results[$i]->{'biblioitemnumber'};
1685 if ( $bibitemno == 0 ) {
1686 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1687 $sth->execute( $data->{'biblionumber'} );
1688 my $biblioitem = $sth->fetchrow_hashref;
1689 $biblioitem->{'volumedate'} = $data->{planneddate};
1690 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1691 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1695 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1696 if ( $info->{barcode} ) {
1698 if ( is_barcode_in_use( $info->{barcode} ) ) {
1699 push @errors, 'barcode_not_unique';
1701 my $marcrecord = MARC::Record->new();
1702 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1703 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1704 $marcrecord->insert_fields_ordered($newField);
1705 if ( $info->{branch} ) {
1706 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1708 #warn "items.homebranch : $tag , $subfield";
1709 if ( $marcrecord->field($tag) ) {
1710 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1712 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1713 $marcrecord->insert_fields_ordered($newField);
1715 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1717 #warn "items.holdingbranch : $tag , $subfield";
1718 if ( $marcrecord->field($tag) ) {
1719 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1721 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1722 $marcrecord->insert_fields_ordered($newField);
1725 if ( $info->{itemcallnumber} ) {
1726 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1728 if ( $marcrecord->field($tag) ) {
1729 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1731 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1732 $marcrecord->insert_fields_ordered($newField);
1735 if ( $info->{notes} ) {
1736 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1738 if ( $marcrecord->field($tag) ) {
1739 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1741 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1742 $marcrecord->insert_fields_ordered($newField);
1745 if ( $info->{location} ) {
1746 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1748 if ( $marcrecord->field($tag) ) {
1749 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1751 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1752 $marcrecord->insert_fields_ordered($newField);
1755 if ( $info->{status} ) {
1756 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1758 if ( $marcrecord->field($tag) ) {
1759 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1761 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1762 $marcrecord->insert_fields_ordered($newField);
1765 if ( C4::Context->preference("RoutingSerials") ) {
1766 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1767 if ( $marcrecord->field($tag) ) {
1768 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1770 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1771 $marcrecord->insert_fields_ordered($newField);
1775 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1778 return ( 0, @errors );
1782 =head2 HasSubscriptionStrictlyExpired
1784 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1786 the subscription has stricly expired when today > the end subscription date
1789 1 if true, 0 if false, -1 if the expiration date is not set.
1793 sub HasSubscriptionStrictlyExpired {
1795 # Getting end of subscription date
1796 my ($subscriptionid) = @_;
1798 return unless ($subscriptionid);
1800 my $dbh = C4::Context->dbh;
1801 my $subscription = GetSubscription($subscriptionid);
1802 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1804 # If the expiration date is set
1805 if ( $expirationdate != 0 ) {
1806 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1808 # Getting today's date
1809 my ( $nowyear, $nowmonth, $nowday ) = Today();
1811 # if today's date > expiration date, then the subscription has stricly expired
1812 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1819 # There are some cases where the expiration date is not set
1820 # As we can't determine if the subscription has expired on a date-basis,
1826 =head2 HasSubscriptionExpired
1828 $has_expired = HasSubscriptionExpired($subscriptionid)
1830 the subscription has expired when the next issue to arrive is out of subscription limit.
1833 0 if the subscription has not expired
1834 1 if the subscription has expired
1835 2 if has subscription does not have a valid expiration date set
1839 sub HasSubscriptionExpired {
1840 my ($subscriptionid) = @_;
1842 return unless ($subscriptionid);
1844 my $dbh = C4::Context->dbh;
1845 my $subscription = GetSubscription($subscriptionid);
1846 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1847 if ( $frequency and $frequency->{unit} ) {
1848 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1849 if (!defined $expirationdate) {
1850 $expirationdate = q{};
1853 SELECT max(planneddate)
1855 WHERE subscriptionid=?
1857 my $sth = $dbh->prepare($query);
1858 $sth->execute($subscriptionid);
1859 my ($res) = $sth->fetchrow;
1860 if (!$res || $res=~m/^0000/) {
1863 my @res = split( /-/, $res );
1864 my @endofsubscriptiondate = split( /-/, $expirationdate );
1865 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1867 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1872 if ( $subscription->{'numberlength'} ) {
1873 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1874 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1880 return 0; # Notice that you'll never get here.
1883 =head2 SetDistributedto
1885 SetDistributedto($distributedto,$subscriptionid);
1886 This function update the value of distributedto for a subscription given on input arg.
1890 sub SetDistributedto {
1891 my ( $distributedto, $subscriptionid ) = @_;
1892 my $dbh = C4::Context->dbh;
1896 WHERE subscriptionid=?
1898 my $sth = $dbh->prepare($query);
1899 $sth->execute( $distributedto, $subscriptionid );
1903 =head2 DelSubscription
1905 DelSubscription($subscriptionid)
1906 this function deletes subscription which has $subscriptionid as id.
1910 sub DelSubscription {
1911 my ($subscriptionid) = @_;
1912 my $dbh = C4::Context->dbh;
1913 $subscriptionid = $dbh->quote($subscriptionid);
1914 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1915 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1916 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1918 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1923 DelIssue($serialseq,$subscriptionid)
1924 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1926 returns the number of rows affected
1931 my ($dataissue) = @_;
1932 my $dbh = C4::Context->dbh;
1933 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1938 AND subscriptionid= ?
1940 my $mainsth = $dbh->prepare($query);
1941 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1943 #Delete element from subscription history
1944 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1945 my $sth = $dbh->prepare($query);
1946 $sth->execute( $dataissue->{'subscriptionid'} );
1947 my $val = $sth->fetchrow_hashref;
1948 unless ( $val->{manualhistory} ) {
1950 SELECT * FROM subscriptionhistory
1951 WHERE subscriptionid= ?
1953 my $sth = $dbh->prepare($query);
1954 $sth->execute( $dataissue->{'subscriptionid'} );
1955 my $data = $sth->fetchrow_hashref;
1956 my $serialseq = $dataissue->{'serialseq'};
1957 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1958 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1959 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1960 $sth = $dbh->prepare($strsth);
1961 $sth->execute( $dataissue->{'subscriptionid'} );
1964 return $mainsth->rows;
1967 =head2 GetLateOrMissingIssues
1969 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1971 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1974 the issuelist as an array of hash refs. Each element of this array contains
1975 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1979 sub GetLateOrMissingIssues {
1980 my ( $supplierid, $serialid, $order ) = @_;
1982 return unless ( $supplierid or $serialid );
1984 my $dbh = C4::Context->dbh;
1988 $byserial = "and serialid = " . $serialid;
1991 $order .= ", title";
1996 $sth = $dbh->prepare(
1998 serialid, aqbooksellerid, name,
1999 biblio.title, planneddate, serialseq,
2000 serial.status, serial.subscriptionid, claimdate,
2001 subscription.branchcode
2003 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
2004 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
2005 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2006 WHERE subscription.subscriptionid = serial.subscriptionid
2007 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2008 AND subscription.aqbooksellerid=$supplierid
2013 $sth = $dbh->prepare(
2015 serialid, aqbooksellerid, name,
2016 biblio.title, planneddate, serialseq,
2017 serial.status, serial.subscriptionid, claimdate,
2018 subscription.branchcode
2020 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
2021 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
2022 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2023 WHERE subscription.subscriptionid = serial.subscriptionid
2024 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2031 while ( my $line = $sth->fetchrow_hashref ) {
2033 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
2034 $line->{planneddate} = format_date( $line->{planneddate} );
2036 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
2037 $line->{claimdate} = format_date( $line->{claimdate} );
2039 $line->{"status".$line->{status}} = 1;
2040 push @issuelist, $line;
2045 =head2 removeMissingIssue
2047 removeMissingIssue($subscriptionid)
2049 this function removes an issue from being part of the missing string in
2050 subscriptionlist.missinglist column
2052 called when a missing issue is found from the serials-recieve.pl file
2056 sub removeMissingIssue {
2057 my ( $sequence, $subscriptionid ) = @_;
2059 return unless ($sequence and $subscriptionid);
2061 my $dbh = C4::Context->dbh;
2062 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2063 $sth->execute($subscriptionid);
2064 my $data = $sth->fetchrow_hashref;
2065 my $missinglist = $data->{'missinglist'};
2066 my $missinglistbefore = $missinglist;
2068 # warn $missinglist." before";
2069 $missinglist =~ s/($sequence)//;
2071 # warn $missinglist." after";
2072 if ( $missinglist ne $missinglistbefore ) {
2073 $missinglist =~ s/\|\s\|/\|/g;
2074 $missinglist =~ s/^\| //g;
2075 $missinglist =~ s/\|$//g;
2076 my $sth2 = $dbh->prepare(
2077 "UPDATE subscriptionhistory
2079 WHERE subscriptionid = ?"
2081 $sth2->execute( $missinglist, $subscriptionid );
2088 &updateClaim($serialid)
2090 this function updates the time when a claim is issued for late/missing items
2092 called from claims.pl file
2097 my ($serialid) = @_;
2098 my $dbh = C4::Context->dbh;
2099 my $sth = $dbh->prepare(
2100 "UPDATE serial SET claimdate = now()
2104 $sth->execute($serialid);
2108 =head2 getsupplierbyserialid
2110 $result = getsupplierbyserialid($serialid)
2112 this function is used to find the supplier id given a serial id
2115 hashref containing serialid, subscriptionid, and aqbooksellerid
2119 sub getsupplierbyserialid {
2120 my ($serialid) = @_;
2121 my $dbh = C4::Context->dbh;
2122 my $sth = $dbh->prepare(
2123 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2125 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2129 $sth->execute($serialid);
2130 my $line = $sth->fetchrow_hashref;
2131 my $result = $line->{'aqbooksellerid'};
2135 =head2 check_routing
2137 $result = &check_routing($subscriptionid)
2139 this function checks to see if a serial has a routing list and returns the count of routingid
2140 used to show either an 'add' or 'edit' link
2145 my ($subscriptionid) = @_;
2147 return unless ($subscriptionid);
2149 my $dbh = C4::Context->dbh;
2150 my $sth = $dbh->prepare(
2151 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2152 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2153 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2156 $sth->execute($subscriptionid);
2157 my $line = $sth->fetchrow_hashref;
2158 my $result = $line->{'routingids'};
2162 =head2 addroutingmember
2164 addroutingmember($borrowernumber,$subscriptionid)
2166 this function takes a borrowernumber and subscriptionid and adds the member to the
2167 routing list for that serial subscription and gives them a rank on the list
2168 of either 1 or highest current rank + 1
2172 sub addroutingmember {
2173 my ( $borrowernumber, $subscriptionid ) = @_;
2175 return unless ($borrowernumber and $subscriptionid);
2178 my $dbh = C4::Context->dbh;
2179 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2180 $sth->execute($subscriptionid);
2181 while ( my $line = $sth->fetchrow_hashref ) {
2182 if ( $line->{'rank'} > 0 ) {
2183 $rank = $line->{'rank'} + 1;
2188 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2189 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2192 =head2 reorder_members
2194 reorder_members($subscriptionid,$routingid,$rank)
2196 this function is used to reorder the routing list
2198 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2199 - it gets all members on list puts their routingid's into an array
2200 - removes the one in the array that is $routingid
2201 - then reinjects $routingid at point indicated by $rank
2202 - then update the database with the routingids in the new order
2206 sub reorder_members {
2207 my ( $subscriptionid, $routingid, $rank ) = @_;
2208 my $dbh = C4::Context->dbh;
2209 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2210 $sth->execute($subscriptionid);
2212 while ( my $line = $sth->fetchrow_hashref ) {
2213 push( @result, $line->{'routingid'} );
2216 # To find the matching index
2218 my $key = -1; # to allow for 0 being a valid response
2219 for ( $i = 0 ; $i < @result ; $i++ ) {
2220 if ( $routingid == $result[$i] ) {
2221 $key = $i; # save the index
2226 # if index exists in array then move it to new position
2227 if ( $key > -1 && $rank > 0 ) {
2228 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2229 my $moving_item = splice( @result, $key, 1 );
2230 splice( @result, $new_rank, 0, $moving_item );
2232 for ( my $j = 0 ; $j < @result ; $j++ ) {
2233 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2239 =head2 delroutingmember
2241 delroutingmember($routingid,$subscriptionid)
2243 this function either deletes one member from routing list if $routingid exists otherwise
2244 deletes all members from the routing list
2248 sub delroutingmember {
2250 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2251 my ( $routingid, $subscriptionid ) = @_;
2252 my $dbh = C4::Context->dbh;
2254 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2255 $sth->execute($routingid);
2256 reorder_members( $subscriptionid, $routingid );
2258 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2259 $sth->execute($subscriptionid);
2264 =head2 getroutinglist
2266 @routinglist = getroutinglist($subscriptionid)
2268 this gets the info from the subscriptionroutinglist for $subscriptionid
2271 the routinglist as an array. Each element of the array contains a hash_ref containing
2272 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2276 sub getroutinglist {
2277 my ($subscriptionid) = @_;
2278 my $dbh = C4::Context->dbh;
2279 my $sth = $dbh->prepare(
2280 'SELECT routingid, borrowernumber, ranking, biblionumber
2282 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2283 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2285 $sth->execute($subscriptionid);
2286 my $routinglist = $sth->fetchall_arrayref({});
2287 return @{$routinglist};
2290 =head2 countissuesfrom
2292 $result = countissuesfrom($subscriptionid,$startdate)
2294 Returns a count of serial rows matching the given subsctiptionid
2295 with published date greater than startdate
2299 sub countissuesfrom {
2300 my ( $subscriptionid, $startdate ) = @_;
2301 my $dbh = C4::Context->dbh;
2305 WHERE subscriptionid=?
2306 AND serial.publisheddate>?
2308 my $sth = $dbh->prepare($query);
2309 $sth->execute( $subscriptionid, $startdate );
2310 my ($countreceived) = $sth->fetchrow;
2311 return $countreceived;
2316 $result = CountIssues($subscriptionid)
2318 Returns a count of serial rows matching the given subsctiptionid
2323 my ($subscriptionid) = @_;
2324 my $dbh = C4::Context->dbh;
2328 WHERE subscriptionid=?
2330 my $sth = $dbh->prepare($query);
2331 $sth->execute($subscriptionid);
2332 my ($countreceived) = $sth->fetchrow;
2333 return $countreceived;
2338 $result = HasItems($subscriptionid)
2340 returns a count of items from serial matching the subscriptionid
2345 my ($subscriptionid) = @_;
2346 my $dbh = C4::Context->dbh;
2348 SELECT COUNT(serialitems.itemnumber)
2350 LEFT JOIN serialitems USING(serialid)
2351 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2353 my $sth=$dbh->prepare($query);
2354 $sth->execute($subscriptionid);
2355 my ($countitems)=$sth->fetchrow_array();
2359 =head2 abouttoexpire
2361 $result = abouttoexpire($subscriptionid)
2363 this function alerts you to the penultimate issue for a serial subscription
2365 returns 1 - if this is the penultimate issue
2371 my ($subscriptionid) = @_;
2372 my $dbh = C4::Context->dbh;
2373 my $subscription = GetSubscription($subscriptionid);
2374 my $per = $subscription->{'periodicity'};
2375 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2376 if ($frequency and $frequency->{unit}){
2377 my $expirationdate = GetExpirationDate($subscriptionid);
2378 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2379 my $nextdate = GetNextDate($subscription, $res);
2380 if(Date::Calc::Delta_Days(
2381 split( /-/, $nextdate ),
2382 split( /-/, $expirationdate )
2386 } elsif ($subscription->{numberlength}>0) {
2387 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2392 sub in_array { # used in next sub down
2393 my ( $val, @elements ) = @_;
2394 foreach my $elem (@elements) {
2395 if ( $val == $elem ) {
2402 =head2 GetSubscriptionsFromBorrower
2404 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2406 this gets the info from subscriptionroutinglist for each $subscriptionid
2409 a count of the serial subscription routing lists to which a patron belongs,
2410 with the titles of those serial subscriptions as an array. Each element of the array
2411 contains a hash_ref with subscriptionID and title of subscription.
2415 sub GetSubscriptionsFromBorrower {
2416 my ($borrowernumber) = @_;
2417 my $dbh = C4::Context->dbh;
2418 my $sth = $dbh->prepare(
2419 "SELECT subscription.subscriptionid, biblio.title
2421 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2422 JOIN subscriptionroutinglist USING (subscriptionid)
2423 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2426 $sth->execute($borrowernumber);
2429 while ( my $line = $sth->fetchrow_hashref ) {
2431 push( @routinglist, $line );
2433 return ( $count, @routinglist );
2437 =head2 GetFictiveIssueNumber
2439 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2441 Get the position of the issue published at $publisheddate, considering the
2442 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2443 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2444 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2445 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2446 depending on how many rows are in serial table.
2447 The issue number calculation is based on subscription frequency, first acquisition
2448 date, and $publisheddate.
2452 sub GetFictiveIssueNumber {
2453 my ($subscription, $publisheddate) = @_;
2455 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2456 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2460 my ($year, $month, $day) = split /-/, $publisheddate;
2461 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2465 if($unit eq 'day') {
2466 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2467 } elsif($unit eq 'week') {
2468 ($wkno, $year) = Week_of_Year($year, $month, $day);
2469 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2470 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2471 } elsif($unit eq 'month') {
2472 $delta = ($fa_year == $year)
2473 ? ($month - $fa_month)
2474 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2475 } elsif($unit eq 'year') {
2476 $delta = $year - $fa_year;
2478 if($frequency->{'unitsperissue'} == 1) {
2479 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2481 # Assuming issuesperunit == 1
2482 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2490 $resultdate = GetNextDate($publisheddate,$subscription)
2492 this function it takes the publisheddate and will return the next issue's date
2493 and will skip dates if there exists an irregularity.
2494 $publisheddate has to be an ISO date
2495 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2496 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2497 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2498 skipped then the returned date will be 2007-05-10
2501 $resultdate - then next date in the sequence (ISO date)
2503 Return $publisheddate if subscription is irregular
2508 my ( $subscription, $publisheddate, $updatecount ) = @_;
2510 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2512 if ($freqdata->{'unit'}) {
2513 my ( $year, $month, $day ) = split /-/, $publisheddate;
2515 # Process an irregularity Hash
2516 # Suppose that irregularities are stored in a string with this structure
2517 # irreg1;irreg2;irreg3
2518 # where irregX is the number of issue which will not be received
2519 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2520 my @irreg = split /;/, $subscription->{'irregularity'} ;
2522 foreach my $irregularity (@irreg) {
2523 $irregularities{$irregularity} = 1;
2526 # Get the 'fictive' next issue number
2527 # It is used to check if next issue is an irregular issue.
2528 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2530 # Then get the next date
2531 my $unit = lc $freqdata->{'unit'};
2532 if ($unit eq 'day') {
2533 while ($irregularities{$issueno}) {
2534 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2535 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
2536 $subscription->{'countissuesperunit'} = 1;
2538 $subscription->{'countissuesperunit'}++;
2542 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2543 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
2544 $subscription->{'countissuesperunit'} = 1;
2546 $subscription->{'countissuesperunit'}++;
2549 elsif ($unit eq 'week') {
2550 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2551 while ($irregularities{$issueno}) {
2552 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2553 $subscription->{'countissuesperunit'} = 1;
2554 $wkno += $freqdata->{"unitsperissue"};
2559 my $dow = Day_of_Week($year, $month, $day);
2560 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2561 if($freqdata->{'issuesperunit'} == 1) {
2562 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2565 $subscription->{'countissuesperunit'}++;
2569 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2570 $subscription->{'countissuesperunit'} = 1;
2571 $wkno += $freqdata->{"unitsperissue"};
2573 $wkno = $wkno % 52 ;
2576 my $dow = Day_of_Week($year, $month, $day);
2577 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2578 if($freqdata->{'issuesperunit'} == 1) {
2579 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2582 $subscription->{'countissuesperunit'}++;
2585 elsif ($unit eq 'month') {
2586 while ($irregularities{$issueno}) {
2587 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2588 $subscription->{'countissuesperunit'} = 1;
2589 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2590 unless($freqdata->{'issuesperunit'} == 1) {
2591 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2594 $subscription->{'countissuesperunit'}++;
2598 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2599 $subscription->{'countissuesperunit'} = 1;
2600 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2601 unless($freqdata->{'issuesperunit'} == 1) {
2602 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2605 $subscription->{'countissuesperunit'}++;
2608 elsif ($unit eq 'year') {
2609 while ($irregularities{$issueno}) {
2610 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2611 $subscription->{'countissuesperunit'} = 1;
2612 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2613 unless($freqdata->{'issuesperunit'} == 1) {
2614 # Jumping to the first day of year, because we don't know what day is expected
2619 $subscription->{'countissuesperunit'}++;
2623 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2624 $subscription->{'countissuesperunit'} = 1;
2625 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2626 unless($freqdata->{'issuesperunit'} == 1) {
2627 # Jumping to the first day of year, because we don't know what day is expected
2632 $subscription->{'countissuesperunit'}++;
2636 my $dbh = C4::Context->dbh;
2639 SET countissuesperunit = ?
2640 WHERE subscriptionid = ?
2642 my $sth = $dbh->prepare($query);
2643 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2645 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2648 return $publisheddate;
2654 $string = &_numeration($value,$num_type,$locale);
2656 _numeration returns the string corresponding to $value in the num_type
2666 my ($value, $num_type, $locale) = @_;
2668 my $initlocale = setlocale(LC_TIME);
2669 if($locale and $locale ne $initlocale) {
2670 $locale = setlocale(LC_TIME, $locale);
2672 $locale ||= $initlocale;
2676 when (/^dayname$/) {
2677 $value = $value % 7;
2678 $string = POSIX::strftime("%A",0,0,0,0,0,0,$value);
2680 when (/^monthname$/) {
2681 $value = $value % 12;
2682 $string = POSIX::strftime("%B",0,0,0,1,$value,0,0,0,0);
2685 my $seasonlocale = ($locale)
2686 ? (substr $locale,0,2)
2690 [qw(Spring Summer Fall Winter)],
2692 [qw(Printemps Été Automne Hiver)],
2694 $value = $value % 4;
2695 $string = ($seasons{$seasonlocale})
2696 ? $seasons{$seasonlocale}->[$value]
2697 : $seasons{'en'}->[$value];
2703 if($locale ne $initlocale) {
2704 setlocale(LC_TIME, $initlocale);
2709 =head2 is_barcode_in_use
2711 Returns number of occurence of the barcode in the items table
2712 Can be used as a boolean test of whether the barcode has
2713 been deployed as yet
2717 sub is_barcode_in_use {
2718 my $barcode = shift;
2719 my $dbh = C4::Context->dbh;
2720 my $occurences = $dbh->selectall_arrayref(
2721 'SELECT itemnumber from items where barcode = ?',
2726 return @{$occurences};
2729 =head2 CloseSubscription
2730 Close a subscription given a subscriptionid
2732 sub CloseSubscription {
2733 my ( $subscriptionid ) = @_;
2734 return unless $subscriptionid;
2735 my $dbh = C4::Context->dbh;
2736 my $sth = $dbh->prepare( qq{
2739 WHERE subscriptionid = ?
2741 $sth->execute( $subscriptionid );
2743 # Set status = missing when status = stopped
2744 $sth = $dbh->prepare( qq{
2747 WHERE subscriptionid = ?
2750 $sth->execute( $subscriptionid );
2753 =head2 ReopenSubscription
2754 Reopen a subscription given a subscriptionid
2756 sub ReopenSubscription {
2757 my ( $subscriptionid ) = @_;
2758 return unless $subscriptionid;
2759 my $dbh = C4::Context->dbh;
2760 my $sth = $dbh->prepare( qq{
2763 WHERE subscriptionid = ?
2765 $sth->execute( $subscriptionid );
2767 # Set status = expected when status = stopped
2768 $sth = $dbh->prepare( qq{
2771 WHERE subscriptionid = ?
2774 $sth->execute( $subscriptionid );
2777 =head2 subscriptionCurrentlyOnOrder
2779 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2781 Return 1 if subscription is currently on order else 0.
2785 sub subscriptionCurrentlyOnOrder {
2786 my ( $subscriptionid ) = @_;
2787 my $dbh = C4::Context->dbh;
2789 SELECT COUNT(*) FROM aqorders
2790 WHERE subscriptionid = ?
2791 AND datereceived IS NULL
2792 AND datecancellationprinted IS NULL
2794 my $sth = $dbh->prepare( $query );
2795 $sth->execute($subscriptionid);
2796 return $sth->fetchrow_array;
2799 =head2 can_edit_subscription
2801 $can = can_edit_subscription( $subscriptionid[, $userid] );
2803 Return 1 if the subscription is editable by the current logged user (or a given $userid), else 0.
2807 sub can_edit_subscription {
2808 my ( $subscription, $userid ) = @_;
2809 return 0 unless C4::Context->userenv;
2810 my $flags = C4::Context->userenv->{flags};
2811 $userid ||= C4::Context->userenv->{'id'};
2812 my $independent_branches = C4::Context->preference('IndependentBranches');
2813 return 1 unless $independent_branches;
2814 if( $flags % 2 == 1 # superlibrarian
2815 or C4::Auth::haspermission( $userid, {serials => 'superserials'}),
2816 or C4::Auth::haspermission( $userid, {serials => 'edit_subscription'}),
2817 or not defined $subscription->{branchcode}
2818 or $subscription->{branchcode} eq ''
2819 or $subscription->{branchcode} eq C4::Context->userenv->{'branch'}
2831 Koha Development Team <http://koha-community.org/>