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);
27 use Date::Calc qw(:all);
28 use POSIX qw(strftime);
30 use C4::Log; # logaction
32 use C4::Serials::Frequency;
33 use C4::Serials::Numberpattern;
35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
38 $VERSION = 3.07.00.049; # set version for version checking
42 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
43 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
45 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
46 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
47 &GetSubscriptionHistoryFromSubscriptionId
49 &GetNextSeq &GetSeq &NewIssue &ItemizeSerials &GetSerials
50 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
51 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
52 &GetSerialInformation &AddItem2Serial
53 &PrepareSerialsData &GetNextExpected &ModNextExpected
55 &UpdateClaimdateIssues
56 &GetSuppliersWithLateIssues &getsupplierbyserialid
57 &GetDistributedTo &SetDistributedTo
58 &getroutinglist &delroutingmember &addroutingmember
60 &check_routing &updateClaim &removeMissingIssue
63 &GetSubscriptionsFromBorrower
64 &subscriptionCurrentlyOnOrder
71 C4::Serials - Serials Module Functions
79 Functions for handling subscriptions, claims routing etc.
84 =head2 GetSuppliersWithLateIssues
86 $supplierlist = GetSuppliersWithLateIssues()
88 this function get all suppliers with late issues.
91 an array_ref of suppliers each entry is a hash_ref containing id and name
92 the array is in name order
96 sub GetSuppliersWithLateIssues {
97 my $dbh = C4::Context->dbh;
99 SELECT DISTINCT id, name
101 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
102 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
105 (planneddate < now() AND serial.status=1)
106 OR serial.STATUS IN (3, 4, 41, 42, 43, 44)
108 AND subscription.closed = 0
110 return $dbh->selectall_arrayref($query, { Slice => {} });
115 @issuelist = GetLateIssues($supplierid)
117 this function selects late issues from the database
120 the issuelist as an array. Each element of this array contains a hashi_ref containing
121 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
126 my ($supplierid) = @_;
128 return unless ($supplierid);
130 my $dbh = C4::Context->dbh;
134 SELECT name,title,planneddate,serialseq,serial.subscriptionid
136 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
137 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
138 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
139 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
140 AND subscription.aqbooksellerid=?
141 AND subscription.closed = 0
144 $sth = $dbh->prepare($query);
145 $sth->execute($supplierid);
148 SELECT name,title,planneddate,serialseq,serial.subscriptionid
150 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
151 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
152 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
153 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
154 AND subscription.closed = 0
157 $sth = $dbh->prepare($query);
162 while ( my $line = $sth->fetchrow_hashref ) {
163 $line->{title} = "" if $last_title and $line->{title} eq $last_title;
164 $last_title = $line->{title} if ( $line->{title} );
165 $line->{planneddate} = format_date( $line->{planneddate} );
166 push @issuelist, $line;
171 =head2 GetSubscriptionHistoryFromSubscriptionId
173 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
175 This function returns the subscription history as a hashref
179 sub GetSubscriptionHistoryFromSubscriptionId {
180 my ($subscriptionid) = @_;
182 return unless $subscriptionid;
184 my $dbh = C4::Context->dbh;
187 FROM subscriptionhistory
188 WHERE subscriptionid = ?
190 my $sth = $dbh->prepare($query);
191 $sth->execute($subscriptionid);
192 my $results = $sth->fetchrow_hashref;
198 =head2 GetSerialStatusFromSerialId
200 $sth = GetSerialStatusFromSerialId();
201 this function returns a statement handle
202 After this function, don't forget to execute it by using $sth->execute($serialid)
204 $sth = $dbh->prepare($query).
208 sub GetSerialStatusFromSerialId {
209 my $dbh = C4::Context->dbh;
215 return $dbh->prepare($query);
218 =head2 GetSerialInformation
221 $data = GetSerialInformation($serialid);
222 returns a hash_ref containing :
223 items : items marcrecord (can be an array)
225 subscription table field
226 + information about subscription expiration
230 sub GetSerialInformation {
232 my $dbh = C4::Context->dbh;
234 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
235 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
238 my $rq = $dbh->prepare($query);
239 $rq->execute($serialid);
240 my $data = $rq->fetchrow_hashref;
242 # create item information if we have serialsadditems for this subscription
243 if ( $data->{'serialsadditems'} ) {
244 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
245 $queryitem->execute($serialid);
246 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
248 if ( scalar(@$itemnumbers) > 0 ) {
249 foreach my $itemnum (@$itemnumbers) {
251 #It is ASSUMED that GetMarcItem ALWAYS WORK...
252 #Maybe GetMarcItem should return values on failure
253 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
254 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
255 $itemprocessed->{'itemnumber'} = $itemnum->[0];
256 $itemprocessed->{'itemid'} = $itemnum->[0];
257 $itemprocessed->{'serialid'} = $serialid;
258 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
259 push @{ $data->{'items'} }, $itemprocessed;
262 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
263 $itemprocessed->{'itemid'} = "N$serialid";
264 $itemprocessed->{'serialid'} = $serialid;
265 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
266 $itemprocessed->{'countitems'} = 0;
267 push @{ $data->{'items'} }, $itemprocessed;
270 $data->{ "status" . $data->{'serstatus'} } = 1;
271 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
272 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
273 $data->{cannotedit} = not can_edit_subscription( $data );
277 =head2 AddItem2Serial
279 $rows = AddItem2Serial($serialid,$itemnumber);
280 Adds an itemnumber to Serial record
281 returns the number of rows affected
286 my ( $serialid, $itemnumber ) = @_;
288 return unless ($serialid and $itemnumber);
290 my $dbh = C4::Context->dbh;
291 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
292 $rq->execute( $serialid, $itemnumber );
296 =head2 UpdateClaimdateIssues
298 UpdateClaimdateIssues($serialids,[$date]);
300 Update Claimdate for issues in @$serialids list with date $date
305 sub UpdateClaimdateIssues {
306 my ( $serialids, $date ) = @_;
308 return unless ($serialids);
310 my $dbh = C4::Context->dbh;
311 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
313 UPDATE serial SET claimdate = ?, status = 7
314 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
315 my $rq = $dbh->prepare($query);
316 $rq->execute($date, @$serialids);
320 =head2 GetSubscription
322 $subs = GetSubscription($subscriptionid)
323 this function returns the subscription which has $subscriptionid as id.
325 a hashref. This hash containts
326 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
330 sub GetSubscription {
331 my ($subscriptionid) = @_;
332 my $dbh = C4::Context->dbh;
334 SELECT subscription.*,
335 subscriptionhistory.*,
336 aqbooksellers.name AS aqbooksellername,
337 biblio.title AS bibliotitle,
338 subscription.biblionumber as bibnum
340 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
341 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
342 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
343 WHERE subscription.subscriptionid = ?
346 $debug and warn "query : $query\nsubsid :$subscriptionid";
347 my $sth = $dbh->prepare($query);
348 $sth->execute($subscriptionid);
349 my $subscription = $sth->fetchrow_hashref;
350 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
351 return $subscription;
354 =head2 GetFullSubscription
356 $array_ref = GetFullSubscription($subscriptionid)
357 this function reads the serial table.
361 sub GetFullSubscription {
362 my ($subscriptionid) = @_;
364 return unless ($subscriptionid);
366 my $dbh = C4::Context->dbh;
368 SELECT serial.serialid,
371 serial.publisheddate,
373 serial.notes as notes,
374 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
375 aqbooksellers.name as aqbooksellername,
376 biblio.title as bibliotitle,
377 subscription.branchcode AS branchcode,
378 subscription.subscriptionid AS subscriptionid
380 LEFT JOIN subscription ON
381 (serial.subscriptionid=subscription.subscriptionid )
382 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
383 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
384 WHERE serial.subscriptionid = ?
386 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
387 serial.subscriptionid
389 $debug and warn "GetFullSubscription query: $query";
390 my $sth = $dbh->prepare($query);
391 $sth->execute($subscriptionid);
392 my $subscriptions = $sth->fetchall_arrayref( {} );
393 for my $subscription ( @$subscriptions ) {
394 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
396 return $subscriptions;
399 =head2 PrepareSerialsData
401 $array_ref = PrepareSerialsData($serialinfomation)
402 where serialinformation is a hashref array
406 sub PrepareSerialsData {
409 return unless ($lines);
415 my $aqbooksellername;
419 my $previousnote = "";
421 foreach my $subs (@{$lines}) {
422 for my $datefield ( qw(publisheddate planneddate) ) {
423 # handle 0000-00-00 dates
424 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
425 $subs->{$datefield} = undef;
428 $subs->{ "status" . $subs->{'status'} } = 1;
429 if ( grep { $_ == $subs->{status} } qw( 1 3 4 41 42 43 44 7 ) ) {
430 $subs->{"checked"} = 1;
433 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
434 $year = $subs->{'year'};
438 if ( $tmpresults{$year} ) {
439 push @{ $tmpresults{$year}->{'serials'} }, $subs;
441 $tmpresults{$year} = {
443 'aqbooksellername' => $subs->{'aqbooksellername'},
444 'bibliotitle' => $subs->{'bibliotitle'},
445 'serials' => [$subs],
450 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
451 push @res, $tmpresults{$key};
456 =head2 GetSubscriptionsFromBiblionumber
458 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
459 this function get the subscription list. it reads the subscription table.
461 reference to an array of subscriptions which have the biblionumber given on input arg.
462 each element of this array is a hashref containing
463 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
467 sub GetSubscriptionsFromBiblionumber {
468 my ($biblionumber) = @_;
470 return unless ($biblionumber);
472 my $dbh = C4::Context->dbh;
474 SELECT subscription.*,
476 subscriptionhistory.*,
477 aqbooksellers.name AS aqbooksellername,
478 biblio.title AS bibliotitle
480 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
481 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
482 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
483 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
484 WHERE subscription.biblionumber = ?
486 my $sth = $dbh->prepare($query);
487 $sth->execute($biblionumber);
489 while ( my $subs = $sth->fetchrow_hashref ) {
490 $subs->{startdate} = format_date( $subs->{startdate} );
491 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
492 $subs->{histenddate} = format_date( $subs->{histenddate} );
493 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
494 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
495 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
496 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
497 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
498 $subs->{ "status" . $subs->{'status'} } = 1;
500 if ( $subs->{enddate} eq '0000-00-00' ) {
501 $subs->{enddate} = '';
503 $subs->{enddate} = format_date( $subs->{enddate} );
505 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
506 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
507 $subs->{cannotedit} = not can_edit_subscription( $subs );
513 =head2 GetFullSubscriptionsFromBiblionumber
515 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
516 this function reads the serial table.
520 sub GetFullSubscriptionsFromBiblionumber {
521 my ($biblionumber) = @_;
522 my $dbh = C4::Context->dbh;
524 SELECT serial.serialid,
527 serial.publisheddate,
529 serial.notes as notes,
530 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
531 biblio.title as bibliotitle,
532 subscription.branchcode AS branchcode,
533 subscription.subscriptionid AS subscriptionid
535 LEFT JOIN subscription ON
536 (serial.subscriptionid=subscription.subscriptionid)
537 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
538 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
539 WHERE subscription.biblionumber = ?
541 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
542 serial.subscriptionid
544 my $sth = $dbh->prepare($query);
545 $sth->execute($biblionumber);
546 my $subscriptions = $sth->fetchall_arrayref( {} );
547 for my $subscription ( @$subscriptions ) {
548 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
550 return $subscriptions;
553 =head2 GetSubscriptions
555 @results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
556 this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
558 a table of hashref. Each hash containt the subscription.
562 sub GetSubscriptions {
563 my ( $string, $issn, $ean, $biblionumber ) = @_;
565 #return unless $title or $ISSN or $biblionumber;
566 my $dbh = C4::Context->dbh;
569 SELECT subscriptionhistory.*, subscription.*, biblio.title,biblioitems.issn,biblio.biblionumber
571 LEFT JOIN subscriptionhistory USING(subscriptionid)
572 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
573 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
578 $sqlwhere = " WHERE biblio.biblionumber=?";
579 push @bind_params, $biblionumber;
583 my @strings_to_search;
584 @strings_to_search = map { "%$_%" } split( / /, $string );
585 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
586 push @bind_params, @strings_to_search;
587 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
588 $debug && warn "$tmpstring";
589 $tmpstring =~ s/^AND //;
590 push @sqlstrings, $tmpstring;
592 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
596 my @strings_to_search;
597 @strings_to_search = map { "%$_%" } split( / /, $issn );
598 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
599 push @bind_params, @strings_to_search;
600 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
601 $debug && warn "$tmpstring";
602 $tmpstring =~ s/^OR //;
603 push @sqlstrings, $tmpstring;
605 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
609 my @strings_to_search;
610 @strings_to_search = map { "$_" } split( / /, $ean );
611 foreach my $index ( qw(biblioitems.ean) ) {
612 push @bind_params, @strings_to_search;
613 my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
614 $debug && warn "$tmpstring";
615 $tmpstring =~ s/^OR //;
616 push @sqlstrings, $tmpstring;
618 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
621 $sql .= "$sqlwhere ORDER BY title";
622 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
623 $sth = $dbh->prepare($sql);
624 $sth->execute(@bind_params);
625 my $subscriptions = $sth->fetchall_arrayref( {} );
626 for my $subscription ( @$subscriptions ) {
627 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
629 return @$subscriptions;
632 =head2 SearchSubscriptions
634 @results = SearchSubscriptions($args);
636 This function returns a list of hashrefs, one for each subscription
637 that meets the conditions specified by the $args hashref.
639 The valid search fields are:
653 The expiration_date search field is special; it specifies the maximum
654 subscription expiration date.
658 sub SearchSubscriptions {
663 subscription.notes AS publicnotes,
665 subscriptionhistory.*,
666 biblio.notes AS biblionotes,
671 LEFT JOIN subscriptionhistory USING(subscriptionid)
672 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
673 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
674 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
678 if( $args->{biblionumber} ) {
679 push @where_strs, "biblio.biblionumber = ?";
680 push @where_args, $args->{biblionumber};
682 if( $args->{title} ){
683 my @words = split / /, $args->{title};
685 foreach my $word (@words) {
686 push @strs, "biblio.title LIKE ?";
687 push @args, "%$word%";
690 push @where_strs, '(' . join (' AND ', @strs) . ')';
691 push @where_args, @args;
695 push @where_strs, "biblioitems.issn LIKE ?";
696 push @where_args, "%$args->{issn}%";
699 push @where_strs, "biblioitems.ean LIKE ?";
700 push @where_args, "%$args->{ean}%";
702 if ( $args->{callnumber} ) {
703 push @where_strs, "subscription.callnumber LIKE ?";
704 push @where_args, "%$args->{callnumber}%";
706 if( $args->{publisher} ){
707 push @where_strs, "biblioitems.publishercode LIKE ?";
708 push @where_args, "%$args->{publisher}%";
710 if( $args->{bookseller} ){
711 push @where_strs, "aqbooksellers.name LIKE ?";
712 push @where_args, "%$args->{bookseller}%";
714 if( $args->{branch} ){
715 push @where_strs, "subscription.branchcode = ?";
716 push @where_args, "$args->{branch}";
718 if ( $args->{location} ) {
719 push @where_strs, "subscription.location = ?";
720 push @where_args, "$args->{location}";
722 if ( $args->{expiration_date} ) {
723 push @where_strs, "subscription.enddate <= ?";
724 push @where_args, "$args->{expiration_date}";
726 if( defined $args->{closed} ){
727 push @where_strs, "subscription.closed = ?";
728 push @where_args, "$args->{closed}";
731 $query .= " WHERE " . join(" AND ", @where_strs);
734 my $dbh = C4::Context->dbh;
735 my $sth = $dbh->prepare($query);
736 $sth->execute(@where_args);
737 my $results = $sth->fetchall_arrayref( {} );
740 for my $subscription ( @$results ) {
741 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
742 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
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, 41, 42, 43, 44, 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, 41, 42, 43, 44, 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 (!defined($line->{$datefield}) || $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 IN (2, 4, 41, 42, 43, 44)
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,41,42,43,44,5");
1167 foreach my $missingserial (@missingserials) {
1168 if ( grep { $_ == $missingserial->{status} } qw( 4 41 42 43 44 ) ) {
1169 $missinglist .= $missingserial->{'serialseq'} . "; ";
1170 } elsif($missingserial->{'status'} == 5) {
1171 $missinglist .= "not issued " . $missingserial->{'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 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1237 $sth = $dbh->prepare($query);
1238 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1239 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1240 $sth = $dbh->prepare($query);
1241 $sth->execute($subscriptionid);
1242 my $val = $sth->fetchrow_hashref;
1243 unless ( $val->{manualhistory} ) {
1244 if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) {
1245 _update_receivedlist($subscriptionid);
1247 my @missing_statuses = qw( 4 41 42 43 44 );
1248 if ( ( grep { $_ == $status } ( @missing_statuses, 5 ) )
1250 ( grep { $_ == $oldstatus } @missing_statuses )
1251 && ! ( grep { $_ == $status } @missing_statuses ) )
1252 || ($oldstatus == 5 && $status != 5)) {
1253 _update_missinglist($subscriptionid);
1258 # create new waited entry if needed (ie : was a "waited" and has changed)
1259 if ( $oldstatus == 1 && $status != 1 ) {
1260 my $subscription = GetSubscription($subscriptionid);
1261 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1265 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1266 $newinnerloop1, $newinnerloop2, $newinnerloop3
1268 = GetNextSeq( $subscription, $pattern, $publisheddate );
1270 # next date (calculated from actual date & frequency parameters)
1271 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1272 my $nextpubdate = $nextpublisheddate;
1273 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1274 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1275 WHERE subscriptionid = ?";
1276 $sth = $dbh->prepare($query);
1277 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1279 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1280 if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) {
1281 require C4::Letters;
1282 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1289 =head2 GetNextExpected
1291 $nextexpected = GetNextExpected($subscriptionid)
1293 Get the planneddate for the current expected issue of the subscription.
1299 planneddate => ISO date
1304 sub GetNextExpected {
1305 my ($subscriptionid) = @_;
1307 my $dbh = C4::Context->dbh;
1311 WHERE subscriptionid = ?
1315 my $sth = $dbh->prepare($query);
1317 # Each subscription has only one 'expected' issue, with serial.status==1.
1318 $sth->execute( $subscriptionid, 1 );
1319 my $nextissue = $sth->fetchrow_hashref;
1320 if ( !$nextissue ) {
1324 WHERE subscriptionid = ?
1325 ORDER BY publisheddate DESC
1328 $sth = $dbh->prepare($query);
1329 $sth->execute($subscriptionid);
1330 $nextissue = $sth->fetchrow_hashref;
1332 foreach(qw/planneddate publisheddate/) {
1333 if ( !defined $nextissue->{$_} ) {
1334 # or should this default to 1st Jan ???
1335 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1337 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1345 =head2 ModNextExpected
1347 ModNextExpected($subscriptionid,$date)
1349 Update the planneddate for the current expected issue of the subscription.
1350 This will modify all future prediction results.
1352 C<$date> is an ISO date.
1358 sub ModNextExpected {
1359 my ( $subscriptionid, $date ) = @_;
1360 my $dbh = C4::Context->dbh;
1362 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1363 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1365 # Each subscription has only one 'expected' issue, with serial.status==1.
1366 $sth->execute( $date, $date, $subscriptionid, 1 );
1371 =head2 GetSubscriptionIrregularities
1375 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1376 get the list of irregularities for a subscription
1382 sub GetSubscriptionIrregularities {
1383 my $subscriptionid = shift;
1385 return unless $subscriptionid;
1387 my $dbh = C4::Context->dbh;
1391 WHERE subscriptionid = ?
1393 my $sth = $dbh->prepare($query);
1394 $sth->execute($subscriptionid);
1396 my ($result) = $sth->fetchrow_array;
1397 my @irreg = split /;/, $result;
1402 =head2 ModSubscription
1404 this function modifies a subscription. Put all new values on input args.
1405 returns the number of rows affected
1409 sub ModSubscription {
1411 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1412 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1413 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1414 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1415 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1416 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1417 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1420 my $dbh = C4::Context->dbh;
1421 my $query = "UPDATE subscription
1422 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1423 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1424 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1425 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1426 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1427 callnumber=?, notes=?, letter=?, manualhistory=?,
1428 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1429 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1431 WHERE subscriptionid = ?";
1433 my $sth = $dbh->prepare($query);
1435 $auser, $branchcode, $aqbooksellerid, $cost,
1436 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1437 $irregularity, $numberpattern, $locale, $numberlength,
1438 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1439 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1440 $status, $biblionumber, $callnumber, $notes,
1441 $letter, ($manualhistory ? $manualhistory : 0),
1442 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1443 $graceperiod, $location, $enddate, $skip_serialseq,
1446 my $rows = $sth->rows;
1448 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1452 =head2 NewSubscription
1454 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1455 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1456 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1457 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1458 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1459 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1461 Create a new subscription with value given on input args.
1464 the id of this new subscription
1468 sub NewSubscription {
1470 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1471 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1472 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1473 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1474 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1475 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1476 $location, $enddate, $skip_serialseq
1478 my $dbh = C4::Context->dbh;
1480 #save subscription (insert into database)
1482 INSERT INTO subscription
1483 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1484 biblionumber, startdate, periodicity, numberlength, weeklength,
1485 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1486 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1487 irregularity, numberpattern, locale, callnumber,
1488 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1489 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1490 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1492 my $sth = $dbh->prepare($query);
1494 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1495 $startdate, $periodicity, $numberlength, $weeklength,
1496 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1497 $lastvalue3, $innerloop3, $status, $notes, $letter,
1498 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1499 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1500 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1503 my $subscriptionid = $dbh->{'mysql_insertid'};
1505 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1509 WHERE subscriptionid=?
1511 $sth = $dbh->prepare($query);
1512 $sth->execute( $enddate, $subscriptionid );
1515 # then create the 1st expected number
1517 INSERT INTO subscriptionhistory
1518 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1521 $sth = $dbh->prepare($query);
1522 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1524 # reread subscription to get a hash (for calculation of the 1st issue number)
1525 my $subscription = GetSubscription($subscriptionid);
1526 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1528 # calculate issue number
1529 my $serialseq = GetSeq($subscription, $pattern) || q{};
1532 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1533 VALUES (?,?,?,?,?,?)
1535 $sth = $dbh->prepare($query);
1536 $sth->execute( $serialseq, $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1538 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1540 #set serial flag on biblio if not already set.
1541 my $bib = GetBiblio($biblionumber);
1542 if ( $bib and !$bib->{'serial'} ) {
1543 my $record = GetMarcBiblio($biblionumber);
1544 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1546 eval { $record->field($tag)->update( $subf => 1 ); };
1548 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1550 return $subscriptionid;
1553 =head2 ReNewSubscription
1555 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1557 this function renew a subscription with values given on input args.
1561 sub ReNewSubscription {
1562 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1563 my $dbh = C4::Context->dbh;
1564 my $subscription = GetSubscription($subscriptionid);
1568 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1569 WHERE biblio.biblionumber=?
1571 my $sth = $dbh->prepare($query);
1572 $sth->execute( $subscription->{biblionumber} );
1573 my $biblio = $sth->fetchrow_hashref;
1575 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1576 require C4::Suggestions;
1577 C4::Suggestions::NewSuggestion(
1578 { 'suggestedby' => $user,
1579 'title' => $subscription->{bibliotitle},
1580 'author' => $biblio->{author},
1581 'publishercode' => $biblio->{publishercode},
1582 'note' => $biblio->{note},
1583 'biblionumber' => $subscription->{biblionumber}
1588 # renew subscription
1591 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1592 WHERE subscriptionid=?
1594 $sth = $dbh->prepare($query);
1595 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1596 my $enddate = GetExpirationDate($subscriptionid);
1597 $debug && warn "enddate :$enddate";
1601 WHERE subscriptionid=?
1603 $sth = $dbh->prepare($query);
1604 $sth->execute( $enddate, $subscriptionid );
1606 UPDATE subscriptionhistory
1608 WHERE subscriptionid=?
1610 $sth = $dbh->prepare($query);
1611 $sth->execute( $enddate, $subscriptionid );
1613 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1619 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1621 Create a new issue stored on the database.
1622 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1623 returns the serial id
1628 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1629 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1631 return unless ($subscriptionid);
1633 my $dbh = C4::Context->dbh;
1636 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1637 VALUES (?,?,?,?,?,?,?)
1639 my $sth = $dbh->prepare($query);
1640 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1641 my $serialid = $dbh->{'mysql_insertid'};
1643 SELECT missinglist,recievedlist
1644 FROM subscriptionhistory
1645 WHERE subscriptionid=?
1647 $sth = $dbh->prepare($query);
1648 $sth->execute($subscriptionid);
1649 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1651 if ( $status == 2 ) {
1652 ### TODO Add a feature that improves recognition and description.
1653 ### As such count (serialseq) i.e. : N18,2(N19),N20
1654 ### Would use substr and index But be careful to previous presence of ()
1655 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1657 if ( $status == 4 ) {
1658 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1661 UPDATE subscriptionhistory
1662 SET recievedlist=?, missinglist=?
1663 WHERE subscriptionid=?
1665 $sth = $dbh->prepare($query);
1666 $recievedlist =~ s/^; //;
1667 $missinglist =~ s/^; //;
1668 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1672 =head2 ItemizeSerials
1674 ItemizeSerials($serialid, $info);
1675 $info is a hashref containing barcode branch, itemcallnumber, status, location
1676 $serialid the serialid
1678 1 if the itemize is a succes.
1679 0 and @error otherwise. @error containts the list of errors found.
1683 sub ItemizeSerials {
1684 my ( $serialid, $info ) = @_;
1686 return unless ($serialid);
1688 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1690 my $dbh = C4::Context->dbh;
1696 my $sth = $dbh->prepare($query);
1697 $sth->execute($serialid);
1698 my $data = $sth->fetchrow_hashref;
1699 if ( C4::Context->preference("RoutingSerials") ) {
1701 # check for existing biblioitem relating to serial issue
1702 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1704 for ( my $i = 0 ; $i < $count ; $i++ ) {
1705 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1706 $bibitemno = $results[$i]->{'biblioitemnumber'};
1710 if ( $bibitemno == 0 ) {
1711 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1712 $sth->execute( $data->{'biblionumber'} );
1713 my $biblioitem = $sth->fetchrow_hashref;
1714 $biblioitem->{'volumedate'} = $data->{planneddate};
1715 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1716 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1720 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1721 if ( $info->{barcode} ) {
1723 if ( is_barcode_in_use( $info->{barcode} ) ) {
1724 push @errors, 'barcode_not_unique';
1726 my $marcrecord = MARC::Record->new();
1727 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1728 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1729 $marcrecord->insert_fields_ordered($newField);
1730 if ( $info->{branch} ) {
1731 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1733 #warn "items.homebranch : $tag , $subfield";
1734 if ( $marcrecord->field($tag) ) {
1735 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1737 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1738 $marcrecord->insert_fields_ordered($newField);
1740 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1742 #warn "items.holdingbranch : $tag , $subfield";
1743 if ( $marcrecord->field($tag) ) {
1744 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1746 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1747 $marcrecord->insert_fields_ordered($newField);
1750 if ( $info->{itemcallnumber} ) {
1751 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1753 if ( $marcrecord->field($tag) ) {
1754 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1756 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1757 $marcrecord->insert_fields_ordered($newField);
1760 if ( $info->{notes} ) {
1761 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1763 if ( $marcrecord->field($tag) ) {
1764 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1766 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1767 $marcrecord->insert_fields_ordered($newField);
1770 if ( $info->{location} ) {
1771 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1773 if ( $marcrecord->field($tag) ) {
1774 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1776 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1777 $marcrecord->insert_fields_ordered($newField);
1780 if ( $info->{status} ) {
1781 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1783 if ( $marcrecord->field($tag) ) {
1784 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1786 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1787 $marcrecord->insert_fields_ordered($newField);
1790 if ( C4::Context->preference("RoutingSerials") ) {
1791 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1792 if ( $marcrecord->field($tag) ) {
1793 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1795 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1796 $marcrecord->insert_fields_ordered($newField);
1800 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1803 return ( 0, @errors );
1807 =head2 HasSubscriptionStrictlyExpired
1809 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1811 the subscription has stricly expired when today > the end subscription date
1814 1 if true, 0 if false, -1 if the expiration date is not set.
1818 sub HasSubscriptionStrictlyExpired {
1820 # Getting end of subscription date
1821 my ($subscriptionid) = @_;
1823 return unless ($subscriptionid);
1825 my $dbh = C4::Context->dbh;
1826 my $subscription = GetSubscription($subscriptionid);
1827 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1829 # If the expiration date is set
1830 if ( $expirationdate != 0 ) {
1831 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1833 # Getting today's date
1834 my ( $nowyear, $nowmonth, $nowday ) = Today();
1836 # if today's date > expiration date, then the subscription has stricly expired
1837 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1844 # There are some cases where the expiration date is not set
1845 # As we can't determine if the subscription has expired on a date-basis,
1851 =head2 HasSubscriptionExpired
1853 $has_expired = HasSubscriptionExpired($subscriptionid)
1855 the subscription has expired when the next issue to arrive is out of subscription limit.
1858 0 if the subscription has not expired
1859 1 if the subscription has expired
1860 2 if has subscription does not have a valid expiration date set
1864 sub HasSubscriptionExpired {
1865 my ($subscriptionid) = @_;
1867 return unless ($subscriptionid);
1869 my $dbh = C4::Context->dbh;
1870 my $subscription = GetSubscription($subscriptionid);
1871 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1872 if ( $frequency and $frequency->{unit} ) {
1873 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1874 if (!defined $expirationdate) {
1875 $expirationdate = q{};
1878 SELECT max(planneddate)
1880 WHERE subscriptionid=?
1882 my $sth = $dbh->prepare($query);
1883 $sth->execute($subscriptionid);
1884 my ($res) = $sth->fetchrow;
1885 if (!$res || $res=~m/^0000/) {
1888 my @res = split( /-/, $res );
1889 my @endofsubscriptiondate = split( /-/, $expirationdate );
1890 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1892 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1897 if ( $subscription->{'numberlength'} ) {
1898 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1899 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1905 return 0; # Notice that you'll never get here.
1908 =head2 SetDistributedto
1910 SetDistributedto($distributedto,$subscriptionid);
1911 This function update the value of distributedto for a subscription given on input arg.
1915 sub SetDistributedto {
1916 my ( $distributedto, $subscriptionid ) = @_;
1917 my $dbh = C4::Context->dbh;
1921 WHERE subscriptionid=?
1923 my $sth = $dbh->prepare($query);
1924 $sth->execute( $distributedto, $subscriptionid );
1928 =head2 DelSubscription
1930 DelSubscription($subscriptionid)
1931 this function deletes subscription which has $subscriptionid as id.
1935 sub DelSubscription {
1936 my ($subscriptionid) = @_;
1937 my $dbh = C4::Context->dbh;
1938 $subscriptionid = $dbh->quote($subscriptionid);
1939 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1940 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1941 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1943 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1948 DelIssue($serialseq,$subscriptionid)
1949 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1951 returns the number of rows affected
1956 my ($dataissue) = @_;
1957 my $dbh = C4::Context->dbh;
1958 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1963 AND subscriptionid= ?
1965 my $mainsth = $dbh->prepare($query);
1966 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1968 #Delete element from subscription history
1969 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1970 my $sth = $dbh->prepare($query);
1971 $sth->execute( $dataissue->{'subscriptionid'} );
1972 my $val = $sth->fetchrow_hashref;
1973 unless ( $val->{manualhistory} ) {
1975 SELECT * FROM subscriptionhistory
1976 WHERE subscriptionid= ?
1978 my $sth = $dbh->prepare($query);
1979 $sth->execute( $dataissue->{'subscriptionid'} );
1980 my $data = $sth->fetchrow_hashref;
1981 my $serialseq = $dataissue->{'serialseq'};
1982 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1983 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1984 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1985 $sth = $dbh->prepare($strsth);
1986 $sth->execute( $dataissue->{'subscriptionid'} );
1989 return $mainsth->rows;
1992 =head2 GetLateOrMissingIssues
1994 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1996 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1999 the issuelist as an array of hash refs. Each element of this array contains
2000 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
2004 sub GetLateOrMissingIssues {
2005 my ( $supplierid, $serialid, $order ) = @_;
2007 return unless ( $supplierid or $serialid );
2009 my $dbh = C4::Context->dbh;
2013 $byserial = "and serialid = " . $serialid;
2016 $order .= ", title";
2021 $sth = $dbh->prepare(
2023 serialid, aqbooksellerid, name,
2024 biblio.title, biblioitems.issn, planneddate, serialseq,
2025 serial.status, serial.subscriptionid, claimdate,
2026 subscription.branchcode
2028 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
2029 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
2030 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
2031 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
2032 WHERE subscription.subscriptionid = serial.subscriptionid
2033 AND (serial.STATUS IN (4, 41, 42, 43, 44) 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 IN (4, 41, 42, 43, 44) 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->{planneddateISO} = $line->{planneddate};
2061 $line->{planneddate} = format_date( $line->{planneddate} );
2063 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
2064 $line->{claimdateISO} = $line->{claimdate};
2065 $line->{claimdate} = format_date( $line->{claimdate} );
2067 $line->{"status".$line->{status}} = 1;
2068 push @issuelist, $line;
2073 =head2 removeMissingIssue
2075 removeMissingIssue($subscriptionid)
2077 this function removes an issue from being part of the missing string in
2078 subscriptionlist.missinglist column
2080 called when a missing issue is found from the serials-recieve.pl file
2084 sub removeMissingIssue {
2085 my ( $sequence, $subscriptionid ) = @_;
2087 return unless ($sequence and $subscriptionid);
2089 my $dbh = C4::Context->dbh;
2090 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2091 $sth->execute($subscriptionid);
2092 my $data = $sth->fetchrow_hashref;
2093 my $missinglist = $data->{'missinglist'};
2094 my $missinglistbefore = $missinglist;
2096 # warn $missinglist." before";
2097 $missinglist =~ s/($sequence)//;
2099 # warn $missinglist." after";
2100 if ( $missinglist ne $missinglistbefore ) {
2101 $missinglist =~ s/\|\s\|/\|/g;
2102 $missinglist =~ s/^\| //g;
2103 $missinglist =~ s/\|$//g;
2104 my $sth2 = $dbh->prepare(
2105 "UPDATE subscriptionhistory
2107 WHERE subscriptionid = ?"
2109 $sth2->execute( $missinglist, $subscriptionid );
2116 &updateClaim($serialid)
2118 this function updates the time when a claim is issued for late/missing items
2120 called from claims.pl file
2125 my ($serialid) = @_;
2126 my $dbh = C4::Context->dbh;
2127 my $sth = $dbh->prepare(
2128 "UPDATE serial SET claimdate = now()
2132 $sth->execute($serialid);
2136 =head2 getsupplierbyserialid
2138 $result = getsupplierbyserialid($serialid)
2140 this function is used to find the supplier id given a serial id
2143 hashref containing serialid, subscriptionid, and aqbooksellerid
2147 sub getsupplierbyserialid {
2148 my ($serialid) = @_;
2149 my $dbh = C4::Context->dbh;
2150 my $sth = $dbh->prepare(
2151 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2153 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2157 $sth->execute($serialid);
2158 my $line = $sth->fetchrow_hashref;
2159 my $result = $line->{'aqbooksellerid'};
2163 =head2 check_routing
2165 $result = &check_routing($subscriptionid)
2167 this function checks to see if a serial has a routing list and returns the count of routingid
2168 used to show either an 'add' or 'edit' link
2173 my ($subscriptionid) = @_;
2175 return unless ($subscriptionid);
2177 my $dbh = C4::Context->dbh;
2178 my $sth = $dbh->prepare(
2179 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2180 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2181 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2184 $sth->execute($subscriptionid);
2185 my $line = $sth->fetchrow_hashref;
2186 my $result = $line->{'routingids'};
2190 =head2 addroutingmember
2192 addroutingmember($borrowernumber,$subscriptionid)
2194 this function takes a borrowernumber and subscriptionid and adds the member to the
2195 routing list for that serial subscription and gives them a rank on the list
2196 of either 1 or highest current rank + 1
2200 sub addroutingmember {
2201 my ( $borrowernumber, $subscriptionid ) = @_;
2203 return unless ($borrowernumber and $subscriptionid);
2206 my $dbh = C4::Context->dbh;
2207 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2208 $sth->execute($subscriptionid);
2209 while ( my $line = $sth->fetchrow_hashref ) {
2210 if ( $line->{'rank'} > 0 ) {
2211 $rank = $line->{'rank'} + 1;
2216 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2217 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2220 =head2 reorder_members
2222 reorder_members($subscriptionid,$routingid,$rank)
2224 this function is used to reorder the routing list
2226 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2227 - it gets all members on list puts their routingid's into an array
2228 - removes the one in the array that is $routingid
2229 - then reinjects $routingid at point indicated by $rank
2230 - then update the database with the routingids in the new order
2234 sub reorder_members {
2235 my ( $subscriptionid, $routingid, $rank ) = @_;
2236 my $dbh = C4::Context->dbh;
2237 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2238 $sth->execute($subscriptionid);
2240 while ( my $line = $sth->fetchrow_hashref ) {
2241 push( @result, $line->{'routingid'} );
2244 # To find the matching index
2246 my $key = -1; # to allow for 0 being a valid response
2247 for ( $i = 0 ; $i < @result ; $i++ ) {
2248 if ( $routingid == $result[$i] ) {
2249 $key = $i; # save the index
2254 # if index exists in array then move it to new position
2255 if ( $key > -1 && $rank > 0 ) {
2256 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2257 my $moving_item = splice( @result, $key, 1 );
2258 splice( @result, $new_rank, 0, $moving_item );
2260 for ( my $j = 0 ; $j < @result ; $j++ ) {
2261 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2267 =head2 delroutingmember
2269 delroutingmember($routingid,$subscriptionid)
2271 this function either deletes one member from routing list if $routingid exists otherwise
2272 deletes all members from the routing list
2276 sub delroutingmember {
2278 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2279 my ( $routingid, $subscriptionid ) = @_;
2280 my $dbh = C4::Context->dbh;
2282 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2283 $sth->execute($routingid);
2284 reorder_members( $subscriptionid, $routingid );
2286 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2287 $sth->execute($subscriptionid);
2292 =head2 getroutinglist
2294 @routinglist = getroutinglist($subscriptionid)
2296 this gets the info from the subscriptionroutinglist for $subscriptionid
2299 the routinglist as an array. Each element of the array contains a hash_ref containing
2300 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2304 sub getroutinglist {
2305 my ($subscriptionid) = @_;
2306 my $dbh = C4::Context->dbh;
2307 my $sth = $dbh->prepare(
2308 'SELECT routingid, borrowernumber, ranking, biblionumber
2310 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2311 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2313 $sth->execute($subscriptionid);
2314 my $routinglist = $sth->fetchall_arrayref({});
2315 return @{$routinglist};
2318 =head2 countissuesfrom
2320 $result = countissuesfrom($subscriptionid,$startdate)
2322 Returns a count of serial rows matching the given subsctiptionid
2323 with published date greater than startdate
2327 sub countissuesfrom {
2328 my ( $subscriptionid, $startdate ) = @_;
2329 my $dbh = C4::Context->dbh;
2333 WHERE subscriptionid=?
2334 AND serial.publisheddate>?
2336 my $sth = $dbh->prepare($query);
2337 $sth->execute( $subscriptionid, $startdate );
2338 my ($countreceived) = $sth->fetchrow;
2339 return $countreceived;
2344 $result = CountIssues($subscriptionid)
2346 Returns a count of serial rows matching the given subsctiptionid
2351 my ($subscriptionid) = @_;
2352 my $dbh = C4::Context->dbh;
2356 WHERE subscriptionid=?
2358 my $sth = $dbh->prepare($query);
2359 $sth->execute($subscriptionid);
2360 my ($countreceived) = $sth->fetchrow;
2361 return $countreceived;
2366 $result = HasItems($subscriptionid)
2368 returns a count of items from serial matching the subscriptionid
2373 my ($subscriptionid) = @_;
2374 my $dbh = C4::Context->dbh;
2376 SELECT COUNT(serialitems.itemnumber)
2378 LEFT JOIN serialitems USING(serialid)
2379 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2381 my $sth=$dbh->prepare($query);
2382 $sth->execute($subscriptionid);
2383 my ($countitems)=$sth->fetchrow_array();
2387 =head2 abouttoexpire
2389 $result = abouttoexpire($subscriptionid)
2391 this function alerts you to the penultimate issue for a serial subscription
2393 returns 1 - if this is the penultimate issue
2399 my ($subscriptionid) = @_;
2400 my $dbh = C4::Context->dbh;
2401 my $subscription = GetSubscription($subscriptionid);
2402 my $per = $subscription->{'periodicity'};
2403 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2404 if ($frequency and $frequency->{unit}){
2405 my $expirationdate = GetExpirationDate($subscriptionid);
2406 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2407 my $nextdate = GetNextDate($subscription, $res);
2408 if(Date::Calc::Delta_Days(
2409 split( /-/, $nextdate ),
2410 split( /-/, $expirationdate )
2414 } elsif ($subscription->{numberlength}>0) {
2415 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2420 sub in_array { # used in next sub down
2421 my ( $val, @elements ) = @_;
2422 foreach my $elem (@elements) {
2423 if ( $val == $elem ) {
2430 =head2 GetSubscriptionsFromBorrower
2432 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2434 this gets the info from subscriptionroutinglist for each $subscriptionid
2437 a count of the serial subscription routing lists to which a patron belongs,
2438 with the titles of those serial subscriptions as an array. Each element of the array
2439 contains a hash_ref with subscriptionID and title of subscription.
2443 sub GetSubscriptionsFromBorrower {
2444 my ($borrowernumber) = @_;
2445 my $dbh = C4::Context->dbh;
2446 my $sth = $dbh->prepare(
2447 "SELECT subscription.subscriptionid, biblio.title
2449 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2450 JOIN subscriptionroutinglist USING (subscriptionid)
2451 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2454 $sth->execute($borrowernumber);
2457 while ( my $line = $sth->fetchrow_hashref ) {
2459 push( @routinglist, $line );
2461 return ( $count, @routinglist );
2465 =head2 GetFictiveIssueNumber
2467 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2469 Get the position of the issue published at $publisheddate, considering the
2470 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2471 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2472 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2473 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2474 depending on how many rows are in serial table.
2475 The issue number calculation is based on subscription frequency, first acquisition
2476 date, and $publisheddate.
2480 sub GetFictiveIssueNumber {
2481 my ($subscription, $publisheddate) = @_;
2483 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2484 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2488 my ($year, $month, $day) = split /-/, $publisheddate;
2489 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2493 if($unit eq 'day') {
2494 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2495 } elsif($unit eq 'week') {
2496 ($wkno, $year) = Week_of_Year($year, $month, $day);
2497 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2498 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2499 } elsif($unit eq 'month') {
2500 $delta = ($fa_year == $year)
2501 ? ($month - $fa_month)
2502 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2503 } elsif($unit eq 'year') {
2504 $delta = $year - $fa_year;
2506 if($frequency->{'unitsperissue'} == 1) {
2507 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2509 # Assuming issuesperunit == 1
2510 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2518 $resultdate = GetNextDate($publisheddate,$subscription)
2520 this function it takes the publisheddate and will return the next issue's date
2521 and will skip dates if there exists an irregularity.
2522 $publisheddate has to be an ISO date
2523 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2524 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2525 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2526 skipped then the returned date will be 2007-05-10
2529 $resultdate - then next date in the sequence (ISO date)
2531 Return undef if subscription is irregular
2536 my ( $subscription, $publisheddate, $updatecount ) = @_;
2538 return unless $subscription and $publisheddate;
2540 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2542 if ($freqdata->{'unit'}) {
2543 my ( $year, $month, $day ) = split /-/, $publisheddate;
2545 # Process an irregularity Hash
2546 # Suppose that irregularities are stored in a string with this structure
2547 # irreg1;irreg2;irreg3
2548 # where irregX is the number of issue which will not be received
2549 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2551 if ( $subscription->{irregularity} ) {
2552 my @irreg = split /;/, $subscription->{'irregularity'} ;
2553 foreach my $irregularity (@irreg) {
2554 $irregularities{$irregularity} = 1;
2558 # Get the 'fictive' next issue number
2559 # It is used to check if next issue is an irregular issue.
2560 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2562 # Then get the next date
2563 my $unit = lc $freqdata->{'unit'};
2564 if ($unit eq 'day') {
2565 while ($irregularities{$issueno}) {
2566 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2567 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
2568 $subscription->{'countissuesperunit'} = 1;
2570 $subscription->{'countissuesperunit'}++;
2574 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2575 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
2576 $subscription->{'countissuesperunit'} = 1;
2578 $subscription->{'countissuesperunit'}++;
2581 elsif ($unit eq 'week') {
2582 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2583 while ($irregularities{$issueno}) {
2584 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2585 $subscription->{'countissuesperunit'} = 1;
2586 $wkno += $freqdata->{"unitsperissue"};
2591 my $dow = Day_of_Week($year, $month, $day);
2592 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2593 if($freqdata->{'issuesperunit'} == 1) {
2594 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2597 $subscription->{'countissuesperunit'}++;
2601 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2602 $subscription->{'countissuesperunit'} = 1;
2603 $wkno += $freqdata->{"unitsperissue"};
2605 $wkno = $wkno % 52 ;
2608 my $dow = Day_of_Week($year, $month, $day);
2609 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2610 if($freqdata->{'issuesperunit'} == 1) {
2611 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2614 $subscription->{'countissuesperunit'}++;
2617 elsif ($unit eq 'month') {
2618 while ($irregularities{$issueno}) {
2619 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2620 $subscription->{'countissuesperunit'} = 1;
2621 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2622 unless($freqdata->{'issuesperunit'} == 1) {
2623 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2626 $subscription->{'countissuesperunit'}++;
2630 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2631 $subscription->{'countissuesperunit'} = 1;
2632 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2633 unless($freqdata->{'issuesperunit'} == 1) {
2634 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2637 $subscription->{'countissuesperunit'}++;
2640 elsif ($unit eq 'year') {
2641 while ($irregularities{$issueno}) {
2642 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2643 $subscription->{'countissuesperunit'} = 1;
2644 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2645 unless($freqdata->{'issuesperunit'} == 1) {
2646 # Jumping to the first day of year, because we don't know what day is expected
2651 $subscription->{'countissuesperunit'}++;
2655 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2656 $subscription->{'countissuesperunit'} = 1;
2657 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2658 unless($freqdata->{'issuesperunit'} == 1) {
2659 # Jumping to the first day of year, because we don't know what day is expected
2664 $subscription->{'countissuesperunit'}++;
2668 my $dbh = C4::Context->dbh;
2671 SET countissuesperunit = ?
2672 WHERE subscriptionid = ?
2674 my $sth = $dbh->prepare($query);
2675 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2677 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2683 $string = &_numeration($value,$num_type,$locale);
2685 _numeration returns the string corresponding to $value in the num_type
2695 my ($value, $num_type, $locale) = @_;
2701 when (/^dayname$/) {
2702 # 1970-11-01 was a Sunday
2703 $value = $value % 7;
2704 my $dt = DateTime->new(
2710 $string = $dt->strftime("%A");
2712 when (/^monthname$/) {
2713 $value = $value % 12;
2714 my $dt = DateTime->new(
2716 month => $value + 1,
2719 $string = $dt->strftime("%B");
2722 my @seasons= qw( Spring Summer Fall Winter );
2723 $value = $value % 4;
2724 $string = $seasons[$value];
2733 =head2 is_barcode_in_use
2735 Returns number of occurence of the barcode in the items table
2736 Can be used as a boolean test of whether the barcode has
2737 been deployed as yet
2741 sub is_barcode_in_use {
2742 my $barcode = shift;
2743 my $dbh = C4::Context->dbh;
2744 my $occurences = $dbh->selectall_arrayref(
2745 'SELECT itemnumber from items where barcode = ?',
2750 return @{$occurences};
2753 =head2 CloseSubscription
2754 Close a subscription given a subscriptionid
2756 sub CloseSubscription {
2757 my ( $subscriptionid ) = @_;
2758 return unless $subscriptionid;
2759 my $dbh = C4::Context->dbh;
2760 my $sth = $dbh->prepare( qq{
2763 WHERE subscriptionid = ?
2765 $sth->execute( $subscriptionid );
2767 # Set status = missing when status = stopped
2768 $sth = $dbh->prepare( qq{
2771 WHERE subscriptionid = ?
2774 $sth->execute( $subscriptionid );
2777 =head2 ReopenSubscription
2778 Reopen a subscription given a subscriptionid
2780 sub ReopenSubscription {
2781 my ( $subscriptionid ) = @_;
2782 return unless $subscriptionid;
2783 my $dbh = C4::Context->dbh;
2784 my $sth = $dbh->prepare( qq{
2787 WHERE subscriptionid = ?
2789 $sth->execute( $subscriptionid );
2791 # Set status = expected when status = stopped
2792 $sth = $dbh->prepare( qq{
2795 WHERE subscriptionid = ?
2798 $sth->execute( $subscriptionid );
2801 =head2 subscriptionCurrentlyOnOrder
2803 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2805 Return 1 if subscription is currently on order else 0.
2809 sub subscriptionCurrentlyOnOrder {
2810 my ( $subscriptionid ) = @_;
2811 my $dbh = C4::Context->dbh;
2813 SELECT COUNT(*) FROM aqorders
2814 WHERE subscriptionid = ?
2815 AND datereceived IS NULL
2816 AND datecancellationprinted IS NULL
2818 my $sth = $dbh->prepare( $query );
2819 $sth->execute($subscriptionid);
2820 return $sth->fetchrow_array;
2823 =head2 can_edit_subscription
2825 $can = can_edit_subscription( $subscriptionid[, $userid] );
2827 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2831 sub can_edit_subscription {
2832 my ( $subscription, $userid ) = @_;
2833 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2836 =head2 can_show_subscription
2838 $can = can_show_subscription( $subscriptionid[, $userid] );
2840 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2844 sub can_show_subscription {
2845 my ( $subscription, $userid ) = @_;
2846 return _can_do_on_subscription( $subscription, $userid, '*' );
2849 sub _can_do_on_subscription {
2850 my ( $subscription, $userid, $permission ) = @_;
2851 return 0 unless C4::Context->userenv;
2852 my $flags = C4::Context->userenv->{flags};
2853 $userid ||= C4::Context->userenv->{'id'};
2855 if ( C4::Context->preference('IndependentBranches') ) {
2857 if C4::Context->IsSuperLibrarian()
2859 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2861 C4::Auth::haspermission( $userid,
2862 { serials => $permission } )
2863 and ( not defined $subscription->{branchcode}
2864 or $subscription->{branchcode} eq ''
2865 or $subscription->{branchcode} eq
2866 C4::Context->userenv->{'branch'} )
2871 if C4::Context->IsSuperLibrarian()
2873 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2874 or C4::Auth::haspermission(
2875 $userid, { serials => $permission }
2887 Koha Development Team <http://koha-community.org/>