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)
107 my $sth = $dbh->prepare($query);
110 while ( my ( $id, $name ) = $sth->fetchrow ) {
111 $supplierlist{$id} = $name;
113 if ( C4::Context->preference("RoutingSerials") ) {
114 $supplierlist{''} = "All Suppliers";
116 return %supplierlist;
123 @issuelist = &GetLateIssues($supplierid)
125 this function select late issues on database
128 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
129 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
136 my ($supplierid) = @_;
137 my $dbh = C4::Context->dbh;
141 SELECT name,title,planneddate,serialseq,serial.subscriptionid
142 FROM subscription, serial, biblio
143 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
144 WHERE subscription.subscriptionid = serial.subscriptionid
145 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
146 AND subscription.aqbooksellerid=$supplierid
147 AND biblio.biblionumber = subscription.biblionumber
150 $sth = $dbh->prepare($query);
154 SELECT name,title,planneddate,serialseq,serial.subscriptionid
155 FROM subscription, serial, biblio
156 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
157 WHERE subscription.subscriptionid = serial.subscriptionid
158 AND ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
159 AND biblio.biblionumber = subscription.biblionumber
162 $sth = $dbh->prepare($query);
169 while ( my $line = $sth->fetchrow_hashref ) {
170 $odd++ unless $line->{title} eq $last_title;
171 $line->{title} = "" if $line->{title} eq $last_title;
172 $last_title = $line->{title} if ( $line->{title} );
173 $line->{planneddate} = format_date( $line->{planneddate} );
175 push @issuelist, $line;
177 return $count, @issuelist;
180 =head2 GetSubscriptionHistoryFromSubscriptionId
184 $sth = GetSubscriptionHistoryFromSubscriptionId()
185 this function just prepare the SQL request.
186 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
188 $sth = $dbh->prepare($query).
194 sub GetSubscriptionHistoryFromSubscriptionId() {
195 my $dbh = C4::Context->dbh;
198 FROM subscriptionhistory
199 WHERE subscriptionid = ?
201 return $dbh->prepare($query);
204 =head2 GetSerialStatusFromSerialId
208 $sth = GetSerialStatusFromSerialId();
209 this function just prepare the SQL request.
210 After this function, don't forget to execute it by using $sth->execute($serialid)
212 $sth = $dbh->prepare($query).
218 sub GetSerialStatusFromSerialId() {
219 my $dbh = C4::Context->dbh;
225 return $dbh->prepare($query);
228 =head2 GetSerialInformation
232 $data = GetSerialInformation($serialid);
233 returns a hash containing :
234 items : items marcrecord (can be an array)
236 subscription table field
237 + information about subscription expiration
243 sub GetSerialInformation {
245 my $dbh = C4::Context->dbh;
247 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
248 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
251 my $rq = $dbh->prepare($query);
252 $rq->execute($serialid);
253 my $data = $rq->fetchrow_hashref;
255 if ( C4::Context->preference("serialsadditems") ) {
256 if ( $data->{'itemnumber'} ) {
257 my @itemnumbers = split /,/, $data->{'itemnumber'};
258 foreach my $itemnum (@itemnumbers) {
260 #It is ASSUMED that GetMarcItem ALWAYS WORK...
261 #Maybe GetMarcItem should return values on failure
262 # warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
264 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
265 $itemprocessed->{'itemnumber'} = $itemnum;
266 $itemprocessed->{'itemid'} = $itemnum;
267 $itemprocessed->{'serialid'} = $serialid;
268 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
269 push @{ $data->{'items'} }, $itemprocessed;
274 PrepareItemrecordDisplay( $data->{'biblionumber'} );
275 $itemprocessed->{'itemid'} = "N$serialid";
276 $itemprocessed->{'serialid'} = $serialid;
277 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
278 $itemprocessed->{'countitems'} = 0;
279 push @{ $data->{'items'} }, $itemprocessed;
282 $data->{ "status" . $data->{'serstatus'} } = 1;
283 $data->{'subscriptionexpired'} =
284 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
285 $data->{'abouttoexpire'} =
286 abouttoexpire( $data->{'subscriptionid'} );
290 =head2 GetSerialInformation
294 $data = AddItem2Serial($serialid,$itemnumber);
295 Adds an itemnumber to Serial record
301 my ( $serialid, $itemnumber ) = @_;
302 my $dbh = C4::Context->dbh;
304 UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber))
307 my $rq = $dbh->prepare($query);
308 $rq->execute($serialid);
312 =head2 UpdateClaimdateIssues
316 UpdateClaimdateIssues($serialids,[$date]);
318 Update Claimdate for issues in @$serialids list with date $date
324 sub UpdateClaimdateIssues {
325 my ( $serialids, $date ) = @_;
326 my $dbh = C4::Context->dbh;
327 $date = strftime("%Y-%m-%d",localtime) unless ($date);
329 UPDATE serial SET claimdate=$date,status=7
330 WHERE serialid in ".join (",",@$serialids);
332 my $rq = $dbh->prepare($query);
337 =head2 GetSubscription
341 $subs = GetSubscription($subscriptionid)
342 this function get the subscription which has $subscriptionid as id.
344 a hashref. This hash containts
345 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
351 sub GetSubscription {
352 my ($subscriptionid) = @_;
353 my $dbh = C4::Context->dbh;
355 SELECT subscription.*,
356 subscriptionhistory.*,
358 aqbooksellers.name AS aqbooksellername,
359 biblio.title AS bibliotitle,
360 subscription.biblionumber as bibnum
362 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
363 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
364 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
365 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
366 WHERE subscription.subscriptionid = ?
368 if (C4::Context->preference('IndependantBranches') &&
369 C4::Context->userenv &&
370 C4::Context->userenv->{'flags'} != 1){
371 # warn "flags: ".C4::Context->userenv->{'flags'};
372 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
374 # warn "query : $query";
375 my $sth = $dbh->prepare($query);
376 $sth->execute($subscriptionid);
377 my $subs = $sth->fetchrow_hashref;
381 =head2 GetFullSubscription
385 \@res = GetFullSubscription($subscriptionid)
386 this function read on serial table.
392 sub GetFullSubscription {
393 my ($subscriptionid) = @_;
394 my $dbh = C4::Context->dbh;
396 SELECT serial.serialid,
399 serial.publisheddate,
401 serial.notes as notes,
402 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
403 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
404 biblio.title as bibliotitle,
405 subscription.branchcode AS branchcode,
406 subscription.subscriptionid AS subscriptionid
408 LEFT JOIN subscription ON
409 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
410 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
411 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
412 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
413 WHERE serial.subscriptionid = ? |;
414 if (C4::Context->preference('IndependantBranches') &&
415 C4::Context->userenv &&
416 C4::Context->userenv->{'flags'} != 1){
418 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
422 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
423 serial.subscriptionid
425 my $sth = $dbh->prepare($query);
426 $sth->execute($subscriptionid);
427 my $subs = $sth->fetchall_arrayref({});
432 =head2 PrepareSerialsData
436 \@res = PrepareSerialsData($serialinfomation)
437 where serialinformation is a hashref array
443 sub PrepareSerialsData{
449 my $aqbooksellername;
453 my $previousnote = "";
455 foreach my $subs ( @$lines ) {
456 $subs->{'publisheddate'} =
457 ( $subs->{'publisheddate'}
458 ? format_date( $subs->{'publisheddate'} )
460 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
461 $subs->{ "status" . $subs->{'status'} } = 1;
463 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
464 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
465 $year = $subs->{'year'};
470 if ( $tmpresults{$year} ) {
471 push @{ $tmpresults{$year}->{'serials'} }, $subs;
474 $tmpresults{$year} = {
477 # 'startdate'=>format_date($subs->{'startdate'}),
478 'aqbooksellername' => $subs->{'aqbooksellername'},
479 'bibliotitle' => $subs->{'bibliotitle'},
480 'serials' => [$subs],
482 'branchcode' => $subs->{'branchcode'},
483 'subscriptionid' => $subs->{'subscriptionid'},
487 # $previousnote=$subs->{notes};
489 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
490 push @res, $tmpresults{$key};
492 $res[0]->{'first'}=1;
496 =head2 GetSubscriptionsFromBiblionumber
498 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
499 this function get the subscription list. it reads on subscription table.
501 table of subscription which has the biblionumber given on input arg.
502 each line of this table is a hashref. All hashes containt
503 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
507 sub GetSubscriptionsFromBiblionumber {
508 my ($biblionumber) = @_;
509 my $dbh = C4::Context->dbh;
511 SELECT subscription.*,
513 subscriptionhistory.*,
515 aqbooksellers.name AS aqbooksellername,
516 biblio.title AS bibliotitle
518 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
519 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
520 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
521 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
522 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
523 WHERE subscription.biblionumber = ?
525 if (C4::Context->preference('IndependantBranches') &&
526 C4::Context->userenv &&
527 C4::Context->userenv->{'flags'} != 1){
528 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
530 my $sth = $dbh->prepare($query);
531 $sth->execute($biblionumber);
533 while ( my $subs = $sth->fetchrow_hashref ) {
534 $subs->{startdate} = format_date( $subs->{startdate} );
535 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
536 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
537 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
538 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
539 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
540 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
541 $subs->{ "status" . $subs->{'status'} } = 1;
542 if ( $subs->{enddate} eq '0000-00-00' ) {
543 $subs->{enddate} = '';
546 $subs->{enddate} = format_date( $subs->{enddate} );
548 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
549 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
555 =head2 GetFullSubscriptionsFromBiblionumber
559 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
560 this function read on serial table.
566 sub GetFullSubscriptionsFromBiblionumber {
567 my ($biblionumber) = @_;
568 my $dbh = C4::Context->dbh;
570 SELECT serial.serialid,
573 serial.publisheddate,
575 serial.notes as notes,
576 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
577 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
578 biblio.title as bibliotitle,
579 subscription.branchcode AS branchcode,
580 subscription.subscriptionid AS subscriptionid
582 LEFT JOIN subscription ON
583 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
584 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
585 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
586 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
587 WHERE subscription.biblionumber = ? |;
588 if (C4::Context->preference('IndependantBranches') &&
589 C4::Context->userenv &&
590 C4::Context->userenv->{'flags'} != 1){
592 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
596 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
597 serial.subscriptionid
599 my $sth = $dbh->prepare($query);
600 $sth->execute($biblionumber);
601 my $subs= $sth->fetchall_arrayref({});
605 =head2 GetSubscriptions
609 @results = GetSubscriptions($title,$ISSN,$biblionumber);
610 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
612 a table of hashref. Each hash containt the subscription.
618 sub GetSubscriptions {
619 my ( $title, $ISSN, $biblionumber ) = @_;
620 #return unless $title or $ISSN or $biblionumber;
621 my $dbh = C4::Context->dbh;
625 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
626 FROM subscription,biblio,biblioitems
627 WHERE biblio.biblionumber = biblioitems.biblionumber
628 AND biblio.biblionumber = subscription.biblionumber
629 AND biblio.biblionumber=?
631 if (C4::Context->preference('IndependantBranches') &&
632 C4::Context->userenv &&
633 C4::Context->userenv->{'flags'} != 1){
634 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
636 $query.=" ORDER BY title";
637 # warn "query :$query";
638 $sth = $dbh->prepare($query);
639 $sth->execute($biblionumber);
642 if ( $ISSN and $title ) {
644 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
645 FROM subscription,biblio,biblioitems
646 WHERE biblio.biblionumber = biblioitems.biblionumber
647 AND biblio.biblionumber= subscription.biblionumber
648 AND (biblio.title LIKE ? or biblioitems.issn = ?)
650 if (C4::Context->preference('IndependantBranches') &&
651 C4::Context->userenv &&
652 C4::Context->userenv->{'flags'} != 1){
653 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
655 $query.=" ORDER BY title";
656 $sth = $dbh->prepare($query);
657 $sth->execute( "%$title%", $ISSN );
662 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
663 FROM subscription,biblio,biblioitems
664 WHERE biblio.biblionumber = biblioitems.biblionumber
665 AND biblio.biblionumber=subscription.biblionumber
666 AND biblioitems.issn LIKE ?
668 if (C4::Context->preference('IndependantBranches') &&
669 C4::Context->userenv &&
670 C4::Context->userenv->{'flags'} != 1){
671 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
673 $query.=" ORDER BY title";
674 # warn "query :$query";
675 $sth = $dbh->prepare($query);
676 $sth->execute( "%" . $ISSN . "%" );
680 SELECT subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,subscription.branchcode,biblio.biblionumber
681 FROM subscription,biblio,biblioitems
682 WHERE biblio.biblionumber = biblioitems.biblionumber
683 AND biblio.biblionumber=subscription.biblionumber
684 AND biblio.title LIKE ?
686 if (C4::Context->preference('IndependantBranches') &&
687 C4::Context->userenv &&
688 C4::Context->userenv->{'flags'} != 1){
689 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
691 $query.=" ORDER BY title";
692 $sth = $dbh->prepare($query);
693 $sth->execute( "%" . $title . "%" );
698 my $previoustitle = "";
700 while ( my $line = $sth->fetchrow_hashref ) {
701 if ( $previoustitle eq $line->{title} ) {
704 $line->{toggle} = 1 if $odd == 1;
707 $previoustitle = $line->{title};
709 $line->{toggle} = 1 if $odd == 1;
711 push @results, $line;
720 ($totalissues,@serials) = GetSerials($subscriptionid);
721 this function get every serial not arrived for a given subscription
722 as well as the number of issues registered in the database (all types)
723 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
730 my ($subscriptionid,$count) = @_;
731 my $dbh = C4::Context->dbh;
733 # status = 2 is "arrived"
735 $count=5 unless ($count);
738 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes
740 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
741 ORDER BY publisheddate,serialid DESC";
742 my $sth = $dbh->prepare($query);
743 $sth->execute($subscriptionid);
744 while ( my $line = $sth->fetchrow_hashref ) {
745 $line->{ "status" . $line->{status} } =
746 1; # fills a "statusX" value, used for template status select list
747 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
748 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
749 push @serials, $line;
751 # OK, now add the last 5 issues arrives/missing
753 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes
755 WHERE subscriptionid = ?
756 AND (status in (2,4,5))
757 ORDER BY publisheddate,serialid DESC
759 $sth = $dbh->prepare($query);
760 $sth->execute($subscriptionid);
761 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
763 $line->{ "status" . $line->{status} } =
764 1; # fills a "statusX" value, used for template status select list
765 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
766 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
767 push @serials, $line;
770 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
771 $sth = $dbh->prepare($query);
772 $sth->execute($subscriptionid);
773 my ($totalissues) = $sth->fetchrow;
774 return ( $totalissues, @serials );
781 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
782 this function get every serial waited for a given subscription
783 as well as the number of issues registered in the database (all types)
784 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
790 my ($subscription,$status) = @_;
791 my $dbh = C4::Context->dbh;
793 SELECT serialid,serialseq, status, planneddate, publisheddate,notes
795 WHERE subscriptionid=$subscription AND status=$status
796 ORDER BY publisheddate,serialid DESC
799 my $sth=$dbh->prepare($query);
802 while(my $line = $sth->fetchrow_hashref) {
803 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
804 $line->{"planneddate"} = format_date($line->{"planneddate"});
805 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
808 my ($totalissues) = scalar(@serials);
809 return ($totalissues,@serials);
812 =head2 GetLatestSerials
816 \@serials = GetLatestSerials($subscriptionid,$limit)
817 get the $limit's latest serials arrived or missing for a given subscription
819 a ref to a table which it containts all of the latest serials stored into a hash.
825 sub GetLatestSerials {
826 my ( $subscriptionid, $limit ) = @_;
827 my $dbh = C4::Context->dbh;
829 # status = 2 is "arrived"
830 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
832 WHERE subscriptionid = ?
833 AND (status =2 or status=4)
834 ORDER BY planneddate DESC LIMIT 0,$limit
836 my $sth = $dbh->prepare($strsth);
837 $sth->execute($subscriptionid);
839 while ( my $line = $sth->fetchrow_hashref ) {
840 $line->{ "status" . $line->{status} } =
841 1; # fills a "statusX" value, used for template status select list
842 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
843 push @serials, $line;
849 # WHERE subscriptionid=?
851 # $sth=$dbh->prepare($query);
852 # $sth->execute($subscriptionid);
853 # my ($totalissues) = $sth->fetchrow;
857 =head2 GetDistributedTo
861 $distributedto=GetDistributedTo($subscriptionid)
862 This function select the old previous value of distributedto in the database.
868 sub GetDistributedTo {
869 my $dbh = C4::Context->dbh;
871 my $subscriptionid = @_;
872 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
873 my $sth = $dbh->prepare($query);
874 $sth->execute($subscriptionid);
875 return ($distributedto) = $sth->fetchrow;
883 $val is a hashref containing all the attributes of the table 'subscription'
884 This function get the next issue for the subscription given on input arg
886 all the input params updated.
894 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
895 # $calculated = $val->{numberingmethod};
896 # # calculate the (expected) value of the next issue recieved.
897 # $newlastvalue1 = $val->{lastvalue1};
898 # # check if we have to increase the new value.
899 # $newinnerloop1 = $val->{innerloop1}+1;
900 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
901 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
902 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
903 # $calculated =~ s/\{X\}/$newlastvalue1/g;
905 # $newlastvalue2 = $val->{lastvalue2};
906 # # check if we have to increase the new value.
907 # $newinnerloop2 = $val->{innerloop2}+1;
908 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
909 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
910 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
911 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
913 # $newlastvalue3 = $val->{lastvalue3};
914 # # check if we have to increase the new value.
915 # $newinnerloop3 = $val->{innerloop3}+1;
916 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
917 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
918 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
919 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
920 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
926 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
927 $newinnerloop1, $newinnerloop2, $newinnerloop3
929 my $pattern = $val->{numberpattern};
930 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
931 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
932 $calculated = $val->{numberingmethod};
933 $newlastvalue1 = $val->{lastvalue1};
934 $newlastvalue2 = $val->{lastvalue2};
935 $newlastvalue3 = $val->{lastvalue3};
937 if ( $newlastvalue3 > 0 ) { # if x y and z columns are used
938 $newlastvalue3 = $newlastvalue3 + 1;
939 if ( $newlastvalue3 > $val->{whenmorethan3} ) {
940 $newlastvalue3 = $val->{setto3};
942 if ( $newlastvalue2 > $val->{whenmorethan2} ) {
944 $newlastvalue2 = $val->{setto2};
947 $calculated =~ s/\{X\}/$newlastvalue1/g;
948 if ( $pattern == 6 ) {
949 if ( $val->{hemisphere} == 2 ) {
950 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
951 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
954 my $newlastvalue2seq = $seasons[$newlastvalue2];
955 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
959 $calculated =~ s/\{Y\}/$newlastvalue2/g;
961 $calculated =~ s/\{Z\}/$newlastvalue3/g;
963 if ( $newlastvalue2 > 0 && $newlastvalue3 < 1 )
964 { # if x and y columns are used
965 $newlastvalue2 = $newlastvalue2 + 1;
966 if ( $newlastvalue2 > $val->{whenmorethan2} ) {
967 $newlastvalue2 = $val->{setto2};
970 $calculated =~ s/\{X\}/$newlastvalue1/g;
971 if ( $pattern == 6 ) {
972 if ( $val->{hemisphere} == 2 ) {
973 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
974 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
977 my $newlastvalue2seq = $seasons[$newlastvalue2];
978 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
982 $calculated =~ s/\{Y\}/$newlastvalue2/g;
985 if ( $newlastvalue1 > 0 && $newlastvalue2 < 1 && $newlastvalue3 < 1 )
987 $newlastvalue1 = $newlastvalue1 + 1;
988 if ( $newlastvalue1 > $val->{whenmorethan1} ) {
989 $newlastvalue1 = $val->{setto2};
991 $calculated =~ s/\{X\}/$newlastvalue1/g;
993 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 );
1000 $calculated = GetSeq($val)
1001 $val is a hashref containing all the attributes of the table 'subscription'
1002 this function transforms {X},{Y},{Z} to 150,0,0 for example.
1004 the sequence in integer format
1012 my $pattern = $val->{numberpattern};
1013 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
1014 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
1015 my $calculated = $val->{numberingmethod};
1016 my $x = $val->{'lastvalue1'};
1017 $calculated =~ s/\{X\}/$x/g;
1018 my $newlastvalue2 = $val->{'lastvalue2'};
1019 if ( $pattern == 6 ) {
1020 if ( $val->{hemisphere} == 2 ) {
1021 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1022 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1025 my $newlastvalue2seq = $seasons[$newlastvalue2];
1026 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1030 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1032 my $z = $val->{'lastvalue3'};
1033 $calculated =~ s/\{Z\}/$z/g;
1037 =head2 GetExpirationDate
1039 $sensddate = GetExpirationDate($subscriptionid)
1041 this function return the expiration date for a subscription given on input args.
1048 sub GetExpirationDate {
1049 my ($subscriptionid) = @_;
1050 my $dbh = C4::Context->dbh;
1051 my $subscription = GetSubscription($subscriptionid);
1052 my $enddate = $subscription->{startdate};
1054 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1055 # warn "SUBSCRIPTIONID :$subscriptionid";
1056 # use Data::Dumper; warn Dumper($subscription);
1058 # warn "dateCHECKRESERV :".$subscription->{startdate};
1059 if ($subscription->{periodicity}){
1060 if ( $subscription->{numberlength} ) {
1061 #calculate the date of the last issue.
1062 my $length = $subscription->{numberlength};
1063 # warn "ENDDATE ".$enddate;
1064 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1065 $enddate = GetNextDate( $enddate, $subscription );
1066 # warn "AFTER ENDDATE ".$enddate;
1069 elsif ( $subscription->{monthlength} ){
1070 my @date=split (/-/,$subscription->{startdate});
1071 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1072 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1073 } elsif ( $subscription->{weeklength} ){
1074 my @date=split (/-/,$subscription->{startdate});
1075 # warn "dateCHECKRESERV :".$subscription->{startdate};
1076 #### An other way to do it
1077 # if ( $subscription->{weeklength} ){
1078 # my ($weeknb,$year)=Week_of_Year(@startdate);
1079 # $weeknb += $subscription->{weeklength};
1080 # my $weeknbcalc= $weeknb % 52;
1081 # $year += int($weeknb/52);
1082 # # warn "year : $year weeknb :$weeknb weeknbcalc $weeknbcalc";
1083 # @endofsubscriptiondate=Monday_of_Week($weeknbcalc,$year);
1085 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1086 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1088 # warn "date de fin :$enddate";
1095 =head2 CountSubscriptionFromBiblionumber
1099 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1100 this count the number of subscription for a biblionumber given.
1102 the number of subscriptions with biblionumber given on input arg.
1108 sub CountSubscriptionFromBiblionumber {
1109 my ($biblionumber) = @_;
1110 my $dbh = C4::Context->dbh;
1111 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1112 my $sth = $dbh->prepare($query);
1113 $sth->execute($biblionumber);
1114 my $subscriptionsnumber = $sth->fetchrow;
1115 return $subscriptionsnumber;
1118 =head2 ModSubscriptionHistory
1122 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1124 this function modify the history of a subscription. Put your new values on input arg.
1130 sub ModSubscriptionHistory {
1132 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1133 $missinglist, $opacnote, $librariannote
1135 my $dbh = C4::Context->dbh;
1136 my $query = "UPDATE subscriptionhistory
1137 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1138 WHERE subscriptionid=?
1140 my $sth = $dbh->prepare($query);
1141 $recievedlist =~ s/^,//g;
1142 $missinglist =~ s/^,//g;
1143 $opacnote =~ s/^,//g;
1145 $histstartdate, $enddate, $recievedlist, $missinglist,
1146 $opacnote, $librariannote, $subscriptionid
1151 =head2 ModSerialStatus
1155 ModSerialStatus($serialid,$serialseq, $publisheddate,$planneddate,$status,$notes)
1157 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1158 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1164 sub ModSerialStatus {
1165 my ( $serialid, $serialseq, $publisheddate, $planneddate, $status, $notes )
1168 #It is a usual serial
1169 # 1st, get previous status :
1170 my $dbh = C4::Context->dbh;
1171 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1172 my $sth = $dbh->prepare($query);
1173 $sth->execute($serialid);
1174 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1176 # change status & update subscriptionhistory
1178 if ( $status eq 6 ) {
1179 DelIssue( $serialseq, $subscriptionid );
1183 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1184 $sth = $dbh->prepare($query);
1185 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1186 $notes, $serialid );
1187 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1188 $sth = $dbh->prepare($query);
1189 $sth->execute($subscriptionid);
1190 my $val = $sth->fetchrow_hashref;
1191 unless ( $val->{manualhistory} ) {
1193 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1194 $sth = $dbh->prepare($query);
1195 $sth->execute($subscriptionid);
1196 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1197 if ( $status eq 2 ) {
1199 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1200 $recievedlist .= ",$serialseq"
1201 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1204 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1205 $missinglist .= ",$serialseq"
1207 and not index( "$missinglist", "$serialseq" ) >= 0 );
1208 $missinglist .= ",not issued $serialseq"
1210 and index( "$missinglist", "$serialseq" ) >= 0 );
1212 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1213 $sth = $dbh->prepare($query);
1214 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1218 # create new waited entry if needed (ie : was a "waited" and has changed)
1219 if ( $oldstatus eq 1 && $status ne 1 ) {
1220 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1221 $sth = $dbh->prepare($query);
1222 $sth->execute($subscriptionid);
1223 my $val = $sth->fetchrow_hashref;
1227 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1228 $newinnerloop1, $newinnerloop2, $newinnerloop3
1229 ) = GetNextSeq($val);
1231 # next date (calculated from actual date & frequency parameters)
1232 # warn "publisheddate :$publisheddate ";
1233 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1234 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1235 1, $nextpublisheddate, $nextpublisheddate );
1237 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1238 WHERE subscriptionid = ?";
1239 $sth = $dbh->prepare($query);
1241 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1242 $newinnerloop2, $newinnerloop3, $subscriptionid
1245 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1246 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1247 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1252 =head2 ModSubscription
1256 this function modify a subscription. Put all new values on input args.
1262 sub ModSubscription {
1264 $auser, $branchcode, $aqbooksellerid, $cost,
1265 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1266 $dow, $irregularity, $numberpattern, $numberlength,
1267 $weeklength, $monthlength, $add1, $every1,
1268 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1269 $add2, $every2, $whenmorethan2, $setto2,
1270 $lastvalue2, $innerloop2, $add3, $every3,
1271 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1272 $numberingmethod, $status, $biblionumber, $callnumber,
1273 $notes, $letter, $hemisphere, $manualhistory,
1277 # warn $irregularity;
1278 my $dbh = C4::Context->dbh;
1279 my $query = "UPDATE subscription
1280 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1281 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1282 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1283 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1284 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1285 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1286 WHERE subscriptionid = ?";
1287 # warn "query :".$query;
1288 my $sth = $dbh->prepare($query);
1290 $auser, $branchcode, $aqbooksellerid, $cost,
1291 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1292 $dow, "$irregularity", $numberpattern, $numberlength,
1293 $weeklength, $monthlength, $add1, $every1,
1294 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1295 $add2, $every2, $whenmorethan2, $setto2,
1296 $lastvalue2, $innerloop2, $add3, $every3,
1297 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1298 $numberingmethod, $status, $biblionumber, $callnumber,
1299 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1303 my $rows=$sth->rows;
1306 &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1307 if C4::Context->preference("SubscriptionLog");
1311 =head2 NewSubscription
1315 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1316 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1317 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1318 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1319 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1320 $numberingmethod, $status, $notes)
1322 Create a new subscription with value given on input args.
1325 the id of this new subscription
1331 sub NewSubscription {
1333 $auser, $branchcode, $aqbooksellerid, $cost,
1334 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1335 $dow, $numberlength, $weeklength, $monthlength,
1336 $add1, $every1, $whenmorethan1, $setto1,
1337 $lastvalue1, $innerloop1, $add2, $every2,
1338 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1339 $add3, $every3, $whenmorethan3, $setto3,
1340 $lastvalue3, $innerloop3, $numberingmethod, $status,
1341 $notes, $letter, $firstacquidate, $irregularity,
1342 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1345 my $dbh = C4::Context->dbh;
1347 #save subscription (insert into database)
1349 INSERT INTO subscription
1350 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1351 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1352 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1353 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1354 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1355 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1356 numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1357 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1359 my $sth = $dbh->prepare($query);
1361 $auser, $branchcode,
1362 $aqbooksellerid, $cost,
1363 $aqbudgetid, $biblionumber,
1364 format_date_in_iso($startdate), $periodicity,
1365 $dow, $numberlength,
1366 $weeklength, $monthlength,
1368 $whenmorethan1, $setto1,
1369 $lastvalue1, $innerloop1,
1371 $whenmorethan2, $setto2,
1372 $lastvalue2, $innerloop2,
1374 $whenmorethan3, $setto3,
1375 $lastvalue3, $innerloop3,
1376 $numberingmethod, "$status",
1378 $firstacquidate, $irregularity,
1379 $numberpattern, $callnumber,
1380 $hemisphere, $manualhistory,
1384 #then create the 1st waited number
1385 my $subscriptionid = $dbh->{'mysql_insertid'};
1387 INSERT INTO subscriptionhistory
1388 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1389 VALUES (?,?,?,?,?,?,?,?)
1391 $sth = $dbh->prepare($query);
1392 $sth->execute( $biblionumber, $subscriptionid,
1393 format_date_in_iso($startdate),
1394 0, "", "", "", "$notes" );
1396 # reread subscription to get a hash (for calculation of the 1st issue number)
1400 WHERE subscriptionid = ?
1402 $sth = $dbh->prepare($query);
1403 $sth->execute($subscriptionid);
1404 my $val = $sth->fetchrow_hashref;
1406 # calculate issue number
1407 my $serialseq = GetSeq($val);
1410 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1411 VALUES (?,?,?,?,?,?)
1413 $sth = $dbh->prepare($query);
1415 "$serialseq", $subscriptionid, $biblionumber, 1,
1416 format_date_in_iso($startdate),
1417 format_date_in_iso($startdate)
1420 &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1421 if C4::Context->preference("SubscriptionLog");
1423 return $subscriptionid;
1426 =head2 ReNewSubscription
1430 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1432 this function renew a subscription with values given on input args.
1438 sub ReNewSubscription {
1439 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1440 $monthlength, $note )
1442 my $dbh = C4::Context->dbh;
1443 my $subscription = GetSubscription($subscriptionid);
1446 FROM biblio,biblioitems
1447 WHERE biblio.biblionumber=biblioitems.biblionumber
1448 AND biblio.biblionumber=?
1450 my $sth = $dbh->prepare($query);
1451 $sth->execute( $subscription->{biblionumber} );
1452 my $biblio = $sth->fetchrow_hashref;
1454 $user, $subscription->{bibliotitle},
1455 $biblio->{author}, $biblio->{publishercode},
1456 $biblio->{note}, '',
1459 $subscription->{biblionumber}
1462 # renew subscription
1465 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1466 WHERE subscriptionid=?
1468 $sth = $dbh->prepare($query);
1469 $sth->execute( format_date_in_iso($startdate),
1470 $numberlength, $weeklength, $monthlength, $subscriptionid );
1472 &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1473 if C4::Context->preference("SubscriptionLog");
1480 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $publisheddate, $planneddate)
1482 Create a new issue stored on the database.
1483 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1490 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1491 $planneddate, $publisheddate, $notes )
1493 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1495 my $dbh = C4::Context->dbh;
1498 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1499 VALUES (?,?,?,?,?,?,?)
1501 my $sth = $dbh->prepare($query);
1502 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1503 $publisheddate, $planneddate,$notes );
1504 my $serialid=$dbh->{'mysql_insertid'};
1506 SELECT missinglist,recievedlist
1507 FROM subscriptionhistory
1508 WHERE subscriptionid=?
1510 $sth = $dbh->prepare($query);
1511 $sth->execute($subscriptionid);
1512 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1514 if ( $status eq 2 ) {
1515 ### TODO Add a feature that improves recognition and description.
1516 ### As such count (serialseq) i.e. : N18,2(N19),N20
1517 ### Would use substr and index But be careful to previous presence of ()
1518 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1520 if ( $status eq 4 ) {
1521 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1524 UPDATE subscriptionhistory
1525 SET recievedlist=?, missinglist=?
1526 WHERE subscriptionid=?
1528 $sth = $dbh->prepare($query);
1529 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1533 =head2 ItemizeSerials
1537 ItemizeSerials($serialid, $info);
1538 $info is a hashref containing barcode branch, itemcallnumber, status, location
1539 $serialid the serialid
1541 1 if the itemize is a succes.
1542 0 and @error else. @error containts the list of errors found.
1548 sub ItemizeSerials {
1549 my ( $serialid, $info ) = @_;
1550 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1552 my $dbh = C4::Context->dbh;
1558 my $sth = $dbh->prepare($query);
1559 $sth->execute($serialid);
1560 my $data = $sth->fetchrow_hashref;
1561 if ( C4::Context->preference("RoutingSerials") ) {
1563 # check for existing biblioitem relating to serial issue
1564 my ( $count, @results ) =
1565 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1567 for ( my $i = 0 ; $i < $count ; $i++ ) {
1568 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1569 . $data->{'planneddate'}
1572 $bibitemno = $results[$i]->{'biblioitemnumber'};
1576 if ( $bibitemno == 0 ) {
1578 # warn "need to add new biblioitem so copy last one and make minor changes";
1581 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1583 $sth->execute( $data->{'biblionumber'} );
1584 my $biblioitem = $sth->fetchrow_hashref;
1585 $biblioitem->{'volumedate'} =
1586 format_date_in_iso( $data->{planneddate} );
1587 $biblioitem->{'volumeddesc'} =
1588 $data->{serialseq} . ' ('
1589 . format_date( $data->{'planneddate'} ) . ')';
1590 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1592 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1593 # so I comment it, we can speak of it when you want
1594 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1595 # if ( $info->{barcode} )
1596 # { # only make biblioitem if we are going to make item also
1597 # $bibitemno = newbiblioitem($biblioitem);
1602 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1603 if ( $info->{barcode} ) {
1605 my $exists = itemdata( $info->{'barcode'} );
1606 push @errors, "barcode_not_unique" if ($exists);
1608 my $marcrecord = MARC::Record->new();
1609 my ( $tag, $subfield ) =
1610 GetMarcFromKohaField( "items.barcode", $fwk );
1612 MARC::Field->new( "$tag", '', '',
1613 "$subfield" => $info->{barcode} );
1614 $marcrecord->insert_fields_ordered($newField);
1615 if ( $info->{branch} ) {
1616 my ( $tag, $subfield ) =
1617 GetMarcFromKohaField( "items.homebranch",
1620 #warn "items.homebranch : $tag , $subfield";
1621 if ( $marcrecord->field($tag) ) {
1622 $marcrecord->field($tag)
1623 ->add_subfields( "$subfield" => $info->{branch} );
1627 MARC::Field->new( "$tag", '', '',
1628 "$subfield" => $info->{branch} );
1629 $marcrecord->insert_fields_ordered($newField);
1631 ( $tag, $subfield ) =
1632 GetMarcFromKohaField( "items.holdingbranch",
1635 #warn "items.holdingbranch : $tag , $subfield";
1636 if ( $marcrecord->field($tag) ) {
1637 $marcrecord->field($tag)
1638 ->add_subfields( "$subfield" => $info->{branch} );
1642 MARC::Field->new( "$tag", '', '',
1643 "$subfield" => $info->{branch} );
1644 $marcrecord->insert_fields_ordered($newField);
1647 if ( $info->{itemcallnumber} ) {
1648 my ( $tag, $subfield ) =
1649 GetMarcFromKohaField( "items.itemcallnumber",
1652 #warn "items.itemcallnumber : $tag , $subfield";
1653 if ( $marcrecord->field($tag) ) {
1654 $marcrecord->field($tag)
1655 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1659 MARC::Field->new( "$tag", '', '',
1660 "$subfield" => $info->{itemcallnumber} );
1661 $marcrecord->insert_fields_ordered($newField);
1664 if ( $info->{notes} ) {
1665 my ( $tag, $subfield ) =
1666 GetMarcFromKohaField( "items.itemnotes", $fwk );
1668 # warn "items.itemnotes : $tag , $subfield";
1669 if ( $marcrecord->field($tag) ) {
1670 $marcrecord->field($tag)
1671 ->add_subfields( "$subfield" => $info->{notes} );
1675 MARC::Field->new( "$tag", '', '',
1676 "$subfield" => $info->{notes} );
1677 $marcrecord->insert_fields_ordered($newField);
1680 if ( $info->{location} ) {
1681 my ( $tag, $subfield ) =
1682 GetMarcFromKohaField( "items.location", $fwk );
1684 # warn "items.location : $tag , $subfield";
1685 if ( $marcrecord->field($tag) ) {
1686 $marcrecord->field($tag)
1687 ->add_subfields( "$subfield" => $info->{location} );
1691 MARC::Field->new( "$tag", '', '',
1692 "$subfield" => $info->{location} );
1693 $marcrecord->insert_fields_ordered($newField);
1696 if ( $info->{status} ) {
1697 my ( $tag, $subfield ) =
1698 GetMarcFromKohaField( "items.notforloan",
1701 # warn "items.notforloan : $tag , $subfield";
1702 if ( $marcrecord->field($tag) ) {
1703 $marcrecord->field($tag)
1704 ->add_subfields( "$subfield" => $info->{status} );
1708 MARC::Field->new( "$tag", '', '',
1709 "$subfield" => $info->{status} );
1710 $marcrecord->insert_fields_ordered($newField);
1713 if ( C4::Context->preference("RoutingSerials") ) {
1714 my ( $tag, $subfield ) =
1715 GetMarcFromKohaField( "items.dateaccessioned",
1717 if ( $marcrecord->field($tag) ) {
1718 $marcrecord->field($tag)
1719 ->add_subfields( "$subfield" => $now );
1723 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1724 $marcrecord->insert_fields_ordered($newField);
1727 AddItem( $marcrecord, $data->{'biblionumber'} );
1730 return ( 0, @errors );
1734 =head2 HasSubscriptionExpired
1738 1 or 0 = HasSubscriptionExpired($subscriptionid)
1740 the subscription has expired when the next issue to arrive is out of subscription limit.
1743 1 if true, 0 if false.
1749 sub HasSubscriptionExpired {
1750 my ($subscriptionid) = @_;
1751 my $dbh = C4::Context->dbh;
1752 my $subscription = GetSubscription($subscriptionid);
1753 if ($subscription->{periodicity}>0){
1754 my $expirationdate = GetExpirationDate($subscriptionid);
1756 SELECT max(planneddate)
1758 WHERE subscriptionid=?
1760 my $sth = $dbh->prepare($query);
1761 $sth->execute($subscriptionid);
1762 my ($res) = $sth->fetchrow ;
1763 my @res=split (/-/,$res);
1764 # warn "date expiration :$expirationdate";
1765 my @endofsubscriptiondate=split(/-/,$expirationdate);
1766 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1767 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1771 if ($subscription->{'numberlength'}){
1772 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1773 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1782 =head2 SetDistributedto
1786 SetDistributedto($distributedto,$subscriptionid);
1787 This function update the value of distributedto for a subscription given on input arg.
1793 sub SetDistributedto {
1794 my ( $distributedto, $subscriptionid ) = @_;
1795 my $dbh = C4::Context->dbh;
1799 WHERE subscriptionid=?
1801 my $sth = $dbh->prepare($query);
1802 $sth->execute( $distributedto, $subscriptionid );
1805 =head2 DelSubscription
1809 DelSubscription($subscriptionid)
1810 this function delete the subscription which has $subscriptionid as id.
1816 sub DelSubscription {
1817 my ($subscriptionid) = @_;
1818 my $dbh = C4::Context->dbh;
1819 $subscriptionid = $dbh->quote($subscriptionid);
1820 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1822 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1823 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1825 &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1826 if C4::Context->preference("SubscriptionLog");
1833 DelIssue($serialseq,$subscriptionid)
1834 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1841 my ( $serialseq, $subscriptionid ) = @_;
1842 my $dbh = C4::Context->dbh;
1846 AND subscriptionid= ?
1848 my $mainsth = $dbh->prepare($query);
1849 $mainsth->execute( $serialseq, $subscriptionid );
1851 #Delete element from subscription history
1852 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1853 my $sth = $dbh->prepare($query);
1854 $sth->execute($subscriptionid);
1855 my $val = $sth->fetchrow_hashref;
1856 unless ( $val->{manualhistory} ) {
1858 SELECT * FROM subscriptionhistory
1859 WHERE subscriptionid= ?
1861 my $sth = $dbh->prepare($query);
1862 $sth->execute($subscriptionid);
1863 my $data = $sth->fetchrow_hashref;
1864 $data->{'missinglist'} =~ s/$serialseq//;
1865 $data->{'recievedlist'} =~ s/$serialseq//;
1866 my $strsth = "UPDATE subscriptionhistory SET "
1868 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1869 . " WHERE subscriptionid=?";
1870 $sth = $dbh->prepare($strsth);
1871 $sth->execute($subscriptionid);
1873 ### TODO Add itemdeletion. Should be in a pref ?
1875 return $mainsth->rows;
1878 =head2 GetLateOrMissingIssues
1882 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1884 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1887 a count of the number of missing issues
1888 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1889 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1895 sub GetLateOrMissingIssues {
1896 my ( $supplierid, $serialid,$order ) = @_;
1897 my $dbh = C4::Context->dbh;
1901 $byserial = "and serialid = " . $serialid;
1909 $sth = $dbh->prepare(
1918 serial.subscriptionid,
1921 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1922 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
1923 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1924 WHERE subscription.subscriptionid = serial.subscriptionid
1925 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1926 AND subscription.aqbooksellerid=$supplierid
1932 $sth = $dbh->prepare(
1941 serial.subscriptionid,
1944 LEFT JOIN subscription
1945 ON serial.subscriptionid=subscription.subscriptionid
1947 ON serial.biblionumber=biblio.biblionumber
1948 LEFT JOIN aqbooksellers
1949 ON subscription.aqbooksellerid = aqbooksellers.id
1951 subscription.subscriptionid = serial.subscriptionid
1952 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1953 AND biblio.biblionumber = subscription.biblionumber
1963 while ( my $line = $sth->fetchrow_hashref ) {
1964 $odd++ unless $line->{title} eq $last_title;
1965 $last_title = $line->{title} if ( $line->{title} );
1966 $line->{planneddate} = format_date( $line->{planneddate} );
1967 $line->{claimdate} = format_date( $line->{claimdate} );
1968 $line->{"status".$line->{status}} = 1;
1969 $line->{'odd'} = 1 if $odd % 2;
1971 push @issuelist, $line;
1973 return $count, @issuelist;
1976 =head2 removeMissingIssue
1980 removeMissingIssue($subscriptionid)
1982 this function removes an issue from being part of the missing string in
1983 subscriptionlist.missinglist column
1985 called when a missing issue is found from the serials-recieve.pl file
1991 sub removeMissingIssue {
1992 my ( $sequence, $subscriptionid ) = @_;
1993 my $dbh = C4::Context->dbh;
1996 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1997 $sth->execute($subscriptionid);
1998 my $data = $sth->fetchrow_hashref;
1999 my $missinglist = $data->{'missinglist'};
2000 my $missinglistbefore = $missinglist;
2002 # warn $missinglist." before";
2003 $missinglist =~ s/($sequence)//;
2005 # warn $missinglist." after";
2006 if ( $missinglist ne $missinglistbefore ) {
2007 $missinglist =~ s/\|\s\|/\|/g;
2008 $missinglist =~ s/^\| //g;
2009 $missinglist =~ s/\|$//g;
2010 my $sth2 = $dbh->prepare(
2011 "UPDATE subscriptionhistory
2013 WHERE subscriptionid = ?"
2015 $sth2->execute( $missinglist, $subscriptionid );
2023 &updateClaim($serialid)
2025 this function updates the time when a claim is issued for late/missing items
2027 called from claims.pl file
2034 my ($serialid) = @_;
2035 my $dbh = C4::Context->dbh;
2036 my $sth = $dbh->prepare(
2037 "UPDATE serial SET claimdate = now()
2041 $sth->execute($serialid);
2044 =head2 getsupplierbyserialid
2048 ($result) = &getsupplierbyserialid($serialid)
2050 this function is used to find the supplier id given a serial id
2053 hashref containing serialid, subscriptionid, and aqbooksellerid
2059 sub getsupplierbyserialid {
2060 my ($serialid) = @_;
2061 my $dbh = C4::Context->dbh;
2062 my $sth = $dbh->prepare(
2063 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2064 FROM serial, subscription
2065 WHERE serial.subscriptionid = subscription.subscriptionid
2069 $sth->execute($serialid);
2070 my $line = $sth->fetchrow_hashref;
2071 my $result = $line->{'aqbooksellerid'};
2075 =head2 check_routing
2079 ($result) = &check_routing($subscriptionid)
2081 this function checks to see if a serial has a routing list and returns the count of routingid
2082 used to show either an 'add' or 'edit' link
2088 my ($subscriptionid) = @_;
2089 my $dbh = C4::Context->dbh;
2090 my $sth = $dbh->prepare(
2091 "SELECT count(routingid) routingids FROM subscriptionroutinglist, subscription
2092 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2093 AND subscription.subscriptionid = ? ORDER BY ranking ASC
2096 $sth->execute($subscriptionid);
2097 my $line = $sth->fetchrow_hashref;
2098 my $result = $line->{'routingids'};
2102 =head2 addroutingmember
2106 &addroutingmember($borrowernumber,$subscriptionid)
2108 this function takes a borrowernumber and subscriptionid and add the member to the
2109 routing list for that serial subscription and gives them a rank on the list
2110 of either 1 or highest current rank + 1
2116 sub addroutingmember {
2117 my ( $borrowernumber, $subscriptionid ) = @_;
2119 my $dbh = C4::Context->dbh;
2122 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2124 $sth->execute($subscriptionid);
2125 while ( my $line = $sth->fetchrow_hashref ) {
2126 if ( $line->{'rank'} > 0 ) {
2127 $rank = $line->{'rank'} + 1;
2135 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2137 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2140 =head2 reorder_members
2144 &reorder_members($subscriptionid,$routingid,$rank)
2146 this function is used to reorder the routing list
2148 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2149 - it gets all members on list puts their routingid's into an array
2150 - removes the one in the array that is $routingid
2151 - then reinjects $routingid at point indicated by $rank
2152 - then update the database with the routingids in the new order
2158 sub reorder_members {
2159 my ( $subscriptionid, $routingid, $rank ) = @_;
2160 my $dbh = C4::Context->dbh;
2163 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2165 $sth->execute($subscriptionid);
2167 while ( my $line = $sth->fetchrow_hashref ) {
2168 push( @result, $line->{'routingid'} );
2171 # To find the matching index
2173 my $key = -1; # to allow for 0 being a valid response
2174 for ( $i = 0 ; $i < @result ; $i++ ) {
2175 if ( $routingid == $result[$i] ) {
2176 $key = $i; # save the index
2181 # if index exists in array then move it to new position
2182 if ( $key > -1 && $rank > 0 ) {
2183 my $new_rank = $rank -
2184 1; # $new_rank is what you want the new index to be in the array
2185 my $moving_item = splice( @result, $key, 1 );
2186 splice( @result, $new_rank, 0, $moving_item );
2188 for ( my $j = 0 ; $j < @result ; $j++ ) {
2190 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2192 . "' WHERE routingid = '"
2199 =head2 delroutingmember
2203 &delroutingmember($routingid,$subscriptionid)
2205 this function either deletes one member from routing list if $routingid exists otherwise
2206 deletes all members from the routing list
2212 sub delroutingmember {
2214 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2215 my ( $routingid, $subscriptionid ) = @_;
2216 my $dbh = C4::Context->dbh;
2220 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2221 $sth->execute($routingid);
2222 reorder_members( $subscriptionid, $routingid );
2227 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2228 $sth->execute($subscriptionid);
2232 =head2 getroutinglist
2236 ($count,@routinglist) = &getroutinglist($subscriptionid)
2238 this gets the info from the subscriptionroutinglist for $subscriptionid
2241 a count of the number of members on routinglist
2242 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2243 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2249 sub getroutinglist {
2250 my ($subscriptionid) = @_;
2251 my $dbh = C4::Context->dbh;
2252 my $sth = $dbh->prepare(
2253 "SELECT routingid, borrowernumber,
2254 ranking, biblionumber FROM subscriptionroutinglist, subscription
2255 WHERE subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2256 AND subscription.subscriptionid = ? ORDER BY ranking ASC
2259 $sth->execute($subscriptionid);
2262 while ( my $line = $sth->fetchrow_hashref ) {
2264 push( @routinglist, $line );
2266 return ( $count, @routinglist );
2269 =head2 countissuesfrom
2273 $result = &countissuesfrom($subscriptionid,$startdate)
2280 sub countissuesfrom {
2281 my ($subscriptionid,$startdate) = @_;
2282 my $dbh = C4::Context->dbh;
2286 WHERE subscriptionid=?
2287 AND serial.publisheddate>?
2289 my $sth=$dbh->prepare($query);
2290 $sth->execute($subscriptionid, $startdate);
2291 my ($countreceived)=$sth->fetchrow;
2292 return $countreceived;
2295 =head2 abouttoexpire
2299 $result = &abouttoexpire($subscriptionid)
2301 this function alerts you to the penultimate issue for a serial subscription
2303 returns 1 - if this is the penultimate issue
2311 my ($subscriptionid) = @_;
2312 my $dbh = C4::Context->dbh;
2313 my $subscription = GetSubscription($subscriptionid);
2314 my $per = $subscription->{'periodicity'};
2316 my $expirationdate = GetExpirationDate($subscriptionid);
2319 "select max(planneddate) from serial where subscriptionid=?");
2320 $sth->execute($subscriptionid);
2321 my ($res) = $sth->fetchrow ;
2322 warn "date expiration : ".$expirationdate." date courante ".$res;
2323 my @res=split /-/,$res;
2324 my @endofsubscriptiondate=split/-/,$expirationdate;
2325 my $per = $subscription->{'periodicity'};
2327 if ( $per == 1 ) {$x=7;}
2328 if ( $per == 2 ) {$x=7; }
2329 if ( $per == 3 ) {$x=14;}
2330 if ( $per == 4 ) { $x = 21; }
2331 if ( $per == 5 ) { $x = 31; }
2332 if ( $per == 6 ) { $x = 62; }
2333 if ( $per == 7 || $per == 8 ) { $x = 93; }
2334 if ( $per == 9 ) { $x = 190; }
2335 if ( $per == 10 ) { $x = 365; }
2336 if ( $per == 11 ) { $x = 730; }
2337 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2338 - (3 * $x)) if (@endofsubscriptiondate);
2339 # warn "DATE BEFORE END: $datebeforeend";
2340 return 1 if ( @res &&
2342 Delta_Days($res[0],$res[1],$res[2],
2343 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2344 (@endofsubscriptiondate &&
2345 Delta_Days($res[0],$res[1],$res[2],
2346 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2348 } elsif ($subscription->{numberlength}>0) {
2349 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2353 =head2 old_newsubscription
2357 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2358 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2359 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2360 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2361 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2362 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2364 this function is similar to the NewSubscription subroutine but has a few different
2366 $firstacquidate - date of first serial issue to arrive
2367 $irregularity - the issues not expected separated by a '|'
2368 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2369 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2370 subscription-add.tmpl file
2371 $callnumber - display the callnumber of the serial
2372 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2375 the $subscriptionid number of the new subscription
2381 sub old_newsubscription {
2383 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2384 $biblionumber, $startdate, $periodicity, $firstacquidate,
2385 $dow, $irregularity, $numberpattern, $numberlength,
2386 $weeklength, $monthlength, $add1, $every1,
2387 $whenmorethan1, $setto1, $lastvalue1, $add2,
2388 $every2, $whenmorethan2, $setto2, $lastvalue2,
2389 $add3, $every3, $whenmorethan3, $setto3,
2390 $lastvalue3, $numberingmethod, $status, $callnumber,
2393 my $dbh = C4::Context->dbh;
2396 my $sth = $dbh->prepare(
2397 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2398 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2399 add1,every1,whenmorethan1,setto1,lastvalue1,
2400 add2,every2,whenmorethan2,setto2,lastvalue2,
2401 add3,every3,whenmorethan3,setto3,lastvalue3,
2402 numberingmethod, status, callnumber, notes, hemisphere) values
2403 (?,?,?,?,?,?,?,?,?,?,?,
2404 ?,?,?,?,?,?,?,?,?,?,?,
2405 ?,?,?,?,?,?,?,?,?,?,?,?)"
2408 $auser, $aqbooksellerid,
2410 $biblionumber, format_date_in_iso($startdate),
2411 $periodicity, format_date_in_iso($firstacquidate),
2412 $dow, $irregularity,
2413 $numberpattern, $numberlength,
2414 $weeklength, $monthlength,
2416 $whenmorethan1, $setto1,
2418 $every2, $whenmorethan2,
2419 $setto2, $lastvalue2,
2421 $whenmorethan3, $setto3,
2422 $lastvalue3, $numberingmethod,
2423 $status, $callnumber,
2427 #then create the 1st waited number
2428 my $subscriptionid = $dbh->{'mysql_insertid'};
2429 my $enddate = GetExpirationDate($subscriptionid);
2433 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2436 $biblionumber, $subscriptionid,
2437 format_date_in_iso($startdate),
2438 format_date_in_iso($enddate),
2442 # reread subscription to get a hash (for calculation of the 1st issue number)
2444 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2445 $sth->execute($subscriptionid);
2446 my $val = $sth->fetchrow_hashref;
2448 # calculate issue number
2449 my $serialseq = GetSeq($val);
2452 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2454 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2455 1, format_date_in_iso($startdate) );
2456 return $subscriptionid;
2459 =head2 old_modsubscription
2463 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2464 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2465 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2466 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2467 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2468 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2470 this function is similar to the ModSubscription subroutine but has a few different
2472 $firstacquidate - date of first serial issue to arrive
2473 $irregularity - the issues not expected separated by a '|'
2474 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2475 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2476 subscription-add.tmpl file
2477 $callnumber - display the callnumber of the serial
2478 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2484 sub old_modsubscription {
2486 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2487 $startdate, $periodicity, $firstacquidate, $dow,
2488 $irregularity, $numberpattern, $numberlength, $weeklength,
2489 $monthlength, $add1, $every1, $whenmorethan1,
2490 $setto1, $lastvalue1, $innerloop1, $add2,
2491 $every2, $whenmorethan2, $setto2, $lastvalue2,
2492 $innerloop2, $add3, $every3, $whenmorethan3,
2493 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2494 $status, $biblionumber, $callnumber, $notes,
2495 $hemisphere, $subscriptionid
2497 my $dbh = C4::Context->dbh;
2498 my $sth = $dbh->prepare(
2499 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2500 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2501 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2502 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2503 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2504 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2507 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2508 $startdate, $periodicity, $firstacquidate, $dow,
2509 $irregularity, $numberpattern, $numberlength, $weeklength,
2510 $monthlength, $add1, $every1, $whenmorethan1,
2511 $setto1, $lastvalue1, $innerloop1, $add2,
2512 $every2, $whenmorethan2, $setto2, $lastvalue2,
2513 $innerloop2, $add3, $every3, $whenmorethan3,
2514 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2515 $status, $biblionumber, $callnumber, $notes,
2516 $hemisphere, $subscriptionid
2521 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2522 $sth->execute($subscriptionid);
2523 my $val = $sth->fetchrow_hashref;
2525 # calculate issue number
2526 my $serialseq = Get_Seq($val);
2528 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2529 $sth->execute( $serialseq, $subscriptionid );
2531 my $enddate = subscriptionexpirationdate($subscriptionid);
2532 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2533 $sth->execute( format_date_in_iso($enddate) );
2536 =head2 old_getserials
2540 ($totalissues,@serials) = &old_getserials($subscriptionid)
2542 this function get a hashref of serials and the total count of them
2545 $totalissues - number of serial lines
2546 the serials into a table. Each line of this table containts a ref to a hash which it containts
2547 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2553 sub old_getserials {
2554 my ($subscriptionid) = @_;
2555 my $dbh = C4::Context->dbh;
2557 # status = 2 is "arrived"
2560 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2562 $sth->execute($subscriptionid);
2565 while ( my $line = $sth->fetchrow_hashref ) {
2566 $line->{ "status" . $line->{status} } =
2567 1; # fills a "statusX" value, used for template status select list
2568 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2569 $line->{"num"} = $num;
2571 push @serials, $line;
2573 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2574 $sth->execute($subscriptionid);
2575 my ($totalissues) = $sth->fetchrow;
2576 return ( $totalissues, @serials );
2581 ($resultdate) = &GetNextDate($planneddate,$subscription)
2583 this function is an extension of GetNextDate which allows for checking for irregularity
2585 it takes the planneddate and will return the next issue's date and will skip dates if there
2586 exists an irregularity
2587 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2588 skipped then the returned date will be 2007-05-10
2591 $resultdate - then next date in the sequence
2593 Return 0 if periodicity==0
2596 sub in_array { # used in next sub down
2597 my ($val,@elements) = @_;
2598 foreach my $elem(@elements) {
2606 sub GetNextDate(@) {
2607 my ( $planneddate, $subscription ) = @_;
2608 my @irreg = split( /\,/, $subscription->{irregularity} );
2610 #date supposed to be in ISO.
2612 my ( $year, $month, $day ) = split(/-/, $planneddate);
2613 $month=1 unless ($month);
2614 $day=1 unless ($day);
2617 # warn "DOW $dayofweek";
2618 if ( $subscription->{periodicity} == 0 ) {
2621 if ( $subscription->{periodicity} == 1 ) {
2622 my $dayofweek = Day_of_Week( $year,$month, $day );
2623 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2624 $dayofweek = 0 if ( $dayofweek == 7 );
2625 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2626 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2630 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2632 if ( $subscription->{periodicity} == 2 ) {
2633 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2634 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2635 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2636 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2637 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2640 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2642 if ( $subscription->{periodicity} == 3 ) {
2643 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2644 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2645 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2646 ### BUGFIX was previously +1 ^
2647 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2648 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2651 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2653 if ( $subscription->{periodicity} == 4 ) {
2654 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2655 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2656 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2657 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2658 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2661 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2663 my $tmpmonth=$month;
2664 if ( $subscription->{periodicity} == 5 ) {
2665 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2666 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2667 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2668 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2671 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2673 if ( $subscription->{periodicity} == 6 ) {
2674 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2675 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2676 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2677 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2680 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2682 if ( $subscription->{periodicity} == 7 ) {
2683 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2684 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2685 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2686 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2689 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2691 if ( $subscription->{periodicity} == 8 ) {
2692 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2693 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2694 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2695 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2698 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2700 if ( $subscription->{periodicity} == 9 ) {
2701 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2702 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2703 ### BUFIX Seems to need more Than One ?
2704 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2705 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2708 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2710 if ( $subscription->{periodicity} == 10 ) {
2711 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2713 if ( $subscription->{periodicity} == 11 ) {
2714 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2716 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2717 # warn "dateNEXTSEQ : ".$resultdate;
2718 return "$resultdate";
2723 $item = &itemdata($barcode);
2725 Looks up the item with the given barcode, and returns a
2726 reference-to-hash containing information about that item. The keys of
2727 the hash are the fields from the C<items> and C<biblioitems> tables in
2735 my $dbh = C4::Context->dbh;
2736 my $sth = $dbh->prepare(
2737 "Select * from items,biblioitems where barcode=?
2738 and items.biblioitemnumber=biblioitems.biblioitemnumber"
2740 $sth->execute($barcode);
2741 my $data = $sth->fetchrow_hashref;
2746 END { } # module clean-up code here (global destructor)
2754 Koha Developement team <info@koha.org>