1 package C4::Serials; #assumes C4/Serials.pm
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
22 use C4::Dates qw(format_date format_date_in_iso);
23 use Date::Calc qw(:all);
24 use POSIX qw(strftime);
31 use C4::Log; # logaction
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
37 $VERSION = 3.01; # set version for version checking
41 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
42 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
43 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
44 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
46 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
47 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
48 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
49 &GetSerialInformation &AddItem2Serial
50 &PrepareSerialsData &GetNextExpected &ModNextExpected
52 &UpdateClaimdateIssues
53 &GetSuppliersWithLateIssues &getsupplierbyserialid
54 &GetDistributedTo &SetDistributedTo
55 &getroutinglist &delroutingmember &addroutingmember
57 &check_routing &updateClaim &removeMissingIssue
59 &old_newsubscription &old_modsubscription &old_getserials
63 =head2 GetSuppliersWithLateIssues
67 C4::Serials - Give functions for serializing.
75 Give all XYZ functions
81 %supplierlist = &GetSuppliersWithLateIssues
83 this function get all suppliers with late issues.
86 the supplierlist into a hash. this hash containts id & name of the supplier
92 sub GetSuppliersWithLateIssues {
93 my $dbh = C4::Context->dbh;
95 SELECT DISTINCT id, name
97 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
98 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
99 WHERE subscription.subscriptionid = serial.subscriptionid
100 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
103 my $sth = $dbh->prepare($query);
106 while ( my ( $id, $name ) = $sth->fetchrow ) {
107 $supplierlist{$id} = $name;
109 if ( C4::Context->preference("RoutingSerials") ) {
110 $supplierlist{''} = "All Suppliers";
112 return %supplierlist;
119 @issuelist = &GetLateIssues($supplierid)
121 this function select late issues on database
124 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
125 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
132 my ($supplierid) = @_;
133 my $dbh = C4::Context->dbh;
137 SELECT name,title,planneddate,serialseq,serial.subscriptionid
139 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
140 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
141 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
142 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
143 AND subscription.aqbooksellerid=$supplierid
146 $sth = $dbh->prepare($query);
150 SELECT name,title,planneddate,serialseq,serial.subscriptionid
152 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
153 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
154 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
155 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
158 $sth = $dbh->prepare($query);
165 while ( my $line = $sth->fetchrow_hashref ) {
166 $odd++ unless $line->{title} eq $last_title;
167 $line->{title} = "" if $line->{title} eq $last_title;
168 $last_title = $line->{title} if ( $line->{title} );
169 $line->{planneddate} = format_date( $line->{planneddate} );
171 push @issuelist, $line;
173 return $count, @issuelist;
176 =head2 GetSubscriptionHistoryFromSubscriptionId
180 $sth = GetSubscriptionHistoryFromSubscriptionId()
181 this function just prepare the SQL request.
182 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
184 $sth = $dbh->prepare($query).
190 sub GetSubscriptionHistoryFromSubscriptionId() {
191 my $dbh = C4::Context->dbh;
194 FROM subscriptionhistory
195 WHERE subscriptionid = ?
197 return $dbh->prepare($query);
200 =head2 GetSerialStatusFromSerialId
204 $sth = GetSerialStatusFromSerialId();
205 this function just prepare the SQL request.
206 After this function, don't forget to execute it by using $sth->execute($serialid)
208 $sth = $dbh->prepare($query).
214 sub GetSerialStatusFromSerialId() {
215 my $dbh = C4::Context->dbh;
221 return $dbh->prepare($query);
224 =head2 GetSerialInformation
228 $data = GetSerialInformation($serialid);
229 returns a hash containing :
230 items : items marcrecord (can be an array)
232 subscription table field
233 + information about subscription expiration
239 sub GetSerialInformation {
241 my $dbh = C4::Context->dbh;
243 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
244 if (C4::Context->preference('IndependantBranches') &&
245 C4::Context->userenv &&
246 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
248 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
251 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
254 my $rq = $dbh->prepare($query);
255 $rq->execute($serialid);
256 my $data = $rq->fetchrow_hashref;
257 # create item information if we have serialsadditems for this subscription
258 if ( $data->{'serialsadditems'} ) {
259 my $queryitem=$dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
260 $queryitem->execute($serialid);
261 my $itemnumbers=$queryitem->fetchall_arrayref([0]);
262 if (scalar(@$itemnumbers)>0){
263 foreach my $itemnum (@$itemnumbers) {
264 #It is ASSUMED that GetMarcItem ALWAYS WORK...
265 #Maybe GetMarcItem should return values on failure
266 $debug and warn "itemnumber :$itemnum->[0], bibnum :".$data->{'biblionumber'};
268 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0] , $data );
269 $itemprocessed->{'itemnumber'} = $itemnum->[0];
270 $itemprocessed->{'itemid'} = $itemnum->[0];
271 $itemprocessed->{'serialid'} = $serialid;
272 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
273 push @{ $data->{'items'} }, $itemprocessed;
278 PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
279 $itemprocessed->{'itemid'} = "N$serialid";
280 $itemprocessed->{'serialid'} = $serialid;
281 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
282 $itemprocessed->{'countitems'} = 0;
283 push @{ $data->{'items'} }, $itemprocessed;
286 $data->{ "status" . $data->{'serstatus'} } = 1;
287 $data->{'subscriptionexpired'} =
288 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
289 $data->{'abouttoexpire'} =
290 abouttoexpire( $data->{'subscriptionid'} );
294 =head2 AddItem2Serial
298 $data = AddItem2Serial($serialid,$itemnumber);
299 Adds an itemnumber to Serial record
305 my ( $serialid, $itemnumber ) = @_;
306 my $dbh = C4::Context->dbh;
307 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
308 $rq->execute($serialid, $itemnumber);
312 =head2 UpdateClaimdateIssues
316 UpdateClaimdateIssues($serialids,[$date]);
318 Update Claimdate for issues in @$serialids list with date $date
324 sub UpdateClaimdateIssues {
325 my ( $serialids, $date ) = @_;
326 my $dbh = C4::Context->dbh;
327 $date = strftime("%Y-%m-%d",localtime) unless ($date);
329 UPDATE serial SET claimdate=$date,status=7
330 WHERE serialid in ".join (",",@$serialids);
332 my $rq = $dbh->prepare($query);
337 =head2 GetSubscription
341 $subs = GetSubscription($subscriptionid)
342 this function get the subscription which has $subscriptionid as id.
344 a hashref. This hash containts
345 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
351 sub GetSubscription {
352 my ($subscriptionid) = @_;
353 my $dbh = C4::Context->dbh;
355 SELECT subscription.*,
356 subscriptionhistory.*,
357 subscriptionhistory.enddate as histenddate,
359 aqbooksellers.name AS aqbooksellername,
360 biblio.title AS bibliotitle,
361 subscription.biblionumber as bibnum);
362 if (C4::Context->preference('IndependantBranches') &&
363 C4::Context->userenv &&
364 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
366 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
370 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
371 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
372 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
373 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
374 WHERE subscription.subscriptionid = ?
376 # if (C4::Context->preference('IndependantBranches') &&
377 # C4::Context->userenv &&
378 # C4::Context->userenv->{'flags'} != 1){
379 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
380 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
382 $debug and warn "query : $query\nsubsid :$subscriptionid";
383 my $sth = $dbh->prepare($query);
384 $sth->execute($subscriptionid);
385 return $sth->fetchrow_hashref;
388 =head2 GetFullSubscription
392 \@res = GetFullSubscription($subscriptionid)
393 this function read on serial table.
399 sub GetFullSubscription {
400 my ($subscriptionid) = @_;
401 my $dbh = C4::Context->dbh;
403 SELECT serial.serialid,
406 serial.publisheddate,
408 serial.notes as notes,
409 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
410 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
411 biblio.title as bibliotitle,
412 subscription.branchcode AS branchcode,
413 subscription.subscriptionid AS subscriptionid |;
414 if (C4::Context->preference('IndependantBranches') &&
415 C4::Context->userenv &&
416 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
418 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
422 LEFT JOIN subscription ON
423 (serial.subscriptionid=subscription.subscriptionid )
424 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
425 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
426 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
427 WHERE serial.subscriptionid = ?
429 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
430 serial.subscriptionid
432 $debug and warn "GetFullSubscription query: $query";
433 my $sth = $dbh->prepare($query);
434 $sth->execute($subscriptionid);
435 return $sth->fetchall_arrayref({});
439 =head2 PrepareSerialsData
443 \@res = PrepareSerialsData($serialinfomation)
444 where serialinformation is a hashref array
450 sub PrepareSerialsData{
456 my $aqbooksellername;
460 my $previousnote = "";
462 foreach my $subs ( @$lines ) {
463 $subs->{'publisheddate'} =
464 ( $subs->{'publisheddate'}
465 ? format_date( $subs->{'publisheddate'} )
467 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
468 $subs->{ "status" . $subs->{'status'} } = 1;
470 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
471 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
472 $year = $subs->{'year'};
477 if ( $tmpresults{$year} ) {
478 push @{ $tmpresults{$year}->{'serials'} }, $subs;
481 $tmpresults{$year} = {
484 # 'startdate'=>format_date($subs->{'startdate'}),
485 'aqbooksellername' => $subs->{'aqbooksellername'},
486 'bibliotitle' => $subs->{'bibliotitle'},
487 'serials' => [$subs],
489 # 'branchcode' => $subs->{'branchcode'},
490 # 'subscriptionid' => $subs->{'subscriptionid'},
494 # $previousnote=$subs->{notes};
496 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
497 push @res, $tmpresults{$key};
499 $res[0]->{'first'}=1;
503 =head2 GetSubscriptionsFromBiblionumber
505 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
506 this function get the subscription list. it reads on subscription table.
508 table of subscription which has the biblionumber given on input arg.
509 each line of this table is a hashref. All hashes containt
510 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
514 sub GetSubscriptionsFromBiblionumber {
515 my ($biblionumber) = @_;
516 my $dbh = C4::Context->dbh;
518 SELECT subscription.*,
520 subscriptionhistory.*,
521 subscriptionhistory.enddate as histenddate,
523 aqbooksellers.name AS aqbooksellername,
524 biblio.title AS bibliotitle
526 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
527 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
528 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
529 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
530 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
531 WHERE subscription.biblionumber = ?
533 # if (C4::Context->preference('IndependantBranches') &&
534 # C4::Context->userenv &&
535 # C4::Context->userenv->{'flags'} != 1){
536 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
538 my $sth = $dbh->prepare($query);
539 $sth->execute($biblionumber);
541 while ( my $subs = $sth->fetchrow_hashref ) {
542 $subs->{startdate} = format_date( $subs->{startdate} );
543 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
544 $subs->{histenddate} = format_date( $subs->{histenddate} );
545 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
546 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
547 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
548 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
549 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
550 $subs->{ "status" . $subs->{'status'} } = 1;
551 $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
552 C4::Context->userenv &&
553 C4::Context->userenv->{flags} !=1 &&
554 C4::Context->userenv->{branch} && $subs->{branchcode} &&
555 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
556 if ( $subs->{enddate} eq '0000-00-00' ) {
557 $subs->{enddate} = '';
560 $subs->{enddate} = format_date( $subs->{enddate} );
562 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
563 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
569 =head2 GetFullSubscriptionsFromBiblionumber
573 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
574 this function read on serial table.
580 sub GetFullSubscriptionsFromBiblionumber {
581 my ($biblionumber) = @_;
582 my $dbh = C4::Context->dbh;
584 SELECT serial.serialid,
587 serial.publisheddate,
589 serial.notes as notes,
590 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
591 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
592 biblio.title as bibliotitle,
593 subscription.branchcode AS branchcode,
594 subscription.subscriptionid AS subscriptionid|;
595 if (C4::Context->preference('IndependantBranches') &&
596 C4::Context->userenv &&
597 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
599 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
604 LEFT JOIN subscription ON
605 (serial.subscriptionid=subscription.subscriptionid)
606 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
607 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
608 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
609 WHERE subscription.biblionumber = ?
611 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
612 serial.subscriptionid
614 my $sth = $dbh->prepare($query);
615 $sth->execute($biblionumber);
616 return $sth->fetchall_arrayref({});
619 =head2 GetSubscriptions
623 @results = GetSubscriptions($title,$ISSN,$biblionumber);
624 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
626 a table of hashref. Each hash containt the subscription.
632 sub GetSubscriptions {
633 my ( $title, $ISSN, $biblionumber ) = @_;
634 #return unless $title or $ISSN or $biblionumber;
635 my $dbh = C4::Context->dbh;
639 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
641 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
642 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
643 WHERE biblio.biblionumber=?
645 $query.=" ORDER BY title";
646 $debug and warn "GetSubscriptions query: $query";
647 $sth = $dbh->prepare($query);
648 $sth->execute($biblionumber);
651 if ( $ISSN and $title ) {
653 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
655 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
656 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
657 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
658 $query.=" ORDER BY title";
659 $debug and warn "GetSubscriptions query: $query";
660 $sth = $dbh->prepare($query);
661 $sth->execute( $ISSN );
666 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
668 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
669 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
670 WHERE biblioitems.issn LIKE ?
672 $query.=" ORDER BY title";
673 $debug and warn "GetSubscriptions query: $query";
674 $sth = $dbh->prepare($query);
675 $sth->execute( "%" . $ISSN . "%" );
679 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
681 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
682 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
684 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
686 $query.=" ORDER BY title";
687 $debug and warn "GetSubscriptions query: $query";
688 $sth = $dbh->prepare($query);
694 my $previoustitle = "";
696 while ( my $line = $sth->fetchrow_hashref ) {
697 if ( $previoustitle eq $line->{title} ) {
702 $previoustitle = $line->{title};
705 $line->{toggle} = 1 if $odd == 1;
706 $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
707 C4::Context->userenv &&
708 C4::Context->userenv->{flags} !=1 &&
709 C4::Context->userenv->{branch} && $line->{branchcode} &&
710 (C4::Context->userenv->{branch} ne $line->{branchcode}));
711 push @results, $line;
720 ($totalissues,@serials) = GetSerials($subscriptionid);
721 this function get every serial not arrived for a given subscription
722 as well as the number of issues registered in the database (all types)
723 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
725 FIXME: We should return \@serials.
731 my ($subscriptionid,$count) = @_;
732 my $dbh = C4::Context->dbh;
734 # status = 2 is "arrived"
736 $count=5 unless ($count);
739 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
741 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
742 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
743 my $sth = $dbh->prepare($query);
744 $sth->execute($subscriptionid);
745 while ( my $line = $sth->fetchrow_hashref ) {
746 $line->{ "status" . $line->{status} } =
747 1; # fills a "statusX" value, used for template status select list
748 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
749 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
750 push @serials, $line;
752 # OK, now add the last 5 issues arrives/missing
754 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
756 WHERE subscriptionid = ?
757 AND (status in (2,4,5))
758 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
760 $sth = $dbh->prepare($query);
761 $sth->execute($subscriptionid);
762 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
764 $line->{ "status" . $line->{status} } =
765 1; # fills a "statusX" value, used for template status select list
766 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
767 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
768 push @serials, $line;
771 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
772 $sth = $dbh->prepare($query);
773 $sth->execute($subscriptionid);
774 my ($totalissues) = $sth->fetchrow;
775 return ( $totalissues, @serials );
782 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
783 this function get every serial waited for a given subscription
784 as well as the number of issues registered in the database (all types)
785 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
791 my ($subscription,$status) = @_;
792 my $dbh = C4::Context->dbh;
794 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
796 WHERE subscriptionid=$subscription AND status IN ($status)
797 ORDER BY publisheddate,serialid DESC
799 $debug and warn "GetSerials2 query: $query";
800 my $sth=$dbh->prepare($query);
803 while(my $line = $sth->fetchrow_hashref) {
804 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
805 $line->{"planneddate"} = format_date($line->{"planneddate"});
806 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
809 my ($totalissues) = scalar(@serials);
810 return ($totalissues,@serials);
813 =head2 GetLatestSerials
817 \@serials = GetLatestSerials($subscriptionid,$limit)
818 get the $limit's latest serials arrived or missing for a given subscription
820 a ref to a table which it containts all of the latest serials stored into a hash.
826 sub GetLatestSerials {
827 my ( $subscriptionid, $limit ) = @_;
828 my $dbh = C4::Context->dbh;
830 # status = 2 is "arrived"
831 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
833 WHERE subscriptionid = ?
834 AND (status =2 or status=4)
835 ORDER BY planneddate DESC LIMIT 0,$limit
837 my $sth = $dbh->prepare($strsth);
838 $sth->execute($subscriptionid);
840 while ( my $line = $sth->fetchrow_hashref ) {
841 $line->{ "status" . $line->{status} } =
842 1; # fills a "statusX" value, used for template status select list
843 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
844 push @serials, $line;
850 # WHERE subscriptionid=?
852 # $sth=$dbh->prepare($query);
853 # $sth->execute($subscriptionid);
854 # my ($totalissues) = $sth->fetchrow;
858 =head2 GetDistributedTo
862 $distributedto=GetDistributedTo($subscriptionid)
863 This function select the old previous value of distributedto in the database.
869 sub GetDistributedTo {
870 my $dbh = C4::Context->dbh;
872 my $subscriptionid = @_;
873 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
874 my $sth = $dbh->prepare($query);
875 $sth->execute($subscriptionid);
876 return ($distributedto) = $sth->fetchrow;
884 $val is a hashref containing all the attributes of the table 'subscription'
885 This function get the next issue for the subscription given on input arg
887 all the input params updated.
895 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
896 # $calculated = $val->{numberingmethod};
897 # # calculate the (expected) value of the next issue recieved.
898 # $newlastvalue1 = $val->{lastvalue1};
899 # # check if we have to increase the new value.
900 # $newinnerloop1 = $val->{innerloop1}+1;
901 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
902 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
903 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
904 # $calculated =~ s/\{X\}/$newlastvalue1/g;
906 # $newlastvalue2 = $val->{lastvalue2};
907 # # check if we have to increase the new value.
908 # $newinnerloop2 = $val->{innerloop2}+1;
909 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
910 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
911 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
912 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
914 # $newlastvalue3 = $val->{lastvalue3};
915 # # check if we have to increase the new value.
916 # $newinnerloop3 = $val->{innerloop3}+1;
917 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
918 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
919 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
920 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
921 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
927 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
928 $newinnerloop1, $newinnerloop2, $newinnerloop3
930 my $pattern = $val->{numberpattern};
931 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
932 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
933 $calculated = $val->{numberingmethod};
934 $newlastvalue1 = $val->{lastvalue1};
935 $newlastvalue2 = $val->{lastvalue2};
936 $newlastvalue3 = $val->{lastvalue3};
937 $newlastvalue1 = $val->{lastvalue1};
938 # check if we have to increase the new value.
939 $newinnerloop1 = $val->{innerloop1} + 1;
940 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
941 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
942 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
943 $calculated =~ s/\{X\}/$newlastvalue1/g;
945 $newlastvalue2 = $val->{lastvalue2};
946 # check if we have to increase the new value.
947 $newinnerloop2 = $val->{innerloop2} + 1;
948 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
949 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
950 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
951 if ( $pattern == 6 ) {
952 if ( $val->{hemisphere} == 2 ) {
953 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
954 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
957 my $newlastvalue2seq = $seasons[$newlastvalue2];
958 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
962 $calculated =~ s/\{Y\}/$newlastvalue2/g;
966 $newlastvalue3 = $val->{lastvalue3};
967 # check if we have to increase the new value.
968 $newinnerloop3 = $val->{innerloop3} + 1;
969 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
970 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
971 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
972 $calculated =~ s/\{Z\}/$newlastvalue3/g;
974 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
975 $newinnerloop1, $newinnerloop2, $newinnerloop3);
982 $calculated = GetSeq($val)
983 $val is a hashref containing all the attributes of the table 'subscription'
984 this function transforms {X},{Y},{Z} to 150,0,0 for example.
986 the sequence in integer format
994 my $pattern = $val->{numberpattern};
995 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
996 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
997 my $calculated = $val->{numberingmethod};
998 my $x = $val->{'lastvalue1'};
999 $calculated =~ s/\{X\}/$x/g;
1000 my $newlastvalue2 = $val->{'lastvalue2'};
1001 if ( $pattern == 6 ) {
1002 if ( $val->{hemisphere} == 2 ) {
1003 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1004 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1007 my $newlastvalue2seq = $seasons[$newlastvalue2];
1008 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1012 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1014 my $z = $val->{'lastvalue3'};
1015 $calculated =~ s/\{Z\}/$z/g;
1019 =head2 GetExpirationDate
1021 $sensddate = GetExpirationDate($subscriptionid)
1023 this function return the expiration date for a subscription given on input args.
1030 sub GetExpirationDate {
1031 my ($subscriptionid) = @_;
1032 my $dbh = C4::Context->dbh;
1033 my $subscription = GetSubscription($subscriptionid);
1034 my $enddate = $subscription->{startdate};
1036 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1037 if (($subscription->{periodicity} % 16) >0){
1038 if ( $subscription->{numberlength} ) {
1039 #calculate the date of the last issue.
1040 my $length = $subscription->{numberlength};
1041 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1042 $enddate = GetNextDate( $enddate, $subscription );
1045 elsif ( $subscription->{monthlength} ){
1046 my @date=split (/-/,$subscription->{startdate});
1047 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1048 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1049 } elsif ( $subscription->{weeklength} ){
1050 my @date=split (/-/,$subscription->{startdate});
1051 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1052 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1060 =head2 CountSubscriptionFromBiblionumber
1064 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1065 this count the number of subscription for a biblionumber given.
1067 the number of subscriptions with biblionumber given on input arg.
1073 sub CountSubscriptionFromBiblionumber {
1074 my ($biblionumber) = @_;
1075 my $dbh = C4::Context->dbh;
1076 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1077 my $sth = $dbh->prepare($query);
1078 $sth->execute($biblionumber);
1079 my $subscriptionsnumber = $sth->fetchrow;
1080 return $subscriptionsnumber;
1083 =head2 ModSubscriptionHistory
1087 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1089 this function modify the history of a subscription. Put your new values on input arg.
1095 sub ModSubscriptionHistory {
1097 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1098 $missinglist, $opacnote, $librariannote
1100 my $dbh = C4::Context->dbh;
1101 my $query = "UPDATE subscriptionhistory
1102 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1103 WHERE subscriptionid=?
1105 my $sth = $dbh->prepare($query);
1106 $recievedlist =~ s/^,//g;
1107 $missinglist =~ s/^,//g;
1108 $opacnote =~ s/^,//g;
1110 $histstartdate, $enddate, $recievedlist, $missinglist,
1111 $opacnote, $librariannote, $subscriptionid
1116 =head2 ModSerialStatus
1120 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1122 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1123 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1129 sub ModSerialStatus {
1130 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1133 #It is a usual serial
1134 # 1st, get previous status :
1135 my $dbh = C4::Context->dbh;
1136 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1137 my $sth = $dbh->prepare($query);
1138 $sth->execute($serialid);
1139 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1141 # change status & update subscriptionhistory
1143 if ( $status eq 6 ) {
1144 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1148 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1149 $sth = $dbh->prepare($query);
1150 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1151 $notes, $serialid );
1152 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1153 $sth = $dbh->prepare($query);
1154 $sth->execute($subscriptionid);
1155 my $val = $sth->fetchrow_hashref;
1156 unless ( $val->{manualhistory} ) {
1158 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1159 $sth = $dbh->prepare($query);
1160 $sth->execute($subscriptionid);
1161 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1162 if ( $status eq 2 ) {
1164 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1165 $recievedlist .= ",$serialseq"
1166 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1169 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1170 $missinglist .= ",$serialseq"
1172 and not index( "$missinglist", "$serialseq" ) >= 0 );
1173 $missinglist .= ",not issued $serialseq"
1175 and index( "$missinglist", "$serialseq" ) >= 0 );
1177 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1178 $sth = $dbh->prepare($query);
1179 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1183 # create new waited entry if needed (ie : was a "waited" and has changed)
1184 if ( $oldstatus eq 1 && $status ne 1 ) {
1185 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1186 $sth = $dbh->prepare($query);
1187 $sth->execute($subscriptionid);
1188 my $val = $sth->fetchrow_hashref;
1193 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1194 $newinnerloop1, $newinnerloop2, $newinnerloop3
1195 ) = GetNextSeq($val);
1196 # warn "Next Seq End";
1198 # next date (calculated from actual date & frequency parameters)
1199 # warn "publisheddate :$publisheddate ";
1200 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1201 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1202 1, $nextpublisheddate, $nextpublisheddate );
1204 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1205 WHERE subscriptionid = ?";
1206 $sth = $dbh->prepare($query);
1208 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1209 $newinnerloop2, $newinnerloop3, $subscriptionid
1212 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1213 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1214 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1219 =head2 GetNextExpected
1223 $nextexpected = GetNextExpected($subscriptionid)
1225 Get the planneddate for the current expected issue of the subscription.
1231 planneddate => C4::Dates object
1238 sub GetNextExpected($) {
1239 my ($subscriptionid) = @_;
1240 my $dbh = C4::Context->dbh;
1241 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1242 # Each subscription has only one 'expected' issue, with serial.status==1.
1243 $sth->execute( $subscriptionid, 1 );
1244 my ( $nextissue ) = $sth->fetchrow_hashref;
1245 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1248 =head2 ModNextExpected
1252 ModNextExpected($subscriptionid,$date)
1254 Update the planneddate for the current expected issue of the subscription.
1255 This will modify all future prediction results.
1257 C<$date> is a C4::Dates object.
1263 sub ModNextExpected($$) {
1264 my ($subscriptionid,$date) = @_;
1265 my $dbh = C4::Context->dbh;
1266 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1267 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1268 # Each subscription has only one 'expected' issue, with serial.status==1.
1269 $sth->execute( $date->output('iso'),$date->output('iso'), $subscriptionid, 1);
1274 =head2 ModSubscription
1278 this function modify a subscription. Put all new values on input args.
1284 sub ModSubscription {
1286 $auser, $branchcode, $aqbooksellerid, $cost,
1287 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1288 $dow, $irregularity, $numberpattern, $numberlength,
1289 $weeklength, $monthlength, $add1, $every1,
1290 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1291 $add2, $every2, $whenmorethan2, $setto2,
1292 $lastvalue2, $innerloop2, $add3, $every3,
1293 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1294 $numberingmethod, $status, $biblionumber, $callnumber,
1295 $notes, $letter, $hemisphere, $manualhistory,
1296 $internalnotes, $serialsadditems,
1299 # warn $irregularity;
1300 my $dbh = C4::Context->dbh;
1301 my $query = "UPDATE subscription
1302 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1303 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1304 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1305 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1306 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1307 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?
1308 WHERE subscriptionid = ?";
1309 # warn "query :".$query;
1310 my $sth = $dbh->prepare($query);
1312 $auser, $branchcode, $aqbooksellerid, $cost,
1313 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1314 $dow, "$irregularity", $numberpattern, $numberlength,
1315 $weeklength, $monthlength, $add1, $every1,
1316 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1317 $add2, $every2, $whenmorethan2, $setto2,
1318 $lastvalue2, $innerloop2, $add3, $every3,
1319 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1320 $numberingmethod, $status, $biblionumber, $callnumber,
1321 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1322 $internalnotes, $serialsadditems,
1325 my $rows=$sth->rows;
1328 logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1332 =head2 NewSubscription
1336 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1337 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1338 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1339 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1340 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1341 $numberingmethod, $status, $notes, $serialsadditems)
1343 Create a new subscription with value given on input args.
1346 the id of this new subscription
1352 sub NewSubscription {
1354 $auser, $branchcode, $aqbooksellerid, $cost,
1355 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1356 $dow, $numberlength, $weeklength, $monthlength,
1357 $add1, $every1, $whenmorethan1, $setto1,
1358 $lastvalue1, $innerloop1, $add2, $every2,
1359 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1360 $add3, $every3, $whenmorethan3, $setto3,
1361 $lastvalue3, $innerloop3, $numberingmethod, $status,
1362 $notes, $letter, $firstacquidate, $irregularity,
1363 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1364 $internalnotes, $serialsadditems,
1366 my $dbh = C4::Context->dbh;
1368 #save subscription (insert into database)
1370 INSERT INTO subscription
1371 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1372 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1373 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1374 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1375 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1376 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1377 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems)
1378 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1380 my $sth = $dbh->prepare($query);
1382 $auser, $branchcode,
1383 $aqbooksellerid, $cost,
1384 $aqbudgetid, $biblionumber,
1385 format_date_in_iso($startdate), $periodicity,
1386 $dow, $numberlength,
1387 $weeklength, $monthlength,
1389 $whenmorethan1, $setto1,
1390 $lastvalue1, $innerloop1,
1392 $whenmorethan2, $setto2,
1393 $lastvalue2, $innerloop2,
1395 $whenmorethan3, $setto3,
1396 $lastvalue3, $innerloop3,
1397 $numberingmethod, "$status",
1399 format_date_in_iso($firstacquidate), $irregularity,
1400 $numberpattern, $callnumber,
1401 $hemisphere, $manualhistory,
1402 $internalnotes, $serialsadditems,
1405 #then create the 1st waited number
1406 my $subscriptionid = $dbh->{'mysql_insertid'};
1408 INSERT INTO subscriptionhistory
1409 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1412 $sth = $dbh->prepare($query);
1413 $sth->execute( $biblionumber, $subscriptionid,
1414 format_date_in_iso($startdate),
1415 $notes,$internalnotes );
1417 # reread subscription to get a hash (for calculation of the 1st issue number)
1421 WHERE subscriptionid = ?
1423 $sth = $dbh->prepare($query);
1424 $sth->execute($subscriptionid);
1425 my $val = $sth->fetchrow_hashref;
1427 # calculate issue number
1428 my $serialseq = GetSeq($val);
1431 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1432 VALUES (?,?,?,?,?,?)
1434 $sth = $dbh->prepare($query);
1436 "$serialseq", $subscriptionid, $biblionumber, 1,
1437 format_date_in_iso($firstacquidate),
1438 format_date_in_iso($firstacquidate)
1441 logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1443 #set serial flag on biblio if not already set.
1444 my ($null, ($bib)) = GetBiblio($biblionumber);
1445 if( ! $bib->{'serial'} ) {
1446 my $record = GetMarcBiblio($biblionumber);
1447 my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1450 $record->field($tag)->update( $subf => 1 );
1453 ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1455 return $subscriptionid;
1458 =head2 ReNewSubscription
1462 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1464 this function renew a subscription with values given on input args.
1470 sub ReNewSubscription {
1471 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1472 $monthlength, $note )
1474 my $dbh = C4::Context->dbh;
1475 my $subscription = GetSubscription($subscriptionid);
1479 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1480 WHERE biblio.biblionumber=?
1482 my $sth = $dbh->prepare($query);
1483 $sth->execute( $subscription->{biblionumber} );
1484 my $biblio = $sth->fetchrow_hashref;
1485 if (C4::Context->preference("RenewSerialAddsSuggestion")){
1487 $user, $subscription->{bibliotitle},
1488 $biblio->{author}, $biblio->{publishercode},
1489 $biblio->{note}, '',
1492 $subscription->{biblionumber}
1496 # renew subscription
1499 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1500 WHERE subscriptionid=?
1502 $sth = $dbh->prepare($query);
1503 $sth->execute( format_date_in_iso($startdate),
1504 $numberlength, $weeklength, $monthlength, $subscriptionid );
1506 logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1513 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1515 Create a new issue stored on the database.
1516 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1523 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1524 $planneddate, $publisheddate, $notes )
1526 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1528 my $dbh = C4::Context->dbh;
1531 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1532 VALUES (?,?,?,?,?,?,?)
1534 my $sth = $dbh->prepare($query);
1535 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1536 $publisheddate, $planneddate,$notes );
1537 my $serialid=$dbh->{'mysql_insertid'};
1539 SELECT missinglist,recievedlist
1540 FROM subscriptionhistory
1541 WHERE subscriptionid=?
1543 $sth = $dbh->prepare($query);
1544 $sth->execute($subscriptionid);
1545 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1547 if ( $status eq 2 ) {
1548 ### TODO Add a feature that improves recognition and description.
1549 ### As such count (serialseq) i.e. : N18,2(N19),N20
1550 ### Would use substr and index But be careful to previous presence of ()
1551 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1553 if ( $status eq 4 ) {
1554 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1557 UPDATE subscriptionhistory
1558 SET recievedlist=?, missinglist=?
1559 WHERE subscriptionid=?
1561 $sth = $dbh->prepare($query);
1562 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1566 =head2 ItemizeSerials
1570 ItemizeSerials($serialid, $info);
1571 $info is a hashref containing barcode branch, itemcallnumber, status, location
1572 $serialid the serialid
1574 1 if the itemize is a succes.
1575 0 and @error else. @error containts the list of errors found.
1581 sub ItemizeSerials {
1582 my ( $serialid, $info ) = @_;
1583 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1585 my $dbh = C4::Context->dbh;
1591 my $sth = $dbh->prepare($query);
1592 $sth->execute($serialid);
1593 my $data = $sth->fetchrow_hashref;
1594 if ( C4::Context->preference("RoutingSerials") ) {
1596 # check for existing biblioitem relating to serial issue
1597 my ( $count, @results ) =
1598 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1600 for ( my $i = 0 ; $i < $count ; $i++ ) {
1601 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1602 . $data->{'planneddate'}
1605 $bibitemno = $results[$i]->{'biblioitemnumber'};
1609 if ( $bibitemno == 0 ) {
1611 # warn "need to add new biblioitem so copy last one and make minor changes";
1614 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1616 $sth->execute( $data->{'biblionumber'} );
1617 my $biblioitem = $sth->fetchrow_hashref;
1618 $biblioitem->{'volumedate'} =
1619 format_date_in_iso( $data->{planneddate} );
1620 $biblioitem->{'volumeddesc'} =
1621 $data->{serialseq} . ' ('
1622 . format_date( $data->{'planneddate'} ) . ')';
1623 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1625 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1626 # so I comment it, we can speak of it when you want
1627 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1628 # if ( $info->{barcode} )
1629 # { # only make biblioitem if we are going to make item also
1630 # $bibitemno = newbiblioitem($biblioitem);
1635 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1636 if ( $info->{barcode} ) {
1638 my $exists = itemdata( $info->{'barcode'} );
1639 push @errors, "barcode_not_unique" if ($exists);
1641 my $marcrecord = MARC::Record->new();
1642 my ( $tag, $subfield ) =
1643 GetMarcFromKohaField( "items.barcode", $fwk );
1645 MARC::Field->new( "$tag", '', '',
1646 "$subfield" => $info->{barcode} );
1647 $marcrecord->insert_fields_ordered($newField);
1648 if ( $info->{branch} ) {
1649 my ( $tag, $subfield ) =
1650 GetMarcFromKohaField( "items.homebranch",
1653 #warn "items.homebranch : $tag , $subfield";
1654 if ( $marcrecord->field($tag) ) {
1655 $marcrecord->field($tag)
1656 ->add_subfields( "$subfield" => $info->{branch} );
1660 MARC::Field->new( "$tag", '', '',
1661 "$subfield" => $info->{branch} );
1662 $marcrecord->insert_fields_ordered($newField);
1664 ( $tag, $subfield ) =
1665 GetMarcFromKohaField( "items.holdingbranch",
1668 #warn "items.holdingbranch : $tag , $subfield";
1669 if ( $marcrecord->field($tag) ) {
1670 $marcrecord->field($tag)
1671 ->add_subfields( "$subfield" => $info->{branch} );
1675 MARC::Field->new( "$tag", '', '',
1676 "$subfield" => $info->{branch} );
1677 $marcrecord->insert_fields_ordered($newField);
1680 if ( $info->{itemcallnumber} ) {
1681 my ( $tag, $subfield ) =
1682 GetMarcFromKohaField( "items.itemcallnumber",
1685 #warn "items.itemcallnumber : $tag , $subfield";
1686 if ( $marcrecord->field($tag) ) {
1687 $marcrecord->field($tag)
1688 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1692 MARC::Field->new( "$tag", '', '',
1693 "$subfield" => $info->{itemcallnumber} );
1694 $marcrecord->insert_fields_ordered($newField);
1697 if ( $info->{notes} ) {
1698 my ( $tag, $subfield ) =
1699 GetMarcFromKohaField( "items.itemnotes", $fwk );
1701 # warn "items.itemnotes : $tag , $subfield";
1702 if ( $marcrecord->field($tag) ) {
1703 $marcrecord->field($tag)
1704 ->add_subfields( "$subfield" => $info->{notes} );
1708 MARC::Field->new( "$tag", '', '',
1709 "$subfield" => $info->{notes} );
1710 $marcrecord->insert_fields_ordered($newField);
1713 if ( $info->{location} ) {
1714 my ( $tag, $subfield ) =
1715 GetMarcFromKohaField( "items.location", $fwk );
1717 # warn "items.location : $tag , $subfield";
1718 if ( $marcrecord->field($tag) ) {
1719 $marcrecord->field($tag)
1720 ->add_subfields( "$subfield" => $info->{location} );
1724 MARC::Field->new( "$tag", '', '',
1725 "$subfield" => $info->{location} );
1726 $marcrecord->insert_fields_ordered($newField);
1729 if ( $info->{status} ) {
1730 my ( $tag, $subfield ) =
1731 GetMarcFromKohaField( "items.notforloan",
1734 # warn "items.notforloan : $tag , $subfield";
1735 if ( $marcrecord->field($tag) ) {
1736 $marcrecord->field($tag)
1737 ->add_subfields( "$subfield" => $info->{status} );
1741 MARC::Field->new( "$tag", '', '',
1742 "$subfield" => $info->{status} );
1743 $marcrecord->insert_fields_ordered($newField);
1746 if ( C4::Context->preference("RoutingSerials") ) {
1747 my ( $tag, $subfield ) =
1748 GetMarcFromKohaField( "items.dateaccessioned",
1750 if ( $marcrecord->field($tag) ) {
1751 $marcrecord->field($tag)
1752 ->add_subfields( "$subfield" => $now );
1756 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1757 $marcrecord->insert_fields_ordered($newField);
1760 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1763 return ( 0, @errors );
1767 =head2 HasSubscriptionExpired
1771 1 or 0 = HasSubscriptionExpired($subscriptionid)
1773 the subscription has expired when the next issue to arrive is out of subscription limit.
1776 1 if true, 0 if false.
1782 sub HasSubscriptionExpired {
1783 my ($subscriptionid) = @_;
1784 my $dbh = C4::Context->dbh;
1785 my $subscription = GetSubscription($subscriptionid);
1786 if (($subscription->{periodicity} % 16)>0){
1787 my $expirationdate = GetExpirationDate($subscriptionid);
1789 SELECT max(planneddate)
1791 WHERE subscriptionid=?
1793 my $sth = $dbh->prepare($query);
1794 $sth->execute($subscriptionid);
1795 my ($res) = $sth->fetchrow ;
1796 my @res=split (/-/,$res);
1797 # warn "date expiration :$expirationdate";
1798 my @endofsubscriptiondate=split(/-/,$expirationdate);
1799 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1800 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1804 if ($subscription->{'numberlength'}){
1805 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1806 return 1 if ($countreceived >$subscription->{'numberlength'});
1812 return 0; # Notice that you'll never get here.
1815 =head2 SetDistributedto
1819 SetDistributedto($distributedto,$subscriptionid);
1820 This function update the value of distributedto for a subscription given on input arg.
1826 sub SetDistributedto {
1827 my ( $distributedto, $subscriptionid ) = @_;
1828 my $dbh = C4::Context->dbh;
1832 WHERE subscriptionid=?
1834 my $sth = $dbh->prepare($query);
1835 $sth->execute( $distributedto, $subscriptionid );
1838 =head2 DelSubscription
1842 DelSubscription($subscriptionid)
1843 this function delete the subscription which has $subscriptionid as id.
1849 sub DelSubscription {
1850 my ($subscriptionid) = @_;
1851 my $dbh = C4::Context->dbh;
1852 $subscriptionid = $dbh->quote($subscriptionid);
1853 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1855 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1856 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1858 logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1865 DelIssue($serialseq,$subscriptionid)
1866 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1873 my ( $dataissue) = @_;
1874 my $dbh = C4::Context->dbh;
1875 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1880 AND subscriptionid= ?
1882 my $mainsth = $dbh->prepare($query);
1883 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1885 #Delete element from subscription history
1886 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1887 my $sth = $dbh->prepare($query);
1888 $sth->execute($dataissue->{'subscriptionid'});
1889 my $val = $sth->fetchrow_hashref;
1890 unless ( $val->{manualhistory} ) {
1892 SELECT * FROM subscriptionhistory
1893 WHERE subscriptionid= ?
1895 my $sth = $dbh->prepare($query);
1896 $sth->execute($dataissue->{'subscriptionid'});
1897 my $data = $sth->fetchrow_hashref;
1898 my $serialseq= $dataissue->{'serialseq'};
1899 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1900 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1901 my $strsth = "UPDATE subscriptionhistory SET "
1903 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1904 . " WHERE subscriptionid=?";
1905 $sth = $dbh->prepare($strsth);
1906 $sth->execute($dataissue->{'subscriptionid'});
1909 return $mainsth->rows;
1912 =head2 GetLateOrMissingIssues
1916 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1918 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1921 a count of the number of missing issues
1922 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1923 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1929 sub GetLateOrMissingIssues {
1930 my ( $supplierid, $serialid,$order ) = @_;
1931 my $dbh = C4::Context->dbh;
1935 $byserial = "and serialid = " . $serialid;
1943 $sth = $dbh->prepare(
1952 serial.subscriptionid,
1955 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1956 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1957 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1958 WHERE subscription.subscriptionid = serial.subscriptionid
1959 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1960 AND subscription.aqbooksellerid=$supplierid
1966 $sth = $dbh->prepare(
1975 serial.subscriptionid,
1978 LEFT JOIN subscription
1979 ON serial.subscriptionid=subscription.subscriptionid
1981 ON subscription.biblionumber=biblio.biblionumber
1982 LEFT JOIN aqbooksellers
1983 ON subscription.aqbooksellerid = aqbooksellers.id
1985 subscription.subscriptionid = serial.subscriptionid
1986 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1996 while ( my $line = $sth->fetchrow_hashref ) {
1997 $odd++ unless $line->{title} eq $last_title;
1998 $last_title = $line->{title} if ( $line->{title} );
1999 $line->{planneddate} = format_date( $line->{planneddate} );
2000 $line->{claimdate} = format_date( $line->{claimdate} );
2001 $line->{"status".$line->{status}} = 1;
2002 $line->{'odd'} = 1 if $odd % 2;
2004 push @issuelist, $line;
2006 return $count, @issuelist;
2009 =head2 removeMissingIssue
2013 removeMissingIssue($subscriptionid)
2015 this function removes an issue from being part of the missing string in
2016 subscriptionlist.missinglist column
2018 called when a missing issue is found from the serials-recieve.pl file
2024 sub removeMissingIssue {
2025 my ( $sequence, $subscriptionid ) = @_;
2026 my $dbh = C4::Context->dbh;
2029 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2030 $sth->execute($subscriptionid);
2031 my $data = $sth->fetchrow_hashref;
2032 my $missinglist = $data->{'missinglist'};
2033 my $missinglistbefore = $missinglist;
2035 # warn $missinglist." before";
2036 $missinglist =~ s/($sequence)//;
2038 # warn $missinglist." after";
2039 if ( $missinglist ne $missinglistbefore ) {
2040 $missinglist =~ s/\|\s\|/\|/g;
2041 $missinglist =~ s/^\| //g;
2042 $missinglist =~ s/\|$//g;
2043 my $sth2 = $dbh->prepare(
2044 "UPDATE subscriptionhistory
2046 WHERE subscriptionid = ?"
2048 $sth2->execute( $missinglist, $subscriptionid );
2056 &updateClaim($serialid)
2058 this function updates the time when a claim is issued for late/missing items
2060 called from claims.pl file
2067 my ($serialid) = @_;
2068 my $dbh = C4::Context->dbh;
2069 my $sth = $dbh->prepare(
2070 "UPDATE serial SET claimdate = now()
2074 $sth->execute($serialid);
2077 =head2 getsupplierbyserialid
2081 ($result) = &getsupplierbyserialid($serialid)
2083 this function is used to find the supplier id given a serial id
2086 hashref containing serialid, subscriptionid, and aqbooksellerid
2092 sub getsupplierbyserialid {
2093 my ($serialid) = @_;
2094 my $dbh = C4::Context->dbh;
2095 my $sth = $dbh->prepare(
2096 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2098 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2102 $sth->execute($serialid);
2103 my $line = $sth->fetchrow_hashref;
2104 my $result = $line->{'aqbooksellerid'};
2108 =head2 check_routing
2112 ($result) = &check_routing($subscriptionid)
2114 this function checks to see if a serial has a routing list and returns the count of routingid
2115 used to show either an 'add' or 'edit' link
2121 my ($subscriptionid) = @_;
2122 my $dbh = C4::Context->dbh;
2123 my $sth = $dbh->prepare(
2124 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2125 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2126 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2129 $sth->execute($subscriptionid);
2130 my $line = $sth->fetchrow_hashref;
2131 my $result = $line->{'routingids'};
2135 =head2 addroutingmember
2139 &addroutingmember($borrowernumber,$subscriptionid)
2141 this function takes a borrowernumber and subscriptionid and add the member to the
2142 routing list for that serial subscription and gives them a rank on the list
2143 of either 1 or highest current rank + 1
2149 sub addroutingmember {
2150 my ( $borrowernumber, $subscriptionid ) = @_;
2152 my $dbh = C4::Context->dbh;
2155 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2157 $sth->execute($subscriptionid);
2158 while ( my $line = $sth->fetchrow_hashref ) {
2159 if ( $line->{'rank'} > 0 ) {
2160 $rank = $line->{'rank'} + 1;
2168 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2170 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2173 =head2 reorder_members
2177 &reorder_members($subscriptionid,$routingid,$rank)
2179 this function is used to reorder the routing list
2181 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2182 - it gets all members on list puts their routingid's into an array
2183 - removes the one in the array that is $routingid
2184 - then reinjects $routingid at point indicated by $rank
2185 - then update the database with the routingids in the new order
2191 sub reorder_members {
2192 my ( $subscriptionid, $routingid, $rank ) = @_;
2193 my $dbh = C4::Context->dbh;
2196 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2198 $sth->execute($subscriptionid);
2200 while ( my $line = $sth->fetchrow_hashref ) {
2201 push( @result, $line->{'routingid'} );
2204 # To find the matching index
2206 my $key = -1; # to allow for 0 being a valid response
2207 for ( $i = 0 ; $i < @result ; $i++ ) {
2208 if ( $routingid == $result[$i] ) {
2209 $key = $i; # save the index
2214 # if index exists in array then move it to new position
2215 if ( $key > -1 && $rank > 0 ) {
2216 my $new_rank = $rank -
2217 1; # $new_rank is what you want the new index to be in the array
2218 my $moving_item = splice( @result, $key, 1 );
2219 splice( @result, $new_rank, 0, $moving_item );
2221 for ( my $j = 0 ; $j < @result ; $j++ ) {
2223 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2225 . "' WHERE routingid = '"
2232 =head2 delroutingmember
2236 &delroutingmember($routingid,$subscriptionid)
2238 this function either deletes one member from routing list if $routingid exists otherwise
2239 deletes all members from the routing list
2245 sub delroutingmember {
2247 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2248 my ( $routingid, $subscriptionid ) = @_;
2249 my $dbh = C4::Context->dbh;
2253 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2254 $sth->execute($routingid);
2255 reorder_members( $subscriptionid, $routingid );
2260 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2261 $sth->execute($subscriptionid);
2265 =head2 getroutinglist
2269 ($count,@routinglist) = &getroutinglist($subscriptionid)
2271 this gets the info from the subscriptionroutinglist for $subscriptionid
2274 a count of the number of members on routinglist
2275 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2276 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2282 sub getroutinglist {
2283 my ($subscriptionid) = @_;
2284 my $dbh = C4::Context->dbh;
2285 my $sth = $dbh->prepare(
2286 "SELECT routingid, borrowernumber,
2287 ranking, biblionumber
2289 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2290 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2293 $sth->execute($subscriptionid);
2296 while ( my $line = $sth->fetchrow_hashref ) {
2298 push( @routinglist, $line );
2300 return ( $count, @routinglist );
2303 =head2 countissuesfrom
2307 $result = &countissuesfrom($subscriptionid,$startdate)
2314 sub countissuesfrom {
2315 my ($subscriptionid,$startdate) = @_;
2316 my $dbh = C4::Context->dbh;
2320 WHERE subscriptionid=?
2321 AND serial.publisheddate>?
2323 my $sth=$dbh->prepare($query);
2324 $sth->execute($subscriptionid, $startdate);
2325 my ($countreceived)=$sth->fetchrow;
2326 return $countreceived;
2329 =head2 abouttoexpire
2333 $result = &abouttoexpire($subscriptionid)
2335 this function alerts you to the penultimate issue for a serial subscription
2337 returns 1 - if this is the penultimate issue
2345 my ($subscriptionid) = @_;
2346 my $dbh = C4::Context->dbh;
2347 my $subscription = GetSubscription($subscriptionid);
2348 my $per = $subscription->{'periodicity'};
2350 my $expirationdate = GetExpirationDate($subscriptionid);
2353 "select max(planneddate) from serial where subscriptionid=?");
2354 $sth->execute($subscriptionid);
2355 my ($res) = $sth->fetchrow ;
2356 # warn "date expiration : ".$expirationdate." date courante ".$res;
2357 my @res=split /-/,$res;
2358 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2359 my @endofsubscriptiondate=split/-/,$expirationdate;
2361 if ( $per == 1 ) {$x=7;}
2362 if ( $per == 2 ) {$x=7; }
2363 if ( $per == 3 ) {$x=14;}
2364 if ( $per == 4 ) { $x = 21; }
2365 if ( $per == 5 ) { $x = 31; }
2366 if ( $per == 6 ) { $x = 62; }
2367 if ( $per == 7 || $per == 8 ) { $x = 93; }
2368 if ( $per == 9 ) { $x = 190; }
2369 if ( $per == 10 ) { $x = 365; }
2370 if ( $per == 11 ) { $x = 730; }
2371 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2372 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2373 # warn "DATE BEFORE END: $datebeforeend";
2374 return 1 if ( @res &&
2376 Delta_Days($res[0],$res[1],$res[2],
2377 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2378 (@endofsubscriptiondate &&
2379 Delta_Days($res[0],$res[1],$res[2],
2380 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2382 } elsif ($subscription->{numberlength}>0) {
2383 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2387 =head2 old_newsubscription
2391 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2392 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2393 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2394 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2395 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2396 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2398 this function is similar to the NewSubscription subroutine but has a few different
2400 $firstacquidate - date of first serial issue to arrive
2401 $irregularity - the issues not expected separated by a '|'
2402 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2403 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2404 subscription-add.tmpl file
2405 $callnumber - display the callnumber of the serial
2406 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2409 the $subscriptionid number of the new subscription
2415 sub old_newsubscription {
2417 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2418 $biblionumber, $startdate, $periodicity, $firstacquidate,
2419 $dow, $irregularity, $numberpattern, $numberlength,
2420 $weeklength, $monthlength, $add1, $every1,
2421 $whenmorethan1, $setto1, $lastvalue1, $add2,
2422 $every2, $whenmorethan2, $setto2, $lastvalue2,
2423 $add3, $every3, $whenmorethan3, $setto3,
2424 $lastvalue3, $numberingmethod, $status, $callnumber,
2427 my $dbh = C4::Context->dbh;
2430 my $sth = $dbh->prepare(
2431 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2432 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2433 add1,every1,whenmorethan1,setto1,lastvalue1,
2434 add2,every2,whenmorethan2,setto2,lastvalue2,
2435 add3,every3,whenmorethan3,setto3,lastvalue3,
2436 numberingmethod, status, callnumber, notes, hemisphere) values
2437 (?,?,?,?,?,?,?,?,?,?,?,
2438 ?,?,?,?,?,?,?,?,?,?,?,
2439 ?,?,?,?,?,?,?,?,?,?,?,?)"
2442 $auser, $aqbooksellerid,
2444 $biblionumber, format_date_in_iso($startdate),
2445 $periodicity, format_date_in_iso($firstacquidate),
2446 $dow, $irregularity,
2447 $numberpattern, $numberlength,
2448 $weeklength, $monthlength,
2450 $whenmorethan1, $setto1,
2452 $every2, $whenmorethan2,
2453 $setto2, $lastvalue2,
2455 $whenmorethan3, $setto3,
2456 $lastvalue3, $numberingmethod,
2457 $status, $callnumber,
2461 #then create the 1st waited number
2462 my $subscriptionid = $dbh->{'mysql_insertid'};
2463 my $enddate = GetExpirationDate($subscriptionid);
2467 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2470 $biblionumber, $subscriptionid,
2471 format_date_in_iso($startdate),
2472 format_date_in_iso($enddate),
2476 # reread subscription to get a hash (for calculation of the 1st issue number)
2478 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2479 $sth->execute($subscriptionid);
2480 my $val = $sth->fetchrow_hashref;
2482 # calculate issue number
2483 my $serialseq = GetSeq($val);
2486 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2488 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2489 1, format_date_in_iso($startdate) );
2490 return $subscriptionid;
2493 =head2 old_modsubscription
2497 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2498 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2499 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2500 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2501 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2502 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2504 this function is similar to the ModSubscription subroutine but has a few different
2506 $firstacquidate - date of first serial issue to arrive
2507 $irregularity - the issues not expected separated by a '|'
2508 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2509 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2510 subscription-add.tmpl file
2511 $callnumber - display the callnumber of the serial
2512 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2518 sub old_modsubscription {
2520 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2521 $startdate, $periodicity, $firstacquidate, $dow,
2522 $irregularity, $numberpattern, $numberlength, $weeklength,
2523 $monthlength, $add1, $every1, $whenmorethan1,
2524 $setto1, $lastvalue1, $innerloop1, $add2,
2525 $every2, $whenmorethan2, $setto2, $lastvalue2,
2526 $innerloop2, $add3, $every3, $whenmorethan3,
2527 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2528 $status, $biblionumber, $callnumber, $notes,
2529 $hemisphere, $subscriptionid
2531 my $dbh = C4::Context->dbh;
2532 my $sth = $dbh->prepare(
2533 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2534 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2535 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2536 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2537 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2538 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2541 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2542 $startdate, $periodicity, $firstacquidate, $dow,
2543 $irregularity, $numberpattern, $numberlength, $weeklength,
2544 $monthlength, $add1, $every1, $whenmorethan1,
2545 $setto1, $lastvalue1, $innerloop1, $add2,
2546 $every2, $whenmorethan2, $setto2, $lastvalue2,
2547 $innerloop2, $add3, $every3, $whenmorethan3,
2548 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2549 $status, $biblionumber, $callnumber, $notes,
2550 $hemisphere, $subscriptionid
2555 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2556 $sth->execute($subscriptionid);
2557 my $val = $sth->fetchrow_hashref;
2559 # calculate issue number
2560 my $serialseq = Get_Seq($val);
2562 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2563 $sth->execute( $serialseq, $subscriptionid );
2565 my $enddate = subscriptionexpirationdate($subscriptionid);
2566 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2567 $sth->execute( format_date_in_iso($enddate) );
2570 =head2 old_getserials
2574 ($totalissues,@serials) = &old_getserials($subscriptionid)
2576 this function get a hashref of serials and the total count of them
2579 $totalissues - number of serial lines
2580 the serials into a table. Each line of this table containts a ref to a hash which it containts
2581 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2587 sub old_getserials {
2588 my ($subscriptionid) = @_;
2589 my $dbh = C4::Context->dbh;
2591 # status = 2 is "arrived"
2594 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2596 $sth->execute($subscriptionid);
2599 while ( my $line = $sth->fetchrow_hashref ) {
2600 $line->{ "status" . $line->{status} } =
2601 1; # fills a "statusX" value, used for template status select list
2602 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2603 $line->{"num"} = $num;
2605 push @serials, $line;
2607 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2608 $sth->execute($subscriptionid);
2609 my ($totalissues) = $sth->fetchrow;
2610 return ( $totalissues, @serials );
2615 ($resultdate) = &GetNextDate($planneddate,$subscription)
2617 this function is an extension of GetNextDate which allows for checking for irregularity
2619 it takes the planneddate and will return the next issue's date and will skip dates if there
2620 exists an irregularity
2621 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2622 skipped then the returned date will be 2007-05-10
2625 $resultdate - then next date in the sequence
2627 Return 0 if periodicity==0
2630 sub in_array { # used in next sub down
2631 my ($val,@elements) = @_;
2632 foreach my $elem(@elements) {
2640 sub GetNextDate(@) {
2641 my ( $planneddate, $subscription ) = @_;
2642 my @irreg = split( /\,/, $subscription->{irregularity} );
2644 #date supposed to be in ISO.
2646 my ( $year, $month, $day ) = split(/-/, $planneddate);
2647 $month=1 unless ($month);
2648 $day=1 unless ($day);
2651 # warn "DOW $dayofweek";
2652 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2656 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2657 # renaming this pattern from 1/day to " n / week ".
2658 if ( $subscription->{periodicity} == 1 ) {
2659 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2660 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2662 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2663 $dayofweek = 0 if ( $dayofweek == 7 );
2664 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2665 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2669 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2673 if ( $subscription->{periodicity} == 2 ) {
2674 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2675 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2677 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2678 #FIXME: if two consecutive irreg, do we only skip one?
2679 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2680 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2681 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2684 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2688 if ( $subscription->{periodicity} == 3 ) {
2689 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2690 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2692 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2693 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2694 ### BUGFIX was previously +1 ^
2695 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2696 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2699 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2703 if ( $subscription->{periodicity} == 4 ) {
2704 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2705 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2707 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2708 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2709 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2710 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2713 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2716 my $tmpmonth=$month;
2717 if ($year && $month && $day){
2718 if ( $subscription->{periodicity} == 5 ) {
2719 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2720 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2721 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2722 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2725 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2727 if ( $subscription->{periodicity} == 6 ) {
2728 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2729 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2730 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2731 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2734 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2736 if ( $subscription->{periodicity} == 7 ) {
2737 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2738 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2739 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2740 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2743 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2745 if ( $subscription->{periodicity} == 8 ) {
2746 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2747 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2748 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2749 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2752 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2754 if ( $subscription->{periodicity} == 9 ) {
2755 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2756 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2757 ### BUFIX Seems to need more Than One ?
2758 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2759 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2762 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2764 if ( $subscription->{periodicity} == 10 ) {
2765 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2767 if ( $subscription->{periodicity} == 11 ) {
2768 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2771 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2773 # warn "dateNEXTSEQ : ".$resultdate;
2774 return "$resultdate";
2779 $item = &itemdata($barcode);
2781 Looks up the item with the given barcode, and returns a
2782 reference-to-hash containing information about that item. The keys of
2783 the hash are the fields from the C<items> and C<biblioitems> tables in
2791 my $dbh = C4::Context->dbh;
2792 my $sth = $dbh->prepare(
2793 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2796 $sth->execute($barcode);
2797 my $data = $sth->fetchrow_hashref;
2809 Koha Developement team <info@koha.org>