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);
31 use C4::Log; # logaction
33 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
36 $VERSION = 3.01; # set version for version checking
40 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
41 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
42 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
43 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
45 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
46 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
47 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
48 &GetSerialInformation &AddItem2Serial
51 &UpdateClaimdateIssues
52 &GetSuppliersWithLateIssues &getsupplierbyserialid
53 &GetDistributedTo &SetDistributedTo
54 &getroutinglist &delroutingmember &addroutingmember
56 &check_routing &updateClaim &removeMissingIssue
58 &old_newsubscription &old_modsubscription &old_getserials
62 =head2 GetSuppliersWithLateIssues
66 C4::Serials - Give functions for serializing.
74 Give all XYZ functions
80 %supplierlist = &GetSuppliersWithLateIssues
82 this function get all suppliers with late issues.
85 the supplierlist into a hash. this hash containts id & name of the supplier
91 sub GetSuppliersWithLateIssues {
92 my $dbh = C4::Context->dbh;
94 SELECT DISTINCT id, name
96 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
97 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
98 WHERE subscription.subscriptionid = serial.subscriptionid
99 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
102 my $sth = $dbh->prepare($query);
105 while ( my ( $id, $name ) = $sth->fetchrow ) {
106 $supplierlist{$id} = $name;
108 if ( C4::Context->preference("RoutingSerials") ) {
109 $supplierlist{''} = "All Suppliers";
111 return %supplierlist;
118 @issuelist = &GetLateIssues($supplierid)
120 this function select late issues on database
123 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
124 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
131 my ($supplierid) = @_;
132 my $dbh = C4::Context->dbh;
136 SELECT name,title,planneddate,serialseq,serial.subscriptionid
138 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
139 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
140 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
141 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
142 AND subscription.aqbooksellerid=$supplierid
145 $sth = $dbh->prepare($query);
149 SELECT name,title,planneddate,serialseq,serial.subscriptionid
151 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
152 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
153 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
154 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
157 $sth = $dbh->prepare($query);
164 while ( my $line = $sth->fetchrow_hashref ) {
165 $odd++ unless $line->{title} eq $last_title;
166 $line->{title} = "" if $line->{title} eq $last_title;
167 $last_title = $line->{title} if ( $line->{title} );
168 $line->{planneddate} = format_date( $line->{planneddate} );
170 push @issuelist, $line;
172 return $count, @issuelist;
175 =head2 GetSubscriptionHistoryFromSubscriptionId
179 $sth = GetSubscriptionHistoryFromSubscriptionId()
180 this function just prepare the SQL request.
181 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
183 $sth = $dbh->prepare($query).
189 sub GetSubscriptionHistoryFromSubscriptionId() {
190 my $dbh = C4::Context->dbh;
193 FROM subscriptionhistory
194 WHERE subscriptionid = ?
196 return $dbh->prepare($query);
199 =head2 GetSerialStatusFromSerialId
203 $sth = GetSerialStatusFromSerialId();
204 this function just prepare the SQL request.
205 After this function, don't forget to execute it by using $sth->execute($serialid)
207 $sth = $dbh->prepare($query).
213 sub GetSerialStatusFromSerialId() {
214 my $dbh = C4::Context->dbh;
220 return $dbh->prepare($query);
223 =head2 GetSerialInformation
227 $data = GetSerialInformation($serialid);
228 returns a hash containing :
229 items : items marcrecord (can be an array)
231 subscription table field
232 + information about subscription expiration
238 sub GetSerialInformation {
240 my $dbh = C4::Context->dbh;
242 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid|;
243 if (C4::Context->preference('IndependantBranches') &&
244 C4::Context->userenv &&
245 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
247 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
250 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
253 my $rq = $dbh->prepare($query);
254 $rq->execute($serialid);
255 my $data = $rq->fetchrow_hashref;
257 if ( C4::Context->preference("serialsadditems") ) {
258 if ( $data->{'itemnumber'} ) {
259 my @itemnumbers = split /,/, $data->{'itemnumber'};
260 foreach my $itemnum (@itemnumbers) {
262 #It is ASSUMED that GetMarcItem ALWAYS WORK...
263 #Maybe GetMarcItem should return values on failure
264 # warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
266 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
267 $itemprocessed->{'itemnumber'} = $itemnum;
268 $itemprocessed->{'itemid'} = $itemnum;
269 $itemprocessed->{'serialid'} = $serialid;
270 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
271 push @{ $data->{'items'} }, $itemprocessed;
276 PrepareItemrecordDisplay( $data->{'biblionumber'} );
277 $itemprocessed->{'itemid'} = "N$serialid";
278 $itemprocessed->{'serialid'} = $serialid;
279 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
280 $itemprocessed->{'countitems'} = 0;
281 push @{ $data->{'items'} }, $itemprocessed;
284 $data->{ "status" . $data->{'serstatus'} } = 1;
285 $data->{'subscriptionexpired'} =
286 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
287 $data->{'abouttoexpire'} =
288 abouttoexpire( $data->{'subscriptionid'} );
292 =head2 AddItem2Serial
296 $data = AddItem2Serial($serialid,$itemnumber);
297 Adds an itemnumber to Serial record
303 my ( $serialid, $itemnumber ) = @_;
304 my $dbh = C4::Context->dbh;
306 UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber))
309 my $rq = $dbh->prepare($query);
310 $rq->execute($serialid);
314 =head2 UpdateClaimdateIssues
318 UpdateClaimdateIssues($serialids,[$date]);
320 Update Claimdate for issues in @$serialids list with date $date
326 sub UpdateClaimdateIssues {
327 my ( $serialids, $date ) = @_;
328 my $dbh = C4::Context->dbh;
329 $date = strftime("%Y-%m-%d",localtime) unless ($date);
331 UPDATE serial SET claimdate=$date,status=7
332 WHERE serialid in ".join (",",@$serialids);
334 my $rq = $dbh->prepare($query);
339 =head2 GetSubscription
343 $subs = GetSubscription($subscriptionid)
344 this function get the subscription which has $subscriptionid as id.
346 a hashref. This hash containts
347 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
353 sub GetSubscription {
354 my ($subscriptionid) = @_;
355 my $dbh = C4::Context->dbh;
357 SELECT subscription.*,
358 subscriptionhistory.*,
360 aqbooksellers.name AS aqbooksellername,
361 biblio.title AS bibliotitle,
362 subscription.biblionumber as bibnum);
363 if (C4::Context->preference('IndependantBranches') &&
364 C4::Context->userenv &&
365 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
367 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
371 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
372 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
373 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
374 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
375 WHERE subscription.subscriptionid = ?
377 # if (C4::Context->preference('IndependantBranches') &&
378 # C4::Context->userenv &&
379 # C4::Context->userenv->{'flags'} != 1){
380 # # warn "flags: ".C4::Context->userenv->{'flags'};
381 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
383 # warn "query : $query";
384 my $sth = $dbh->prepare($query);
385 # warn "subsid :$subscriptionid";
386 $sth->execute($subscriptionid);
387 my $subs = $sth->fetchrow_hashref;
391 =head2 GetFullSubscription
395 \@res = GetFullSubscription($subscriptionid)
396 this function read on serial table.
402 sub GetFullSubscription {
403 my ($subscriptionid) = @_;
404 my $dbh = C4::Context->dbh;
406 SELECT serial.serialid,
409 serial.publisheddate,
411 serial.notes as notes,
412 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
413 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
414 biblio.title as bibliotitle,
415 subscription.branchcode AS branchcode,
416 subscription.subscriptionid AS subscriptionid |;
417 if (C4::Context->preference('IndependantBranches') &&
418 C4::Context->userenv &&
419 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
421 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
425 LEFT JOIN subscription ON
426 (serial.subscriptionid=subscription.subscriptionid )
427 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
428 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
429 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
430 WHERE serial.subscriptionid = ?
432 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
433 serial.subscriptionid
436 my $sth = $dbh->prepare($query);
437 $sth->execute($subscriptionid);
438 my $subs = $sth->fetchall_arrayref({});
443 =head2 PrepareSerialsData
447 \@res = PrepareSerialsData($serialinfomation)
448 where serialinformation is a hashref array
454 sub PrepareSerialsData{
460 my $aqbooksellername;
464 my $previousnote = "";
466 foreach my $subs ( @$lines ) {
467 $subs->{'publisheddate'} =
468 ( $subs->{'publisheddate'}
469 ? format_date( $subs->{'publisheddate'} )
471 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
472 $subs->{ "status" . $subs->{'status'} } = 1;
474 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
475 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
476 $year = $subs->{'year'};
481 if ( $tmpresults{$year} ) {
482 push @{ $tmpresults{$year}->{'serials'} }, $subs;
485 $tmpresults{$year} = {
488 # 'startdate'=>format_date($subs->{'startdate'}),
489 'aqbooksellername' => $subs->{'aqbooksellername'},
490 'bibliotitle' => $subs->{'bibliotitle'},
491 'serials' => [$subs],
493 # 'branchcode' => $subs->{'branchcode'},
494 # 'subscriptionid' => $subs->{'subscriptionid'},
498 # $previousnote=$subs->{notes};
500 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
501 push @res, $tmpresults{$key};
503 $res[0]->{'first'}=1;
507 =head2 GetSubscriptionsFromBiblionumber
509 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
510 this function get the subscription list. it reads on subscription table.
512 table of subscription which has the biblionumber given on input arg.
513 each line of this table is a hashref. All hashes containt
514 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
518 sub GetSubscriptionsFromBiblionumber {
519 my ($biblionumber) = @_;
520 my $dbh = C4::Context->dbh;
522 SELECT subscription.*,
524 subscriptionhistory.*,
526 aqbooksellers.name AS aqbooksellername,
527 biblio.title AS bibliotitle
529 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
530 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
531 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
532 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
533 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
534 WHERE subscription.biblionumber = ?
536 # if (C4::Context->preference('IndependantBranches') &&
537 # C4::Context->userenv &&
538 # C4::Context->userenv->{'flags'} != 1){
539 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
541 my $sth = $dbh->prepare($query);
542 $sth->execute($biblionumber);
544 while ( my $subs = $sth->fetchrow_hashref ) {
545 $subs->{startdate} = format_date( $subs->{startdate} );
546 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
547 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
548 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
549 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
550 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
551 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
552 $subs->{ "status" . $subs->{'status'} } = 1;
553 $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
554 C4::Context->userenv &&
555 C4::Context->userenv->{flags} !=1 &&
556 C4::Context->userenv->{branch} && $subs->{branchcode} &&
557 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
558 if ( $subs->{enddate} eq '0000-00-00' ) {
559 $subs->{enddate} = '';
562 $subs->{enddate} = format_date( $subs->{enddate} );
564 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
565 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
571 =head2 GetFullSubscriptionsFromBiblionumber
575 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
576 this function read on serial table.
582 sub GetFullSubscriptionsFromBiblionumber {
583 my ($biblionumber) = @_;
584 my $dbh = C4::Context->dbh;
586 SELECT serial.serialid,
589 serial.publisheddate,
591 serial.notes as notes,
592 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
593 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
594 biblio.title as bibliotitle,
595 subscription.branchcode AS branchcode,
596 subscription.subscriptionid AS subscriptionid|;
597 if (C4::Context->preference('IndependantBranches') &&
598 C4::Context->userenv &&
599 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
601 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
606 LEFT JOIN subscription ON
607 (serial.subscriptionid=subscription.subscriptionid)
608 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
609 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
610 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
611 WHERE subscription.biblionumber = ?
613 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
614 serial.subscriptionid
616 my $sth = $dbh->prepare($query);
617 $sth->execute($biblionumber);
618 my $subs= $sth->fetchall_arrayref({});
622 =head2 GetSubscriptions
626 @results = GetSubscriptions($title,$ISSN,$biblionumber);
627 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
629 a table of hashref. Each hash containt the subscription.
635 sub GetSubscriptions {
636 my ( $title, $ISSN, $biblionumber ) = @_;
637 #return unless $title or $ISSN or $biblionumber;
638 my $dbh = C4::Context->dbh;
642 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
644 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
645 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
646 WHERE biblio.biblionumber=?
648 $query.=" ORDER BY title";
649 # warn "query :$query";
650 $sth = $dbh->prepare($query);
651 $sth->execute($biblionumber);
654 if ( $ISSN and $title ) {
656 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
658 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
659 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
660 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
661 $query.=" ORDER BY title";
662 $sth = $dbh->prepare($query);
663 $sth->execute( $ISSN );
668 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
670 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
671 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
672 WHERE biblioitems.issn LIKE ?
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) );
688 $query.=" ORDER BY title";
690 $sth = $dbh->prepare($query);
696 my $previoustitle = "";
698 while ( my $line = $sth->fetchrow_hashref ) {
699 if ( $previoustitle eq $line->{title} ) {
702 $line->{toggle} = 1 if $odd == 1;
705 $previoustitle = $line->{title};
707 $line->{toggle} = 1 if $odd == 1;
709 $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
710 C4::Context->userenv &&
711 C4::Context->userenv->{flags} !=1 &&
712 C4::Context->userenv->{branch} && $line->{branchcode} &&
713 (C4::Context->userenv->{branch} ne $line->{branchcode}));
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};
939 $newlastvalue1 = $val->{lastvalue1};
940 # check if we have to increase the new value.
941 $newinnerloop1 = $val->{innerloop1} + 1;
942 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
943 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
944 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
945 $calculated =~ s/\{X\}/$newlastvalue1/g;
947 $newlastvalue2 = $val->{lastvalue2};
948 # check if we have to increase the new value.
949 $newinnerloop2 = $val->{innerloop2} + 1;
950 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
951 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
952 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
953 if ( $pattern == 6 ) {
954 if ( $val->{hemisphere} == 2 ) {
955 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
956 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
959 my $newlastvalue2seq = $seasons[$newlastvalue2];
960 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
964 $calculated =~ s/\{Y\}/$newlastvalue2/g;
968 $newlastvalue3 = $val->{lastvalue3};
969 # check if we have to increase the new value.
970 $newinnerloop3 = $val->{innerloop3} + 1;
971 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
972 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
973 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
974 $calculated =~ s/\{Z\}/$newlastvalue3/g;
976 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
977 $newinnerloop1, $newinnerloop2, $newinnerloop3);
984 $calculated = GetSeq($val)
985 $val is a hashref containing all the attributes of the table 'subscription'
986 this function transforms {X},{Y},{Z} to 150,0,0 for example.
988 the sequence in integer format
996 my $pattern = $val->{numberpattern};
997 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
998 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
999 my $calculated = $val->{numberingmethod};
1000 my $x = $val->{'lastvalue1'};
1001 $calculated =~ s/\{X\}/$x/g;
1002 my $newlastvalue2 = $val->{'lastvalue2'};
1003 if ( $pattern == 6 ) {
1004 if ( $val->{hemisphere} == 2 ) {
1005 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1006 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1009 my $newlastvalue2seq = $seasons[$newlastvalue2];
1010 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1014 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1016 my $z = $val->{'lastvalue3'};
1017 $calculated =~ s/\{Z\}/$z/g;
1021 =head2 GetExpirationDate
1023 $sensddate = GetExpirationDate($subscriptionid)
1025 this function return the expiration date for a subscription given on input args.
1032 sub GetExpirationDate {
1033 my ($subscriptionid) = @_;
1034 my $dbh = C4::Context->dbh;
1035 my $subscription = GetSubscription($subscriptionid);
1036 my $enddate = $subscription->{startdate};
1038 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1039 if (($subscription->{periodicity} % 16) >0){
1040 if ( $subscription->{numberlength} ) {
1041 #calculate the date of the last issue.
1042 my $length = $subscription->{numberlength};
1043 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1044 $enddate = GetNextDate( $enddate, $subscription );
1047 elsif ( $subscription->{monthlength} ){
1048 my @date=split (/-/,$subscription->{startdate});
1049 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1050 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1051 } elsif ( $subscription->{weeklength} ){
1052 my @date=split (/-/,$subscription->{startdate});
1053 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1054 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1062 =head2 CountSubscriptionFromBiblionumber
1066 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1067 this count the number of subscription for a biblionumber given.
1069 the number of subscriptions with biblionumber given on input arg.
1075 sub CountSubscriptionFromBiblionumber {
1076 my ($biblionumber) = @_;
1077 my $dbh = C4::Context->dbh;
1078 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1079 my $sth = $dbh->prepare($query);
1080 $sth->execute($biblionumber);
1081 my $subscriptionsnumber = $sth->fetchrow;
1082 return $subscriptionsnumber;
1085 =head2 ModSubscriptionHistory
1089 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1091 this function modify the history of a subscription. Put your new values on input arg.
1097 sub ModSubscriptionHistory {
1099 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1100 $missinglist, $opacnote, $librariannote
1102 my $dbh = C4::Context->dbh;
1103 my $query = "UPDATE subscriptionhistory
1104 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1105 WHERE subscriptionid=?
1107 my $sth = $dbh->prepare($query);
1108 $recievedlist =~ s/^,//g;
1109 $missinglist =~ s/^,//g;
1110 $opacnote =~ s/^,//g;
1112 $histstartdate, $enddate, $recievedlist, $missinglist,
1113 $opacnote, $librariannote, $subscriptionid
1118 =head2 ModSerialStatus
1122 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1124 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1125 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1131 sub ModSerialStatus {
1132 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1135 #It is a usual serial
1136 # 1st, get previous status :
1137 my $dbh = C4::Context->dbh;
1138 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1139 my $sth = $dbh->prepare($query);
1140 $sth->execute($serialid);
1141 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1143 # change status & update subscriptionhistory
1145 if ( $status eq 6 ) {
1146 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1150 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1151 $sth = $dbh->prepare($query);
1152 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1153 $notes, $serialid );
1154 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1155 $sth = $dbh->prepare($query);
1156 $sth->execute($subscriptionid);
1157 my $val = $sth->fetchrow_hashref;
1158 unless ( $val->{manualhistory} ) {
1160 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1161 $sth = $dbh->prepare($query);
1162 $sth->execute($subscriptionid);
1163 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1164 if ( $status eq 2 ) {
1166 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1167 $recievedlist .= ",$serialseq"
1168 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1171 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1172 $missinglist .= ",$serialseq"
1174 and not index( "$missinglist", "$serialseq" ) >= 0 );
1175 $missinglist .= ",not issued $serialseq"
1177 and index( "$missinglist", "$serialseq" ) >= 0 );
1179 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1180 $sth = $dbh->prepare($query);
1181 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1185 # create new waited entry if needed (ie : was a "waited" and has changed)
1186 if ( $oldstatus eq 1 && $status ne 1 ) {
1187 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1188 $sth = $dbh->prepare($query);
1189 $sth->execute($subscriptionid);
1190 my $val = $sth->fetchrow_hashref;
1195 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1196 $newinnerloop1, $newinnerloop2, $newinnerloop3
1197 ) = GetNextSeq($val);
1198 # warn "Next Seq End";
1200 # next date (calculated from actual date & frequency parameters)
1201 # warn "publisheddate :$publisheddate ";
1202 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1203 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1204 1, $nextpublisheddate, $nextpublisheddate );
1206 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1207 WHERE subscriptionid = ?";
1208 $sth = $dbh->prepare($query);
1210 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1211 $newinnerloop2, $newinnerloop3, $subscriptionid
1214 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1215 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1216 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1221 =head2 ModSubscription
1225 this function modify a subscription. Put all new values on input args.
1231 sub ModSubscription {
1233 $auser, $branchcode, $aqbooksellerid, $cost,
1234 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1235 $dow, $irregularity, $numberpattern, $numberlength,
1236 $weeklength, $monthlength, $add1, $every1,
1237 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1238 $add2, $every2, $whenmorethan2, $setto2,
1239 $lastvalue2, $innerloop2, $add3, $every3,
1240 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1241 $numberingmethod, $status, $biblionumber, $callnumber,
1242 $notes, $letter, $hemisphere, $manualhistory,
1246 # warn $irregularity;
1247 my $dbh = C4::Context->dbh;
1248 my $query = "UPDATE subscription
1249 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1250 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1251 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1252 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1253 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1254 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1255 WHERE subscriptionid = ?";
1256 # warn "query :".$query;
1257 my $sth = $dbh->prepare($query);
1259 $auser, $branchcode, $aqbooksellerid, $cost,
1260 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1261 $dow, "$irregularity", $numberpattern, $numberlength,
1262 $weeklength, $monthlength, $add1, $every1,
1263 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1264 $add2, $every2, $whenmorethan2, $setto2,
1265 $lastvalue2, $innerloop2, $add3, $every3,
1266 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1267 $numberingmethod, $status, $biblionumber, $callnumber,
1268 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1272 my $rows=$sth->rows;
1275 &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1276 if C4::Context->preference("SubscriptionLog");
1280 =head2 NewSubscription
1284 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1285 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1286 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1287 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1288 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1289 $numberingmethod, $status, $notes)
1291 Create a new subscription with value given on input args.
1294 the id of this new subscription
1300 sub NewSubscription {
1302 $auser, $branchcode, $aqbooksellerid, $cost,
1303 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1304 $dow, $numberlength, $weeklength, $monthlength,
1305 $add1, $every1, $whenmorethan1, $setto1,
1306 $lastvalue1, $innerloop1, $add2, $every2,
1307 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1308 $add3, $every3, $whenmorethan3, $setto3,
1309 $lastvalue3, $innerloop3, $numberingmethod, $status,
1310 $notes, $letter, $firstacquidate, $irregularity,
1311 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1314 my $dbh = C4::Context->dbh;
1316 #save subscription (insert into database)
1318 INSERT INTO subscription
1319 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1320 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1321 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1322 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1323 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1324 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1325 numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1326 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1328 my $sth = $dbh->prepare($query);
1330 $auser, $branchcode,
1331 $aqbooksellerid, $cost,
1332 $aqbudgetid, $biblionumber,
1333 format_date_in_iso($startdate), $periodicity,
1334 $dow, $numberlength,
1335 $weeklength, $monthlength,
1337 $whenmorethan1, $setto1,
1338 $lastvalue1, $innerloop1,
1340 $whenmorethan2, $setto2,
1341 $lastvalue2, $innerloop2,
1343 $whenmorethan3, $setto3,
1344 $lastvalue3, $innerloop3,
1345 $numberingmethod, "$status",
1347 format_date_in_iso($firstacquidate), $irregularity,
1348 $numberpattern, $callnumber,
1349 $hemisphere, $manualhistory,
1353 #then create the 1st waited number
1354 my $subscriptionid = $dbh->{'mysql_insertid'};
1356 INSERT INTO subscriptionhistory
1357 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1358 VALUES (?,?,?,?,?,?,?,?)
1360 $sth = $dbh->prepare($query);
1361 $sth->execute( $biblionumber, $subscriptionid,
1362 format_date_in_iso($startdate),
1363 $notes,$internalnotes );
1365 # reread subscription to get a hash (for calculation of the 1st issue number)
1369 WHERE subscriptionid = ?
1371 $sth = $dbh->prepare($query);
1372 $sth->execute($subscriptionid);
1373 my $val = $sth->fetchrow_hashref;
1375 # calculate issue number
1376 my $serialseq = GetSeq($val);
1379 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1380 VALUES (?,?,?,?,?,?)
1382 $sth = $dbh->prepare($query);
1384 "$serialseq", $subscriptionid, $biblionumber, 1,
1385 format_date_in_iso($startdate),
1386 format_date_in_iso($startdate)
1389 &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1390 if C4::Context->preference("SubscriptionLog");
1392 return $subscriptionid;
1395 =head2 ReNewSubscription
1399 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1401 this function renew a subscription with values given on input args.
1407 sub ReNewSubscription {
1408 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1409 $monthlength, $note )
1411 my $dbh = C4::Context->dbh;
1412 my $subscription = GetSubscription($subscriptionid);
1416 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1417 WHERE biblio.biblionumber=?
1419 my $sth = $dbh->prepare($query);
1420 $sth->execute( $subscription->{biblionumber} );
1421 my $biblio = $sth->fetchrow_hashref;
1423 $user, $subscription->{bibliotitle},
1424 $biblio->{author}, $biblio->{publishercode},
1425 $biblio->{note}, '',
1428 $subscription->{biblionumber}
1431 # renew subscription
1434 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1435 WHERE subscriptionid=?
1437 $sth = $dbh->prepare($query);
1438 $sth->execute( format_date_in_iso($startdate),
1439 $numberlength, $weeklength, $monthlength, $subscriptionid );
1441 &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1442 if C4::Context->preference("SubscriptionLog");
1449 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1451 Create a new issue stored on the database.
1452 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1459 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1460 $planneddate, $publisheddate, $notes )
1462 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1464 my $dbh = C4::Context->dbh;
1467 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1468 VALUES (?,?,?,?,?,?,?)
1470 my $sth = $dbh->prepare($query);
1471 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1472 $publisheddate, $planneddate,$notes );
1473 my $serialid=$dbh->{'mysql_insertid'};
1475 SELECT missinglist,recievedlist
1476 FROM subscriptionhistory
1477 WHERE subscriptionid=?
1479 $sth = $dbh->prepare($query);
1480 $sth->execute($subscriptionid);
1481 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1483 if ( $status eq 2 ) {
1484 ### TODO Add a feature that improves recognition and description.
1485 ### As such count (serialseq) i.e. : N18,2(N19),N20
1486 ### Would use substr and index But be careful to previous presence of ()
1487 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1489 if ( $status eq 4 ) {
1490 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1493 UPDATE subscriptionhistory
1494 SET recievedlist=?, missinglist=?
1495 WHERE subscriptionid=?
1497 $sth = $dbh->prepare($query);
1498 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1502 =head2 ItemizeSerials
1506 ItemizeSerials($serialid, $info);
1507 $info is a hashref containing barcode branch, itemcallnumber, status, location
1508 $serialid the serialid
1510 1 if the itemize is a succes.
1511 0 and @error else. @error containts the list of errors found.
1517 sub ItemizeSerials {
1518 my ( $serialid, $info ) = @_;
1519 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1521 my $dbh = C4::Context->dbh;
1527 my $sth = $dbh->prepare($query);
1528 $sth->execute($serialid);
1529 my $data = $sth->fetchrow_hashref;
1530 if ( C4::Context->preference("RoutingSerials") ) {
1532 # check for existing biblioitem relating to serial issue
1533 my ( $count, @results ) =
1534 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1536 for ( my $i = 0 ; $i < $count ; $i++ ) {
1537 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1538 . $data->{'planneddate'}
1541 $bibitemno = $results[$i]->{'biblioitemnumber'};
1545 if ( $bibitemno == 0 ) {
1547 # warn "need to add new biblioitem so copy last one and make minor changes";
1550 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1552 $sth->execute( $data->{'biblionumber'} );
1553 my $biblioitem = $sth->fetchrow_hashref;
1554 $biblioitem->{'volumedate'} =
1555 format_date_in_iso( $data->{planneddate} );
1556 $biblioitem->{'volumeddesc'} =
1557 $data->{serialseq} . ' ('
1558 . format_date( $data->{'planneddate'} ) . ')';
1559 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1561 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1562 # so I comment it, we can speak of it when you want
1563 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1564 # if ( $info->{barcode} )
1565 # { # only make biblioitem if we are going to make item also
1566 # $bibitemno = newbiblioitem($biblioitem);
1571 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1572 if ( $info->{barcode} ) {
1574 my $exists = itemdata( $info->{'barcode'} );
1575 push @errors, "barcode_not_unique" if ($exists);
1577 my $marcrecord = MARC::Record->new();
1578 my ( $tag, $subfield ) =
1579 GetMarcFromKohaField( "items.barcode", $fwk );
1581 MARC::Field->new( "$tag", '', '',
1582 "$subfield" => $info->{barcode} );
1583 $marcrecord->insert_fields_ordered($newField);
1584 if ( $info->{branch} ) {
1585 my ( $tag, $subfield ) =
1586 GetMarcFromKohaField( "items.homebranch",
1589 #warn "items.homebranch : $tag , $subfield";
1590 if ( $marcrecord->field($tag) ) {
1591 $marcrecord->field($tag)
1592 ->add_subfields( "$subfield" => $info->{branch} );
1596 MARC::Field->new( "$tag", '', '',
1597 "$subfield" => $info->{branch} );
1598 $marcrecord->insert_fields_ordered($newField);
1600 ( $tag, $subfield ) =
1601 GetMarcFromKohaField( "items.holdingbranch",
1604 #warn "items.holdingbranch : $tag , $subfield";
1605 if ( $marcrecord->field($tag) ) {
1606 $marcrecord->field($tag)
1607 ->add_subfields( "$subfield" => $info->{branch} );
1611 MARC::Field->new( "$tag", '', '',
1612 "$subfield" => $info->{branch} );
1613 $marcrecord->insert_fields_ordered($newField);
1616 if ( $info->{itemcallnumber} ) {
1617 my ( $tag, $subfield ) =
1618 GetMarcFromKohaField( "items.itemcallnumber",
1621 #warn "items.itemcallnumber : $tag , $subfield";
1622 if ( $marcrecord->field($tag) ) {
1623 $marcrecord->field($tag)
1624 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1628 MARC::Field->new( "$tag", '', '',
1629 "$subfield" => $info->{itemcallnumber} );
1630 $marcrecord->insert_fields_ordered($newField);
1633 if ( $info->{notes} ) {
1634 my ( $tag, $subfield ) =
1635 GetMarcFromKohaField( "items.itemnotes", $fwk );
1637 # warn "items.itemnotes : $tag , $subfield";
1638 if ( $marcrecord->field($tag) ) {
1639 $marcrecord->field($tag)
1640 ->add_subfields( "$subfield" => $info->{notes} );
1644 MARC::Field->new( "$tag", '', '',
1645 "$subfield" => $info->{notes} );
1646 $marcrecord->insert_fields_ordered($newField);
1649 if ( $info->{location} ) {
1650 my ( $tag, $subfield ) =
1651 GetMarcFromKohaField( "items.location", $fwk );
1653 # warn "items.location : $tag , $subfield";
1654 if ( $marcrecord->field($tag) ) {
1655 $marcrecord->field($tag)
1656 ->add_subfields( "$subfield" => $info->{location} );
1660 MARC::Field->new( "$tag", '', '',
1661 "$subfield" => $info->{location} );
1662 $marcrecord->insert_fields_ordered($newField);
1665 if ( $info->{status} ) {
1666 my ( $tag, $subfield ) =
1667 GetMarcFromKohaField( "items.notforloan",
1670 # warn "items.notforloan : $tag , $subfield";
1671 if ( $marcrecord->field($tag) ) {
1672 $marcrecord->field($tag)
1673 ->add_subfields( "$subfield" => $info->{status} );
1677 MARC::Field->new( "$tag", '', '',
1678 "$subfield" => $info->{status} );
1679 $marcrecord->insert_fields_ordered($newField);
1682 if ( C4::Context->preference("RoutingSerials") ) {
1683 my ( $tag, $subfield ) =
1684 GetMarcFromKohaField( "items.dateaccessioned",
1686 if ( $marcrecord->field($tag) ) {
1687 $marcrecord->field($tag)
1688 ->add_subfields( "$subfield" => $now );
1692 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1693 $marcrecord->insert_fields_ordered($newField);
1696 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1699 return ( 0, @errors );
1703 =head2 HasSubscriptionExpired
1707 1 or 0 = HasSubscriptionExpired($subscriptionid)
1709 the subscription has expired when the next issue to arrive is out of subscription limit.
1712 1 if true, 0 if false.
1718 sub HasSubscriptionExpired {
1719 my ($subscriptionid) = @_;
1720 my $dbh = C4::Context->dbh;
1721 my $subscription = GetSubscription($subscriptionid);
1722 if (($subscription->{periodicity} % 16)>0){
1723 my $expirationdate = GetExpirationDate($subscriptionid);
1725 SELECT max(planneddate)
1727 WHERE subscriptionid=?
1729 my $sth = $dbh->prepare($query);
1730 $sth->execute($subscriptionid);
1731 my ($res) = $sth->fetchrow ;
1732 my @res=split (/-/,$res);
1733 # warn "date expiration :$expirationdate";
1734 my @endofsubscriptiondate=split(/-/,$expirationdate);
1735 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1736 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1740 if ($subscription->{'numberlength'}){
1741 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1742 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1751 =head2 SetDistributedto
1755 SetDistributedto($distributedto,$subscriptionid);
1756 This function update the value of distributedto for a subscription given on input arg.
1762 sub SetDistributedto {
1763 my ( $distributedto, $subscriptionid ) = @_;
1764 my $dbh = C4::Context->dbh;
1768 WHERE subscriptionid=?
1770 my $sth = $dbh->prepare($query);
1771 $sth->execute( $distributedto, $subscriptionid );
1774 =head2 DelSubscription
1778 DelSubscription($subscriptionid)
1779 this function delete the subscription which has $subscriptionid as id.
1785 sub DelSubscription {
1786 my ($subscriptionid) = @_;
1787 my $dbh = C4::Context->dbh;
1788 $subscriptionid = $dbh->quote($subscriptionid);
1789 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1791 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1792 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1794 &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1795 if C4::Context->preference("SubscriptionLog");
1802 DelIssue($serialseq,$subscriptionid)
1803 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1810 my ( $dataissue) = @_;
1811 my $dbh = C4::Context->dbh;
1812 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1817 AND subscriptionid= ?
1819 my $mainsth = $dbh->prepare($query);
1820 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1822 #Delete element from subscription history
1823 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1824 my $sth = $dbh->prepare($query);
1825 $sth->execute($dataissue->{'subscriptionid'});
1826 my $val = $sth->fetchrow_hashref;
1827 unless ( $val->{manualhistory} ) {
1829 SELECT * FROM subscriptionhistory
1830 WHERE subscriptionid= ?
1832 my $sth = $dbh->prepare($query);
1833 $sth->execute($dataissue->{'subscriptionid'});
1834 my $data = $sth->fetchrow_hashref;
1835 my $serialseq= $dataissue->{'serialseq'};
1836 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1837 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1838 my $strsth = "UPDATE subscriptionhistory SET "
1840 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1841 . " WHERE subscriptionid=?";
1842 $sth = $dbh->prepare($strsth);
1843 $sth->execute($dataissue->{'subscriptionid'});
1846 return $mainsth->rows;
1849 =head2 GetLateOrMissingIssues
1853 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1855 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1858 a count of the number of missing issues
1859 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1860 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1866 sub GetLateOrMissingIssues {
1867 my ( $supplierid, $serialid,$order ) = @_;
1868 my $dbh = C4::Context->dbh;
1872 $byserial = "and serialid = " . $serialid;
1880 $sth = $dbh->prepare(
1889 serial.subscriptionid,
1892 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1893 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1894 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1895 WHERE subscription.subscriptionid = serial.subscriptionid
1896 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1897 AND subscription.aqbooksellerid=$supplierid
1903 $sth = $dbh->prepare(
1912 serial.subscriptionid,
1915 LEFT JOIN subscription
1916 ON serial.subscriptionid=subscription.subscriptionid
1918 ON subscription.biblionumber=biblio.biblionumber
1919 LEFT JOIN aqbooksellers
1920 ON subscription.aqbooksellerid = aqbooksellers.id
1922 subscription.subscriptionid = serial.subscriptionid
1923 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1933 while ( my $line = $sth->fetchrow_hashref ) {
1934 $odd++ unless $line->{title} eq $last_title;
1935 $last_title = $line->{title} if ( $line->{title} );
1936 $line->{planneddate} = format_date( $line->{planneddate} );
1937 $line->{claimdate} = format_date( $line->{claimdate} );
1938 $line->{"status".$line->{status}} = 1;
1939 $line->{'odd'} = 1 if $odd % 2;
1941 push @issuelist, $line;
1943 return $count, @issuelist;
1946 =head2 removeMissingIssue
1950 removeMissingIssue($subscriptionid)
1952 this function removes an issue from being part of the missing string in
1953 subscriptionlist.missinglist column
1955 called when a missing issue is found from the serials-recieve.pl file
1961 sub removeMissingIssue {
1962 my ( $sequence, $subscriptionid ) = @_;
1963 my $dbh = C4::Context->dbh;
1966 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1967 $sth->execute($subscriptionid);
1968 my $data = $sth->fetchrow_hashref;
1969 my $missinglist = $data->{'missinglist'};
1970 my $missinglistbefore = $missinglist;
1972 # warn $missinglist." before";
1973 $missinglist =~ s/($sequence)//;
1975 # warn $missinglist." after";
1976 if ( $missinglist ne $missinglistbefore ) {
1977 $missinglist =~ s/\|\s\|/\|/g;
1978 $missinglist =~ s/^\| //g;
1979 $missinglist =~ s/\|$//g;
1980 my $sth2 = $dbh->prepare(
1981 "UPDATE subscriptionhistory
1983 WHERE subscriptionid = ?"
1985 $sth2->execute( $missinglist, $subscriptionid );
1993 &updateClaim($serialid)
1995 this function updates the time when a claim is issued for late/missing items
1997 called from claims.pl file
2004 my ($serialid) = @_;
2005 my $dbh = C4::Context->dbh;
2006 my $sth = $dbh->prepare(
2007 "UPDATE serial SET claimdate = now()
2011 $sth->execute($serialid);
2014 =head2 getsupplierbyserialid
2018 ($result) = &getsupplierbyserialid($serialid)
2020 this function is used to find the supplier id given a serial id
2023 hashref containing serialid, subscriptionid, and aqbooksellerid
2029 sub getsupplierbyserialid {
2030 my ($serialid) = @_;
2031 my $dbh = C4::Context->dbh;
2032 my $sth = $dbh->prepare(
2033 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2035 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2039 $sth->execute($serialid);
2040 my $line = $sth->fetchrow_hashref;
2041 my $result = $line->{'aqbooksellerid'};
2045 =head2 check_routing
2049 ($result) = &check_routing($subscriptionid)
2051 this function checks to see if a serial has a routing list and returns the count of routingid
2052 used to show either an 'add' or 'edit' link
2058 my ($subscriptionid) = @_;
2059 my $dbh = C4::Context->dbh;
2060 my $sth = $dbh->prepare(
2061 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2062 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2063 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2066 $sth->execute($subscriptionid);
2067 my $line = $sth->fetchrow_hashref;
2068 my $result = $line->{'routingids'};
2072 =head2 addroutingmember
2076 &addroutingmember($borrowernumber,$subscriptionid)
2078 this function takes a borrowernumber and subscriptionid and add the member to the
2079 routing list for that serial subscription and gives them a rank on the list
2080 of either 1 or highest current rank + 1
2086 sub addroutingmember {
2087 my ( $borrowernumber, $subscriptionid ) = @_;
2089 my $dbh = C4::Context->dbh;
2092 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2094 $sth->execute($subscriptionid);
2095 while ( my $line = $sth->fetchrow_hashref ) {
2096 if ( $line->{'rank'} > 0 ) {
2097 $rank = $line->{'rank'} + 1;
2105 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2107 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2110 =head2 reorder_members
2114 &reorder_members($subscriptionid,$routingid,$rank)
2116 this function is used to reorder the routing list
2118 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2119 - it gets all members on list puts their routingid's into an array
2120 - removes the one in the array that is $routingid
2121 - then reinjects $routingid at point indicated by $rank
2122 - then update the database with the routingids in the new order
2128 sub reorder_members {
2129 my ( $subscriptionid, $routingid, $rank ) = @_;
2130 my $dbh = C4::Context->dbh;
2133 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2135 $sth->execute($subscriptionid);
2137 while ( my $line = $sth->fetchrow_hashref ) {
2138 push( @result, $line->{'routingid'} );
2141 # To find the matching index
2143 my $key = -1; # to allow for 0 being a valid response
2144 for ( $i = 0 ; $i < @result ; $i++ ) {
2145 if ( $routingid == $result[$i] ) {
2146 $key = $i; # save the index
2151 # if index exists in array then move it to new position
2152 if ( $key > -1 && $rank > 0 ) {
2153 my $new_rank = $rank -
2154 1; # $new_rank is what you want the new index to be in the array
2155 my $moving_item = splice( @result, $key, 1 );
2156 splice( @result, $new_rank, 0, $moving_item );
2158 for ( my $j = 0 ; $j < @result ; $j++ ) {
2160 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2162 . "' WHERE routingid = '"
2169 =head2 delroutingmember
2173 &delroutingmember($routingid,$subscriptionid)
2175 this function either deletes one member from routing list if $routingid exists otherwise
2176 deletes all members from the routing list
2182 sub delroutingmember {
2184 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2185 my ( $routingid, $subscriptionid ) = @_;
2186 my $dbh = C4::Context->dbh;
2190 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2191 $sth->execute($routingid);
2192 reorder_members( $subscriptionid, $routingid );
2197 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2198 $sth->execute($subscriptionid);
2202 =head2 getroutinglist
2206 ($count,@routinglist) = &getroutinglist($subscriptionid)
2208 this gets the info from the subscriptionroutinglist for $subscriptionid
2211 a count of the number of members on routinglist
2212 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2213 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2219 sub getroutinglist {
2220 my ($subscriptionid) = @_;
2221 my $dbh = C4::Context->dbh;
2222 my $sth = $dbh->prepare(
2223 "SELECT routingid, borrowernumber,
2224 ranking, biblionumber
2226 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2227 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2230 $sth->execute($subscriptionid);
2233 while ( my $line = $sth->fetchrow_hashref ) {
2235 push( @routinglist, $line );
2237 return ( $count, @routinglist );
2240 =head2 countissuesfrom
2244 $result = &countissuesfrom($subscriptionid,$startdate)
2251 sub countissuesfrom {
2252 my ($subscriptionid,$startdate) = @_;
2253 my $dbh = C4::Context->dbh;
2257 WHERE subscriptionid=?
2258 AND serial.publisheddate>?
2260 my $sth=$dbh->prepare($query);
2261 $sth->execute($subscriptionid, $startdate);
2262 my ($countreceived)=$sth->fetchrow;
2263 return $countreceived;
2266 =head2 abouttoexpire
2270 $result = &abouttoexpire($subscriptionid)
2272 this function alerts you to the penultimate issue for a serial subscription
2274 returns 1 - if this is the penultimate issue
2282 my ($subscriptionid) = @_;
2283 my $dbh = C4::Context->dbh;
2284 my $subscription = GetSubscription($subscriptionid);
2285 my $per = $subscription->{'periodicity'};
2287 my $expirationdate = GetExpirationDate($subscriptionid);
2290 "select max(planneddate) from serial where subscriptionid=?");
2291 $sth->execute($subscriptionid);
2292 my ($res) = $sth->fetchrow ;
2293 # warn "date expiration : ".$expirationdate." date courante ".$res;
2294 my @res=split /-/,$res;
2295 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2296 my @endofsubscriptiondate=split/-/,$expirationdate;
2298 if ( $per == 1 ) {$x=7;}
2299 if ( $per == 2 ) {$x=7; }
2300 if ( $per == 3 ) {$x=14;}
2301 if ( $per == 4 ) { $x = 21; }
2302 if ( $per == 5 ) { $x = 31; }
2303 if ( $per == 6 ) { $x = 62; }
2304 if ( $per == 7 || $per == 8 ) { $x = 93; }
2305 if ( $per == 9 ) { $x = 190; }
2306 if ( $per == 10 ) { $x = 365; }
2307 if ( $per == 11 ) { $x = 730; }
2308 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2309 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2310 # warn "DATE BEFORE END: $datebeforeend";
2311 return 1 if ( @res &&
2313 Delta_Days($res[0],$res[1],$res[2],
2314 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2315 (@endofsubscriptiondate &&
2316 Delta_Days($res[0],$res[1],$res[2],
2317 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2319 } elsif ($subscription->{numberlength}>0) {
2320 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2324 =head2 old_newsubscription
2328 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2329 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2330 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2331 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2332 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2333 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2335 this function is similar to the NewSubscription subroutine but has a few different
2337 $firstacquidate - date of first serial issue to arrive
2338 $irregularity - the issues not expected separated by a '|'
2339 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2340 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2341 subscription-add.tmpl file
2342 $callnumber - display the callnumber of the serial
2343 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2346 the $subscriptionid number of the new subscription
2352 sub old_newsubscription {
2354 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2355 $biblionumber, $startdate, $periodicity, $firstacquidate,
2356 $dow, $irregularity, $numberpattern, $numberlength,
2357 $weeklength, $monthlength, $add1, $every1,
2358 $whenmorethan1, $setto1, $lastvalue1, $add2,
2359 $every2, $whenmorethan2, $setto2, $lastvalue2,
2360 $add3, $every3, $whenmorethan3, $setto3,
2361 $lastvalue3, $numberingmethod, $status, $callnumber,
2364 my $dbh = C4::Context->dbh;
2367 my $sth = $dbh->prepare(
2368 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2369 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2370 add1,every1,whenmorethan1,setto1,lastvalue1,
2371 add2,every2,whenmorethan2,setto2,lastvalue2,
2372 add3,every3,whenmorethan3,setto3,lastvalue3,
2373 numberingmethod, status, callnumber, notes, hemisphere) values
2374 (?,?,?,?,?,?,?,?,?,?,?,
2375 ?,?,?,?,?,?,?,?,?,?,?,
2376 ?,?,?,?,?,?,?,?,?,?,?,?)"
2379 $auser, $aqbooksellerid,
2381 $biblionumber, format_date_in_iso($startdate),
2382 $periodicity, format_date_in_iso($firstacquidate),
2383 $dow, $irregularity,
2384 $numberpattern, $numberlength,
2385 $weeklength, $monthlength,
2387 $whenmorethan1, $setto1,
2389 $every2, $whenmorethan2,
2390 $setto2, $lastvalue2,
2392 $whenmorethan3, $setto3,
2393 $lastvalue3, $numberingmethod,
2394 $status, $callnumber,
2398 #then create the 1st waited number
2399 my $subscriptionid = $dbh->{'mysql_insertid'};
2400 my $enddate = GetExpirationDate($subscriptionid);
2404 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2407 $biblionumber, $subscriptionid,
2408 format_date_in_iso($startdate),
2409 format_date_in_iso($enddate),
2413 # reread subscription to get a hash (for calculation of the 1st issue number)
2415 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2416 $sth->execute($subscriptionid);
2417 my $val = $sth->fetchrow_hashref;
2419 # calculate issue number
2420 my $serialseq = GetSeq($val);
2423 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2425 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2426 1, format_date_in_iso($startdate) );
2427 return $subscriptionid;
2430 =head2 old_modsubscription
2434 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2435 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2436 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2437 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2438 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2439 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2441 this function is similar to the ModSubscription subroutine but has a few different
2443 $firstacquidate - date of first serial issue to arrive
2444 $irregularity - the issues not expected separated by a '|'
2445 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2446 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2447 subscription-add.tmpl file
2448 $callnumber - display the callnumber of the serial
2449 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2455 sub old_modsubscription {
2457 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2458 $startdate, $periodicity, $firstacquidate, $dow,
2459 $irregularity, $numberpattern, $numberlength, $weeklength,
2460 $monthlength, $add1, $every1, $whenmorethan1,
2461 $setto1, $lastvalue1, $innerloop1, $add2,
2462 $every2, $whenmorethan2, $setto2, $lastvalue2,
2463 $innerloop2, $add3, $every3, $whenmorethan3,
2464 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2465 $status, $biblionumber, $callnumber, $notes,
2466 $hemisphere, $subscriptionid
2468 my $dbh = C4::Context->dbh;
2469 my $sth = $dbh->prepare(
2470 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2471 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2472 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2473 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2474 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2475 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2478 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2479 $startdate, $periodicity, $firstacquidate, $dow,
2480 $irregularity, $numberpattern, $numberlength, $weeklength,
2481 $monthlength, $add1, $every1, $whenmorethan1,
2482 $setto1, $lastvalue1, $innerloop1, $add2,
2483 $every2, $whenmorethan2, $setto2, $lastvalue2,
2484 $innerloop2, $add3, $every3, $whenmorethan3,
2485 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2486 $status, $biblionumber, $callnumber, $notes,
2487 $hemisphere, $subscriptionid
2492 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2493 $sth->execute($subscriptionid);
2494 my $val = $sth->fetchrow_hashref;
2496 # calculate issue number
2497 my $serialseq = Get_Seq($val);
2499 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2500 $sth->execute( $serialseq, $subscriptionid );
2502 my $enddate = subscriptionexpirationdate($subscriptionid);
2503 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2504 $sth->execute( format_date_in_iso($enddate) );
2507 =head2 old_getserials
2511 ($totalissues,@serials) = &old_getserials($subscriptionid)
2513 this function get a hashref of serials and the total count of them
2516 $totalissues - number of serial lines
2517 the serials into a table. Each line of this table containts a ref to a hash which it containts
2518 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2524 sub old_getserials {
2525 my ($subscriptionid) = @_;
2526 my $dbh = C4::Context->dbh;
2528 # status = 2 is "arrived"
2531 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2533 $sth->execute($subscriptionid);
2536 while ( my $line = $sth->fetchrow_hashref ) {
2537 $line->{ "status" . $line->{status} } =
2538 1; # fills a "statusX" value, used for template status select list
2539 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2540 $line->{"num"} = $num;
2542 push @serials, $line;
2544 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2545 $sth->execute($subscriptionid);
2546 my ($totalissues) = $sth->fetchrow;
2547 return ( $totalissues, @serials );
2552 ($resultdate) = &GetNextDate($planneddate,$subscription)
2554 this function is an extension of GetNextDate which allows for checking for irregularity
2556 it takes the planneddate and will return the next issue's date and will skip dates if there
2557 exists an irregularity
2558 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2559 skipped then the returned date will be 2007-05-10
2562 $resultdate - then next date in the sequence
2564 Return 0 if periodicity==0
2567 sub in_array { # used in next sub down
2568 my ($val,@elements) = @_;
2569 foreach my $elem(@elements) {
2577 sub GetNextDate(@) {
2578 my ( $planneddate, $subscription ) = @_;
2579 my @irreg = split( /\,/, $subscription->{irregularity} );
2581 #date supposed to be in ISO.
2583 my ( $year, $month, $day ) = split(/-/, $planneddate);
2584 $month=1 unless ($month);
2585 $day=1 unless ($day);
2588 # warn "DOW $dayofweek";
2589 if ( $subscription->{periodicity} % 16 == 0 ) {
2592 if ( $subscription->{periodicity} == 1 ) {
2593 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2594 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2596 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2597 $dayofweek = 0 if ( $dayofweek == 7 );
2598 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2599 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2603 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2606 if ( $subscription->{periodicity} == 2 ) {
2607 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2608 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2610 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2611 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2612 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2613 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2616 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2619 if ( $subscription->{periodicity} == 3 ) {
2620 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2621 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2623 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2624 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2625 ### BUGFIX was previously +1 ^
2626 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2627 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2630 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2633 if ( $subscription->{periodicity} == 4 ) {
2634 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2635 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2637 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2638 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2639 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2640 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2643 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2646 my $tmpmonth=$month;
2647 if ($year && $month && $day){
2648 if ( $subscription->{periodicity} == 5 ) {
2649 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2650 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2651 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2652 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2655 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2657 if ( $subscription->{periodicity} == 6 ) {
2658 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2659 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2660 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2661 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2664 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2666 if ( $subscription->{periodicity} == 7 ) {
2667 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2668 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2669 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2670 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2673 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2675 if ( $subscription->{periodicity} == 8 ) {
2676 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2677 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2678 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2679 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2682 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2684 if ( $subscription->{periodicity} == 9 ) {
2685 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2686 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2687 ### BUFIX Seems to need more Than One ?
2688 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2689 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2692 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2694 if ( $subscription->{periodicity} == 10 ) {
2695 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2697 if ( $subscription->{periodicity} == 11 ) {
2698 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2701 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2703 # warn "dateNEXTSEQ : ".$resultdate;
2704 return "$resultdate";
2709 $item = &itemdata($barcode);
2711 Looks up the item with the given barcode, and returns a
2712 reference-to-hash containing information about that item. The keys of
2713 the hash are the fields from the C<items> and C<biblioitems> tables in
2721 my $dbh = C4::Context->dbh;
2722 my $sth = $dbh->prepare(
2723 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2726 $sth->execute($barcode);
2727 my $data = $sth->fetchrow_hashref;
2739 Koha Developement team <info@koha.org>