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
102 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
103 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
104 WHERE subscription.subscriptionid = serial.subscriptionid
105 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
108 my $sth = $dbh->prepare($query);
111 while ( my ( $id, $name ) = $sth->fetchrow ) {
112 $supplierlist{$id} = $name;
114 if ( C4::Context->preference("RoutingSerials") ) {
115 $supplierlist{''} = "All Suppliers";
117 return %supplierlist;
124 @issuelist = &GetLateIssues($supplierid)
126 this function select late issues on database
129 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
130 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
137 my ($supplierid) = @_;
138 my $dbh = C4::Context->dbh;
142 SELECT name,title,planneddate,serialseq,serial.subscriptionid
143 FROM subscription, serial, biblio
144 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
145 WHERE subscription.subscriptionid = serial.subscriptionid
146 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
147 AND subscription.aqbooksellerid=$supplierid
148 AND biblio.biblionumber = subscription.biblionumber
151 $sth = $dbh->prepare($query);
155 SELECT name,title,planneddate,serialseq,serial.subscriptionid
156 FROM subscription, serial, biblio
157 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
158 WHERE subscription.subscriptionid = serial.subscriptionid
159 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
160 AND biblio.biblionumber = subscription.biblionumber
163 $sth = $dbh->prepare($query);
170 while ( my $line = $sth->fetchrow_hashref ) {
171 $odd++ unless $line->{title} eq $last_title;
172 $line->{title} = "" if $line->{title} eq $last_title;
173 $last_title = $line->{title} if ( $line->{title} );
174 $line->{planneddate} = format_date( $line->{planneddate} );
176 push @issuelist, $line;
178 return $count, @issuelist;
181 =head2 GetSubscriptionHistoryFromSubscriptionId
185 $sth = GetSubscriptionHistoryFromSubscriptionId()
186 this function just prepare the SQL request.
187 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
189 $sth = $dbh->prepare($query).
195 sub GetSubscriptionHistoryFromSubscriptionId() {
196 my $dbh = C4::Context->dbh;
199 FROM subscriptionhistory
200 WHERE subscriptionid = ?
202 return $dbh->prepare($query);
205 =head2 GetSerialStatusFromSerialId
209 $sth = GetSerialStatusFromSerialId();
210 this function just prepare the SQL request.
211 After this function, don't forget to execute it by using $sth->execute($serialid)
213 $sth = $dbh->prepare($query).
219 sub GetSerialStatusFromSerialId() {
220 my $dbh = C4::Context->dbh;
226 return $dbh->prepare($query);
229 =head2 GetSerialInformation
233 $data = GetSerialInformation($serialid);
234 returns a hash containing :
235 items : items marcrecord (can be an array)
237 subscription table field
238 + information about subscription expiration
244 sub GetSerialInformation {
246 my $dbh = C4::Context->dbh;
248 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
249 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
252 my $rq = $dbh->prepare($query);
253 $rq->execute($serialid);
254 my $data = $rq->fetchrow_hashref;
256 if ( C4::Context->preference("serialsadditems") ) {
257 if ( $data->{'itemnumber'} ) {
258 my @itemnumbers = split /,/, $data->{'itemnumber'};
259 foreach my $itemnum (@itemnumbers) {
261 #It is ASSUMED that GetMarcItem ALWAYS WORK...
262 #Maybe GetMarcItem should return values on failure
263 # warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
265 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
266 $itemprocessed->{'itemnumber'} = $itemnum;
267 $itemprocessed->{'itemid'} = $itemnum;
268 $itemprocessed->{'serialid'} = $serialid;
269 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
270 push @{ $data->{'items'} }, $itemprocessed;
275 PrepareItemrecordDisplay( $data->{'biblionumber'} );
276 $itemprocessed->{'itemid'} = "N$serialid";
277 $itemprocessed->{'serialid'} = $serialid;
278 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
279 $itemprocessed->{'countitems'} = 0;
280 push @{ $data->{'items'} }, $itemprocessed;
283 $data->{ "status" . $data->{'serstatus'} } = 1;
284 $data->{'subscriptionexpired'} =
285 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
286 $data->{'abouttoexpire'} =
287 abouttoexpire( $data->{'subscriptionid'} );
291 =head2 GetSerialInformation
295 $data = AddItem2Serial($serialid,$itemnumber);
296 Adds an itemnumber to Serial record
302 my ( $serialid, $itemnumber ) = @_;
303 my $dbh = C4::Context->dbh;
305 UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber))
308 my $rq = $dbh->prepare($query);
309 $rq->execute($serialid);
313 =head2 UpdateClaimdateIssues
317 UpdateClaimdateIssues($serialids,[$date]);
319 Update Claimdate for issues in @$serialids list with date $date
325 sub UpdateClaimdateIssues {
326 my ( $serialids, $date ) = @_;
327 my $dbh = C4::Context->dbh;
328 $date = strftime("%Y-%m-%d",localtime) unless ($date);
330 UPDATE serial SET claimdate=$date,status=7
331 WHERE serialid in ".join (",",@$serialids);
333 my $rq = $dbh->prepare($query);
338 =head2 GetSubscription
342 $subs = GetSubscription($subscriptionid)
343 this function get the subscription which has $subscriptionid as id.
345 a hashref. This hash containts
346 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
352 sub GetSubscription {
353 my ($subscriptionid) = @_;
354 my $dbh = C4::Context->dbh;
356 SELECT subscription.*,
357 subscriptionhistory.*,
359 aqbooksellers.name AS aqbooksellername,
360 biblio.title AS bibliotitle,
361 subscription.biblionumber as bibnum
363 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
364 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
365 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
366 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
367 WHERE subscription.subscriptionid = ?
369 if (C4::Context->preference('IndependantBranches') &&
370 C4::Context->userenv &&
371 C4::Context->userenv->{'flags'} != 1){
372 # warn "flags: ".C4::Context->userenv->{'flags'};
373 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
375 # warn "query : $query";
376 my $sth = $dbh->prepare($query);
377 # warn "subsid :$subscriptionid";
378 $sth->execute($subscriptionid);
379 my $subs = $sth->fetchrow_hashref;
383 =head2 GetFullSubscription
387 \@res = GetFullSubscription($subscriptionid)
388 this function read on serial table.
394 sub GetFullSubscription {
395 my ($subscriptionid) = @_;
396 my $dbh = C4::Context->dbh;
398 SELECT serial.serialid,
401 serial.publisheddate,
403 serial.notes as notes,
404 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
405 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
406 biblio.title as bibliotitle,
407 subscription.branchcode AS branchcode,
408 subscription.subscriptionid AS subscriptionid
410 LEFT JOIN subscription ON
411 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
412 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
413 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
414 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
415 WHERE serial.subscriptionid = ? |;
416 if (C4::Context->preference('IndependantBranches') &&
417 C4::Context->userenv &&
418 C4::Context->userenv->{'flags'} != 1){
420 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
424 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
425 serial.subscriptionid
427 my $sth = $dbh->prepare($query);
428 $sth->execute($subscriptionid);
429 my $subs = $sth->fetchall_arrayref({});
434 =head2 PrepareSerialsData
438 \@res = PrepareSerialsData($serialinfomation)
439 where serialinformation is a hashref array
445 sub PrepareSerialsData{
451 my $aqbooksellername;
455 my $previousnote = "";
457 foreach my $subs ( @$lines ) {
458 $subs->{'publisheddate'} =
459 ( $subs->{'publisheddate'}
460 ? format_date( $subs->{'publisheddate'} )
462 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
463 $subs->{ "status" . $subs->{'status'} } = 1;
465 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
466 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
467 $year = $subs->{'year'};
472 if ( $tmpresults{$year} ) {
473 push @{ $tmpresults{$year}->{'serials'} }, $subs;
476 $tmpresults{$year} = {
479 # 'startdate'=>format_date($subs->{'startdate'}),
480 'aqbooksellername' => $subs->{'aqbooksellername'},
481 'bibliotitle' => $subs->{'bibliotitle'},
482 'serials' => [$subs],
484 'branchcode' => $subs->{'branchcode'},
485 'subscriptionid' => $subs->{'subscriptionid'},
489 # $previousnote=$subs->{notes};
491 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
492 push @res, $tmpresults{$key};
494 $res[0]->{'first'}=1;
498 =head2 GetSubscriptionsFromBiblionumber
500 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
501 this function get the subscription list. it reads on subscription table.
503 table of subscription which has the biblionumber given on input arg.
504 each line of this table is a hashref. All hashes containt
505 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
509 sub GetSubscriptionsFromBiblionumber {
510 my ($biblionumber) = @_;
511 my $dbh = C4::Context->dbh;
513 SELECT subscription.*,
515 subscriptionhistory.*,
517 aqbooksellers.name AS aqbooksellername,
518 biblio.title AS bibliotitle
520 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
521 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
522 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
523 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
524 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
525 WHERE subscription.biblionumber = ?
527 if (C4::Context->preference('IndependantBranches') &&
528 C4::Context->userenv &&
529 C4::Context->userenv->{'flags'} != 1){
530 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
532 my $sth = $dbh->prepare($query);
533 $sth->execute($biblionumber);
535 while ( my $subs = $sth->fetchrow_hashref ) {
536 $subs->{startdate} = format_date( $subs->{startdate} );
537 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
538 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
539 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
540 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
541 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
542 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
543 $subs->{ "status" . $subs->{'status'} } = 1;
544 if ( $subs->{enddate} eq '0000-00-00' ) {
545 $subs->{enddate} = '';
548 $subs->{enddate} = format_date( $subs->{enddate} );
550 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
551 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
557 =head2 GetFullSubscriptionsFromBiblionumber
561 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
562 this function read on serial table.
568 sub GetFullSubscriptionsFromBiblionumber {
569 my ($biblionumber) = @_;
570 my $dbh = C4::Context->dbh;
572 SELECT serial.serialid,
575 serial.publisheddate,
577 serial.notes as notes,
578 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
579 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
580 biblio.title as bibliotitle,
581 subscription.branchcode AS branchcode,
582 subscription.subscriptionid AS subscriptionid
584 LEFT JOIN subscription ON
585 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
586 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
587 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
588 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
589 WHERE subscription.biblionumber = ? |;
590 if (C4::Context->preference('IndependantBranches') &&
591 C4::Context->userenv &&
592 C4::Context->userenv->{'flags'} != 1){
594 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
598 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
599 serial.subscriptionid
601 my $sth = $dbh->prepare($query);
602 $sth->execute($biblionumber);
603 my $subs= $sth->fetchall_arrayref({});
607 =head2 GetSubscriptions
611 @results = GetSubscriptions($title,$ISSN,$biblionumber);
612 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
614 a table of hashref. Each hash containt the subscription.
620 sub GetSubscriptions {
621 my ( $title, $ISSN, $biblionumber ) = @_;
622 #return unless $title or $ISSN or $biblionumber;
623 my $dbh = C4::Context->dbh;
627 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
629 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
630 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
631 WHERE biblio.biblionumber=?
633 if (C4::Context->preference('IndependantBranches') &&
634 C4::Context->userenv &&
635 C4::Context->userenv->{'flags'} != 1){
636 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
638 $query.=" ORDER BY title";
639 # warn "query :$query";
640 $sth = $dbh->prepare($query);
641 $sth->execute($biblionumber);
644 if ( $ISSN and $title ) {
646 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
648 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
649 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
650 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
652 if (C4::Context->preference('IndependantBranches') &&
653 C4::Context->userenv &&
654 C4::Context->userenv->{'flags'} != 1){
655 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
657 $query.=" ORDER BY title";
658 $sth = $dbh->prepare($query);
659 $sth->execute( $ISSN );
664 SELECT subscription.*,biblio.title,biblioitems.issn,,biblio.biblionumber
666 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
667 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
668 WHERE biblioitems.issn LIKE ?
670 if (C4::Context->preference('IndependantBranches') &&
671 C4::Context->userenv &&
672 C4::Context->userenv->{'flags'} != 1){
673 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
675 $query.=" ORDER BY title";
676 # warn "query :$query";
677 $sth = $dbh->prepare($query);
678 $sth->execute( "%" . $ISSN . "%" );
682 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
684 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
685 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
687 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
690 if (C4::Context->preference('IndependantBranches') &&
691 C4::Context->userenv &&
692 C4::Context->userenv->{'flags'} != 1){
693 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
695 $query.=" ORDER BY title";
696 $sth = $dbh->prepare($query);
702 my $previoustitle = "";
704 while ( my $line = $sth->fetchrow_hashref ) {
705 if ( $previoustitle eq $line->{title} ) {
708 $line->{toggle} = 1 if $odd == 1;
711 $previoustitle = $line->{title};
713 $line->{toggle} = 1 if $odd == 1;
715 push @results, $line;
724 ($totalissues,@serials) = GetSerials($subscriptionid);
725 this function get every serial not arrived for a given subscription
726 as well as the number of issues registered in the database (all types)
727 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
734 my ($subscriptionid,$count) = @_;
735 my $dbh = C4::Context->dbh;
737 # status = 2 is "arrived"
739 $count=5 unless ($count);
742 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes
744 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
745 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
746 my $sth = $dbh->prepare($query);
747 $sth->execute($subscriptionid);
748 while ( my $line = $sth->fetchrow_hashref ) {
749 $line->{ "status" . $line->{status} } =
750 1; # fills a "statusX" value, used for template status select list
751 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
752 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
753 push @serials, $line;
755 # OK, now add the last 5 issues arrives/missing
757 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes
759 WHERE subscriptionid = ?
760 AND (status in (2,4,5))
761 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
763 $sth = $dbh->prepare($query);
764 $sth->execute($subscriptionid);
765 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
767 $line->{ "status" . $line->{status} } =
768 1; # fills a "statusX" value, used for template status select list
769 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
770 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
771 push @serials, $line;
774 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
775 $sth = $dbh->prepare($query);
776 $sth->execute($subscriptionid);
777 my ($totalissues) = $sth->fetchrow;
778 return ( $totalissues, @serials );
785 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
786 this function get every serial waited for a given subscription
787 as well as the number of issues registered in the database (all types)
788 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
794 my ($subscription,$status) = @_;
795 my $dbh = C4::Context->dbh;
797 SELECT serialid,serialseq, status, planneddate, publisheddate,notes
799 WHERE subscriptionid=$subscription AND status IN ($status)
800 ORDER BY publisheddate,serialid DESC
803 my $sth=$dbh->prepare($query);
806 while(my $line = $sth->fetchrow_hashref) {
807 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
808 $line->{"planneddate"} = format_date($line->{"planneddate"});
809 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
812 my ($totalissues) = scalar(@serials);
813 return ($totalissues,@serials);
816 =head2 GetLatestSerials
820 \@serials = GetLatestSerials($subscriptionid,$limit)
821 get the $limit's latest serials arrived or missing for a given subscription
823 a ref to a table which it containts all of the latest serials stored into a hash.
829 sub GetLatestSerials {
830 my ( $subscriptionid, $limit ) = @_;
831 my $dbh = C4::Context->dbh;
833 # status = 2 is "arrived"
834 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
836 WHERE subscriptionid = ?
837 AND (status =2 or status=4)
838 ORDER BY planneddate DESC LIMIT 0,$limit
840 my $sth = $dbh->prepare($strsth);
841 $sth->execute($subscriptionid);
843 while ( my $line = $sth->fetchrow_hashref ) {
844 $line->{ "status" . $line->{status} } =
845 1; # fills a "statusX" value, used for template status select list
846 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
847 push @serials, $line;
853 # WHERE subscriptionid=?
855 # $sth=$dbh->prepare($query);
856 # $sth->execute($subscriptionid);
857 # my ($totalissues) = $sth->fetchrow;
861 =head2 GetDistributedTo
865 $distributedto=GetDistributedTo($subscriptionid)
866 This function select the old previous value of distributedto in the database.
872 sub GetDistributedTo {
873 my $dbh = C4::Context->dbh;
875 my $subscriptionid = @_;
876 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
877 my $sth = $dbh->prepare($query);
878 $sth->execute($subscriptionid);
879 return ($distributedto) = $sth->fetchrow;
887 $val is a hashref containing all the attributes of the table 'subscription'
888 This function get the next issue for the subscription given on input arg
890 all the input params updated.
898 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
899 # $calculated = $val->{numberingmethod};
900 # # calculate the (expected) value of the next issue recieved.
901 # $newlastvalue1 = $val->{lastvalue1};
902 # # check if we have to increase the new value.
903 # $newinnerloop1 = $val->{innerloop1}+1;
904 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
905 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
906 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
907 # $calculated =~ s/\{X\}/$newlastvalue1/g;
909 # $newlastvalue2 = $val->{lastvalue2};
910 # # check if we have to increase the new value.
911 # $newinnerloop2 = $val->{innerloop2}+1;
912 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
913 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
914 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
915 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
917 # $newlastvalue3 = $val->{lastvalue3};
918 # # check if we have to increase the new value.
919 # $newinnerloop3 = $val->{innerloop3}+1;
920 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
921 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
922 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
923 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
924 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
930 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
931 $newinnerloop1, $newinnerloop2, $newinnerloop3
933 my $pattern = $val->{numberpattern};
934 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
935 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
936 $calculated = $val->{numberingmethod};
937 $newlastvalue1 = $val->{lastvalue1};
938 $newlastvalue2 = $val->{lastvalue2};
939 $newlastvalue3 = $val->{lastvalue3};
941 $newlastvalue1 = $val->{lastvalue1};
942 # check if we have to increase the new value.
943 $newinnerloop1 = $val->{innerloop1}+1;
944 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
945 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
946 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
947 $calculated =~ s/\{X\}/$newlastvalue1/g;
949 $newlastvalue2 = $val->{lastvalue2};
950 # check if we have to increase the new value.
951 $newinnerloop2 = $val->{innerloop2}+1;
952 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
953 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
954 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
955 if ( $pattern == 6 ) {
956 if ( $val->{hemisphere} == 2 ) {
957 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
958 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
961 my $newlastvalue2seq = $seasons[$newlastvalue2];
962 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
966 $calculated =~ s/\{Y\}/$newlastvalue2/g;
970 $newlastvalue3 = $val->{lastvalue3};
971 # check if we have to increase the new value.
972 $newinnerloop3 = $val->{innerloop3}+1;
973 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
974 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
975 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
976 $calculated =~ s/\{Z\}/$newlastvalue3/g;
978 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
979 $newinnerloop1, $newinnerloop2, $newinnerloop3);
986 $calculated = GetSeq($val)
987 $val is a hashref containing all the attributes of the table 'subscription'
988 this function transforms {X},{Y},{Z} to 150,0,0 for example.
990 the sequence in integer format
998 my $pattern = $val->{numberpattern};
999 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
1000 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
1001 my $calculated = $val->{numberingmethod};
1002 my $x = $val->{'lastvalue1'};
1003 $calculated =~ s/\{X\}/$x/g;
1004 my $newlastvalue2 = $val->{'lastvalue2'};
1005 if ( $pattern == 6 ) {
1006 if ( $val->{hemisphere} == 2 ) {
1007 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1008 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1011 my $newlastvalue2seq = $seasons[$newlastvalue2];
1012 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1016 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1018 my $z = $val->{'lastvalue3'};
1019 $calculated =~ s/\{Z\}/$z/g;
1023 =head2 GetExpirationDate
1025 $sensddate = GetExpirationDate($subscriptionid)
1027 this function return the expiration date for a subscription given on input args.
1034 sub GetExpirationDate {
1035 my ($subscriptionid) = @_;
1036 my $dbh = C4::Context->dbh;
1037 my $subscription = GetSubscription($subscriptionid);
1038 my $enddate = $subscription->{startdate};
1040 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1041 # warn "SUBSCRIPTIONID :$subscriptionid";
1042 # use Data::Dumper; warn Dumper($subscription);
1044 # warn "dateCHECKRESERV :".$subscription->{startdate};
1045 if ($subscription->{periodicity}){
1046 if ( $subscription->{numberlength} ) {
1047 #calculate the date of the last issue.
1048 my $length = $subscription->{numberlength};
1049 # warn "ENDDATE ".$enddate;
1050 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1051 $enddate = GetNextDate( $enddate, $subscription );
1052 # warn "AFTER ENDDATE ".$enddate;
1055 elsif ( $subscription->{monthlength} ){
1056 my @date=split (/-/,$subscription->{startdate});
1057 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1058 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1059 } elsif ( $subscription->{weeklength} ){
1060 my @date=split (/-/,$subscription->{startdate});
1061 # warn "dateCHECKRESERV :".$subscription->{startdate};
1062 #### An other way to do it
1063 # if ( $subscription->{weeklength} ){
1064 # my ($weeknb,$year)=Week_of_Year(@startdate);
1065 # $weeknb += $subscription->{weeklength};
1066 # my $weeknbcalc= $weeknb % 52;
1067 # $year += int($weeknb/52);
1068 # # warn "year : $year weeknb :$weeknb weeknbcalc $weeknbcalc";
1069 # @endofsubscriptiondate=Monday_of_Week($weeknbcalc,$year);
1071 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1072 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1074 # warn "date de fin :$enddate";
1081 =head2 CountSubscriptionFromBiblionumber
1085 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1086 this count the number of subscription for a biblionumber given.
1088 the number of subscriptions with biblionumber given on input arg.
1094 sub CountSubscriptionFromBiblionumber {
1095 my ($biblionumber) = @_;
1096 my $dbh = C4::Context->dbh;
1097 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1098 my $sth = $dbh->prepare($query);
1099 $sth->execute($biblionumber);
1100 my $subscriptionsnumber = $sth->fetchrow;
1101 return $subscriptionsnumber;
1104 =head2 ModSubscriptionHistory
1108 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1110 this function modify the history of a subscription. Put your new values on input arg.
1116 sub ModSubscriptionHistory {
1118 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1119 $missinglist, $opacnote, $librariannote
1121 my $dbh = C4::Context->dbh;
1122 my $query = "UPDATE subscriptionhistory
1123 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1124 WHERE subscriptionid=?
1126 my $sth = $dbh->prepare($query);
1127 $recievedlist =~ s/^,//g;
1128 $missinglist =~ s/^,//g;
1129 $opacnote =~ s/^,//g;
1131 $histstartdate, $enddate, $recievedlist, $missinglist,
1132 $opacnote, $librariannote, $subscriptionid
1137 =head2 ModSerialStatus
1141 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1143 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1144 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1150 sub ModSerialStatus {
1151 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1154 #It is a usual serial
1155 # 1st, get previous status :
1156 my $dbh = C4::Context->dbh;
1157 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1158 my $sth = $dbh->prepare($query);
1159 $sth->execute($serialid);
1160 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1162 # change status & update subscriptionhistory
1164 if ( $status eq 6 ) {
1165 DelIssue( $serialseq, $subscriptionid );
1169 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1170 $sth = $dbh->prepare($query);
1171 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1172 $notes, $serialid );
1173 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1174 $sth = $dbh->prepare($query);
1175 $sth->execute($subscriptionid);
1176 my $val = $sth->fetchrow_hashref;
1177 unless ( $val->{manualhistory} ) {
1179 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1180 $sth = $dbh->prepare($query);
1181 $sth->execute($subscriptionid);
1182 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1183 if ( $status eq 2 ) {
1185 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1186 $recievedlist .= ",$serialseq"
1187 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1190 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1191 $missinglist .= ",$serialseq"
1193 and not index( "$missinglist", "$serialseq" ) >= 0 );
1194 $missinglist .= ",not issued $serialseq"
1196 and index( "$missinglist", "$serialseq" ) >= 0 );
1198 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1199 $sth = $dbh->prepare($query);
1200 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1204 # create new waited entry if needed (ie : was a "waited" and has changed)
1205 if ( $oldstatus eq 1 && $status ne 1 ) {
1206 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1207 $sth = $dbh->prepare($query);
1208 $sth->execute($subscriptionid);
1209 my $val = $sth->fetchrow_hashref;
1214 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1215 $newinnerloop1, $newinnerloop2, $newinnerloop3
1216 ) = GetNextSeq($val);
1217 # warn "Next Seq End";
1219 # next date (calculated from actual date & frequency parameters)
1220 # warn "publisheddate :$publisheddate ";
1221 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1222 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1223 1, $nextpublisheddate, $nextpublisheddate );
1225 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1226 WHERE subscriptionid = ?";
1227 $sth = $dbh->prepare($query);
1229 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1230 $newinnerloop2, $newinnerloop3, $subscriptionid
1233 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1234 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1235 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1240 =head2 ModSubscription
1244 this function modify a subscription. Put all new values on input args.
1250 sub ModSubscription {
1252 $auser, $branchcode, $aqbooksellerid, $cost,
1253 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1254 $dow, $irregularity, $numberpattern, $numberlength,
1255 $weeklength, $monthlength, $add1, $every1,
1256 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1257 $add2, $every2, $whenmorethan2, $setto2,
1258 $lastvalue2, $innerloop2, $add3, $every3,
1259 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1260 $numberingmethod, $status, $biblionumber, $callnumber,
1261 $notes, $letter, $hemisphere, $manualhistory,
1265 # warn $irregularity;
1266 my $dbh = C4::Context->dbh;
1267 my $query = "UPDATE subscription
1268 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1269 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1270 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1271 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1272 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1273 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1274 WHERE subscriptionid = ?";
1275 # warn "query :".$query;
1276 my $sth = $dbh->prepare($query);
1278 $auser, $branchcode, $aqbooksellerid, $cost,
1279 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1280 $dow, "$irregularity", $numberpattern, $numberlength,
1281 $weeklength, $monthlength, $add1, $every1,
1282 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1283 $add2, $every2, $whenmorethan2, $setto2,
1284 $lastvalue2, $innerloop2, $add3, $every3,
1285 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1286 $numberingmethod, $status, $biblionumber, $callnumber,
1287 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1291 my $rows=$sth->rows;
1294 &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1295 if C4::Context->preference("SubscriptionLog");
1299 =head2 NewSubscription
1303 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1304 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1305 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1306 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1307 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1308 $numberingmethod, $status, $notes)
1310 Create a new subscription with value given on input args.
1313 the id of this new subscription
1319 sub NewSubscription {
1321 $auser, $branchcode, $aqbooksellerid, $cost,
1322 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1323 $dow, $numberlength, $weeklength, $monthlength,
1324 $add1, $every1, $whenmorethan1, $setto1,
1325 $lastvalue1, $innerloop1, $add2, $every2,
1326 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1327 $add3, $every3, $whenmorethan3, $setto3,
1328 $lastvalue3, $innerloop3, $numberingmethod, $status,
1329 $notes, $letter, $firstacquidate, $irregularity,
1330 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1333 my $dbh = C4::Context->dbh;
1335 #save subscription (insert into database)
1337 INSERT INTO subscription
1338 (librarian,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, letter,firstacquidate,irregularity,
1344 numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1345 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1347 my $sth = $dbh->prepare($query);
1349 $auser, $branchcode,
1350 $aqbooksellerid, $cost,
1351 $aqbudgetid, $biblionumber,
1352 format_date_in_iso($startdate), $periodicity,
1353 $dow, $numberlength,
1354 $weeklength, $monthlength,
1356 $whenmorethan1, $setto1,
1357 $lastvalue1, $innerloop1,
1359 $whenmorethan2, $setto2,
1360 $lastvalue2, $innerloop2,
1362 $whenmorethan3, $setto3,
1363 $lastvalue3, $innerloop3,
1364 $numberingmethod, "$status",
1366 $firstacquidate, $irregularity,
1367 $numberpattern, $callnumber,
1368 $hemisphere, $manualhistory,
1372 #then create the 1st waited number
1373 my $subscriptionid = $dbh->{'mysql_insertid'};
1375 INSERT INTO subscriptionhistory
1376 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1377 VALUES (?,?,?,?,?,?,?,?)
1379 $sth = $dbh->prepare($query);
1380 $sth->execute( $biblionumber, $subscriptionid,
1381 format_date_in_iso($startdate),
1382 0, "", "", "", "$notes" );
1384 # reread subscription to get a hash (for calculation of the 1st issue number)
1388 WHERE subscriptionid = ?
1390 $sth = $dbh->prepare($query);
1391 $sth->execute($subscriptionid);
1392 my $val = $sth->fetchrow_hashref;
1394 # calculate issue number
1395 my $serialseq = GetSeq($val);
1398 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1399 VALUES (?,?,?,?,?,?)
1401 $sth = $dbh->prepare($query);
1403 "$serialseq", $subscriptionid, $biblionumber, 1,
1404 format_date_in_iso($startdate),
1405 format_date_in_iso($startdate)
1408 &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1409 if C4::Context->preference("SubscriptionLog");
1411 return $subscriptionid;
1414 =head2 ReNewSubscription
1418 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1420 this function renew a subscription with values given on input args.
1426 sub ReNewSubscription {
1427 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1428 $monthlength, $note )
1430 my $dbh = C4::Context->dbh;
1431 my $subscription = GetSubscription($subscriptionid);
1434 FROM biblio,biblioitems
1435 WHERE biblio.biblionumber=biblioitems.biblionumber
1436 AND biblio.biblionumber=?
1438 my $sth = $dbh->prepare($query);
1439 $sth->execute( $subscription->{biblionumber} );
1440 my $biblio = $sth->fetchrow_hashref;
1442 $user, $subscription->{bibliotitle},
1443 $biblio->{author}, $biblio->{publishercode},
1444 $biblio->{note}, '',
1447 $subscription->{biblionumber}
1450 # renew subscription
1453 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1454 WHERE subscriptionid=?
1456 my $sth = $dbh->prepare($query);
1457 $sth->execute( format_date_in_iso($startdate),
1458 $numberlength, $weeklength, $monthlength, $subscriptionid );
1460 &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1461 if C4::Context->preference("SubscriptionLog");
1468 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1470 Create a new issue stored on the database.
1471 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1478 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1479 $planneddate, $publisheddate, $notes )
1481 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1483 my $dbh = C4::Context->dbh;
1486 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1487 VALUES (?,?,?,?,?,?,?)
1489 my $sth = $dbh->prepare($query);
1490 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1491 $publisheddate, $planneddate,$notes );
1492 my $serialid=$dbh->{'mysql_insertid'};
1494 SELECT missinglist,recievedlist
1495 FROM subscriptionhistory
1496 WHERE subscriptionid=?
1498 $sth = $dbh->prepare($query);
1499 $sth->execute($subscriptionid);
1500 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1502 if ( $status eq 2 ) {
1503 ### TODO Add a feature that improves recognition and description.
1504 ### As such count (serialseq) i.e. : N18,2(N19),N20
1505 ### Would use substr and index But be careful to previous presence of ()
1506 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1508 if ( $status eq 4 ) {
1509 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1512 UPDATE subscriptionhistory
1513 SET recievedlist=?, missinglist=?
1514 WHERE subscriptionid=?
1516 $sth = $dbh->prepare($query);
1517 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1521 =head2 ItemizeSerials
1525 ItemizeSerials($serialid, $info);
1526 $info is a hashref containing barcode branch, itemcallnumber, status, location
1527 $serialid the serialid
1529 1 if the itemize is a succes.
1530 0 and @error else. @error containts the list of errors found.
1536 sub ItemizeSerials {
1537 my ( $serialid, $info ) = @_;
1538 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1540 my $dbh = C4::Context->dbh;
1546 my $sth = $dbh->prepare($query);
1547 $sth->execute($serialid);
1548 my $data = $sth->fetchrow_hashref;
1549 if ( C4::Context->preference("RoutingSerials") ) {
1551 # check for existing biblioitem relating to serial issue
1552 my ( $count, @results ) =
1553 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1555 for ( my $i = 0 ; $i < $count ; $i++ ) {
1556 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1557 . $data->{'planneddate'}
1560 $bibitemno = $results[$i]->{'biblioitemnumber'};
1564 if ( $bibitemno == 0 ) {
1566 # warn "need to add new biblioitem so copy last one and make minor changes";
1569 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1571 $sth->execute( $data->{'biblionumber'} );
1572 my $biblioitem = $sth->fetchrow_hashref;
1573 $biblioitem->{'volumedate'} =
1574 format_date_in_iso( $data->{planneddate} );
1575 $biblioitem->{'volumeddesc'} =
1576 $data->{serialseq} . ' ('
1577 . format_date( $data->{'planneddate'} ) . ')';
1578 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1580 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1581 # so I comment it, we can speak of it when you want
1582 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1583 # if ( $info->{barcode} )
1584 # { # only make biblioitem if we are going to make item also
1585 # $bibitemno = newbiblioitem($biblioitem);
1590 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1591 if ( $info->{barcode} ) {
1593 my $exists = itemdata( $info->{'barcode'} );
1594 push @errors, "barcode_not_unique" if ($exists);
1596 my $marcrecord = MARC::Record->new();
1597 my ( $tag, $subfield ) =
1598 GetMarcFromKohaField( "items.barcode", $fwk );
1600 MARC::Field->new( "$tag", '', '',
1601 "$subfield" => $info->{barcode} );
1602 $marcrecord->insert_fields_ordered($newField);
1603 if ( $info->{branch} ) {
1604 my ( $tag, $subfield ) =
1605 GetMarcFromKohaField( "items.homebranch",
1608 #warn "items.homebranch : $tag , $subfield";
1609 if ( $marcrecord->field($tag) ) {
1610 $marcrecord->field($tag)
1611 ->add_subfields( "$subfield" => $info->{branch} );
1615 MARC::Field->new( "$tag", '', '',
1616 "$subfield" => $info->{branch} );
1617 $marcrecord->insert_fields_ordered($newField);
1619 ( $tag, $subfield ) =
1620 GetMarcFromKohaField( "items.holdingbranch",
1623 #warn "items.holdingbranch : $tag , $subfield";
1624 if ( $marcrecord->field($tag) ) {
1625 $marcrecord->field($tag)
1626 ->add_subfields( "$subfield" => $info->{branch} );
1630 MARC::Field->new( "$tag", '', '',
1631 "$subfield" => $info->{branch} );
1632 $marcrecord->insert_fields_ordered($newField);
1635 if ( $info->{itemcallnumber} ) {
1636 my ( $tag, $subfield ) =
1637 GetMarcFromKohaField( "items.itemcallnumber",
1640 #warn "items.itemcallnumber : $tag , $subfield";
1641 if ( $marcrecord->field($tag) ) {
1642 $marcrecord->field($tag)
1643 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1647 MARC::Field->new( "$tag", '', '',
1648 "$subfield" => $info->{itemcallnumber} );
1649 $marcrecord->insert_fields_ordered($newField);
1652 if ( $info->{notes} ) {
1653 my ( $tag, $subfield ) =
1654 GetMarcFromKohaField( "items.itemnotes", $fwk );
1656 # warn "items.itemnotes : $tag , $subfield";
1657 if ( $marcrecord->field($tag) ) {
1658 $marcrecord->field($tag)
1659 ->add_subfields( "$subfield" => $info->{notes} );
1663 MARC::Field->new( "$tag", '', '',
1664 "$subfield" => $info->{notes} );
1665 $marcrecord->insert_fields_ordered($newField);
1668 if ( $info->{location} ) {
1669 my ( $tag, $subfield ) =
1670 GetMarcFromKohaField( "items.location", $fwk );
1672 # warn "items.location : $tag , $subfield";
1673 if ( $marcrecord->field($tag) ) {
1674 $marcrecord->field($tag)
1675 ->add_subfields( "$subfield" => $info->{location} );
1679 MARC::Field->new( "$tag", '', '',
1680 "$subfield" => $info->{location} );
1681 $marcrecord->insert_fields_ordered($newField);
1684 if ( $info->{status} ) {
1685 my ( $tag, $subfield ) =
1686 GetMarcFromKohaField( "items.notforloan",
1689 # warn "items.notforloan : $tag , $subfield";
1690 if ( $marcrecord->field($tag) ) {
1691 $marcrecord->field($tag)
1692 ->add_subfields( "$subfield" => $info->{status} );
1696 MARC::Field->new( "$tag", '', '',
1697 "$subfield" => $info->{status} );
1698 $marcrecord->insert_fields_ordered($newField);
1701 if ( C4::Context->preference("RoutingSerials") ) {
1702 my ( $tag, $subfield ) =
1703 GetMarcFromKohaField( "items.dateaccessioned",
1705 if ( $marcrecord->field($tag) ) {
1706 $marcrecord->field($tag)
1707 ->add_subfields( "$subfield" => $now );
1711 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1712 $marcrecord->insert_fields_ordered($newField);
1715 AddItem( $marcrecord, $data->{'biblionumber'} );
1718 return ( 0, @errors );
1722 =head2 HasSubscriptionExpired
1726 1 or 0 = HasSubscriptionExpired($subscriptionid)
1728 the subscription has expired when the next issue to arrive is out of subscription limit.
1731 1 if true, 0 if false.
1737 sub HasSubscriptionExpired {
1738 my ($subscriptionid) = @_;
1739 my $dbh = C4::Context->dbh;
1740 my $subscription = GetSubscription($subscriptionid);
1741 if ($subscription->{periodicity}>0){
1742 my $expirationdate = GetExpirationDate($subscriptionid);
1744 SELECT max(planneddate)
1746 WHERE subscriptionid=?
1748 my $sth = $dbh->prepare($query);
1749 $sth->execute($subscriptionid);
1750 my ($res) = $sth->fetchrow ;
1751 my @res=split (/-/,$res);
1752 # warn "date expiration :$expirationdate";
1753 my @endofsubscriptiondate=split(/-/,$expirationdate);
1754 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1755 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1759 if ($subscription->{'numberlength'}){
1760 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1761 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1770 =head2 SetDistributedto
1774 SetDistributedto($distributedto,$subscriptionid);
1775 This function update the value of distributedto for a subscription given on input arg.
1781 sub SetDistributedto {
1782 my ( $distributedto, $subscriptionid ) = @_;
1783 my $dbh = C4::Context->dbh;
1787 WHERE subscriptionid=?
1789 my $sth = $dbh->prepare($query);
1790 $sth->execute( $distributedto, $subscriptionid );
1793 =head2 DelSubscription
1797 DelSubscription($subscriptionid)
1798 this function delete the subscription which has $subscriptionid as id.
1804 sub DelSubscription {
1805 my ($subscriptionid) = @_;
1806 my $dbh = C4::Context->dbh;
1807 $subscriptionid = $dbh->quote($subscriptionid);
1808 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1810 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1811 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1813 &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1814 if C4::Context->preference("SubscriptionLog");
1821 DelIssue($serialseq,$subscriptionid)
1822 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1829 my ( $serialseq, $subscriptionid ) = @_;
1830 my $dbh = C4::Context->dbh;
1834 AND subscriptionid= ?
1836 my $mainsth = $dbh->prepare($query);
1837 $mainsth->execute( $serialseq, $subscriptionid );
1839 #Delete element from subscription history
1840 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1841 my $sth = $dbh->prepare($query);
1842 $sth->execute($subscriptionid);
1843 my $val = $sth->fetchrow_hashref;
1844 unless ( $val->{manualhistory} ) {
1846 SELECT * FROM subscriptionhistory
1847 WHERE subscriptionid= ?
1849 my $sth = $dbh->prepare($query);
1850 $sth->execute($subscriptionid);
1851 my $data = $sth->fetchrow_hashref;
1852 $data->{'missinglist'} =~ s/$serialseq//;
1853 $data->{'recievedlist'} =~ s/$serialseq//;
1854 my $strsth = "UPDATE subscriptionhistory SET "
1856 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1857 . " WHERE subscriptionid=?";
1858 $sth = $dbh->prepare($strsth);
1859 $sth->execute($subscriptionid);
1861 ### TODO Add itemdeletion. Should be in a pref ?
1863 return $mainsth->rows;
1866 =head2 GetLateOrMissingIssues
1870 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1872 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1875 a count of the number of missing issues
1876 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1877 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1883 sub GetLateOrMissingIssues {
1884 my ( $supplierid, $serialid,$order ) = @_;
1885 my $dbh = C4::Context->dbh;
1889 $byserial = "and serialid = " . $serialid;
1897 $sth = $dbh->prepare(
1906 serial.subscriptionid,
1909 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1910 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
1911 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1912 WHERE subscription.subscriptionid = serial.subscriptionid
1913 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1914 AND subscription.aqbooksellerid=$supplierid
1920 $sth = $dbh->prepare(
1929 serial.subscriptionid,
1932 LEFT JOIN subscription
1933 ON serial.subscriptionid=subscription.subscriptionid
1935 ON serial.biblionumber=biblio.biblionumber
1936 LEFT JOIN aqbooksellers
1937 ON subscription.aqbooksellerid = aqbooksellers.id
1939 subscription.subscriptionid = serial.subscriptionid
1940 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1941 AND biblio.biblionumber = subscription.biblionumber
1951 while ( my $line = $sth->fetchrow_hashref ) {
1952 $odd++ unless $line->{title} eq $last_title;
1953 $last_title = $line->{title} if ( $line->{title} );
1954 $line->{planneddate} = format_date( $line->{planneddate} );
1955 $line->{claimdate} = format_date( $line->{claimdate} );
1956 $line->{"status".$line->{status}} = 1;
1957 $line->{'odd'} = 1 if $odd % 2;
1959 push @issuelist, $line;
1961 return $count, @issuelist;
1964 =head2 removeMissingIssue
1968 removeMissingIssue($subscriptionid)
1970 this function removes an issue from being part of the missing string in
1971 subscriptionlist.missinglist column
1973 called when a missing issue is found from the serials-recieve.pl file
1979 sub removeMissingIssue {
1980 my ( $sequence, $subscriptionid ) = @_;
1981 my $dbh = C4::Context->dbh;
1984 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1985 $sth->execute($subscriptionid);
1986 my $data = $sth->fetchrow_hashref;
1987 my $missinglist = $data->{'missinglist'};
1988 my $missinglistbefore = $missinglist;
1990 # warn $missinglist." before";
1991 $missinglist =~ s/($sequence)//;
1993 # warn $missinglist." after";
1994 if ( $missinglist ne $missinglistbefore ) {
1995 $missinglist =~ s/\|\s\|/\|/g;
1996 $missinglist =~ s/^\| //g;
1997 $missinglist =~ s/\|$//g;
1998 my $sth2 = $dbh->prepare(
1999 "UPDATE subscriptionhistory
2001 WHERE subscriptionid = ?"
2003 $sth2->execute( $missinglist, $subscriptionid );
2011 &updateClaim($serialid)
2013 this function updates the time when a claim is issued for late/missing items
2015 called from claims.pl file
2022 my ($serialid) = @_;
2023 my $dbh = C4::Context->dbh;
2024 my $sth = $dbh->prepare(
2025 "UPDATE serial SET claimdate = now()
2029 $sth->execute($serialid);
2032 =head2 getsupplierbyserialid
2036 ($result) = &getsupplierbyserialid($serialid)
2038 this function is used to find the supplier id given a serial id
2041 hashref containing serialid, subscriptionid, and aqbooksellerid
2047 sub getsupplierbyserialid {
2048 my ($serialid) = @_;
2049 my $dbh = C4::Context->dbh;
2050 my $sth = $dbh->prepare(
2051 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2052 FROM serial, subscription
2053 WHERE serial.subscriptionid = subscription.subscriptionid
2057 $sth->execute($serialid);
2058 my $line = $sth->fetchrow_hashref;
2059 my $result = $line->{'aqbooksellerid'};
2063 =head2 check_routing
2067 ($result) = &check_routing($subscriptionid)
2069 this function checks to see if a serial has a routing list and returns the count of routingid
2070 used to show either an 'add' or 'edit' link
2076 my ($subscriptionid) = @_;
2077 my $dbh = C4::Context->dbh;
2078 my $sth = $dbh->prepare(
2079 "SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
2080 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2081 AND subscription.subscriptionid = ? ORDER BY ranking ASC
2084 $sth->execute($subscriptionid);
2085 my $line = $sth->fetchrow_hashref;
2086 my $result = $line->{'routingids'};
2090 =head2 addroutingmember
2094 &addroutingmember($borrowernumber,$subscriptionid)
2096 this function takes a borrowernumber and subscriptionid and add the member to the
2097 routing list for that serial subscription and gives them a rank on the list
2098 of either 1 or highest current rank + 1
2104 sub addroutingmember {
2105 my ( $borrowernumber, $subscriptionid ) = @_;
2107 my $dbh = C4::Context->dbh;
2110 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2112 $sth->execute($subscriptionid);
2113 while ( my $line = $sth->fetchrow_hashref ) {
2114 if ( $line->{'rank'} > 0 ) {
2115 $rank = $line->{'rank'} + 1;
2123 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2125 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2128 =head2 reorder_members
2132 &reorder_members($subscriptionid,$routingid,$rank)
2134 this function is used to reorder the routing list
2136 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2137 - it gets all members on list puts their routingid's into an array
2138 - removes the one in the array that is $routingid
2139 - then reinjects $routingid at point indicated by $rank
2140 - then update the database with the routingids in the new order
2146 sub reorder_members {
2147 my ( $subscriptionid, $routingid, $rank ) = @_;
2148 my $dbh = C4::Context->dbh;
2151 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2153 $sth->execute($subscriptionid);
2155 while ( my $line = $sth->fetchrow_hashref ) {
2156 push( @result, $line->{'routingid'} );
2159 # To find the matching index
2161 my $key = -1; # to allow for 0 being a valid response
2162 for ( $i = 0 ; $i < @result ; $i++ ) {
2163 if ( $routingid == $result[$i] ) {
2164 $key = $i; # save the index
2169 # if index exists in array then move it to new position
2170 if ( $key > -1 && $rank > 0 ) {
2171 my $new_rank = $rank -
2172 1; # $new_rank is what you want the new index to be in the array
2173 my $moving_item = splice( @result, $key, 1 );
2174 splice( @result, $new_rank, 0, $moving_item );
2176 for ( my $j = 0 ; $j < @result ; $j++ ) {
2178 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2180 . "' WHERE routingid = '"
2187 =head2 delroutingmember
2191 &delroutingmember($routingid,$subscriptionid)
2193 this function either deletes one member from routing list if $routingid exists otherwise
2194 deletes all members from the routing list
2200 sub delroutingmember {
2202 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2203 my ( $routingid, $subscriptionid ) = @_;
2204 my $dbh = C4::Context->dbh;
2208 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2209 $sth->execute($routingid);
2210 reorder_members( $subscriptionid, $routingid );
2215 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2216 $sth->execute($subscriptionid);
2220 =head2 getroutinglist
2224 ($count,@routinglist) = &getroutinglist($subscriptionid)
2226 this gets the info from the subscriptionroutinglist for $subscriptionid
2229 a count of the number of members on routinglist
2230 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2231 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2237 sub getroutinglist {
2238 my ($subscriptionid) = @_;
2239 my $dbh = C4::Context->dbh;
2240 my $sth = $dbh->prepare(
2241 "SELECT routingid, borrowernumber,
2242 ranking, biblionumber FROM subscriptionroutinglist, subscription
2243 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2244 AND subscription.subscriptionid = ? ORDER BY ranking ASC
2247 $sth->execute($subscriptionid);
2250 while ( my $line = $sth->fetchrow_hashref ) {
2252 push( @routinglist, $line );
2254 return ( $count, @routinglist );
2257 =head2 countissuesfrom
2261 $result = &countissuesfrom($subscriptionid,$startdate)
2268 sub countissuesfrom {
2269 my ($subscriptionid,$startdate) = @_;
2270 my $dbh = C4::Context->dbh;
2274 WHERE subscriptionid=?
2275 AND serial.publisheddate>?
2277 my $sth=$dbh->prepare($query);
2278 $sth->execute($subscriptionid, $startdate);
2279 my ($countreceived)=$sth->fetchrow;
2280 return $countreceived;
2283 =head2 abouttoexpire
2287 $result = &abouttoexpire($subscriptionid)
2289 this function alerts you to the penultimate issue for a serial subscription
2291 returns 1 - if this is the penultimate issue
2299 my ($subscriptionid) = @_;
2300 my $dbh = C4::Context->dbh;
2301 my $subscription = GetSubscription($subscriptionid);
2302 my $per = $subscription->{'periodicity'};
2304 my $expirationdate = GetExpirationDate($subscriptionid);
2307 "select max(planneddate) from serial where subscriptionid=?");
2308 $sth->execute($subscriptionid);
2309 my ($res) = $sth->fetchrow ;
2310 # warn "date expiration : ".$expirationdate." date courante ".$res;
2311 my @res=split /-/,$res;
2312 my @endofsubscriptiondate=split/-/,$expirationdate;
2313 my $per = $subscription->{'periodicity'};
2315 if ( $per == 1 ) {$x=7;}
2316 if ( $per == 2 ) {$x=7; }
2317 if ( $per == 3 ) {$x=14;}
2318 if ( $per == 4 ) { $x = 21; }
2319 if ( $per == 5 ) { $x = 31; }
2320 if ( $per == 6 ) { $x = 62; }
2321 if ( $per == 7 || $per == 8 ) { $x = 93; }
2322 if ( $per == 9 ) { $x = 190; }
2323 if ( $per == 10 ) { $x = 365; }
2324 if ( $per == 11 ) { $x = 730; }
2325 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2326 - (3 * $x)) if (@endofsubscriptiondate);
2327 # warn "DATE BEFORE END: $datebeforeend";
2328 return 1 if ( @res &&
2330 Delta_Days($res[0],$res[1],$res[2],
2331 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2332 (@endofsubscriptiondate &&
2333 Delta_Days($res[0],$res[1],$res[2],
2334 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2336 } elsif ($subscription->{numberlength}>0) {
2337 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2341 =head2 old_newsubscription
2345 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2346 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2347 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2348 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2349 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2350 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2352 this function is similar to the NewSubscription subroutine but has a few different
2354 $firstacquidate - date of first serial issue to arrive
2355 $irregularity - the issues not expected separated by a '|'
2356 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2357 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2358 subscription-add.tmpl file
2359 $callnumber - display the callnumber of the serial
2360 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2363 the $subscriptionid number of the new subscription
2369 sub old_newsubscription {
2371 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2372 $biblionumber, $startdate, $periodicity, $firstacquidate,
2373 $dow, $irregularity, $numberpattern, $numberlength,
2374 $weeklength, $monthlength, $add1, $every1,
2375 $whenmorethan1, $setto1, $lastvalue1, $add2,
2376 $every2, $whenmorethan2, $setto2, $lastvalue2,
2377 $add3, $every3, $whenmorethan3, $setto3,
2378 $lastvalue3, $numberingmethod, $status, $callnumber,
2381 my $dbh = C4::Context->dbh;
2384 my $sth = $dbh->prepare(
2385 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2386 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2387 add1,every1,whenmorethan1,setto1,lastvalue1,
2388 add2,every2,whenmorethan2,setto2,lastvalue2,
2389 add3,every3,whenmorethan3,setto3,lastvalue3,
2390 numberingmethod, status, callnumber, notes, hemisphere) values
2391 (?,?,?,?,?,?,?,?,?,?,?,
2392 ?,?,?,?,?,?,?,?,?,?,?,
2393 ?,?,?,?,?,?,?,?,?,?,?,?)"
2396 $auser, $aqbooksellerid,
2398 $biblionumber, format_date_in_iso($startdate),
2399 $periodicity, format_date_in_iso($firstacquidate),
2400 $dow, $irregularity,
2401 $numberpattern, $numberlength,
2402 $weeklength, $monthlength,
2404 $whenmorethan1, $setto1,
2406 $every2, $whenmorethan2,
2407 $setto2, $lastvalue2,
2409 $whenmorethan3, $setto3,
2410 $lastvalue3, $numberingmethod,
2411 $status, $callnumber,
2415 #then create the 1st waited number
2416 my $subscriptionid = $dbh->{'mysql_insertid'};
2417 my $enddate = GetExpirationDate($subscriptionid);
2421 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2424 $biblionumber, $subscriptionid,
2425 format_date_in_iso($startdate),
2426 format_date_in_iso($enddate),
2430 # reread subscription to get a hash (for calculation of the 1st issue number)
2432 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2433 $sth->execute($subscriptionid);
2434 my $val = $sth->fetchrow_hashref;
2436 # calculate issue number
2437 my $serialseq = GetSeq($val);
2440 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2442 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2443 1, format_date_in_iso($startdate) );
2444 return $subscriptionid;
2447 =head2 old_modsubscription
2451 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2452 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2453 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2454 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2455 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2456 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2458 this function is similar to the ModSubscription subroutine but has a few different
2460 $firstacquidate - date of first serial issue to arrive
2461 $irregularity - the issues not expected separated by a '|'
2462 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2463 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2464 subscription-add.tmpl file
2465 $callnumber - display the callnumber of the serial
2466 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2472 sub old_modsubscription {
2474 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2475 $startdate, $periodicity, $firstacquidate, $dow,
2476 $irregularity, $numberpattern, $numberlength, $weeklength,
2477 $monthlength, $add1, $every1, $whenmorethan1,
2478 $setto1, $lastvalue1, $innerloop1, $add2,
2479 $every2, $whenmorethan2, $setto2, $lastvalue2,
2480 $innerloop2, $add3, $every3, $whenmorethan3,
2481 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2482 $status, $biblionumber, $callnumber, $notes,
2483 $hemisphere, $subscriptionid
2485 my $dbh = C4::Context->dbh;
2486 my $sth = $dbh->prepare(
2487 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2488 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2489 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2490 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2491 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2492 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2495 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2496 $startdate, $periodicity, $firstacquidate, $dow,
2497 $irregularity, $numberpattern, $numberlength, $weeklength,
2498 $monthlength, $add1, $every1, $whenmorethan1,
2499 $setto1, $lastvalue1, $innerloop1, $add2,
2500 $every2, $whenmorethan2, $setto2, $lastvalue2,
2501 $innerloop2, $add3, $every3, $whenmorethan3,
2502 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2503 $status, $biblionumber, $callnumber, $notes,
2504 $hemisphere, $subscriptionid
2509 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2510 $sth->execute($subscriptionid);
2511 my $val = $sth->fetchrow_hashref;
2513 # calculate issue number
2514 my $serialseq = Get_Seq($val);
2516 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2517 $sth->execute( $serialseq, $subscriptionid );
2519 my $enddate = subscriptionexpirationdate($subscriptionid);
2520 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2521 $sth->execute( format_date_in_iso($enddate) );
2524 =head2 old_getserials
2528 ($totalissues,@serials) = &old_getserials($subscriptionid)
2530 this function get a hashref of serials and the total count of them
2533 $totalissues - number of serial lines
2534 the serials into a table. Each line of this table containts a ref to a hash which it containts
2535 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2541 sub old_getserials {
2542 my ($subscriptionid) = @_;
2543 my $dbh = C4::Context->dbh;
2545 # status = 2 is "arrived"
2548 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2550 $sth->execute($subscriptionid);
2553 while ( my $line = $sth->fetchrow_hashref ) {
2554 $line->{ "status" . $line->{status} } =
2555 1; # fills a "statusX" value, used for template status select list
2556 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2557 $line->{"num"} = $num;
2559 push @serials, $line;
2561 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2562 $sth->execute($subscriptionid);
2563 my ($totalissues) = $sth->fetchrow;
2564 return ( $totalissues, @serials );
2569 ($resultdate) = &GetNextDate($planneddate,$subscription)
2571 this function is an extension of GetNextDate which allows for checking for irregularity
2573 it takes the planneddate and will return the next issue's date and will skip dates if there
2574 exists an irregularity
2575 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2576 skipped then the returned date will be 2007-05-10
2579 $resultdate - then next date in the sequence
2581 Return 0 if periodicity==0
2584 sub in_array { # used in next sub down
2585 my ($val,@elements) = @_;
2586 foreach my $elem(@elements) {
2594 sub GetNextDate(@) {
2595 my ( $planneddate, $subscription ) = @_;
2596 my @irreg = split( /\,/, $subscription->{irregularity} );
2598 #date supposed to be in ISO.
2600 my ( $year, $month, $day ) = split(/-/, $planneddate);
2601 $month=1 unless ($month);
2602 $day=1 unless ($day);
2605 # warn "DOW $dayofweek";
2606 if ( $subscription->{periodicity} == 0 ) {
2609 if ( $subscription->{periodicity} == 1 ) {
2610 my $dayofweek = Day_of_Week( $year,$month, $day );
2611 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2612 $dayofweek = 0 if ( $dayofweek == 7 );
2613 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2614 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2618 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2620 if ( $subscription->{periodicity} == 2 ) {
2621 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2622 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2623 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2624 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2625 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2628 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2630 if ( $subscription->{periodicity} == 3 ) {
2631 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2632 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2633 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2634 ### BUGFIX was previously +1 ^
2635 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2636 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2639 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2641 if ( $subscription->{periodicity} == 4 ) {
2642 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2643 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2644 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2645 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2646 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2649 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2651 my $tmpmonth=$month;
2652 if ( $subscription->{periodicity} == 5 ) {
2653 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2654 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2655 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2656 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2659 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2661 if ( $subscription->{periodicity} == 6 ) {
2662 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2663 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2664 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2665 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2668 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2670 if ( $subscription->{periodicity} == 7 ) {
2671 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2672 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2673 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2674 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2677 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2679 if ( $subscription->{periodicity} == 8 ) {
2680 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2681 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2682 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2683 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2686 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2688 if ( $subscription->{periodicity} == 9 ) {
2689 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2690 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2691 ### BUFIX Seems to need more Than One ?
2692 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2693 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2696 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2698 if ( $subscription->{periodicity} == 10 ) {
2699 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2701 if ( $subscription->{periodicity} == 11 ) {
2702 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2704 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2705 # warn "dateNEXTSEQ : ".$resultdate;
2706 return "$resultdate";
2711 $item = &itemdata($barcode);
2713 Looks up the item with the given barcode, and returns a
2714 reference-to-hash containing information about that item. The keys of
2715 the hash are the fields from the C<items> and C<biblioitems> tables in
2723 my $dbh = C4::Context->dbh;
2724 my $sth = $dbh->prepare(
2725 "Select * from items,biblioitems where barcode=?
2726 and items.biblioitemnumber=biblioitems.biblioitemnumber"
2728 $sth->execute($barcode);
2729 my $data = $sth->fetchrow_hashref;
2734 END { } # module clean-up code here (global destructor)
2742 Koha Developement team <info@koha.org>