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
22 use C4::Dates qw(format_date format_date_in_iso);
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 $VERSION = 3.00; # set version for version checking
40 C4::Serials - Give functions for serializing.
48 Give all XYZ functions
57 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
58 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
59 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
60 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
62 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
63 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
64 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
65 &GetSerialInformation &AddItem2Serial
68 &UpdateClaimdateIssues
69 &GetSuppliersWithLateIssues &getsupplierbyserialid
70 &GetDistributedTo &SetDistributedTo
71 &getroutinglist &delroutingmember &addroutingmember
73 &check_routing &updateClaim &removeMissingIssue
75 &old_newsubscription &old_modsubscription &old_getserials
78 =head2 GetSuppliersWithLateIssues
82 %supplierlist = &GetSuppliersWithLateIssues
84 this function get all suppliers with late issues.
87 the supplierlist into a hash. this hash containts id & name of the supplier
93 sub GetSuppliersWithLateIssues {
94 my $dbh = C4::Context->dbh;
96 SELECT DISTINCT id, name
98 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
99 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
100 WHERE subscription.subscriptionid = serial.subscriptionid
101 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
104 my $sth = $dbh->prepare($query);
107 while ( my ( $id, $name ) = $sth->fetchrow ) {
108 $supplierlist{$id} = $name;
110 if ( C4::Context->preference("RoutingSerials") ) {
111 $supplierlist{''} = "All Suppliers";
113 return %supplierlist;
120 @issuelist = &GetLateIssues($supplierid)
122 this function select late issues on database
125 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
126 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
133 my ($supplierid) = @_;
134 my $dbh = C4::Context->dbh;
138 SELECT name,title,planneddate,serialseq,serial.subscriptionid
140 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
141 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
142 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
143 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
144 AND subscription.aqbooksellerid=$supplierid
147 $sth = $dbh->prepare($query);
151 SELECT name,title,planneddate,serialseq,serial.subscriptionid
153 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
154 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
155 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
156 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
159 $sth = $dbh->prepare($query);
166 while ( my $line = $sth->fetchrow_hashref ) {
167 $odd++ unless $line->{title} eq $last_title;
168 $line->{title} = "" if $line->{title} eq $last_title;
169 $last_title = $line->{title} if ( $line->{title} );
170 $line->{planneddate} = format_date( $line->{planneddate} );
172 push @issuelist, $line;
174 return $count, @issuelist;
177 =head2 GetSubscriptionHistoryFromSubscriptionId
181 $sth = GetSubscriptionHistoryFromSubscriptionId()
182 this function just prepare the SQL request.
183 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
185 $sth = $dbh->prepare($query).
191 sub GetSubscriptionHistoryFromSubscriptionId() {
192 my $dbh = C4::Context->dbh;
195 FROM subscriptionhistory
196 WHERE subscriptionid = ?
198 return $dbh->prepare($query);
201 =head2 GetSerialStatusFromSerialId
205 $sth = GetSerialStatusFromSerialId();
206 this function just prepare the SQL request.
207 After this function, don't forget to execute it by using $sth->execute($serialid)
209 $sth = $dbh->prepare($query).
215 sub GetSerialStatusFromSerialId() {
216 my $dbh = C4::Context->dbh;
222 return $dbh->prepare($query);
225 =head2 GetSerialInformation
229 $data = GetSerialInformation($serialid);
230 returns a hash containing :
231 items : items marcrecord (can be an array)
233 subscription table field
234 + information about subscription expiration
240 sub GetSerialInformation {
242 my $dbh = C4::Context->dbh;
244 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid|;
245 if (C4::Context->preference('IndependantBranches') &&
246 C4::Context->userenv &&
247 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
249 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
252 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
255 my $rq = $dbh->prepare($query);
256 $rq->execute($serialid);
257 my $data = $rq->fetchrow_hashref;
259 if ( C4::Context->preference("serialsadditems") ) {
260 if ( $data->{'itemnumber'} ) {
261 my @itemnumbers = split /,/, $data->{'itemnumber'};
262 foreach my $itemnum (@itemnumbers) {
264 #It is ASSUMED that GetMarcItem ALWAYS WORK...
265 #Maybe GetMarcItem should return values on failure
266 # warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
268 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
269 $itemprocessed->{'itemnumber'} = $itemnum;
270 $itemprocessed->{'itemid'} = $itemnum;
271 $itemprocessed->{'serialid'} = $serialid;
272 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
273 push @{ $data->{'items'} }, $itemprocessed;
278 PrepareItemrecordDisplay( $data->{'biblionumber'} );
279 $itemprocessed->{'itemid'} = "N$serialid";
280 $itemprocessed->{'serialid'} = $serialid;
281 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
282 $itemprocessed->{'countitems'} = 0;
283 push @{ $data->{'items'} }, $itemprocessed;
286 $data->{ "status" . $data->{'serstatus'} } = 1;
287 $data->{'subscriptionexpired'} =
288 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
289 $data->{'abouttoexpire'} =
290 abouttoexpire( $data->{'subscriptionid'} );
294 =head2 AddItem2Serial
298 $data = AddItem2Serial($serialid,$itemnumber);
299 Adds an itemnumber to Serial record
305 my ( $serialid, $itemnumber ) = @_;
306 my $dbh = C4::Context->dbh;
308 UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber))
311 my $rq = $dbh->prepare($query);
312 $rq->execute($serialid);
316 =head2 UpdateClaimdateIssues
320 UpdateClaimdateIssues($serialids,[$date]);
322 Update Claimdate for issues in @$serialids list with date $date
328 sub UpdateClaimdateIssues {
329 my ( $serialids, $date ) = @_;
330 my $dbh = C4::Context->dbh;
331 $date = strftime("%Y-%m-%d",localtime) unless ($date);
333 UPDATE serial SET claimdate=$date,status=7
334 WHERE serialid in ".join (",",@$serialids);
336 my $rq = $dbh->prepare($query);
341 =head2 GetSubscription
345 $subs = GetSubscription($subscriptionid)
346 this function get the subscription which has $subscriptionid as id.
348 a hashref. This hash containts
349 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
355 sub GetSubscription {
356 my ($subscriptionid) = @_;
357 my $dbh = C4::Context->dbh;
359 SELECT subscription.*,
360 subscriptionhistory.*,
362 aqbooksellers.name AS aqbooksellername,
363 biblio.title AS bibliotitle,
364 subscription.biblionumber as bibnum);
365 if (C4::Context->preference('IndependantBranches') &&
366 C4::Context->userenv &&
367 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
369 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
373 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
374 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
375 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
376 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
377 WHERE subscription.subscriptionid = ?
379 # if (C4::Context->preference('IndependantBranches') &&
380 # C4::Context->userenv &&
381 # C4::Context->userenv->{'flags'} != 1){
382 # # warn "flags: ".C4::Context->userenv->{'flags'};
383 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
385 # warn "query : $query";
386 my $sth = $dbh->prepare($query);
387 # warn "subsid :$subscriptionid";
388 $sth->execute($subscriptionid);
389 my $subs = $sth->fetchrow_hashref;
393 =head2 GetFullSubscription
397 \@res = GetFullSubscription($subscriptionid)
398 this function read on serial table.
404 sub GetFullSubscription {
405 my ($subscriptionid) = @_;
406 my $dbh = C4::Context->dbh;
408 SELECT serial.serialid,
411 serial.publisheddate,
413 serial.notes as notes,
414 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
415 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
416 biblio.title as bibliotitle,
417 subscription.branchcode AS branchcode,
418 subscription.subscriptionid AS subscriptionid |;
419 if (C4::Context->preference('IndependantBranches') &&
420 C4::Context->userenv &&
421 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
423 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
427 LEFT JOIN subscription ON
428 (serial.subscriptionid=subscription.subscriptionid )
429 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
430 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
431 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
432 WHERE serial.subscriptionid = ?
434 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
435 serial.subscriptionid
438 my $sth = $dbh->prepare($query);
439 $sth->execute($subscriptionid);
440 my $subs = $sth->fetchall_arrayref({});
445 =head2 PrepareSerialsData
449 \@res = PrepareSerialsData($serialinfomation)
450 where serialinformation is a hashref array
456 sub PrepareSerialsData{
462 my $aqbooksellername;
466 my $previousnote = "";
468 foreach my $subs ( @$lines ) {
469 $subs->{'publisheddate'} =
470 ( $subs->{'publisheddate'}
471 ? format_date( $subs->{'publisheddate'} )
473 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
474 $subs->{ "status" . $subs->{'status'} } = 1;
476 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
477 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
478 $year = $subs->{'year'};
483 if ( $tmpresults{$year} ) {
484 push @{ $tmpresults{$year}->{'serials'} }, $subs;
487 $tmpresults{$year} = {
490 # 'startdate'=>format_date($subs->{'startdate'}),
491 'aqbooksellername' => $subs->{'aqbooksellername'},
492 'bibliotitle' => $subs->{'bibliotitle'},
493 'serials' => [$subs],
495 # 'branchcode' => $subs->{'branchcode'},
496 # 'subscriptionid' => $subs->{'subscriptionid'},
500 # $previousnote=$subs->{notes};
502 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
503 push @res, $tmpresults{$key};
505 $res[0]->{'first'}=1;
509 =head2 GetSubscriptionsFromBiblionumber
511 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
512 this function get the subscription list. it reads on subscription table.
514 table of subscription which has the biblionumber given on input arg.
515 each line of this table is a hashref. All hashes containt
516 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
520 sub GetSubscriptionsFromBiblionumber {
521 my ($biblionumber) = @_;
522 my $dbh = C4::Context->dbh;
524 SELECT subscription.*,
526 subscriptionhistory.*,
528 aqbooksellers.name AS aqbooksellername,
529 biblio.title AS bibliotitle
531 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
532 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
533 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
534 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
535 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
536 WHERE subscription.biblionumber = ?
538 # if (C4::Context->preference('IndependantBranches') &&
539 # C4::Context->userenv &&
540 # C4::Context->userenv->{'flags'} != 1){
541 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
543 my $sth = $dbh->prepare($query);
544 $sth->execute($biblionumber);
546 while ( my $subs = $sth->fetchrow_hashref ) {
547 $subs->{startdate} = format_date( $subs->{startdate} );
548 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
549 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
550 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
551 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
552 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
553 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
554 $subs->{ "status" . $subs->{'status'} } = 1;
555 $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
556 C4::Context->userenv &&
557 C4::Context->userenv->{flags} !=1 &&
558 C4::Context->userenv->{branch} && $subs->{branchcode} &&
559 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
560 if ( $subs->{enddate} eq '0000-00-00' ) {
561 $subs->{enddate} = '';
564 $subs->{enddate} = format_date( $subs->{enddate} );
566 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
567 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
573 =head2 GetFullSubscriptionsFromBiblionumber
577 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
578 this function read on serial table.
584 sub GetFullSubscriptionsFromBiblionumber {
585 my ($biblionumber) = @_;
586 my $dbh = C4::Context->dbh;
588 SELECT serial.serialid,
591 serial.publisheddate,
593 serial.notes as notes,
594 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
595 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
596 biblio.title as bibliotitle,
597 subscription.branchcode AS branchcode,
598 subscription.subscriptionid AS subscriptionid|;
599 if (C4::Context->preference('IndependantBranches') &&
600 C4::Context->userenv &&
601 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
603 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
608 LEFT JOIN subscription ON
609 (serial.subscriptionid=subscription.subscriptionid)
610 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
611 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
612 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
613 WHERE subscription.biblionumber = ?
615 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
616 serial.subscriptionid
618 my $sth = $dbh->prepare($query);
619 $sth->execute($biblionumber);
620 my $subs= $sth->fetchall_arrayref({});
624 =head2 GetSubscriptions
628 @results = GetSubscriptions($title,$ISSN,$biblionumber);
629 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
631 a table of hashref. Each hash containt the subscription.
637 sub GetSubscriptions {
638 my ( $title, $ISSN, $biblionumber ) = @_;
639 #return unless $title or $ISSN or $biblionumber;
640 my $dbh = C4::Context->dbh;
644 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
646 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
647 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
648 WHERE biblio.biblionumber=?
650 $query.=" ORDER BY title";
651 # warn "query :$query";
652 $sth = $dbh->prepare($query);
653 $sth->execute($biblionumber);
656 if ( $ISSN and $title ) {
658 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
660 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
661 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
662 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
663 $query.=" ORDER BY title";
664 $sth = $dbh->prepare($query);
665 $sth->execute( $ISSN );
670 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
672 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
673 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
674 WHERE biblioitems.issn LIKE ?
676 $query.=" ORDER BY title";
677 # warn "query :$query";
678 $sth = $dbh->prepare($query);
679 $sth->execute( "%" . $ISSN . "%" );
683 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
685 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
686 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
688 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
690 $query.=" ORDER BY title";
692 $sth = $dbh->prepare($query);
698 my $previoustitle = "";
700 while ( my $line = $sth->fetchrow_hashref ) {
701 if ( $previoustitle eq $line->{title} ) {
704 $line->{toggle} = 1 if $odd == 1;
707 $previoustitle = $line->{title};
709 $line->{toggle} = 1 if $odd == 1;
711 $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
712 C4::Context->userenv &&
713 C4::Context->userenv->{flags} !=1 &&
714 C4::Context->userenv->{branch} && $line->{branchcode} &&
715 (C4::Context->userenv->{branch} ne $line->{branchcode}));
716 push @results, $line;
725 ($totalissues,@serials) = GetSerials($subscriptionid);
726 this function get every serial not arrived for a given subscription
727 as well as the number of issues registered in the database (all types)
728 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
735 my ($subscriptionid,$count) = @_;
736 my $dbh = C4::Context->dbh;
738 # status = 2 is "arrived"
740 $count=5 unless ($count);
743 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
745 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
746 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
747 my $sth = $dbh->prepare($query);
748 $sth->execute($subscriptionid);
749 while ( my $line = $sth->fetchrow_hashref ) {
750 $line->{ "status" . $line->{status} } =
751 1; # fills a "statusX" value, used for template status select list
752 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
753 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
754 push @serials, $line;
756 # OK, now add the last 5 issues arrives/missing
758 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
760 WHERE subscriptionid = ?
761 AND (status in (2,4,5))
762 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
764 $sth = $dbh->prepare($query);
765 $sth->execute($subscriptionid);
766 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
768 $line->{ "status" . $line->{status} } =
769 1; # fills a "statusX" value, used for template status select list
770 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
771 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
772 push @serials, $line;
775 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
776 $sth = $dbh->prepare($query);
777 $sth->execute($subscriptionid);
778 my ($totalissues) = $sth->fetchrow;
779 return ( $totalissues, @serials );
786 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
787 this function get every serial waited for a given subscription
788 as well as the number of issues registered in the database (all types)
789 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
795 my ($subscription,$status) = @_;
796 my $dbh = C4::Context->dbh;
798 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
800 WHERE subscriptionid=$subscription AND status IN ($status)
801 ORDER BY publisheddate,serialid DESC
804 my $sth=$dbh->prepare($query);
807 while(my $line = $sth->fetchrow_hashref) {
808 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
809 $line->{"planneddate"} = format_date($line->{"planneddate"});
810 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
813 my ($totalissues) = scalar(@serials);
814 return ($totalissues,@serials);
817 =head2 GetLatestSerials
821 \@serials = GetLatestSerials($subscriptionid,$limit)
822 get the $limit's latest serials arrived or missing for a given subscription
824 a ref to a table which it containts all of the latest serials stored into a hash.
830 sub GetLatestSerials {
831 my ( $subscriptionid, $limit ) = @_;
832 my $dbh = C4::Context->dbh;
834 # status = 2 is "arrived"
835 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
837 WHERE subscriptionid = ?
838 AND (status =2 or status=4)
839 ORDER BY planneddate DESC LIMIT 0,$limit
841 my $sth = $dbh->prepare($strsth);
842 $sth->execute($subscriptionid);
844 while ( my $line = $sth->fetchrow_hashref ) {
845 $line->{ "status" . $line->{status} } =
846 1; # fills a "statusX" value, used for template status select list
847 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
848 push @serials, $line;
854 # WHERE subscriptionid=?
856 # $sth=$dbh->prepare($query);
857 # $sth->execute($subscriptionid);
858 # my ($totalissues) = $sth->fetchrow;
862 =head2 GetDistributedTo
866 $distributedto=GetDistributedTo($subscriptionid)
867 This function select the old previous value of distributedto in the database.
873 sub GetDistributedTo {
874 my $dbh = C4::Context->dbh;
876 my $subscriptionid = @_;
877 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
878 my $sth = $dbh->prepare($query);
879 $sth->execute($subscriptionid);
880 return ($distributedto) = $sth->fetchrow;
888 $val is a hashref containing all the attributes of the table 'subscription'
889 This function get the next issue for the subscription given on input arg
891 all the input params updated.
899 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
900 # $calculated = $val->{numberingmethod};
901 # # calculate the (expected) value of the next issue recieved.
902 # $newlastvalue1 = $val->{lastvalue1};
903 # # check if we have to increase the new value.
904 # $newinnerloop1 = $val->{innerloop1}+1;
905 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
906 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
907 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
908 # $calculated =~ s/\{X\}/$newlastvalue1/g;
910 # $newlastvalue2 = $val->{lastvalue2};
911 # # check if we have to increase the new value.
912 # $newinnerloop2 = $val->{innerloop2}+1;
913 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
914 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
915 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
916 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
918 # $newlastvalue3 = $val->{lastvalue3};
919 # # check if we have to increase the new value.
920 # $newinnerloop3 = $val->{innerloop3}+1;
921 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
922 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
923 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
924 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
925 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
931 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
932 $newinnerloop1, $newinnerloop2, $newinnerloop3
934 my $pattern = $val->{numberpattern};
935 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
936 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
937 $calculated = $val->{numberingmethod};
938 $newlastvalue1 = $val->{lastvalue1};
939 $newlastvalue2 = $val->{lastvalue2};
940 $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 if (($subscription->{periodicity} % 16) >0){
1042 if ( $subscription->{numberlength} ) {
1043 #calculate the date of the last issue.
1044 my $length = $subscription->{numberlength};
1045 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1046 $enddate = GetNextDate( $enddate, $subscription );
1049 elsif ( $subscription->{monthlength} ){
1050 my @date=split (/-/,$subscription->{startdate});
1051 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1052 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1053 } elsif ( $subscription->{weeklength} ){
1054 my @date=split (/-/,$subscription->{startdate});
1055 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1056 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1064 =head2 CountSubscriptionFromBiblionumber
1068 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1069 this count the number of subscription for a biblionumber given.
1071 the number of subscriptions with biblionumber given on input arg.
1077 sub CountSubscriptionFromBiblionumber {
1078 my ($biblionumber) = @_;
1079 my $dbh = C4::Context->dbh;
1080 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1081 my $sth = $dbh->prepare($query);
1082 $sth->execute($biblionumber);
1083 my $subscriptionsnumber = $sth->fetchrow;
1084 return $subscriptionsnumber;
1087 =head2 ModSubscriptionHistory
1091 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1093 this function modify the history of a subscription. Put your new values on input arg.
1099 sub ModSubscriptionHistory {
1101 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1102 $missinglist, $opacnote, $librariannote
1104 my $dbh = C4::Context->dbh;
1105 my $query = "UPDATE subscriptionhistory
1106 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1107 WHERE subscriptionid=?
1109 my $sth = $dbh->prepare($query);
1110 $recievedlist =~ s/^,//g;
1111 $missinglist =~ s/^,//g;
1112 $opacnote =~ s/^,//g;
1114 $histstartdate, $enddate, $recievedlist, $missinglist,
1115 $opacnote, $librariannote, $subscriptionid
1120 =head2 ModSerialStatus
1124 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1126 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1127 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1133 sub ModSerialStatus {
1134 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1137 #It is a usual serial
1138 # 1st, get previous status :
1139 my $dbh = C4::Context->dbh;
1140 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1141 my $sth = $dbh->prepare($query);
1142 $sth->execute($serialid);
1143 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1145 # change status & update subscriptionhistory
1147 if ( $status eq 6 ) {
1148 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1152 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1153 $sth = $dbh->prepare($query);
1154 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1155 $notes, $serialid );
1156 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1157 $sth = $dbh->prepare($query);
1158 $sth->execute($subscriptionid);
1159 my $val = $sth->fetchrow_hashref;
1160 unless ( $val->{manualhistory} ) {
1162 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1163 $sth = $dbh->prepare($query);
1164 $sth->execute($subscriptionid);
1165 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1166 if ( $status eq 2 ) {
1168 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1169 $recievedlist .= ",$serialseq"
1170 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1173 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1174 $missinglist .= ",$serialseq"
1176 and not index( "$missinglist", "$serialseq" ) >= 0 );
1177 $missinglist .= ",not issued $serialseq"
1179 and index( "$missinglist", "$serialseq" ) >= 0 );
1181 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1182 $sth = $dbh->prepare($query);
1183 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1187 # create new waited entry if needed (ie : was a "waited" and has changed)
1188 if ( $oldstatus eq 1 && $status ne 1 ) {
1189 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1190 $sth = $dbh->prepare($query);
1191 $sth->execute($subscriptionid);
1192 my $val = $sth->fetchrow_hashref;
1197 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1198 $newinnerloop1, $newinnerloop2, $newinnerloop3
1199 ) = GetNextSeq($val);
1200 # warn "Next Seq End";
1202 # next date (calculated from actual date & frequency parameters)
1203 # warn "publisheddate :$publisheddate ";
1204 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1205 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1206 1, $nextpublisheddate, $nextpublisheddate );
1208 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1209 WHERE subscriptionid = ?";
1210 $sth = $dbh->prepare($query);
1212 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1213 $newinnerloop2, $newinnerloop3, $subscriptionid
1216 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1217 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1218 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1223 =head2 ModSubscription
1227 this function modify a subscription. Put all new values on input args.
1233 sub ModSubscription {
1235 $auser, $branchcode, $aqbooksellerid, $cost,
1236 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1237 $dow, $irregularity, $numberpattern, $numberlength,
1238 $weeklength, $monthlength, $add1, $every1,
1239 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1240 $add2, $every2, $whenmorethan2, $setto2,
1241 $lastvalue2, $innerloop2, $add3, $every3,
1242 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1243 $numberingmethod, $status, $biblionumber, $callnumber,
1244 $notes, $letter, $hemisphere, $manualhistory,
1248 # warn $irregularity;
1249 my $dbh = C4::Context->dbh;
1250 my $query = "UPDATE subscription
1251 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1252 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1253 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1254 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1255 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1256 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1257 WHERE subscriptionid = ?";
1258 # warn "query :".$query;
1259 my $sth = $dbh->prepare($query);
1261 $auser, $branchcode, $aqbooksellerid, $cost,
1262 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1263 $dow, "$irregularity", $numberpattern, $numberlength,
1264 $weeklength, $monthlength, $add1, $every1,
1265 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1266 $add2, $every2, $whenmorethan2, $setto2,
1267 $lastvalue2, $innerloop2, $add3, $every3,
1268 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1269 $numberingmethod, $status, $biblionumber, $callnumber,
1270 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1274 my $rows=$sth->rows;
1277 &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1278 if C4::Context->preference("SubscriptionLog");
1282 =head2 NewSubscription
1286 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1287 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1288 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1289 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1290 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1291 $numberingmethod, $status, $notes)
1293 Create a new subscription with value given on input args.
1296 the id of this new subscription
1302 sub NewSubscription {
1304 $auser, $branchcode, $aqbooksellerid, $cost,
1305 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1306 $dow, $numberlength, $weeklength, $monthlength,
1307 $add1, $every1, $whenmorethan1, $setto1,
1308 $lastvalue1, $innerloop1, $add2, $every2,
1309 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1310 $add3, $every3, $whenmorethan3, $setto3,
1311 $lastvalue3, $innerloop3, $numberingmethod, $status,
1312 $notes, $letter, $firstacquidate, $irregularity,
1313 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1316 my $dbh = C4::Context->dbh;
1318 #save subscription (insert into database)
1320 INSERT INTO subscription
1321 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1322 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1323 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1324 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1325 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1326 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1327 numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1328 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1330 my $sth = $dbh->prepare($query);
1332 $auser, $branchcode,
1333 $aqbooksellerid, $cost,
1334 $aqbudgetid, $biblionumber,
1335 format_date_in_iso($startdate), $periodicity,
1336 $dow, $numberlength,
1337 $weeklength, $monthlength,
1339 $whenmorethan1, $setto1,
1340 $lastvalue1, $innerloop1,
1342 $whenmorethan2, $setto2,
1343 $lastvalue2, $innerloop2,
1345 $whenmorethan3, $setto3,
1346 $lastvalue3, $innerloop3,
1347 $numberingmethod, "$status",
1349 format_date_in_iso($firstacquidate), $irregularity,
1350 $numberpattern, $callnumber,
1351 $hemisphere, $manualhistory,
1355 #then create the 1st waited number
1356 my $subscriptionid = $dbh->{'mysql_insertid'};
1358 INSERT INTO subscriptionhistory
1359 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1360 VALUES (?,?,?,?,?,?,?,?)
1362 $sth = $dbh->prepare($query);
1363 $sth->execute( $biblionumber, $subscriptionid,
1364 format_date_in_iso($startdate),
1365 0, "", "", "", "$notes" );
1367 # reread subscription to get a hash (for calculation of the 1st issue number)
1371 WHERE subscriptionid = ?
1373 $sth = $dbh->prepare($query);
1374 $sth->execute($subscriptionid);
1375 my $val = $sth->fetchrow_hashref;
1377 # calculate issue number
1378 my $serialseq = GetSeq($val);
1381 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1382 VALUES (?,?,?,?,?,?)
1384 $sth = $dbh->prepare($query);
1386 "$serialseq", $subscriptionid, $biblionumber, 1,
1387 format_date_in_iso($startdate),
1388 format_date_in_iso($startdate)
1391 &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1392 if C4::Context->preference("SubscriptionLog");
1394 return $subscriptionid;
1397 =head2 ReNewSubscription
1401 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1403 this function renew a subscription with values given on input args.
1409 sub ReNewSubscription {
1410 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1411 $monthlength, $note )
1413 my $dbh = C4::Context->dbh;
1414 my $subscription = GetSubscription($subscriptionid);
1418 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1419 WHERE biblio.biblionumber=?
1421 my $sth = $dbh->prepare($query);
1422 $sth->execute( $subscription->{biblionumber} );
1423 my $biblio = $sth->fetchrow_hashref;
1425 $user, $subscription->{bibliotitle},
1426 $biblio->{author}, $biblio->{publishercode},
1427 $biblio->{note}, '',
1430 $subscription->{biblionumber}
1433 # renew subscription
1436 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1437 WHERE subscriptionid=?
1439 my $sth = $dbh->prepare($query);
1440 $sth->execute( format_date_in_iso($startdate),
1441 $numberlength, $weeklength, $monthlength, $subscriptionid );
1443 &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1444 if C4::Context->preference("SubscriptionLog");
1451 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1453 Create a new issue stored on the database.
1454 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1461 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1462 $planneddate, $publisheddate, $notes )
1464 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1466 my $dbh = C4::Context->dbh;
1469 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1470 VALUES (?,?,?,?,?,?,?)
1472 my $sth = $dbh->prepare($query);
1473 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1474 $publisheddate, $planneddate,$notes );
1475 my $serialid=$dbh->{'mysql_insertid'};
1477 SELECT missinglist,recievedlist
1478 FROM subscriptionhistory
1479 WHERE subscriptionid=?
1481 $sth = $dbh->prepare($query);
1482 $sth->execute($subscriptionid);
1483 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1485 if ( $status eq 2 ) {
1486 ### TODO Add a feature that improves recognition and description.
1487 ### As such count (serialseq) i.e. : N18,2(N19),N20
1488 ### Would use substr and index But be careful to previous presence of ()
1489 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1491 if ( $status eq 4 ) {
1492 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1495 UPDATE subscriptionhistory
1496 SET recievedlist=?, missinglist=?
1497 WHERE subscriptionid=?
1499 $sth = $dbh->prepare($query);
1500 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1504 =head2 ItemizeSerials
1508 ItemizeSerials($serialid, $info);
1509 $info is a hashref containing barcode branch, itemcallnumber, status, location
1510 $serialid the serialid
1512 1 if the itemize is a succes.
1513 0 and @error else. @error containts the list of errors found.
1519 sub ItemizeSerials {
1520 my ( $serialid, $info ) = @_;
1521 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1523 my $dbh = C4::Context->dbh;
1529 my $sth = $dbh->prepare($query);
1530 $sth->execute($serialid);
1531 my $data = $sth->fetchrow_hashref;
1532 if ( C4::Context->preference("RoutingSerials") ) {
1534 # check for existing biblioitem relating to serial issue
1535 my ( $count, @results ) =
1536 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1538 for ( my $i = 0 ; $i < $count ; $i++ ) {
1539 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1540 . $data->{'planneddate'}
1543 $bibitemno = $results[$i]->{'biblioitemnumber'};
1547 if ( $bibitemno == 0 ) {
1549 # warn "need to add new biblioitem so copy last one and make minor changes";
1552 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1554 $sth->execute( $data->{'biblionumber'} );
1555 my $biblioitem = $sth->fetchrow_hashref;
1556 $biblioitem->{'volumedate'} =
1557 format_date_in_iso( $data->{planneddate} );
1558 $biblioitem->{'volumeddesc'} =
1559 $data->{serialseq} . ' ('
1560 . format_date( $data->{'planneddate'} ) . ')';
1561 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1563 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1564 # so I comment it, we can speak of it when you want
1565 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1566 # if ( $info->{barcode} )
1567 # { # only make biblioitem if we are going to make item also
1568 # $bibitemno = newbiblioitem($biblioitem);
1573 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1574 if ( $info->{barcode} ) {
1576 my $exists = itemdata( $info->{'barcode'} );
1577 push @errors, "barcode_not_unique" if ($exists);
1579 my $marcrecord = MARC::Record->new();
1580 my ( $tag, $subfield ) =
1581 GetMarcFromKohaField( "items.barcode", $fwk );
1583 MARC::Field->new( "$tag", '', '',
1584 "$subfield" => $info->{barcode} );
1585 $marcrecord->insert_fields_ordered($newField);
1586 if ( $info->{branch} ) {
1587 my ( $tag, $subfield ) =
1588 GetMarcFromKohaField( "items.homebranch",
1591 #warn "items.homebranch : $tag , $subfield";
1592 if ( $marcrecord->field($tag) ) {
1593 $marcrecord->field($tag)
1594 ->add_subfields( "$subfield" => $info->{branch} );
1598 MARC::Field->new( "$tag", '', '',
1599 "$subfield" => $info->{branch} );
1600 $marcrecord->insert_fields_ordered($newField);
1602 ( $tag, $subfield ) =
1603 GetMarcFromKohaField( "items.holdingbranch",
1606 #warn "items.holdingbranch : $tag , $subfield";
1607 if ( $marcrecord->field($tag) ) {
1608 $marcrecord->field($tag)
1609 ->add_subfields( "$subfield" => $info->{branch} );
1613 MARC::Field->new( "$tag", '', '',
1614 "$subfield" => $info->{branch} );
1615 $marcrecord->insert_fields_ordered($newField);
1618 if ( $info->{itemcallnumber} ) {
1619 my ( $tag, $subfield ) =
1620 GetMarcFromKohaField( "items.itemcallnumber",
1623 #warn "items.itemcallnumber : $tag , $subfield";
1624 if ( $marcrecord->field($tag) ) {
1625 $marcrecord->field($tag)
1626 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1630 MARC::Field->new( "$tag", '', '',
1631 "$subfield" => $info->{itemcallnumber} );
1632 $marcrecord->insert_fields_ordered($newField);
1635 if ( $info->{notes} ) {
1636 my ( $tag, $subfield ) =
1637 GetMarcFromKohaField( "items.itemnotes", $fwk );
1639 # warn "items.itemnotes : $tag , $subfield";
1640 if ( $marcrecord->field($tag) ) {
1641 $marcrecord->field($tag)
1642 ->add_subfields( "$subfield" => $info->{notes} );
1646 MARC::Field->new( "$tag", '', '',
1647 "$subfield" => $info->{notes} );
1648 $marcrecord->insert_fields_ordered($newField);
1651 if ( $info->{location} ) {
1652 my ( $tag, $subfield ) =
1653 GetMarcFromKohaField( "items.location", $fwk );
1655 # warn "items.location : $tag , $subfield";
1656 if ( $marcrecord->field($tag) ) {
1657 $marcrecord->field($tag)
1658 ->add_subfields( "$subfield" => $info->{location} );
1662 MARC::Field->new( "$tag", '', '',
1663 "$subfield" => $info->{location} );
1664 $marcrecord->insert_fields_ordered($newField);
1667 if ( $info->{status} ) {
1668 my ( $tag, $subfield ) =
1669 GetMarcFromKohaField( "items.notforloan",
1672 # warn "items.notforloan : $tag , $subfield";
1673 if ( $marcrecord->field($tag) ) {
1674 $marcrecord->field($tag)
1675 ->add_subfields( "$subfield" => $info->{status} );
1679 MARC::Field->new( "$tag", '', '',
1680 "$subfield" => $info->{status} );
1681 $marcrecord->insert_fields_ordered($newField);
1684 if ( C4::Context->preference("RoutingSerials") ) {
1685 my ( $tag, $subfield ) =
1686 GetMarcFromKohaField( "items.dateaccessioned",
1688 if ( $marcrecord->field($tag) ) {
1689 $marcrecord->field($tag)
1690 ->add_subfields( "$subfield" => $now );
1694 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1695 $marcrecord->insert_fields_ordered($newField);
1698 AddItem( $marcrecord, $data->{'biblionumber'} );
1701 return ( 0, @errors );
1705 =head2 HasSubscriptionExpired
1709 1 or 0 = HasSubscriptionExpired($subscriptionid)
1711 the subscription has expired when the next issue to arrive is out of subscription limit.
1714 1 if true, 0 if false.
1720 sub HasSubscriptionExpired {
1721 my ($subscriptionid) = @_;
1722 my $dbh = C4::Context->dbh;
1723 my $subscription = GetSubscription($subscriptionid);
1724 if (($subscription->{periodicity} % 16)>0){
1725 my $expirationdate = GetExpirationDate($subscriptionid);
1727 SELECT max(planneddate)
1729 WHERE subscriptionid=?
1731 my $sth = $dbh->prepare($query);
1732 $sth->execute($subscriptionid);
1733 my ($res) = $sth->fetchrow ;
1734 my @res=split (/-/,$res);
1735 # warn "date expiration :$expirationdate";
1736 my @endofsubscriptiondate=split(/-/,$expirationdate);
1737 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1738 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1742 if ($subscription->{'numberlength'}){
1743 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1744 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1753 =head2 SetDistributedto
1757 SetDistributedto($distributedto,$subscriptionid);
1758 This function update the value of distributedto for a subscription given on input arg.
1764 sub SetDistributedto {
1765 my ( $distributedto, $subscriptionid ) = @_;
1766 my $dbh = C4::Context->dbh;
1770 WHERE subscriptionid=?
1772 my $sth = $dbh->prepare($query);
1773 $sth->execute( $distributedto, $subscriptionid );
1776 =head2 DelSubscription
1780 DelSubscription($subscriptionid)
1781 this function delete the subscription which has $subscriptionid as id.
1787 sub DelSubscription {
1788 my ($subscriptionid) = @_;
1789 my $dbh = C4::Context->dbh;
1790 $subscriptionid = $dbh->quote($subscriptionid);
1791 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1793 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1794 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1796 &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1797 if C4::Context->preference("SubscriptionLog");
1804 DelIssue($serialseq,$subscriptionid)
1805 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1812 my ( $dataissue) = @_;
1813 my $dbh = C4::Context->dbh;
1814 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1819 AND subscriptionid= ?
1821 my $mainsth = $dbh->prepare($query);
1822 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1824 #Delete element from subscription history
1825 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1826 my $sth = $dbh->prepare($query);
1827 $sth->execute($dataissue->{'subscriptionid'});
1828 my $val = $sth->fetchrow_hashref;
1829 unless ( $val->{manualhistory} ) {
1831 SELECT * FROM subscriptionhistory
1832 WHERE subscriptionid= ?
1834 my $sth = $dbh->prepare($query);
1835 $sth->execute($dataissue->{'subscriptionid'});
1836 my $data = $sth->fetchrow_hashref;
1837 my $serialseq= $dataissue->{'serialseq'};
1838 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1839 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1840 my $strsth = "UPDATE subscriptionhistory SET "
1842 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1843 . " WHERE subscriptionid=?";
1844 $sth = $dbh->prepare($strsth);
1845 $sth->execute($dataissue->{'subscriptionid'});
1848 return $mainsth->rows;
1851 =head2 GetLateOrMissingIssues
1855 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1857 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1860 a count of the number of missing issues
1861 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1862 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1868 sub GetLateOrMissingIssues {
1869 my ( $supplierid, $serialid,$order ) = @_;
1870 my $dbh = C4::Context->dbh;
1874 $byserial = "and serialid = " . $serialid;
1882 $sth = $dbh->prepare(
1891 serial.subscriptionid,
1894 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1895 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1896 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1897 WHERE subscription.subscriptionid = serial.subscriptionid
1898 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1899 AND subscription.aqbooksellerid=$supplierid
1905 $sth = $dbh->prepare(
1914 serial.subscriptionid,
1917 LEFT JOIN subscription
1918 ON serial.subscriptionid=subscription.subscriptionid
1920 ON subscription.biblionumber=biblio.biblionumber
1921 LEFT JOIN aqbooksellers
1922 ON subscription.aqbooksellerid = aqbooksellers.id
1924 subscription.subscriptionid = serial.subscriptionid
1925 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
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;
2300 if ( $per == 1 ) {$x=7;}
2301 if ( $per == 2 ) {$x=7; }
2302 if ( $per == 3 ) {$x=14;}
2303 if ( $per == 4 ) { $x = 21; }
2304 if ( $per == 5 ) { $x = 31; }
2305 if ( $per == 6 ) { $x = 62; }
2306 if ( $per == 7 || $per == 8 ) { $x = 93; }
2307 if ( $per == 9 ) { $x = 190; }
2308 if ( $per == 10 ) { $x = 365; }
2309 if ( $per == 11 ) { $x = 730; }
2310 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2311 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2312 # warn "DATE BEFORE END: $datebeforeend";
2313 return 1 if ( @res &&
2315 Delta_Days($res[0],$res[1],$res[2],
2316 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2317 (@endofsubscriptiondate &&
2318 Delta_Days($res[0],$res[1],$res[2],
2319 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2321 } elsif ($subscription->{numberlength}>0) {
2322 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2326 =head2 old_newsubscription
2330 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2331 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2332 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2333 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2334 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2335 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2337 this function is similar to the NewSubscription subroutine but has a few different
2339 $firstacquidate - date of first serial issue to arrive
2340 $irregularity - the issues not expected separated by a '|'
2341 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2342 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2343 subscription-add.tmpl file
2344 $callnumber - display the callnumber of the serial
2345 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2348 the $subscriptionid number of the new subscription
2354 sub old_newsubscription {
2356 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2357 $biblionumber, $startdate, $periodicity, $firstacquidate,
2358 $dow, $irregularity, $numberpattern, $numberlength,
2359 $weeklength, $monthlength, $add1, $every1,
2360 $whenmorethan1, $setto1, $lastvalue1, $add2,
2361 $every2, $whenmorethan2, $setto2, $lastvalue2,
2362 $add3, $every3, $whenmorethan3, $setto3,
2363 $lastvalue3, $numberingmethod, $status, $callnumber,
2366 my $dbh = C4::Context->dbh;
2369 my $sth = $dbh->prepare(
2370 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2371 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2372 add1,every1,whenmorethan1,setto1,lastvalue1,
2373 add2,every2,whenmorethan2,setto2,lastvalue2,
2374 add3,every3,whenmorethan3,setto3,lastvalue3,
2375 numberingmethod, status, callnumber, notes, hemisphere) values
2376 (?,?,?,?,?,?,?,?,?,?,?,
2377 ?,?,?,?,?,?,?,?,?,?,?,
2378 ?,?,?,?,?,?,?,?,?,?,?,?)"
2381 $auser, $aqbooksellerid,
2383 $biblionumber, format_date_in_iso($startdate),
2384 $periodicity, format_date_in_iso($firstacquidate),
2385 $dow, $irregularity,
2386 $numberpattern, $numberlength,
2387 $weeklength, $monthlength,
2389 $whenmorethan1, $setto1,
2391 $every2, $whenmorethan2,
2392 $setto2, $lastvalue2,
2394 $whenmorethan3, $setto3,
2395 $lastvalue3, $numberingmethod,
2396 $status, $callnumber,
2400 #then create the 1st waited number
2401 my $subscriptionid = $dbh->{'mysql_insertid'};
2402 my $enddate = GetExpirationDate($subscriptionid);
2406 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2409 $biblionumber, $subscriptionid,
2410 format_date_in_iso($startdate),
2411 format_date_in_iso($enddate),
2415 # reread subscription to get a hash (for calculation of the 1st issue number)
2417 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2418 $sth->execute($subscriptionid);
2419 my $val = $sth->fetchrow_hashref;
2421 # calculate issue number
2422 my $serialseq = GetSeq($val);
2425 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2427 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2428 1, format_date_in_iso($startdate) );
2429 return $subscriptionid;
2432 =head2 old_modsubscription
2436 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2437 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2438 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2439 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2440 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2441 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2443 this function is similar to the ModSubscription subroutine but has a few different
2445 $firstacquidate - date of first serial issue to arrive
2446 $irregularity - the issues not expected separated by a '|'
2447 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2448 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2449 subscription-add.tmpl file
2450 $callnumber - display the callnumber of the serial
2451 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2457 sub old_modsubscription {
2459 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2460 $startdate, $periodicity, $firstacquidate, $dow,
2461 $irregularity, $numberpattern, $numberlength, $weeklength,
2462 $monthlength, $add1, $every1, $whenmorethan1,
2463 $setto1, $lastvalue1, $innerloop1, $add2,
2464 $every2, $whenmorethan2, $setto2, $lastvalue2,
2465 $innerloop2, $add3, $every3, $whenmorethan3,
2466 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2467 $status, $biblionumber, $callnumber, $notes,
2468 $hemisphere, $subscriptionid
2470 my $dbh = C4::Context->dbh;
2471 my $sth = $dbh->prepare(
2472 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2473 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2474 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2475 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2476 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2477 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2480 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2481 $startdate, $periodicity, $firstacquidate, $dow,
2482 $irregularity, $numberpattern, $numberlength, $weeklength,
2483 $monthlength, $add1, $every1, $whenmorethan1,
2484 $setto1, $lastvalue1, $innerloop1, $add2,
2485 $every2, $whenmorethan2, $setto2, $lastvalue2,
2486 $innerloop2, $add3, $every3, $whenmorethan3,
2487 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2488 $status, $biblionumber, $callnumber, $notes,
2489 $hemisphere, $subscriptionid
2494 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2495 $sth->execute($subscriptionid);
2496 my $val = $sth->fetchrow_hashref;
2498 # calculate issue number
2499 my $serialseq = Get_Seq($val);
2501 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2502 $sth->execute( $serialseq, $subscriptionid );
2504 my $enddate = subscriptionexpirationdate($subscriptionid);
2505 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2506 $sth->execute( format_date_in_iso($enddate) );
2509 =head2 old_getserials
2513 ($totalissues,@serials) = &old_getserials($subscriptionid)
2515 this function get a hashref of serials and the total count of them
2518 $totalissues - number of serial lines
2519 the serials into a table. Each line of this table containts a ref to a hash which it containts
2520 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2526 sub old_getserials {
2527 my ($subscriptionid) = @_;
2528 my $dbh = C4::Context->dbh;
2530 # status = 2 is "arrived"
2533 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2535 $sth->execute($subscriptionid);
2538 while ( my $line = $sth->fetchrow_hashref ) {
2539 $line->{ "status" . $line->{status} } =
2540 1; # fills a "statusX" value, used for template status select list
2541 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2542 $line->{"num"} = $num;
2544 push @serials, $line;
2546 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2547 $sth->execute($subscriptionid);
2548 my ($totalissues) = $sth->fetchrow;
2549 return ( $totalissues, @serials );
2554 ($resultdate) = &GetNextDate($planneddate,$subscription)
2556 this function is an extension of GetNextDate which allows for checking for irregularity
2558 it takes the planneddate and will return the next issue's date and will skip dates if there
2559 exists an irregularity
2560 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2561 skipped then the returned date will be 2007-05-10
2564 $resultdate - then next date in the sequence
2566 Return 0 if periodicity==0
2569 sub in_array { # used in next sub down
2570 my ($val,@elements) = @_;
2571 foreach my $elem(@elements) {
2579 sub GetNextDate(@) {
2580 my ( $planneddate, $subscription ) = @_;
2581 my @irreg = split( /\,/, $subscription->{irregularity} );
2583 #date supposed to be in ISO.
2585 my ( $year, $month, $day ) = split(/-/, $planneddate);
2586 $month=1 unless ($month);
2587 $day=1 unless ($day);
2590 # warn "DOW $dayofweek";
2591 if ( $subscription->{periodicity} % 16 == 0 ) {
2594 if ( $subscription->{periodicity} == 1 ) {
2595 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2596 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2598 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2599 $dayofweek = 0 if ( $dayofweek == 7 );
2600 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2601 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2605 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2608 if ( $subscription->{periodicity} == 2 ) {
2609 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2610 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2612 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2613 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2614 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2615 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2618 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2621 if ( $subscription->{periodicity} == 3 ) {
2622 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2623 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2625 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2626 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2627 ### BUGFIX was previously +1 ^
2628 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2629 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2632 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2635 if ( $subscription->{periodicity} == 4 ) {
2636 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2637 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2639 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2640 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2641 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2642 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2645 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2648 my $tmpmonth=$month;
2649 if ($year && $month && $day){
2650 if ( $subscription->{periodicity} == 5 ) {
2651 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2652 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2653 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2654 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2657 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2659 if ( $subscription->{periodicity} == 6 ) {
2660 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2661 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2662 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2663 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2666 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2668 if ( $subscription->{periodicity} == 7 ) {
2669 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2670 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2671 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2672 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2675 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2677 if ( $subscription->{periodicity} == 8 ) {
2678 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2679 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2680 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2681 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2684 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2686 if ( $subscription->{periodicity} == 9 ) {
2687 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2688 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2689 ### BUFIX Seems to need more Than One ?
2690 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2691 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2694 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2696 if ( $subscription->{periodicity} == 10 ) {
2697 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2699 if ( $subscription->{periodicity} == 11 ) {
2700 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2703 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2705 # warn "dateNEXTSEQ : ".$resultdate;
2706 return "$resultdate";
2711 $item = &itemdata($barcode);
2713 Looks up the item with the given barcode, and returns a
2714 reference-to-hash containing information about that item. The keys of
2715 the hash are the fields from the C<items> and C<biblioitems> tables in
2723 my $dbh = C4::Context->dbh;
2724 my $sth = $dbh->prepare(
2725 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2728 $sth->execute($barcode);
2729 my $data = $sth->fetchrow_hashref;
2734 END { } # module clean-up code here (global destructor)
2742 Koha Developement team <info@koha.org>