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->{callnumber} ) {
686 push @where_strs, "subscription.callnumber LIKE ?";
687 push @where_args, "%$args->{callnumber}%";
689 if( $args->{publisher} ){
690 push @where_strs, "biblioitems.publishercode LIKE ?";
691 push @where_args, "%$args->{publisher}%";
693 if( $args->{bookseller} ){
694 push @where_strs, "aqbooksellers.name LIKE ?";
695 push @where_args, "%$args->{bookseller}%";
697 if( $args->{branch} ){
698 push @where_strs, "subscription.branchcode = ?";
699 push @where_args, "$args->{branch}";
701 if ( $args->{location} ) {
702 push @where_strs, "subscription.location = ?";
703 push @where_args, "$args->{location}";
705 if ( $args->{expiration_date} ) {
706 push @where_strs, "subscription.enddate <= ?";
707 push @where_args, "$args->{expiration_date}";
709 if( defined $args->{closed} ){
710 push @where_strs, "subscription.closed = ?";
711 push @where_args, "$args->{closed}";
714 $query .= " WHERE " . join(" AND ", @where_strs);
717 my $dbh = C4::Context->dbh;
718 my $sth = $dbh->prepare($query);
719 $sth->execute(@where_args);
720 my $results = $sth->fetchall_arrayref( {} );
723 for my $subscription ( @$results ) {
724 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
725 $subscription->{cannotdisplay} =
726 ( C4::Context->preference("IndependentBranches") &&
727 C4::Context->userenv &&
728 $subscription->{branchcode} ne C4::Context->userenv->{'branch'} ) ? 1 : 0;
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 ) = @_;
749 return unless $subscriptionid;
751 my $dbh = C4::Context->dbh;
753 # status = 2 is "arrived"
755 $count = 5 unless ($count);
757 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
759 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
760 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
761 my $sth = $dbh->prepare($query);
762 $sth->execute($subscriptionid);
764 while ( my $line = $sth->fetchrow_hashref ) {
765 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
766 for my $datefield ( qw( planneddate publisheddate) ) {
767 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
768 $line->{$datefield} = format_date( $line->{$datefield});
770 $line->{$datefield} = q{};
773 push @serials, $line;
776 # OK, now add the last 5 issues arrives/missing
777 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
779 WHERE subscriptionid = ?
780 AND (status in (2,4,5))
781 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
783 $sth = $dbh->prepare($query);
784 $sth->execute($subscriptionid);
785 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
787 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
788 for my $datefield ( qw( planneddate publisheddate) ) {
789 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
790 $line->{$datefield} = format_date( $line->{$datefield});
792 $line->{$datefield} = q{};
796 push @serials, $line;
799 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
800 $sth = $dbh->prepare($query);
801 $sth->execute($subscriptionid);
802 my ($totalissues) = $sth->fetchrow;
803 return ( $totalissues, @serials );
808 @serials = GetSerials2($subscriptionid,$status);
809 this function returns every serial waited for a given subscription
810 as well as the number of issues registered in the database (all types)
811 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
816 my ( $subscription, $status ) = @_;
818 return unless ($subscription and $status);
820 my $dbh = C4::Context->dbh;
822 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
824 WHERE subscriptionid=$subscription AND status IN ($status)
825 ORDER BY publisheddate,serialid DESC
827 $debug and warn "GetSerials2 query: $query";
828 my $sth = $dbh->prepare($query);
832 while ( my $line = $sth->fetchrow_hashref ) {
833 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
834 # Format dates for display
835 for my $datefield ( qw( planneddate publisheddate ) ) {
836 if ($line->{$datefield} =~m/^00/) {
837 $line->{$datefield} = q{};
840 $line->{$datefield} = format_date( $line->{$datefield} );
843 push @serials, $line;
848 =head2 GetLatestSerials
850 \@serials = GetLatestSerials($subscriptionid,$limit)
851 get the $limit's latest serials arrived or missing for a given subscription
853 a ref to an array which contains all of the latest serials stored into a hash.
857 sub GetLatestSerials {
858 my ( $subscriptionid, $limit ) = @_;
860 return unless ($subscriptionid and $limit);
862 my $dbh = C4::Context->dbh;
864 # status = 2 is "arrived"
865 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
867 WHERE subscriptionid = ?
868 AND (status =2 or status=4)
869 ORDER BY publisheddate DESC LIMIT 0,$limit
871 my $sth = $dbh->prepare($strsth);
872 $sth->execute($subscriptionid);
874 while ( my $line = $sth->fetchrow_hashref ) {
875 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
876 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
877 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
878 push @serials, $line;
884 =head2 GetDistributedTo
886 $distributedto=GetDistributedTo($subscriptionid)
887 This function returns the field distributedto for the subscription matching subscriptionid
891 sub GetDistributedTo {
892 my $dbh = C4::Context->dbh;
894 my ($subscriptionid) = @_;
896 return unless ($subscriptionid);
898 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
899 my $sth = $dbh->prepare($query);
900 $sth->execute($subscriptionid);
901 return ($distributedto) = $sth->fetchrow;
907 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
908 $newinnerloop1, $newinnerloop2, $newinnerloop3
909 ) = GetNextSeq( $subscription, $pattern, $planneddate );
911 $subscription is a hashref containing all the attributes of the table
913 $pattern is a hashref containing all the attributes of the table
914 'subscription_numberpatterns'.
915 $planneddate is a C4::Dates object.
916 This function get the next issue for the subscription given on input arg
921 my ($subscription, $pattern, $planneddate) = @_;
923 return unless ($subscription and $pattern);
925 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
926 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
929 if ($subscription->{'skip_serialseq'}) {
930 my @irreg = split /;/, $subscription->{'irregularity'};
932 my $irregularities = {};
933 $irregularities->{$_} = 1 foreach(@irreg);
934 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
935 while($irregularities->{$issueno}) {
942 my $numberingmethod = $pattern->{numberingmethod};
944 if ($numberingmethod) {
945 $calculated = $numberingmethod;
946 my $locale = $subscription->{locale};
947 $newlastvalue1 = $subscription->{lastvalue1} || 0;
948 $newlastvalue2 = $subscription->{lastvalue2} || 0;
949 $newlastvalue3 = $subscription->{lastvalue3} || 0;
950 $newinnerloop1 = $subscription->{innerloop1} || 0;
951 $newinnerloop2 = $subscription->{innerloop2} || 0;
952 $newinnerloop3 = $subscription->{innerloop3} || 0;
955 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
958 for(my $i = 0; $i < $count; $i++) {
960 # check if we have to increase the new value.
962 if ($newinnerloop1 >= $pattern->{every1}) {
964 $newlastvalue1 += $pattern->{add1};
966 # reset counter if needed.
967 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
970 # check if we have to increase the new value.
972 if ($newinnerloop2 >= $pattern->{every2}) {
974 $newlastvalue2 += $pattern->{add2};
976 # reset counter if needed.
977 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
980 # check if we have to increase the new value.
982 if ($newinnerloop3 >= $pattern->{every3}) {
984 $newlastvalue3 += $pattern->{add3};
986 # reset counter if needed.
987 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
991 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
992 $calculated =~ s/\{X\}/$newlastvalue1string/g;
995 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
996 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
999 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
1000 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
1004 return ($calculated,
1005 $newlastvalue1, $newlastvalue2, $newlastvalue3,
1006 $newinnerloop1, $newinnerloop2, $newinnerloop3);
1011 $calculated = GetSeq($subscription, $pattern)
1012 $subscription is a hashref containing all the attributes of the table 'subscription'
1013 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
1014 this function transforms {X},{Y},{Z} to 150,0,0 for example.
1016 the sequence in string format
1021 my ($subscription, $pattern) = @_;
1023 return unless ($subscription and $pattern);
1025 my $locale = $subscription->{locale};
1027 my $calculated = $pattern->{numberingmethod};
1029 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
1030 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
1031 $calculated =~ s/\{X\}/$newlastvalue1/g;
1033 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1034 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1035 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1037 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1038 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1039 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1043 =head2 GetExpirationDate
1045 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1047 this function return the next expiration date for a subscription given on input args.
1050 the enddate or undef
1054 sub GetExpirationDate {
1055 my ( $subscriptionid, $startdate ) = @_;
1057 return unless ($subscriptionid);
1059 my $dbh = C4::Context->dbh;
1060 my $subscription = GetSubscription($subscriptionid);
1063 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1064 $enddate = $startdate || $subscription->{startdate};
1065 my @date = split( /-/, $enddate );
1066 return if ( scalar(@date) != 3 || not check_date(@date) );
1067 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1068 if ( $frequency and $frequency->{unit} ) {
1071 if ( my $length = $subscription->{numberlength} ) {
1073 #calculate the date of the last issue.
1074 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1075 $enddate = GetNextDate( $subscription, $enddate );
1077 } elsif ( $subscription->{monthlength} ) {
1078 if ( $$subscription{startdate} ) {
1079 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1080 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1082 } elsif ( $subscription->{weeklength} ) {
1083 if ( $$subscription{startdate} ) {
1084 my @date = split( /-/, $subscription->{startdate} );
1085 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1086 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1089 $enddate = $subscription->{enddate};
1093 return $subscription->{enddate};
1097 =head2 CountSubscriptionFromBiblionumber
1099 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1100 this returns a count of the subscriptions for a given biblionumber
1102 the number of subscriptions
1106 sub CountSubscriptionFromBiblionumber {
1107 my ($biblionumber) = @_;
1109 return unless ($biblionumber);
1111 my $dbh = C4::Context->dbh;
1112 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1113 my $sth = $dbh->prepare($query);
1114 $sth->execute($biblionumber);
1115 my $subscriptionsnumber = $sth->fetchrow;
1116 return $subscriptionsnumber;
1119 =head2 ModSubscriptionHistory
1121 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1123 this function modifies the history of a subscription. Put your new values on input arg.
1124 returns the number of rows affected
1128 sub ModSubscriptionHistory {
1129 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1131 return unless ($subscriptionid);
1133 my $dbh = C4::Context->dbh;
1134 my $query = "UPDATE subscriptionhistory
1135 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1136 WHERE subscriptionid=?
1138 my $sth = $dbh->prepare($query);
1139 $receivedlist =~ s/^; // if $receivedlist;
1140 $missinglist =~ s/^; // if $missinglist;
1141 $opacnote =~ s/^; // if $opacnote;
1142 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1146 # Update missinglist field, used by ModSerialStatus
1147 sub _update_missinglist {
1148 my $subscriptionid = shift;
1150 my $dbh = C4::Context->dbh;
1151 my @missingserials = GetSerials2($subscriptionid, "4,5");
1153 foreach (@missingserials) {
1154 if($_->{'status'} == 4) {
1155 $missinglist .= $_->{'serialseq'} . "; ";
1156 } elsif($_->{'status'} == 5) {
1157 $missinglist .= "not issued " . $_->{'serialseq'} . "; ";
1160 $missinglist =~ s/; $//;
1162 UPDATE subscriptionhistory
1164 WHERE subscriptionid = ?
1166 my $sth = $dbh->prepare($query);
1167 $sth->execute($missinglist, $subscriptionid);
1170 # Update recievedlist field, used by ModSerialStatus
1171 sub _update_receivedlist {
1172 my $subscriptionid = shift;
1174 my $dbh = C4::Context->dbh;
1175 my @receivedserials = GetSerials2($subscriptionid, "2");
1177 foreach (@receivedserials) {
1178 $receivedlist .= $_->{'serialseq'} . "; ";
1180 $receivedlist =~ s/; $//;
1182 UPDATE subscriptionhistory
1183 SET recievedlist = ?
1184 WHERE subscriptionid = ?
1186 my $sth = $dbh->prepare($query);
1187 $sth->execute($receivedlist, $subscriptionid);
1190 =head2 ModSerialStatus
1192 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1194 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1195 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1199 sub ModSerialStatus {
1200 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1202 return unless ($serialid);
1204 #It is a usual serial
1205 # 1st, get previous status :
1206 my $dbh = C4::Context->dbh;
1207 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1208 FROM serial, subscription
1209 WHERE serial.subscriptionid=subscription.subscriptionid
1211 my $sth = $dbh->prepare($query);
1212 $sth->execute($serialid);
1213 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1214 my $frequency = GetSubscriptionFrequency($periodicity);
1216 # change status & update subscriptionhistory
1218 if ( $status == 6 ) {
1219 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1222 unless ($frequency->{'unit'}) {
1223 if ( not $planneddate or $planneddate eq '0000-00-00' ) { $planneddate = C4::Dates->new()->output('iso') };
1224 if ( not $publisheddate or $publisheddate eq '0000-00-00' ) { $publisheddate = C4::Dates->new()->output('iso') };
1226 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1227 $sth = $dbh->prepare($query);
1228 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1229 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1230 $sth = $dbh->prepare($query);
1231 $sth->execute($subscriptionid);
1232 my $val = $sth->fetchrow_hashref;
1233 unless ( $val->{manualhistory} ) {
1234 if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) {
1235 _update_receivedlist($subscriptionid);
1237 if($status == 4 || $status == 5
1238 || ($oldstatus == 4 && $status != 4)
1239 || ($oldstatus == 5 && $status != 5)) {
1240 _update_missinglist($subscriptionid);
1245 # create new waited entry if needed (ie : was a "waited" and has changed)
1246 if ( $oldstatus == 1 && $status != 1 ) {
1247 my $subscription = GetSubscription($subscriptionid);
1248 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1252 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1253 $newinnerloop1, $newinnerloop2, $newinnerloop3
1255 = GetNextSeq( $subscription, $pattern, $publisheddate );
1257 # next date (calculated from actual date & frequency parameters)
1258 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1259 my $nextpubdate = $nextpublisheddate;
1260 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1261 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1262 WHERE subscriptionid = ?";
1263 $sth = $dbh->prepare($query);
1264 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1266 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1267 if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) {
1268 require C4::Letters;
1269 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1276 =head2 GetNextExpected
1278 $nextexpected = GetNextExpected($subscriptionid)
1280 Get the planneddate for the current expected issue of the subscription.
1286 planneddate => ISO date
1291 sub GetNextExpected {
1292 my ($subscriptionid) = @_;
1294 my $dbh = C4::Context->dbh;
1298 WHERE subscriptionid = ?
1302 my $sth = $dbh->prepare($query);
1304 # Each subscription has only one 'expected' issue, with serial.status==1.
1305 $sth->execute( $subscriptionid, 1 );
1306 my $nextissue = $sth->fetchrow_hashref;
1307 if ( !$nextissue ) {
1311 WHERE subscriptionid = ?
1312 ORDER BY publisheddate DESC
1315 $sth = $dbh->prepare($query);
1316 $sth->execute($subscriptionid);
1317 $nextissue = $sth->fetchrow_hashref;
1319 foreach(qw/planneddate publisheddate/) {
1320 if ( !defined $nextissue->{$_} ) {
1321 # or should this default to 1st Jan ???
1322 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1324 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1332 =head2 ModNextExpected
1334 ModNextExpected($subscriptionid,$date)
1336 Update the planneddate for the current expected issue of the subscription.
1337 This will modify all future prediction results.
1339 C<$date> is an ISO date.
1345 sub ModNextExpected {
1346 my ( $subscriptionid, $date ) = @_;
1347 my $dbh = C4::Context->dbh;
1349 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1350 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1352 # Each subscription has only one 'expected' issue, with serial.status==1.
1353 $sth->execute( $date, $date, $subscriptionid, 1 );
1358 =head2 GetSubscriptionIrregularities
1362 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1363 get the list of irregularities for a subscription
1369 sub GetSubscriptionIrregularities {
1370 my $subscriptionid = shift;
1372 return unless $subscriptionid;
1374 my $dbh = C4::Context->dbh;
1378 WHERE subscriptionid = ?
1380 my $sth = $dbh->prepare($query);
1381 $sth->execute($subscriptionid);
1383 my ($result) = $sth->fetchrow_array;
1384 my @irreg = split /;/, $result;
1389 =head2 ModSubscription
1391 this function modifies a subscription. Put all new values on input args.
1392 returns the number of rows affected
1396 sub ModSubscription {
1398 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1399 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1400 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1401 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1402 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1403 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1404 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1407 my $dbh = C4::Context->dbh;
1408 my $query = "UPDATE subscription
1409 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1410 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1411 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1412 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1413 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1414 callnumber=?, notes=?, letter=?, manualhistory=?,
1415 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1416 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1418 WHERE subscriptionid = ?";
1420 my $sth = $dbh->prepare($query);
1422 $auser, $branchcode, $aqbooksellerid, $cost,
1423 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1424 $irregularity, $numberpattern, $locale, $numberlength,
1425 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1426 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1427 $status, $biblionumber, $callnumber, $notes,
1428 $letter, ($manualhistory ? $manualhistory : 0),
1429 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1430 $graceperiod, $location, $enddate, $skip_serialseq,
1433 my $rows = $sth->rows;
1435 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1439 =head2 NewSubscription
1441 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1442 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1443 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1444 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1445 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1446 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1448 Create a new subscription with value given on input args.
1451 the id of this new subscription
1455 sub NewSubscription {
1457 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1458 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1459 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1460 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1461 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1462 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1463 $location, $enddate, $skip_serialseq
1465 my $dbh = C4::Context->dbh;
1467 #save subscription (insert into database)
1469 INSERT INTO subscription
1470 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1471 biblionumber, startdate, periodicity, numberlength, weeklength,
1472 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1473 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1474 irregularity, numberpattern, locale, callnumber,
1475 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1476 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1477 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1479 my $sth = $dbh->prepare($query);
1481 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1482 $startdate, $periodicity, $numberlength, $weeklength,
1483 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1484 $lastvalue3, $innerloop3, $status, $notes, $letter,
1485 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1486 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1487 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1490 my $subscriptionid = $dbh->{'mysql_insertid'};
1492 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1496 WHERE subscriptionid=?
1498 $sth = $dbh->prepare($query);
1499 $sth->execute( $enddate, $subscriptionid );
1502 # then create the 1st expected number
1504 INSERT INTO subscriptionhistory
1505 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1508 $sth = $dbh->prepare($query);
1509 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1511 # reread subscription to get a hash (for calculation of the 1st issue number)
1512 my $subscription = GetSubscription($subscriptionid);
1513 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1515 # calculate issue number
1516 my $serialseq = GetSeq($subscription, $pattern);
1519 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1520 VALUES (?,?,?,?,?,?)
1522 $sth = $dbh->prepare($query);
1523 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1525 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1527 #set serial flag on biblio if not already set.
1528 my $bib = GetBiblio($biblionumber);
1529 if ( $bib and !$bib->{'serial'} ) {
1530 my $record = GetMarcBiblio($biblionumber);
1531 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1533 eval { $record->field($tag)->update( $subf => 1 ); };
1535 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1537 return $subscriptionid;
1540 =head2 ReNewSubscription
1542 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1544 this function renew a subscription with values given on input args.
1548 sub ReNewSubscription {
1549 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1550 my $dbh = C4::Context->dbh;
1551 my $subscription = GetSubscription($subscriptionid);
1555 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1556 WHERE biblio.biblionumber=?
1558 my $sth = $dbh->prepare($query);
1559 $sth->execute( $subscription->{biblionumber} );
1560 my $biblio = $sth->fetchrow_hashref;
1562 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1563 require C4::Suggestions;
1564 C4::Suggestions::NewSuggestion(
1565 { 'suggestedby' => $user,
1566 'title' => $subscription->{bibliotitle},
1567 'author' => $biblio->{author},
1568 'publishercode' => $biblio->{publishercode},
1569 'note' => $biblio->{note},
1570 'biblionumber' => $subscription->{biblionumber}
1575 # renew subscription
1578 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1579 WHERE subscriptionid=?
1581 $sth = $dbh->prepare($query);
1582 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1583 my $enddate = GetExpirationDate($subscriptionid);
1584 $debug && warn "enddate :$enddate";
1588 WHERE subscriptionid=?
1590 $sth = $dbh->prepare($query);
1591 $sth->execute( $enddate, $subscriptionid );
1593 UPDATE subscriptionhistory
1595 WHERE subscriptionid=?
1597 $sth = $dbh->prepare($query);
1598 $sth->execute( $enddate, $subscriptionid );
1600 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1606 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1608 Create a new issue stored on the database.
1609 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1610 returns the serial id
1615 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1616 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1618 return unless ($subscriptionid);
1620 my $dbh = C4::Context->dbh;
1623 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1624 VALUES (?,?,?,?,?,?,?)
1626 my $sth = $dbh->prepare($query);
1627 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1628 my $serialid = $dbh->{'mysql_insertid'};
1630 SELECT missinglist,recievedlist
1631 FROM subscriptionhistory
1632 WHERE subscriptionid=?
1634 $sth = $dbh->prepare($query);
1635 $sth->execute($subscriptionid);
1636 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1638 if ( $status == 2 ) {
1639 ### TODO Add a feature that improves recognition and description.
1640 ### As such count (serialseq) i.e. : N18,2(N19),N20
1641 ### Would use substr and index But be careful to previous presence of ()
1642 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1644 if ( $status == 4 ) {
1645 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1648 UPDATE subscriptionhistory
1649 SET recievedlist=?, missinglist=?
1650 WHERE subscriptionid=?
1652 $sth = $dbh->prepare($query);
1653 $recievedlist =~ s/^; //;
1654 $missinglist =~ s/^; //;
1655 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1659 =head2 ItemizeSerials
1661 ItemizeSerials($serialid, $info);
1662 $info is a hashref containing barcode branch, itemcallnumber, status, location
1663 $serialid the serialid
1665 1 if the itemize is a succes.
1666 0 and @error otherwise. @error containts the list of errors found.
1670 sub ItemizeSerials {
1671 my ( $serialid, $info ) = @_;
1673 return unless ($serialid);
1675 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1677 my $dbh = C4::Context->dbh;
1683 my $sth = $dbh->prepare($query);
1684 $sth->execute($serialid);
1685 my $data = $sth->fetchrow_hashref;
1686 if ( C4::Context->preference("RoutingSerials") ) {
1688 # check for existing biblioitem relating to serial issue
1689 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1691 for ( my $i = 0 ; $i < $count ; $i++ ) {
1692 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1693 $bibitemno = $results[$i]->{'biblioitemnumber'};
1697 if ( $bibitemno == 0 ) {
1698 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1699 $sth->execute( $data->{'biblionumber'} );
1700 my $biblioitem = $sth->fetchrow_hashref;
1701 $biblioitem->{'volumedate'} = $data->{planneddate};
1702 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1703 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1707 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1708 if ( $info->{barcode} ) {
1710 if ( is_barcode_in_use( $info->{barcode} ) ) {
1711 push @errors, 'barcode_not_unique';
1713 my $marcrecord = MARC::Record->new();
1714 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1715 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1716 $marcrecord->insert_fields_ordered($newField);
1717 if ( $info->{branch} ) {
1718 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1720 #warn "items.homebranch : $tag , $subfield";
1721 if ( $marcrecord->field($tag) ) {
1722 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1724 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1725 $marcrecord->insert_fields_ordered($newField);
1727 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1729 #warn "items.holdingbranch : $tag , $subfield";
1730 if ( $marcrecord->field($tag) ) {
1731 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1733 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1734 $marcrecord->insert_fields_ordered($newField);
1737 if ( $info->{itemcallnumber} ) {
1738 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1740 if ( $marcrecord->field($tag) ) {
1741 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1743 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1744 $marcrecord->insert_fields_ordered($newField);
1747 if ( $info->{notes} ) {
1748 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1750 if ( $marcrecord->field($tag) ) {
1751 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1753 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1754 $marcrecord->insert_fields_ordered($newField);
1757 if ( $info->{location} ) {
1758 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1760 if ( $marcrecord->field($tag) ) {
1761 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1763 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1764 $marcrecord->insert_fields_ordered($newField);
1767 if ( $info->{status} ) {
1768 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1770 if ( $marcrecord->field($tag) ) {
1771 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1773 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1774 $marcrecord->insert_fields_ordered($newField);
1777 if ( C4::Context->preference("RoutingSerials") ) {
1778 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1779 if ( $marcrecord->field($tag) ) {
1780 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1782 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1783 $marcrecord->insert_fields_ordered($newField);
1787 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1790 return ( 0, @errors );
1794 =head2 HasSubscriptionStrictlyExpired
1796 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1798 the subscription has stricly expired when today > the end subscription date
1801 1 if true, 0 if false, -1 if the expiration date is not set.
1805 sub HasSubscriptionStrictlyExpired {
1807 # Getting end of subscription date
1808 my ($subscriptionid) = @_;
1810 return unless ($subscriptionid);
1812 my $dbh = C4::Context->dbh;
1813 my $subscription = GetSubscription($subscriptionid);
1814 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1816 # If the expiration date is set
1817 if ( $expirationdate != 0 ) {
1818 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1820 # Getting today's date
1821 my ( $nowyear, $nowmonth, $nowday ) = Today();
1823 # if today's date > expiration date, then the subscription has stricly expired
1824 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1831 # There are some cases where the expiration date is not set
1832 # As we can't determine if the subscription has expired on a date-basis,
1838 =head2 HasSubscriptionExpired
1840 $has_expired = HasSubscriptionExpired($subscriptionid)
1842 the subscription has expired when the next issue to arrive is out of subscription limit.
1845 0 if the subscription has not expired
1846 1 if the subscription has expired
1847 2 if has subscription does not have a valid expiration date set
1851 sub HasSubscriptionExpired {
1852 my ($subscriptionid) = @_;
1854 return unless ($subscriptionid);
1856 my $dbh = C4::Context->dbh;
1857 my $subscription = GetSubscription($subscriptionid);
1858 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1859 if ( $frequency and $frequency->{unit} ) {
1860 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1861 if (!defined $expirationdate) {
1862 $expirationdate = q{};
1865 SELECT max(planneddate)
1867 WHERE subscriptionid=?
1869 my $sth = $dbh->prepare($query);
1870 $sth->execute($subscriptionid);
1871 my ($res) = $sth->fetchrow;
1872 if (!$res || $res=~m/^0000/) {
1875 my @res = split( /-/, $res );
1876 my @endofsubscriptiondate = split( /-/, $expirationdate );
1877 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1879 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1884 if ( $subscription->{'numberlength'} ) {
1885 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1886 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1892 return 0; # Notice that you'll never get here.
1895 =head2 SetDistributedto
1897 SetDistributedto($distributedto,$subscriptionid);
1898 This function update the value of distributedto for a subscription given on input arg.
1902 sub SetDistributedto {
1903 my ( $distributedto, $subscriptionid ) = @_;
1904 my $dbh = C4::Context->dbh;
1908 WHERE subscriptionid=?
1910 my $sth = $dbh->prepare($query);
1911 $sth->execute( $distributedto, $subscriptionid );
1915 =head2 DelSubscription
1917 DelSubscription($subscriptionid)
1918 this function deletes subscription which has $subscriptionid as id.
1922 sub DelSubscription {
1923 my ($subscriptionid) = @_;
1924 my $dbh = C4::Context->dbh;
1925 $subscriptionid = $dbh->quote($subscriptionid);
1926 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1927 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1928 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1930 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1935 DelIssue($serialseq,$subscriptionid)
1936 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1938 returns the number of rows affected
1943 my ($dataissue) = @_;
1944 my $dbh = C4::Context->dbh;
1945 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1950 AND subscriptionid= ?
1952 my $mainsth = $dbh->prepare($query);
1953 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1955 #Delete element from subscription history
1956 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1957 my $sth = $dbh->prepare($query);
1958 $sth->execute( $dataissue->{'subscriptionid'} );
1959 my $val = $sth->fetchrow_hashref;
1960 unless ( $val->{manualhistory} ) {
1962 SELECT * FROM subscriptionhistory
1963 WHERE subscriptionid= ?
1965 my $sth = $dbh->prepare($query);
1966 $sth->execute( $dataissue->{'subscriptionid'} );
1967 my $data = $sth->fetchrow_hashref;
1968 my $serialseq = $dataissue->{'serialseq'};
1969 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1970 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1971 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1972 $sth = $dbh->prepare($strsth);
1973 $sth->execute( $dataissue->{'subscriptionid'} );
1976 return $mainsth->rows;
1979 =head2 GetLateOrMissingIssues
1981 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1983 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1986 the issuelist as an array of hash refs. Each element of this array contains
1987 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1991 sub GetLateOrMissingIssues {
1992 my ( $supplierid, $serialid, $order ) = @_;
1994 return unless ( $supplierid or $serialid );
1996 my $dbh = C4::Context->dbh;
2000 $byserial = "and serialid = " . $serialid;
2003 $order .= ", title";
2008 $sth = $dbh->prepare(
2010 serialid, aqbooksellerid, name,
2011 biblio.title, planneddate, serialseq,
2012 serial.status, serial.subscriptionid, claimdate,
2013 subscription.branchcode
2015 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
2016 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
2017 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2018 WHERE subscription.subscriptionid = serial.subscriptionid
2019 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2020 AND subscription.aqbooksellerid=$supplierid
2025 $sth = $dbh->prepare(
2027 serialid, aqbooksellerid, name,
2028 biblio.title, planneddate, serialseq,
2029 serial.status, serial.subscriptionid, claimdate,
2030 subscription.branchcode
2032 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
2033 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
2034 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2035 WHERE subscription.subscriptionid = serial.subscriptionid
2036 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2043 while ( my $line = $sth->fetchrow_hashref ) {
2045 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
2046 $line->{planneddate} = format_date( $line->{planneddate} );
2048 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
2049 $line->{claimdate} = format_date( $line->{claimdate} );
2051 $line->{"status".$line->{status}} = 1;
2052 push @issuelist, $line;
2057 =head2 removeMissingIssue
2059 removeMissingIssue($subscriptionid)
2061 this function removes an issue from being part of the missing string in
2062 subscriptionlist.missinglist column
2064 called when a missing issue is found from the serials-recieve.pl file
2068 sub removeMissingIssue {
2069 my ( $sequence, $subscriptionid ) = @_;
2071 return unless ($sequence and $subscriptionid);
2073 my $dbh = C4::Context->dbh;
2074 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2075 $sth->execute($subscriptionid);
2076 my $data = $sth->fetchrow_hashref;
2077 my $missinglist = $data->{'missinglist'};
2078 my $missinglistbefore = $missinglist;
2080 # warn $missinglist." before";
2081 $missinglist =~ s/($sequence)//;
2083 # warn $missinglist." after";
2084 if ( $missinglist ne $missinglistbefore ) {
2085 $missinglist =~ s/\|\s\|/\|/g;
2086 $missinglist =~ s/^\| //g;
2087 $missinglist =~ s/\|$//g;
2088 my $sth2 = $dbh->prepare(
2089 "UPDATE subscriptionhistory
2091 WHERE subscriptionid = ?"
2093 $sth2->execute( $missinglist, $subscriptionid );
2100 &updateClaim($serialid)
2102 this function updates the time when a claim is issued for late/missing items
2104 called from claims.pl file
2109 my ($serialid) = @_;
2110 my $dbh = C4::Context->dbh;
2111 my $sth = $dbh->prepare(
2112 "UPDATE serial SET claimdate = now()
2116 $sth->execute($serialid);
2120 =head2 getsupplierbyserialid
2122 $result = getsupplierbyserialid($serialid)
2124 this function is used to find the supplier id given a serial id
2127 hashref containing serialid, subscriptionid, and aqbooksellerid
2131 sub getsupplierbyserialid {
2132 my ($serialid) = @_;
2133 my $dbh = C4::Context->dbh;
2134 my $sth = $dbh->prepare(
2135 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2137 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2141 $sth->execute($serialid);
2142 my $line = $sth->fetchrow_hashref;
2143 my $result = $line->{'aqbooksellerid'};
2147 =head2 check_routing
2149 $result = &check_routing($subscriptionid)
2151 this function checks to see if a serial has a routing list and returns the count of routingid
2152 used to show either an 'add' or 'edit' link
2157 my ($subscriptionid) = @_;
2159 return unless ($subscriptionid);
2161 my $dbh = C4::Context->dbh;
2162 my $sth = $dbh->prepare(
2163 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2164 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2165 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2168 $sth->execute($subscriptionid);
2169 my $line = $sth->fetchrow_hashref;
2170 my $result = $line->{'routingids'};
2174 =head2 addroutingmember
2176 addroutingmember($borrowernumber,$subscriptionid)
2178 this function takes a borrowernumber and subscriptionid and adds the member to the
2179 routing list for that serial subscription and gives them a rank on the list
2180 of either 1 or highest current rank + 1
2184 sub addroutingmember {
2185 my ( $borrowernumber, $subscriptionid ) = @_;
2187 return unless ($borrowernumber and $subscriptionid);
2190 my $dbh = C4::Context->dbh;
2191 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2192 $sth->execute($subscriptionid);
2193 while ( my $line = $sth->fetchrow_hashref ) {
2194 if ( $line->{'rank'} > 0 ) {
2195 $rank = $line->{'rank'} + 1;
2200 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2201 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2204 =head2 reorder_members
2206 reorder_members($subscriptionid,$routingid,$rank)
2208 this function is used to reorder the routing list
2210 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2211 - it gets all members on list puts their routingid's into an array
2212 - removes the one in the array that is $routingid
2213 - then reinjects $routingid at point indicated by $rank
2214 - then update the database with the routingids in the new order
2218 sub reorder_members {
2219 my ( $subscriptionid, $routingid, $rank ) = @_;
2220 my $dbh = C4::Context->dbh;
2221 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2222 $sth->execute($subscriptionid);
2224 while ( my $line = $sth->fetchrow_hashref ) {
2225 push( @result, $line->{'routingid'} );
2228 # To find the matching index
2230 my $key = -1; # to allow for 0 being a valid response
2231 for ( $i = 0 ; $i < @result ; $i++ ) {
2232 if ( $routingid == $result[$i] ) {
2233 $key = $i; # save the index
2238 # if index exists in array then move it to new position
2239 if ( $key > -1 && $rank > 0 ) {
2240 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2241 my $moving_item = splice( @result, $key, 1 );
2242 splice( @result, $new_rank, 0, $moving_item );
2244 for ( my $j = 0 ; $j < @result ; $j++ ) {
2245 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2251 =head2 delroutingmember
2253 delroutingmember($routingid,$subscriptionid)
2255 this function either deletes one member from routing list if $routingid exists otherwise
2256 deletes all members from the routing list
2260 sub delroutingmember {
2262 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2263 my ( $routingid, $subscriptionid ) = @_;
2264 my $dbh = C4::Context->dbh;
2266 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2267 $sth->execute($routingid);
2268 reorder_members( $subscriptionid, $routingid );
2270 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2271 $sth->execute($subscriptionid);
2276 =head2 getroutinglist
2278 @routinglist = getroutinglist($subscriptionid)
2280 this gets the info from the subscriptionroutinglist for $subscriptionid
2283 the routinglist as an array. Each element of the array contains a hash_ref containing
2284 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2288 sub getroutinglist {
2289 my ($subscriptionid) = @_;
2290 my $dbh = C4::Context->dbh;
2291 my $sth = $dbh->prepare(
2292 'SELECT routingid, borrowernumber, ranking, biblionumber
2294 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2295 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2297 $sth->execute($subscriptionid);
2298 my $routinglist = $sth->fetchall_arrayref({});
2299 return @{$routinglist};
2302 =head2 countissuesfrom
2304 $result = countissuesfrom($subscriptionid,$startdate)
2306 Returns a count of serial rows matching the given subsctiptionid
2307 with published date greater than startdate
2311 sub countissuesfrom {
2312 my ( $subscriptionid, $startdate ) = @_;
2313 my $dbh = C4::Context->dbh;
2317 WHERE subscriptionid=?
2318 AND serial.publisheddate>?
2320 my $sth = $dbh->prepare($query);
2321 $sth->execute( $subscriptionid, $startdate );
2322 my ($countreceived) = $sth->fetchrow;
2323 return $countreceived;
2328 $result = CountIssues($subscriptionid)
2330 Returns a count of serial rows matching the given subsctiptionid
2335 my ($subscriptionid) = @_;
2336 my $dbh = C4::Context->dbh;
2340 WHERE subscriptionid=?
2342 my $sth = $dbh->prepare($query);
2343 $sth->execute($subscriptionid);
2344 my ($countreceived) = $sth->fetchrow;
2345 return $countreceived;
2350 $result = HasItems($subscriptionid)
2352 returns a count of items from serial matching the subscriptionid
2357 my ($subscriptionid) = @_;
2358 my $dbh = C4::Context->dbh;
2360 SELECT COUNT(serialitems.itemnumber)
2362 LEFT JOIN serialitems USING(serialid)
2363 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2365 my $sth=$dbh->prepare($query);
2366 $sth->execute($subscriptionid);
2367 my ($countitems)=$sth->fetchrow_array();
2371 =head2 abouttoexpire
2373 $result = abouttoexpire($subscriptionid)
2375 this function alerts you to the penultimate issue for a serial subscription
2377 returns 1 - if this is the penultimate issue
2383 my ($subscriptionid) = @_;
2384 my $dbh = C4::Context->dbh;
2385 my $subscription = GetSubscription($subscriptionid);
2386 my $per = $subscription->{'periodicity'};
2387 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2388 if ($frequency and $frequency->{unit}){
2389 my $expirationdate = GetExpirationDate($subscriptionid);
2390 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2391 my $nextdate = GetNextDate($subscription, $res);
2392 if(Date::Calc::Delta_Days(
2393 split( /-/, $nextdate ),
2394 split( /-/, $expirationdate )
2398 } elsif ($subscription->{numberlength}>0) {
2399 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2404 sub in_array { # used in next sub down
2405 my ( $val, @elements ) = @_;
2406 foreach my $elem (@elements) {
2407 if ( $val == $elem ) {
2414 =head2 GetSubscriptionsFromBorrower
2416 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2418 this gets the info from subscriptionroutinglist for each $subscriptionid
2421 a count of the serial subscription routing lists to which a patron belongs,
2422 with the titles of those serial subscriptions as an array. Each element of the array
2423 contains a hash_ref with subscriptionID and title of subscription.
2427 sub GetSubscriptionsFromBorrower {
2428 my ($borrowernumber) = @_;
2429 my $dbh = C4::Context->dbh;
2430 my $sth = $dbh->prepare(
2431 "SELECT subscription.subscriptionid, biblio.title
2433 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2434 JOIN subscriptionroutinglist USING (subscriptionid)
2435 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2438 $sth->execute($borrowernumber);
2441 while ( my $line = $sth->fetchrow_hashref ) {
2443 push( @routinglist, $line );
2445 return ( $count, @routinglist );
2449 =head2 GetFictiveIssueNumber
2451 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2453 Get the position of the issue published at $publisheddate, considering the
2454 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2455 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2456 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2457 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2458 depending on how many rows are in serial table.
2459 The issue number calculation is based on subscription frequency, first acquisition
2460 date, and $publisheddate.
2464 sub GetFictiveIssueNumber {
2465 my ($subscription, $publisheddate) = @_;
2467 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2468 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2472 my ($year, $month, $day) = split /-/, $publisheddate;
2473 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2477 if($unit eq 'day') {
2478 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2479 } elsif($unit eq 'week') {
2480 ($wkno, $year) = Week_of_Year($year, $month, $day);
2481 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2482 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2483 } elsif($unit eq 'month') {
2484 $delta = ($fa_year == $year)
2485 ? ($month - $fa_month)
2486 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2487 } elsif($unit eq 'year') {
2488 $delta = $year - $fa_year;
2490 if($frequency->{'unitsperissue'} == 1) {
2491 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2493 # Assuming issuesperunit == 1
2494 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2502 $resultdate = GetNextDate($publisheddate,$subscription)
2504 this function it takes the publisheddate and will return the next issue's date
2505 and will skip dates if there exists an irregularity.
2506 $publisheddate has to be an ISO date
2507 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2508 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2509 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2510 skipped then the returned date will be 2007-05-10
2513 $resultdate - then next date in the sequence (ISO date)
2515 Return $publisheddate if subscription is irregular
2520 my ( $subscription, $publisheddate, $updatecount ) = @_;
2522 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2524 if ($freqdata->{'unit'}) {
2525 my ( $year, $month, $day ) = split /-/, $publisheddate;
2527 # Process an irregularity Hash
2528 # Suppose that irregularities are stored in a string with this structure
2529 # irreg1;irreg2;irreg3
2530 # where irregX is the number of issue which will not be received
2531 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2532 my @irreg = split /;/, $subscription->{'irregularity'} ;
2534 foreach my $irregularity (@irreg) {
2535 $irregularities{$irregularity} = 1;
2538 # Get the 'fictive' next issue number
2539 # It is used to check if next issue is an irregular issue.
2540 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2542 # Then get the next date
2543 my $unit = lc $freqdata->{'unit'};
2544 if ($unit eq 'day') {
2545 while ($irregularities{$issueno}) {
2546 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2547 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
2548 $subscription->{'countissuesperunit'} = 1;
2550 $subscription->{'countissuesperunit'}++;
2554 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2555 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
2556 $subscription->{'countissuesperunit'} = 1;
2558 $subscription->{'countissuesperunit'}++;
2561 elsif ($unit eq 'week') {
2562 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2563 while ($irregularities{$issueno}) {
2564 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2565 $subscription->{'countissuesperunit'} = 1;
2566 $wkno += $freqdata->{"unitsperissue"};
2571 my $dow = Day_of_Week($year, $month, $day);
2572 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2573 if($freqdata->{'issuesperunit'} == 1) {
2574 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2577 $subscription->{'countissuesperunit'}++;
2581 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2582 $subscription->{'countissuesperunit'} = 1;
2583 $wkno += $freqdata->{"unitsperissue"};
2585 $wkno = $wkno % 52 ;
2588 my $dow = Day_of_Week($year, $month, $day);
2589 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2590 if($freqdata->{'issuesperunit'} == 1) {
2591 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2594 $subscription->{'countissuesperunit'}++;
2597 elsif ($unit eq 'month') {
2598 while ($irregularities{$issueno}) {
2599 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2600 $subscription->{'countissuesperunit'} = 1;
2601 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2602 unless($freqdata->{'issuesperunit'} == 1) {
2603 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2606 $subscription->{'countissuesperunit'}++;
2610 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2611 $subscription->{'countissuesperunit'} = 1;
2612 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2613 unless($freqdata->{'issuesperunit'} == 1) {
2614 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2617 $subscription->{'countissuesperunit'}++;
2620 elsif ($unit eq 'year') {
2621 while ($irregularities{$issueno}) {
2622 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2623 $subscription->{'countissuesperunit'} = 1;
2624 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2625 unless($freqdata->{'issuesperunit'} == 1) {
2626 # Jumping to the first day of year, because we don't know what day is expected
2631 $subscription->{'countissuesperunit'}++;
2635 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2636 $subscription->{'countissuesperunit'} = 1;
2637 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2638 unless($freqdata->{'issuesperunit'} == 1) {
2639 # Jumping to the first day of year, because we don't know what day is expected
2644 $subscription->{'countissuesperunit'}++;
2648 my $dbh = C4::Context->dbh;
2651 SET countissuesperunit = ?
2652 WHERE subscriptionid = ?
2654 my $sth = $dbh->prepare($query);
2655 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2657 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2660 return $publisheddate;
2666 $string = &_numeration($value,$num_type,$locale);
2668 _numeration returns the string corresponding to $value in the num_type
2678 my ($value, $num_type, $locale) = @_;
2680 my $initlocale = setlocale(LC_TIME);
2681 if($locale and $locale ne $initlocale) {
2682 $locale = setlocale(LC_TIME, $locale);
2684 $locale ||= $initlocale;
2688 when (/^dayname$/) {
2689 $value = $value % 7;
2690 $string = POSIX::strftime("%A",0,0,0,0,0,0,$value);
2692 when (/^monthname$/) {
2693 $value = $value % 12;
2694 $string = POSIX::strftime("%B",0,0,0,1,$value,0,0,0,0);
2697 my $seasonlocale = ($locale)
2698 ? (substr $locale,0,2)
2702 [qw(Spring Summer Fall Winter)],
2704 [qw(Printemps Été Automne Hiver)],
2706 $value = $value % 4;
2707 $string = ($seasons{$seasonlocale})
2708 ? $seasons{$seasonlocale}->[$value]
2709 : $seasons{'en'}->[$value];
2715 if($locale ne $initlocale) {
2716 setlocale(LC_TIME, $initlocale);
2721 =head2 is_barcode_in_use
2723 Returns number of occurence of the barcode in the items table
2724 Can be used as a boolean test of whether the barcode has
2725 been deployed as yet
2729 sub is_barcode_in_use {
2730 my $barcode = shift;
2731 my $dbh = C4::Context->dbh;
2732 my $occurences = $dbh->selectall_arrayref(
2733 'SELECT itemnumber from items where barcode = ?',
2738 return @{$occurences};
2741 =head2 CloseSubscription
2742 Close a subscription given a subscriptionid
2744 sub CloseSubscription {
2745 my ( $subscriptionid ) = @_;
2746 return unless $subscriptionid;
2747 my $dbh = C4::Context->dbh;
2748 my $sth = $dbh->prepare( qq{
2751 WHERE subscriptionid = ?
2753 $sth->execute( $subscriptionid );
2755 # Set status = missing when status = stopped
2756 $sth = $dbh->prepare( qq{
2759 WHERE subscriptionid = ?
2762 $sth->execute( $subscriptionid );
2765 =head2 ReopenSubscription
2766 Reopen a subscription given a subscriptionid
2768 sub ReopenSubscription {
2769 my ( $subscriptionid ) = @_;
2770 return unless $subscriptionid;
2771 my $dbh = C4::Context->dbh;
2772 my $sth = $dbh->prepare( qq{
2775 WHERE subscriptionid = ?
2777 $sth->execute( $subscriptionid );
2779 # Set status = expected when status = stopped
2780 $sth = $dbh->prepare( qq{
2783 WHERE subscriptionid = ?
2786 $sth->execute( $subscriptionid );
2789 =head2 subscriptionCurrentlyOnOrder
2791 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2793 Return 1 if subscription is currently on order else 0.
2797 sub subscriptionCurrentlyOnOrder {
2798 my ( $subscriptionid ) = @_;
2799 my $dbh = C4::Context->dbh;
2801 SELECT COUNT(*) FROM aqorders
2802 WHERE subscriptionid = ?
2803 AND datereceived IS NULL
2804 AND datecancellationprinted IS NULL
2806 my $sth = $dbh->prepare( $query );
2807 $sth->execute($subscriptionid);
2808 return $sth->fetchrow_array;
2811 =head2 can_edit_subscription
2813 $can = can_edit_subscription( $subscriptionid[, $userid] );
2815 Return 1 if the subscription is editable by the current logged user (or a given $userid), else 0.
2819 sub can_edit_subscription {
2820 my ( $subscription, $userid ) = @_;
2821 return 0 unless C4::Context->userenv;
2822 my $flags = C4::Context->userenv->{flags};
2823 $userid ||= C4::Context->userenv->{'id'};
2824 my $independent_branches = C4::Context->preference('IndependentBranches');
2825 return 1 unless $independent_branches;
2826 if( $flags % 2 == 1 # superlibrarian
2827 or C4::Auth::haspermission( $userid, {serials => 'superserials'}),
2828 or C4::Auth::haspermission( $userid, {serials => 'edit_subscription'}),
2829 or not defined $subscription->{branchcode}
2830 or $subscription->{branchcode} eq ''
2831 or $subscription->{branchcode} eq C4::Context->userenv->{'branch'}
2843 Koha Development Team <http://koha-community.org/>