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;
256 # create item information if we have serialsadditems for this subscription
257 if ( $data->{'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;
305 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
306 $rq->execute($serialid, $itemnumber);
310 =head2 UpdateClaimdateIssues
314 UpdateClaimdateIssues($serialids,[$date]);
316 Update Claimdate for issues in @$serialids list with date $date
322 sub UpdateClaimdateIssues {
323 my ( $serialids, $date ) = @_;
324 my $dbh = C4::Context->dbh;
325 $date = strftime("%Y-%m-%d",localtime) unless ($date);
327 UPDATE serial SET claimdate=$date,status=7
328 WHERE serialid in ".join (",",@$serialids);
330 my $rq = $dbh->prepare($query);
335 =head2 GetSubscription
339 $subs = GetSubscription($subscriptionid)
340 this function get the subscription which has $subscriptionid as id.
342 a hashref. This hash containts
343 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
349 sub GetSubscription {
350 my ($subscriptionid) = @_;
351 my $dbh = C4::Context->dbh;
353 SELECT subscription.*,
354 subscriptionhistory.*,
355 subscriptionhistory.enddate as histenddate,
357 aqbooksellers.name AS aqbooksellername,
358 biblio.title AS bibliotitle,
359 subscription.biblionumber as bibnum);
360 if (C4::Context->preference('IndependantBranches') &&
361 C4::Context->userenv &&
362 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
364 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
368 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
369 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
370 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
371 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
372 WHERE subscription.subscriptionid = ?
374 # if (C4::Context->preference('IndependantBranches') &&
375 # C4::Context->userenv &&
376 # C4::Context->userenv->{'flags'} != 1){
377 # # warn "flags: ".C4::Context->userenv->{'flags'};
378 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
380 # warn "query : $query";
381 my $sth = $dbh->prepare($query);
382 # warn "subsid :$subscriptionid";
383 $sth->execute($subscriptionid);
384 my $subs = $sth->fetchrow_hashref;
388 =head2 GetFullSubscription
392 \@res = GetFullSubscription($subscriptionid)
393 this function read on serial table.
399 sub GetFullSubscription {
400 my ($subscriptionid) = @_;
401 my $dbh = C4::Context->dbh;
403 SELECT serial.serialid,
406 serial.publisheddate,
408 serial.notes as notes,
409 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
410 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
411 biblio.title as bibliotitle,
412 subscription.branchcode AS branchcode,
413 subscription.subscriptionid AS subscriptionid |;
414 if (C4::Context->preference('IndependantBranches') &&
415 C4::Context->userenv &&
416 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
418 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
422 LEFT JOIN subscription ON
423 (serial.subscriptionid=subscription.subscriptionid )
424 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
425 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
426 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
427 WHERE serial.subscriptionid = ?
429 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
430 serial.subscriptionid
433 my $sth = $dbh->prepare($query);
434 $sth->execute($subscriptionid);
435 my $subs = $sth->fetchall_arrayref({});
440 =head2 PrepareSerialsData
444 \@res = PrepareSerialsData($serialinfomation)
445 where serialinformation is a hashref array
451 sub PrepareSerialsData{
457 my $aqbooksellername;
461 my $previousnote = "";
463 foreach my $subs ( @$lines ) {
464 $subs->{'publisheddate'} =
465 ( $subs->{'publisheddate'}
466 ? format_date( $subs->{'publisheddate'} )
468 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
469 $subs->{ "status" . $subs->{'status'} } = 1;
471 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
472 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
473 $year = $subs->{'year'};
478 if ( $tmpresults{$year} ) {
479 push @{ $tmpresults{$year}->{'serials'} }, $subs;
482 $tmpresults{$year} = {
485 # 'startdate'=>format_date($subs->{'startdate'}),
486 'aqbooksellername' => $subs->{'aqbooksellername'},
487 'bibliotitle' => $subs->{'bibliotitle'},
488 'serials' => [$subs],
490 # 'branchcode' => $subs->{'branchcode'},
491 # 'subscriptionid' => $subs->{'subscriptionid'},
495 # $previousnote=$subs->{notes};
497 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
498 push @res, $tmpresults{$key};
500 $res[0]->{'first'}=1;
504 =head2 GetSubscriptionsFromBiblionumber
506 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
507 this function get the subscription list. it reads on subscription table.
509 table of subscription which has the biblionumber given on input arg.
510 each line of this table is a hashref. All hashes containt
511 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
515 sub GetSubscriptionsFromBiblionumber {
516 my ($biblionumber) = @_;
517 my $dbh = C4::Context->dbh;
519 SELECT subscription.*,
521 subscriptionhistory.*,
522 subscriptionhistory.enddate as histenddate,
524 aqbooksellers.name AS aqbooksellername,
525 biblio.title AS bibliotitle
527 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
528 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
529 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
530 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
531 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
532 WHERE subscription.biblionumber = ?
534 # if (C4::Context->preference('IndependantBranches') &&
535 # C4::Context->userenv &&
536 # C4::Context->userenv->{'flags'} != 1){
537 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
539 my $sth = $dbh->prepare($query);
540 $sth->execute($biblionumber);
542 while ( my $subs = $sth->fetchrow_hashref ) {
543 $subs->{startdate} = format_date( $subs->{startdate} );
544 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
545 $subs->{histenddate} = format_date( $subs->{histenddate} );
546 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
547 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
548 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
549 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
550 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
551 $subs->{ "status" . $subs->{'status'} } = 1;
552 $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
553 C4::Context->userenv &&
554 C4::Context->userenv->{flags} !=1 &&
555 C4::Context->userenv->{branch} && $subs->{branchcode} &&
556 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
557 if ( $subs->{enddate} eq '0000-00-00' ) {
558 $subs->{enddate} = '';
561 $subs->{enddate} = format_date( $subs->{enddate} );
563 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
564 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
570 =head2 GetFullSubscriptionsFromBiblionumber
574 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
575 this function read on serial table.
581 sub GetFullSubscriptionsFromBiblionumber {
582 my ($biblionumber) = @_;
583 my $dbh = C4::Context->dbh;
585 SELECT serial.serialid,
588 serial.publisheddate,
590 serial.notes as notes,
591 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
592 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
593 biblio.title as bibliotitle,
594 subscription.branchcode AS branchcode,
595 subscription.subscriptionid AS subscriptionid|;
596 if (C4::Context->preference('IndependantBranches') &&
597 C4::Context->userenv &&
598 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
600 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
605 LEFT JOIN subscription ON
606 (serial.subscriptionid=subscription.subscriptionid)
607 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
608 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
609 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
610 WHERE subscription.biblionumber = ?
612 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
613 serial.subscriptionid
615 my $sth = $dbh->prepare($query);
616 $sth->execute($biblionumber);
617 my $subs= $sth->fetchall_arrayref({});
621 =head2 GetSubscriptions
625 @results = GetSubscriptions($title,$ISSN,$biblionumber);
626 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
628 a table of hashref. Each hash containt the subscription.
634 sub GetSubscriptions {
635 my ( $title, $ISSN, $biblionumber ) = @_;
636 #return unless $title or $ISSN or $biblionumber;
637 my $dbh = C4::Context->dbh;
641 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
643 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
644 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
645 WHERE biblio.biblionumber=?
647 $query.=" ORDER BY title";
648 # warn "query :$query";
649 $sth = $dbh->prepare($query);
650 $sth->execute($biblionumber);
653 if ( $ISSN and $title ) {
655 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
657 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
658 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
659 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
660 $query.=" ORDER BY title";
661 $sth = $dbh->prepare($query);
662 $sth->execute( $ISSN );
667 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
669 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
670 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
671 WHERE biblioitems.issn LIKE ?
673 $query.=" ORDER BY title";
674 # warn "query :$query";
675 $sth = $dbh->prepare($query);
676 $sth->execute( "%" . $ISSN . "%" );
680 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
682 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
683 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
685 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
687 $query.=" ORDER BY title";
689 $sth = $dbh->prepare($query);
695 my $previoustitle = "";
697 while ( my $line = $sth->fetchrow_hashref ) {
698 if ( $previoustitle eq $line->{title} ) {
701 $line->{toggle} = 1 if $odd == 1;
704 $previoustitle = $line->{title};
706 $line->{toggle} = 1 if $odd == 1;
708 $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
709 C4::Context->userenv &&
710 C4::Context->userenv->{flags} !=1 &&
711 C4::Context->userenv->{branch} && $line->{branchcode} &&
712 (C4::Context->userenv->{branch} ne $line->{branchcode}));
713 push @results, $line;
722 ($totalissues,@serials) = GetSerials($subscriptionid);
723 this function get every serial not arrived for a given subscription
724 as well as the number of issues registered in the database (all types)
725 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
732 my ($subscriptionid,$count) = @_;
733 my $dbh = C4::Context->dbh;
735 # status = 2 is "arrived"
737 $count=5 unless ($count);
740 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
742 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
743 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
744 my $sth = $dbh->prepare($query);
745 $sth->execute($subscriptionid);
746 while ( my $line = $sth->fetchrow_hashref ) {
747 $line->{ "status" . $line->{status} } =
748 1; # fills a "statusX" value, used for template status select list
749 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
750 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
751 push @serials, $line;
753 # OK, now add the last 5 issues arrives/missing
755 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
757 WHERE subscriptionid = ?
758 AND (status in (2,4,5))
759 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
761 $sth = $dbh->prepare($query);
762 $sth->execute($subscriptionid);
763 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
765 $line->{ "status" . $line->{status} } =
766 1; # fills a "statusX" value, used for template status select list
767 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
768 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
769 push @serials, $line;
772 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
773 $sth = $dbh->prepare($query);
774 $sth->execute($subscriptionid);
775 my ($totalissues) = $sth->fetchrow;
776 return ( $totalissues, @serials );
783 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
784 this function get every serial waited for a given subscription
785 as well as the number of issues registered in the database (all types)
786 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
792 my ($subscription,$status) = @_;
793 my $dbh = C4::Context->dbh;
795 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
797 WHERE subscriptionid=$subscription AND status IN ($status)
798 ORDER BY publisheddate,serialid DESC
801 my $sth=$dbh->prepare($query);
804 while(my $line = $sth->fetchrow_hashref) {
805 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
806 $line->{"planneddate"} = format_date($line->{"planneddate"});
807 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
810 my ($totalissues) = scalar(@serials);
811 return ($totalissues,@serials);
814 =head2 GetLatestSerials
818 \@serials = GetLatestSerials($subscriptionid,$limit)
819 get the $limit's latest serials arrived or missing for a given subscription
821 a ref to a table which it containts all of the latest serials stored into a hash.
827 sub GetLatestSerials {
828 my ( $subscriptionid, $limit ) = @_;
829 my $dbh = C4::Context->dbh;
831 # status = 2 is "arrived"
832 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
834 WHERE subscriptionid = ?
835 AND (status =2 or status=4)
836 ORDER BY planneddate DESC LIMIT 0,$limit
838 my $sth = $dbh->prepare($strsth);
839 $sth->execute($subscriptionid);
841 while ( my $line = $sth->fetchrow_hashref ) {
842 $line->{ "status" . $line->{status} } =
843 1; # fills a "statusX" value, used for template status select list
844 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
845 push @serials, $line;
851 # WHERE subscriptionid=?
853 # $sth=$dbh->prepare($query);
854 # $sth->execute($subscriptionid);
855 # my ($totalissues) = $sth->fetchrow;
859 =head2 GetDistributedTo
863 $distributedto=GetDistributedTo($subscriptionid)
864 This function select the old previous value of distributedto in the database.
870 sub GetDistributedTo {
871 my $dbh = C4::Context->dbh;
873 my $subscriptionid = @_;
874 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
875 my $sth = $dbh->prepare($query);
876 $sth->execute($subscriptionid);
877 return ($distributedto) = $sth->fetchrow;
885 $val is a hashref containing all the attributes of the table 'subscription'
886 This function get the next issue for the subscription given on input arg
888 all the input params updated.
896 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
897 # $calculated = $val->{numberingmethod};
898 # # calculate the (expected) value of the next issue recieved.
899 # $newlastvalue1 = $val->{lastvalue1};
900 # # check if we have to increase the new value.
901 # $newinnerloop1 = $val->{innerloop1}+1;
902 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
903 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
904 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
905 # $calculated =~ s/\{X\}/$newlastvalue1/g;
907 # $newlastvalue2 = $val->{lastvalue2};
908 # # check if we have to increase the new value.
909 # $newinnerloop2 = $val->{innerloop2}+1;
910 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
911 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
912 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
913 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
915 # $newlastvalue3 = $val->{lastvalue3};
916 # # check if we have to increase the new value.
917 # $newinnerloop3 = $val->{innerloop3}+1;
918 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
919 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
920 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
921 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
922 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
928 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
929 $newinnerloop1, $newinnerloop2, $newinnerloop3
931 my $pattern = $val->{numberpattern};
932 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
933 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
934 $calculated = $val->{numberingmethod};
935 $newlastvalue1 = $val->{lastvalue1};
936 $newlastvalue2 = $val->{lastvalue2};
937 $newlastvalue3 = $val->{lastvalue3};
938 $newlastvalue1 = $val->{lastvalue1};
939 # check if we have to increase the new value.
940 $newinnerloop1 = $val->{innerloop1} + 1;
941 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
942 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
943 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
944 $calculated =~ s/\{X\}/$newlastvalue1/g;
946 $newlastvalue2 = $val->{lastvalue2};
947 # check if we have to increase the new value.
948 $newinnerloop2 = $val->{innerloop2} + 1;
949 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
950 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
951 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
952 if ( $pattern == 6 ) {
953 if ( $val->{hemisphere} == 2 ) {
954 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
955 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
958 my $newlastvalue2seq = $seasons[$newlastvalue2];
959 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
963 $calculated =~ s/\{Y\}/$newlastvalue2/g;
967 $newlastvalue3 = $val->{lastvalue3};
968 # check if we have to increase the new value.
969 $newinnerloop3 = $val->{innerloop3} + 1;
970 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
971 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
972 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
973 $calculated =~ s/\{Z\}/$newlastvalue3/g;
975 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
976 $newinnerloop1, $newinnerloop2, $newinnerloop3);
983 $calculated = GetSeq($val)
984 $val is a hashref containing all the attributes of the table 'subscription'
985 this function transforms {X},{Y},{Z} to 150,0,0 for example.
987 the sequence in integer format
995 my $pattern = $val->{numberpattern};
996 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
997 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
998 my $calculated = $val->{numberingmethod};
999 my $x = $val->{'lastvalue1'};
1000 $calculated =~ s/\{X\}/$x/g;
1001 my $newlastvalue2 = $val->{'lastvalue2'};
1002 if ( $pattern == 6 ) {
1003 if ( $val->{hemisphere} == 2 ) {
1004 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1005 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1008 my $newlastvalue2seq = $seasons[$newlastvalue2];
1009 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1013 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1015 my $z = $val->{'lastvalue3'};
1016 $calculated =~ s/\{Z\}/$z/g;
1020 =head2 GetExpirationDate
1022 $sensddate = GetExpirationDate($subscriptionid)
1024 this function return the expiration date for a subscription given on input args.
1031 sub GetExpirationDate {
1032 my ($subscriptionid) = @_;
1033 my $dbh = C4::Context->dbh;
1034 my $subscription = GetSubscription($subscriptionid);
1035 my $enddate = $subscription->{startdate};
1037 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1038 if (($subscription->{periodicity} % 16) >0){
1039 if ( $subscription->{numberlength} ) {
1040 #calculate the date of the last issue.
1041 my $length = $subscription->{numberlength};
1042 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1043 $enddate = GetNextDate( $enddate, $subscription );
1046 elsif ( $subscription->{monthlength} ){
1047 my @date=split (/-/,$subscription->{startdate});
1048 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1049 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1050 } elsif ( $subscription->{weeklength} ){
1051 my @date=split (/-/,$subscription->{startdate});
1052 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1053 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1061 =head2 CountSubscriptionFromBiblionumber
1065 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1066 this count the number of subscription for a biblionumber given.
1068 the number of subscriptions with biblionumber given on input arg.
1074 sub CountSubscriptionFromBiblionumber {
1075 my ($biblionumber) = @_;
1076 my $dbh = C4::Context->dbh;
1077 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1078 my $sth = $dbh->prepare($query);
1079 $sth->execute($biblionumber);
1080 my $subscriptionsnumber = $sth->fetchrow;
1081 return $subscriptionsnumber;
1084 =head2 ModSubscriptionHistory
1088 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1090 this function modify the history of a subscription. Put your new values on input arg.
1096 sub ModSubscriptionHistory {
1098 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1099 $missinglist, $opacnote, $librariannote
1101 my $dbh = C4::Context->dbh;
1102 my $query = "UPDATE subscriptionhistory
1103 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1104 WHERE subscriptionid=?
1106 my $sth = $dbh->prepare($query);
1107 $recievedlist =~ s/^,//g;
1108 $missinglist =~ s/^,//g;
1109 $opacnote =~ s/^,//g;
1111 $histstartdate, $enddate, $recievedlist, $missinglist,
1112 $opacnote, $librariannote, $subscriptionid
1117 =head2 ModSerialStatus
1121 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1123 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1124 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1130 sub ModSerialStatus {
1131 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1134 #It is a usual serial
1135 # 1st, get previous status :
1136 my $dbh = C4::Context->dbh;
1137 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1138 my $sth = $dbh->prepare($query);
1139 $sth->execute($serialid);
1140 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1142 # change status & update subscriptionhistory
1144 if ( $status eq 6 ) {
1145 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1149 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1150 $sth = $dbh->prepare($query);
1151 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1152 $notes, $serialid );
1153 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1154 $sth = $dbh->prepare($query);
1155 $sth->execute($subscriptionid);
1156 my $val = $sth->fetchrow_hashref;
1157 unless ( $val->{manualhistory} ) {
1159 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1160 $sth = $dbh->prepare($query);
1161 $sth->execute($subscriptionid);
1162 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1163 if ( $status eq 2 ) {
1165 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1166 $recievedlist .= ",$serialseq"
1167 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1170 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1171 $missinglist .= ",$serialseq"
1173 and not index( "$missinglist", "$serialseq" ) >= 0 );
1174 $missinglist .= ",not issued $serialseq"
1176 and index( "$missinglist", "$serialseq" ) >= 0 );
1178 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1179 $sth = $dbh->prepare($query);
1180 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1184 # create new waited entry if needed (ie : was a "waited" and has changed)
1185 if ( $oldstatus eq 1 && $status ne 1 ) {
1186 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1187 $sth = $dbh->prepare($query);
1188 $sth->execute($subscriptionid);
1189 my $val = $sth->fetchrow_hashref;
1194 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1195 $newinnerloop1, $newinnerloop2, $newinnerloop3
1196 ) = GetNextSeq($val);
1197 # warn "Next Seq End";
1199 # next date (calculated from actual date & frequency parameters)
1200 # warn "publisheddate :$publisheddate ";
1201 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1202 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1203 1, $nextpublisheddate, $nextpublisheddate );
1205 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1206 WHERE subscriptionid = ?";
1207 $sth = $dbh->prepare($query);
1209 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1210 $newinnerloop2, $newinnerloop3, $subscriptionid
1213 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1214 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1215 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1220 =head2 ModSubscription
1224 this function modify a subscription. Put all new values on input args.
1230 sub ModSubscription {
1232 $auser, $branchcode, $aqbooksellerid, $cost,
1233 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1234 $dow, $irregularity, $numberpattern, $numberlength,
1235 $weeklength, $monthlength, $add1, $every1,
1236 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1237 $add2, $every2, $whenmorethan2, $setto2,
1238 $lastvalue2, $innerloop2, $add3, $every3,
1239 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1240 $numberingmethod, $status, $biblionumber, $callnumber,
1241 $notes, $letter, $hemisphere, $manualhistory,
1242 $internalnotes, $serialsadditems,
1245 # warn $irregularity;
1246 my $dbh = C4::Context->dbh;
1247 my $query = "UPDATE subscription
1248 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1249 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1250 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1251 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1252 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1253 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?
1254 WHERE subscriptionid = ?";
1255 # warn "query :".$query;
1256 my $sth = $dbh->prepare($query);
1258 $auser, $branchcode, $aqbooksellerid, $cost,
1259 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1260 $dow, "$irregularity", $numberpattern, $numberlength,
1261 $weeklength, $monthlength, $add1, $every1,
1262 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1263 $add2, $every2, $whenmorethan2, $setto2,
1264 $lastvalue2, $innerloop2, $add3, $every3,
1265 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1266 $numberingmethod, $status, $biblionumber, $callnumber,
1267 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1268 $internalnotes, $serialsadditems,
1271 my $rows=$sth->rows;
1274 logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1278 =head2 NewSubscription
1282 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1283 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1284 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1285 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1286 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1287 $numberingmethod, $status, $notes, $serialsadditems)
1289 Create a new subscription with value given on input args.
1292 the id of this new subscription
1298 sub NewSubscription {
1300 $auser, $branchcode, $aqbooksellerid, $cost,
1301 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1302 $dow, $numberlength, $weeklength, $monthlength,
1303 $add1, $every1, $whenmorethan1, $setto1,
1304 $lastvalue1, $innerloop1, $add2, $every2,
1305 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1306 $add3, $every3, $whenmorethan3, $setto3,
1307 $lastvalue3, $innerloop3, $numberingmethod, $status,
1308 $notes, $letter, $firstacquidate, $irregularity,
1309 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1310 $internalnotes, $serialsadditems,
1312 my $dbh = C4::Context->dbh;
1314 #save subscription (insert into database)
1316 INSERT INTO subscription
1317 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1318 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1319 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1320 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1321 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1322 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1323 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems)
1324 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1326 my $sth = $dbh->prepare($query);
1328 $auser, $branchcode,
1329 $aqbooksellerid, $cost,
1330 $aqbudgetid, $biblionumber,
1331 format_date_in_iso($startdate), $periodicity,
1332 $dow, $numberlength,
1333 $weeklength, $monthlength,
1335 $whenmorethan1, $setto1,
1336 $lastvalue1, $innerloop1,
1338 $whenmorethan2, $setto2,
1339 $lastvalue2, $innerloop2,
1341 $whenmorethan3, $setto3,
1342 $lastvalue3, $innerloop3,
1343 $numberingmethod, "$status",
1345 format_date_in_iso($firstacquidate), $irregularity,
1346 $numberpattern, $callnumber,
1347 $hemisphere, $manualhistory,
1348 $internalnotes, $serialsadditems,
1351 #then create the 1st waited number
1352 my $subscriptionid = $dbh->{'mysql_insertid'};
1354 INSERT INTO subscriptionhistory
1355 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1358 $sth = $dbh->prepare($query);
1359 $sth->execute( $biblionumber, $subscriptionid,
1360 format_date_in_iso($startdate),
1361 $notes,$internalnotes );
1363 # reread subscription to get a hash (for calculation of the 1st issue number)
1367 WHERE subscriptionid = ?
1369 $sth = $dbh->prepare($query);
1370 $sth->execute($subscriptionid);
1371 my $val = $sth->fetchrow_hashref;
1373 # calculate issue number
1374 my $serialseq = GetSeq($val);
1377 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1378 VALUES (?,?,?,?,?,?)
1380 $sth = $dbh->prepare($query);
1382 "$serialseq", $subscriptionid, $biblionumber, 1,
1383 format_date_in_iso($startdate),
1384 format_date_in_iso($startdate)
1387 logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1389 #set serial flag on biblio if not already set.
1390 my ($null, ($bib)) = GetBiblio($biblionumber);
1391 if( ! $bib->{'serial'} ) {
1392 my $record = GetMarcBiblio($biblionumber);
1393 my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1396 $record->field($tag)->update( $subf => 1 );
1399 ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1401 return $subscriptionid;
1404 =head2 ReNewSubscription
1408 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1410 this function renew a subscription with values given on input args.
1416 sub ReNewSubscription {
1417 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1418 $monthlength, $note )
1420 my $dbh = C4::Context->dbh;
1421 my $subscription = GetSubscription($subscriptionid);
1425 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1426 WHERE biblio.biblionumber=?
1428 my $sth = $dbh->prepare($query);
1429 $sth->execute( $subscription->{biblionumber} );
1430 my $biblio = $sth->fetchrow_hashref;
1432 $user, $subscription->{bibliotitle},
1433 $biblio->{author}, $biblio->{publishercode},
1434 $biblio->{note}, '',
1437 $subscription->{biblionumber}
1440 # renew subscription
1443 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1444 WHERE subscriptionid=?
1446 $sth = $dbh->prepare($query);
1447 $sth->execute( format_date_in_iso($startdate),
1448 $numberlength, $weeklength, $monthlength, $subscriptionid );
1450 logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1457 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1459 Create a new issue stored on the database.
1460 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1467 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1468 $planneddate, $publisheddate, $notes )
1470 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1472 my $dbh = C4::Context->dbh;
1475 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1476 VALUES (?,?,?,?,?,?,?)
1478 my $sth = $dbh->prepare($query);
1479 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1480 $publisheddate, $planneddate,$notes );
1481 my $serialid=$dbh->{'mysql_insertid'};
1483 SELECT missinglist,recievedlist
1484 FROM subscriptionhistory
1485 WHERE subscriptionid=?
1487 $sth = $dbh->prepare($query);
1488 $sth->execute($subscriptionid);
1489 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1491 if ( $status eq 2 ) {
1492 ### TODO Add a feature that improves recognition and description.
1493 ### As such count (serialseq) i.e. : N18,2(N19),N20
1494 ### Would use substr and index But be careful to previous presence of ()
1495 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1497 if ( $status eq 4 ) {
1498 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1501 UPDATE subscriptionhistory
1502 SET recievedlist=?, missinglist=?
1503 WHERE subscriptionid=?
1505 $sth = $dbh->prepare($query);
1506 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1510 =head2 ItemizeSerials
1514 ItemizeSerials($serialid, $info);
1515 $info is a hashref containing barcode branch, itemcallnumber, status, location
1516 $serialid the serialid
1518 1 if the itemize is a succes.
1519 0 and @error else. @error containts the list of errors found.
1525 sub ItemizeSerials {
1526 my ( $serialid, $info ) = @_;
1527 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1529 my $dbh = C4::Context->dbh;
1535 my $sth = $dbh->prepare($query);
1536 $sth->execute($serialid);
1537 my $data = $sth->fetchrow_hashref;
1538 if ( C4::Context->preference("RoutingSerials") ) {
1540 # check for existing biblioitem relating to serial issue
1541 my ( $count, @results ) =
1542 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1544 for ( my $i = 0 ; $i < $count ; $i++ ) {
1545 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1546 . $data->{'planneddate'}
1549 $bibitemno = $results[$i]->{'biblioitemnumber'};
1553 if ( $bibitemno == 0 ) {
1555 # warn "need to add new biblioitem so copy last one and make minor changes";
1558 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1560 $sth->execute( $data->{'biblionumber'} );
1561 my $biblioitem = $sth->fetchrow_hashref;
1562 $biblioitem->{'volumedate'} =
1563 format_date_in_iso( $data->{planneddate} );
1564 $biblioitem->{'volumeddesc'} =
1565 $data->{serialseq} . ' ('
1566 . format_date( $data->{'planneddate'} ) . ')';
1567 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1569 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1570 # so I comment it, we can speak of it when you want
1571 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1572 # if ( $info->{barcode} )
1573 # { # only make biblioitem if we are going to make item also
1574 # $bibitemno = newbiblioitem($biblioitem);
1579 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1580 if ( $info->{barcode} ) {
1582 my $exists = itemdata( $info->{'barcode'} );
1583 push @errors, "barcode_not_unique" if ($exists);
1585 my $marcrecord = MARC::Record->new();
1586 my ( $tag, $subfield ) =
1587 GetMarcFromKohaField( "items.barcode", $fwk );
1589 MARC::Field->new( "$tag", '', '',
1590 "$subfield" => $info->{barcode} );
1591 $marcrecord->insert_fields_ordered($newField);
1592 if ( $info->{branch} ) {
1593 my ( $tag, $subfield ) =
1594 GetMarcFromKohaField( "items.homebranch",
1597 #warn "items.homebranch : $tag , $subfield";
1598 if ( $marcrecord->field($tag) ) {
1599 $marcrecord->field($tag)
1600 ->add_subfields( "$subfield" => $info->{branch} );
1604 MARC::Field->new( "$tag", '', '',
1605 "$subfield" => $info->{branch} );
1606 $marcrecord->insert_fields_ordered($newField);
1608 ( $tag, $subfield ) =
1609 GetMarcFromKohaField( "items.holdingbranch",
1612 #warn "items.holdingbranch : $tag , $subfield";
1613 if ( $marcrecord->field($tag) ) {
1614 $marcrecord->field($tag)
1615 ->add_subfields( "$subfield" => $info->{branch} );
1619 MARC::Field->new( "$tag", '', '',
1620 "$subfield" => $info->{branch} );
1621 $marcrecord->insert_fields_ordered($newField);
1624 if ( $info->{itemcallnumber} ) {
1625 my ( $tag, $subfield ) =
1626 GetMarcFromKohaField( "items.itemcallnumber",
1629 #warn "items.itemcallnumber : $tag , $subfield";
1630 if ( $marcrecord->field($tag) ) {
1631 $marcrecord->field($tag)
1632 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1636 MARC::Field->new( "$tag", '', '',
1637 "$subfield" => $info->{itemcallnumber} );
1638 $marcrecord->insert_fields_ordered($newField);
1641 if ( $info->{notes} ) {
1642 my ( $tag, $subfield ) =
1643 GetMarcFromKohaField( "items.itemnotes", $fwk );
1645 # warn "items.itemnotes : $tag , $subfield";
1646 if ( $marcrecord->field($tag) ) {
1647 $marcrecord->field($tag)
1648 ->add_subfields( "$subfield" => $info->{notes} );
1652 MARC::Field->new( "$tag", '', '',
1653 "$subfield" => $info->{notes} );
1654 $marcrecord->insert_fields_ordered($newField);
1657 if ( $info->{location} ) {
1658 my ( $tag, $subfield ) =
1659 GetMarcFromKohaField( "items.location", $fwk );
1661 # warn "items.location : $tag , $subfield";
1662 if ( $marcrecord->field($tag) ) {
1663 $marcrecord->field($tag)
1664 ->add_subfields( "$subfield" => $info->{location} );
1668 MARC::Field->new( "$tag", '', '',
1669 "$subfield" => $info->{location} );
1670 $marcrecord->insert_fields_ordered($newField);
1673 if ( $info->{status} ) {
1674 my ( $tag, $subfield ) =
1675 GetMarcFromKohaField( "items.notforloan",
1678 # warn "items.notforloan : $tag , $subfield";
1679 if ( $marcrecord->field($tag) ) {
1680 $marcrecord->field($tag)
1681 ->add_subfields( "$subfield" => $info->{status} );
1685 MARC::Field->new( "$tag", '', '',
1686 "$subfield" => $info->{status} );
1687 $marcrecord->insert_fields_ordered($newField);
1690 if ( C4::Context->preference("RoutingSerials") ) {
1691 my ( $tag, $subfield ) =
1692 GetMarcFromKohaField( "items.dateaccessioned",
1694 if ( $marcrecord->field($tag) ) {
1695 $marcrecord->field($tag)
1696 ->add_subfields( "$subfield" => $now );
1700 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1701 $marcrecord->insert_fields_ordered($newField);
1704 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1707 return ( 0, @errors );
1711 =head2 HasSubscriptionExpired
1715 1 or 0 = HasSubscriptionExpired($subscriptionid)
1717 the subscription has expired when the next issue to arrive is out of subscription limit.
1720 1 if true, 0 if false.
1726 sub HasSubscriptionExpired {
1727 my ($subscriptionid) = @_;
1728 my $dbh = C4::Context->dbh;
1729 my $subscription = GetSubscription($subscriptionid);
1730 if (($subscription->{periodicity} % 16)>0){
1731 my $expirationdate = GetExpirationDate($subscriptionid);
1733 SELECT max(planneddate)
1735 WHERE subscriptionid=?
1737 my $sth = $dbh->prepare($query);
1738 $sth->execute($subscriptionid);
1739 my ($res) = $sth->fetchrow ;
1740 my @res=split (/-/,$res);
1741 # warn "date expiration :$expirationdate";
1742 my @endofsubscriptiondate=split(/-/,$expirationdate);
1743 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1744 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1748 if ($subscription->{'numberlength'}){
1749 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1750 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1759 =head2 SetDistributedto
1763 SetDistributedto($distributedto,$subscriptionid);
1764 This function update the value of distributedto for a subscription given on input arg.
1770 sub SetDistributedto {
1771 my ( $distributedto, $subscriptionid ) = @_;
1772 my $dbh = C4::Context->dbh;
1776 WHERE subscriptionid=?
1778 my $sth = $dbh->prepare($query);
1779 $sth->execute( $distributedto, $subscriptionid );
1782 =head2 DelSubscription
1786 DelSubscription($subscriptionid)
1787 this function delete the subscription which has $subscriptionid as id.
1793 sub DelSubscription {
1794 my ($subscriptionid) = @_;
1795 my $dbh = C4::Context->dbh;
1796 $subscriptionid = $dbh->quote($subscriptionid);
1797 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1799 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1800 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1802 logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1809 DelIssue($serialseq,$subscriptionid)
1810 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1817 my ( $dataissue) = @_;
1818 my $dbh = C4::Context->dbh;
1819 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1824 AND subscriptionid= ?
1826 my $mainsth = $dbh->prepare($query);
1827 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1829 #Delete element from subscription history
1830 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1831 my $sth = $dbh->prepare($query);
1832 $sth->execute($dataissue->{'subscriptionid'});
1833 my $val = $sth->fetchrow_hashref;
1834 unless ( $val->{manualhistory} ) {
1836 SELECT * FROM subscriptionhistory
1837 WHERE subscriptionid= ?
1839 my $sth = $dbh->prepare($query);
1840 $sth->execute($dataissue->{'subscriptionid'});
1841 my $data = $sth->fetchrow_hashref;
1842 my $serialseq= $dataissue->{'serialseq'};
1843 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1844 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1845 my $strsth = "UPDATE subscriptionhistory SET "
1847 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1848 . " WHERE subscriptionid=?";
1849 $sth = $dbh->prepare($strsth);
1850 $sth->execute($dataissue->{'subscriptionid'});
1853 return $mainsth->rows;
1856 =head2 GetLateOrMissingIssues
1860 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1862 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1865 a count of the number of missing issues
1866 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1867 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1873 sub GetLateOrMissingIssues {
1874 my ( $supplierid, $serialid,$order ) = @_;
1875 my $dbh = C4::Context->dbh;
1879 $byserial = "and serialid = " . $serialid;
1887 $sth = $dbh->prepare(
1896 serial.subscriptionid,
1899 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1900 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1901 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1902 WHERE subscription.subscriptionid = serial.subscriptionid
1903 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1904 AND subscription.aqbooksellerid=$supplierid
1910 $sth = $dbh->prepare(
1919 serial.subscriptionid,
1922 LEFT JOIN subscription
1923 ON serial.subscriptionid=subscription.subscriptionid
1925 ON subscription.biblionumber=biblio.biblionumber
1926 LEFT JOIN aqbooksellers
1927 ON subscription.aqbooksellerid = aqbooksellers.id
1929 subscription.subscriptionid = serial.subscriptionid
1930 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1940 while ( my $line = $sth->fetchrow_hashref ) {
1941 $odd++ unless $line->{title} eq $last_title;
1942 $last_title = $line->{title} if ( $line->{title} );
1943 $line->{planneddate} = format_date( $line->{planneddate} );
1944 $line->{claimdate} = format_date( $line->{claimdate} );
1945 $line->{"status".$line->{status}} = 1;
1946 $line->{'odd'} = 1 if $odd % 2;
1948 push @issuelist, $line;
1950 return $count, @issuelist;
1953 =head2 removeMissingIssue
1957 removeMissingIssue($subscriptionid)
1959 this function removes an issue from being part of the missing string in
1960 subscriptionlist.missinglist column
1962 called when a missing issue is found from the serials-recieve.pl file
1968 sub removeMissingIssue {
1969 my ( $sequence, $subscriptionid ) = @_;
1970 my $dbh = C4::Context->dbh;
1973 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1974 $sth->execute($subscriptionid);
1975 my $data = $sth->fetchrow_hashref;
1976 my $missinglist = $data->{'missinglist'};
1977 my $missinglistbefore = $missinglist;
1979 # warn $missinglist." before";
1980 $missinglist =~ s/($sequence)//;
1982 # warn $missinglist." after";
1983 if ( $missinglist ne $missinglistbefore ) {
1984 $missinglist =~ s/\|\s\|/\|/g;
1985 $missinglist =~ s/^\| //g;
1986 $missinglist =~ s/\|$//g;
1987 my $sth2 = $dbh->prepare(
1988 "UPDATE subscriptionhistory
1990 WHERE subscriptionid = ?"
1992 $sth2->execute( $missinglist, $subscriptionid );
2000 &updateClaim($serialid)
2002 this function updates the time when a claim is issued for late/missing items
2004 called from claims.pl file
2011 my ($serialid) = @_;
2012 my $dbh = C4::Context->dbh;
2013 my $sth = $dbh->prepare(
2014 "UPDATE serial SET claimdate = now()
2018 $sth->execute($serialid);
2021 =head2 getsupplierbyserialid
2025 ($result) = &getsupplierbyserialid($serialid)
2027 this function is used to find the supplier id given a serial id
2030 hashref containing serialid, subscriptionid, and aqbooksellerid
2036 sub getsupplierbyserialid {
2037 my ($serialid) = @_;
2038 my $dbh = C4::Context->dbh;
2039 my $sth = $dbh->prepare(
2040 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2042 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2046 $sth->execute($serialid);
2047 my $line = $sth->fetchrow_hashref;
2048 my $result = $line->{'aqbooksellerid'};
2052 =head2 check_routing
2056 ($result) = &check_routing($subscriptionid)
2058 this function checks to see if a serial has a routing list and returns the count of routingid
2059 used to show either an 'add' or 'edit' link
2065 my ($subscriptionid) = @_;
2066 my $dbh = C4::Context->dbh;
2067 my $sth = $dbh->prepare(
2068 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2069 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2070 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2073 $sth->execute($subscriptionid);
2074 my $line = $sth->fetchrow_hashref;
2075 my $result = $line->{'routingids'};
2079 =head2 addroutingmember
2083 &addroutingmember($borrowernumber,$subscriptionid)
2085 this function takes a borrowernumber and subscriptionid and add the member to the
2086 routing list for that serial subscription and gives them a rank on the list
2087 of either 1 or highest current rank + 1
2093 sub addroutingmember {
2094 my ( $borrowernumber, $subscriptionid ) = @_;
2096 my $dbh = C4::Context->dbh;
2099 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2101 $sth->execute($subscriptionid);
2102 while ( my $line = $sth->fetchrow_hashref ) {
2103 if ( $line->{'rank'} > 0 ) {
2104 $rank = $line->{'rank'} + 1;
2112 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2114 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2117 =head2 reorder_members
2121 &reorder_members($subscriptionid,$routingid,$rank)
2123 this function is used to reorder the routing list
2125 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2126 - it gets all members on list puts their routingid's into an array
2127 - removes the one in the array that is $routingid
2128 - then reinjects $routingid at point indicated by $rank
2129 - then update the database with the routingids in the new order
2135 sub reorder_members {
2136 my ( $subscriptionid, $routingid, $rank ) = @_;
2137 my $dbh = C4::Context->dbh;
2140 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2142 $sth->execute($subscriptionid);
2144 while ( my $line = $sth->fetchrow_hashref ) {
2145 push( @result, $line->{'routingid'} );
2148 # To find the matching index
2150 my $key = -1; # to allow for 0 being a valid response
2151 for ( $i = 0 ; $i < @result ; $i++ ) {
2152 if ( $routingid == $result[$i] ) {
2153 $key = $i; # save the index
2158 # if index exists in array then move it to new position
2159 if ( $key > -1 && $rank > 0 ) {
2160 my $new_rank = $rank -
2161 1; # $new_rank is what you want the new index to be in the array
2162 my $moving_item = splice( @result, $key, 1 );
2163 splice( @result, $new_rank, 0, $moving_item );
2165 for ( my $j = 0 ; $j < @result ; $j++ ) {
2167 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2169 . "' WHERE routingid = '"
2176 =head2 delroutingmember
2180 &delroutingmember($routingid,$subscriptionid)
2182 this function either deletes one member from routing list if $routingid exists otherwise
2183 deletes all members from the routing list
2189 sub delroutingmember {
2191 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2192 my ( $routingid, $subscriptionid ) = @_;
2193 my $dbh = C4::Context->dbh;
2197 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2198 $sth->execute($routingid);
2199 reorder_members( $subscriptionid, $routingid );
2204 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2205 $sth->execute($subscriptionid);
2209 =head2 getroutinglist
2213 ($count,@routinglist) = &getroutinglist($subscriptionid)
2215 this gets the info from the subscriptionroutinglist for $subscriptionid
2218 a count of the number of members on routinglist
2219 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2220 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2226 sub getroutinglist {
2227 my ($subscriptionid) = @_;
2228 my $dbh = C4::Context->dbh;
2229 my $sth = $dbh->prepare(
2230 "SELECT routingid, borrowernumber,
2231 ranking, biblionumber
2233 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2234 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2237 $sth->execute($subscriptionid);
2240 while ( my $line = $sth->fetchrow_hashref ) {
2242 push( @routinglist, $line );
2244 return ( $count, @routinglist );
2247 =head2 countissuesfrom
2251 $result = &countissuesfrom($subscriptionid,$startdate)
2258 sub countissuesfrom {
2259 my ($subscriptionid,$startdate) = @_;
2260 my $dbh = C4::Context->dbh;
2264 WHERE subscriptionid=?
2265 AND serial.publisheddate>?
2267 my $sth=$dbh->prepare($query);
2268 $sth->execute($subscriptionid, $startdate);
2269 my ($countreceived)=$sth->fetchrow;
2270 return $countreceived;
2273 =head2 abouttoexpire
2277 $result = &abouttoexpire($subscriptionid)
2279 this function alerts you to the penultimate issue for a serial subscription
2281 returns 1 - if this is the penultimate issue
2289 my ($subscriptionid) = @_;
2290 my $dbh = C4::Context->dbh;
2291 my $subscription = GetSubscription($subscriptionid);
2292 my $per = $subscription->{'periodicity'};
2294 my $expirationdate = GetExpirationDate($subscriptionid);
2297 "select max(planneddate) from serial where subscriptionid=?");
2298 $sth->execute($subscriptionid);
2299 my ($res) = $sth->fetchrow ;
2300 # warn "date expiration : ".$expirationdate." date courante ".$res;
2301 my @res=split /-/,$res;
2302 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2303 my @endofsubscriptiondate=split/-/,$expirationdate;
2305 if ( $per == 1 ) {$x=7;}
2306 if ( $per == 2 ) {$x=7; }
2307 if ( $per == 3 ) {$x=14;}
2308 if ( $per == 4 ) { $x = 21; }
2309 if ( $per == 5 ) { $x = 31; }
2310 if ( $per == 6 ) { $x = 62; }
2311 if ( $per == 7 || $per == 8 ) { $x = 93; }
2312 if ( $per == 9 ) { $x = 190; }
2313 if ( $per == 10 ) { $x = 365; }
2314 if ( $per == 11 ) { $x = 730; }
2315 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2316 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2317 # warn "DATE BEFORE END: $datebeforeend";
2318 return 1 if ( @res &&
2320 Delta_Days($res[0],$res[1],$res[2],
2321 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2322 (@endofsubscriptiondate &&
2323 Delta_Days($res[0],$res[1],$res[2],
2324 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2326 } elsif ($subscription->{numberlength}>0) {
2327 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2331 =head2 old_newsubscription
2335 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2336 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2337 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2338 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2339 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2340 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2342 this function is similar to the NewSubscription subroutine but has a few different
2344 $firstacquidate - date of first serial issue to arrive
2345 $irregularity - the issues not expected separated by a '|'
2346 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2347 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2348 subscription-add.tmpl file
2349 $callnumber - display the callnumber of the serial
2350 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2353 the $subscriptionid number of the new subscription
2359 sub old_newsubscription {
2361 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2362 $biblionumber, $startdate, $periodicity, $firstacquidate,
2363 $dow, $irregularity, $numberpattern, $numberlength,
2364 $weeklength, $monthlength, $add1, $every1,
2365 $whenmorethan1, $setto1, $lastvalue1, $add2,
2366 $every2, $whenmorethan2, $setto2, $lastvalue2,
2367 $add3, $every3, $whenmorethan3, $setto3,
2368 $lastvalue3, $numberingmethod, $status, $callnumber,
2371 my $dbh = C4::Context->dbh;
2374 my $sth = $dbh->prepare(
2375 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2376 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2377 add1,every1,whenmorethan1,setto1,lastvalue1,
2378 add2,every2,whenmorethan2,setto2,lastvalue2,
2379 add3,every3,whenmorethan3,setto3,lastvalue3,
2380 numberingmethod, status, callnumber, notes, hemisphere) values
2381 (?,?,?,?,?,?,?,?,?,?,?,
2382 ?,?,?,?,?,?,?,?,?,?,?,
2383 ?,?,?,?,?,?,?,?,?,?,?,?)"
2386 $auser, $aqbooksellerid,
2388 $biblionumber, format_date_in_iso($startdate),
2389 $periodicity, format_date_in_iso($firstacquidate),
2390 $dow, $irregularity,
2391 $numberpattern, $numberlength,
2392 $weeklength, $monthlength,
2394 $whenmorethan1, $setto1,
2396 $every2, $whenmorethan2,
2397 $setto2, $lastvalue2,
2399 $whenmorethan3, $setto3,
2400 $lastvalue3, $numberingmethod,
2401 $status, $callnumber,
2405 #then create the 1st waited number
2406 my $subscriptionid = $dbh->{'mysql_insertid'};
2407 my $enddate = GetExpirationDate($subscriptionid);
2411 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2414 $biblionumber, $subscriptionid,
2415 format_date_in_iso($startdate),
2416 format_date_in_iso($enddate),
2420 # reread subscription to get a hash (for calculation of the 1st issue number)
2422 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2423 $sth->execute($subscriptionid);
2424 my $val = $sth->fetchrow_hashref;
2426 # calculate issue number
2427 my $serialseq = GetSeq($val);
2430 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2432 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2433 1, format_date_in_iso($startdate) );
2434 return $subscriptionid;
2437 =head2 old_modsubscription
2441 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2442 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2443 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2444 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2445 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2446 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2448 this function is similar to the ModSubscription subroutine but has a few different
2450 $firstacquidate - date of first serial issue to arrive
2451 $irregularity - the issues not expected separated by a '|'
2452 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2453 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2454 subscription-add.tmpl file
2455 $callnumber - display the callnumber of the serial
2456 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2462 sub old_modsubscription {
2464 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2465 $startdate, $periodicity, $firstacquidate, $dow,
2466 $irregularity, $numberpattern, $numberlength, $weeklength,
2467 $monthlength, $add1, $every1, $whenmorethan1,
2468 $setto1, $lastvalue1, $innerloop1, $add2,
2469 $every2, $whenmorethan2, $setto2, $lastvalue2,
2470 $innerloop2, $add3, $every3, $whenmorethan3,
2471 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2472 $status, $biblionumber, $callnumber, $notes,
2473 $hemisphere, $subscriptionid
2475 my $dbh = C4::Context->dbh;
2476 my $sth = $dbh->prepare(
2477 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2478 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2479 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2480 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2481 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2482 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2485 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2486 $startdate, $periodicity, $firstacquidate, $dow,
2487 $irregularity, $numberpattern, $numberlength, $weeklength,
2488 $monthlength, $add1, $every1, $whenmorethan1,
2489 $setto1, $lastvalue1, $innerloop1, $add2,
2490 $every2, $whenmorethan2, $setto2, $lastvalue2,
2491 $innerloop2, $add3, $every3, $whenmorethan3,
2492 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2493 $status, $biblionumber, $callnumber, $notes,
2494 $hemisphere, $subscriptionid
2499 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2500 $sth->execute($subscriptionid);
2501 my $val = $sth->fetchrow_hashref;
2503 # calculate issue number
2504 my $serialseq = Get_Seq($val);
2506 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2507 $sth->execute( $serialseq, $subscriptionid );
2509 my $enddate = subscriptionexpirationdate($subscriptionid);
2510 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2511 $sth->execute( format_date_in_iso($enddate) );
2514 =head2 old_getserials
2518 ($totalissues,@serials) = &old_getserials($subscriptionid)
2520 this function get a hashref of serials and the total count of them
2523 $totalissues - number of serial lines
2524 the serials into a table. Each line of this table containts a ref to a hash which it containts
2525 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2531 sub old_getserials {
2532 my ($subscriptionid) = @_;
2533 my $dbh = C4::Context->dbh;
2535 # status = 2 is "arrived"
2538 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2540 $sth->execute($subscriptionid);
2543 while ( my $line = $sth->fetchrow_hashref ) {
2544 $line->{ "status" . $line->{status} } =
2545 1; # fills a "statusX" value, used for template status select list
2546 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2547 $line->{"num"} = $num;
2549 push @serials, $line;
2551 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2552 $sth->execute($subscriptionid);
2553 my ($totalissues) = $sth->fetchrow;
2554 return ( $totalissues, @serials );
2559 ($resultdate) = &GetNextDate($planneddate,$subscription)
2561 this function is an extension of GetNextDate which allows for checking for irregularity
2563 it takes the planneddate and will return the next issue's date and will skip dates if there
2564 exists an irregularity
2565 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2566 skipped then the returned date will be 2007-05-10
2569 $resultdate - then next date in the sequence
2571 Return 0 if periodicity==0
2574 sub in_array { # used in next sub down
2575 my ($val,@elements) = @_;
2576 foreach my $elem(@elements) {
2584 sub GetNextDate(@) {
2585 my ( $planneddate, $subscription ) = @_;
2586 my @irreg = split( /\,/, $subscription->{irregularity} );
2588 #date supposed to be in ISO.
2590 my ( $year, $month, $day ) = split(/-/, $planneddate);
2591 $month=1 unless ($month);
2592 $day=1 unless ($day);
2595 # warn "DOW $dayofweek";
2596 if ( $subscription->{periodicity} % 16 == 0 ) {
2599 if ( $subscription->{periodicity} == 1 ) {
2600 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2601 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2603 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2604 $dayofweek = 0 if ( $dayofweek == 7 );
2605 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2606 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2610 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2613 if ( $subscription->{periodicity} == 2 ) {
2614 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2615 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2617 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2618 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2619 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2620 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2623 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2626 if ( $subscription->{periodicity} == 3 ) {
2627 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2628 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2630 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2631 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2632 ### BUGFIX was previously +1 ^
2633 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2634 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2637 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2640 if ( $subscription->{periodicity} == 4 ) {
2641 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2642 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2644 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2645 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2646 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2647 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2650 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2653 my $tmpmonth=$month;
2654 if ($year && $month && $day){
2655 if ( $subscription->{periodicity} == 5 ) {
2656 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2657 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2658 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2659 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2662 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2664 if ( $subscription->{periodicity} == 6 ) {
2665 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2666 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2667 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2668 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2671 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2673 if ( $subscription->{periodicity} == 7 ) {
2674 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2675 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2676 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2677 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2680 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2682 if ( $subscription->{periodicity} == 8 ) {
2683 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2684 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2685 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2686 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2689 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2691 if ( $subscription->{periodicity} == 9 ) {
2692 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2693 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2694 ### BUFIX Seems to need more Than One ?
2695 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2696 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2699 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2701 if ( $subscription->{periodicity} == 10 ) {
2702 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2704 if ( $subscription->{periodicity} == 11 ) {
2705 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2708 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2710 # warn "dateNEXTSEQ : ".$resultdate;
2711 return "$resultdate";
2716 $item = &itemdata($barcode);
2718 Looks up the item with the given barcode, and returns a
2719 reference-to-hash containing information about that item. The keys of
2720 the hash are the fields from the C<items> and C<biblioitems> tables in
2728 my $dbh = C4::Context->dbh;
2729 my $sth = $dbh->prepare(
2730 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2733 $sth->execute($barcode);
2734 my $data = $sth->fetchrow_hashref;
2746 Koha Developement team <info@koha.org>