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
23 use Date::Calc qw(:all);
24 use POSIX qw(strftime);
30 use C4::Log; # logaction
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
36 # set the version for version checking
37 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
38 shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
43 C4::Serials - Give functions for serializing.
51 Give all XYZ functions
60 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
61 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
62 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
63 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
65 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
66 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
67 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
68 &GetSerialInformation &AddItem2Serial
71 &UpdateClaimdateIssues
72 &GetSuppliersWithLateIssues &getsupplierbyserialid
73 &GetDistributedTo &SetDistributedTo
74 &getroutinglist &delroutingmember &addroutingmember
76 &check_routing &updateClaim &removeMissingIssue
78 &old_newsubscription &old_modsubscription &old_getserials
81 =head2 GetSuppliersWithLateIssues
85 %supplierlist = &GetSuppliersWithLateIssues
87 this function get all suppliers with late issues.
90 the supplierlist into a hash. this hash containts id & name of the supplier
96 sub GetSuppliersWithLateIssues {
97 my $dbh = C4::Context->dbh;
99 SELECT DISTINCT id, name
101 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
102 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
103 WHERE subscription.subscriptionid = serial.subscriptionid
104 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
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
143 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
144 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
145 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
146 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
147 AND subscription.aqbooksellerid=$supplierid
150 $sth = $dbh->prepare($query);
154 SELECT name,title,planneddate,serialseq,serial.subscriptionid
156 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
157 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
158 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
159 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
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 # warn "subsid :$subscriptionid";
377 $sth->execute($subscriptionid);
378 my $subs = $sth->fetchrow_hashref;
382 =head2 GetFullSubscription
386 \@res = GetFullSubscription($subscriptionid)
387 this function read on serial table.
393 sub GetFullSubscription {
394 my ($subscriptionid) = @_;
395 my $dbh = C4::Context->dbh;
397 SELECT serial.serialid,
400 serial.publisheddate,
402 serial.notes as notes,
403 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
404 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
405 biblio.title as bibliotitle,
406 subscription.branchcode AS branchcode,
407 subscription.subscriptionid AS subscriptionid
409 LEFT JOIN subscription ON
410 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
411 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
412 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
413 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
414 WHERE serial.subscriptionid = ? |;
415 if (C4::Context->preference('IndependantBranches') &&
416 C4::Context->userenv &&
417 C4::Context->userenv->{'flags'} != 1){
419 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
423 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
424 serial.subscriptionid
426 my $sth = $dbh->prepare($query);
427 $sth->execute($subscriptionid);
428 my $subs = $sth->fetchall_arrayref({});
433 =head2 PrepareSerialsData
437 \@res = PrepareSerialsData($serialinfomation)
438 where serialinformation is a hashref array
444 sub PrepareSerialsData{
450 my $aqbooksellername;
454 my $previousnote = "";
456 foreach my $subs ( @$lines ) {
457 $subs->{'publisheddate'} =
458 ( $subs->{'publisheddate'}
459 ? format_date( $subs->{'publisheddate'} )
461 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
462 $subs->{ "status" . $subs->{'status'} } = 1;
464 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
465 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
466 $year = $subs->{'year'};
471 if ( $tmpresults{$year} ) {
472 push @{ $tmpresults{$year}->{'serials'} }, $subs;
475 $tmpresults{$year} = {
478 # 'startdate'=>format_date($subs->{'startdate'}),
479 'aqbooksellername' => $subs->{'aqbooksellername'},
480 'bibliotitle' => $subs->{'bibliotitle'},
481 'serials' => [$subs],
483 'branchcode' => $subs->{'branchcode'},
484 'subscriptionid' => $subs->{'subscriptionid'},
488 # $previousnote=$subs->{notes};
490 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
491 push @res, $tmpresults{$key};
493 $res[0]->{'first'}=1;
497 =head2 GetSubscriptionsFromBiblionumber
499 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
500 this function get the subscription list. it reads on subscription table.
502 table of subscription which has the biblionumber given on input arg.
503 each line of this table is a hashref. All hashes containt
504 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
508 sub GetSubscriptionsFromBiblionumber {
509 my ($biblionumber) = @_;
510 my $dbh = C4::Context->dbh;
512 SELECT subscription.*,
514 subscriptionhistory.*,
516 aqbooksellers.name AS aqbooksellername,
517 biblio.title AS bibliotitle
519 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
520 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
521 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
522 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
523 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
524 WHERE subscription.biblionumber = ?
526 if (C4::Context->preference('IndependantBranches') &&
527 C4::Context->userenv &&
528 C4::Context->userenv->{'flags'} != 1){
529 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
531 my $sth = $dbh->prepare($query);
532 $sth->execute($biblionumber);
534 while ( my $subs = $sth->fetchrow_hashref ) {
535 $subs->{startdate} = format_date( $subs->{startdate} );
536 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
537 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
538 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
539 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
540 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
541 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
542 $subs->{ "status" . $subs->{'status'} } = 1;
543 if ( $subs->{enddate} eq '0000-00-00' ) {
544 $subs->{enddate} = '';
547 $subs->{enddate} = format_date( $subs->{enddate} );
549 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
550 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
556 =head2 GetFullSubscriptionsFromBiblionumber
560 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
561 this function read on serial table.
567 sub GetFullSubscriptionsFromBiblionumber {
568 my ($biblionumber) = @_;
569 my $dbh = C4::Context->dbh;
571 SELECT serial.serialid,
574 serial.publisheddate,
576 serial.notes as notes,
577 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
578 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
579 biblio.title as bibliotitle,
580 subscription.branchcode AS branchcode,
581 subscription.subscriptionid AS subscriptionid
583 LEFT JOIN subscription ON
584 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
585 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
586 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
587 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
588 WHERE subscription.biblionumber = ? |;
589 if (C4::Context->preference('IndependantBranches') &&
590 C4::Context->userenv &&
591 C4::Context->userenv->{'flags'} != 1){
593 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
597 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
598 serial.subscriptionid
600 my $sth = $dbh->prepare($query);
601 $sth->execute($biblionumber);
602 my $subs= $sth->fetchall_arrayref({});
606 =head2 GetSubscriptions
610 @results = GetSubscriptions($title,$ISSN,$biblionumber);
611 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
613 a table of hashref. Each hash containt the subscription.
619 sub GetSubscriptions {
620 my ( $title, $ISSN, $biblionumber ) = @_;
621 #return unless $title or $ISSN or $biblionumber;
622 my $dbh = C4::Context->dbh;
626 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
628 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
629 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
630 WHERE biblio.biblionumber=?
632 if (C4::Context->preference('IndependantBranches') &&
633 C4::Context->userenv &&
634 C4::Context->userenv->{'flags'} != 1){
635 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
637 $query.=" ORDER BY title";
638 # warn "query :$query";
639 $sth = $dbh->prepare($query);
640 $sth->execute($biblionumber);
643 if ( $ISSN and $title ) {
645 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
647 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
648 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
649 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
651 if (C4::Context->preference('IndependantBranches') &&
652 C4::Context->userenv &&
653 C4::Context->userenv->{'flags'} != 1){
654 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
656 $query.=" ORDER BY title";
657 $sth = $dbh->prepare($query);
658 $sth->execute( $ISSN );
663 SELECT subscription.*,biblio.title,biblioitems.issn,,biblio.biblionumber
665 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
666 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
667 WHERE biblioitems.issn LIKE ?
669 if (C4::Context->preference('IndependantBranches') &&
670 C4::Context->userenv &&
671 C4::Context->userenv->{'flags'} != 1){
672 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
674 $query.=" ORDER BY title";
675 # warn "query :$query";
676 $sth = $dbh->prepare($query);
677 $sth->execute( "%" . $ISSN . "%" );
681 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
683 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
684 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
686 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
689 if (C4::Context->preference('IndependantBranches') &&
690 C4::Context->userenv &&
691 C4::Context->userenv->{'flags'} != 1){
692 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
694 $query.=" ORDER BY title";
695 $sth = $dbh->prepare($query);
701 my $previoustitle = "";
703 while ( my $line = $sth->fetchrow_hashref ) {
704 if ( $previoustitle eq $line->{title} ) {
707 $line->{toggle} = 1 if $odd == 1;
710 $previoustitle = $line->{title};
712 $line->{toggle} = 1 if $odd == 1;
714 push @results, $line;
723 ($totalissues,@serials) = GetSerials($subscriptionid);
724 this function get every serial not arrived for a given subscription
725 as well as the number of issues registered in the database (all types)
726 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
733 my ($subscriptionid,$count) = @_;
734 my $dbh = C4::Context->dbh;
736 # status = 2 is "arrived"
738 $count=5 unless ($count);
741 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
743 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
744 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
745 my $sth = $dbh->prepare($query);
746 $sth->execute($subscriptionid);
747 while ( my $line = $sth->fetchrow_hashref ) {
748 $line->{ "status" . $line->{status} } =
749 1; # fills a "statusX" value, used for template status select list
750 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
751 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
752 push @serials, $line;
754 # OK, now add the last 5 issues arrives/missing
756 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
758 WHERE subscriptionid = ?
759 AND (status in (2,4,5))
760 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
762 $sth = $dbh->prepare($query);
763 $sth->execute($subscriptionid);
764 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
766 $line->{ "status" . $line->{status} } =
767 1; # fills a "statusX" value, used for template status select list
768 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
769 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
770 push @serials, $line;
773 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
774 $sth = $dbh->prepare($query);
775 $sth->execute($subscriptionid);
776 my ($totalissues) = $sth->fetchrow;
777 return ( $totalissues, @serials );
784 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
785 this function get every serial waited for a given subscription
786 as well as the number of issues registered in the database (all types)
787 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
793 my ($subscription,$status) = @_;
794 my $dbh = C4::Context->dbh;
796 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
798 WHERE subscriptionid=$subscription AND status IN ($status)
799 ORDER BY publisheddate,serialid DESC
802 my $sth=$dbh->prepare($query);
805 while(my $line = $sth->fetchrow_hashref) {
806 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
807 $line->{"planneddate"} = format_date($line->{"planneddate"});
808 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
811 my ($totalissues) = scalar(@serials);
812 return ($totalissues,@serials);
815 =head2 GetLatestSerials
819 \@serials = GetLatestSerials($subscriptionid,$limit)
820 get the $limit's latest serials arrived or missing for a given subscription
822 a ref to a table which it containts all of the latest serials stored into a hash.
828 sub GetLatestSerials {
829 my ( $subscriptionid, $limit ) = @_;
830 my $dbh = C4::Context->dbh;
832 # status = 2 is "arrived"
833 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
835 WHERE subscriptionid = ?
836 AND (status =2 or status=4)
837 ORDER BY planneddate DESC LIMIT 0,$limit
839 my $sth = $dbh->prepare($strsth);
840 $sth->execute($subscriptionid);
842 while ( my $line = $sth->fetchrow_hashref ) {
843 $line->{ "status" . $line->{status} } =
844 1; # fills a "statusX" value, used for template status select list
845 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
846 push @serials, $line;
852 # WHERE subscriptionid=?
854 # $sth=$dbh->prepare($query);
855 # $sth->execute($subscriptionid);
856 # my ($totalissues) = $sth->fetchrow;
860 =head2 GetDistributedTo
864 $distributedto=GetDistributedTo($subscriptionid)
865 This function select the old previous value of distributedto in the database.
871 sub GetDistributedTo {
872 my $dbh = C4::Context->dbh;
874 my $subscriptionid = @_;
875 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
876 my $sth = $dbh->prepare($query);
877 $sth->execute($subscriptionid);
878 return ($distributedto) = $sth->fetchrow;
886 $val is a hashref containing all the attributes of the table 'subscription'
887 This function get the next issue for the subscription given on input arg
889 all the input params updated.
897 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
898 # $calculated = $val->{numberingmethod};
899 # # calculate the (expected) value of the next issue recieved.
900 # $newlastvalue1 = $val->{lastvalue1};
901 # # check if we have to increase the new value.
902 # $newinnerloop1 = $val->{innerloop1}+1;
903 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
904 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
905 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
906 # $calculated =~ s/\{X\}/$newlastvalue1/g;
908 # $newlastvalue2 = $val->{lastvalue2};
909 # # check if we have to increase the new value.
910 # $newinnerloop2 = $val->{innerloop2}+1;
911 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
912 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
913 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
914 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
916 # $newlastvalue3 = $val->{lastvalue3};
917 # # check if we have to increase the new value.
918 # $newinnerloop3 = $val->{innerloop3}+1;
919 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
920 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
921 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
922 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
923 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
929 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
930 $newinnerloop1, $newinnerloop2, $newinnerloop3
932 my $pattern = $val->{numberpattern};
933 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
934 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
935 $calculated = $val->{numberingmethod};
936 $newlastvalue1 = $val->{lastvalue1};
937 $newlastvalue2 = $val->{lastvalue2};
938 $newlastvalue3 = $val->{lastvalue3};
940 $newlastvalue1 = $val->{lastvalue1};
941 # check if we have to increase the new value.
942 $newinnerloop1 = $val->{innerloop1}+1;
943 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
944 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
945 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
946 $calculated =~ s/\{X\}/$newlastvalue1/g;
948 $newlastvalue2 = $val->{lastvalue2};
949 # check if we have to increase the new value.
950 $newinnerloop2 = $val->{innerloop2}+1;
951 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
952 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
953 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
954 if ( $pattern == 6 ) {
955 if ( $val->{hemisphere} == 2 ) {
956 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
957 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
960 my $newlastvalue2seq = $seasons[$newlastvalue2];
961 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
965 $calculated =~ s/\{Y\}/$newlastvalue2/g;
969 $newlastvalue3 = $val->{lastvalue3};
970 # check if we have to increase the new value.
971 $newinnerloop3 = $val->{innerloop3}+1;
972 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
973 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
974 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
975 $calculated =~ s/\{Z\}/$newlastvalue3/g;
977 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
978 $newinnerloop1, $newinnerloop2, $newinnerloop3);
985 $calculated = GetSeq($val)
986 $val is a hashref containing all the attributes of the table 'subscription'
987 this function transforms {X},{Y},{Z} to 150,0,0 for example.
989 the sequence in integer format
997 my $pattern = $val->{numberpattern};
998 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
999 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
1000 my $calculated = $val->{numberingmethod};
1001 my $x = $val->{'lastvalue1'};
1002 $calculated =~ s/\{X\}/$x/g;
1003 my $newlastvalue2 = $val->{'lastvalue2'};
1004 if ( $pattern == 6 ) {
1005 if ( $val->{hemisphere} == 2 ) {
1006 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1007 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1010 my $newlastvalue2seq = $seasons[$newlastvalue2];
1011 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1015 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1017 my $z = $val->{'lastvalue3'};
1018 $calculated =~ s/\{Z\}/$z/g;
1022 =head2 GetExpirationDate
1024 $sensddate = GetExpirationDate($subscriptionid)
1026 this function return the expiration date for a subscription given on input args.
1033 sub GetExpirationDate {
1034 my ($subscriptionid) = @_;
1035 my $dbh = C4::Context->dbh;
1036 my $subscription = GetSubscription($subscriptionid);
1037 my $enddate = $subscription->{startdate};
1039 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1040 if ($subscription->{periodicity}){
1041 if ( $subscription->{numberlength} ) {
1042 #calculate the date of the last issue.
1043 my $length = $subscription->{numberlength};
1044 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1045 $enddate = GetNextDate( $enddate, $subscription );
1048 elsif ( $subscription->{monthlength} ){
1049 my @date=split (/-/,$subscription->{startdate});
1050 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1051 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1052 } elsif ( $subscription->{weeklength} ){
1053 my @date=split (/-/,$subscription->{startdate});
1054 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1055 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1063 =head2 CountSubscriptionFromBiblionumber
1067 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1068 this count the number of subscription for a biblionumber given.
1070 the number of subscriptions with biblionumber given on input arg.
1076 sub CountSubscriptionFromBiblionumber {
1077 my ($biblionumber) = @_;
1078 my $dbh = C4::Context->dbh;
1079 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1080 my $sth = $dbh->prepare($query);
1081 $sth->execute($biblionumber);
1082 my $subscriptionsnumber = $sth->fetchrow;
1083 return $subscriptionsnumber;
1086 =head2 ModSubscriptionHistory
1090 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1092 this function modify the history of a subscription. Put your new values on input arg.
1098 sub ModSubscriptionHistory {
1100 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1101 $missinglist, $opacnote, $librariannote
1103 my $dbh = C4::Context->dbh;
1104 my $query = "UPDATE subscriptionhistory
1105 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1106 WHERE subscriptionid=?
1108 my $sth = $dbh->prepare($query);
1109 $recievedlist =~ s/^,//g;
1110 $missinglist =~ s/^,//g;
1111 $opacnote =~ s/^,//g;
1113 $histstartdate, $enddate, $recievedlist, $missinglist,
1114 $opacnote, $librariannote, $subscriptionid
1119 =head2 ModSerialStatus
1123 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1125 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1126 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1132 sub ModSerialStatus {
1133 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1136 #It is a usual serial
1137 # 1st, get previous status :
1138 my $dbh = C4::Context->dbh;
1139 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1140 my $sth = $dbh->prepare($query);
1141 $sth->execute($serialid);
1142 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1144 # change status & update subscriptionhistory
1146 if ( $status eq 6 ) {
1147 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1151 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1152 $sth = $dbh->prepare($query);
1153 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1154 $notes, $serialid );
1155 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1156 $sth = $dbh->prepare($query);
1157 $sth->execute($subscriptionid);
1158 my $val = $sth->fetchrow_hashref;
1159 unless ( $val->{manualhistory} ) {
1161 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1162 $sth = $dbh->prepare($query);
1163 $sth->execute($subscriptionid);
1164 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1165 if ( $status eq 2 ) {
1167 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1168 $recievedlist .= ",$serialseq"
1169 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1172 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1173 $missinglist .= ",$serialseq"
1175 and not index( "$missinglist", "$serialseq" ) >= 0 );
1176 $missinglist .= ",not issued $serialseq"
1178 and index( "$missinglist", "$serialseq" ) >= 0 );
1180 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1181 $sth = $dbh->prepare($query);
1182 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1186 # create new waited entry if needed (ie : was a "waited" and has changed)
1187 if ( $oldstatus eq 1 && $status ne 1 ) {
1188 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1189 $sth = $dbh->prepare($query);
1190 $sth->execute($subscriptionid);
1191 my $val = $sth->fetchrow_hashref;
1196 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1197 $newinnerloop1, $newinnerloop2, $newinnerloop3
1198 ) = GetNextSeq($val);
1199 # warn "Next Seq End";
1201 # next date (calculated from actual date & frequency parameters)
1202 # warn "publisheddate :$publisheddate ";
1203 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1204 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1205 1, $nextpublisheddate, $nextpublisheddate );
1207 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1208 WHERE subscriptionid = ?";
1209 $sth = $dbh->prepare($query);
1211 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1212 $newinnerloop2, $newinnerloop3, $subscriptionid
1215 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1216 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1217 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1222 =head2 ModSubscription
1226 this function modify a subscription. Put all new values on input args.
1232 sub ModSubscription {
1234 $auser, $branchcode, $aqbooksellerid, $cost,
1235 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1236 $dow, $irregularity, $numberpattern, $numberlength,
1237 $weeklength, $monthlength, $add1, $every1,
1238 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1239 $add2, $every2, $whenmorethan2, $setto2,
1240 $lastvalue2, $innerloop2, $add3, $every3,
1241 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1242 $numberingmethod, $status, $biblionumber, $callnumber,
1243 $notes, $letter, $hemisphere, $manualhistory,
1247 # warn $irregularity;
1248 my $dbh = C4::Context->dbh;
1249 my $query = "UPDATE subscription
1250 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1251 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1252 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1253 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1254 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1255 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1256 WHERE subscriptionid = ?";
1257 # warn "query :".$query;
1258 my $sth = $dbh->prepare($query);
1260 $auser, $branchcode, $aqbooksellerid, $cost,
1261 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1262 $dow, "$irregularity", $numberpattern, $numberlength,
1263 $weeklength, $monthlength, $add1, $every1,
1264 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1265 $add2, $every2, $whenmorethan2, $setto2,
1266 $lastvalue2, $innerloop2, $add3, $every3,
1267 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1268 $numberingmethod, $status, $biblionumber, $callnumber,
1269 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1273 my $rows=$sth->rows;
1276 &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1277 if C4::Context->preference("SubscriptionLog");
1281 =head2 NewSubscription
1285 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1286 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1287 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1288 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1289 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1290 $numberingmethod, $status, $notes)
1292 Create a new subscription with value given on input args.
1295 the id of this new subscription
1301 sub NewSubscription {
1303 $auser, $branchcode, $aqbooksellerid, $cost,
1304 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1305 $dow, $numberlength, $weeklength, $monthlength,
1306 $add1, $every1, $whenmorethan1, $setto1,
1307 $lastvalue1, $innerloop1, $add2, $every2,
1308 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1309 $add3, $every3, $whenmorethan3, $setto3,
1310 $lastvalue3, $innerloop3, $numberingmethod, $status,
1311 $notes, $letter, $firstacquidate, $irregularity,
1312 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1315 my $dbh = C4::Context->dbh;
1317 #save subscription (insert into database)
1319 INSERT INTO subscription
1320 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1321 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1322 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1323 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1324 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1325 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1326 numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1327 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1329 my $sth = $dbh->prepare($query);
1331 $auser, $branchcode,
1332 $aqbooksellerid, $cost,
1333 $aqbudgetid, $biblionumber,
1334 format_date_in_iso($startdate), $periodicity,
1335 $dow, $numberlength,
1336 $weeklength, $monthlength,
1338 $whenmorethan1, $setto1,
1339 $lastvalue1, $innerloop1,
1341 $whenmorethan2, $setto2,
1342 $lastvalue2, $innerloop2,
1344 $whenmorethan3, $setto3,
1345 $lastvalue3, $innerloop3,
1346 $numberingmethod, "$status",
1348 $firstacquidate, $irregularity,
1349 $numberpattern, $callnumber,
1350 $hemisphere, $manualhistory,
1354 #then create the 1st waited number
1355 my $subscriptionid = $dbh->{'mysql_insertid'};
1357 INSERT INTO subscriptionhistory
1358 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1359 VALUES (?,?,?,?,?,?,?,?)
1361 $sth = $dbh->prepare($query);
1362 $sth->execute( $biblionumber, $subscriptionid,
1363 format_date_in_iso($startdate),
1364 0, "", "", "", "$notes" );
1366 # reread subscription to get a hash (for calculation of the 1st issue number)
1370 WHERE subscriptionid = ?
1372 $sth = $dbh->prepare($query);
1373 $sth->execute($subscriptionid);
1374 my $val = $sth->fetchrow_hashref;
1376 # calculate issue number
1377 my $serialseq = GetSeq($val);
1380 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1381 VALUES (?,?,?,?,?,?)
1383 $sth = $dbh->prepare($query);
1385 "$serialseq", $subscriptionid, $biblionumber, 1,
1386 format_date_in_iso($startdate),
1387 format_date_in_iso($startdate)
1390 &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1391 if C4::Context->preference("SubscriptionLog");
1393 return $subscriptionid;
1396 =head2 ReNewSubscription
1400 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1402 this function renew a subscription with values given on input args.
1408 sub ReNewSubscription {
1409 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1410 $monthlength, $note )
1412 my $dbh = C4::Context->dbh;
1413 my $subscription = GetSubscription($subscriptionid);
1417 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1418 WHERE biblio.biblionumber=?
1420 my $sth = $dbh->prepare($query);
1421 $sth->execute( $subscription->{biblionumber} );
1422 my $biblio = $sth->fetchrow_hashref;
1424 $user, $subscription->{bibliotitle},
1425 $biblio->{author}, $biblio->{publishercode},
1426 $biblio->{note}, '',
1429 $subscription->{biblionumber}
1432 # renew subscription
1435 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1436 WHERE subscriptionid=?
1438 my $sth = $dbh->prepare($query);
1439 $sth->execute( format_date_in_iso($startdate),
1440 $numberlength, $weeklength, $monthlength, $subscriptionid );
1442 &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1443 if C4::Context->preference("SubscriptionLog");
1450 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1452 Create a new issue stored on the database.
1453 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1460 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1461 $planneddate, $publisheddate, $notes )
1463 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1465 my $dbh = C4::Context->dbh;
1468 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1469 VALUES (?,?,?,?,?,?,?)
1471 my $sth = $dbh->prepare($query);
1472 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1473 $publisheddate, $planneddate,$notes );
1474 my $serialid=$dbh->{'mysql_insertid'};
1476 SELECT missinglist,recievedlist
1477 FROM subscriptionhistory
1478 WHERE subscriptionid=?
1480 $sth = $dbh->prepare($query);
1481 $sth->execute($subscriptionid);
1482 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1484 if ( $status eq 2 ) {
1485 ### TODO Add a feature that improves recognition and description.
1486 ### As such count (serialseq) i.e. : N18,2(N19),N20
1487 ### Would use substr and index But be careful to previous presence of ()
1488 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1490 if ( $status eq 4 ) {
1491 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1494 UPDATE subscriptionhistory
1495 SET recievedlist=?, missinglist=?
1496 WHERE subscriptionid=?
1498 $sth = $dbh->prepare($query);
1499 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1503 =head2 ItemizeSerials
1507 ItemizeSerials($serialid, $info);
1508 $info is a hashref containing barcode branch, itemcallnumber, status, location
1509 $serialid the serialid
1511 1 if the itemize is a succes.
1512 0 and @error else. @error containts the list of errors found.
1518 sub ItemizeSerials {
1519 my ( $serialid, $info ) = @_;
1520 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1522 my $dbh = C4::Context->dbh;
1528 my $sth = $dbh->prepare($query);
1529 $sth->execute($serialid);
1530 my $data = $sth->fetchrow_hashref;
1531 if ( C4::Context->preference("RoutingSerials") ) {
1533 # check for existing biblioitem relating to serial issue
1534 my ( $count, @results ) =
1535 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1537 for ( my $i = 0 ; $i < $count ; $i++ ) {
1538 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1539 . $data->{'planneddate'}
1542 $bibitemno = $results[$i]->{'biblioitemnumber'};
1546 if ( $bibitemno == 0 ) {
1548 # warn "need to add new biblioitem so copy last one and make minor changes";
1551 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1553 $sth->execute( $data->{'biblionumber'} );
1554 my $biblioitem = $sth->fetchrow_hashref;
1555 $biblioitem->{'volumedate'} =
1556 format_date_in_iso( $data->{planneddate} );
1557 $biblioitem->{'volumeddesc'} =
1558 $data->{serialseq} . ' ('
1559 . format_date( $data->{'planneddate'} ) . ')';
1560 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1562 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1563 # so I comment it, we can speak of it when you want
1564 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1565 # if ( $info->{barcode} )
1566 # { # only make biblioitem if we are going to make item also
1567 # $bibitemno = newbiblioitem($biblioitem);
1572 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1573 if ( $info->{barcode} ) {
1575 my $exists = itemdata( $info->{'barcode'} );
1576 push @errors, "barcode_not_unique" if ($exists);
1578 my $marcrecord = MARC::Record->new();
1579 my ( $tag, $subfield ) =
1580 GetMarcFromKohaField( "items.barcode", $fwk );
1582 MARC::Field->new( "$tag", '', '',
1583 "$subfield" => $info->{barcode} );
1584 $marcrecord->insert_fields_ordered($newField);
1585 if ( $info->{branch} ) {
1586 my ( $tag, $subfield ) =
1587 GetMarcFromKohaField( "items.homebranch",
1590 #warn "items.homebranch : $tag , $subfield";
1591 if ( $marcrecord->field($tag) ) {
1592 $marcrecord->field($tag)
1593 ->add_subfields( "$subfield" => $info->{branch} );
1597 MARC::Field->new( "$tag", '', '',
1598 "$subfield" => $info->{branch} );
1599 $marcrecord->insert_fields_ordered($newField);
1601 ( $tag, $subfield ) =
1602 GetMarcFromKohaField( "items.holdingbranch",
1605 #warn "items.holdingbranch : $tag , $subfield";
1606 if ( $marcrecord->field($tag) ) {
1607 $marcrecord->field($tag)
1608 ->add_subfields( "$subfield" => $info->{branch} );
1612 MARC::Field->new( "$tag", '', '',
1613 "$subfield" => $info->{branch} );
1614 $marcrecord->insert_fields_ordered($newField);
1617 if ( $info->{itemcallnumber} ) {
1618 my ( $tag, $subfield ) =
1619 GetMarcFromKohaField( "items.itemcallnumber",
1622 #warn "items.itemcallnumber : $tag , $subfield";
1623 if ( $marcrecord->field($tag) ) {
1624 $marcrecord->field($tag)
1625 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1629 MARC::Field->new( "$tag", '', '',
1630 "$subfield" => $info->{itemcallnumber} );
1631 $marcrecord->insert_fields_ordered($newField);
1634 if ( $info->{notes} ) {
1635 my ( $tag, $subfield ) =
1636 GetMarcFromKohaField( "items.itemnotes", $fwk );
1638 # warn "items.itemnotes : $tag , $subfield";
1639 if ( $marcrecord->field($tag) ) {
1640 $marcrecord->field($tag)
1641 ->add_subfields( "$subfield" => $info->{notes} );
1645 MARC::Field->new( "$tag", '', '',
1646 "$subfield" => $info->{notes} );
1647 $marcrecord->insert_fields_ordered($newField);
1650 if ( $info->{location} ) {
1651 my ( $tag, $subfield ) =
1652 GetMarcFromKohaField( "items.location", $fwk );
1654 # warn "items.location : $tag , $subfield";
1655 if ( $marcrecord->field($tag) ) {
1656 $marcrecord->field($tag)
1657 ->add_subfields( "$subfield" => $info->{location} );
1661 MARC::Field->new( "$tag", '', '',
1662 "$subfield" => $info->{location} );
1663 $marcrecord->insert_fields_ordered($newField);
1666 if ( $info->{status} ) {
1667 my ( $tag, $subfield ) =
1668 GetMarcFromKohaField( "items.notforloan",
1671 # warn "items.notforloan : $tag , $subfield";
1672 if ( $marcrecord->field($tag) ) {
1673 $marcrecord->field($tag)
1674 ->add_subfields( "$subfield" => $info->{status} );
1678 MARC::Field->new( "$tag", '', '',
1679 "$subfield" => $info->{status} );
1680 $marcrecord->insert_fields_ordered($newField);
1683 if ( C4::Context->preference("RoutingSerials") ) {
1684 my ( $tag, $subfield ) =
1685 GetMarcFromKohaField( "items.dateaccessioned",
1687 if ( $marcrecord->field($tag) ) {
1688 $marcrecord->field($tag)
1689 ->add_subfields( "$subfield" => $now );
1693 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1694 $marcrecord->insert_fields_ordered($newField);
1697 AddItem( $marcrecord, $data->{'biblionumber'} );
1700 return ( 0, @errors );
1704 =head2 HasSubscriptionExpired
1708 1 or 0 = HasSubscriptionExpired($subscriptionid)
1710 the subscription has expired when the next issue to arrive is out of subscription limit.
1713 1 if true, 0 if false.
1719 sub HasSubscriptionExpired {
1720 my ($subscriptionid) = @_;
1721 my $dbh = C4::Context->dbh;
1722 my $subscription = GetSubscription($subscriptionid);
1723 if ($subscription->{periodicity}>0){
1724 my $expirationdate = GetExpirationDate($subscriptionid);
1726 SELECT max(planneddate)
1728 WHERE subscriptionid=?
1730 my $sth = $dbh->prepare($query);
1731 $sth->execute($subscriptionid);
1732 my ($res) = $sth->fetchrow ;
1733 my @res=split (/-/,$res);
1734 # warn "date expiration :$expirationdate";
1735 my @endofsubscriptiondate=split(/-/,$expirationdate);
1736 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1737 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1741 if ($subscription->{'numberlength'}){
1742 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1743 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1752 =head2 SetDistributedto
1756 SetDistributedto($distributedto,$subscriptionid);
1757 This function update the value of distributedto for a subscription given on input arg.
1763 sub SetDistributedto {
1764 my ( $distributedto, $subscriptionid ) = @_;
1765 my $dbh = C4::Context->dbh;
1769 WHERE subscriptionid=?
1771 my $sth = $dbh->prepare($query);
1772 $sth->execute( $distributedto, $subscriptionid );
1775 =head2 DelSubscription
1779 DelSubscription($subscriptionid)
1780 this function delete the subscription which has $subscriptionid as id.
1786 sub DelSubscription {
1787 my ($subscriptionid) = @_;
1788 my $dbh = C4::Context->dbh;
1789 $subscriptionid = $dbh->quote($subscriptionid);
1790 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1792 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1793 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1795 &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1796 if C4::Context->preference("SubscriptionLog");
1803 DelIssue($serialseq,$subscriptionid)
1804 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1811 my ( $dataissue) = @_;
1812 my $dbh = C4::Context->dbh;
1813 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1818 AND subscriptionid= ?
1820 my $mainsth = $dbh->prepare($query);
1821 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1823 #Delete element from subscription history
1824 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1825 my $sth = $dbh->prepare($query);
1826 $sth->execute($dataissue->{'subscriptionid'});
1827 my $val = $sth->fetchrow_hashref;
1828 unless ( $val->{manualhistory} ) {
1830 SELECT * FROM subscriptionhistory
1831 WHERE subscriptionid= ?
1833 my $sth = $dbh->prepare($query);
1834 $sth->execute($dataissue->{'subscriptionid'});
1835 my $data = $sth->fetchrow_hashref;
1836 my $serialseq= $dataissue->{'serialseq'};
1837 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1838 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1839 my $strsth = "UPDATE subscriptionhistory SET "
1841 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1842 . " WHERE subscriptionid=?";
1843 $sth = $dbh->prepare($strsth);
1844 $sth->execute($dataissue->{'subscriptionid'});
1847 return $mainsth->rows;
1850 =head2 GetLateOrMissingIssues
1854 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1856 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1859 a count of the number of missing issues
1860 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1861 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1867 sub GetLateOrMissingIssues {
1868 my ( $supplierid, $serialid,$order ) = @_;
1869 my $dbh = C4::Context->dbh;
1873 $byserial = "and serialid = " . $serialid;
1881 $sth = $dbh->prepare(
1890 serial.subscriptionid,
1893 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1894 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
1895 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1896 WHERE subscription.subscriptionid = serial.subscriptionid
1897 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1898 AND subscription.aqbooksellerid=$supplierid
1904 $sth = $dbh->prepare(
1913 serial.subscriptionid,
1916 LEFT JOIN subscription
1917 ON serial.subscriptionid=subscription.subscriptionid
1919 ON serial.biblionumber=biblio.biblionumber
1920 LEFT JOIN aqbooksellers
1921 ON subscription.aqbooksellerid = aqbooksellers.id
1923 subscription.subscriptionid = serial.subscriptionid
1924 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1925 AND biblio.biblionumber = subscription.biblionumber
1935 while ( my $line = $sth->fetchrow_hashref ) {
1936 $odd++ unless $line->{title} eq $last_title;
1937 $last_title = $line->{title} if ( $line->{title} );
1938 $line->{planneddate} = format_date( $line->{planneddate} );
1939 $line->{claimdate} = format_date( $line->{claimdate} );
1940 $line->{"status".$line->{status}} = 1;
1941 $line->{'odd'} = 1 if $odd % 2;
1943 push @issuelist, $line;
1945 return $count, @issuelist;
1948 =head2 removeMissingIssue
1952 removeMissingIssue($subscriptionid)
1954 this function removes an issue from being part of the missing string in
1955 subscriptionlist.missinglist column
1957 called when a missing issue is found from the serials-recieve.pl file
1963 sub removeMissingIssue {
1964 my ( $sequence, $subscriptionid ) = @_;
1965 my $dbh = C4::Context->dbh;
1968 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1969 $sth->execute($subscriptionid);
1970 my $data = $sth->fetchrow_hashref;
1971 my $missinglist = $data->{'missinglist'};
1972 my $missinglistbefore = $missinglist;
1974 # warn $missinglist." before";
1975 $missinglist =~ s/($sequence)//;
1977 # warn $missinglist." after";
1978 if ( $missinglist ne $missinglistbefore ) {
1979 $missinglist =~ s/\|\s\|/\|/g;
1980 $missinglist =~ s/^\| //g;
1981 $missinglist =~ s/\|$//g;
1982 my $sth2 = $dbh->prepare(
1983 "UPDATE subscriptionhistory
1985 WHERE subscriptionid = ?"
1987 $sth2->execute( $missinglist, $subscriptionid );
1995 &updateClaim($serialid)
1997 this function updates the time when a claim is issued for late/missing items
1999 called from claims.pl file
2006 my ($serialid) = @_;
2007 my $dbh = C4::Context->dbh;
2008 my $sth = $dbh->prepare(
2009 "UPDATE serial SET claimdate = now()
2013 $sth->execute($serialid);
2016 =head2 getsupplierbyserialid
2020 ($result) = &getsupplierbyserialid($serialid)
2022 this function is used to find the supplier id given a serial id
2025 hashref containing serialid, subscriptionid, and aqbooksellerid
2031 sub getsupplierbyserialid {
2032 my ($serialid) = @_;
2033 my $dbh = C4::Context->dbh;
2034 my $sth = $dbh->prepare(
2035 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2037 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2041 $sth->execute($serialid);
2042 my $line = $sth->fetchrow_hashref;
2043 my $result = $line->{'aqbooksellerid'};
2047 =head2 check_routing
2051 ($result) = &check_routing($subscriptionid)
2053 this function checks to see if a serial has a routing list and returns the count of routingid
2054 used to show either an 'add' or 'edit' link
2060 my ($subscriptionid) = @_;
2061 my $dbh = C4::Context->dbh;
2062 my $sth = $dbh->prepare(
2063 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2064 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2065 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2068 $sth->execute($subscriptionid);
2069 my $line = $sth->fetchrow_hashref;
2070 my $result = $line->{'routingids'};
2074 =head2 addroutingmember
2078 &addroutingmember($borrowernumber,$subscriptionid)
2080 this function takes a borrowernumber and subscriptionid and add the member to the
2081 routing list for that serial subscription and gives them a rank on the list
2082 of either 1 or highest current rank + 1
2088 sub addroutingmember {
2089 my ( $borrowernumber, $subscriptionid ) = @_;
2091 my $dbh = C4::Context->dbh;
2094 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2096 $sth->execute($subscriptionid);
2097 while ( my $line = $sth->fetchrow_hashref ) {
2098 if ( $line->{'rank'} > 0 ) {
2099 $rank = $line->{'rank'} + 1;
2107 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2109 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2112 =head2 reorder_members
2116 &reorder_members($subscriptionid,$routingid,$rank)
2118 this function is used to reorder the routing list
2120 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2121 - it gets all members on list puts their routingid's into an array
2122 - removes the one in the array that is $routingid
2123 - then reinjects $routingid at point indicated by $rank
2124 - then update the database with the routingids in the new order
2130 sub reorder_members {
2131 my ( $subscriptionid, $routingid, $rank ) = @_;
2132 my $dbh = C4::Context->dbh;
2135 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2137 $sth->execute($subscriptionid);
2139 while ( my $line = $sth->fetchrow_hashref ) {
2140 push( @result, $line->{'routingid'} );
2143 # To find the matching index
2145 my $key = -1; # to allow for 0 being a valid response
2146 for ( $i = 0 ; $i < @result ; $i++ ) {
2147 if ( $routingid == $result[$i] ) {
2148 $key = $i; # save the index
2153 # if index exists in array then move it to new position
2154 if ( $key > -1 && $rank > 0 ) {
2155 my $new_rank = $rank -
2156 1; # $new_rank is what you want the new index to be in the array
2157 my $moving_item = splice( @result, $key, 1 );
2158 splice( @result, $new_rank, 0, $moving_item );
2160 for ( my $j = 0 ; $j < @result ; $j++ ) {
2162 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2164 . "' WHERE routingid = '"
2171 =head2 delroutingmember
2175 &delroutingmember($routingid,$subscriptionid)
2177 this function either deletes one member from routing list if $routingid exists otherwise
2178 deletes all members from the routing list
2184 sub delroutingmember {
2186 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2187 my ( $routingid, $subscriptionid ) = @_;
2188 my $dbh = C4::Context->dbh;
2192 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2193 $sth->execute($routingid);
2194 reorder_members( $subscriptionid, $routingid );
2199 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2200 $sth->execute($subscriptionid);
2204 =head2 getroutinglist
2208 ($count,@routinglist) = &getroutinglist($subscriptionid)
2210 this gets the info from the subscriptionroutinglist for $subscriptionid
2213 a count of the number of members on routinglist
2214 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2215 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2221 sub getroutinglist {
2222 my ($subscriptionid) = @_;
2223 my $dbh = C4::Context->dbh;
2224 my $sth = $dbh->prepare(
2225 "SELECT routingid, borrowernumber,
2226 ranking, biblionumber
2228 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2229 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2232 $sth->execute($subscriptionid);
2235 while ( my $line = $sth->fetchrow_hashref ) {
2237 push( @routinglist, $line );
2239 return ( $count, @routinglist );
2242 =head2 countissuesfrom
2246 $result = &countissuesfrom($subscriptionid,$startdate)
2253 sub countissuesfrom {
2254 my ($subscriptionid,$startdate) = @_;
2255 my $dbh = C4::Context->dbh;
2259 WHERE subscriptionid=?
2260 AND serial.publisheddate>?
2262 my $sth=$dbh->prepare($query);
2263 $sth->execute($subscriptionid, $startdate);
2264 my ($countreceived)=$sth->fetchrow;
2265 return $countreceived;
2268 =head2 abouttoexpire
2272 $result = &abouttoexpire($subscriptionid)
2274 this function alerts you to the penultimate issue for a serial subscription
2276 returns 1 - if this is the penultimate issue
2284 my ($subscriptionid) = @_;
2285 my $dbh = C4::Context->dbh;
2286 my $subscription = GetSubscription($subscriptionid);
2287 my $per = $subscription->{'periodicity'};
2289 my $expirationdate = GetExpirationDate($subscriptionid);
2292 "select max(planneddate) from serial where subscriptionid=?");
2293 $sth->execute($subscriptionid);
2294 my ($res) = $sth->fetchrow ;
2295 # warn "date expiration : ".$expirationdate." date courante ".$res;
2296 my @res=split /-/,$res;
2297 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2298 my @endofsubscriptiondate=split/-/,$expirationdate;
2299 my $per = $subscription->{'periodicity'};
2301 if ( $per == 1 ) {$x=7;}
2302 if ( $per == 2 ) {$x=7; }
2303 if ( $per == 3 ) {$x=14;}
2304 if ( $per == 4 ) { $x = 21; }
2305 if ( $per == 5 ) { $x = 31; }
2306 if ( $per == 6 ) { $x = 62; }
2307 if ( $per == 7 || $per == 8 ) { $x = 93; }
2308 if ( $per == 9 ) { $x = 190; }
2309 if ( $per == 10 ) { $x = 365; }
2310 if ( $per == 11 ) { $x = 730; }
2311 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2312 - (3 * $x)) if (@endofsubscriptiondate);
2313 # warn "DATE BEFORE END: $datebeforeend";
2314 return 1 if ( @res &&
2316 Delta_Days($res[0],$res[1],$res[2],
2317 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2318 (@endofsubscriptiondate &&
2319 Delta_Days($res[0],$res[1],$res[2],
2320 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2322 } elsif ($subscription->{numberlength}>0) {
2323 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2327 =head2 old_newsubscription
2331 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2332 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2333 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2334 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2335 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2336 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2338 this function is similar to the NewSubscription subroutine but has a few different
2340 $firstacquidate - date of first serial issue to arrive
2341 $irregularity - the issues not expected separated by a '|'
2342 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2343 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2344 subscription-add.tmpl file
2345 $callnumber - display the callnumber of the serial
2346 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2349 the $subscriptionid number of the new subscription
2355 sub old_newsubscription {
2357 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2358 $biblionumber, $startdate, $periodicity, $firstacquidate,
2359 $dow, $irregularity, $numberpattern, $numberlength,
2360 $weeklength, $monthlength, $add1, $every1,
2361 $whenmorethan1, $setto1, $lastvalue1, $add2,
2362 $every2, $whenmorethan2, $setto2, $lastvalue2,
2363 $add3, $every3, $whenmorethan3, $setto3,
2364 $lastvalue3, $numberingmethod, $status, $callnumber,
2367 my $dbh = C4::Context->dbh;
2370 my $sth = $dbh->prepare(
2371 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2372 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2373 add1,every1,whenmorethan1,setto1,lastvalue1,
2374 add2,every2,whenmorethan2,setto2,lastvalue2,
2375 add3,every3,whenmorethan3,setto3,lastvalue3,
2376 numberingmethod, status, callnumber, notes, hemisphere) values
2377 (?,?,?,?,?,?,?,?,?,?,?,
2378 ?,?,?,?,?,?,?,?,?,?,?,
2379 ?,?,?,?,?,?,?,?,?,?,?,?)"
2382 $auser, $aqbooksellerid,
2384 $biblionumber, format_date_in_iso($startdate),
2385 $periodicity, format_date_in_iso($firstacquidate),
2386 $dow, $irregularity,
2387 $numberpattern, $numberlength,
2388 $weeklength, $monthlength,
2390 $whenmorethan1, $setto1,
2392 $every2, $whenmorethan2,
2393 $setto2, $lastvalue2,
2395 $whenmorethan3, $setto3,
2396 $lastvalue3, $numberingmethod,
2397 $status, $callnumber,
2401 #then create the 1st waited number
2402 my $subscriptionid = $dbh->{'mysql_insertid'};
2403 my $enddate = GetExpirationDate($subscriptionid);
2407 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2410 $biblionumber, $subscriptionid,
2411 format_date_in_iso($startdate),
2412 format_date_in_iso($enddate),
2416 # reread subscription to get a hash (for calculation of the 1st issue number)
2418 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2419 $sth->execute($subscriptionid);
2420 my $val = $sth->fetchrow_hashref;
2422 # calculate issue number
2423 my $serialseq = GetSeq($val);
2426 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2428 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2429 1, format_date_in_iso($startdate) );
2430 return $subscriptionid;
2433 =head2 old_modsubscription
2437 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2438 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2439 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2440 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2441 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2442 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2444 this function is similar to the ModSubscription subroutine but has a few different
2446 $firstacquidate - date of first serial issue to arrive
2447 $irregularity - the issues not expected separated by a '|'
2448 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2449 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2450 subscription-add.tmpl file
2451 $callnumber - display the callnumber of the serial
2452 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2458 sub old_modsubscription {
2460 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2461 $startdate, $periodicity, $firstacquidate, $dow,
2462 $irregularity, $numberpattern, $numberlength, $weeklength,
2463 $monthlength, $add1, $every1, $whenmorethan1,
2464 $setto1, $lastvalue1, $innerloop1, $add2,
2465 $every2, $whenmorethan2, $setto2, $lastvalue2,
2466 $innerloop2, $add3, $every3, $whenmorethan3,
2467 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2468 $status, $biblionumber, $callnumber, $notes,
2469 $hemisphere, $subscriptionid
2471 my $dbh = C4::Context->dbh;
2472 my $sth = $dbh->prepare(
2473 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2474 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2475 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2476 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2477 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2478 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2481 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2482 $startdate, $periodicity, $firstacquidate, $dow,
2483 $irregularity, $numberpattern, $numberlength, $weeklength,
2484 $monthlength, $add1, $every1, $whenmorethan1,
2485 $setto1, $lastvalue1, $innerloop1, $add2,
2486 $every2, $whenmorethan2, $setto2, $lastvalue2,
2487 $innerloop2, $add3, $every3, $whenmorethan3,
2488 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2489 $status, $biblionumber, $callnumber, $notes,
2490 $hemisphere, $subscriptionid
2495 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2496 $sth->execute($subscriptionid);
2497 my $val = $sth->fetchrow_hashref;
2499 # calculate issue number
2500 my $serialseq = Get_Seq($val);
2502 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2503 $sth->execute( $serialseq, $subscriptionid );
2505 my $enddate = subscriptionexpirationdate($subscriptionid);
2506 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2507 $sth->execute( format_date_in_iso($enddate) );
2510 =head2 old_getserials
2514 ($totalissues,@serials) = &old_getserials($subscriptionid)
2516 this function get a hashref of serials and the total count of them
2519 $totalissues - number of serial lines
2520 the serials into a table. Each line of this table containts a ref to a hash which it containts
2521 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2527 sub old_getserials {
2528 my ($subscriptionid) = @_;
2529 my $dbh = C4::Context->dbh;
2531 # status = 2 is "arrived"
2534 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2536 $sth->execute($subscriptionid);
2539 while ( my $line = $sth->fetchrow_hashref ) {
2540 $line->{ "status" . $line->{status} } =
2541 1; # fills a "statusX" value, used for template status select list
2542 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2543 $line->{"num"} = $num;
2545 push @serials, $line;
2547 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2548 $sth->execute($subscriptionid);
2549 my ($totalissues) = $sth->fetchrow;
2550 return ( $totalissues, @serials );
2555 ($resultdate) = &GetNextDate($planneddate,$subscription)
2557 this function is an extension of GetNextDate which allows for checking for irregularity
2559 it takes the planneddate and will return the next issue's date and will skip dates if there
2560 exists an irregularity
2561 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2562 skipped then the returned date will be 2007-05-10
2565 $resultdate - then next date in the sequence
2567 Return 0 if periodicity==0
2570 sub in_array { # used in next sub down
2571 my ($val,@elements) = @_;
2572 foreach my $elem(@elements) {
2580 sub GetNextDate(@) {
2581 my ( $planneddate, $subscription ) = @_;
2582 my @irreg = split( /\,/, $subscription->{irregularity} );
2584 #date supposed to be in ISO.
2586 my ( $year, $month, $day ) = split(/-/, $planneddate);
2587 $month=1 unless ($month);
2588 $day=1 unless ($day);
2591 # warn "DOW $dayofweek";
2592 if ( $subscription->{periodicity} == 0 ) {
2595 if ( $subscription->{periodicity} == 1 ) {
2596 my $dayofweek = Day_of_Week( $year,$month, $day );
2597 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2598 $dayofweek = 0 if ( $dayofweek == 7 );
2599 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2600 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2604 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2606 if ( $subscription->{periodicity} == 2 ) {
2607 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2608 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2609 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2610 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2611 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2614 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2616 if ( $subscription->{periodicity} == 3 ) {
2617 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2618 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2619 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2620 ### BUGFIX was previously +1 ^
2621 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2622 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2625 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2627 if ( $subscription->{periodicity} == 4 ) {
2628 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2629 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2630 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2631 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2632 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2635 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2637 my $tmpmonth=$month;
2638 if ( $subscription->{periodicity} == 5 ) {
2639 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2640 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2641 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2642 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2645 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2647 if ( $subscription->{periodicity} == 6 ) {
2648 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2649 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2650 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2651 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2654 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2656 if ( $subscription->{periodicity} == 7 ) {
2657 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2658 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2659 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2660 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2663 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2665 if ( $subscription->{periodicity} == 8 ) {
2666 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2667 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2668 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2669 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2672 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2674 if ( $subscription->{periodicity} == 9 ) {
2675 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2676 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2677 ### BUFIX Seems to need more Than One ?
2678 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2679 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2682 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2684 if ( $subscription->{periodicity} == 10 ) {
2685 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2687 if ( $subscription->{periodicity} == 11 ) {
2688 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2690 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2691 # warn "dateNEXTSEQ : ".$resultdate;
2692 return "$resultdate";
2697 $item = &itemdata($barcode);
2699 Looks up the item with the given barcode, and returns a
2700 reference-to-hash containing information about that item. The keys of
2701 the hash are the fields from the C<items> and C<biblioitems> tables in
2709 my $dbh = C4::Context->dbh;
2710 my $sth = $dbh->prepare(
2711 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2714 $sth->execute($barcode);
2715 my $data = $sth->fetchrow_hashref;
2720 END { } # module clean-up code here (global destructor)
2728 Koha Developement team <info@koha.org>