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
24 use Date::Calc qw(:all);
25 use POSIX qw(strftime);
31 use C4::Log; # logaction
35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
37 # set the version for version checking
38 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
39 shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
44 C4::Serials - Give functions for serializing.
52 Give all XYZ functions
61 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
62 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
63 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
64 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
66 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
67 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
68 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
69 &GetSerialInformation &AddItem2Serial
72 &UpdateClaimdateIssues
73 &GetSuppliersWithLateIssues &getsupplierbyserialid
74 &GetDistributedTo &SetDistributedTo
75 &getroutinglist &delroutingmember &addroutingmember
77 &check_routing &updateClaim &removeMissingIssue
79 &old_newsubscription &old_modsubscription &old_getserials
82 =head2 GetSuppliersWithLateIssues
86 %supplierlist = &GetSuppliersWithLateIssues
88 this function get all suppliers with late issues.
91 the supplierlist into a hash. this hash containts id & name of the supplier
97 sub GetSuppliersWithLateIssues {
98 my $dbh = C4::Context->dbh;
100 SELECT DISTINCT id, name
101 FROM subscription, serial
102 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
103 WHERE subscription.subscriptionid = serial.subscriptionid
104 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
106 my $sth = $dbh->prepare($query);
109 while ( my ( $id, $name ) = $sth->fetchrow ) {
110 $supplierlist{$id} = $name;
112 if ( C4::Context->preference("RoutingSerials") ) {
113 $supplierlist{''} = "All Suppliers";
115 return %supplierlist;
122 @issuelist = &GetLateIssues($supplierid)
124 this function select late issues on database
127 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
128 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
135 my ($supplierid) = @_;
136 my $dbh = C4::Context->dbh;
140 SELECT name,title,planneddate,serialseq,serial.subscriptionid
141 FROM subscription, serial, biblio
142 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
143 WHERE subscription.subscriptionid = serial.subscriptionid
144 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
145 AND subscription.aqbooksellerid=$supplierid
146 AND biblio.biblionumber = subscription.biblionumber
149 $sth = $dbh->prepare($query);
153 SELECT name,title,planneddate,serialseq,serial.subscriptionid
154 FROM subscription, serial, biblio
155 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
156 WHERE subscription.subscriptionid = serial.subscriptionid
157 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
158 AND biblio.biblionumber = subscription.biblionumber
161 $sth = $dbh->prepare($query);
168 while ( my $line = $sth->fetchrow_hashref ) {
169 $odd++ unless $line->{title} eq $last_title;
170 $line->{title} = "" if $line->{title} eq $last_title;
171 $last_title = $line->{title} if ( $line->{title} );
172 $line->{planneddate} = format_date( $line->{planneddate} );
174 push @issuelist, $line;
176 return $count, @issuelist;
179 =head2 GetSubscriptionHistoryFromSubscriptionId
183 $sth = GetSubscriptionHistoryFromSubscriptionId()
184 this function just prepare the SQL request.
185 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
187 $sth = $dbh->prepare($query).
193 sub GetSubscriptionHistoryFromSubscriptionId() {
194 my $dbh = C4::Context->dbh;
197 FROM subscriptionhistory
198 WHERE subscriptionid = ?
200 return $dbh->prepare($query);
203 =head2 GetSerialStatusFromSerialId
207 $sth = GetSerialStatusFromSerialId();
208 this function just prepare the SQL request.
209 After this function, don't forget to execute it by using $sth->execute($serialid)
211 $sth = $dbh->prepare($query).
217 sub GetSerialStatusFromSerialId() {
218 my $dbh = C4::Context->dbh;
224 return $dbh->prepare($query);
227 =head2 GetSerialInformation
231 $data = GetSerialInformation($serialid);
232 returns a hash containing :
233 items : items marcrecord (can be an array)
235 subscription table field
236 + information about subscription expiration
242 sub GetSerialInformation {
244 my $dbh = C4::Context->dbh;
246 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
247 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
250 my $rq = $dbh->prepare($query);
251 $rq->execute($serialid);
252 my $data = $rq->fetchrow_hashref;
254 if ( C4::Context->preference("serialsadditems") ) {
255 if ( $data->{'itemnumber'} ) {
256 my @itemnumbers = split /,/, $data->{'itemnumber'};
257 foreach my $itemnum (@itemnumbers) {
259 #It is ASSUMED that MARCgetitem ALWAYS WORK...
260 #Maybe MARCgetitem should return values on failure
261 # warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
263 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
264 $itemprocessed->{'itemnumber'} = $itemnum;
265 $itemprocessed->{'itemid'} = $itemnum;
266 $itemprocessed->{'serialid'} = $serialid;
267 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
268 push @{ $data->{'items'} }, $itemprocessed;
273 PrepareItemrecordDisplay( $data->{'biblionumber'} );
274 $itemprocessed->{'itemid'} = "N$serialid";
275 $itemprocessed->{'serialid'} = $serialid;
276 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
277 $itemprocessed->{'countitems'} = 0;
278 push @{ $data->{'items'} }, $itemprocessed;
281 $data->{ "status" . $data->{'serstatus'} } = 1;
282 $data->{'subscriptionexpired'} =
283 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
284 $data->{'abouttoexpire'} =
285 abouttoexpire( $data->{'subscriptionid'} );
289 =head2 GetSerialInformation
293 $data = AddItem2Serial($serialid,$itemnumber);
294 Adds an itemnumber to Serial record
300 my ( $serialid, $itemnumber ) = @_;
301 my $dbh = C4::Context->dbh;
303 UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber))
306 my $rq = $dbh->prepare($query);
307 $rq->execute($serialid);
311 =head2 UpdateClaimdateIssues
315 UpdateClaimdateIssues($serialids,[$date]);
317 Update Claimdate for issues in @$serialids list with date $date
323 sub UpdateClaimdateIssues {
324 my ( $serialids, $date ) = @_;
325 my $dbh = C4::Context->dbh;
326 $date = strftime("%Y-%m-%d",localtime) unless ($date);
328 UPDATE serial SET claimdate=$date,status=7
329 WHERE serialid in ".join (",",@$serialids);
331 my $rq = $dbh->prepare($query);
336 =head2 GetSubscription
340 $subs = GetSubscription($subscriptionid)
341 this function get the subscription which has $subscriptionid as id.
343 a hashref. This hash containts
344 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
350 sub GetSubscription {
351 my ($subscriptionid) = @_;
352 my $dbh = C4::Context->dbh;
354 SELECT subscription.*,
355 subscriptionhistory.*,
357 aqbooksellers.name AS aqbooksellername,
358 biblio.title AS bibliotitle,
359 subscription.biblionumber as bibnum
361 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
362 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
363 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
364 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
365 WHERE subscription.subscriptionid = ?
367 if (C4::Context->preference('IndependantBranches') &&
368 C4::Context->userenv &&
369 C4::Context->userenv->{'flags'} != 1){
370 # warn "flags: ".C4::Context->userenv->{'flags'};
371 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
373 # warn "query : $query";
374 my $sth = $dbh->prepare($query);
375 $sth->execute($subscriptionid);
376 my $subs = $sth->fetchrow_hashref;
380 =head2 GetFullSubscription
384 \@res = GetFullSubscription($subscriptionid)
385 this function read on serial table.
391 sub GetFullSubscription {
392 my ($subscriptionid) = @_;
393 my $dbh = C4::Context->dbh;
395 SELECT serial.serialid,
398 serial.publisheddate,
400 serial.notes as notes,
401 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
402 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
403 biblio.title as bibliotitle,
404 subscription.branchcode AS branchcode,
405 subscription.subscriptionid AS subscriptionid
407 LEFT JOIN subscription ON
408 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
409 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
410 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
411 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
412 WHERE serial.subscriptionid = ? |;
413 if (C4::Context->preference('IndependantBranches') &&
414 C4::Context->userenv &&
415 C4::Context->userenv->{'flags'} != 1){
417 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
421 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
422 serial.subscriptionid
424 my $sth = $dbh->prepare($query);
425 $sth->execute($subscriptionid);
426 my $subs = $sth->fetchall_arrayref({});
431 =head2 PrepareSerialsData
435 \@res = PrepareSerialsData($serialinfomation)
436 where serialinformation is a hashref array
442 sub PrepareSerialsData{
448 my $aqbooksellername;
452 my $previousnote = "";
454 foreach my $subs ( @$lines ) {
455 $subs->{'publisheddate'} =
456 ( $subs->{'publisheddate'}
457 ? format_date( $subs->{'publisheddate'} )
459 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
460 $subs->{ "status" . $subs->{'status'} } = 1;
462 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
463 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
464 $year = $subs->{'year'};
469 if ( $tmpresults{$year} ) {
470 push @{ $tmpresults{$year}->{'serials'} }, $subs;
473 $tmpresults{$year} = {
476 # 'startdate'=>format_date($subs->{'startdate'}),
477 'aqbooksellername' => $subs->{'aqbooksellername'},
478 'bibliotitle' => $subs->{'bibliotitle'},
479 'serials' => [$subs],
481 'branchcode' => $subs->{'branchcode'},
482 'subscriptionid' => $subs->{'subscriptionid'},
486 # $previousnote=$subs->{notes};
488 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
489 push @res, $tmpresults{$key};
494 =head2 GetSubscriptionsFromBiblionumber
496 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
497 this function get the subscription list. it reads on subscription table.
499 table of subscription which has the biblionumber given on input arg.
500 each line of this table is a hashref. All hashes containt
501 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
505 sub GetSubscriptionsFromBiblionumber {
506 my ($biblionumber) = @_;
507 my $dbh = C4::Context->dbh;
509 SELECT subscription.*,
511 subscriptionhistory.*,
513 aqbooksellers.name AS aqbooksellername,
514 biblio.title AS bibliotitle
516 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
517 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
518 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
519 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
520 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
521 WHERE subscription.biblionumber = ?
523 if (C4::Context->preference('IndependantBranches') &&
524 C4::Context->userenv &&
525 C4::Context->userenv->{'flags'} != 1){
526 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
528 my $sth = $dbh->prepare($query);
529 $sth->execute($biblionumber);
531 while ( my $subs = $sth->fetchrow_hashref ) {
532 $subs->{startdate} = format_date( $subs->{startdate} );
533 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
534 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
535 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
536 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
537 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
538 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
539 $subs->{ "status" . $subs->{'status'} } = 1;
540 if ( $subs->{enddate} eq '0000-00-00' ) {
541 $subs->{enddate} = '';
544 $subs->{enddate} = format_date( $subs->{enddate} );
546 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
547 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
553 =head2 GetFullSubscriptionsFromBiblionumber
557 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
558 this function read on serial table.
564 sub GetFullSubscriptionsFromBiblionumber {
565 my ($biblionumber) = @_;
566 my $dbh = C4::Context->dbh;
568 SELECT serial.serialid,
571 serial.publisheddate,
573 serial.notes as notes,
574 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
575 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
576 biblio.title as bibliotitle,
577 subscription.branchcode AS branchcode,
578 subscription.subscriptionid AS subscriptionid
580 LEFT JOIN subscription ON
581 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
582 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
583 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
584 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
585 WHERE subscription.biblionumber = ? |;
586 if (C4::Context->preference('IndependantBranches') &&
587 C4::Context->userenv &&
588 C4::Context->userenv->{'flags'} != 1){
590 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
594 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
595 serial.subscriptionid
597 my $sth = $dbh->prepare($query);
598 $sth->execute($biblionumber);
599 my $subs= $sth->fetchall_arrayref({});
603 =head2 GetSubscriptions
607 @results = GetSubscriptions($title,$ISSN,$biblionumber);
608 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
610 a table of hashref. Each hash containt the subscription.
616 sub GetSubscriptions {
617 my ( $title, $ISSN, $biblionumber ) = @_;
618 #return unless $title or $ISSN or $biblionumber;
619 my $dbh = C4::Context->dbh;
623 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
624 FROM subscription,biblio,biblioitems
625 WHERE biblio.biblionumber = biblioitems.biblionumber
626 AND biblio.biblionumber = subscription.biblionumber
627 AND biblio.biblionumber=?
629 if (C4::Context->preference('IndependantBranches') &&
630 C4::Context->userenv &&
631 C4::Context->userenv->{'flags'} != 1){
632 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
634 $query.=" ORDER BY title";
635 # warn "query :$query";
636 $sth = $dbh->prepare($query);
637 $sth->execute($biblionumber);
640 if ( $ISSN and $title ) {
642 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
643 FROM subscription,biblio,biblioitems
644 WHERE biblio.biblionumber = biblioitems.biblionumber
645 AND biblio.biblionumber= subscription.biblionumber
646 AND (biblio.title LIKE ? or biblioitems.issn = ?)
648 if (C4::Context->preference('IndependantBranches') &&
649 C4::Context->userenv &&
650 C4::Context->userenv->{'flags'} != 1){
651 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
653 $query.=" ORDER BY title";
654 $sth = $dbh->prepare($query);
655 $sth->execute( "%$title%", $ISSN );
660 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
661 FROM subscription,biblio,biblioitems
662 WHERE biblio.biblionumber = biblioitems.biblionumber
663 AND biblio.biblionumber=subscription.biblionumber
664 AND biblioitems.issn LIKE ?
666 if (C4::Context->preference('IndependantBranches') &&
667 C4::Context->userenv &&
668 C4::Context->userenv->{'flags'} != 1){
669 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
671 $query.=" ORDER BY title";
672 # warn "query :$query";
673 $sth = $dbh->prepare($query);
674 $sth->execute( "%" . $ISSN . "%" );
678 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
679 FROM subscription,biblio,biblioitems
680 WHERE biblio.biblionumber = biblioitems.biblionumber
681 AND biblio.biblionumber=subscription.biblionumber
682 AND biblio.title LIKE ?
684 if (C4::Context->preference('IndependantBranches') &&
685 C4::Context->userenv &&
686 C4::Context->userenv->{'flags'} != 1){
687 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
689 $query.=" ORDER BY title";
690 $sth = $dbh->prepare($query);
691 $sth->execute( "%" . $title . "%" );
696 my $previoustitle = "";
698 while ( my $line = $sth->fetchrow_hashref ) {
699 if ( $previoustitle eq $line->{title} ) {
702 $line->{toggle} = 1 if $odd == 1;
705 $previoustitle = $line->{title};
707 $line->{toggle} = 1 if $odd == 1;
709 push @results, $line;
718 ($totalissues,@serials) = GetSerials($subscriptionid);
719 this function get every serial not arrived for a given subscription
720 as well as the number of issues registered in the database (all types)
721 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
728 my ($subscriptionid,$count) = @_;
729 my $dbh = C4::Context->dbh;
731 # status = 2 is "arrived"
733 $count=5 unless ($count);
736 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes
738 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
739 ORDER BY publisheddate,serialid DESC";
740 my $sth = $dbh->prepare($query);
741 $sth->execute($subscriptionid);
742 while ( my $line = $sth->fetchrow_hashref ) {
743 $line->{ "status" . $line->{status} } =
744 1; # fills a "statusX" value, used for template status select list
745 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
746 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
747 push @serials, $line;
749 # OK, now add the last 5 issues arrives/missing
751 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes
753 WHERE subscriptionid = ?
754 AND (status in (2,4,5))
755 ORDER BY publisheddate,serialid DESC
757 $sth = $dbh->prepare($query);
758 $sth->execute($subscriptionid);
759 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
761 $line->{ "status" . $line->{status} } =
762 1; # fills a "statusX" value, used for template status select list
763 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
764 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
765 push @serials, $line;
768 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
769 $sth = $dbh->prepare($query);
770 $sth->execute($subscriptionid);
771 my ($totalissues) = $sth->fetchrow;
772 return ( $totalissues, @serials );
779 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
780 this function get every serial waited for a given subscription
781 as well as the number of issues registered in the database (all types)
782 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
788 my ($subscription,$status) = @_;
789 my $dbh = C4::Context->dbh;
791 SELECT serialid,serialseq, status, planneddate, publisheddate,notes
793 WHERE subscriptionid=$subscription AND status=$status
794 ORDER BY publisheddate,serialid DESC
797 my $sth=$dbh->prepare($query);
800 while(my $line = $sth->fetchrow_hashref) {
801 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
802 $line->{"planneddate"} = format_date($line->{"planneddate"});
803 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
806 my ($totalissues) = scalar(@serials);
807 return ($totalissues,@serials);
810 =head2 GetLatestSerials
814 \@serials = GetLatestSerials($subscriptionid,$limit)
815 get the $limit's latest serials arrived or missing for a given subscription
817 a ref to a table which it containts all of the latest serials stored into a hash.
823 sub GetLatestSerials {
824 my ( $subscriptionid, $limit ) = @_;
825 my $dbh = C4::Context->dbh;
827 # status = 2 is "arrived"
828 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
830 WHERE subscriptionid = ?
831 AND (status =2 or status=4)
832 ORDER BY planneddate DESC LIMIT 0,$limit
834 my $sth = $dbh->prepare($strsth);
835 $sth->execute($subscriptionid);
837 while ( my $line = $sth->fetchrow_hashref ) {
838 $line->{ "status" . $line->{status} } =
839 1; # fills a "statusX" value, used for template status select list
840 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
841 push @serials, $line;
847 # WHERE subscriptionid=?
849 # $sth=$dbh->prepare($query);
850 # $sth->execute($subscriptionid);
851 # my ($totalissues) = $sth->fetchrow;
855 =head2 GetDistributedTo
859 $distributedto=GetDistributedTo($subscriptionid)
860 This function select the old previous value of distributedto in the database.
866 sub GetDistributedTo {
867 my $dbh = C4::Context->dbh;
869 my $subscriptionid = @_;
870 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
871 my $sth = $dbh->prepare($query);
872 $sth->execute($subscriptionid);
873 return ($distributedto) = $sth->fetchrow;
881 $val is a hashref containing all the attributes of the table 'subscription'
882 This function get the next issue for the subscription given on input arg
884 all the input params updated.
892 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
893 # $calculated = $val->{numberingmethod};
894 # # calculate the (expected) value of the next issue recieved.
895 # $newlastvalue1 = $val->{lastvalue1};
896 # # check if we have to increase the new value.
897 # $newinnerloop1 = $val->{innerloop1}+1;
898 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
899 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
900 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
901 # $calculated =~ s/\{X\}/$newlastvalue1/g;
903 # $newlastvalue2 = $val->{lastvalue2};
904 # # check if we have to increase the new value.
905 # $newinnerloop2 = $val->{innerloop2}+1;
906 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
907 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
908 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
909 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
911 # $newlastvalue3 = $val->{lastvalue3};
912 # # check if we have to increase the new value.
913 # $newinnerloop3 = $val->{innerloop3}+1;
914 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
915 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
916 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
917 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
918 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
924 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
925 $newinnerloop1, $newinnerloop2, $newinnerloop3
927 my $pattern = $val->{numberpattern};
928 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
929 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
930 $calculated = $val->{numberingmethod};
931 $newlastvalue1 = $val->{lastvalue1};
932 $newlastvalue2 = $val->{lastvalue2};
933 $newlastvalue3 = $val->{lastvalue3};
935 if ( $newlastvalue3 > 0 ) { # if x y and z columns are used
936 $newlastvalue3 = $newlastvalue3 + 1;
937 if ( $newlastvalue3 > $val->{whenmorethan3} ) {
938 $newlastvalue3 = $val->{setto3};
940 if ( $newlastvalue2 > $val->{whenmorethan2} ) {
942 $newlastvalue2 = $val->{setto2};
945 $calculated =~ s/\{X\}/$newlastvalue1/g;
946 if ( $pattern == 6 ) {
947 if ( $val->{hemisphere} == 2 ) {
948 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
949 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
952 my $newlastvalue2seq = $seasons[$newlastvalue2];
953 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
957 $calculated =~ s/\{Y\}/$newlastvalue2/g;
959 $calculated =~ s/\{Z\}/$newlastvalue3/g;
961 if ( $newlastvalue2 > 0 && $newlastvalue3 < 1 )
962 { # if x and y columns are used
963 $newlastvalue2 = $newlastvalue2 + 1;
964 if ( $newlastvalue2 > $val->{whenmorethan2} ) {
965 $newlastvalue2 = $val->{setto2};
968 $calculated =~ s/\{X\}/$newlastvalue1/g;
969 if ( $pattern == 6 ) {
970 if ( $val->{hemisphere} == 2 ) {
971 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
972 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
975 my $newlastvalue2seq = $seasons[$newlastvalue2];
976 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
980 $calculated =~ s/\{Y\}/$newlastvalue2/g;
983 if ( $newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1 )
985 $newlastvalue1 = $newlastvalue1 + 1;
986 if ( $newlastvalue1 > $val->{whenmorethan1} ) {
987 $newlastvalue1 = $val->{setto2};
989 $calculated =~ s/\{X\}/$newlastvalue1/g;
991 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 );
998 $calculated = GetSeq($val)
999 $val is a hashref containing all the attributes of the table 'subscription'
1000 this function transforms {X},{Y},{Z} to 150,0,0 for example.
1002 the sequence in integer format
1010 my $pattern = $val->{numberpattern};
1011 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
1012 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
1013 my $calculated = $val->{numberingmethod};
1014 my $x = $val->{'lastvalue1'};
1015 $calculated =~ s/\{X\}/$x/g;
1016 my $newlastvalue2 = $val->{'lastvalue2'};
1017 if ( $pattern == 6 ) {
1018 if ( $val->{hemisphere} == 2 ) {
1019 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1020 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1023 my $newlastvalue2seq = $seasons[$newlastvalue2];
1024 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1028 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1030 my $z = $val->{'lastvalue3'};
1031 $calculated =~ s/\{Z\}/$z/g;
1035 =head2 GetExpirationDate
1037 $sensddate = GetExpirationDate($subscriptionid)
1039 this function return the expiration date for a subscription given on input args.
1046 sub GetExpirationDate {
1047 my ($subscriptionid) = @_;
1048 my $dbh = C4::Context->dbh;
1049 my $subscription = GetSubscription($subscriptionid);
1050 my $enddate = $subscription->{startdate};
1052 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1053 # warn "SUBSCRIPTIONID :$subscriptionid";
1054 # use Data::Dumper; warn Dumper($subscription);
1056 if ( $subscription->{numberlength} ) {
1057 #calculate the date of the last issue.
1058 my $length = $subscription->{numberlength};
1059 # warn "ENDDATE ".$enddate;
1060 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1061 $enddate = GetNextDate( $enddate, $subscription );
1062 # warn "AFTER ENDDATE ".$enddate;
1065 elsif ( $subscription->{monthlength} ){
1066 # warn "dateCHECKRESERV :".$subscription->{startdate};
1067 my @date=split (/-/,$subscription->{startdate});
1068 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1069 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1070 } elsif ( $subscription->{weeklength} ){
1071 my @date=split (/-/,$subscription->{startdate});
1072 # warn "dateCHECKRESERV :".$subscription->{startdate};
1073 #### An other way to do it
1074 # if ( $subscription->{weeklength} ){
1075 # my ($weeknb,$year)=Week_of_Year(@startdate);
1076 # $weeknb += $subscription->{weeklength};
1077 # my $weeknbcalc= $weeknb % 52;
1078 # $year += int($weeknb/52);
1079 # # warn "year : $year weeknb :$weeknb weeknbcalc $weeknbcalc";
1080 # @endofsubscriptiondate=Monday_of_Week($weeknbcalc,$year);
1082 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1083 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1085 # warn "date de fin :$enddate";
1089 =head2 CountSubscriptionFromBiblionumber
1093 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1094 this count the number of subscription for a biblionumber given.
1096 the number of subscriptions with biblionumber given on input arg.
1102 sub CountSubscriptionFromBiblionumber {
1103 my ($biblionumber) = @_;
1104 my $dbh = C4::Context->dbh;
1105 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1106 my $sth = $dbh->prepare($query);
1107 $sth->execute($biblionumber);
1108 my $subscriptionsnumber = $sth->fetchrow;
1109 return $subscriptionsnumber;
1112 =head2 ModSubscriptionHistory
1116 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1118 this function modify the history of a subscription. Put your new values on input arg.
1124 sub ModSubscriptionHistory {
1126 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1127 $missinglist, $opacnote, $librariannote
1129 my $dbh = C4::Context->dbh;
1130 my $query = "UPDATE subscriptionhistory
1131 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1132 WHERE subscriptionid=?
1134 my $sth = $dbh->prepare($query);
1135 $recievedlist =~ s/^,//g;
1136 $missinglist =~ s/^,//g;
1137 $opacnote =~ s/^,//g;
1139 $histstartdate, $enddate, $recievedlist, $missinglist,
1140 $opacnote, $librariannote, $subscriptionid
1145 =head2 ModSerialStatus
1149 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
1151 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1152 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1158 sub ModSerialStatus {
1159 my ( $serialid, $serialseq, $publisheddate, $planneddate, $status, $notes )
1162 #It is a usual serial
1163 # 1st, get previous status :
1164 my $dbh = C4::Context->dbh;
1165 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1166 my $sth = $dbh->prepare($query);
1167 $sth->execute($serialid);
1168 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1170 # change status & update subscriptionhistory
1172 if ( $status eq 6 ) {
1173 DelIssue( $serialseq, $subscriptionid );
1177 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1178 $sth = $dbh->prepare($query);
1179 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1180 $notes, $serialid );
1181 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1182 $sth = $dbh->prepare($query);
1183 $sth->execute($subscriptionid);
1184 my $val = $sth->fetchrow_hashref;
1185 unless ( $val->{manualhistory} ) {
1187 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1188 $sth = $dbh->prepare($query);
1189 $sth->execute($subscriptionid);
1190 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1191 if ( $status eq 2 ) {
1193 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1194 $recievedlist .= ",$serialseq"
1195 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1198 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1199 $missinglist .= ",$serialseq"
1201 and not index( "$missinglist", "$serialseq" ) >= 0 );
1202 $missinglist .= ",not issued $serialseq"
1204 and index( "$missinglist", "$serialseq" ) >= 0 );
1206 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1207 $sth = $dbh->prepare($query);
1208 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1212 # create new waited entry if needed (ie : was a "waited" and has changed)
1213 if ( $oldstatus eq 1 && $status ne 1 ) {
1214 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1215 $sth = $dbh->prepare($query);
1216 $sth->execute($subscriptionid);
1217 my $val = $sth->fetchrow_hashref;
1221 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1222 $newinnerloop1, $newinnerloop2, $newinnerloop3
1223 ) = GetNextSeq($val);
1225 # next date (calculated from actual date & frequency parameters)
1226 # warn "publisheddate :$publisheddate ";
1227 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1228 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1229 1, $nextpublisheddate, $nextpublisheddate );
1231 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1232 WHERE subscriptionid = ?";
1233 $sth = $dbh->prepare($query);
1235 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1236 $newinnerloop2, $newinnerloop3, $subscriptionid
1239 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1240 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1241 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1246 =head2 ModSubscription
1250 this function modify a subscription. Put all new values on input args.
1256 sub ModSubscription {
1258 $auser, $branchcode, $aqbooksellerid, $cost,
1259 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1260 $dow, $irregularity, $numberpattern, $numberlength,
1261 $weeklength, $monthlength, $add1, $every1,
1262 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1263 $add2, $every2, $whenmorethan2, $setto2,
1264 $lastvalue2, $innerloop2, $add3, $every3,
1265 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1266 $numberingmethod, $status, $biblionumber, $callnumber,
1267 $notes, $letter, $hemisphere, $manualhistory,
1271 # warn $irregularity;
1272 my $dbh = C4::Context->dbh;
1273 my $query = "UPDATE subscription
1274 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1275 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1276 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1277 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1278 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1279 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1280 WHERE subscriptionid = ?";
1281 # warn "query :".$query;
1282 my $sth = $dbh->prepare($query);
1284 $auser, $branchcode, $aqbooksellerid, $cost,
1285 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1286 $dow, "$irregularity", $numberpattern, $numberlength,
1287 $weeklength, $monthlength, $add1, $every1,
1288 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1289 $add2, $every2, $whenmorethan2, $setto2,
1290 $lastvalue2, $innerloop2, $add3, $every3,
1291 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1292 $numberingmethod, $status, $biblionumber, $callnumber,
1293 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1297 my $rows=$sth->rows;
1300 &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1301 if C4::Context->preference("SubscriptionLog");
1305 =head2 NewSubscription
1309 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1310 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1311 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1312 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1313 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1314 $numberingmethod, $status, $notes)
1316 Create a new subscription with value given on input args.
1319 the id of this new subscription
1325 sub NewSubscription {
1327 $auser, $branchcode, $aqbooksellerid, $cost,
1328 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1329 $dow, $numberlength, $weeklength, $monthlength,
1330 $add1, $every1, $whenmorethan1, $setto1,
1331 $lastvalue1, $innerloop1, $add2, $every2,
1332 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1333 $add3, $every3, $whenmorethan3, $setto3,
1334 $lastvalue3, $innerloop3, $numberingmethod, $status,
1335 $notes, $letter, $firstacquidate, $irregularity,
1336 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1339 my $dbh = C4::Context->dbh;
1341 #save subscription (insert into database)
1343 INSERT INTO subscription
1344 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1345 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1346 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1347 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1348 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1349 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1350 numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1351 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1353 my $sth = $dbh->prepare($query);
1355 $auser, $branchcode,
1356 $aqbooksellerid, $cost,
1357 $aqbudgetid, $biblionumber,
1358 format_date_in_iso($startdate), $periodicity,
1359 $dow, $numberlength,
1360 $weeklength, $monthlength,
1362 $whenmorethan1, $setto1,
1363 $lastvalue1, $innerloop1,
1365 $whenmorethan2, $setto2,
1366 $lastvalue2, $innerloop2,
1368 $whenmorethan3, $setto3,
1369 $lastvalue3, $innerloop3,
1370 $numberingmethod, "$status",
1372 $firstacquidate, $irregularity,
1373 $numberpattern, $callnumber,
1374 $hemisphere, $manualhistory,
1378 #then create the 1st waited number
1379 my $subscriptionid = $dbh->{'mysql_insertid'};
1381 INSERT INTO subscriptionhistory
1382 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1383 VALUES (?,?,?,?,?,?,?,?)
1385 $sth = $dbh->prepare($query);
1386 $sth->execute( $biblionumber, $subscriptionid,
1387 format_date_in_iso($startdate),
1388 0, "", "", "", "$notes" );
1390 # reread subscription to get a hash (for calculation of the 1st issue number)
1394 WHERE subscriptionid = ?
1396 $sth = $dbh->prepare($query);
1397 $sth->execute($subscriptionid);
1398 my $val = $sth->fetchrow_hashref;
1400 # calculate issue number
1401 my $serialseq = GetSeq($val);
1404 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1405 VALUES (?,?,?,?,?,?)
1407 $sth = $dbh->prepare($query);
1409 "$serialseq", $subscriptionid, $biblionumber, 1,
1410 format_date_in_iso($startdate),
1411 format_date_in_iso($startdate)
1414 &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1415 if C4::Context->preference("SubscriptionLog");
1417 return $subscriptionid;
1420 =head2 ReNewSubscription
1424 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1426 this function renew a subscription with values given on input args.
1432 sub ReNewSubscription {
1433 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1434 $monthlength, $note )
1436 my $dbh = C4::Context->dbh;
1437 my $subscription = GetSubscription($subscriptionid);
1440 FROM biblio,biblioitems
1441 WHERE biblio.biblionumber=biblioitems.biblionumber
1442 AND biblio.biblionumber=?
1444 my $sth = $dbh->prepare($query);
1445 $sth->execute( $subscription->{biblionumber} );
1446 my $biblio = $sth->fetchrow_hashref;
1448 $user, $subscription->{bibliotitle},
1449 $biblio->{author}, $biblio->{publishercode},
1450 $biblio->{note}, '',
1453 $subscription->{biblionumber}
1456 # renew subscription
1459 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1460 WHERE subscriptionid=?
1462 $sth = $dbh->prepare($query);
1463 $sth->execute( format_date_in_iso($startdate),
1464 $numberlength, $weeklength, $monthlength, $subscriptionid );
1466 &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1467 if C4::Context->preference("SubscriptionLog");
1474 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1476 Create a new issue stored on the database.
1477 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1484 my ( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate,
1485 $planneddate, $notes )
1487 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1489 my $dbh = C4::Context->dbh;
1492 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1493 VALUES (?,?,?,?,?,?,?)
1495 my $sth = $dbh->prepare($query);
1496 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1497 $publisheddate, $planneddate,$notes );
1498 my $serialid=$dbh->{'mysql_insertid'};
1500 SELECT missinglist,recievedlist
1501 FROM subscriptionhistory
1502 WHERE subscriptionid=?
1504 $sth = $dbh->prepare($query);
1505 $sth->execute($subscriptionid);
1506 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1508 if ( $status eq 2 ) {
1509 ### TODO Add a feature that improves recognition and description.
1510 ### As such count (serialseq) i.e. : N°18,2(N°19),N°20
1511 ### Would use substr and index But be careful to previous presence of ()
1512 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1514 if ( $status eq 4 ) {
1515 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1518 UPDATE subscriptionhistory
1519 SET recievedlist=?, missinglist=?
1520 WHERE subscriptionid=?
1522 $sth = $dbh->prepare($query);
1523 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1527 =head2 ItemizeSerials
1531 ItemizeSerials($serialid, $info);
1532 $info is a hashref containing barcode branch, itemcallnumber, status, location
1533 $serialid the serialid
1535 1 if the itemize is a succes.
1536 0 and @error else. @error containts the list of errors found.
1542 sub ItemizeSerials {
1543 my ( $serialid, $info ) = @_;
1544 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1546 my $dbh = C4::Context->dbh;
1552 my $sth = $dbh->prepare($query);
1553 $sth->execute($serialid);
1554 my $data = $sth->fetchrow_hashref;
1555 if ( C4::Context->preference("RoutingSerials") ) {
1557 # check for existing biblioitem relating to serial issue
1558 my ( $count, @results ) =
1559 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1561 for ( my $i = 0 ; $i < $count ; $i++ ) {
1562 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1563 . $data->{'planneddate'}
1566 $bibitemno = $results[$i]->{'biblioitemnumber'};
1570 if ( $bibitemno == 0 ) {
1572 # warn "need to add new biblioitem so copy last one and make minor changes";
1575 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1577 $sth->execute( $data->{'biblionumber'} );
1578 my $biblioitem = $sth->fetchrow_hashref;
1579 $biblioitem->{'volumedate'} =
1580 format_date_in_iso( $data->{planneddate} );
1581 $biblioitem->{'volumeddesc'} =
1582 $data->{serialseq} . ' ('
1583 . format_date( $data->{'planneddate'} ) . ')';
1584 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1586 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1587 # so I comment it, we can speak of it when you want
1588 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1589 # if ( $info->{barcode} )
1590 # { # only make biblioitem if we are going to make item also
1591 # $bibitemno = newbiblioitem($biblioitem);
1596 my $fwk = MARCfind_frameworkcode( $data->{'biblionumber'} );
1597 if ( $info->{barcode} ) {
1599 my $exists = itemdata( $info->{'barcode'} );
1600 push @errors, "barcode_not_unique" if ($exists);
1602 my $marcrecord = MARC::Record->new();
1603 my ( $tag, $subfield ) =
1604 MARCfind_marc_from_kohafield( $dbh, "items.barcode", $fwk );
1606 MARC::Field->new( "$tag", '', '',
1607 "$subfield" => $info->{barcode} );
1608 $marcrecord->insert_fields_ordered($newField);
1609 if ( $info->{branch} ) {
1610 my ( $tag, $subfield ) =
1611 MARCfind_marc_from_kohafield( $dbh, "items.homebranch",
1614 #warn "items.homebranch : $tag , $subfield";
1615 if ( $marcrecord->field($tag) ) {
1616 $marcrecord->field($tag)
1617 ->add_subfields( "$subfield" => $info->{branch} );
1621 MARC::Field->new( "$tag", '', '',
1622 "$subfield" => $info->{branch} );
1623 $marcrecord->insert_fields_ordered($newField);
1625 ( $tag, $subfield ) =
1626 MARCfind_marc_from_kohafield( $dbh, "items.holdingbranch",
1629 #warn "items.holdingbranch : $tag , $subfield";
1630 if ( $marcrecord->field($tag) ) {
1631 $marcrecord->field($tag)
1632 ->add_subfields( "$subfield" => $info->{branch} );
1636 MARC::Field->new( "$tag", '', '',
1637 "$subfield" => $info->{branch} );
1638 $marcrecord->insert_fields_ordered($newField);
1641 if ( $info->{itemcallnumber} ) {
1642 my ( $tag, $subfield ) =
1643 MARCfind_marc_from_kohafield( $dbh, "items.itemcallnumber",
1646 #warn "items.itemcallnumber : $tag , $subfield";
1647 if ( $marcrecord->field($tag) ) {
1648 $marcrecord->field($tag)
1649 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1653 MARC::Field->new( "$tag", '', '',
1654 "$subfield" => $info->{itemcallnumber} );
1655 $marcrecord->insert_fields_ordered($newField);
1658 if ( $info->{notes} ) {
1659 my ( $tag, $subfield ) =
1660 MARCfind_marc_from_kohafield( $dbh, "items.itemnotes", $fwk );
1662 # warn "items.itemnotes : $tag , $subfield";
1663 if ( $marcrecord->field($tag) ) {
1664 $marcrecord->field($tag)
1665 ->add_subfields( "$subfield" => $info->{notes} );
1669 MARC::Field->new( "$tag", '', '',
1670 "$subfield" => $info->{notes} );
1671 $marcrecord->insert_fields_ordered($newField);
1674 if ( $info->{location} ) {
1675 my ( $tag, $subfield ) =
1676 MARCfind_marc_from_kohafield( $dbh, "items.location", $fwk );
1678 # warn "items.location : $tag , $subfield";
1679 if ( $marcrecord->field($tag) ) {
1680 $marcrecord->field($tag)
1681 ->add_subfields( "$subfield" => $info->{location} );
1685 MARC::Field->new( "$tag", '', '',
1686 "$subfield" => $info->{location} );
1687 $marcrecord->insert_fields_ordered($newField);
1690 if ( $info->{status} ) {
1691 my ( $tag, $subfield ) =
1692 MARCfind_marc_from_kohafield( $dbh, "items.notforloan",
1695 # warn "items.notforloan : $tag , $subfield";
1696 if ( $marcrecord->field($tag) ) {
1697 $marcrecord->field($tag)
1698 ->add_subfields( "$subfield" => $info->{status} );
1702 MARC::Field->new( "$tag", '', '',
1703 "$subfield" => $info->{status} );
1704 $marcrecord->insert_fields_ordered($newField);
1707 if ( C4::Context->preference("RoutingSerials") ) {
1708 my ( $tag, $subfield ) =
1709 MARCfind_marc_from_kohafield( $dbh, "items.dateaccessioned",
1711 if ( $marcrecord->field($tag) ) {
1712 $marcrecord->field($tag)
1713 ->add_subfields( "$subfield" => $now );
1717 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1718 $marcrecord->insert_fields_ordered($newField);
1721 AddItem( $marcrecord, $data->{'biblionumber'} );
1724 return ( 0, @errors );
1728 =head2 HasSubscriptionExpired
1732 1 or 0 = HasSubscriptionExpired($subscriptionid)
1734 the subscription has expired when the next issue to arrive is out of subscription limit.
1737 1 if true, 0 if false.
1743 sub HasSubscriptionExpired {
1744 my ($subscriptionid) = @_;
1745 my $dbh = C4::Context->dbh;
1746 my $subscription = GetSubscription($subscriptionid);
1747 my $expirationdate = GetExpirationDate($subscriptionid);
1749 SELECT max(planneddate)
1751 WHERE subscriptionid=?
1753 my $sth = $dbh->prepare($query);
1754 $sth->execute($subscriptionid);
1755 my ($res) = $sth->fetchrow ;
1756 my @res=split (/-/,$res);
1757 my @endofsubscriptiondate=split(/-/,$expirationdate);
1758 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1759 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1764 =head2 SetDistributedto
1768 SetDistributedto($distributedto,$subscriptionid);
1769 This function update the value of distributedto for a subscription given on input arg.
1775 sub SetDistributedto {
1776 my ( $distributedto, $subscriptionid ) = @_;
1777 my $dbh = C4::Context->dbh;
1781 WHERE subscriptionid=?
1783 my $sth = $dbh->prepare($query);
1784 $sth->execute( $distributedto, $subscriptionid );
1787 =head2 DelSubscription
1791 DelSubscription($subscriptionid)
1792 this function delete the subscription which has $subscriptionid as id.
1798 sub DelSubscription {
1799 my ($subscriptionid) = @_;
1800 my $dbh = C4::Context->dbh;
1801 $subscriptionid = $dbh->quote($subscriptionid);
1802 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1804 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1805 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1807 &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1808 if C4::Context->preference("SubscriptionLog");
1815 DelIssue($serialseq,$subscriptionid)
1816 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1823 my ( $serialseq, $subscriptionid ) = @_;
1824 my $dbh = C4::Context->dbh;
1828 AND subscriptionid= ?
1830 my $mainsth = $dbh->prepare($query);
1831 $mainsth->execute( $serialseq, $subscriptionid );
1833 #Delete element from subscription history
1834 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1835 my $sth = $dbh->prepare($query);
1836 $sth->execute($subscriptionid);
1837 my $val = $sth->fetchrow_hashref;
1838 unless ( $val->{manualhistory} ) {
1840 SELECT * FROM subscriptionhistory
1841 WHERE subscriptionid= ?
1843 my $sth = $dbh->prepare($query);
1844 $sth->execute($subscriptionid);
1845 my $data = $sth->fetchrow_hashref;
1846 $data->{'missinglist'} =~ s/$serialseq//;
1847 $data->{'recievedlist'} =~ s/$serialseq//;
1848 my $strsth = "UPDATE subscriptionhistory SET "
1850 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1851 . " WHERE subscriptionid=?";
1852 $sth = $dbh->prepare($strsth);
1853 $sth->execute($subscriptionid);
1855 ### TODO Add itemdeletion. Should be in a pref ?
1857 return $mainsth->rows;
1860 =head2 GetLateOrMissingIssues
1864 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1866 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1869 a count of the number of missing issues
1870 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1871 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1877 sub GetLateOrMissingIssues {
1878 my ( $supplierid, $serialid,$order ) = @_;
1879 my $dbh = C4::Context->dbh;
1883 $byserial = "and serialid = " . $serialid;
1891 $sth = $dbh->prepare(
1900 serial.subscriptionid,
1903 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1904 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
1905 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1906 WHERE subscription.subscriptionid = serial.subscriptionid
1907 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1908 AND subscription.aqbooksellerid=$supplierid
1914 $sth = $dbh->prepare(
1923 serial.subscriptionid,
1926 LEFT JOIN subscription
1927 ON serial.subscriptionid=subscription.subscriptionid
1929 ON serial.biblionumber=biblio.biblionumber
1930 LEFT JOIN aqbooksellers
1931 ON subscription.aqbooksellerid = aqbooksellers.id
1933 subscription.subscriptionid = serial.subscriptionid
1934 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1935 AND biblio.biblionumber = subscription.biblionumber
1945 while ( my $line = $sth->fetchrow_hashref ) {
1946 $odd++ unless $line->{title} eq $last_title;
1947 $last_title = $line->{title} if ( $line->{title} );
1948 $line->{planneddate} = format_date( $line->{planneddate} );
1949 $line->{claimdate} = format_date( $line->{claimdate} );
1950 $line->{"status".$line->{status}} = 1;
1951 $line->{'odd'} = 1 if $odd % 2;
1953 push @issuelist, $line;
1955 return $count, @issuelist;
1958 =head2 removeMissingIssue
1962 removeMissingIssue($subscriptionid)
1964 this function removes an issue from being part of the missing string in
1965 subscriptionlist.missinglist column
1967 called when a missing issue is found from the serials-recieve.pl file
1973 sub removeMissingIssue {
1974 my ( $sequence, $subscriptionid ) = @_;
1975 my $dbh = C4::Context->dbh;
1978 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1979 $sth->execute($subscriptionid);
1980 my $data = $sth->fetchrow_hashref;
1981 my $missinglist = $data->{'missinglist'};
1982 my $missinglistbefore = $missinglist;
1984 # warn $missinglist." before";
1985 $missinglist =~ s/($sequence)//;
1987 # warn $missinglist." after";
1988 if ( $missinglist ne $missinglistbefore ) {
1989 $missinglist =~ s/\|\s\|/\|/g;
1990 $missinglist =~ s/^\| //g;
1991 $missinglist =~ s/\|$//g;
1992 my $sth2 = $dbh->prepare(
1993 "UPDATE subscriptionhistory
1995 WHERE subscriptionid = ?"
1997 $sth2->execute( $missinglist, $subscriptionid );
2005 &updateClaim($serialid)
2007 this function updates the time when a claim is issued for late/missing items
2009 called from claims.pl file
2016 my ($serialid) = @_;
2017 my $dbh = C4::Context->dbh;
2018 my $sth = $dbh->prepare(
2019 "UPDATE serial SET claimdate = now()
2023 $sth->execute($serialid);
2026 =head2 getsupplierbyserialid
2030 ($result) = &getsupplierbyserialid($serialid)
2032 this function is used to find the supplier id given a serial id
2035 hashref containing serialid, subscriptionid, and aqbooksellerid
2041 sub getsupplierbyserialid {
2042 my ($serialid) = @_;
2043 my $dbh = C4::Context->dbh;
2044 my $sth = $dbh->prepare(
2045 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2046 FROM serial, subscription
2047 WHERE serial.subscriptionid = subscription.subscriptionid
2051 $sth->execute($serialid);
2052 my $line = $sth->fetchrow_hashref;
2053 my $result = $line->{'aqbooksellerid'};
2057 =head2 check_routing
2061 ($result) = &check_routing($subscriptionid)
2063 this function checks to see if a serial has a routing list and returns the count of routingid
2064 used to show either an 'add' or 'edit' link
2070 my ($subscriptionid) = @_;
2071 my $dbh = C4::Context->dbh;
2072 my $sth = $dbh->prepare(
2073 "SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
2074 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2075 AND subscription.subscriptionid = ? ORDER BY ranking ASC
2078 $sth->execute($subscriptionid);
2079 my $line = $sth->fetchrow_hashref;
2080 my $result = $line->{'routingids'};
2084 =head2 addroutingmember
2088 &addroutingmember($borrowernumber,$subscriptionid)
2090 this function takes a borrowernumber and subscriptionid and add the member to the
2091 routing list for that serial subscription and gives them a rank on the list
2092 of either 1 or highest current rank + 1
2098 sub addroutingmember {
2099 my ( $borrowernumber, $subscriptionid ) = @_;
2101 my $dbh = C4::Context->dbh;
2104 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2106 $sth->execute($subscriptionid);
2107 while ( my $line = $sth->fetchrow_hashref ) {
2108 if ( $line->{'rank'} > 0 ) {
2109 $rank = $line->{'rank'} + 1;
2117 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2119 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2122 =head2 reorder_members
2126 &reorder_members($subscriptionid,$routingid,$rank)
2128 this function is used to reorder the routing list
2130 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2131 - it gets all members on list puts their routingid's into an array
2132 - removes the one in the array that is $routingid
2133 - then reinjects $routingid at point indicated by $rank
2134 - then update the database with the routingids in the new order
2140 sub reorder_members {
2141 my ( $subscriptionid, $routingid, $rank ) = @_;
2142 my $dbh = C4::Context->dbh;
2145 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2147 $sth->execute($subscriptionid);
2149 while ( my $line = $sth->fetchrow_hashref ) {
2150 push( @result, $line->{'routingid'} );
2153 # To find the matching index
2155 my $key = -1; # to allow for 0 being a valid response
2156 for ( $i = 0 ; $i < @result ; $i++ ) {
2157 if ( $routingid == $result[$i] ) {
2158 $key = $i; # save the index
2163 # if index exists in array then move it to new position
2164 if ( $key > -1 && $rank > 0 ) {
2165 my $new_rank = $rank -
2166 1; # $new_rank is what you want the new index to be in the array
2167 my $moving_item = splice( @result, $key, 1 );
2168 splice( @result, $new_rank, 0, $moving_item );
2170 for ( my $j = 0 ; $j < @result ; $j++ ) {
2172 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2174 . "' WHERE routingid = '"
2181 =head2 delroutingmember
2185 &delroutingmember($routingid,$subscriptionid)
2187 this function either deletes one member from routing list if $routingid exists otherwise
2188 deletes all members from the routing list
2194 sub delroutingmember {
2196 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2197 my ( $routingid, $subscriptionid ) = @_;
2198 my $dbh = C4::Context->dbh;
2202 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2203 $sth->execute($routingid);
2204 reorder_members( $subscriptionid, $routingid );
2209 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2210 $sth->execute($subscriptionid);
2214 =head2 getroutinglist
2218 ($count,@routinglist) = &getroutinglist($subscriptionid)
2220 this gets the info from the subscriptionroutinglist for $subscriptionid
2223 a count of the number of members on routinglist
2224 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2225 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2231 sub getroutinglist {
2232 my ($subscriptionid) = @_;
2233 my $dbh = C4::Context->dbh;
2234 my $sth = $dbh->prepare(
2235 "SELECT routingid, borrowernumber,
2236 ranking, biblionumber FROM subscriptionroutinglist, subscription
2237 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2238 AND subscription.subscriptionid = ? ORDER BY ranking ASC
2241 $sth->execute($subscriptionid);
2244 while ( my $line = $sth->fetchrow_hashref ) {
2246 push( @routinglist, $line );
2248 return ( $count, @routinglist );
2251 =head2 abouttoexpire
2255 $result = &abouttoexpire($subscriptionid)
2257 this function alerts you to the penultimate issue for a serial subscription
2259 returns 1 - if this is the penultimate issue
2267 my ($subscriptionid) = @_;
2268 my $dbh = C4::Context->dbh;
2269 my $subscription = GetSubscription($subscriptionid);
2270 my $expirationdate = GetExpirationDate($subscriptionid);
2273 "select max(planneddate) from serial where subscriptionid=?");
2274 $sth->execute($subscriptionid);
2275 my ($res) = $sth->fetchrow ;
2276 # warn "date expiration : ".$expirationdate." date courante ".$res;
2277 my @res=split /-/,$res;
2278 my @endofsubscriptiondate=split/-/,$expirationdate;
2279 my $per = $subscription->{'periodicity'};
2281 if ( $per == 1 ) {$x=7;}
2282 if ( $per == 2 ) {$x=7; }
2283 if ( $per == 3 ) {$x=14;}
2284 if ( $per == 4 ) { $x = 21; }
2285 if ( $per == 5 ) { $x = 31; }
2286 if ( $per == 6 ) { $x = 62; }
2287 if ( $per == 7 || $per == 8 ) { $x = 93; }
2288 if ( $per == 9 ) { $x = 190; }
2289 if ( $per == 10 ) { $x = 365; }
2290 if ( $per == 11 ) { $x = 730; }
2291 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2292 - (3 * $x)) if (@endofsubscriptiondate);
2293 # warn "DATE BEFORE END: $datebeforeend";
2294 return 1 if ( @res &&
2296 Delta_Days($res[0],$res[1],$res[2],
2297 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2298 (@endofsubscriptiondate &&
2299 Delta_Days($res[0],$res[1],$res[2],
2300 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2304 =head2 old_newsubscription
2308 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2309 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2310 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2311 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2312 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2313 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2315 this function is similar to the NewSubscription subroutine but has a few different
2317 $firstacquidate - date of first serial issue to arrive
2318 $irregularity - the issues not expected separated by a '|'
2319 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2320 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2321 subscription-add.tmpl file
2322 $callnumber - display the callnumber of the serial
2323 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2326 the $subscriptionid number of the new subscription
2332 sub old_newsubscription {
2334 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2335 $biblionumber, $startdate, $periodicity, $firstacquidate,
2336 $dow, $irregularity, $numberpattern, $numberlength,
2337 $weeklength, $monthlength, $add1, $every1,
2338 $whenmorethan1, $setto1, $lastvalue1, $add2,
2339 $every2, $whenmorethan2, $setto2, $lastvalue2,
2340 $add3, $every3, $whenmorethan3, $setto3,
2341 $lastvalue3, $numberingmethod, $status, $callnumber,
2344 my $dbh = C4::Context->dbh;
2347 my $sth = $dbh->prepare(
2348 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2349 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2350 add1,every1,whenmorethan1,setto1,lastvalue1,
2351 add2,every2,whenmorethan2,setto2,lastvalue2,
2352 add3,every3,whenmorethan3,setto3,lastvalue3,
2353 numberingmethod, status, callnumber, notes, hemisphere) values
2354 (?,?,?,?,?,?,?,?,?,?,?,
2355 ?,?,?,?,?,?,?,?,?,?,?,
2356 ?,?,?,?,?,?,?,?,?,?,?,?)"
2359 $auser, $aqbooksellerid,
2361 $biblionumber, format_date_in_iso($startdate),
2362 $periodicity, format_date_in_iso($firstacquidate),
2363 $dow, $irregularity,
2364 $numberpattern, $numberlength,
2365 $weeklength, $monthlength,
2367 $whenmorethan1, $setto1,
2369 $every2, $whenmorethan2,
2370 $setto2, $lastvalue2,
2372 $whenmorethan3, $setto3,
2373 $lastvalue3, $numberingmethod,
2374 $status, $callnumber,
2378 #then create the 1st waited number
2379 my $subscriptionid = $dbh->{'mysql_insertid'};
2380 my $enddate = GetExpirationDate($subscriptionid);
2384 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2387 $biblionumber, $subscriptionid,
2388 format_date_in_iso($startdate),
2389 format_date_in_iso($enddate),
2393 # reread subscription to get a hash (for calculation of the 1st issue number)
2395 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2396 $sth->execute($subscriptionid);
2397 my $val = $sth->fetchrow_hashref;
2399 # calculate issue number
2400 my $serialseq = GetSeq($val);
2403 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2405 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2406 1, format_date_in_iso($startdate) );
2407 return $subscriptionid;
2410 =head2 old_modsubscription
2414 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2415 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2416 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2417 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2418 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2419 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2421 this function is similar to the ModSubscription subroutine but has a few different
2423 $firstacquidate - date of first serial issue to arrive
2424 $irregularity - the issues not expected separated by a '|'
2425 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2426 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2427 subscription-add.tmpl file
2428 $callnumber - display the callnumber of the serial
2429 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2435 sub old_modsubscription {
2437 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2438 $startdate, $periodicity, $firstacquidate, $dow,
2439 $irregularity, $numberpattern, $numberlength, $weeklength,
2440 $monthlength, $add1, $every1, $whenmorethan1,
2441 $setto1, $lastvalue1, $innerloop1, $add2,
2442 $every2, $whenmorethan2, $setto2, $lastvalue2,
2443 $innerloop2, $add3, $every3, $whenmorethan3,
2444 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2445 $status, $biblionumber, $callnumber, $notes,
2446 $hemisphere, $subscriptionid
2448 my $dbh = C4::Context->dbh;
2449 my $sth = $dbh->prepare(
2450 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2451 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2452 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2453 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2454 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2455 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2458 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2459 $startdate, $periodicity, $firstacquidate, $dow,
2460 $irregularity, $numberpattern, $numberlength, $weeklength,
2461 $monthlength, $add1, $every1, $whenmorethan1,
2462 $setto1, $lastvalue1, $innerloop1, $add2,
2463 $every2, $whenmorethan2, $setto2, $lastvalue2,
2464 $innerloop2, $add3, $every3, $whenmorethan3,
2465 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2466 $status, $biblionumber, $callnumber, $notes,
2467 $hemisphere, $subscriptionid
2472 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2473 $sth->execute($subscriptionid);
2474 my $val = $sth->fetchrow_hashref;
2476 # calculate issue number
2477 my $serialseq = Get_Seq($val);
2479 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2480 $sth->execute( $serialseq, $subscriptionid );
2482 my $enddate = subscriptionexpirationdate($subscriptionid);
2483 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2484 $sth->execute( format_date_in_iso($enddate) );
2487 =head2 old_getserials
2491 ($totalissues,@serials) = &old_getserials($subscriptionid)
2493 this function get a hashref of serials and the total count of them
2496 $totalissues - number of serial lines
2497 the serials into a table. Each line of this table containts a ref to a hash which it containts
2498 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2504 sub old_getserials {
2505 my ($subscriptionid) = @_;
2506 my $dbh = C4::Context->dbh;
2508 # status = 2 is "arrived"
2511 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2513 $sth->execute($subscriptionid);
2516 while ( my $line = $sth->fetchrow_hashref ) {
2517 $line->{ "status" . $line->{status} } =
2518 1; # fills a "statusX" value, used for template status select list
2519 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2520 $line->{"num"} = $num;
2522 push @serials, $line;
2524 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2525 $sth->execute($subscriptionid);
2526 my ($totalissues) = $sth->fetchrow;
2527 return ( $totalissues, @serials );
2532 ($resultdate) = &GetNextDate($planneddate,$subscription)
2534 this function is an extension of GetNextDate which allows for checking for irregularity
2536 it takes the planneddate and will return the next issue's date and will skip dates if there
2537 exists an irregularity
2538 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2539 skipped then the returned date will be 2007-05-10
2542 $resultdate - then next date in the sequence
2544 FIXME : have to replace Date::Manip by Date::Calc in this function to improve performances.
2547 sub in_array { # used in next sub down
2548 my ($val,@elements) = @_;
2549 foreach my $elem(@elements) {
2557 sub GetNextDate(@) {
2558 my ( $planneddate, $subscription ) = @_;
2559 my @irreg = split( /\,/, $subscription->{irregularity} );
2561 #date supposed to be in ISO.
2563 my ( $year, $month, $day ) = split(/-/, $planneddate);
2564 $month=1 unless ($month);
2565 $day=1 unless ($day);
2568 # warn "DOW $dayofweek";
2569 if ( $subscription->{periodicity} == 1 ) {
2570 my $dayofweek = Day_of_Week( $year,$month, $day );
2571 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2572 $dayofweek = 0 if ( $dayofweek == 7 );
2573 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2574 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2578 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2580 if ( $subscription->{periodicity} == 2 ) {
2581 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2582 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2583 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2584 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2585 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2588 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2590 if ( $subscription->{periodicity} == 3 ) {
2591 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2592 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2593 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2594 ### BUGFIX was previously +1 ^
2595 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2596 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2599 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2601 if ( $subscription->{periodicity} == 4 ) {
2602 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2603 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2604 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2605 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2606 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2609 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2611 my $tmpmonth=$month;
2612 if ( $subscription->{periodicity} == 5 ) {
2613 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2614 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2615 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2616 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2619 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2621 if ( $subscription->{periodicity} == 6 ) {
2622 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2623 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2624 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2625 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2628 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2630 if ( $subscription->{periodicity} == 7 ) {
2631 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2632 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2633 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2634 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2637 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2639 if ( $subscription->{periodicity} == 8 ) {
2640 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2641 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2642 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2643 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2646 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2648 if ( $subscription->{periodicity} == 9 ) {
2649 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2650 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2651 ### BUFIX Seems to need more Than One ?
2652 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2653 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2656 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2658 if ( $subscription->{periodicity} == 10 ) {
2659 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2661 if ( $subscription->{periodicity} == 11 ) {
2662 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2664 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2665 # warn "dateNEXTSEQ : ".$resultdate;
2666 return "$resultdate";
2671 $item = &itemdata($barcode);
2673 Looks up the item with the given barcode, and returns a
2674 reference-to-hash containing information about that item. The keys of
2675 the hash are the fields from the C<items> and C<biblioitems> tables in
2683 my $dbh = C4::Context->dbh;
2684 my $sth = $dbh->prepare(
2685 "Select * from items,biblioitems where barcode=?
2686 and items.biblioitemnumber=biblioitems.biblioitemnumber"
2688 $sth->execute($barcode);
2689 my $data = $sth->fetchrow_hashref;
2694 END { } # module clean-up code here (global destructor)
2702 Koha Developement team <info@koha.org>