3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 use C4::Dates qw(format_date format_date_in_iso);
24 use Date::Calc qw(:all);
25 use POSIX qw(strftime);
27 use C4::Log; # logaction
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33 $VERSION = 3.01; # set version for version checking
37 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
38 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
39 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
40 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
42 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
43 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
44 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
45 &GetSerialInformation &AddItem2Serial
46 &PrepareSerialsData &GetNextExpected &ModNextExpected
48 &UpdateClaimdateIssues
49 &GetSuppliersWithLateIssues &getsupplierbyserialid
50 &GetDistributedTo &SetDistributedTo
51 &getroutinglist &delroutingmember &addroutingmember
53 &check_routing &updateClaim &removeMissingIssue
62 C4::Serials - Serials Module Functions
70 Functions for handling subscriptions, claims routing etc.
75 =head2 GetSuppliersWithLateIssues
77 $supplierlist = GetSuppliersWithLateIssues()
79 this function get all suppliers with late issues.
82 an array_ref of suppliers each entry is a hash_ref containing id and name
83 the array is in name order
87 sub GetSuppliersWithLateIssues {
88 my $dbh = C4::Context->dbh;
90 SELECT DISTINCT id, name
92 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
93 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
94 WHERE id > 0 AND ((planneddate < now() AND serial.status=1) OR serial.STATUS = 3 OR serial.STATUS = 4) ORDER BY name|;
95 return $dbh->selectall_arrayref($query, { Slice => {} });
100 @issuelist = GetLateIssues($supplierid)
102 this function selects late issues from the database
105 the issuelist as an array. Each element of this array contains a hashi_ref containing
106 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
111 my ($supplierid) = @_;
112 my $dbh = C4::Context->dbh;
116 SELECT name,title,planneddate,serialseq,serial.subscriptionid
118 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
119 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
120 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
121 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
122 AND subscription.aqbooksellerid=?
125 $sth = $dbh->prepare($query);
126 $sth->execute($supplierid);
129 SELECT name,title,planneddate,serialseq,serial.subscriptionid
131 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
132 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
133 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
134 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
137 $sth = $dbh->prepare($query);
143 while ( my $line = $sth->fetchrow_hashref ) {
144 $odd++ unless $line->{title} eq $last_title;
145 $line->{title} = "" if $line->{title} eq $last_title;
146 $last_title = $line->{title} if ( $line->{title} );
147 $line->{planneddate} = format_date( $line->{planneddate} );
148 push @issuelist, $line;
153 =head2 GetSubscriptionHistoryFromSubscriptionId
155 $sth = GetSubscriptionHistoryFromSubscriptionId()
156 this function prepares the SQL request and returns the statement handle
157 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
161 sub GetSubscriptionHistoryFromSubscriptionId() {
162 my $dbh = C4::Context->dbh;
165 FROM subscriptionhistory
166 WHERE subscriptionid = ?
168 return $dbh->prepare($query);
171 =head2 GetSerialStatusFromSerialId
173 $sth = GetSerialStatusFromSerialId();
174 this function returns a statement handle
175 After this function, don't forget to execute it by using $sth->execute($serialid)
177 $sth = $dbh->prepare($query).
181 sub GetSerialStatusFromSerialId() {
182 my $dbh = C4::Context->dbh;
188 return $dbh->prepare($query);
191 =head2 GetSerialInformation
194 $data = GetSerialInformation($serialid);
195 returns a hash_ref containing :
196 items : items marcrecord (can be an array)
198 subscription table field
199 + information about subscription expiration
203 sub GetSerialInformation {
205 my $dbh = C4::Context->dbh;
207 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
208 if ( C4::Context->preference('IndependantBranches')
209 && C4::Context->userenv
210 && C4::Context->userenv->{'flags'} != 1
211 && C4::Context->userenv->{'branch'} ) {
213 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
216 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
219 my $rq = $dbh->prepare($query);
220 $rq->execute($serialid);
221 my $data = $rq->fetchrow_hashref;
223 # create item information if we have serialsadditems for this subscription
224 if ( $data->{'serialsadditems'} ) {
225 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
226 $queryitem->execute($serialid);
227 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
229 if ( scalar(@$itemnumbers) > 0 ) {
230 foreach my $itemnum (@$itemnumbers) {
232 #It is ASSUMED that GetMarcItem ALWAYS WORK...
233 #Maybe GetMarcItem should return values on failure
234 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
235 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
236 $itemprocessed->{'itemnumber'} = $itemnum->[0];
237 $itemprocessed->{'itemid'} = $itemnum->[0];
238 $itemprocessed->{'serialid'} = $serialid;
239 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
240 push @{ $data->{'items'} }, $itemprocessed;
243 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
244 $itemprocessed->{'itemid'} = "N$serialid";
245 $itemprocessed->{'serialid'} = $serialid;
246 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
247 $itemprocessed->{'countitems'} = 0;
248 push @{ $data->{'items'} }, $itemprocessed;
251 $data->{ "status" . $data->{'serstatus'} } = 1;
252 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
253 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
257 =head2 AddItem2Serial
259 $rows = AddItem2Serial($serialid,$itemnumber);
260 Adds an itemnumber to Serial record
261 returns the number of rows affected
266 my ( $serialid, $itemnumber ) = @_;
267 my $dbh = C4::Context->dbh;
268 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
269 $rq->execute( $serialid, $itemnumber );
273 =head2 UpdateClaimdateIssues
275 UpdateClaimdateIssues($serialids,[$date]);
277 Update Claimdate for issues in @$serialids list with date $date
282 sub UpdateClaimdateIssues {
283 my ( $serialids, $date ) = @_;
284 my $dbh = C4::Context->dbh;
285 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
287 UPDATE serial SET claimdate = ?, status = 7
288 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
289 my $rq = $dbh->prepare($query);
290 $rq->execute($date, @$serialids);
294 =head2 GetSubscription
296 $subs = GetSubscription($subscriptionid)
297 this function returns the subscription which has $subscriptionid as id.
299 a hashref. This hash containts
300 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
304 sub GetSubscription {
305 my ($subscriptionid) = @_;
306 my $dbh = C4::Context->dbh;
308 SELECT subscription.*,
309 subscriptionhistory.*,
310 aqbooksellers.name AS aqbooksellername,
311 biblio.title AS bibliotitle,
312 subscription.biblionumber as bibnum);
313 if ( C4::Context->preference('IndependantBranches')
314 && C4::Context->userenv
315 && C4::Context->userenv->{'flags'} != 1
316 && C4::Context->userenv->{'branch'} ) {
318 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
322 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
323 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
324 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
325 WHERE subscription.subscriptionid = ?
328 # if (C4::Context->preference('IndependantBranches') &&
329 # C4::Context->userenv &&
330 # C4::Context->userenv->{'flags'} != 1){
331 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
332 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
334 $debug and warn "query : $query\nsubsid :$subscriptionid";
335 my $sth = $dbh->prepare($query);
336 $sth->execute($subscriptionid);
337 return $sth->fetchrow_hashref;
340 =head2 GetFullSubscription
342 $array_ref = GetFullSubscription($subscriptionid)
343 this function reads the serial table.
347 sub GetFullSubscription {
348 my ($subscriptionid) = @_;
349 my $dbh = C4::Context->dbh;
351 SELECT serial.serialid,
354 serial.publisheddate,
356 serial.notes as notes,
357 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
358 aqbooksellers.name as aqbooksellername,
359 biblio.title as bibliotitle,
360 subscription.branchcode AS branchcode,
361 subscription.subscriptionid AS subscriptionid |;
362 if ( C4::Context->preference('IndependantBranches')
363 && C4::Context->userenv
364 && C4::Context->userenv->{'flags'} != 1
365 && C4::Context->userenv->{'branch'} ) {
367 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
371 LEFT JOIN subscription ON
372 (serial.subscriptionid=subscription.subscriptionid )
373 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
374 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
375 WHERE serial.subscriptionid = ?
377 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
378 serial.subscriptionid
380 $debug and warn "GetFullSubscription query: $query";
381 my $sth = $dbh->prepare($query);
382 $sth->execute($subscriptionid);
383 return $sth->fetchall_arrayref( {} );
386 =head2 PrepareSerialsData
388 $array_ref = PrepareSerialsData($serialinfomation)
389 where serialinformation is a hashref array
393 sub PrepareSerialsData {
399 my $aqbooksellername;
403 my $previousnote = "";
405 foreach my $subs (@{$lines}) {
406 for my $datefield ( qw(publisheddate planneddate) ) {
407 # handle both undef and undef returned as 0000-00-00
408 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
409 $subs->{$datefield} = 'XXX';
412 $subs->{$datefield} = format_date( $subs->{$datefield} );
415 $subs->{ "status" . $subs->{'status'} } = 1;
416 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
418 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
419 $year = $subs->{'year'};
423 if ( $tmpresults{$year} ) {
424 push @{ $tmpresults{$year}->{'serials'} }, $subs;
426 $tmpresults{$year} = {
428 'aqbooksellername' => $subs->{'aqbooksellername'},
429 'bibliotitle' => $subs->{'bibliotitle'},
430 'serials' => [$subs],
435 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
436 push @res, $tmpresults{$key};
441 =head2 GetSubscriptionsFromBiblionumber
443 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
444 this function get the subscription list. it reads the subscription table.
446 reference to an array of subscriptions which have the biblionumber given on input arg.
447 each element of this array is a hashref containing
448 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
452 sub GetSubscriptionsFromBiblionumber {
453 my ($biblionumber) = @_;
454 my $dbh = C4::Context->dbh;
456 SELECT subscription.*,
458 subscriptionhistory.*,
459 aqbooksellers.name AS aqbooksellername,
460 biblio.title AS bibliotitle
462 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
463 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
464 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
465 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
466 WHERE subscription.biblionumber = ?
468 my $sth = $dbh->prepare($query);
469 $sth->execute($biblionumber);
471 while ( my $subs = $sth->fetchrow_hashref ) {
472 $subs->{startdate} = format_date( $subs->{startdate} );
473 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
474 $subs->{histenddate} = format_date( $subs->{histenddate} );
475 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
476 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
477 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
478 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
479 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
480 $subs->{ "status" . $subs->{'status'} } = 1;
481 $subs->{'cannotedit'} =
482 ( C4::Context->preference('IndependantBranches')
483 && C4::Context->userenv
484 && C4::Context->userenv->{flags} % 2 != 1
485 && C4::Context->userenv->{branch}
486 && $subs->{branchcode}
487 && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
489 if ( $subs->{enddate} eq '0000-00-00' ) {
490 $subs->{enddate} = '';
492 $subs->{enddate} = format_date( $subs->{enddate} );
494 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
495 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
501 =head2 GetFullSubscriptionsFromBiblionumber
503 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
504 this function reads the serial table.
508 sub GetFullSubscriptionsFromBiblionumber {
509 my ($biblionumber) = @_;
510 my $dbh = C4::Context->dbh;
512 SELECT serial.serialid,
515 serial.publisheddate,
517 serial.notes as notes,
518 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
519 biblio.title as bibliotitle,
520 subscription.branchcode AS branchcode,
521 subscription.subscriptionid AS subscriptionid|;
522 if ( C4::Context->preference('IndependantBranches')
523 && C4::Context->userenv
524 && C4::Context->userenv->{'flags'} != 1
525 && C4::Context->userenv->{'branch'} ) {
527 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
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 return $sth->fetchall_arrayref( {} );
546 =head2 GetSubscriptions
548 @results = GetSubscriptions($title,$ISSN,$biblionumber);
549 this function gets all subscriptions which have title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
551 a table of hashref. Each hash containt the subscription.
555 sub GetSubscriptions {
556 my ( $string, $issn, $biblionumber ) = @_;
558 #return unless $title or $ISSN or $biblionumber;
559 my $dbh = C4::Context->dbh;
562 SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber
564 LEFT JOIN subscriptionhistory USING(subscriptionid)
565 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
566 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
571 $sqlwhere = " WHERE biblio.biblionumber=?";
572 push @bind_params, $biblionumber;
576 my @strings_to_search;
577 @strings_to_search = map { "%$_%" } split( / /, $string );
578 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
579 push @bind_params, @strings_to_search;
580 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
581 $debug && warn "$tmpstring";
582 $tmpstring =~ s/^AND //;
583 push @sqlstrings, $tmpstring;
585 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
589 my @strings_to_search;
590 @strings_to_search = map { "%$_%" } split( / /, $issn );
591 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
592 push @bind_params, @strings_to_search;
593 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
594 $debug && warn "$tmpstring";
595 $tmpstring =~ s/^OR //;
596 push @sqlstrings, $tmpstring;
598 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
600 $sql .= "$sqlwhere ORDER BY title";
601 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
602 $sth = $dbh->prepare($sql);
603 $sth->execute(@bind_params);
606 while ( my $line = $sth->fetchrow_hashref ) {
607 $line->{'cannotedit'} =
608 ( C4::Context->preference('IndependantBranches')
609 && C4::Context->userenv
610 && C4::Context->userenv->{flags} % 2 != 1
611 && C4::Context->userenv->{branch}
612 && $line->{branchcode}
613 && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
614 push @results, $line;
621 ($totalissues,@serials) = GetSerials($subscriptionid);
622 this function gets every serial not arrived for a given subscription
623 as well as the number of issues registered in the database (all types)
624 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
626 FIXME: We should return \@serials.
631 my ( $subscriptionid, $count ) = @_;
632 my $dbh = C4::Context->dbh;
634 # status = 2 is "arrived"
636 $count = 5 unless ($count);
638 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
640 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
641 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
642 my $sth = $dbh->prepare($query);
643 $sth->execute($subscriptionid);
645 while ( my $line = $sth->fetchrow_hashref ) {
646 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
647 for my $datefield ( qw( planneddate publisheddate) ) {
648 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
649 $line->{$datefield} = format_date( $line->{$datefield});
651 $line->{$datefield} = q{};
654 push @serials, $line;
657 # OK, now add the last 5 issues arrives/missing
658 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
660 WHERE subscriptionid = ?
661 AND (status in (2,4,5))
662 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
664 $sth = $dbh->prepare($query);
665 $sth->execute($subscriptionid);
666 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
668 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
669 for my $datefield ( qw( planneddate publisheddate) ) {
670 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
671 $line->{$datefield} = format_date( $line->{$datefield});
673 $line->{$datefield} = q{};
677 push @serials, $line;
680 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
681 $sth = $dbh->prepare($query);
682 $sth->execute($subscriptionid);
683 my ($totalissues) = $sth->fetchrow;
684 return ( $totalissues, @serials );
689 @serials = GetSerials2($subscriptionid,$status);
690 this function returns every serial waited for a given subscription
691 as well as the number of issues registered in the database (all types)
692 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
697 my ( $subscription, $status ) = @_;
698 my $dbh = C4::Context->dbh;
700 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
702 WHERE subscriptionid=$subscription AND status IN ($status)
703 ORDER BY publisheddate,serialid DESC
705 $debug and warn "GetSerials2 query: $query";
706 my $sth = $dbh->prepare($query);
710 while ( my $line = $sth->fetchrow_hashref ) {
711 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
712 # Format dates for display
713 for my $datefield ( qw( planneddate publisheddate ) ) {
714 if ($line->{$datefield} =~m/^00/) {
715 $line->{$datefield} = q{};
718 $line->{$datefield} = format_date( $line->{$datefield} );
721 push @serials, $line;
726 =head2 GetLatestSerials
728 \@serials = GetLatestSerials($subscriptionid,$limit)
729 get the $limit's latest serials arrived or missing for a given subscription
731 a ref to an array which contains all of the latest serials stored into a hash.
735 sub GetLatestSerials {
736 my ( $subscriptionid, $limit ) = @_;
737 my $dbh = C4::Context->dbh;
739 # status = 2 is "arrived"
740 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
742 WHERE subscriptionid = ?
743 AND (status =2 or status=4)
744 ORDER BY planneddate DESC LIMIT 0,$limit
746 my $sth = $dbh->prepare($strsth);
747 $sth->execute($subscriptionid);
749 while ( my $line = $sth->fetchrow_hashref ) {
750 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
751 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
752 push @serials, $line;
758 =head2 GetDistributedTo
760 $distributedto=GetDistributedTo($subscriptionid)
761 This function returns the field distributedto for the subscription matching subscriptionid
765 sub GetDistributedTo {
766 my $dbh = C4::Context->dbh;
768 my $subscriptionid = @_;
769 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
770 my $sth = $dbh->prepare($query);
771 $sth->execute($subscriptionid);
772 return ($distributedto) = $sth->fetchrow;
778 $val is a hashref containing all the attributes of the table 'subscription'
779 This function get the next issue for the subscription given on input arg
781 a list containing all the input params updated.
787 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
788 # $calculated = $val->{numberingmethod};
789 # # calculate the (expected) value of the next issue recieved.
790 # $newlastvalue1 = $val->{lastvalue1};
791 # # check if we have to increase the new value.
792 # $newinnerloop1 = $val->{innerloop1}+1;
793 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
794 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
795 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
796 # $calculated =~ s/\{X\}/$newlastvalue1/g;
798 # $newlastvalue2 = $val->{lastvalue2};
799 # # check if we have to increase the new value.
800 # $newinnerloop2 = $val->{innerloop2}+1;
801 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
802 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
803 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
804 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
806 # $newlastvalue3 = $val->{lastvalue3};
807 # # check if we have to increase the new value.
808 # $newinnerloop3 = $val->{innerloop3}+1;
809 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
810 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
811 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
812 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
813 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
818 my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
819 my $pattern = $val->{numberpattern};
820 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
821 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
822 $calculated = $val->{numberingmethod};
823 $newlastvalue1 = $val->{lastvalue1};
824 $newlastvalue2 = $val->{lastvalue2};
825 $newlastvalue3 = $val->{lastvalue3};
826 $newlastvalue1 = $val->{lastvalue1};
828 # check if we have to increase the new value.
829 $newinnerloop1 = $val->{innerloop1} + 1;
830 $newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} );
831 $newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 ); # <1 to be true when 0 or empty.
832 $newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} ); # reset counter if needed.
833 $calculated =~ s/\{X\}/$newlastvalue1/g;
835 $newlastvalue2 = $val->{lastvalue2};
837 # check if we have to increase the new value.
838 $newinnerloop2 = $val->{innerloop2} + 1;
839 $newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} );
840 $newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 ); # <1 to be true when 0 or empty.
841 $newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} ); # reset counter if needed.
842 if ( $pattern == 6 ) {
843 if ( $val->{hemisphere} == 2 ) {
844 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
845 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
847 my $newlastvalue2seq = $seasons[$newlastvalue2];
848 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
851 $calculated =~ s/\{Y\}/$newlastvalue2/g;
854 $newlastvalue3 = $val->{lastvalue3};
856 # check if we have to increase the new value.
857 $newinnerloop3 = $val->{innerloop3} + 1;
858 $newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} );
859 $newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 ); # <1 to be true when 0 or empty.
860 $newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} ); # reset counter if needed.
861 $calculated =~ s/\{Z\}/$newlastvalue3/g;
863 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
868 $calculated = GetSeq($val)
869 $val is a hashref containing all the attributes of the table 'subscription'
870 this function transforms {X},{Y},{Z} to 150,0,0 for example.
872 the sequence in integer format
878 my $pattern = $val->{numberpattern};
879 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
880 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
881 my $calculated = $val->{numberingmethod};
882 my $x = $val->{'lastvalue1'};
883 $calculated =~ s/\{X\}/$x/g;
884 my $newlastvalue2 = $val->{'lastvalue2'};
886 if ( $pattern == 6 ) {
887 if ( $val->{hemisphere} == 2 ) {
888 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
889 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
891 my $newlastvalue2seq = $seasons[$newlastvalue2];
892 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
895 $calculated =~ s/\{Y\}/$newlastvalue2/g;
897 my $z = $val->{'lastvalue3'};
898 $calculated =~ s/\{Z\}/$z/g;
902 =head2 GetExpirationDate
904 $enddate = GetExpirationDate($subscriptionid, [$startdate])
906 this function return the next expiration date for a subscription given on input args.
913 sub GetExpirationDate {
914 my ( $subscriptionid, $startdate ) = @_;
915 my $dbh = C4::Context->dbh;
916 my $subscription = GetSubscription($subscriptionid);
919 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
920 $enddate = $startdate || $subscription->{startdate};
921 my @date = split( /-/, $enddate );
922 return if ( scalar(@date) != 3 || not check_date(@date) );
923 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
926 if ( my $length = $subscription->{numberlength} ) {
928 #calculate the date of the last issue.
929 for ( my $i = 1 ; $i <= $length ; $i++ ) {
930 $enddate = GetNextDate( $enddate, $subscription );
932 } elsif ( $subscription->{monthlength} ) {
933 if ( $$subscription{startdate} ) {
934 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
935 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
937 } elsif ( $subscription->{weeklength} ) {
938 if ( $$subscription{startdate} ) {
939 my @date = split( /-/, $subscription->{startdate} );
940 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
941 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
950 =head2 CountSubscriptionFromBiblionumber
952 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
953 this returns a count of the subscriptions for a given biblionumber
955 the number of subscriptions
959 sub CountSubscriptionFromBiblionumber {
960 my ($biblionumber) = @_;
961 my $dbh = C4::Context->dbh;
962 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
963 my $sth = $dbh->prepare($query);
964 $sth->execute($biblionumber);
965 my $subscriptionsnumber = $sth->fetchrow;
966 return $subscriptionsnumber;
969 =head2 ModSubscriptionHistory
971 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
973 this function modifies the history of a subscription. Put your new values on input arg.
974 returns the number of rows affected
978 sub ModSubscriptionHistory {
979 my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_;
980 my $dbh = C4::Context->dbh;
981 my $query = "UPDATE subscriptionhistory
982 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
983 WHERE subscriptionid=?
985 my $sth = $dbh->prepare($query);
986 $recievedlist =~ s/^; //;
987 $missinglist =~ s/^; //;
988 $opacnote =~ s/^; //;
989 $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
993 =head2 ModSerialStatus
995 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
997 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
998 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1002 sub ModSerialStatus {
1003 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1005 #It is a usual serial
1006 # 1st, get previous status :
1007 my $dbh = C4::Context->dbh;
1008 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1009 my $sth = $dbh->prepare($query);
1010 $sth->execute($serialid);
1011 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1013 # change status & update subscriptionhistory
1015 if ( $status == 6 ) {
1016 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1020 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1021 $sth = $dbh->prepare($query);
1022 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1023 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1024 $sth = $dbh->prepare($query);
1025 $sth->execute($subscriptionid);
1026 my $val = $sth->fetchrow_hashref;
1027 unless ( $val->{manualhistory} ) {
1028 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1029 $sth = $dbh->prepare($query);
1030 $sth->execute($subscriptionid);
1031 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1032 if ( $status == 2 ) {
1034 $recievedlist .= "; $serialseq"
1035 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1038 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1039 $missinglist .= "; $serialseq"
1041 and not index( "$missinglist", "$serialseq" ) >= 0 );
1042 $missinglist .= "; not issued $serialseq"
1044 and index( "$missinglist", "$serialseq" ) >= 0 );
1045 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1046 $sth = $dbh->prepare($query);
1047 $recievedlist =~ s/^; //;
1048 $missinglist =~ s/^; //;
1049 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1053 # create new waited entry if needed (ie : was a "waited" and has changed)
1054 if ( $oldstatus == 1 && $status != 1 ) {
1055 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1056 $sth = $dbh->prepare($query);
1057 $sth->execute($subscriptionid);
1058 my $val = $sth->fetchrow_hashref;
1062 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1063 $newinnerloop1, $newinnerloop2, $newinnerloop3
1064 ) = GetNextSeq($val);
1066 # next date (calculated from actual date & frequency parameters)
1067 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1068 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate );
1069 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1070 WHERE subscriptionid = ?";
1071 $sth = $dbh->prepare($query);
1072 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1074 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1075 if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) {
1076 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1082 =head2 GetNextExpected
1084 $nextexpected = GetNextExpected($subscriptionid)
1086 Get the planneddate for the current expected issue of the subscription.
1092 planneddate => C4::Dates object
1097 sub GetNextExpected($) {
1098 my ($subscriptionid) = @_;
1099 my $dbh = C4::Context->dbh;
1100 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1102 # Each subscription has only one 'expected' issue, with serial.status==1.
1103 $sth->execute( $subscriptionid, 1 );
1104 my ( $nextissue ) = $sth->fetchrow_hashref;
1106 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1107 $sth->execute( $subscriptionid );
1108 $nextissue = $sth->fetchrow_hashref;
1110 if (!defined $nextissue->{planneddate}) {
1111 # or should this default to 1st Jan ???
1112 $nextissue->{planneddate} = strftime('%Y-%m-%d',localtime);
1114 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1119 =head2 ModNextExpected
1121 ModNextExpected($subscriptionid,$date)
1123 Update the planneddate for the current expected issue of the subscription.
1124 This will modify all future prediction results.
1126 C<$date> is a C4::Dates object.
1132 sub ModNextExpected($$) {
1133 my ( $subscriptionid, $date ) = @_;
1134 my $dbh = C4::Context->dbh;
1136 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1137 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1139 # Each subscription has only one 'expected' issue, with serial.status==1.
1140 $sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 );
1145 =head2 ModSubscription
1147 this function modifies a subscription. Put all new values on input args.
1148 returns the number of rows affected
1152 sub ModSubscription {
1153 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1154 $dow, $irregularity, $numberpattern, $numberlength, $weeklength, $monthlength, $add1, $every1,
1155 $whenmorethan1, $setto1, $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2,
1156 $lastvalue2, $innerloop2, $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1157 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory,
1158 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid
1161 # warn $irregularity;
1162 my $dbh = C4::Context->dbh;
1163 my $query = "UPDATE subscription
1164 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1165 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1166 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1167 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1168 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1169 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?,
1170 letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
1171 staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1173 WHERE subscriptionid = ?";
1175 #warn "query :".$query;
1176 my $sth = $dbh->prepare($query);
1178 $auser, $branchcode, $aqbooksellerid, $cost,
1179 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1180 $dow, "$irregularity", $numberpattern, $numberlength,
1181 $weeklength, $monthlength, $add1, $every1,
1182 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1183 $add2, $every2, $whenmorethan2, $setto2,
1184 $lastvalue2, $innerloop2, $add3, $every3,
1185 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1186 $numberingmethod, $status, $biblionumber, $callnumber,
1187 $notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ),
1188 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1189 $graceperiod, $location, $enddate, $subscriptionid
1191 my $rows = $sth->rows;
1193 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1197 =head2 NewSubscription
1199 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1200 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1201 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1202 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1203 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1204 $numberingmethod, $status, $notes, $serialsadditems,
1205 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
1207 Create a new subscription with value given on input args.
1210 the id of this new subscription
1214 sub NewSubscription {
1215 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1216 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1217 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1218 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status,
1219 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1220 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1222 my $dbh = C4::Context->dbh;
1224 #save subscription (insert into database)
1226 INSERT INTO subscription
1227 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1228 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1229 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1230 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1231 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1232 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1233 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1234 staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
1235 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1237 my $sth = $dbh->prepare($query);
1239 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1240 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1241 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1242 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, "$status",
1243 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1244 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1247 my $subscriptionid = $dbh->{'mysql_insertid'};
1249 $enddate = GetExpirationDate($subscriptionid,$startdate);
1253 WHERE subscriptionid=?
1255 $sth = $dbh->prepare($query);
1256 $sth->execute( $enddate, $subscriptionid );
1258 #then create the 1st waited number
1260 INSERT INTO subscriptionhistory
1261 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1264 $sth = $dbh->prepare($query);
1265 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1267 # reread subscription to get a hash (for calculation of the 1st issue number)
1271 WHERE subscriptionid = ?
1273 $sth = $dbh->prepare($query);
1274 $sth->execute($subscriptionid);
1275 my $val = $sth->fetchrow_hashref;
1277 # calculate issue number
1278 my $serialseq = GetSeq($val);
1281 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1282 VALUES (?,?,?,?,?,?)
1284 $sth = $dbh->prepare($query);
1285 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1287 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1289 #set serial flag on biblio if not already set.
1290 my ( $null, ($bib) ) = GetBiblio($biblionumber);
1291 if ( !$bib->{'serial'} ) {
1292 my $record = GetMarcBiblio($biblionumber);
1293 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1295 eval { $record->field($tag)->update( $subf => 1 ); };
1297 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1299 return $subscriptionid;
1302 =head2 ReNewSubscription
1304 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1306 this function renew a subscription with values given on input args.
1310 sub ReNewSubscription {
1311 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1312 my $dbh = C4::Context->dbh;
1313 my $subscription = GetSubscription($subscriptionid);
1317 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1318 WHERE biblio.biblionumber=?
1320 my $sth = $dbh->prepare($query);
1321 $sth->execute( $subscription->{biblionumber} );
1322 my $biblio = $sth->fetchrow_hashref;
1324 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1325 require C4::Suggestions;
1326 C4::Suggestions::NewSuggestion(
1327 { 'suggestedby' => $user,
1328 'title' => $subscription->{bibliotitle},
1329 'author' => $biblio->{author},
1330 'publishercode' => $biblio->{publishercode},
1331 'note' => $biblio->{note},
1332 'biblionumber' => $subscription->{biblionumber}
1337 # renew subscription
1340 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1341 WHERE subscriptionid=?
1343 $sth = $dbh->prepare($query);
1344 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1345 my $enddate = GetExpirationDate($subscriptionid);
1346 $debug && warn "enddate :$enddate";
1350 WHERE subscriptionid=?
1352 $sth = $dbh->prepare($query);
1353 $sth->execute( $enddate, $subscriptionid );
1355 UPDATE subscriptionhistory
1357 WHERE subscriptionid=?
1359 $sth = $dbh->prepare($query);
1360 $sth->execute( $enddate, $subscriptionid );
1362 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1368 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1370 Create a new issue stored on the database.
1371 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1372 returns the serial id
1377 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1378 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1380 my $dbh = C4::Context->dbh;
1383 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1384 VALUES (?,?,?,?,?,?,?)
1386 my $sth = $dbh->prepare($query);
1387 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1388 my $serialid = $dbh->{'mysql_insertid'};
1390 SELECT missinglist,recievedlist
1391 FROM subscriptionhistory
1392 WHERE subscriptionid=?
1394 $sth = $dbh->prepare($query);
1395 $sth->execute($subscriptionid);
1396 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1398 if ( $status == 2 ) {
1399 ### TODO Add a feature that improves recognition and description.
1400 ### As such count (serialseq) i.e. : N18,2(N19),N20
1401 ### Would use substr and index But be careful to previous presence of ()
1402 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1404 if ( $status == 4 ) {
1405 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1408 UPDATE subscriptionhistory
1409 SET recievedlist=?, missinglist=?
1410 WHERE subscriptionid=?
1412 $sth = $dbh->prepare($query);
1413 $recievedlist =~ s/^; //;
1414 $missinglist =~ s/^; //;
1415 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1419 =head2 ItemizeSerials
1421 ItemizeSerials($serialid, $info);
1422 $info is a hashref containing barcode branch, itemcallnumber, status, location
1423 $serialid the serialid
1425 1 if the itemize is a succes.
1426 0 and @error otherwise. @error containts the list of errors found.
1430 sub ItemizeSerials {
1431 my ( $serialid, $info ) = @_;
1432 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1434 my $dbh = C4::Context->dbh;
1440 my $sth = $dbh->prepare($query);
1441 $sth->execute($serialid);
1442 my $data = $sth->fetchrow_hashref;
1443 if ( C4::Context->preference("RoutingSerials") ) {
1445 # check for existing biblioitem relating to serial issue
1446 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1448 for ( my $i = 0 ; $i < $count ; $i++ ) {
1449 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1450 $bibitemno = $results[$i]->{'biblioitemnumber'};
1454 if ( $bibitemno == 0 ) {
1455 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1456 $sth->execute( $data->{'biblionumber'} );
1457 my $biblioitem = $sth->fetchrow_hashref;
1458 $biblioitem->{'volumedate'} = $data->{planneddate};
1459 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1460 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1464 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1465 if ( $info->{barcode} ) {
1467 if ( is_barcode_in_use( $info->{barcode} ) ) {
1468 push @errors, 'barcode_not_unique';
1470 my $marcrecord = MARC::Record->new();
1471 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1472 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1473 $marcrecord->insert_fields_ordered($newField);
1474 if ( $info->{branch} ) {
1475 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1477 #warn "items.homebranch : $tag , $subfield";
1478 if ( $marcrecord->field($tag) ) {
1479 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1481 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1482 $marcrecord->insert_fields_ordered($newField);
1484 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1486 #warn "items.holdingbranch : $tag , $subfield";
1487 if ( $marcrecord->field($tag) ) {
1488 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1490 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1491 $marcrecord->insert_fields_ordered($newField);
1494 if ( $info->{itemcallnumber} ) {
1495 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1497 if ( $marcrecord->field($tag) ) {
1498 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1500 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1501 $marcrecord->insert_fields_ordered($newField);
1504 if ( $info->{notes} ) {
1505 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1507 if ( $marcrecord->field($tag) ) {
1508 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1510 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1511 $marcrecord->insert_fields_ordered($newField);
1514 if ( $info->{location} ) {
1515 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1517 if ( $marcrecord->field($tag) ) {
1518 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1520 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1521 $marcrecord->insert_fields_ordered($newField);
1524 if ( $info->{status} ) {
1525 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1527 if ( $marcrecord->field($tag) ) {
1528 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1530 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1531 $marcrecord->insert_fields_ordered($newField);
1534 if ( C4::Context->preference("RoutingSerials") ) {
1535 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1536 if ( $marcrecord->field($tag) ) {
1537 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1539 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1540 $marcrecord->insert_fields_ordered($newField);
1544 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1547 return ( 0, @errors );
1551 =head2 HasSubscriptionStrictlyExpired
1553 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1555 the subscription has stricly expired when today > the end subscription date
1558 1 if true, 0 if false, -1 if the expiration date is not set.
1562 sub HasSubscriptionStrictlyExpired {
1564 # Getting end of subscription date
1565 my ($subscriptionid) = @_;
1566 my $dbh = C4::Context->dbh;
1567 my $subscription = GetSubscription($subscriptionid);
1568 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1570 # If the expiration date is set
1571 if ( $expirationdate != 0 ) {
1572 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1574 # Getting today's date
1575 my ( $nowyear, $nowmonth, $nowday ) = Today();
1577 # if today's date > expiration date, then the subscription has stricly expired
1578 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1585 # There are some cases where the expiration date is not set
1586 # As we can't determine if the subscription has expired on a date-basis,
1592 =head2 HasSubscriptionExpired
1594 $has_expired = HasSubscriptionExpired($subscriptionid)
1596 the subscription has expired when the next issue to arrive is out of subscription limit.
1599 0 if the subscription has not expired
1600 1 if the subscription has expired
1601 2 if has subscription does not have a valid expiration date set
1605 sub HasSubscriptionExpired {
1606 my ($subscriptionid) = @_;
1607 my $dbh = C4::Context->dbh;
1608 my $subscription = GetSubscription($subscriptionid);
1609 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1610 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1611 if (!defined $expirationdate) {
1612 $expirationdate = q{};
1615 SELECT max(planneddate)
1617 WHERE subscriptionid=?
1619 my $sth = $dbh->prepare($query);
1620 $sth->execute($subscriptionid);
1621 my ($res) = $sth->fetchrow;
1622 if (!$res || $res=~m/^0000/) {
1625 my @res = split( /-/, $res );
1626 my @endofsubscriptiondate = split( /-/, $expirationdate );
1627 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1629 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1633 if ( $subscription->{'numberlength'} ) {
1634 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1635 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1641 return 0; # Notice that you'll never get here.
1644 =head2 SetDistributedto
1646 SetDistributedto($distributedto,$subscriptionid);
1647 This function update the value of distributedto for a subscription given on input arg.
1651 sub SetDistributedto {
1652 my ( $distributedto, $subscriptionid ) = @_;
1653 my $dbh = C4::Context->dbh;
1657 WHERE subscriptionid=?
1659 my $sth = $dbh->prepare($query);
1660 $sth->execute( $distributedto, $subscriptionid );
1664 =head2 DelSubscription
1666 DelSubscription($subscriptionid)
1667 this function deletes subscription which has $subscriptionid as id.
1671 sub DelSubscription {
1672 my ($subscriptionid) = @_;
1673 my $dbh = C4::Context->dbh;
1674 $subscriptionid = $dbh->quote($subscriptionid);
1675 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1676 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1677 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1679 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1684 DelIssue($serialseq,$subscriptionid)
1685 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1687 returns the number of rows affected
1692 my ($dataissue) = @_;
1693 my $dbh = C4::Context->dbh;
1694 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1699 AND subscriptionid= ?
1701 my $mainsth = $dbh->prepare($query);
1702 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1704 #Delete element from subscription history
1705 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1706 my $sth = $dbh->prepare($query);
1707 $sth->execute( $dataissue->{'subscriptionid'} );
1708 my $val = $sth->fetchrow_hashref;
1709 unless ( $val->{manualhistory} ) {
1711 SELECT * FROM subscriptionhistory
1712 WHERE subscriptionid= ?
1714 my $sth = $dbh->prepare($query);
1715 $sth->execute( $dataissue->{'subscriptionid'} );
1716 my $data = $sth->fetchrow_hashref;
1717 my $serialseq = $dataissue->{'serialseq'};
1718 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1719 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1720 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1721 $sth = $dbh->prepare($strsth);
1722 $sth->execute( $dataissue->{'subscriptionid'} );
1725 return $mainsth->rows;
1728 =head2 GetLateOrMissingIssues
1730 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1732 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1735 the issuelist as an array of hash refs. Each element of this array contains
1736 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1740 sub GetLateOrMissingIssues {
1741 my ( $supplierid, $serialid, $order ) = @_;
1742 my $dbh = C4::Context->dbh;
1746 $byserial = "and serialid = " . $serialid;
1749 $order .= ", title";
1754 $sth = $dbh->prepare(
1756 serialid, aqbooksellerid, name,
1757 biblio.title, planneddate, serialseq,
1758 serial.status, serial.subscriptionid, claimdate,
1759 subscription.branchcode
1761 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1762 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1763 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1764 WHERE subscription.subscriptionid = serial.subscriptionid
1765 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1766 AND subscription.aqbooksellerid=$supplierid
1771 $sth = $dbh->prepare(
1773 serialid, aqbooksellerid, name,
1774 biblio.title, planneddate, serialseq,
1775 serial.status, serial.subscriptionid, claimdate,
1776 subscription.branchcode
1778 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1779 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1780 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1781 WHERE subscription.subscriptionid = serial.subscriptionid
1782 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1789 while ( my $line = $sth->fetchrow_hashref ) {
1791 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1792 $line->{planneddate} = format_date( $line->{planneddate} );
1794 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1795 $line->{claimdate} = format_date( $line->{claimdate} );
1797 $line->{"status".$line->{status}} = 1;
1798 push @issuelist, $line;
1803 =head2 removeMissingIssue
1805 removeMissingIssue($subscriptionid)
1807 this function removes an issue from being part of the missing string in
1808 subscriptionlist.missinglist column
1810 called when a missing issue is found from the serials-recieve.pl file
1814 sub removeMissingIssue {
1815 my ( $sequence, $subscriptionid ) = @_;
1816 my $dbh = C4::Context->dbh;
1817 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1818 $sth->execute($subscriptionid);
1819 my $data = $sth->fetchrow_hashref;
1820 my $missinglist = $data->{'missinglist'};
1821 my $missinglistbefore = $missinglist;
1823 # warn $missinglist." before";
1824 $missinglist =~ s/($sequence)//;
1826 # warn $missinglist." after";
1827 if ( $missinglist ne $missinglistbefore ) {
1828 $missinglist =~ s/\|\s\|/\|/g;
1829 $missinglist =~ s/^\| //g;
1830 $missinglist =~ s/\|$//g;
1831 my $sth2 = $dbh->prepare(
1832 "UPDATE subscriptionhistory
1834 WHERE subscriptionid = ?"
1836 $sth2->execute( $missinglist, $subscriptionid );
1843 &updateClaim($serialid)
1845 this function updates the time when a claim is issued for late/missing items
1847 called from claims.pl file
1852 my ($serialid) = @_;
1853 my $dbh = C4::Context->dbh;
1854 my $sth = $dbh->prepare(
1855 "UPDATE serial SET claimdate = now()
1859 $sth->execute($serialid);
1863 =head2 getsupplierbyserialid
1865 $result = getsupplierbyserialid($serialid)
1867 this function is used to find the supplier id given a serial id
1870 hashref containing serialid, subscriptionid, and aqbooksellerid
1874 sub getsupplierbyserialid {
1875 my ($serialid) = @_;
1876 my $dbh = C4::Context->dbh;
1877 my $sth = $dbh->prepare(
1878 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1880 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1884 $sth->execute($serialid);
1885 my $line = $sth->fetchrow_hashref;
1886 my $result = $line->{'aqbooksellerid'};
1890 =head2 check_routing
1892 $result = &check_routing($subscriptionid)
1894 this function checks to see if a serial has a routing list and returns the count of routingid
1895 used to show either an 'add' or 'edit' link
1900 my ($subscriptionid) = @_;
1901 my $dbh = C4::Context->dbh;
1902 my $sth = $dbh->prepare(
1903 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1904 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1905 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1908 $sth->execute($subscriptionid);
1909 my $line = $sth->fetchrow_hashref;
1910 my $result = $line->{'routingids'};
1914 =head2 addroutingmember
1916 addroutingmember($borrowernumber,$subscriptionid)
1918 this function takes a borrowernumber and subscriptionid and adds the member to the
1919 routing list for that serial subscription and gives them a rank on the list
1920 of either 1 or highest current rank + 1
1924 sub addroutingmember {
1925 my ( $borrowernumber, $subscriptionid ) = @_;
1927 my $dbh = C4::Context->dbh;
1928 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1929 $sth->execute($subscriptionid);
1930 while ( my $line = $sth->fetchrow_hashref ) {
1931 if ( $line->{'rank'} > 0 ) {
1932 $rank = $line->{'rank'} + 1;
1937 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1938 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1941 =head2 reorder_members
1943 reorder_members($subscriptionid,$routingid,$rank)
1945 this function is used to reorder the routing list
1947 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1948 - it gets all members on list puts their routingid's into an array
1949 - removes the one in the array that is $routingid
1950 - then reinjects $routingid at point indicated by $rank
1951 - then update the database with the routingids in the new order
1955 sub reorder_members {
1956 my ( $subscriptionid, $routingid, $rank ) = @_;
1957 my $dbh = C4::Context->dbh;
1958 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1959 $sth->execute($subscriptionid);
1961 while ( my $line = $sth->fetchrow_hashref ) {
1962 push( @result, $line->{'routingid'} );
1965 # To find the matching index
1967 my $key = -1; # to allow for 0 being a valid response
1968 for ( $i = 0 ; $i < @result ; $i++ ) {
1969 if ( $routingid == $result[$i] ) {
1970 $key = $i; # save the index
1975 # if index exists in array then move it to new position
1976 if ( $key > -1 && $rank > 0 ) {
1977 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1978 my $moving_item = splice( @result, $key, 1 );
1979 splice( @result, $new_rank, 0, $moving_item );
1981 for ( my $j = 0 ; $j < @result ; $j++ ) {
1982 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
1988 =head2 delroutingmember
1990 delroutingmember($routingid,$subscriptionid)
1992 this function either deletes one member from routing list if $routingid exists otherwise
1993 deletes all members from the routing list
1997 sub delroutingmember {
1999 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2000 my ( $routingid, $subscriptionid ) = @_;
2001 my $dbh = C4::Context->dbh;
2003 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2004 $sth->execute($routingid);
2005 reorder_members( $subscriptionid, $routingid );
2007 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2008 $sth->execute($subscriptionid);
2013 =head2 getroutinglist
2015 @routinglist = getroutinglist($subscriptionid)
2017 this gets the info from the subscriptionroutinglist for $subscriptionid
2020 the routinglist as an array. Each element of the array contains a hash_ref containing
2021 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2025 sub getroutinglist {
2026 my ($subscriptionid) = @_;
2027 my $dbh = C4::Context->dbh;
2028 my $sth = $dbh->prepare(
2029 'SELECT routingid, borrowernumber, ranking, biblionumber
2031 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2032 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2034 $sth->execute($subscriptionid);
2035 my $routinglist = $sth->fetchall_arrayref({});
2036 return @{$routinglist};
2039 =head2 countissuesfrom
2041 $result = countissuesfrom($subscriptionid,$startdate)
2043 Returns a count of serial rows matching the given subsctiptionid
2044 with published date greater than startdate
2048 sub countissuesfrom {
2049 my ( $subscriptionid, $startdate ) = @_;
2050 my $dbh = C4::Context->dbh;
2054 WHERE subscriptionid=?
2055 AND serial.publisheddate>?
2057 my $sth = $dbh->prepare($query);
2058 $sth->execute( $subscriptionid, $startdate );
2059 my ($countreceived) = $sth->fetchrow;
2060 return $countreceived;
2065 $result = CountIssues($subscriptionid)
2067 Returns a count of serial rows matching the given subsctiptionid
2072 my ($subscriptionid) = @_;
2073 my $dbh = C4::Context->dbh;
2077 WHERE subscriptionid=?
2079 my $sth = $dbh->prepare($query);
2080 $sth->execute($subscriptionid);
2081 my ($countreceived) = $sth->fetchrow;
2082 return $countreceived;
2087 $result = HasItems($subscriptionid)
2089 returns a count of items from serial matching the subscriptionid
2094 my ($subscriptionid) = @_;
2095 my $dbh = C4::Context->dbh;
2097 SELECT COUNT(serialitems.itemnumber)
2099 LEFT JOIN serialitems USING(serialid)
2100 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2102 my $sth=$dbh->prepare($query);
2103 $sth->execute($subscriptionid);
2104 my ($countitems)=$sth->fetchrow_array();
2108 =head2 abouttoexpire
2110 $result = abouttoexpire($subscriptionid)
2112 this function alerts you to the penultimate issue for a serial subscription
2114 returns 1 - if this is the penultimate issue
2120 my ($subscriptionid) = @_;
2121 my $dbh = C4::Context->dbh;
2122 my $subscription = GetSubscription($subscriptionid);
2123 my $per = $subscription->{'periodicity'};
2124 if ($per && $per % 16 > 0){
2125 my $expirationdate = GetExpirationDate($subscriptionid);
2126 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2129 @res=split (/-/,$res);
2130 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2131 } else { # default an undefined value
2132 @res=Date::Calc::Today;
2134 my @endofsubscriptiondate=split(/-/,$expirationdate);
2135 my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 124, 0, 0);
2137 @datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2138 - (3 * $per_list[$per])) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2139 return 1 if ( @res &&
2141 Delta_Days($res[0],$res[1],$res[2],
2142 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2143 (@endofsubscriptiondate &&
2144 Delta_Days($res[0],$res[1],$res[2],
2145 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2147 } elsif ($subscription->{numberlength}>0) {
2148 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2153 sub in_array { # used in next sub down
2154 my ( $val, @elements ) = @_;
2155 foreach my $elem (@elements) {
2156 if ( $val == $elem ) {
2165 $resultdate = GetNextDate($planneddate,$subscription)
2167 this function it takes the planneddate and will return the next issue's date and will skip dates if there
2168 exists an irregularity
2169 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2170 skipped then the returned date will be 2007-05-10
2173 $resultdate - then next date in the sequence
2175 Return 0 if periodicity==0
2179 sub GetNextDate(@) {
2180 my ( $planneddate, $subscription ) = @_;
2181 my @irreg = split( /\,/, $subscription->{irregularity} );
2183 #date supposed to be in ISO.
2185 my ( $year, $month, $day ) = split( /-/, $planneddate );
2186 $month = 1 unless ($month);
2187 $day = 1 unless ($day);
2190 # warn "DOW $dayofweek";
2191 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2196 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2197 # renaming this pattern from 1/day to " n / week ".
2198 if ( $subscription->{periodicity} == 1 ) {
2199 my $dayofweek = eval { Day_of_Week( $year, $month, $day ) };
2200 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2202 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2203 $dayofweek = 0 if ( $dayofweek == 7 );
2204 if ( in_array( ( $dayofweek + 1 ), @irreg ) ) {
2205 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 );
2209 @resultdate = Add_Delta_Days( $year, $month, $day, 1 );
2214 if ( $subscription->{periodicity} == 2 ) {
2215 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2216 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2218 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2220 #FIXME: if two consecutive irreg, do we only skip one?
2221 if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) {
2222 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 );
2223 $wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 );
2226 @resultdate = Add_Delta_Days( $year, $month, $day, 7 );
2231 if ( $subscription->{periodicity} == 3 ) {
2232 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2233 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2235 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2236 if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) {
2237 ### BUGFIX was previously +1 ^
2238 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 );
2239 $wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 );
2242 @resultdate = Add_Delta_Days( $year, $month, $day, 14 );
2247 if ( $subscription->{periodicity} == 4 ) {
2248 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2249 if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; }
2251 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2252 if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) {
2253 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 );
2254 $wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 );
2257 @resultdate = Add_Delta_Days( $year, $month, $day, 21 );
2260 my $tmpmonth = $month;
2261 if ( $year && $month && $day ) {
2262 if ( $subscription->{periodicity} == 5 ) {
2263 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2264 if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) {
2265 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2266 $tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 );
2269 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2271 if ( $subscription->{periodicity} == 6 ) {
2272 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2273 if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) {
2274 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2275 $tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 );
2278 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2280 if ( $subscription->{periodicity} == 7 ) {
2281 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2282 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2283 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2284 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2287 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2289 if ( $subscription->{periodicity} == 8 ) {
2290 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2291 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2292 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2293 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2296 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2298 if ( $subscription->{periodicity} == 13 ) {
2299 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2300 if ( $irreg[$i] == ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 ) ) {
2301 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2302 $tmpmonth = ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 );
2305 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2307 if ( $subscription->{periodicity} == 9 ) {
2308 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2309 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2310 ### BUFIX Seems to need more Than One ?
2311 ( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 );
2312 $tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 );
2315 @resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 );
2317 if ( $subscription->{periodicity} == 10 ) {
2318 @resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 );
2320 if ( $subscription->{periodicity} == 11 ) {
2321 @resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 );
2324 my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] );
2326 return "$resultdate";
2329 =head2 is_barcode_in_use
2331 Returns number of occurence of the barcode in the items table
2332 Can be used as a boolean test of whether the barcode has
2333 been deployed as yet
2337 sub is_barcode_in_use {
2338 my $barcode = shift;
2339 my $dbh = C4::Context->dbh;
2340 my $occurences = $dbh->selectall_arrayref(
2341 'SELECT itemnumber from items where barcode = ?',
2346 return @{$occurences};
2354 Koha Development Team <http://koha-community.org/>