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);
633 This function returns a list of hashrefs, one for each subscription
634 that meets the conditions specified by the $args hashref.
636 The valid search fields are:
650 The expiration_date search field is special; it specifies the maximum
651 subscription expiration date.
655 sub SearchSubscriptions {
660 subscription.notes AS publicnotes,
662 subscriptionhistory.*,
663 biblio.notes AS biblionotes,
668 LEFT JOIN subscriptionhistory USING(subscriptionid)
669 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
670 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
671 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
675 if( $args->{biblionumber} ) {
676 push @where_strs, "biblio.biblionumber = ?";
677 push @where_args, $args->{biblionumber};
679 if( $args->{title} ){
680 my @words = split / /, $args->{title};
682 foreach my $word (@words) {
683 push @strs, "biblio.title LIKE ?";
684 push @args, "%$word%";
687 push @where_strs, '(' . join (' AND ', @strs) . ')';
688 push @where_args, @args;
692 push @where_strs, "biblioitems.issn LIKE ?";
693 push @where_args, "%$args->{issn}%";
696 push @where_strs, "biblioitems.ean LIKE ?";
697 push @where_args, "%$args->{ean}%";
699 if ( $args->{callnumber} ) {
700 push @where_strs, "subscription.callnumber LIKE ?";
701 push @where_args, "%$args->{callnumber}%";
703 if( $args->{publisher} ){
704 push @where_strs, "biblioitems.publishercode LIKE ?";
705 push @where_args, "%$args->{publisher}%";
707 if( $args->{bookseller} ){
708 push @where_strs, "aqbooksellers.name LIKE ?";
709 push @where_args, "%$args->{bookseller}%";
711 if( $args->{branch} ){
712 push @where_strs, "subscription.branchcode = ?";
713 push @where_args, "$args->{branch}";
715 if ( $args->{location} ) {
716 push @where_strs, "subscription.location = ?";
717 push @where_args, "$args->{location}";
719 if ( $args->{expiration_date} ) {
720 push @where_strs, "subscription.enddate <= ?";
721 push @where_args, "$args->{expiration_date}";
723 if( defined $args->{closed} ){
724 push @where_strs, "subscription.closed = ?";
725 push @where_args, "$args->{closed}";
728 $query .= " WHERE " . join(" AND ", @where_strs);
731 my $dbh = C4::Context->dbh;
732 my $sth = $dbh->prepare($query);
733 $sth->execute(@where_args);
734 my $results = $sth->fetchall_arrayref( {} );
737 for my $subscription ( @$results ) {
738 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
739 $subscription->{cannotdisplay} =
740 ( C4::Context->preference("IndependentBranches") &&
741 C4::Context->userenv &&
742 $subscription->{branchcode} ne C4::Context->userenv->{'branch'} ) ? 1 : 0;
751 ($totalissues,@serials) = GetSerials($subscriptionid);
752 this function gets every serial not arrived for a given subscription
753 as well as the number of issues registered in the database (all types)
754 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
756 FIXME: We should return \@serials.
761 my ( $subscriptionid, $count ) = @_;
763 return unless $subscriptionid;
765 my $dbh = C4::Context->dbh;
767 # status = 2 is "arrived"
769 $count = 5 unless ($count);
771 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
773 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
774 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
775 my $sth = $dbh->prepare($query);
776 $sth->execute($subscriptionid);
778 while ( my $line = $sth->fetchrow_hashref ) {
779 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
780 for my $datefield ( qw( planneddate publisheddate) ) {
781 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
782 $line->{$datefield} = format_date( $line->{$datefield});
784 $line->{$datefield} = q{};
787 push @serials, $line;
790 # OK, now add the last 5 issues arrives/missing
791 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
793 WHERE subscriptionid = ?
794 AND (status in (2,4,5))
795 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
797 $sth = $dbh->prepare($query);
798 $sth->execute($subscriptionid);
799 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
801 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
802 for my $datefield ( qw( planneddate publisheddate) ) {
803 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
804 $line->{$datefield} = format_date( $line->{$datefield});
806 $line->{$datefield} = q{};
810 push @serials, $line;
813 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
814 $sth = $dbh->prepare($query);
815 $sth->execute($subscriptionid);
816 my ($totalissues) = $sth->fetchrow;
817 return ( $totalissues, @serials );
822 @serials = GetSerials2($subscriptionid,$status);
823 this function returns every serial waited for a given subscription
824 as well as the number of issues registered in the database (all types)
825 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
830 my ( $subscription, $status ) = @_;
832 return unless ($subscription and $status);
834 my $dbh = C4::Context->dbh;
836 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
838 WHERE subscriptionid=$subscription AND status IN ($status)
839 ORDER BY publisheddate,serialid DESC
841 $debug and warn "GetSerials2 query: $query";
842 my $sth = $dbh->prepare($query);
846 while ( my $line = $sth->fetchrow_hashref ) {
847 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
848 # Format dates for display
849 for my $datefield ( qw( planneddate publisheddate ) ) {
850 if ($line->{$datefield} =~m/^00/) {
851 $line->{$datefield} = q{};
854 $line->{$datefield} = format_date( $line->{$datefield} );
857 push @serials, $line;
862 =head2 GetLatestSerials
864 \@serials = GetLatestSerials($subscriptionid,$limit)
865 get the $limit's latest serials arrived or missing for a given subscription
867 a ref to an array which contains all of the latest serials stored into a hash.
871 sub GetLatestSerials {
872 my ( $subscriptionid, $limit ) = @_;
874 return unless ($subscriptionid and $limit);
876 my $dbh = C4::Context->dbh;
878 # status = 2 is "arrived"
879 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
881 WHERE subscriptionid = ?
882 AND (status =2 or status=4)
883 ORDER BY publisheddate DESC LIMIT 0,$limit
885 my $sth = $dbh->prepare($strsth);
886 $sth->execute($subscriptionid);
888 while ( my $line = $sth->fetchrow_hashref ) {
889 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
890 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
891 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
892 push @serials, $line;
898 =head2 GetDistributedTo
900 $distributedto=GetDistributedTo($subscriptionid)
901 This function returns the field distributedto for the subscription matching subscriptionid
905 sub GetDistributedTo {
906 my $dbh = C4::Context->dbh;
908 my ($subscriptionid) = @_;
910 return unless ($subscriptionid);
912 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
913 my $sth = $dbh->prepare($query);
914 $sth->execute($subscriptionid);
915 return ($distributedto) = $sth->fetchrow;
921 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
922 $newinnerloop1, $newinnerloop2, $newinnerloop3
923 ) = GetNextSeq( $subscription, $pattern, $planneddate );
925 $subscription is a hashref containing all the attributes of the table
927 $pattern is a hashref containing all the attributes of the table
928 'subscription_numberpatterns'.
929 $planneddate is a C4::Dates object.
930 This function get the next issue for the subscription given on input arg
935 my ($subscription, $pattern, $planneddate) = @_;
937 return unless ($subscription and $pattern);
939 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
940 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
943 if ($subscription->{'skip_serialseq'}) {
944 my @irreg = split /;/, $subscription->{'irregularity'};
946 my $irregularities = {};
947 $irregularities->{$_} = 1 foreach(@irreg);
948 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
949 while($irregularities->{$issueno}) {
956 my $numberingmethod = $pattern->{numberingmethod};
958 if ($numberingmethod) {
959 $calculated = $numberingmethod;
960 my $locale = $subscription->{locale};
961 $newlastvalue1 = $subscription->{lastvalue1} || 0;
962 $newlastvalue2 = $subscription->{lastvalue2} || 0;
963 $newlastvalue3 = $subscription->{lastvalue3} || 0;
964 $newinnerloop1 = $subscription->{innerloop1} || 0;
965 $newinnerloop2 = $subscription->{innerloop2} || 0;
966 $newinnerloop3 = $subscription->{innerloop3} || 0;
969 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
972 for(my $i = 0; $i < $count; $i++) {
974 # check if we have to increase the new value.
976 if ($newinnerloop1 >= $pattern->{every1}) {
978 $newlastvalue1 += $pattern->{add1};
980 # reset counter if needed.
981 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
984 # check if we have to increase the new value.
986 if ($newinnerloop2 >= $pattern->{every2}) {
988 $newlastvalue2 += $pattern->{add2};
990 # reset counter if needed.
991 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
994 # check if we have to increase the new value.
996 if ($newinnerloop3 >= $pattern->{every3}) {
998 $newlastvalue3 += $pattern->{add3};
1000 # reset counter if needed.
1001 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
1005 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
1006 $calculated =~ s/\{X\}/$newlastvalue1string/g;
1009 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
1010 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
1013 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
1014 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
1018 return ($calculated,
1019 $newlastvalue1, $newlastvalue2, $newlastvalue3,
1020 $newinnerloop1, $newinnerloop2, $newinnerloop3);
1025 $calculated = GetSeq($subscription, $pattern)
1026 $subscription is a hashref containing all the attributes of the table 'subscription'
1027 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
1028 this function transforms {X},{Y},{Z} to 150,0,0 for example.
1030 the sequence in string format
1035 my ($subscription, $pattern) = @_;
1037 return unless ($subscription and $pattern);
1039 my $locale = $subscription->{locale};
1041 my $calculated = $pattern->{numberingmethod};
1043 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
1044 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
1045 $calculated =~ s/\{X\}/$newlastvalue1/g;
1047 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1048 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1049 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1051 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1052 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1053 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1057 =head2 GetExpirationDate
1059 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1061 this function return the next expiration date for a subscription given on input args.
1064 the enddate or undef
1068 sub GetExpirationDate {
1069 my ( $subscriptionid, $startdate ) = @_;
1071 return unless ($subscriptionid);
1073 my $dbh = C4::Context->dbh;
1074 my $subscription = GetSubscription($subscriptionid);
1077 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1078 $enddate = $startdate || $subscription->{startdate};
1079 my @date = split( /-/, $enddate );
1080 return if ( scalar(@date) != 3 || not check_date(@date) );
1081 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1082 if ( $frequency and $frequency->{unit} ) {
1085 if ( my $length = $subscription->{numberlength} ) {
1087 #calculate the date of the last issue.
1088 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1089 $enddate = GetNextDate( $subscription, $enddate );
1091 } elsif ( $subscription->{monthlength} ) {
1092 if ( $$subscription{startdate} ) {
1093 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1094 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1096 } elsif ( $subscription->{weeklength} ) {
1097 if ( $$subscription{startdate} ) {
1098 my @date = split( /-/, $subscription->{startdate} );
1099 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1100 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1103 $enddate = $subscription->{enddate};
1107 return $subscription->{enddate};
1111 =head2 CountSubscriptionFromBiblionumber
1113 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1114 this returns a count of the subscriptions for a given biblionumber
1116 the number of subscriptions
1120 sub CountSubscriptionFromBiblionumber {
1121 my ($biblionumber) = @_;
1123 return unless ($biblionumber);
1125 my $dbh = C4::Context->dbh;
1126 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1127 my $sth = $dbh->prepare($query);
1128 $sth->execute($biblionumber);
1129 my $subscriptionsnumber = $sth->fetchrow;
1130 return $subscriptionsnumber;
1133 =head2 ModSubscriptionHistory
1135 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1137 this function modifies the history of a subscription. Put your new values on input arg.
1138 returns the number of rows affected
1142 sub ModSubscriptionHistory {
1143 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1145 return unless ($subscriptionid);
1147 my $dbh = C4::Context->dbh;
1148 my $query = "UPDATE subscriptionhistory
1149 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1150 WHERE subscriptionid=?
1152 my $sth = $dbh->prepare($query);
1153 $receivedlist =~ s/^; // if $receivedlist;
1154 $missinglist =~ s/^; // if $missinglist;
1155 $opacnote =~ s/^; // if $opacnote;
1156 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1160 # Update missinglist field, used by ModSerialStatus
1161 sub _update_missinglist {
1162 my $subscriptionid = shift;
1164 my $dbh = C4::Context->dbh;
1165 my @missingserials = GetSerials2($subscriptionid, "4,5");
1167 foreach (@missingserials) {
1168 if($_->{'status'} == 4) {
1169 $missinglist .= $_->{'serialseq'} . "; ";
1170 } elsif($_->{'status'} == 5) {
1171 $missinglist .= "not issued " . $_->{'serialseq'} . "; ";
1174 $missinglist =~ s/; $//;
1176 UPDATE subscriptionhistory
1178 WHERE subscriptionid = ?
1180 my $sth = $dbh->prepare($query);
1181 $sth->execute($missinglist, $subscriptionid);
1184 # Update recievedlist field, used by ModSerialStatus
1185 sub _update_receivedlist {
1186 my $subscriptionid = shift;
1188 my $dbh = C4::Context->dbh;
1189 my @receivedserials = GetSerials2($subscriptionid, "2");
1191 foreach (@receivedserials) {
1192 $receivedlist .= $_->{'serialseq'} . "; ";
1194 $receivedlist =~ s/; $//;
1196 UPDATE subscriptionhistory
1197 SET recievedlist = ?
1198 WHERE subscriptionid = ?
1200 my $sth = $dbh->prepare($query);
1201 $sth->execute($receivedlist, $subscriptionid);
1204 =head2 ModSerialStatus
1206 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1208 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1209 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1213 sub ModSerialStatus {
1214 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1216 return unless ($serialid);
1218 #It is a usual serial
1219 # 1st, get previous status :
1220 my $dbh = C4::Context->dbh;
1221 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1222 FROM serial, subscription
1223 WHERE serial.subscriptionid=subscription.subscriptionid
1225 my $sth = $dbh->prepare($query);
1226 $sth->execute($serialid);
1227 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1228 my $frequency = GetSubscriptionFrequency($periodicity);
1230 # change status & update subscriptionhistory
1232 if ( $status == 6 ) {
1233 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1236 unless ($frequency->{'unit'}) {
1237 if ( not $planneddate or $planneddate eq '0000-00-00' ) { $planneddate = C4::Dates->new()->output('iso') };
1238 if ( not $publisheddate or $publisheddate eq '0000-00-00' ) { $publisheddate = C4::Dates->new()->output('iso') };
1240 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1241 $sth = $dbh->prepare($query);
1242 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1243 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1244 $sth = $dbh->prepare($query);
1245 $sth->execute($subscriptionid);
1246 my $val = $sth->fetchrow_hashref;
1247 unless ( $val->{manualhistory} ) {
1248 if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) {
1249 _update_receivedlist($subscriptionid);
1251 if($status == 4 || $status == 5
1252 || ($oldstatus == 4 && $status != 4)
1253 || ($oldstatus == 5 && $status != 5)) {
1254 _update_missinglist($subscriptionid);
1259 # create new waited entry if needed (ie : was a "waited" and has changed)
1260 if ( $oldstatus == 1 && $status != 1 ) {
1261 my $subscription = GetSubscription($subscriptionid);
1262 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1266 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1267 $newinnerloop1, $newinnerloop2, $newinnerloop3
1269 = GetNextSeq( $subscription, $pattern, $publisheddate );
1271 # next date (calculated from actual date & frequency parameters)
1272 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1273 my $nextpubdate = $nextpublisheddate;
1274 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1275 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1276 WHERE subscriptionid = ?";
1277 $sth = $dbh->prepare($query);
1278 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1280 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1281 if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) {
1282 require C4::Letters;
1283 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1290 =head2 GetNextExpected
1292 $nextexpected = GetNextExpected($subscriptionid)
1294 Get the planneddate for the current expected issue of the subscription.
1300 planneddate => ISO date
1305 sub GetNextExpected {
1306 my ($subscriptionid) = @_;
1308 my $dbh = C4::Context->dbh;
1312 WHERE subscriptionid = ?
1316 my $sth = $dbh->prepare($query);
1318 # Each subscription has only one 'expected' issue, with serial.status==1.
1319 $sth->execute( $subscriptionid, 1 );
1320 my $nextissue = $sth->fetchrow_hashref;
1321 if ( !$nextissue ) {
1325 WHERE subscriptionid = ?
1326 ORDER BY publisheddate DESC
1329 $sth = $dbh->prepare($query);
1330 $sth->execute($subscriptionid);
1331 $nextissue = $sth->fetchrow_hashref;
1333 foreach(qw/planneddate publisheddate/) {
1334 if ( !defined $nextissue->{$_} ) {
1335 # or should this default to 1st Jan ???
1336 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1338 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1346 =head2 ModNextExpected
1348 ModNextExpected($subscriptionid,$date)
1350 Update the planneddate for the current expected issue of the subscription.
1351 This will modify all future prediction results.
1353 C<$date> is an ISO date.
1359 sub ModNextExpected {
1360 my ( $subscriptionid, $date ) = @_;
1361 my $dbh = C4::Context->dbh;
1363 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1364 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1366 # Each subscription has only one 'expected' issue, with serial.status==1.
1367 $sth->execute( $date, $date, $subscriptionid, 1 );
1372 =head2 GetSubscriptionIrregularities
1376 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1377 get the list of irregularities for a subscription
1383 sub GetSubscriptionIrregularities {
1384 my $subscriptionid = shift;
1386 return unless $subscriptionid;
1388 my $dbh = C4::Context->dbh;
1392 WHERE subscriptionid = ?
1394 my $sth = $dbh->prepare($query);
1395 $sth->execute($subscriptionid);
1397 my ($result) = $sth->fetchrow_array;
1398 my @irreg = split /;/, $result;
1403 =head2 ModSubscription
1405 this function modifies a subscription. Put all new values on input args.
1406 returns the number of rows affected
1410 sub ModSubscription {
1412 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1413 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1414 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1415 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1416 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1417 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1418 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1421 my $dbh = C4::Context->dbh;
1422 my $query = "UPDATE subscription
1423 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1424 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1425 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1426 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1427 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1428 callnumber=?, notes=?, letter=?, manualhistory=?,
1429 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1430 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1432 WHERE subscriptionid = ?";
1434 my $sth = $dbh->prepare($query);
1436 $auser, $branchcode, $aqbooksellerid, $cost,
1437 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1438 $irregularity, $numberpattern, $locale, $numberlength,
1439 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1440 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1441 $status, $biblionumber, $callnumber, $notes,
1442 $letter, ($manualhistory ? $manualhistory : 0),
1443 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1444 $graceperiod, $location, $enddate, $skip_serialseq,
1447 my $rows = $sth->rows;
1449 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1453 =head2 NewSubscription
1455 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1456 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1457 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1458 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1459 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1460 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1462 Create a new subscription with value given on input args.
1465 the id of this new subscription
1469 sub NewSubscription {
1471 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1472 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1473 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1474 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1475 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1476 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1477 $location, $enddate, $skip_serialseq
1479 my $dbh = C4::Context->dbh;
1481 #save subscription (insert into database)
1483 INSERT INTO subscription
1484 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1485 biblionumber, startdate, periodicity, numberlength, weeklength,
1486 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1487 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1488 irregularity, numberpattern, locale, callnumber,
1489 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1490 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1491 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1493 my $sth = $dbh->prepare($query);
1495 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1496 $startdate, $periodicity, $numberlength, $weeklength,
1497 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1498 $lastvalue3, $innerloop3, $status, $notes, $letter,
1499 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1500 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1501 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1504 my $subscriptionid = $dbh->{'mysql_insertid'};
1506 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1510 WHERE subscriptionid=?
1512 $sth = $dbh->prepare($query);
1513 $sth->execute( $enddate, $subscriptionid );
1516 # then create the 1st expected number
1518 INSERT INTO subscriptionhistory
1519 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1522 $sth = $dbh->prepare($query);
1523 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1525 # reread subscription to get a hash (for calculation of the 1st issue number)
1526 my $subscription = GetSubscription($subscriptionid);
1527 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1529 # calculate issue number
1530 my $serialseq = GetSeq($subscription, $pattern);
1533 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1534 VALUES (?,?,?,?,?,?)
1536 $sth = $dbh->prepare($query);
1537 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1539 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1541 #set serial flag on biblio if not already set.
1542 my $bib = GetBiblio($biblionumber);
1543 if ( $bib and !$bib->{'serial'} ) {
1544 my $record = GetMarcBiblio($biblionumber);
1545 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1547 eval { $record->field($tag)->update( $subf => 1 ); };
1549 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1551 return $subscriptionid;
1554 =head2 ReNewSubscription
1556 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1558 this function renew a subscription with values given on input args.
1562 sub ReNewSubscription {
1563 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1564 my $dbh = C4::Context->dbh;
1565 my $subscription = GetSubscription($subscriptionid);
1569 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1570 WHERE biblio.biblionumber=?
1572 my $sth = $dbh->prepare($query);
1573 $sth->execute( $subscription->{biblionumber} );
1574 my $biblio = $sth->fetchrow_hashref;
1576 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1577 require C4::Suggestions;
1578 C4::Suggestions::NewSuggestion(
1579 { 'suggestedby' => $user,
1580 'title' => $subscription->{bibliotitle},
1581 'author' => $biblio->{author},
1582 'publishercode' => $biblio->{publishercode},
1583 'note' => $biblio->{note},
1584 'biblionumber' => $subscription->{biblionumber}
1589 # renew subscription
1592 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1593 WHERE subscriptionid=?
1595 $sth = $dbh->prepare($query);
1596 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1597 my $enddate = GetExpirationDate($subscriptionid);
1598 $debug && warn "enddate :$enddate";
1602 WHERE subscriptionid=?
1604 $sth = $dbh->prepare($query);
1605 $sth->execute( $enddate, $subscriptionid );
1607 UPDATE subscriptionhistory
1609 WHERE subscriptionid=?
1611 $sth = $dbh->prepare($query);
1612 $sth->execute( $enddate, $subscriptionid );
1614 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1620 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1622 Create a new issue stored on the database.
1623 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1624 returns the serial id
1629 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1630 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1632 return unless ($subscriptionid);
1634 my $dbh = C4::Context->dbh;
1637 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1638 VALUES (?,?,?,?,?,?,?)
1640 my $sth = $dbh->prepare($query);
1641 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1642 my $serialid = $dbh->{'mysql_insertid'};
1644 SELECT missinglist,recievedlist
1645 FROM subscriptionhistory
1646 WHERE subscriptionid=?
1648 $sth = $dbh->prepare($query);
1649 $sth->execute($subscriptionid);
1650 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1652 if ( $status == 2 ) {
1653 ### TODO Add a feature that improves recognition and description.
1654 ### As such count (serialseq) i.e. : N18,2(N19),N20
1655 ### Would use substr and index But be careful to previous presence of ()
1656 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1658 if ( $status == 4 ) {
1659 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1662 UPDATE subscriptionhistory
1663 SET recievedlist=?, missinglist=?
1664 WHERE subscriptionid=?
1666 $sth = $dbh->prepare($query);
1667 $recievedlist =~ s/^; //;
1668 $missinglist =~ s/^; //;
1669 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1673 =head2 ItemizeSerials
1675 ItemizeSerials($serialid, $info);
1676 $info is a hashref containing barcode branch, itemcallnumber, status, location
1677 $serialid the serialid
1679 1 if the itemize is a succes.
1680 0 and @error otherwise. @error containts the list of errors found.
1684 sub ItemizeSerials {
1685 my ( $serialid, $info ) = @_;
1687 return unless ($serialid);
1689 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1691 my $dbh = C4::Context->dbh;
1697 my $sth = $dbh->prepare($query);
1698 $sth->execute($serialid);
1699 my $data = $sth->fetchrow_hashref;
1700 if ( C4::Context->preference("RoutingSerials") ) {
1702 # check for existing biblioitem relating to serial issue
1703 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1705 for ( my $i = 0 ; $i < $count ; $i++ ) {
1706 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1707 $bibitemno = $results[$i]->{'biblioitemnumber'};
1711 if ( $bibitemno == 0 ) {
1712 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1713 $sth->execute( $data->{'biblionumber'} );
1714 my $biblioitem = $sth->fetchrow_hashref;
1715 $biblioitem->{'volumedate'} = $data->{planneddate};
1716 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1717 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1721 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1722 if ( $info->{barcode} ) {
1724 if ( is_barcode_in_use( $info->{barcode} ) ) {
1725 push @errors, 'barcode_not_unique';
1727 my $marcrecord = MARC::Record->new();
1728 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1729 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1730 $marcrecord->insert_fields_ordered($newField);
1731 if ( $info->{branch} ) {
1732 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1734 #warn "items.homebranch : $tag , $subfield";
1735 if ( $marcrecord->field($tag) ) {
1736 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1738 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1739 $marcrecord->insert_fields_ordered($newField);
1741 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1743 #warn "items.holdingbranch : $tag , $subfield";
1744 if ( $marcrecord->field($tag) ) {
1745 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1747 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1748 $marcrecord->insert_fields_ordered($newField);
1751 if ( $info->{itemcallnumber} ) {
1752 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1754 if ( $marcrecord->field($tag) ) {
1755 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1757 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1758 $marcrecord->insert_fields_ordered($newField);
1761 if ( $info->{notes} ) {
1762 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1764 if ( $marcrecord->field($tag) ) {
1765 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1767 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1768 $marcrecord->insert_fields_ordered($newField);
1771 if ( $info->{location} ) {
1772 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1774 if ( $marcrecord->field($tag) ) {
1775 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1777 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1778 $marcrecord->insert_fields_ordered($newField);
1781 if ( $info->{status} ) {
1782 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1784 if ( $marcrecord->field($tag) ) {
1785 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1787 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1788 $marcrecord->insert_fields_ordered($newField);
1791 if ( C4::Context->preference("RoutingSerials") ) {
1792 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1793 if ( $marcrecord->field($tag) ) {
1794 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1796 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1797 $marcrecord->insert_fields_ordered($newField);
1801 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1804 return ( 0, @errors );
1808 =head2 HasSubscriptionStrictlyExpired
1810 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1812 the subscription has stricly expired when today > the end subscription date
1815 1 if true, 0 if false, -1 if the expiration date is not set.
1819 sub HasSubscriptionStrictlyExpired {
1821 # Getting end of subscription date
1822 my ($subscriptionid) = @_;
1824 return unless ($subscriptionid);
1826 my $dbh = C4::Context->dbh;
1827 my $subscription = GetSubscription($subscriptionid);
1828 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1830 # If the expiration date is set
1831 if ( $expirationdate != 0 ) {
1832 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1834 # Getting today's date
1835 my ( $nowyear, $nowmonth, $nowday ) = Today();
1837 # if today's date > expiration date, then the subscription has stricly expired
1838 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1845 # There are some cases where the expiration date is not set
1846 # As we can't determine if the subscription has expired on a date-basis,
1852 =head2 HasSubscriptionExpired
1854 $has_expired = HasSubscriptionExpired($subscriptionid)
1856 the subscription has expired when the next issue to arrive is out of subscription limit.
1859 0 if the subscription has not expired
1860 1 if the subscription has expired
1861 2 if has subscription does not have a valid expiration date set
1865 sub HasSubscriptionExpired {
1866 my ($subscriptionid) = @_;
1868 return unless ($subscriptionid);
1870 my $dbh = C4::Context->dbh;
1871 my $subscription = GetSubscription($subscriptionid);
1872 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1873 if ( $frequency and $frequency->{unit} ) {
1874 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1875 if (!defined $expirationdate) {
1876 $expirationdate = q{};
1879 SELECT max(planneddate)
1881 WHERE subscriptionid=?
1883 my $sth = $dbh->prepare($query);
1884 $sth->execute($subscriptionid);
1885 my ($res) = $sth->fetchrow;
1886 if (!$res || $res=~m/^0000/) {
1889 my @res = split( /-/, $res );
1890 my @endofsubscriptiondate = split( /-/, $expirationdate );
1891 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1893 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1898 if ( $subscription->{'numberlength'} ) {
1899 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1900 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1906 return 0; # Notice that you'll never get here.
1909 =head2 SetDistributedto
1911 SetDistributedto($distributedto,$subscriptionid);
1912 This function update the value of distributedto for a subscription given on input arg.
1916 sub SetDistributedto {
1917 my ( $distributedto, $subscriptionid ) = @_;
1918 my $dbh = C4::Context->dbh;
1922 WHERE subscriptionid=?
1924 my $sth = $dbh->prepare($query);
1925 $sth->execute( $distributedto, $subscriptionid );
1929 =head2 DelSubscription
1931 DelSubscription($subscriptionid)
1932 this function deletes subscription which has $subscriptionid as id.
1936 sub DelSubscription {
1937 my ($subscriptionid) = @_;
1938 my $dbh = C4::Context->dbh;
1939 $subscriptionid = $dbh->quote($subscriptionid);
1940 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1941 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1942 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1944 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1949 DelIssue($serialseq,$subscriptionid)
1950 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1952 returns the number of rows affected
1957 my ($dataissue) = @_;
1958 my $dbh = C4::Context->dbh;
1959 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1964 AND subscriptionid= ?
1966 my $mainsth = $dbh->prepare($query);
1967 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1969 #Delete element from subscription history
1970 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1971 my $sth = $dbh->prepare($query);
1972 $sth->execute( $dataissue->{'subscriptionid'} );
1973 my $val = $sth->fetchrow_hashref;
1974 unless ( $val->{manualhistory} ) {
1976 SELECT * FROM subscriptionhistory
1977 WHERE subscriptionid= ?
1979 my $sth = $dbh->prepare($query);
1980 $sth->execute( $dataissue->{'subscriptionid'} );
1981 my $data = $sth->fetchrow_hashref;
1982 my $serialseq = $dataissue->{'serialseq'};
1983 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1984 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1985 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1986 $sth = $dbh->prepare($strsth);
1987 $sth->execute( $dataissue->{'subscriptionid'} );
1990 return $mainsth->rows;
1993 =head2 GetLateOrMissingIssues
1995 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1997 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
2000 the issuelist as an array of hash refs. Each element of this array contains
2001 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
2005 sub GetLateOrMissingIssues {
2006 my ( $supplierid, $serialid, $order ) = @_;
2008 return unless ( $supplierid or $serialid );
2010 my $dbh = C4::Context->dbh;
2014 $byserial = "and serialid = " . $serialid;
2017 $order .= ", title";
2022 $sth = $dbh->prepare(
2024 serialid, aqbooksellerid, name,
2025 biblio.title, planneddate, serialseq,
2026 serial.status, serial.subscriptionid, claimdate,
2027 subscription.branchcode
2029 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
2030 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
2031 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2032 WHERE subscription.subscriptionid = serial.subscriptionid
2033 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2034 AND subscription.aqbooksellerid=$supplierid
2039 $sth = $dbh->prepare(
2041 serialid, aqbooksellerid, name,
2042 biblio.title, planneddate, serialseq,
2043 serial.status, serial.subscriptionid, claimdate,
2044 subscription.branchcode
2046 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
2047 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
2048 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2049 WHERE subscription.subscriptionid = serial.subscriptionid
2050 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
2057 while ( my $line = $sth->fetchrow_hashref ) {
2059 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
2060 $line->{planneddate} = format_date( $line->{planneddate} );
2062 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
2063 $line->{claimdate} = format_date( $line->{claimdate} );
2065 $line->{"status".$line->{status}} = 1;
2066 push @issuelist, $line;
2071 =head2 removeMissingIssue
2073 removeMissingIssue($subscriptionid)
2075 this function removes an issue from being part of the missing string in
2076 subscriptionlist.missinglist column
2078 called when a missing issue is found from the serials-recieve.pl file
2082 sub removeMissingIssue {
2083 my ( $sequence, $subscriptionid ) = @_;
2085 return unless ($sequence and $subscriptionid);
2087 my $dbh = C4::Context->dbh;
2088 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2089 $sth->execute($subscriptionid);
2090 my $data = $sth->fetchrow_hashref;
2091 my $missinglist = $data->{'missinglist'};
2092 my $missinglistbefore = $missinglist;
2094 # warn $missinglist." before";
2095 $missinglist =~ s/($sequence)//;
2097 # warn $missinglist." after";
2098 if ( $missinglist ne $missinglistbefore ) {
2099 $missinglist =~ s/\|\s\|/\|/g;
2100 $missinglist =~ s/^\| //g;
2101 $missinglist =~ s/\|$//g;
2102 my $sth2 = $dbh->prepare(
2103 "UPDATE subscriptionhistory
2105 WHERE subscriptionid = ?"
2107 $sth2->execute( $missinglist, $subscriptionid );
2114 &updateClaim($serialid)
2116 this function updates the time when a claim is issued for late/missing items
2118 called from claims.pl file
2123 my ($serialid) = @_;
2124 my $dbh = C4::Context->dbh;
2125 my $sth = $dbh->prepare(
2126 "UPDATE serial SET claimdate = now()
2130 $sth->execute($serialid);
2134 =head2 getsupplierbyserialid
2136 $result = getsupplierbyserialid($serialid)
2138 this function is used to find the supplier id given a serial id
2141 hashref containing serialid, subscriptionid, and aqbooksellerid
2145 sub getsupplierbyserialid {
2146 my ($serialid) = @_;
2147 my $dbh = C4::Context->dbh;
2148 my $sth = $dbh->prepare(
2149 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2151 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2155 $sth->execute($serialid);
2156 my $line = $sth->fetchrow_hashref;
2157 my $result = $line->{'aqbooksellerid'};
2161 =head2 check_routing
2163 $result = &check_routing($subscriptionid)
2165 this function checks to see if a serial has a routing list and returns the count of routingid
2166 used to show either an 'add' or 'edit' link
2171 my ($subscriptionid) = @_;
2173 return unless ($subscriptionid);
2175 my $dbh = C4::Context->dbh;
2176 my $sth = $dbh->prepare(
2177 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2178 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2179 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2182 $sth->execute($subscriptionid);
2183 my $line = $sth->fetchrow_hashref;
2184 my $result = $line->{'routingids'};
2188 =head2 addroutingmember
2190 addroutingmember($borrowernumber,$subscriptionid)
2192 this function takes a borrowernumber and subscriptionid and adds the member to the
2193 routing list for that serial subscription and gives them a rank on the list
2194 of either 1 or highest current rank + 1
2198 sub addroutingmember {
2199 my ( $borrowernumber, $subscriptionid ) = @_;
2201 return unless ($borrowernumber and $subscriptionid);
2204 my $dbh = C4::Context->dbh;
2205 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2206 $sth->execute($subscriptionid);
2207 while ( my $line = $sth->fetchrow_hashref ) {
2208 if ( $line->{'rank'} > 0 ) {
2209 $rank = $line->{'rank'} + 1;
2214 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2215 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2218 =head2 reorder_members
2220 reorder_members($subscriptionid,$routingid,$rank)
2222 this function is used to reorder the routing list
2224 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2225 - it gets all members on list puts their routingid's into an array
2226 - removes the one in the array that is $routingid
2227 - then reinjects $routingid at point indicated by $rank
2228 - then update the database with the routingids in the new order
2232 sub reorder_members {
2233 my ( $subscriptionid, $routingid, $rank ) = @_;
2234 my $dbh = C4::Context->dbh;
2235 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2236 $sth->execute($subscriptionid);
2238 while ( my $line = $sth->fetchrow_hashref ) {
2239 push( @result, $line->{'routingid'} );
2242 # To find the matching index
2244 my $key = -1; # to allow for 0 being a valid response
2245 for ( $i = 0 ; $i < @result ; $i++ ) {
2246 if ( $routingid == $result[$i] ) {
2247 $key = $i; # save the index
2252 # if index exists in array then move it to new position
2253 if ( $key > -1 && $rank > 0 ) {
2254 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2255 my $moving_item = splice( @result, $key, 1 );
2256 splice( @result, $new_rank, 0, $moving_item );
2258 for ( my $j = 0 ; $j < @result ; $j++ ) {
2259 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2265 =head2 delroutingmember
2267 delroutingmember($routingid,$subscriptionid)
2269 this function either deletes one member from routing list if $routingid exists otherwise
2270 deletes all members from the routing list
2274 sub delroutingmember {
2276 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2277 my ( $routingid, $subscriptionid ) = @_;
2278 my $dbh = C4::Context->dbh;
2280 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2281 $sth->execute($routingid);
2282 reorder_members( $subscriptionid, $routingid );
2284 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2285 $sth->execute($subscriptionid);
2290 =head2 getroutinglist
2292 @routinglist = getroutinglist($subscriptionid)
2294 this gets the info from the subscriptionroutinglist for $subscriptionid
2297 the routinglist as an array. Each element of the array contains a hash_ref containing
2298 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2302 sub getroutinglist {
2303 my ($subscriptionid) = @_;
2304 my $dbh = C4::Context->dbh;
2305 my $sth = $dbh->prepare(
2306 'SELECT routingid, borrowernumber, ranking, biblionumber
2308 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2309 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2311 $sth->execute($subscriptionid);
2312 my $routinglist = $sth->fetchall_arrayref({});
2313 return @{$routinglist};
2316 =head2 countissuesfrom
2318 $result = countissuesfrom($subscriptionid,$startdate)
2320 Returns a count of serial rows matching the given subsctiptionid
2321 with published date greater than startdate
2325 sub countissuesfrom {
2326 my ( $subscriptionid, $startdate ) = @_;
2327 my $dbh = C4::Context->dbh;
2331 WHERE subscriptionid=?
2332 AND serial.publisheddate>?
2334 my $sth = $dbh->prepare($query);
2335 $sth->execute( $subscriptionid, $startdate );
2336 my ($countreceived) = $sth->fetchrow;
2337 return $countreceived;
2342 $result = CountIssues($subscriptionid)
2344 Returns a count of serial rows matching the given subsctiptionid
2349 my ($subscriptionid) = @_;
2350 my $dbh = C4::Context->dbh;
2354 WHERE subscriptionid=?
2356 my $sth = $dbh->prepare($query);
2357 $sth->execute($subscriptionid);
2358 my ($countreceived) = $sth->fetchrow;
2359 return $countreceived;
2364 $result = HasItems($subscriptionid)
2366 returns a count of items from serial matching the subscriptionid
2371 my ($subscriptionid) = @_;
2372 my $dbh = C4::Context->dbh;
2374 SELECT COUNT(serialitems.itemnumber)
2376 LEFT JOIN serialitems USING(serialid)
2377 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2379 my $sth=$dbh->prepare($query);
2380 $sth->execute($subscriptionid);
2381 my ($countitems)=$sth->fetchrow_array();
2385 =head2 abouttoexpire
2387 $result = abouttoexpire($subscriptionid)
2389 this function alerts you to the penultimate issue for a serial subscription
2391 returns 1 - if this is the penultimate issue
2397 my ($subscriptionid) = @_;
2398 my $dbh = C4::Context->dbh;
2399 my $subscription = GetSubscription($subscriptionid);
2400 my $per = $subscription->{'periodicity'};
2401 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2402 if ($frequency and $frequency->{unit}){
2403 my $expirationdate = GetExpirationDate($subscriptionid);
2404 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2405 my $nextdate = GetNextDate($subscription, $res);
2406 if(Date::Calc::Delta_Days(
2407 split( /-/, $nextdate ),
2408 split( /-/, $expirationdate )
2412 } elsif ($subscription->{numberlength}>0) {
2413 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2418 sub in_array { # used in next sub down
2419 my ( $val, @elements ) = @_;
2420 foreach my $elem (@elements) {
2421 if ( $val == $elem ) {
2428 =head2 GetSubscriptionsFromBorrower
2430 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2432 this gets the info from subscriptionroutinglist for each $subscriptionid
2435 a count of the serial subscription routing lists to which a patron belongs,
2436 with the titles of those serial subscriptions as an array. Each element of the array
2437 contains a hash_ref with subscriptionID and title of subscription.
2441 sub GetSubscriptionsFromBorrower {
2442 my ($borrowernumber) = @_;
2443 my $dbh = C4::Context->dbh;
2444 my $sth = $dbh->prepare(
2445 "SELECT subscription.subscriptionid, biblio.title
2447 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2448 JOIN subscriptionroutinglist USING (subscriptionid)
2449 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2452 $sth->execute($borrowernumber);
2455 while ( my $line = $sth->fetchrow_hashref ) {
2457 push( @routinglist, $line );
2459 return ( $count, @routinglist );
2463 =head2 GetFictiveIssueNumber
2465 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2467 Get the position of the issue published at $publisheddate, considering the
2468 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2469 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2470 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2471 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2472 depending on how many rows are in serial table.
2473 The issue number calculation is based on subscription frequency, first acquisition
2474 date, and $publisheddate.
2478 sub GetFictiveIssueNumber {
2479 my ($subscription, $publisheddate) = @_;
2481 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2482 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2486 my ($year, $month, $day) = split /-/, $publisheddate;
2487 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2491 if($unit eq 'day') {
2492 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2493 } elsif($unit eq 'week') {
2494 ($wkno, $year) = Week_of_Year($year, $month, $day);
2495 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2496 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2497 } elsif($unit eq 'month') {
2498 $delta = ($fa_year == $year)
2499 ? ($month - $fa_month)
2500 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2501 } elsif($unit eq 'year') {
2502 $delta = $year - $fa_year;
2504 if($frequency->{'unitsperissue'} == 1) {
2505 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2507 # Assuming issuesperunit == 1
2508 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2516 $resultdate = GetNextDate($publisheddate,$subscription)
2518 this function it takes the publisheddate and will return the next issue's date
2519 and will skip dates if there exists an irregularity.
2520 $publisheddate has to be an ISO date
2521 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2522 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2523 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2524 skipped then the returned date will be 2007-05-10
2527 $resultdate - then next date in the sequence (ISO date)
2529 Return $publisheddate if subscription is irregular
2534 my ( $subscription, $publisheddate, $updatecount ) = @_;
2536 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2538 if ($freqdata->{'unit'}) {
2539 my ( $year, $month, $day ) = split /-/, $publisheddate;
2541 # Process an irregularity Hash
2542 # Suppose that irregularities are stored in a string with this structure
2543 # irreg1;irreg2;irreg3
2544 # where irregX is the number of issue which will not be received
2545 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2546 my @irreg = split /;/, $subscription->{'irregularity'} ;
2548 foreach my $irregularity (@irreg) {
2549 $irregularities{$irregularity} = 1;
2552 # Get the 'fictive' next issue number
2553 # It is used to check if next issue is an irregular issue.
2554 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2556 # Then get the next date
2557 my $unit = lc $freqdata->{'unit'};
2558 if ($unit eq 'day') {
2559 while ($irregularities{$issueno}) {
2560 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2561 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
2562 $subscription->{'countissuesperunit'} = 1;
2564 $subscription->{'countissuesperunit'}++;
2568 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2569 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
2570 $subscription->{'countissuesperunit'} = 1;
2572 $subscription->{'countissuesperunit'}++;
2575 elsif ($unit eq 'week') {
2576 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2577 while ($irregularities{$issueno}) {
2578 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2579 $subscription->{'countissuesperunit'} = 1;
2580 $wkno += $freqdata->{"unitsperissue"};
2585 my $dow = Day_of_Week($year, $month, $day);
2586 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2587 if($freqdata->{'issuesperunit'} == 1) {
2588 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2591 $subscription->{'countissuesperunit'}++;
2595 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2596 $subscription->{'countissuesperunit'} = 1;
2597 $wkno += $freqdata->{"unitsperissue"};
2599 $wkno = $wkno % 52 ;
2602 my $dow = Day_of_Week($year, $month, $day);
2603 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2604 if($freqdata->{'issuesperunit'} == 1) {
2605 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2608 $subscription->{'countissuesperunit'}++;
2611 elsif ($unit eq 'month') {
2612 while ($irregularities{$issueno}) {
2613 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2614 $subscription->{'countissuesperunit'} = 1;
2615 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2616 unless($freqdata->{'issuesperunit'} == 1) {
2617 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2620 $subscription->{'countissuesperunit'}++;
2624 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2625 $subscription->{'countissuesperunit'} = 1;
2626 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2627 unless($freqdata->{'issuesperunit'} == 1) {
2628 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2631 $subscription->{'countissuesperunit'}++;
2634 elsif ($unit eq 'year') {
2635 while ($irregularities{$issueno}) {
2636 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2637 $subscription->{'countissuesperunit'} = 1;
2638 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2639 unless($freqdata->{'issuesperunit'} == 1) {
2640 # Jumping to the first day of year, because we don't know what day is expected
2645 $subscription->{'countissuesperunit'}++;
2649 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2650 $subscription->{'countissuesperunit'} = 1;
2651 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2652 unless($freqdata->{'issuesperunit'} == 1) {
2653 # Jumping to the first day of year, because we don't know what day is expected
2658 $subscription->{'countissuesperunit'}++;
2662 my $dbh = C4::Context->dbh;
2665 SET countissuesperunit = ?
2666 WHERE subscriptionid = ?
2668 my $sth = $dbh->prepare($query);
2669 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2671 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2674 return $publisheddate;
2680 $string = &_numeration($value,$num_type,$locale);
2682 _numeration returns the string corresponding to $value in the num_type
2692 my ($value, $num_type, $locale) = @_;
2694 my $initlocale = setlocale(LC_TIME);
2695 if($locale and $locale ne $initlocale) {
2696 $locale = setlocale(LC_TIME, $locale);
2698 $locale ||= $initlocale;
2702 when (/^dayname$/) {
2703 $value = $value % 7;
2704 $string = POSIX::strftime("%A",0,0,0,0,0,0,$value);
2706 when (/^monthname$/) {
2707 $value = $value % 12;
2708 $string = POSIX::strftime("%B",0,0,0,1,$value,0,0,0,0);
2711 my $seasonlocale = ($locale)
2712 ? (substr $locale,0,2)
2716 [qw(Spring Summer Fall Winter)],
2718 [qw(Printemps Été Automne Hiver)],
2720 $value = $value % 4;
2721 $string = ($seasons{$seasonlocale})
2722 ? $seasons{$seasonlocale}->[$value]
2723 : $seasons{'en'}->[$value];
2729 if($locale ne $initlocale) {
2730 setlocale(LC_TIME, $initlocale);
2735 =head2 is_barcode_in_use
2737 Returns number of occurence of the barcode in the items table
2738 Can be used as a boolean test of whether the barcode has
2739 been deployed as yet
2743 sub is_barcode_in_use {
2744 my $barcode = shift;
2745 my $dbh = C4::Context->dbh;
2746 my $occurences = $dbh->selectall_arrayref(
2747 'SELECT itemnumber from items where barcode = ?',
2752 return @{$occurences};
2755 =head2 CloseSubscription
2756 Close a subscription given a subscriptionid
2758 sub CloseSubscription {
2759 my ( $subscriptionid ) = @_;
2760 return unless $subscriptionid;
2761 my $dbh = C4::Context->dbh;
2762 my $sth = $dbh->prepare( qq{
2765 WHERE subscriptionid = ?
2767 $sth->execute( $subscriptionid );
2769 # Set status = missing when status = stopped
2770 $sth = $dbh->prepare( qq{
2773 WHERE subscriptionid = ?
2776 $sth->execute( $subscriptionid );
2779 =head2 ReopenSubscription
2780 Reopen a subscription given a subscriptionid
2782 sub ReopenSubscription {
2783 my ( $subscriptionid ) = @_;
2784 return unless $subscriptionid;
2785 my $dbh = C4::Context->dbh;
2786 my $sth = $dbh->prepare( qq{
2789 WHERE subscriptionid = ?
2791 $sth->execute( $subscriptionid );
2793 # Set status = expected when status = stopped
2794 $sth = $dbh->prepare( qq{
2797 WHERE subscriptionid = ?
2800 $sth->execute( $subscriptionid );
2803 =head2 subscriptionCurrentlyOnOrder
2805 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2807 Return 1 if subscription is currently on order else 0.
2811 sub subscriptionCurrentlyOnOrder {
2812 my ( $subscriptionid ) = @_;
2813 my $dbh = C4::Context->dbh;
2815 SELECT COUNT(*) FROM aqorders
2816 WHERE subscriptionid = ?
2817 AND datereceived IS NULL
2818 AND datecancellationprinted IS NULL
2820 my $sth = $dbh->prepare( $query );
2821 $sth->execute($subscriptionid);
2822 return $sth->fetchrow_array;
2825 =head2 can_edit_subscription
2827 $can = can_edit_subscription( $subscriptionid[, $userid] );
2829 Return 1 if the subscription is editable by the current logged user (or a given $userid), else 0.
2833 sub can_edit_subscription {
2834 my ( $subscription, $userid ) = @_;
2835 return 0 unless C4::Context->userenv;
2836 my $flags = C4::Context->userenv->{flags};
2837 $userid ||= C4::Context->userenv->{'id'};
2838 my $independent_branches = C4::Context->preference('IndependentBranches');
2839 return 1 unless $independent_branches;
2840 if( C4::Context->IsSuperLibrarian()
2841 or C4::Auth::haspermission( $userid, {serials => 'superserials'}),
2842 or C4::Auth::haspermission( $userid, {serials => 'edit_subscription'}),
2843 or not defined $subscription->{branchcode}
2844 or $subscription->{branchcode} eq ''
2845 or $subscription->{branchcode} eq C4::Context->userenv->{'branch'}
2857 Koha Development Team <http://koha-community.org/>