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
144 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
145 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
146 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
147 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
148 AND subscription.aqbooksellerid=$supplierid
151 $sth = $dbh->prepare($query);
155 SELECT name,title,planneddate,serialseq,serial.subscriptionid
157 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
158 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
159 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
160 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
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( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
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);
1435 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1436 WHERE 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 ( $dataissue) = @_;
1830 my $dbh = C4::Context->dbh;
1831 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1836 AND subscriptionid= ?
1838 my $mainsth = $dbh->prepare($query);
1839 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1841 #Delete element from subscription history
1842 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1843 my $sth = $dbh->prepare($query);
1844 $sth->execute($dataissue->{'subscriptionid'});
1845 my $val = $sth->fetchrow_hashref;
1846 unless ( $val->{manualhistory} ) {
1848 SELECT * FROM subscriptionhistory
1849 WHERE subscriptionid= ?
1851 my $sth = $dbh->prepare($query);
1852 $sth->execute($dataissue->{'subscriptionid'});
1853 my $data = $sth->fetchrow_hashref;
1854 my $serialseq= $dataissue->{'serialseq'};
1855 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1856 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1857 my $strsth = "UPDATE subscriptionhistory SET "
1859 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1860 . " WHERE subscriptionid=?";
1861 $sth = $dbh->prepare($strsth);
1862 $sth->execute($dataissue->{'subscriptionid'});
1865 return $mainsth->rows;
1868 =head2 GetLateOrMissingIssues
1872 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1874 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1877 a count of the number of missing issues
1878 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1879 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1885 sub GetLateOrMissingIssues {
1886 my ( $supplierid, $serialid,$order ) = @_;
1887 my $dbh = C4::Context->dbh;
1891 $byserial = "and serialid = " . $serialid;
1899 $sth = $dbh->prepare(
1908 serial.subscriptionid,
1911 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1912 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
1913 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1914 WHERE subscription.subscriptionid = serial.subscriptionid
1915 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1916 AND subscription.aqbooksellerid=$supplierid
1922 $sth = $dbh->prepare(
1931 serial.subscriptionid,
1934 LEFT JOIN subscription
1935 ON serial.subscriptionid=subscription.subscriptionid
1937 ON serial.biblionumber=biblio.biblionumber
1938 LEFT JOIN aqbooksellers
1939 ON subscription.aqbooksellerid = aqbooksellers.id
1941 subscription.subscriptionid = serial.subscriptionid
1942 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1943 AND biblio.biblionumber = subscription.biblionumber
1953 while ( my $line = $sth->fetchrow_hashref ) {
1954 $odd++ unless $line->{title} eq $last_title;
1955 $last_title = $line->{title} if ( $line->{title} );
1956 $line->{planneddate} = format_date( $line->{planneddate} );
1957 $line->{claimdate} = format_date( $line->{claimdate} );
1958 $line->{"status".$line->{status}} = 1;
1959 $line->{'odd'} = 1 if $odd % 2;
1961 push @issuelist, $line;
1963 return $count, @issuelist;
1966 =head2 removeMissingIssue
1970 removeMissingIssue($subscriptionid)
1972 this function removes an issue from being part of the missing string in
1973 subscriptionlist.missinglist column
1975 called when a missing issue is found from the serials-recieve.pl file
1981 sub removeMissingIssue {
1982 my ( $sequence, $subscriptionid ) = @_;
1983 my $dbh = C4::Context->dbh;
1986 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1987 $sth->execute($subscriptionid);
1988 my $data = $sth->fetchrow_hashref;
1989 my $missinglist = $data->{'missinglist'};
1990 my $missinglistbefore = $missinglist;
1992 # warn $missinglist." before";
1993 $missinglist =~ s/($sequence)//;
1995 # warn $missinglist." after";
1996 if ( $missinglist ne $missinglistbefore ) {
1997 $missinglist =~ s/\|\s\|/\|/g;
1998 $missinglist =~ s/^\| //g;
1999 $missinglist =~ s/\|$//g;
2000 my $sth2 = $dbh->prepare(
2001 "UPDATE subscriptionhistory
2003 WHERE subscriptionid = ?"
2005 $sth2->execute( $missinglist, $subscriptionid );
2013 &updateClaim($serialid)
2015 this function updates the time when a claim is issued for late/missing items
2017 called from claims.pl file
2024 my ($serialid) = @_;
2025 my $dbh = C4::Context->dbh;
2026 my $sth = $dbh->prepare(
2027 "UPDATE serial SET claimdate = now()
2031 $sth->execute($serialid);
2034 =head2 getsupplierbyserialid
2038 ($result) = &getsupplierbyserialid($serialid)
2040 this function is used to find the supplier id given a serial id
2043 hashref containing serialid, subscriptionid, and aqbooksellerid
2049 sub getsupplierbyserialid {
2050 my ($serialid) = @_;
2051 my $dbh = C4::Context->dbh;
2052 my $sth = $dbh->prepare(
2053 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2055 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2059 $sth->execute($serialid);
2060 my $line = $sth->fetchrow_hashref;
2061 my $result = $line->{'aqbooksellerid'};
2065 =head2 check_routing
2069 ($result) = &check_routing($subscriptionid)
2071 this function checks to see if a serial has a routing list and returns the count of routingid
2072 used to show either an 'add' or 'edit' link
2078 my ($subscriptionid) = @_;
2079 my $dbh = C4::Context->dbh;
2080 my $sth = $dbh->prepare(
2081 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2082 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2083 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2086 $sth->execute($subscriptionid);
2087 my $line = $sth->fetchrow_hashref;
2088 my $result = $line->{'routingids'};
2092 =head2 addroutingmember
2096 &addroutingmember($borrowernumber,$subscriptionid)
2098 this function takes a borrowernumber and subscriptionid and add the member to the
2099 routing list for that serial subscription and gives them a rank on the list
2100 of either 1 or highest current rank + 1
2106 sub addroutingmember {
2107 my ( $borrowernumber, $subscriptionid ) = @_;
2109 my $dbh = C4::Context->dbh;
2112 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2114 $sth->execute($subscriptionid);
2115 while ( my $line = $sth->fetchrow_hashref ) {
2116 if ( $line->{'rank'} > 0 ) {
2117 $rank = $line->{'rank'} + 1;
2125 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2127 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2130 =head2 reorder_members
2134 &reorder_members($subscriptionid,$routingid,$rank)
2136 this function is used to reorder the routing list
2138 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2139 - it gets all members on list puts their routingid's into an array
2140 - removes the one in the array that is $routingid
2141 - then reinjects $routingid at point indicated by $rank
2142 - then update the database with the routingids in the new order
2148 sub reorder_members {
2149 my ( $subscriptionid, $routingid, $rank ) = @_;
2150 my $dbh = C4::Context->dbh;
2153 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2155 $sth->execute($subscriptionid);
2157 while ( my $line = $sth->fetchrow_hashref ) {
2158 push( @result, $line->{'routingid'} );
2161 # To find the matching index
2163 my $key = -1; # to allow for 0 being a valid response
2164 for ( $i = 0 ; $i < @result ; $i++ ) {
2165 if ( $routingid == $result[$i] ) {
2166 $key = $i; # save the index
2171 # if index exists in array then move it to new position
2172 if ( $key > -1 && $rank > 0 ) {
2173 my $new_rank = $rank -
2174 1; # $new_rank is what you want the new index to be in the array
2175 my $moving_item = splice( @result, $key, 1 );
2176 splice( @result, $new_rank, 0, $moving_item );
2178 for ( my $j = 0 ; $j < @result ; $j++ ) {
2180 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2182 . "' WHERE routingid = '"
2189 =head2 delroutingmember
2193 &delroutingmember($routingid,$subscriptionid)
2195 this function either deletes one member from routing list if $routingid exists otherwise
2196 deletes all members from the routing list
2202 sub delroutingmember {
2204 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2205 my ( $routingid, $subscriptionid ) = @_;
2206 my $dbh = C4::Context->dbh;
2210 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2211 $sth->execute($routingid);
2212 reorder_members( $subscriptionid, $routingid );
2217 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2218 $sth->execute($subscriptionid);
2222 =head2 getroutinglist
2226 ($count,@routinglist) = &getroutinglist($subscriptionid)
2228 this gets the info from the subscriptionroutinglist for $subscriptionid
2231 a count of the number of members on routinglist
2232 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2233 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2239 sub getroutinglist {
2240 my ($subscriptionid) = @_;
2241 my $dbh = C4::Context->dbh;
2242 my $sth = $dbh->prepare(
2243 "SELECT routingid, borrowernumber,
2244 ranking, biblionumber
2246 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2247 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2250 $sth->execute($subscriptionid);
2253 while ( my $line = $sth->fetchrow_hashref ) {
2255 push( @routinglist, $line );
2257 return ( $count, @routinglist );
2260 =head2 countissuesfrom
2264 $result = &countissuesfrom($subscriptionid,$startdate)
2271 sub countissuesfrom {
2272 my ($subscriptionid,$startdate) = @_;
2273 my $dbh = C4::Context->dbh;
2277 WHERE subscriptionid=?
2278 AND serial.publisheddate>?
2280 my $sth=$dbh->prepare($query);
2281 $sth->execute($subscriptionid, $startdate);
2282 my ($countreceived)=$sth->fetchrow;
2283 return $countreceived;
2286 =head2 abouttoexpire
2290 $result = &abouttoexpire($subscriptionid)
2292 this function alerts you to the penultimate issue for a serial subscription
2294 returns 1 - if this is the penultimate issue
2302 my ($subscriptionid) = @_;
2303 my $dbh = C4::Context->dbh;
2304 my $subscription = GetSubscription($subscriptionid);
2305 my $per = $subscription->{'periodicity'};
2307 my $expirationdate = GetExpirationDate($subscriptionid);
2310 "select max(planneddate) from serial where subscriptionid=?");
2311 $sth->execute($subscriptionid);
2312 my ($res) = $sth->fetchrow ;
2313 # warn "date expiration : ".$expirationdate." date courante ".$res;
2314 my @res=split /-/,$res;
2315 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2316 my @endofsubscriptiondate=split/-/,$expirationdate;
2317 my $per = $subscription->{'periodicity'};
2319 if ( $per == 1 ) {$x=7;}
2320 if ( $per == 2 ) {$x=7; }
2321 if ( $per == 3 ) {$x=14;}
2322 if ( $per == 4 ) { $x = 21; }
2323 if ( $per == 5 ) { $x = 31; }
2324 if ( $per == 6 ) { $x = 62; }
2325 if ( $per == 7 || $per == 8 ) { $x = 93; }
2326 if ( $per == 9 ) { $x = 190; }
2327 if ( $per == 10 ) { $x = 365; }
2328 if ( $per == 11 ) { $x = 730; }
2329 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2330 - (3 * $x)) if (@endofsubscriptiondate);
2331 # warn "DATE BEFORE END: $datebeforeend";
2332 return 1 if ( @res &&
2334 Delta_Days($res[0],$res[1],$res[2],
2335 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2336 (@endofsubscriptiondate &&
2337 Delta_Days($res[0],$res[1],$res[2],
2338 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2340 } elsif ($subscription->{numberlength}>0) {
2341 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2345 =head2 old_newsubscription
2349 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2350 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2351 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2352 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2353 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2354 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2356 this function is similar to the NewSubscription subroutine but has a few different
2358 $firstacquidate - date of first serial issue to arrive
2359 $irregularity - the issues not expected separated by a '|'
2360 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2361 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2362 subscription-add.tmpl file
2363 $callnumber - display the callnumber of the serial
2364 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2367 the $subscriptionid number of the new subscription
2373 sub old_newsubscription {
2375 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2376 $biblionumber, $startdate, $periodicity, $firstacquidate,
2377 $dow, $irregularity, $numberpattern, $numberlength,
2378 $weeklength, $monthlength, $add1, $every1,
2379 $whenmorethan1, $setto1, $lastvalue1, $add2,
2380 $every2, $whenmorethan2, $setto2, $lastvalue2,
2381 $add3, $every3, $whenmorethan3, $setto3,
2382 $lastvalue3, $numberingmethod, $status, $callnumber,
2385 my $dbh = C4::Context->dbh;
2388 my $sth = $dbh->prepare(
2389 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2390 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2391 add1,every1,whenmorethan1,setto1,lastvalue1,
2392 add2,every2,whenmorethan2,setto2,lastvalue2,
2393 add3,every3,whenmorethan3,setto3,lastvalue3,
2394 numberingmethod, status, callnumber, notes, hemisphere) values
2395 (?,?,?,?,?,?,?,?,?,?,?,
2396 ?,?,?,?,?,?,?,?,?,?,?,
2397 ?,?,?,?,?,?,?,?,?,?,?,?)"
2400 $auser, $aqbooksellerid,
2402 $biblionumber, format_date_in_iso($startdate),
2403 $periodicity, format_date_in_iso($firstacquidate),
2404 $dow, $irregularity,
2405 $numberpattern, $numberlength,
2406 $weeklength, $monthlength,
2408 $whenmorethan1, $setto1,
2410 $every2, $whenmorethan2,
2411 $setto2, $lastvalue2,
2413 $whenmorethan3, $setto3,
2414 $lastvalue3, $numberingmethod,
2415 $status, $callnumber,
2419 #then create the 1st waited number
2420 my $subscriptionid = $dbh->{'mysql_insertid'};
2421 my $enddate = GetExpirationDate($subscriptionid);
2425 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2428 $biblionumber, $subscriptionid,
2429 format_date_in_iso($startdate),
2430 format_date_in_iso($enddate),
2434 # reread subscription to get a hash (for calculation of the 1st issue number)
2436 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2437 $sth->execute($subscriptionid);
2438 my $val = $sth->fetchrow_hashref;
2440 # calculate issue number
2441 my $serialseq = GetSeq($val);
2444 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2446 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2447 1, format_date_in_iso($startdate) );
2448 return $subscriptionid;
2451 =head2 old_modsubscription
2455 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2456 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2457 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2458 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2459 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2460 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2462 this function is similar to the ModSubscription subroutine but has a few different
2464 $firstacquidate - date of first serial issue to arrive
2465 $irregularity - the issues not expected separated by a '|'
2466 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2467 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2468 subscription-add.tmpl file
2469 $callnumber - display the callnumber of the serial
2470 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2476 sub old_modsubscription {
2478 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2479 $startdate, $periodicity, $firstacquidate, $dow,
2480 $irregularity, $numberpattern, $numberlength, $weeklength,
2481 $monthlength, $add1, $every1, $whenmorethan1,
2482 $setto1, $lastvalue1, $innerloop1, $add2,
2483 $every2, $whenmorethan2, $setto2, $lastvalue2,
2484 $innerloop2, $add3, $every3, $whenmorethan3,
2485 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2486 $status, $biblionumber, $callnumber, $notes,
2487 $hemisphere, $subscriptionid
2489 my $dbh = C4::Context->dbh;
2490 my $sth = $dbh->prepare(
2491 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2492 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2493 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2494 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2495 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2496 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2499 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2500 $startdate, $periodicity, $firstacquidate, $dow,
2501 $irregularity, $numberpattern, $numberlength, $weeklength,
2502 $monthlength, $add1, $every1, $whenmorethan1,
2503 $setto1, $lastvalue1, $innerloop1, $add2,
2504 $every2, $whenmorethan2, $setto2, $lastvalue2,
2505 $innerloop2, $add3, $every3, $whenmorethan3,
2506 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2507 $status, $biblionumber, $callnumber, $notes,
2508 $hemisphere, $subscriptionid
2513 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2514 $sth->execute($subscriptionid);
2515 my $val = $sth->fetchrow_hashref;
2517 # calculate issue number
2518 my $serialseq = Get_Seq($val);
2520 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2521 $sth->execute( $serialseq, $subscriptionid );
2523 my $enddate = subscriptionexpirationdate($subscriptionid);
2524 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2525 $sth->execute( format_date_in_iso($enddate) );
2528 =head2 old_getserials
2532 ($totalissues,@serials) = &old_getserials($subscriptionid)
2534 this function get a hashref of serials and the total count of them
2537 $totalissues - number of serial lines
2538 the serials into a table. Each line of this table containts a ref to a hash which it containts
2539 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2545 sub old_getserials {
2546 my ($subscriptionid) = @_;
2547 my $dbh = C4::Context->dbh;
2549 # status = 2 is "arrived"
2552 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2554 $sth->execute($subscriptionid);
2557 while ( my $line = $sth->fetchrow_hashref ) {
2558 $line->{ "status" . $line->{status} } =
2559 1; # fills a "statusX" value, used for template status select list
2560 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2561 $line->{"num"} = $num;
2563 push @serials, $line;
2565 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2566 $sth->execute($subscriptionid);
2567 my ($totalissues) = $sth->fetchrow;
2568 return ( $totalissues, @serials );
2573 ($resultdate) = &GetNextDate($planneddate,$subscription)
2575 this function is an extension of GetNextDate which allows for checking for irregularity
2577 it takes the planneddate and will return the next issue's date and will skip dates if there
2578 exists an irregularity
2579 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2580 skipped then the returned date will be 2007-05-10
2583 $resultdate - then next date in the sequence
2585 Return 0 if periodicity==0
2588 sub in_array { # used in next sub down
2589 my ($val,@elements) = @_;
2590 foreach my $elem(@elements) {
2598 sub GetNextDate(@) {
2599 my ( $planneddate, $subscription ) = @_;
2600 my @irreg = split( /\,/, $subscription->{irregularity} );
2602 #date supposed to be in ISO.
2604 my ( $year, $month, $day ) = split(/-/, $planneddate);
2605 $month=1 unless ($month);
2606 $day=1 unless ($day);
2609 # warn "DOW $dayofweek";
2610 if ( $subscription->{periodicity} == 0 ) {
2613 if ( $subscription->{periodicity} == 1 ) {
2614 my $dayofweek = Day_of_Week( $year,$month, $day );
2615 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2616 $dayofweek = 0 if ( $dayofweek == 7 );
2617 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2618 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2622 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2624 if ( $subscription->{periodicity} == 2 ) {
2625 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2626 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2627 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2628 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2629 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2632 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2634 if ( $subscription->{periodicity} == 3 ) {
2635 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2636 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2637 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2638 ### BUGFIX was previously +1 ^
2639 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2640 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2643 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2645 if ( $subscription->{periodicity} == 4 ) {
2646 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2647 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2648 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2649 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2650 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2653 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2655 my $tmpmonth=$month;
2656 if ( $subscription->{periodicity} == 5 ) {
2657 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2658 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2659 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2660 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2663 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2665 if ( $subscription->{periodicity} == 6 ) {
2666 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2667 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2668 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2669 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2672 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2674 if ( $subscription->{periodicity} == 7 ) {
2675 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2676 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2677 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2678 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2681 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2683 if ( $subscription->{periodicity} == 8 ) {
2684 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2685 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2686 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2687 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2690 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2692 if ( $subscription->{periodicity} == 9 ) {
2693 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2694 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2695 ### BUFIX Seems to need more Than One ?
2696 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2697 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2700 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2702 if ( $subscription->{periodicity} == 10 ) {
2703 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2705 if ( $subscription->{periodicity} == 11 ) {
2706 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2708 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2709 # warn "dateNEXTSEQ : ".$resultdate;
2710 return "$resultdate";
2715 $item = &itemdata($barcode);
2717 Looks up the item with the given barcode, and returns a
2718 reference-to-hash containing information about that item. The keys of
2719 the hash are the fields from the C<items> and C<biblioitems> tables in
2727 my $dbh = C4::Context->dbh;
2728 my $sth = $dbh->prepare(
2729 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2732 $sth->execute($barcode);
2733 my $data = $sth->fetchrow_hashref;
2738 END { } # module clean-up code here (global destructor)
2746 Koha Developement team <info@koha.org>