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] );
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'} );
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 warn $subscriptionid;
1266 warn $date->output('iso');
1267 my $dbh = C4::Context->dbh;
1268 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1269 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1270 # Each subscription has only one 'expected' issue, with serial.status==1.
1271 $sth->execute( $date->output('iso'),$date->output('iso'), $subscriptionid, 1);
1276 =head2 ModSubscription
1280 this function modify a subscription. Put all new values on input args.
1286 sub ModSubscription {
1288 $auser, $branchcode, $aqbooksellerid, $cost,
1289 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1290 $dow, $irregularity, $numberpattern, $numberlength,
1291 $weeklength, $monthlength, $add1, $every1,
1292 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1293 $add2, $every2, $whenmorethan2, $setto2,
1294 $lastvalue2, $innerloop2, $add3, $every3,
1295 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1296 $numberingmethod, $status, $biblionumber, $callnumber,
1297 $notes, $letter, $hemisphere, $manualhistory,
1298 $internalnotes, $serialsadditems,
1301 # warn $irregularity;
1302 my $dbh = C4::Context->dbh;
1303 my $query = "UPDATE subscription
1304 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1305 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1306 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1307 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1308 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1309 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?
1310 WHERE subscriptionid = ?";
1311 # warn "query :".$query;
1312 my $sth = $dbh->prepare($query);
1314 $auser, $branchcode, $aqbooksellerid, $cost,
1315 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1316 $dow, "$irregularity", $numberpattern, $numberlength,
1317 $weeklength, $monthlength, $add1, $every1,
1318 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1319 $add2, $every2, $whenmorethan2, $setto2,
1320 $lastvalue2, $innerloop2, $add3, $every3,
1321 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1322 $numberingmethod, $status, $biblionumber, $callnumber,
1323 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1324 $internalnotes, $serialsadditems,
1327 my $rows=$sth->rows;
1330 logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1334 =head2 NewSubscription
1338 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1339 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1340 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1341 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1342 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1343 $numberingmethod, $status, $notes, $serialsadditems)
1345 Create a new subscription with value given on input args.
1348 the id of this new subscription
1354 sub NewSubscription {
1356 $auser, $branchcode, $aqbooksellerid, $cost,
1357 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1358 $dow, $numberlength, $weeklength, $monthlength,
1359 $add1, $every1, $whenmorethan1, $setto1,
1360 $lastvalue1, $innerloop1, $add2, $every2,
1361 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1362 $add3, $every3, $whenmorethan3, $setto3,
1363 $lastvalue3, $innerloop3, $numberingmethod, $status,
1364 $notes, $letter, $firstacquidate, $irregularity,
1365 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1366 $internalnotes, $serialsadditems,
1368 my $dbh = C4::Context->dbh;
1370 #save subscription (insert into database)
1372 INSERT INTO subscription
1373 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1374 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1375 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1376 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1377 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1378 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1379 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems)
1380 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1382 my $sth = $dbh->prepare($query);
1384 $auser, $branchcode,
1385 $aqbooksellerid, $cost,
1386 $aqbudgetid, $biblionumber,
1387 format_date_in_iso($startdate), $periodicity,
1388 $dow, $numberlength,
1389 $weeklength, $monthlength,
1391 $whenmorethan1, $setto1,
1392 $lastvalue1, $innerloop1,
1394 $whenmorethan2, $setto2,
1395 $lastvalue2, $innerloop2,
1397 $whenmorethan3, $setto3,
1398 $lastvalue3, $innerloop3,
1399 $numberingmethod, "$status",
1401 format_date_in_iso($firstacquidate), $irregularity,
1402 $numberpattern, $callnumber,
1403 $hemisphere, $manualhistory,
1404 $internalnotes, $serialsadditems,
1407 #then create the 1st waited number
1408 my $subscriptionid = $dbh->{'mysql_insertid'};
1410 INSERT INTO subscriptionhistory
1411 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1414 $sth = $dbh->prepare($query);
1415 $sth->execute( $biblionumber, $subscriptionid,
1416 format_date_in_iso($startdate),
1417 $notes,$internalnotes );
1419 # reread subscription to get a hash (for calculation of the 1st issue number)
1423 WHERE subscriptionid = ?
1425 $sth = $dbh->prepare($query);
1426 $sth->execute($subscriptionid);
1427 my $val = $sth->fetchrow_hashref;
1429 # calculate issue number
1430 my $serialseq = GetSeq($val);
1433 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1434 VALUES (?,?,?,?,?,?)
1436 $sth = $dbh->prepare($query);
1438 "$serialseq", $subscriptionid, $biblionumber, 1,
1439 format_date_in_iso($firstacquidate),
1440 format_date_in_iso($firstacquidate)
1443 logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1445 #set serial flag on biblio if not already set.
1446 my ($null, ($bib)) = GetBiblio($biblionumber);
1447 if( ! $bib->{'serial'} ) {
1448 my $record = GetMarcBiblio($biblionumber);
1449 my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1452 $record->field($tag)->update( $subf => 1 );
1455 ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1457 return $subscriptionid;
1460 =head2 ReNewSubscription
1464 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1466 this function renew a subscription with values given on input args.
1472 sub ReNewSubscription {
1473 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1474 $monthlength, $note )
1476 my $dbh = C4::Context->dbh;
1477 my $subscription = GetSubscription($subscriptionid);
1481 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1482 WHERE biblio.biblionumber=?
1484 my $sth = $dbh->prepare($query);
1485 $sth->execute( $subscription->{biblionumber} );
1486 my $biblio = $sth->fetchrow_hashref;
1487 if (C4::Context->preference("RenewSerialAddsSuggestion")){
1489 $user, $subscription->{bibliotitle},
1490 $biblio->{author}, $biblio->{publishercode},
1491 $biblio->{note}, '',
1494 $subscription->{biblionumber}
1498 # renew subscription
1501 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1502 WHERE subscriptionid=?
1504 $sth = $dbh->prepare($query);
1505 $sth->execute( format_date_in_iso($startdate),
1506 $numberlength, $weeklength, $monthlength, $subscriptionid );
1508 logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1515 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1517 Create a new issue stored on the database.
1518 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1525 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1526 $planneddate, $publisheddate, $notes )
1528 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1530 my $dbh = C4::Context->dbh;
1533 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1534 VALUES (?,?,?,?,?,?,?)
1536 my $sth = $dbh->prepare($query);
1537 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1538 $publisheddate, $planneddate,$notes );
1539 my $serialid=$dbh->{'mysql_insertid'};
1541 SELECT missinglist,recievedlist
1542 FROM subscriptionhistory
1543 WHERE subscriptionid=?
1545 $sth = $dbh->prepare($query);
1546 $sth->execute($subscriptionid);
1547 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1549 if ( $status eq 2 ) {
1550 ### TODO Add a feature that improves recognition and description.
1551 ### As such count (serialseq) i.e. : N18,2(N19),N20
1552 ### Would use substr and index But be careful to previous presence of ()
1553 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1555 if ( $status eq 4 ) {
1556 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1559 UPDATE subscriptionhistory
1560 SET recievedlist=?, missinglist=?
1561 WHERE subscriptionid=?
1563 $sth = $dbh->prepare($query);
1564 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1568 =head2 ItemizeSerials
1572 ItemizeSerials($serialid, $info);
1573 $info is a hashref containing barcode branch, itemcallnumber, status, location
1574 $serialid the serialid
1576 1 if the itemize is a succes.
1577 0 and @error else. @error containts the list of errors found.
1583 sub ItemizeSerials {
1584 my ( $serialid, $info ) = @_;
1585 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1587 my $dbh = C4::Context->dbh;
1593 my $sth = $dbh->prepare($query);
1594 $sth->execute($serialid);
1595 my $data = $sth->fetchrow_hashref;
1596 if ( C4::Context->preference("RoutingSerials") ) {
1598 # check for existing biblioitem relating to serial issue
1599 my ( $count, @results ) =
1600 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1602 for ( my $i = 0 ; $i < $count ; $i++ ) {
1603 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1604 . $data->{'planneddate'}
1607 $bibitemno = $results[$i]->{'biblioitemnumber'};
1611 if ( $bibitemno == 0 ) {
1613 # warn "need to add new biblioitem so copy last one and make minor changes";
1616 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1618 $sth->execute( $data->{'biblionumber'} );
1619 my $biblioitem = $sth->fetchrow_hashref;
1620 $biblioitem->{'volumedate'} =
1621 format_date_in_iso( $data->{planneddate} );
1622 $biblioitem->{'volumeddesc'} =
1623 $data->{serialseq} . ' ('
1624 . format_date( $data->{'planneddate'} ) . ')';
1625 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1627 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1628 # so I comment it, we can speak of it when you want
1629 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1630 # if ( $info->{barcode} )
1631 # { # only make biblioitem if we are going to make item also
1632 # $bibitemno = newbiblioitem($biblioitem);
1637 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1638 if ( $info->{barcode} ) {
1640 my $exists = itemdata( $info->{'barcode'} );
1641 push @errors, "barcode_not_unique" if ($exists);
1643 my $marcrecord = MARC::Record->new();
1644 my ( $tag, $subfield ) =
1645 GetMarcFromKohaField( "items.barcode", $fwk );
1647 MARC::Field->new( "$tag", '', '',
1648 "$subfield" => $info->{barcode} );
1649 $marcrecord->insert_fields_ordered($newField);
1650 if ( $info->{branch} ) {
1651 my ( $tag, $subfield ) =
1652 GetMarcFromKohaField( "items.homebranch",
1655 #warn "items.homebranch : $tag , $subfield";
1656 if ( $marcrecord->field($tag) ) {
1657 $marcrecord->field($tag)
1658 ->add_subfields( "$subfield" => $info->{branch} );
1662 MARC::Field->new( "$tag", '', '',
1663 "$subfield" => $info->{branch} );
1664 $marcrecord->insert_fields_ordered($newField);
1666 ( $tag, $subfield ) =
1667 GetMarcFromKohaField( "items.holdingbranch",
1670 #warn "items.holdingbranch : $tag , $subfield";
1671 if ( $marcrecord->field($tag) ) {
1672 $marcrecord->field($tag)
1673 ->add_subfields( "$subfield" => $info->{branch} );
1677 MARC::Field->new( "$tag", '', '',
1678 "$subfield" => $info->{branch} );
1679 $marcrecord->insert_fields_ordered($newField);
1682 if ( $info->{itemcallnumber} ) {
1683 my ( $tag, $subfield ) =
1684 GetMarcFromKohaField( "items.itemcallnumber",
1687 #warn "items.itemcallnumber : $tag , $subfield";
1688 if ( $marcrecord->field($tag) ) {
1689 $marcrecord->field($tag)
1690 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1694 MARC::Field->new( "$tag", '', '',
1695 "$subfield" => $info->{itemcallnumber} );
1696 $marcrecord->insert_fields_ordered($newField);
1699 if ( $info->{notes} ) {
1700 my ( $tag, $subfield ) =
1701 GetMarcFromKohaField( "items.itemnotes", $fwk );
1703 # warn "items.itemnotes : $tag , $subfield";
1704 if ( $marcrecord->field($tag) ) {
1705 $marcrecord->field($tag)
1706 ->add_subfields( "$subfield" => $info->{notes} );
1710 MARC::Field->new( "$tag", '', '',
1711 "$subfield" => $info->{notes} );
1712 $marcrecord->insert_fields_ordered($newField);
1715 if ( $info->{location} ) {
1716 my ( $tag, $subfield ) =
1717 GetMarcFromKohaField( "items.location", $fwk );
1719 # warn "items.location : $tag , $subfield";
1720 if ( $marcrecord->field($tag) ) {
1721 $marcrecord->field($tag)
1722 ->add_subfields( "$subfield" => $info->{location} );
1726 MARC::Field->new( "$tag", '', '',
1727 "$subfield" => $info->{location} );
1728 $marcrecord->insert_fields_ordered($newField);
1731 if ( $info->{status} ) {
1732 my ( $tag, $subfield ) =
1733 GetMarcFromKohaField( "items.notforloan",
1736 # warn "items.notforloan : $tag , $subfield";
1737 if ( $marcrecord->field($tag) ) {
1738 $marcrecord->field($tag)
1739 ->add_subfields( "$subfield" => $info->{status} );
1743 MARC::Field->new( "$tag", '', '',
1744 "$subfield" => $info->{status} );
1745 $marcrecord->insert_fields_ordered($newField);
1748 if ( C4::Context->preference("RoutingSerials") ) {
1749 my ( $tag, $subfield ) =
1750 GetMarcFromKohaField( "items.dateaccessioned",
1752 if ( $marcrecord->field($tag) ) {
1753 $marcrecord->field($tag)
1754 ->add_subfields( "$subfield" => $now );
1758 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1759 $marcrecord->insert_fields_ordered($newField);
1762 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1765 return ( 0, @errors );
1769 =head2 HasSubscriptionExpired
1773 1 or 0 = HasSubscriptionExpired($subscriptionid)
1775 the subscription has expired when the next issue to arrive is out of subscription limit.
1778 1 if true, 0 if false.
1784 sub HasSubscriptionExpired {
1785 my ($subscriptionid) = @_;
1786 my $dbh = C4::Context->dbh;
1787 my $subscription = GetSubscription($subscriptionid);
1788 if (($subscription->{periodicity} % 16)>0){
1789 my $expirationdate = GetExpirationDate($subscriptionid);
1791 SELECT max(planneddate)
1793 WHERE subscriptionid=?
1795 my $sth = $dbh->prepare($query);
1796 $sth->execute($subscriptionid);
1797 my ($res) = $sth->fetchrow ;
1798 my @res=split (/-/,$res);
1799 # warn "date expiration :$expirationdate";
1800 my @endofsubscriptiondate=split(/-/,$expirationdate);
1801 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1802 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1806 if ($subscription->{'numberlength'}){
1807 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1808 return 1 if ($countreceived >$subscription->{'numberlength'});
1814 return 0; # Notice that you'll never get here.
1817 =head2 SetDistributedto
1821 SetDistributedto($distributedto,$subscriptionid);
1822 This function update the value of distributedto for a subscription given on input arg.
1828 sub SetDistributedto {
1829 my ( $distributedto, $subscriptionid ) = @_;
1830 my $dbh = C4::Context->dbh;
1834 WHERE subscriptionid=?
1836 my $sth = $dbh->prepare($query);
1837 $sth->execute( $distributedto, $subscriptionid );
1840 =head2 DelSubscription
1844 DelSubscription($subscriptionid)
1845 this function delete the subscription which has $subscriptionid as id.
1851 sub DelSubscription {
1852 my ($subscriptionid) = @_;
1853 my $dbh = C4::Context->dbh;
1854 $subscriptionid = $dbh->quote($subscriptionid);
1855 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1857 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1858 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1860 logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1867 DelIssue($serialseq,$subscriptionid)
1868 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1875 my ( $dataissue) = @_;
1876 my $dbh = C4::Context->dbh;
1877 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1882 AND subscriptionid= ?
1884 my $mainsth = $dbh->prepare($query);
1885 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1887 #Delete element from subscription history
1888 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1889 my $sth = $dbh->prepare($query);
1890 $sth->execute($dataissue->{'subscriptionid'});
1891 my $val = $sth->fetchrow_hashref;
1892 unless ( $val->{manualhistory} ) {
1894 SELECT * FROM subscriptionhistory
1895 WHERE subscriptionid= ?
1897 my $sth = $dbh->prepare($query);
1898 $sth->execute($dataissue->{'subscriptionid'});
1899 my $data = $sth->fetchrow_hashref;
1900 my $serialseq= $dataissue->{'serialseq'};
1901 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1902 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1903 my $strsth = "UPDATE subscriptionhistory SET "
1905 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1906 . " WHERE subscriptionid=?";
1907 $sth = $dbh->prepare($strsth);
1908 $sth->execute($dataissue->{'subscriptionid'});
1911 return $mainsth->rows;
1914 =head2 GetLateOrMissingIssues
1918 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1920 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1923 a count of the number of missing issues
1924 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1925 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1931 sub GetLateOrMissingIssues {
1932 my ( $supplierid, $serialid,$order ) = @_;
1933 my $dbh = C4::Context->dbh;
1937 $byserial = "and serialid = " . $serialid;
1945 $sth = $dbh->prepare(
1954 serial.subscriptionid,
1957 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1958 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1959 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1960 WHERE subscription.subscriptionid = serial.subscriptionid
1961 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1962 AND subscription.aqbooksellerid=$supplierid
1968 $sth = $dbh->prepare(
1977 serial.subscriptionid,
1980 LEFT JOIN subscription
1981 ON serial.subscriptionid=subscription.subscriptionid
1983 ON subscription.biblionumber=biblio.biblionumber
1984 LEFT JOIN aqbooksellers
1985 ON subscription.aqbooksellerid = aqbooksellers.id
1987 subscription.subscriptionid = serial.subscriptionid
1988 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1998 while ( my $line = $sth->fetchrow_hashref ) {
1999 $odd++ unless $line->{title} eq $last_title;
2000 $last_title = $line->{title} if ( $line->{title} );
2001 $line->{planneddate} = format_date( $line->{planneddate} );
2002 $line->{claimdate} = format_date( $line->{claimdate} );
2003 $line->{"status".$line->{status}} = 1;
2004 $line->{'odd'} = 1 if $odd % 2;
2006 push @issuelist, $line;
2008 return $count, @issuelist;
2011 =head2 removeMissingIssue
2015 removeMissingIssue($subscriptionid)
2017 this function removes an issue from being part of the missing string in
2018 subscriptionlist.missinglist column
2020 called when a missing issue is found from the serials-recieve.pl file
2026 sub removeMissingIssue {
2027 my ( $sequence, $subscriptionid ) = @_;
2028 my $dbh = C4::Context->dbh;
2031 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2032 $sth->execute($subscriptionid);
2033 my $data = $sth->fetchrow_hashref;
2034 my $missinglist = $data->{'missinglist'};
2035 my $missinglistbefore = $missinglist;
2037 # warn $missinglist." before";
2038 $missinglist =~ s/($sequence)//;
2040 # warn $missinglist." after";
2041 if ( $missinglist ne $missinglistbefore ) {
2042 $missinglist =~ s/\|\s\|/\|/g;
2043 $missinglist =~ s/^\| //g;
2044 $missinglist =~ s/\|$//g;
2045 my $sth2 = $dbh->prepare(
2046 "UPDATE subscriptionhistory
2048 WHERE subscriptionid = ?"
2050 $sth2->execute( $missinglist, $subscriptionid );
2058 &updateClaim($serialid)
2060 this function updates the time when a claim is issued for late/missing items
2062 called from claims.pl file
2069 my ($serialid) = @_;
2070 my $dbh = C4::Context->dbh;
2071 my $sth = $dbh->prepare(
2072 "UPDATE serial SET claimdate = now()
2076 $sth->execute($serialid);
2079 =head2 getsupplierbyserialid
2083 ($result) = &getsupplierbyserialid($serialid)
2085 this function is used to find the supplier id given a serial id
2088 hashref containing serialid, subscriptionid, and aqbooksellerid
2094 sub getsupplierbyserialid {
2095 my ($serialid) = @_;
2096 my $dbh = C4::Context->dbh;
2097 my $sth = $dbh->prepare(
2098 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2100 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2104 $sth->execute($serialid);
2105 my $line = $sth->fetchrow_hashref;
2106 my $result = $line->{'aqbooksellerid'};
2110 =head2 check_routing
2114 ($result) = &check_routing($subscriptionid)
2116 this function checks to see if a serial has a routing list and returns the count of routingid
2117 used to show either an 'add' or 'edit' link
2123 my ($subscriptionid) = @_;
2124 my $dbh = C4::Context->dbh;
2125 my $sth = $dbh->prepare(
2126 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2127 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2128 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2131 $sth->execute($subscriptionid);
2132 my $line = $sth->fetchrow_hashref;
2133 my $result = $line->{'routingids'};
2137 =head2 addroutingmember
2141 &addroutingmember($borrowernumber,$subscriptionid)
2143 this function takes a borrowernumber and subscriptionid and add the member to the
2144 routing list for that serial subscription and gives them a rank on the list
2145 of either 1 or highest current rank + 1
2151 sub addroutingmember {
2152 my ( $borrowernumber, $subscriptionid ) = @_;
2154 my $dbh = C4::Context->dbh;
2157 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2159 $sth->execute($subscriptionid);
2160 while ( my $line = $sth->fetchrow_hashref ) {
2161 if ( $line->{'rank'} > 0 ) {
2162 $rank = $line->{'rank'} + 1;
2170 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2172 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2175 =head2 reorder_members
2179 &reorder_members($subscriptionid,$routingid,$rank)
2181 this function is used to reorder the routing list
2183 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2184 - it gets all members on list puts their routingid's into an array
2185 - removes the one in the array that is $routingid
2186 - then reinjects $routingid at point indicated by $rank
2187 - then update the database with the routingids in the new order
2193 sub reorder_members {
2194 my ( $subscriptionid, $routingid, $rank ) = @_;
2195 my $dbh = C4::Context->dbh;
2198 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2200 $sth->execute($subscriptionid);
2202 while ( my $line = $sth->fetchrow_hashref ) {
2203 push( @result, $line->{'routingid'} );
2206 # To find the matching index
2208 my $key = -1; # to allow for 0 being a valid response
2209 for ( $i = 0 ; $i < @result ; $i++ ) {
2210 if ( $routingid == $result[$i] ) {
2211 $key = $i; # save the index
2216 # if index exists in array then move it to new position
2217 if ( $key > -1 && $rank > 0 ) {
2218 my $new_rank = $rank -
2219 1; # $new_rank is what you want the new index to be in the array
2220 my $moving_item = splice( @result, $key, 1 );
2221 splice( @result, $new_rank, 0, $moving_item );
2223 for ( my $j = 0 ; $j < @result ; $j++ ) {
2225 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2227 . "' WHERE routingid = '"
2234 =head2 delroutingmember
2238 &delroutingmember($routingid,$subscriptionid)
2240 this function either deletes one member from routing list if $routingid exists otherwise
2241 deletes all members from the routing list
2247 sub delroutingmember {
2249 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2250 my ( $routingid, $subscriptionid ) = @_;
2251 my $dbh = C4::Context->dbh;
2255 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2256 $sth->execute($routingid);
2257 reorder_members( $subscriptionid, $routingid );
2262 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2263 $sth->execute($subscriptionid);
2267 =head2 getroutinglist
2271 ($count,@routinglist) = &getroutinglist($subscriptionid)
2273 this gets the info from the subscriptionroutinglist for $subscriptionid
2276 a count of the number of members on routinglist
2277 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2278 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2284 sub getroutinglist {
2285 my ($subscriptionid) = @_;
2286 my $dbh = C4::Context->dbh;
2287 my $sth = $dbh->prepare(
2288 "SELECT routingid, borrowernumber,
2289 ranking, biblionumber
2291 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2292 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2295 $sth->execute($subscriptionid);
2298 while ( my $line = $sth->fetchrow_hashref ) {
2300 push( @routinglist, $line );
2302 return ( $count, @routinglist );
2305 =head2 countissuesfrom
2309 $result = &countissuesfrom($subscriptionid,$startdate)
2316 sub countissuesfrom {
2317 my ($subscriptionid,$startdate) = @_;
2318 my $dbh = C4::Context->dbh;
2322 WHERE subscriptionid=?
2323 AND serial.publisheddate>?
2325 my $sth=$dbh->prepare($query);
2326 $sth->execute($subscriptionid, $startdate);
2327 my ($countreceived)=$sth->fetchrow;
2328 return $countreceived;
2331 =head2 abouttoexpire
2335 $result = &abouttoexpire($subscriptionid)
2337 this function alerts you to the penultimate issue for a serial subscription
2339 returns 1 - if this is the penultimate issue
2347 my ($subscriptionid) = @_;
2348 my $dbh = C4::Context->dbh;
2349 my $subscription = GetSubscription($subscriptionid);
2350 my $per = $subscription->{'periodicity'};
2352 my $expirationdate = GetExpirationDate($subscriptionid);
2355 "select max(planneddate) from serial where subscriptionid=?");
2356 $sth->execute($subscriptionid);
2357 my ($res) = $sth->fetchrow ;
2358 # warn "date expiration : ".$expirationdate." date courante ".$res;
2359 my @res=split /-/,$res;
2360 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2361 my @endofsubscriptiondate=split/-/,$expirationdate;
2363 if ( $per == 1 ) {$x=7;}
2364 if ( $per == 2 ) {$x=7; }
2365 if ( $per == 3 ) {$x=14;}
2366 if ( $per == 4 ) { $x = 21; }
2367 if ( $per == 5 ) { $x = 31; }
2368 if ( $per == 6 ) { $x = 62; }
2369 if ( $per == 7 || $per == 8 ) { $x = 93; }
2370 if ( $per == 9 ) { $x = 190; }
2371 if ( $per == 10 ) { $x = 365; }
2372 if ( $per == 11 ) { $x = 730; }
2373 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2374 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2375 # warn "DATE BEFORE END: $datebeforeend";
2376 return 1 if ( @res &&
2378 Delta_Days($res[0],$res[1],$res[2],
2379 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2380 (@endofsubscriptiondate &&
2381 Delta_Days($res[0],$res[1],$res[2],
2382 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2384 } elsif ($subscription->{numberlength}>0) {
2385 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2389 =head2 old_newsubscription
2393 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2394 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2395 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2396 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2397 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2398 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2400 this function is similar to the NewSubscription subroutine but has a few different
2402 $firstacquidate - date of first serial issue to arrive
2403 $irregularity - the issues not expected separated by a '|'
2404 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2405 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2406 subscription-add.tmpl file
2407 $callnumber - display the callnumber of the serial
2408 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2411 the $subscriptionid number of the new subscription
2417 sub old_newsubscription {
2419 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2420 $biblionumber, $startdate, $periodicity, $firstacquidate,
2421 $dow, $irregularity, $numberpattern, $numberlength,
2422 $weeklength, $monthlength, $add1, $every1,
2423 $whenmorethan1, $setto1, $lastvalue1, $add2,
2424 $every2, $whenmorethan2, $setto2, $lastvalue2,
2425 $add3, $every3, $whenmorethan3, $setto3,
2426 $lastvalue3, $numberingmethod, $status, $callnumber,
2429 my $dbh = C4::Context->dbh;
2432 my $sth = $dbh->prepare(
2433 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2434 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2435 add1,every1,whenmorethan1,setto1,lastvalue1,
2436 add2,every2,whenmorethan2,setto2,lastvalue2,
2437 add3,every3,whenmorethan3,setto3,lastvalue3,
2438 numberingmethod, status, callnumber, notes, hemisphere) values
2439 (?,?,?,?,?,?,?,?,?,?,?,
2440 ?,?,?,?,?,?,?,?,?,?,?,
2441 ?,?,?,?,?,?,?,?,?,?,?,?)"
2444 $auser, $aqbooksellerid,
2446 $biblionumber, format_date_in_iso($startdate),
2447 $periodicity, format_date_in_iso($firstacquidate),
2448 $dow, $irregularity,
2449 $numberpattern, $numberlength,
2450 $weeklength, $monthlength,
2452 $whenmorethan1, $setto1,
2454 $every2, $whenmorethan2,
2455 $setto2, $lastvalue2,
2457 $whenmorethan3, $setto3,
2458 $lastvalue3, $numberingmethod,
2459 $status, $callnumber,
2463 #then create the 1st waited number
2464 my $subscriptionid = $dbh->{'mysql_insertid'};
2465 my $enddate = GetExpirationDate($subscriptionid);
2469 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2472 $biblionumber, $subscriptionid,
2473 format_date_in_iso($startdate),
2474 format_date_in_iso($enddate),
2478 # reread subscription to get a hash (for calculation of the 1st issue number)
2480 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2481 $sth->execute($subscriptionid);
2482 my $val = $sth->fetchrow_hashref;
2484 # calculate issue number
2485 my $serialseq = GetSeq($val);
2488 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2490 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2491 1, format_date_in_iso($startdate) );
2492 return $subscriptionid;
2495 =head2 old_modsubscription
2499 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2500 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2501 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2502 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2503 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2504 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2506 this function is similar to the ModSubscription subroutine but has a few different
2508 $firstacquidate - date of first serial issue to arrive
2509 $irregularity - the issues not expected separated by a '|'
2510 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2511 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2512 subscription-add.tmpl file
2513 $callnumber - display the callnumber of the serial
2514 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2520 sub old_modsubscription {
2522 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2523 $startdate, $periodicity, $firstacquidate, $dow,
2524 $irregularity, $numberpattern, $numberlength, $weeklength,
2525 $monthlength, $add1, $every1, $whenmorethan1,
2526 $setto1, $lastvalue1, $innerloop1, $add2,
2527 $every2, $whenmorethan2, $setto2, $lastvalue2,
2528 $innerloop2, $add3, $every3, $whenmorethan3,
2529 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2530 $status, $biblionumber, $callnumber, $notes,
2531 $hemisphere, $subscriptionid
2533 my $dbh = C4::Context->dbh;
2534 my $sth = $dbh->prepare(
2535 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2536 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2537 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2538 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2539 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2540 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2543 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2544 $startdate, $periodicity, $firstacquidate, $dow,
2545 $irregularity, $numberpattern, $numberlength, $weeklength,
2546 $monthlength, $add1, $every1, $whenmorethan1,
2547 $setto1, $lastvalue1, $innerloop1, $add2,
2548 $every2, $whenmorethan2, $setto2, $lastvalue2,
2549 $innerloop2, $add3, $every3, $whenmorethan3,
2550 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2551 $status, $biblionumber, $callnumber, $notes,
2552 $hemisphere, $subscriptionid
2557 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2558 $sth->execute($subscriptionid);
2559 my $val = $sth->fetchrow_hashref;
2561 # calculate issue number
2562 my $serialseq = Get_Seq($val);
2564 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2565 $sth->execute( $serialseq, $subscriptionid );
2567 my $enddate = subscriptionexpirationdate($subscriptionid);
2568 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2569 $sth->execute( format_date_in_iso($enddate) );
2572 =head2 old_getserials
2576 ($totalissues,@serials) = &old_getserials($subscriptionid)
2578 this function get a hashref of serials and the total count of them
2581 $totalissues - number of serial lines
2582 the serials into a table. Each line of this table containts a ref to a hash which it containts
2583 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2589 sub old_getserials {
2590 my ($subscriptionid) = @_;
2591 my $dbh = C4::Context->dbh;
2593 # status = 2 is "arrived"
2596 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2598 $sth->execute($subscriptionid);
2601 while ( my $line = $sth->fetchrow_hashref ) {
2602 $line->{ "status" . $line->{status} } =
2603 1; # fills a "statusX" value, used for template status select list
2604 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2605 $line->{"num"} = $num;
2607 push @serials, $line;
2609 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2610 $sth->execute($subscriptionid);
2611 my ($totalissues) = $sth->fetchrow;
2612 return ( $totalissues, @serials );
2617 ($resultdate) = &GetNextDate($planneddate,$subscription)
2619 this function is an extension of GetNextDate which allows for checking for irregularity
2621 it takes the planneddate and will return the next issue's date and will skip dates if there
2622 exists an irregularity
2623 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2624 skipped then the returned date will be 2007-05-10
2627 $resultdate - then next date in the sequence
2629 Return 0 if periodicity==0
2632 sub in_array { # used in next sub down
2633 my ($val,@elements) = @_;
2634 foreach my $elem(@elements) {
2642 sub GetNextDate(@) {
2643 my ( $planneddate, $subscription ) = @_;
2644 my @irreg = split( /\,/, $subscription->{irregularity} );
2646 #date supposed to be in ISO.
2648 my ( $year, $month, $day ) = split(/-/, $planneddate);
2649 $month=1 unless ($month);
2650 $day=1 unless ($day);
2653 # warn "DOW $dayofweek";
2654 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2658 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2659 # renaming this pattern from 1/day to " n / week ".
2660 if ( $subscription->{periodicity} == 1 ) {
2661 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2662 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2664 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2665 $dayofweek = 0 if ( $dayofweek == 7 );
2666 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2667 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2671 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2675 if ( $subscription->{periodicity} == 2 ) {
2676 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2677 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2679 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2680 #FIXME: if two consecutive irreg, do we only skip one?
2681 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2682 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2683 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2686 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2690 if ( $subscription->{periodicity} == 3 ) {
2691 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2692 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2694 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2695 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2696 ### BUGFIX was previously +1 ^
2697 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2698 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2701 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2705 if ( $subscription->{periodicity} == 4 ) {
2706 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2707 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2709 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2710 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2711 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2712 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2715 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2718 my $tmpmonth=$month;
2719 if ($year && $month && $day){
2720 if ( $subscription->{periodicity} == 5 ) {
2721 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2722 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2723 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2724 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2727 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2729 if ( $subscription->{periodicity} == 6 ) {
2730 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2731 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2732 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2733 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2736 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2738 if ( $subscription->{periodicity} == 7 ) {
2739 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2740 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2741 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2742 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2745 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2747 if ( $subscription->{periodicity} == 8 ) {
2748 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2749 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2750 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2751 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2754 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2756 if ( $subscription->{periodicity} == 9 ) {
2757 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2758 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2759 ### BUFIX Seems to need more Than One ?
2760 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2761 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2764 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2766 if ( $subscription->{periodicity} == 10 ) {
2767 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2769 if ( $subscription->{periodicity} == 11 ) {
2770 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2773 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2775 # warn "dateNEXTSEQ : ".$resultdate;
2776 return "$resultdate";
2781 $item = &itemdata($barcode);
2783 Looks up the item with the given barcode, and returns a
2784 reference-to-hash containing information about that item. The keys of
2785 the hash are the fields from the C<items> and C<biblioitems> tables in
2793 my $dbh = C4::Context->dbh;
2794 my $sth = $dbh->prepare(
2795 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2798 $sth->execute($barcode);
2799 my $data = $sth->fetchrow_hashref;
2811 Koha Developement team <info@koha.org>