1 package C4::Serials; #assumes C4/Serials.pm
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
24 use Date::Calc qw(:all);
25 use POSIX qw(strftime);
31 use C4::Log; # logaction
35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
37 # set the version for version checking
38 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
39 shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
44 C4::Serials - Give functions for serializing.
52 Give all XYZ functions
61 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
62 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
63 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
64 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
66 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
67 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
68 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
69 &GetSerialInformation &AddItem2Serial
72 &UpdateClaimdateIssues
73 &GetSuppliersWithLateIssues &getsupplierbyserialid
74 &GetDistributedTo &SetDistributedTo
75 &getroutinglist &delroutingmember &addroutingmember
77 &check_routing &updateClaim &removeMissingIssue
79 &old_newsubscription &old_modsubscription &old_getserials
82 =head2 GetSuppliersWithLateIssues
86 %supplierlist = &GetSuppliersWithLateIssues
88 this function get all suppliers with late issues.
91 the supplierlist into a hash. this hash containts id & name of the supplier
97 sub GetSuppliersWithLateIssues {
98 my $dbh = C4::Context->dbh;
100 SELECT DISTINCT id, name
102 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
103 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
104 WHERE subscription.subscriptionid = serial.subscriptionid
105 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
108 my $sth = $dbh->prepare($query);
111 while ( my ( $id, $name ) = $sth->fetchrow ) {
112 $supplierlist{$id} = $name;
114 if ( C4::Context->preference("RoutingSerials") ) {
115 $supplierlist{''} = "All Suppliers";
117 return %supplierlist;
124 @issuelist = &GetLateIssues($supplierid)
126 this function select late issues on database
129 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
130 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
137 my ($supplierid) = @_;
138 my $dbh = C4::Context->dbh;
142 SELECT name,title,planneddate,serialseq,serial.subscriptionid
144 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
145 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
146 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
147 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
148 AND subscription.aqbooksellerid=$supplierid
151 $sth = $dbh->prepare($query);
155 SELECT name,title,planneddate,serialseq,serial.subscriptionid
157 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
158 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
159 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
160 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
163 $sth = $dbh->prepare($query);
170 while ( my $line = $sth->fetchrow_hashref ) {
171 $odd++ unless $line->{title} eq $last_title;
172 $line->{title} = "" if $line->{title} eq $last_title;
173 $last_title = $line->{title} if ( $line->{title} );
174 $line->{planneddate} = format_date( $line->{planneddate} );
176 push @issuelist, $line;
178 return $count, @issuelist;
181 =head2 GetSubscriptionHistoryFromSubscriptionId
185 $sth = GetSubscriptionHistoryFromSubscriptionId()
186 this function just prepare the SQL request.
187 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
189 $sth = $dbh->prepare($query).
195 sub GetSubscriptionHistoryFromSubscriptionId() {
196 my $dbh = C4::Context->dbh;
199 FROM subscriptionhistory
200 WHERE subscriptionid = ?
202 return $dbh->prepare($query);
205 =head2 GetSerialStatusFromSerialId
209 $sth = GetSerialStatusFromSerialId();
210 this function just prepare the SQL request.
211 After this function, don't forget to execute it by using $sth->execute($serialid)
213 $sth = $dbh->prepare($query).
219 sub GetSerialStatusFromSerialId() {
220 my $dbh = C4::Context->dbh;
226 return $dbh->prepare($query);
229 =head2 GetSerialInformation
233 $data = GetSerialInformation($serialid);
234 returns a hash containing :
235 items : items marcrecord (can be an array)
237 subscription table field
238 + information about subscription expiration
244 sub GetSerialInformation {
246 my $dbh = C4::Context->dbh;
248 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
249 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
252 my $rq = $dbh->prepare($query);
253 $rq->execute($serialid);
254 my $data = $rq->fetchrow_hashref;
256 if ( C4::Context->preference("serialsadditems") ) {
257 if ( $data->{'itemnumber'} ) {
258 my @itemnumbers = split /,/, $data->{'itemnumber'};
259 foreach my $itemnum (@itemnumbers) {
261 #It is ASSUMED that GetMarcItem ALWAYS WORK...
262 #Maybe GetMarcItem should return values on failure
263 # warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
265 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum );
266 $itemprocessed->{'itemnumber'} = $itemnum;
267 $itemprocessed->{'itemid'} = $itemnum;
268 $itemprocessed->{'serialid'} = $serialid;
269 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
270 push @{ $data->{'items'} }, $itemprocessed;
275 PrepareItemrecordDisplay( $data->{'biblionumber'} );
276 $itemprocessed->{'itemid'} = "N$serialid";
277 $itemprocessed->{'serialid'} = $serialid;
278 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
279 $itemprocessed->{'countitems'} = 0;
280 push @{ $data->{'items'} }, $itemprocessed;
283 $data->{ "status" . $data->{'serstatus'} } = 1;
284 $data->{'subscriptionexpired'} =
285 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
286 $data->{'abouttoexpire'} =
287 abouttoexpire( $data->{'subscriptionid'} );
291 =head2 GetSerialInformation
295 $data = AddItem2Serial($serialid,$itemnumber);
296 Adds an itemnumber to Serial record
302 my ( $serialid, $itemnumber ) = @_;
303 my $dbh = C4::Context->dbh;
305 UPDATE serial SET itemnumber=IF(itemnumber IS NULL, $itemnumber, CONCAT(itemnumber,",",$itemnumber))
308 my $rq = $dbh->prepare($query);
309 $rq->execute($serialid);
313 =head2 UpdateClaimdateIssues
317 UpdateClaimdateIssues($serialids,[$date]);
319 Update Claimdate for issues in @$serialids list with date $date
325 sub UpdateClaimdateIssues {
326 my ( $serialids, $date ) = @_;
327 my $dbh = C4::Context->dbh;
328 $date = strftime("%Y-%m-%d",localtime) unless ($date);
330 UPDATE serial SET claimdate=$date,status=7
331 WHERE serialid in ".join (",",@$serialids);
333 my $rq = $dbh->prepare($query);
338 =head2 GetSubscription
342 $subs = GetSubscription($subscriptionid)
343 this function get the subscription which has $subscriptionid as id.
345 a hashref. This hash containts
346 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
352 sub GetSubscription {
353 my ($subscriptionid) = @_;
354 my $dbh = C4::Context->dbh;
356 SELECT subscription.*,
357 subscriptionhistory.*,
359 aqbooksellers.name AS aqbooksellername,
360 biblio.title AS bibliotitle,
361 subscription.biblionumber as bibnum
363 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
364 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
365 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
366 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
367 WHERE subscription.subscriptionid = ?
369 # if (C4::Context->preference('IndependantBranches') &&
370 # C4::Context->userenv &&
371 # C4::Context->userenv->{'flags'} != 1){
372 # # warn "flags: ".C4::Context->userenv->{'flags'};
373 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
375 # warn "query : $query";
376 my $sth = $dbh->prepare($query);
377 # warn "subsid :$subscriptionid";
378 $sth->execute($subscriptionid);
379 my $subs = $sth->fetchrow_hashref;
383 =head2 GetFullSubscription
387 \@res = GetFullSubscription($subscriptionid)
388 this function read on serial table.
394 sub GetFullSubscription {
395 my ($subscriptionid) = @_;
396 my $dbh = C4::Context->dbh;
398 SELECT serial.serialid,
401 serial.publisheddate,
403 serial.notes as notes,
404 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
405 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
406 biblio.title as bibliotitle,
407 subscription.branchcode AS branchcode,
408 subscription.subscriptionid AS subscriptionid
410 LEFT JOIN subscription ON
411 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
412 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
413 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
414 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
415 WHERE serial.subscriptionid = ? |;
416 if (C4::Context->preference('IndependantBranches') &&
417 C4::Context->userenv &&
418 C4::Context->userenv->{'flags'} != 1){
420 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
424 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
425 serial.subscriptionid
427 my $sth = $dbh->prepare($query);
428 $sth->execute($subscriptionid);
429 my $subs = $sth->fetchall_arrayref({});
434 =head2 PrepareSerialsData
438 \@res = PrepareSerialsData($serialinfomation)
439 where serialinformation is a hashref array
445 sub PrepareSerialsData{
451 my $aqbooksellername;
455 my $previousnote = "";
457 foreach my $subs ( @$lines ) {
458 $subs->{'publisheddate'} =
459 ( $subs->{'publisheddate'}
460 ? format_date( $subs->{'publisheddate'} )
462 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
463 $subs->{ "status" . $subs->{'status'} } = 1;
465 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
466 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
467 $year = $subs->{'year'};
472 if ( $tmpresults{$year} ) {
473 push @{ $tmpresults{$year}->{'serials'} }, $subs;
476 $tmpresults{$year} = {
479 # 'startdate'=>format_date($subs->{'startdate'}),
480 'aqbooksellername' => $subs->{'aqbooksellername'},
481 'bibliotitle' => $subs->{'bibliotitle'},
482 'serials' => [$subs],
484 'branchcode' => $subs->{'branchcode'},
485 'subscriptionid' => $subs->{'subscriptionid'},
489 # $previousnote=$subs->{notes};
491 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
492 push @res, $tmpresults{$key};
494 $res[0]->{'first'}=1;
498 =head2 GetSubscriptionsFromBiblionumber
500 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
501 this function get the subscription list. it reads on subscription table.
503 table of subscription which has the biblionumber given on input arg.
504 each line of this table is a hashref. All hashes containt
505 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
509 sub GetSubscriptionsFromBiblionumber {
510 my ($biblionumber) = @_;
511 my $dbh = C4::Context->dbh;
513 SELECT subscription.*,
515 subscriptionhistory.*,
517 aqbooksellers.name AS aqbooksellername,
518 biblio.title AS bibliotitle
520 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
521 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
522 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
523 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
524 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
525 WHERE subscription.biblionumber = ?
527 if (C4::Context->preference('IndependantBranches') &&
528 C4::Context->userenv &&
529 C4::Context->userenv->{'flags'} != 1){
530 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
532 my $sth = $dbh->prepare($query);
533 $sth->execute($biblionumber);
535 while ( my $subs = $sth->fetchrow_hashref ) {
536 $subs->{startdate} = format_date( $subs->{startdate} );
537 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
538 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
539 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
540 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
541 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
542 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
543 $subs->{ "status" . $subs->{'status'} } = 1;
544 if ( $subs->{enddate} eq '0000-00-00' ) {
545 $subs->{enddate} = '';
548 $subs->{enddate} = format_date( $subs->{enddate} );
550 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
551 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
557 =head2 GetFullSubscriptionsFromBiblionumber
561 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
562 this function read on serial table.
568 sub GetFullSubscriptionsFromBiblionumber {
569 my ($biblionumber) = @_;
570 my $dbh = C4::Context->dbh;
572 SELECT serial.serialid,
575 serial.publisheddate,
577 serial.notes as notes,
578 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
579 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
580 biblio.title as bibliotitle,
581 subscription.branchcode AS branchcode,
582 subscription.subscriptionid AS subscriptionid
584 LEFT JOIN subscription ON
585 (serial.subscriptionid=subscription.subscriptionid AND subscription.biblionumber=serial.biblionumber)
586 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
587 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
588 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
589 WHERE subscription.biblionumber = ? |;
590 if (C4::Context->preference('IndependantBranches') &&
591 C4::Context->userenv &&
592 C4::Context->userenv->{'flags'} != 1){
594 AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
598 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
599 serial.subscriptionid
601 my $sth = $dbh->prepare($query);
602 $sth->execute($biblionumber);
603 my $subs= $sth->fetchall_arrayref({});
607 =head2 GetSubscriptions
611 @results = GetSubscriptions($title,$ISSN,$biblionumber);
612 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
614 a table of hashref. Each hash containt the subscription.
620 sub GetSubscriptions {
621 my ( $title, $ISSN, $biblionumber ) = @_;
622 #return unless $title or $ISSN or $biblionumber;
623 my $dbh = C4::Context->dbh;
627 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
629 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
630 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
631 WHERE biblio.biblionumber=?
633 if (C4::Context->preference('IndependantBranches') &&
634 C4::Context->userenv &&
635 C4::Context->userenv->{'flags'} != 1){
636 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
638 $query.=" ORDER BY title";
639 # warn "query :$query";
640 $sth = $dbh->prepare($query);
641 $sth->execute($biblionumber);
644 if ( $ISSN and $title ) {
646 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
648 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
649 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
650 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
652 if (C4::Context->preference('IndependantBranches') &&
653 C4::Context->userenv &&
654 C4::Context->userenv->{'flags'} != 1){
655 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
657 $query.=" ORDER BY title";
658 $sth = $dbh->prepare($query);
659 $sth->execute( $ISSN );
664 SELECT subscription.*,biblio.title,biblioitems.issn,,biblio.biblionumber
666 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
667 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
668 WHERE biblioitems.issn LIKE ?
670 if (C4::Context->preference('IndependantBranches') &&
671 C4::Context->userenv &&
672 C4::Context->userenv->{'flags'} != 1){
673 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
675 $query.=" ORDER BY title";
676 # warn "query :$query";
677 $sth = $dbh->prepare($query);
678 $sth->execute( "%" . $ISSN . "%" );
682 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
684 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
685 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
687 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
690 if (C4::Context->preference('IndependantBranches') &&
691 C4::Context->userenv &&
692 C4::Context->userenv->{'flags'} != 1){
693 $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"''\")";
695 $query.=" ORDER BY title";
696 $sth = $dbh->prepare($query);
702 my $previoustitle = "";
704 while ( my $line = $sth->fetchrow_hashref ) {
705 if ( $previoustitle eq $line->{title} ) {
708 $line->{toggle} = 1 if $odd == 1;
711 $previoustitle = $line->{title};
713 $line->{toggle} = 1 if $odd == 1;
715 push @results, $line;
724 ($totalissues,@serials) = GetSerials($subscriptionid);
725 this function get every serial not arrived for a given subscription
726 as well as the number of issues registered in the database (all types)
727 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
734 my ($subscriptionid,$count) = @_;
735 my $dbh = C4::Context->dbh;
737 # status = 2 is "arrived"
739 $count=5 unless ($count);
742 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes
744 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
745 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
746 my $sth = $dbh->prepare($query);
747 $sth->execute($subscriptionid);
748 while ( my $line = $sth->fetchrow_hashref ) {
749 $line->{ "status" . $line->{status} } =
750 1; # fills a "statusX" value, used for template status select list
751 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
752 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
753 push @serials, $line;
755 # OK, now add the last 5 issues arrives/missing
757 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes
759 WHERE subscriptionid = ?
760 AND (status in (2,4,5))
761 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
763 $sth = $dbh->prepare($query);
764 $sth->execute($subscriptionid);
765 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
767 $line->{ "status" . $line->{status} } =
768 1; # fills a "statusX" value, used for template status select list
769 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
770 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
771 push @serials, $line;
774 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
775 $sth = $dbh->prepare($query);
776 $sth->execute($subscriptionid);
777 my ($totalissues) = $sth->fetchrow;
778 return ( $totalissues, @serials );
785 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
786 this function get every serial waited for a given subscription
787 as well as the number of issues registered in the database (all types)
788 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
794 my ($subscription,$status) = @_;
795 my $dbh = C4::Context->dbh;
797 SELECT serialid,serialseq, status, planneddate, publisheddate,notes
799 WHERE subscriptionid=$subscription AND status IN ($status)
800 ORDER BY publisheddate,serialid DESC
803 my $sth=$dbh->prepare($query);
806 while(my $line = $sth->fetchrow_hashref) {
807 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
808 $line->{"planneddate"} = format_date($line->{"planneddate"});
809 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
812 my ($totalissues) = scalar(@serials);
813 return ($totalissues,@serials);
816 =head2 GetLatestSerials
820 \@serials = GetLatestSerials($subscriptionid,$limit)
821 get the $limit's latest serials arrived or missing for a given subscription
823 a ref to a table which it containts all of the latest serials stored into a hash.
829 sub GetLatestSerials {
830 my ( $subscriptionid, $limit ) = @_;
831 my $dbh = C4::Context->dbh;
833 # status = 2 is "arrived"
834 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
836 WHERE subscriptionid = ?
837 AND (status =2 or status=4)
838 ORDER BY planneddate DESC LIMIT 0,$limit
840 my $sth = $dbh->prepare($strsth);
841 $sth->execute($subscriptionid);
843 while ( my $line = $sth->fetchrow_hashref ) {
844 $line->{ "status" . $line->{status} } =
845 1; # fills a "statusX" value, used for template status select list
846 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
847 push @serials, $line;
853 # WHERE subscriptionid=?
855 # $sth=$dbh->prepare($query);
856 # $sth->execute($subscriptionid);
857 # my ($totalissues) = $sth->fetchrow;
861 =head2 GetDistributedTo
865 $distributedto=GetDistributedTo($subscriptionid)
866 This function select the old previous value of distributedto in the database.
872 sub GetDistributedTo {
873 my $dbh = C4::Context->dbh;
875 my $subscriptionid = @_;
876 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
877 my $sth = $dbh->prepare($query);
878 $sth->execute($subscriptionid);
879 return ($distributedto) = $sth->fetchrow;
887 $val is a hashref containing all the attributes of the table 'subscription'
888 This function get the next issue for the subscription given on input arg
890 all the input params updated.
898 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
899 # $calculated = $val->{numberingmethod};
900 # # calculate the (expected) value of the next issue recieved.
901 # $newlastvalue1 = $val->{lastvalue1};
902 # # check if we have to increase the new value.
903 # $newinnerloop1 = $val->{innerloop1}+1;
904 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
905 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
906 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
907 # $calculated =~ s/\{X\}/$newlastvalue1/g;
909 # $newlastvalue2 = $val->{lastvalue2};
910 # # check if we have to increase the new value.
911 # $newinnerloop2 = $val->{innerloop2}+1;
912 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
913 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
914 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
915 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
917 # $newlastvalue3 = $val->{lastvalue3};
918 # # check if we have to increase the new value.
919 # $newinnerloop3 = $val->{innerloop3}+1;
920 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
921 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
922 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
923 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
924 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
930 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
931 $newinnerloop1, $newinnerloop2, $newinnerloop3
933 my $pattern = $val->{numberpattern};
934 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
935 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
936 $calculated = $val->{numberingmethod};
937 $newlastvalue1 = $val->{lastvalue1};
938 $newlastvalue2 = $val->{lastvalue2};
939 $newlastvalue3 = $val->{lastvalue3};
941 $newlastvalue1 = $val->{lastvalue1};
942 # check if we have to increase the new value.
943 $newinnerloop1 = $val->{innerloop1}+1;
944 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
945 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
946 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
947 $calculated =~ s/\{X\}/$newlastvalue1/g;
949 $newlastvalue2 = $val->{lastvalue2};
950 # check if we have to increase the new value.
951 $newinnerloop2 = $val->{innerloop2}+1;
952 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
953 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
954 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
955 if ( $pattern == 6 ) {
956 if ( $val->{hemisphere} == 2 ) {
957 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
958 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
961 my $newlastvalue2seq = $seasons[$newlastvalue2];
962 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
966 $calculated =~ s/\{Y\}/$newlastvalue2/g;
970 $newlastvalue3 = $val->{lastvalue3};
971 # check if we have to increase the new value.
972 $newinnerloop3 = $val->{innerloop3}+1;
973 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
974 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
975 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
976 $calculated =~ s/\{Z\}/$newlastvalue3/g;
978 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
979 $newinnerloop1, $newinnerloop2, $newinnerloop3);
986 $calculated = GetSeq($val)
987 $val is a hashref containing all the attributes of the table 'subscription'
988 this function transforms {X},{Y},{Z} to 150,0,0 for example.
990 the sequence in integer format
998 my $pattern = $val->{numberpattern};
999 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
1000 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
1001 my $calculated = $val->{numberingmethod};
1002 my $x = $val->{'lastvalue1'};
1003 $calculated =~ s/\{X\}/$x/g;
1004 my $newlastvalue2 = $val->{'lastvalue2'};
1005 if ( $pattern == 6 ) {
1006 if ( $val->{hemisphere} == 2 ) {
1007 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1008 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1011 my $newlastvalue2seq = $seasons[$newlastvalue2];
1012 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1016 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1018 my $z = $val->{'lastvalue3'};
1019 $calculated =~ s/\{Z\}/$z/g;
1023 =head2 GetExpirationDate
1025 $sensddate = GetExpirationDate($subscriptionid)
1027 this function return the expiration date for a subscription given on input args.
1034 sub GetExpirationDate {
1035 my ($subscriptionid) = @_;
1036 my $dbh = C4::Context->dbh;
1037 my $subscription = GetSubscription($subscriptionid);
1038 my $enddate = $subscription->{startdate};
1040 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1041 if ($subscription->{periodicity}){
1042 if ( $subscription->{numberlength} ) {
1043 #calculate the date of the last issue.
1044 my $length = $subscription->{numberlength};
1045 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1046 $enddate = GetNextDate( $enddate, $subscription );
1049 elsif ( $subscription->{monthlength} ){
1050 my @date=split (/-/,$subscription->{startdate});
1051 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1052 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1053 } elsif ( $subscription->{weeklength} ){
1054 my @date=split (/-/,$subscription->{startdate});
1055 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1056 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1064 =head2 CountSubscriptionFromBiblionumber
1068 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1069 this count the number of subscription for a biblionumber given.
1071 the number of subscriptions with biblionumber given on input arg.
1077 sub CountSubscriptionFromBiblionumber {
1078 my ($biblionumber) = @_;
1079 my $dbh = C4::Context->dbh;
1080 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1081 my $sth = $dbh->prepare($query);
1082 $sth->execute($biblionumber);
1083 my $subscriptionsnumber = $sth->fetchrow;
1084 return $subscriptionsnumber;
1087 =head2 ModSubscriptionHistory
1091 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1093 this function modify the history of a subscription. Put your new values on input arg.
1099 sub ModSubscriptionHistory {
1101 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1102 $missinglist, $opacnote, $librariannote
1104 my $dbh = C4::Context->dbh;
1105 my $query = "UPDATE subscriptionhistory
1106 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1107 WHERE subscriptionid=?
1109 my $sth = $dbh->prepare($query);
1110 $recievedlist =~ s/^,//g;
1111 $missinglist =~ s/^,//g;
1112 $opacnote =~ s/^,//g;
1114 $histstartdate, $enddate, $recievedlist, $missinglist,
1115 $opacnote, $librariannote, $subscriptionid
1120 =head2 ModSerialStatus
1124 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1126 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1127 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1133 sub ModSerialStatus {
1134 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1137 #It is a usual serial
1138 # 1st, get previous status :
1139 my $dbh = C4::Context->dbh;
1140 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1141 my $sth = $dbh->prepare($query);
1142 $sth->execute($serialid);
1143 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1145 # change status & update subscriptionhistory
1147 if ( $status eq 6 ) {
1148 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1152 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1153 $sth = $dbh->prepare($query);
1154 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1155 $notes, $serialid );
1156 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1157 $sth = $dbh->prepare($query);
1158 $sth->execute($subscriptionid);
1159 my $val = $sth->fetchrow_hashref;
1160 unless ( $val->{manualhistory} ) {
1162 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1163 $sth = $dbh->prepare($query);
1164 $sth->execute($subscriptionid);
1165 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1166 if ( $status eq 2 ) {
1168 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1169 $recievedlist .= ",$serialseq"
1170 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1173 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1174 $missinglist .= ",$serialseq"
1176 and not index( "$missinglist", "$serialseq" ) >= 0 );
1177 $missinglist .= ",not issued $serialseq"
1179 and index( "$missinglist", "$serialseq" ) >= 0 );
1181 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1182 $sth = $dbh->prepare($query);
1183 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1187 # create new waited entry if needed (ie : was a "waited" and has changed)
1188 if ( $oldstatus eq 1 && $status ne 1 ) {
1189 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1190 $sth = $dbh->prepare($query);
1191 $sth->execute($subscriptionid);
1192 my $val = $sth->fetchrow_hashref;
1197 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1198 $newinnerloop1, $newinnerloop2, $newinnerloop3
1199 ) = GetNextSeq($val);
1200 # warn "Next Seq End";
1202 # next date (calculated from actual date & frequency parameters)
1203 # warn "publisheddate :$publisheddate ";
1204 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1205 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1206 1, $nextpublisheddate, $nextpublisheddate );
1208 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1209 WHERE subscriptionid = ?";
1210 $sth = $dbh->prepare($query);
1212 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1213 $newinnerloop2, $newinnerloop3, $subscriptionid
1216 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1217 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1218 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1223 =head2 ModSubscription
1227 this function modify a subscription. Put all new values on input args.
1233 sub ModSubscription {
1235 $auser, $branchcode, $aqbooksellerid, $cost,
1236 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1237 $dow, $irregularity, $numberpattern, $numberlength,
1238 $weeklength, $monthlength, $add1, $every1,
1239 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1240 $add2, $every2, $whenmorethan2, $setto2,
1241 $lastvalue2, $innerloop2, $add3, $every3,
1242 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1243 $numberingmethod, $status, $biblionumber, $callnumber,
1244 $notes, $letter, $hemisphere, $manualhistory,
1248 # warn $irregularity;
1249 my $dbh = C4::Context->dbh;
1250 my $query = "UPDATE subscription
1251 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1252 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1253 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1254 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1255 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1256 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1257 WHERE subscriptionid = ?";
1258 # warn "query :".$query;
1259 my $sth = $dbh->prepare($query);
1261 $auser, $branchcode, $aqbooksellerid, $cost,
1262 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1263 $dow, "$irregularity", $numberpattern, $numberlength,
1264 $weeklength, $monthlength, $add1, $every1,
1265 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1266 $add2, $every2, $whenmorethan2, $setto2,
1267 $lastvalue2, $innerloop2, $add3, $every3,
1268 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1269 $numberingmethod, $status, $biblionumber, $callnumber,
1270 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1274 my $rows=$sth->rows;
1277 &logaction(C4::Context->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1278 if C4::Context->preference("SubscriptionLog");
1282 =head2 NewSubscription
1286 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1287 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1288 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1289 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1290 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1291 $numberingmethod, $status, $notes)
1293 Create a new subscription with value given on input args.
1296 the id of this new subscription
1302 sub NewSubscription {
1304 $auser, $branchcode, $aqbooksellerid, $cost,
1305 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1306 $dow, $numberlength, $weeklength, $monthlength,
1307 $add1, $every1, $whenmorethan1, $setto1,
1308 $lastvalue1, $innerloop1, $add2, $every2,
1309 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1310 $add3, $every3, $whenmorethan3, $setto3,
1311 $lastvalue3, $innerloop3, $numberingmethod, $status,
1312 $notes, $letter, $firstacquidate, $irregularity,
1313 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1316 my $dbh = C4::Context->dbh;
1318 #save subscription (insert into database)
1320 INSERT INTO subscription
1321 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1322 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1323 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1324 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1325 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1326 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1327 numberpattern, callnumber, hemisphere,manualhistory,internalnotes)
1328 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1330 my $sth = $dbh->prepare($query);
1332 $auser, $branchcode,
1333 $aqbooksellerid, $cost,
1334 $aqbudgetid, $biblionumber,
1335 format_date_in_iso($startdate), $periodicity,
1336 $dow, $numberlength,
1337 $weeklength, $monthlength,
1339 $whenmorethan1, $setto1,
1340 $lastvalue1, $innerloop1,
1342 $whenmorethan2, $setto2,
1343 $lastvalue2, $innerloop2,
1345 $whenmorethan3, $setto3,
1346 $lastvalue3, $innerloop3,
1347 $numberingmethod, "$status",
1349 $firstacquidate, $irregularity,
1350 $numberpattern, $callnumber,
1351 $hemisphere, $manualhistory,
1355 #then create the 1st waited number
1356 my $subscriptionid = $dbh->{'mysql_insertid'};
1358 INSERT INTO subscriptionhistory
1359 (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote)
1360 VALUES (?,?,?,?,?,?,?,?)
1362 $sth = $dbh->prepare($query);
1363 $sth->execute( $biblionumber, $subscriptionid,
1364 format_date_in_iso($startdate),
1365 0, "", "", "", "$notes" );
1367 # reread subscription to get a hash (for calculation of the 1st issue number)
1371 WHERE subscriptionid = ?
1373 $sth = $dbh->prepare($query);
1374 $sth->execute($subscriptionid);
1375 my $val = $sth->fetchrow_hashref;
1377 # calculate issue number
1378 my $serialseq = GetSeq($val);
1381 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1382 VALUES (?,?,?,?,?,?)
1384 $sth = $dbh->prepare($query);
1386 "$serialseq", $subscriptionid, $biblionumber, 1,
1387 format_date_in_iso($startdate),
1388 format_date_in_iso($startdate)
1391 &logaction(C4::Context->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1392 if C4::Context->preference("SubscriptionLog");
1394 return $subscriptionid;
1397 =head2 ReNewSubscription
1401 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1403 this function renew a subscription with values given on input args.
1409 sub ReNewSubscription {
1410 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1411 $monthlength, $note )
1413 my $dbh = C4::Context->dbh;
1414 my $subscription = GetSubscription($subscriptionid);
1418 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1419 WHERE biblio.biblionumber=?
1421 my $sth = $dbh->prepare($query);
1422 $sth->execute( $subscription->{biblionumber} );
1423 my $biblio = $sth->fetchrow_hashref;
1425 $user, $subscription->{bibliotitle},
1426 $biblio->{author}, $biblio->{publishercode},
1427 $biblio->{note}, '',
1430 $subscription->{biblionumber}
1433 # renew subscription
1436 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1437 WHERE subscriptionid=?
1439 my $sth = $dbh->prepare($query);
1440 $sth->execute( format_date_in_iso($startdate),
1441 $numberlength, $weeklength, $monthlength, $subscriptionid );
1443 &logaction(C4::Context->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1444 if C4::Context->preference("SubscriptionLog");
1451 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1453 Create a new issue stored on the database.
1454 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1461 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1462 $planneddate, $publisheddate, $notes )
1464 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1466 my $dbh = C4::Context->dbh;
1469 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1470 VALUES (?,?,?,?,?,?,?)
1472 my $sth = $dbh->prepare($query);
1473 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1474 $publisheddate, $planneddate,$notes );
1475 my $serialid=$dbh->{'mysql_insertid'};
1477 SELECT missinglist,recievedlist
1478 FROM subscriptionhistory
1479 WHERE subscriptionid=?
1481 $sth = $dbh->prepare($query);
1482 $sth->execute($subscriptionid);
1483 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1485 if ( $status eq 2 ) {
1486 ### TODO Add a feature that improves recognition and description.
1487 ### As such count (serialseq) i.e. : N18,2(N19),N20
1488 ### Would use substr and index But be careful to previous presence of ()
1489 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1491 if ( $status eq 4 ) {
1492 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1495 UPDATE subscriptionhistory
1496 SET recievedlist=?, missinglist=?
1497 WHERE subscriptionid=?
1499 $sth = $dbh->prepare($query);
1500 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1504 =head2 ItemizeSerials
1508 ItemizeSerials($serialid, $info);
1509 $info is a hashref containing barcode branch, itemcallnumber, status, location
1510 $serialid the serialid
1512 1 if the itemize is a succes.
1513 0 and @error else. @error containts the list of errors found.
1519 sub ItemizeSerials {
1520 my ( $serialid, $info ) = @_;
1521 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1523 my $dbh = C4::Context->dbh;
1529 my $sth = $dbh->prepare($query);
1530 $sth->execute($serialid);
1531 my $data = $sth->fetchrow_hashref;
1532 if ( C4::Context->preference("RoutingSerials") ) {
1534 # check for existing biblioitem relating to serial issue
1535 my ( $count, @results ) =
1536 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1538 for ( my $i = 0 ; $i < $count ; $i++ ) {
1539 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1540 . $data->{'planneddate'}
1543 $bibitemno = $results[$i]->{'biblioitemnumber'};
1547 if ( $bibitemno == 0 ) {
1549 # warn "need to add new biblioitem so copy last one and make minor changes";
1552 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1554 $sth->execute( $data->{'biblionumber'} );
1555 my $biblioitem = $sth->fetchrow_hashref;
1556 $biblioitem->{'volumedate'} =
1557 format_date_in_iso( $data->{planneddate} );
1558 $biblioitem->{'volumeddesc'} =
1559 $data->{serialseq} . ' ('
1560 . format_date( $data->{'planneddate'} ) . ')';
1561 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1563 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1564 # so I comment it, we can speak of it when you want
1565 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1566 # if ( $info->{barcode} )
1567 # { # only make biblioitem if we are going to make item also
1568 # $bibitemno = newbiblioitem($biblioitem);
1573 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1574 if ( $info->{barcode} ) {
1576 my $exists = itemdata( $info->{'barcode'} );
1577 push @errors, "barcode_not_unique" if ($exists);
1579 my $marcrecord = MARC::Record->new();
1580 my ( $tag, $subfield ) =
1581 GetMarcFromKohaField( "items.barcode", $fwk );
1583 MARC::Field->new( "$tag", '', '',
1584 "$subfield" => $info->{barcode} );
1585 $marcrecord->insert_fields_ordered($newField);
1586 if ( $info->{branch} ) {
1587 my ( $tag, $subfield ) =
1588 GetMarcFromKohaField( "items.homebranch",
1591 #warn "items.homebranch : $tag , $subfield";
1592 if ( $marcrecord->field($tag) ) {
1593 $marcrecord->field($tag)
1594 ->add_subfields( "$subfield" => $info->{branch} );
1598 MARC::Field->new( "$tag", '', '',
1599 "$subfield" => $info->{branch} );
1600 $marcrecord->insert_fields_ordered($newField);
1602 ( $tag, $subfield ) =
1603 GetMarcFromKohaField( "items.holdingbranch",
1606 #warn "items.holdingbranch : $tag , $subfield";
1607 if ( $marcrecord->field($tag) ) {
1608 $marcrecord->field($tag)
1609 ->add_subfields( "$subfield" => $info->{branch} );
1613 MARC::Field->new( "$tag", '', '',
1614 "$subfield" => $info->{branch} );
1615 $marcrecord->insert_fields_ordered($newField);
1618 if ( $info->{itemcallnumber} ) {
1619 my ( $tag, $subfield ) =
1620 GetMarcFromKohaField( "items.itemcallnumber",
1623 #warn "items.itemcallnumber : $tag , $subfield";
1624 if ( $marcrecord->field($tag) ) {
1625 $marcrecord->field($tag)
1626 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1630 MARC::Field->new( "$tag", '', '',
1631 "$subfield" => $info->{itemcallnumber} );
1632 $marcrecord->insert_fields_ordered($newField);
1635 if ( $info->{notes} ) {
1636 my ( $tag, $subfield ) =
1637 GetMarcFromKohaField( "items.itemnotes", $fwk );
1639 # warn "items.itemnotes : $tag , $subfield";
1640 if ( $marcrecord->field($tag) ) {
1641 $marcrecord->field($tag)
1642 ->add_subfields( "$subfield" => $info->{notes} );
1646 MARC::Field->new( "$tag", '', '',
1647 "$subfield" => $info->{notes} );
1648 $marcrecord->insert_fields_ordered($newField);
1651 if ( $info->{location} ) {
1652 my ( $tag, $subfield ) =
1653 GetMarcFromKohaField( "items.location", $fwk );
1655 # warn "items.location : $tag , $subfield";
1656 if ( $marcrecord->field($tag) ) {
1657 $marcrecord->field($tag)
1658 ->add_subfields( "$subfield" => $info->{location} );
1662 MARC::Field->new( "$tag", '', '',
1663 "$subfield" => $info->{location} );
1664 $marcrecord->insert_fields_ordered($newField);
1667 if ( $info->{status} ) {
1668 my ( $tag, $subfield ) =
1669 GetMarcFromKohaField( "items.notforloan",
1672 # warn "items.notforloan : $tag , $subfield";
1673 if ( $marcrecord->field($tag) ) {
1674 $marcrecord->field($tag)
1675 ->add_subfields( "$subfield" => $info->{status} );
1679 MARC::Field->new( "$tag", '', '',
1680 "$subfield" => $info->{status} );
1681 $marcrecord->insert_fields_ordered($newField);
1684 if ( C4::Context->preference("RoutingSerials") ) {
1685 my ( $tag, $subfield ) =
1686 GetMarcFromKohaField( "items.dateaccessioned",
1688 if ( $marcrecord->field($tag) ) {
1689 $marcrecord->field($tag)
1690 ->add_subfields( "$subfield" => $now );
1694 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1695 $marcrecord->insert_fields_ordered($newField);
1698 AddItem( $marcrecord, $data->{'biblionumber'} );
1701 return ( 0, @errors );
1705 =head2 HasSubscriptionExpired
1709 1 or 0 = HasSubscriptionExpired($subscriptionid)
1711 the subscription has expired when the next issue to arrive is out of subscription limit.
1714 1 if true, 0 if false.
1720 sub HasSubscriptionExpired {
1721 my ($subscriptionid) = @_;
1722 my $dbh = C4::Context->dbh;
1723 my $subscription = GetSubscription($subscriptionid);
1724 if ($subscription->{periodicity}>0){
1725 my $expirationdate = GetExpirationDate($subscriptionid);
1727 SELECT max(planneddate)
1729 WHERE subscriptionid=?
1731 my $sth = $dbh->prepare($query);
1732 $sth->execute($subscriptionid);
1733 my ($res) = $sth->fetchrow ;
1734 my @res=split (/-/,$res);
1735 # warn "date expiration :$expirationdate";
1736 my @endofsubscriptiondate=split(/-/,$expirationdate);
1737 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1738 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1742 if ($subscription->{'numberlength'}){
1743 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1744 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1753 =head2 SetDistributedto
1757 SetDistributedto($distributedto,$subscriptionid);
1758 This function update the value of distributedto for a subscription given on input arg.
1764 sub SetDistributedto {
1765 my ( $distributedto, $subscriptionid ) = @_;
1766 my $dbh = C4::Context->dbh;
1770 WHERE subscriptionid=?
1772 my $sth = $dbh->prepare($query);
1773 $sth->execute( $distributedto, $subscriptionid );
1776 =head2 DelSubscription
1780 DelSubscription($subscriptionid)
1781 this function delete the subscription which has $subscriptionid as id.
1787 sub DelSubscription {
1788 my ($subscriptionid) = @_;
1789 my $dbh = C4::Context->dbh;
1790 $subscriptionid = $dbh->quote($subscriptionid);
1791 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1793 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1794 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1796 &logaction(C4::Context->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1797 if C4::Context->preference("SubscriptionLog");
1804 DelIssue($serialseq,$subscriptionid)
1805 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1812 my ( $dataissue) = @_;
1813 my $dbh = C4::Context->dbh;
1814 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1819 AND subscriptionid= ?
1821 my $mainsth = $dbh->prepare($query);
1822 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1824 #Delete element from subscription history
1825 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1826 my $sth = $dbh->prepare($query);
1827 $sth->execute($dataissue->{'subscriptionid'});
1828 my $val = $sth->fetchrow_hashref;
1829 unless ( $val->{manualhistory} ) {
1831 SELECT * FROM subscriptionhistory
1832 WHERE subscriptionid= ?
1834 my $sth = $dbh->prepare($query);
1835 $sth->execute($dataissue->{'subscriptionid'});
1836 my $data = $sth->fetchrow_hashref;
1837 my $serialseq= $dataissue->{'serialseq'};
1838 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1839 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1840 my $strsth = "UPDATE subscriptionhistory SET "
1842 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1843 . " WHERE subscriptionid=?";
1844 $sth = $dbh->prepare($strsth);
1845 $sth->execute($dataissue->{'subscriptionid'});
1848 return $mainsth->rows;
1851 =head2 GetLateOrMissingIssues
1855 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1857 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1860 a count of the number of missing issues
1861 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1862 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1868 sub GetLateOrMissingIssues {
1869 my ( $supplierid, $serialid,$order ) = @_;
1870 my $dbh = C4::Context->dbh;
1874 $byserial = "and serialid = " . $serialid;
1882 $sth = $dbh->prepare(
1891 serial.subscriptionid,
1894 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1895 LEFT JOIN biblio ON serial.biblionumber=biblio.biblionumber
1896 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1897 WHERE subscription.subscriptionid = serial.subscriptionid
1898 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1899 AND subscription.aqbooksellerid=$supplierid
1905 $sth = $dbh->prepare(
1914 serial.subscriptionid,
1917 LEFT JOIN subscription
1918 ON serial.subscriptionid=subscription.subscriptionid
1920 ON serial.biblionumber=biblio.biblionumber
1921 LEFT JOIN aqbooksellers
1922 ON subscription.aqbooksellerid = aqbooksellers.id
1924 subscription.subscriptionid = serial.subscriptionid
1925 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1926 AND biblio.biblionumber = subscription.biblionumber
1936 while ( my $line = $sth->fetchrow_hashref ) {
1937 $odd++ unless $line->{title} eq $last_title;
1938 $last_title = $line->{title} if ( $line->{title} );
1939 $line->{planneddate} = format_date( $line->{planneddate} );
1940 $line->{claimdate} = format_date( $line->{claimdate} );
1941 $line->{"status".$line->{status}} = 1;
1942 $line->{'odd'} = 1 if $odd % 2;
1944 push @issuelist, $line;
1946 return $count, @issuelist;
1949 =head2 removeMissingIssue
1953 removeMissingIssue($subscriptionid)
1955 this function removes an issue from being part of the missing string in
1956 subscriptionlist.missinglist column
1958 called when a missing issue is found from the serials-recieve.pl file
1964 sub removeMissingIssue {
1965 my ( $sequence, $subscriptionid ) = @_;
1966 my $dbh = C4::Context->dbh;
1969 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1970 $sth->execute($subscriptionid);
1971 my $data = $sth->fetchrow_hashref;
1972 my $missinglist = $data->{'missinglist'};
1973 my $missinglistbefore = $missinglist;
1975 # warn $missinglist." before";
1976 $missinglist =~ s/($sequence)//;
1978 # warn $missinglist." after";
1979 if ( $missinglist ne $missinglistbefore ) {
1980 $missinglist =~ s/\|\s\|/\|/g;
1981 $missinglist =~ s/^\| //g;
1982 $missinglist =~ s/\|$//g;
1983 my $sth2 = $dbh->prepare(
1984 "UPDATE subscriptionhistory
1986 WHERE subscriptionid = ?"
1988 $sth2->execute( $missinglist, $subscriptionid );
1996 &updateClaim($serialid)
1998 this function updates the time when a claim is issued for late/missing items
2000 called from claims.pl file
2007 my ($serialid) = @_;
2008 my $dbh = C4::Context->dbh;
2009 my $sth = $dbh->prepare(
2010 "UPDATE serial SET claimdate = now()
2014 $sth->execute($serialid);
2017 =head2 getsupplierbyserialid
2021 ($result) = &getsupplierbyserialid($serialid)
2023 this function is used to find the supplier id given a serial id
2026 hashref containing serialid, subscriptionid, and aqbooksellerid
2032 sub getsupplierbyserialid {
2033 my ($serialid) = @_;
2034 my $dbh = C4::Context->dbh;
2035 my $sth = $dbh->prepare(
2036 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2038 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2042 $sth->execute($serialid);
2043 my $line = $sth->fetchrow_hashref;
2044 my $result = $line->{'aqbooksellerid'};
2048 =head2 check_routing
2052 ($result) = &check_routing($subscriptionid)
2054 this function checks to see if a serial has a routing list and returns the count of routingid
2055 used to show either an 'add' or 'edit' link
2061 my ($subscriptionid) = @_;
2062 my $dbh = C4::Context->dbh;
2063 my $sth = $dbh->prepare(
2064 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2065 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2066 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2069 $sth->execute($subscriptionid);
2070 my $line = $sth->fetchrow_hashref;
2071 my $result = $line->{'routingids'};
2075 =head2 addroutingmember
2079 &addroutingmember($borrowernumber,$subscriptionid)
2081 this function takes a borrowernumber and subscriptionid and add the member to the
2082 routing list for that serial subscription and gives them a rank on the list
2083 of either 1 or highest current rank + 1
2089 sub addroutingmember {
2090 my ( $borrowernumber, $subscriptionid ) = @_;
2092 my $dbh = C4::Context->dbh;
2095 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2097 $sth->execute($subscriptionid);
2098 while ( my $line = $sth->fetchrow_hashref ) {
2099 if ( $line->{'rank'} > 0 ) {
2100 $rank = $line->{'rank'} + 1;
2108 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2110 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2113 =head2 reorder_members
2117 &reorder_members($subscriptionid,$routingid,$rank)
2119 this function is used to reorder the routing list
2121 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2122 - it gets all members on list puts their routingid's into an array
2123 - removes the one in the array that is $routingid
2124 - then reinjects $routingid at point indicated by $rank
2125 - then update the database with the routingids in the new order
2131 sub reorder_members {
2132 my ( $subscriptionid, $routingid, $rank ) = @_;
2133 my $dbh = C4::Context->dbh;
2136 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2138 $sth->execute($subscriptionid);
2140 while ( my $line = $sth->fetchrow_hashref ) {
2141 push( @result, $line->{'routingid'} );
2144 # To find the matching index
2146 my $key = -1; # to allow for 0 being a valid response
2147 for ( $i = 0 ; $i < @result ; $i++ ) {
2148 if ( $routingid == $result[$i] ) {
2149 $key = $i; # save the index
2154 # if index exists in array then move it to new position
2155 if ( $key > -1 && $rank > 0 ) {
2156 my $new_rank = $rank -
2157 1; # $new_rank is what you want the new index to be in the array
2158 my $moving_item = splice( @result, $key, 1 );
2159 splice( @result, $new_rank, 0, $moving_item );
2161 for ( my $j = 0 ; $j < @result ; $j++ ) {
2163 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2165 . "' WHERE routingid = '"
2172 =head2 delroutingmember
2176 &delroutingmember($routingid,$subscriptionid)
2178 this function either deletes one member from routing list if $routingid exists otherwise
2179 deletes all members from the routing list
2185 sub delroutingmember {
2187 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2188 my ( $routingid, $subscriptionid ) = @_;
2189 my $dbh = C4::Context->dbh;
2193 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2194 $sth->execute($routingid);
2195 reorder_members( $subscriptionid, $routingid );
2200 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2201 $sth->execute($subscriptionid);
2205 =head2 getroutinglist
2209 ($count,@routinglist) = &getroutinglist($subscriptionid)
2211 this gets the info from the subscriptionroutinglist for $subscriptionid
2214 a count of the number of members on routinglist
2215 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2216 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2222 sub getroutinglist {
2223 my ($subscriptionid) = @_;
2224 my $dbh = C4::Context->dbh;
2225 my $sth = $dbh->prepare(
2226 "SELECT routingid, borrowernumber,
2227 ranking, biblionumber
2229 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2230 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2233 $sth->execute($subscriptionid);
2236 while ( my $line = $sth->fetchrow_hashref ) {
2238 push( @routinglist, $line );
2240 return ( $count, @routinglist );
2243 =head2 countissuesfrom
2247 $result = &countissuesfrom($subscriptionid,$startdate)
2254 sub countissuesfrom {
2255 my ($subscriptionid,$startdate) = @_;
2256 my $dbh = C4::Context->dbh;
2260 WHERE subscriptionid=?
2261 AND serial.publisheddate>?
2263 my $sth=$dbh->prepare($query);
2264 $sth->execute($subscriptionid, $startdate);
2265 my ($countreceived)=$sth->fetchrow;
2266 return $countreceived;
2269 =head2 abouttoexpire
2273 $result = &abouttoexpire($subscriptionid)
2275 this function alerts you to the penultimate issue for a serial subscription
2277 returns 1 - if this is the penultimate issue
2285 my ($subscriptionid) = @_;
2286 my $dbh = C4::Context->dbh;
2287 my $subscription = GetSubscription($subscriptionid);
2288 my $per = $subscription->{'periodicity'};
2290 my $expirationdate = GetExpirationDate($subscriptionid);
2293 "select max(planneddate) from serial where subscriptionid=?");
2294 $sth->execute($subscriptionid);
2295 my ($res) = $sth->fetchrow ;
2296 # warn "date expiration : ".$expirationdate." date courante ".$res;
2297 my @res=split /-/,$res;
2298 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2299 my @endofsubscriptiondate=split/-/,$expirationdate;
2300 my $per = $subscription->{'periodicity'};
2302 if ( $per == 1 ) {$x=7;}
2303 if ( $per == 2 ) {$x=7; }
2304 if ( $per == 3 ) {$x=14;}
2305 if ( $per == 4 ) { $x = 21; }
2306 if ( $per == 5 ) { $x = 31; }
2307 if ( $per == 6 ) { $x = 62; }
2308 if ( $per == 7 || $per == 8 ) { $x = 93; }
2309 if ( $per == 9 ) { $x = 190; }
2310 if ( $per == 10 ) { $x = 365; }
2311 if ( $per == 11 ) { $x = 730; }
2312 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2313 - (3 * $x)) if (@endofsubscriptiondate);
2314 # warn "DATE BEFORE END: $datebeforeend";
2315 return 1 if ( @res &&
2317 Delta_Days($res[0],$res[1],$res[2],
2318 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2319 (@endofsubscriptiondate &&
2320 Delta_Days($res[0],$res[1],$res[2],
2321 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2323 } elsif ($subscription->{numberlength}>0) {
2324 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2328 =head2 old_newsubscription
2332 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2333 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2334 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2335 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2336 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2337 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2339 this function is similar to the NewSubscription subroutine but has a few different
2341 $firstacquidate - date of first serial issue to arrive
2342 $irregularity - the issues not expected separated by a '|'
2343 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2344 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2345 subscription-add.tmpl file
2346 $callnumber - display the callnumber of the serial
2347 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2350 the $subscriptionid number of the new subscription
2356 sub old_newsubscription {
2358 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2359 $biblionumber, $startdate, $periodicity, $firstacquidate,
2360 $dow, $irregularity, $numberpattern, $numberlength,
2361 $weeklength, $monthlength, $add1, $every1,
2362 $whenmorethan1, $setto1, $lastvalue1, $add2,
2363 $every2, $whenmorethan2, $setto2, $lastvalue2,
2364 $add3, $every3, $whenmorethan3, $setto3,
2365 $lastvalue3, $numberingmethod, $status, $callnumber,
2368 my $dbh = C4::Context->dbh;
2371 my $sth = $dbh->prepare(
2372 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2373 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2374 add1,every1,whenmorethan1,setto1,lastvalue1,
2375 add2,every2,whenmorethan2,setto2,lastvalue2,
2376 add3,every3,whenmorethan3,setto3,lastvalue3,
2377 numberingmethod, status, callnumber, notes, hemisphere) values
2378 (?,?,?,?,?,?,?,?,?,?,?,
2379 ?,?,?,?,?,?,?,?,?,?,?,
2380 ?,?,?,?,?,?,?,?,?,?,?,?)"
2383 $auser, $aqbooksellerid,
2385 $biblionumber, format_date_in_iso($startdate),
2386 $periodicity, format_date_in_iso($firstacquidate),
2387 $dow, $irregularity,
2388 $numberpattern, $numberlength,
2389 $weeklength, $monthlength,
2391 $whenmorethan1, $setto1,
2393 $every2, $whenmorethan2,
2394 $setto2, $lastvalue2,
2396 $whenmorethan3, $setto3,
2397 $lastvalue3, $numberingmethod,
2398 $status, $callnumber,
2402 #then create the 1st waited number
2403 my $subscriptionid = $dbh->{'mysql_insertid'};
2404 my $enddate = GetExpirationDate($subscriptionid);
2408 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2411 $biblionumber, $subscriptionid,
2412 format_date_in_iso($startdate),
2413 format_date_in_iso($enddate),
2417 # reread subscription to get a hash (for calculation of the 1st issue number)
2419 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2420 $sth->execute($subscriptionid);
2421 my $val = $sth->fetchrow_hashref;
2423 # calculate issue number
2424 my $serialseq = GetSeq($val);
2427 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2429 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2430 1, format_date_in_iso($startdate) );
2431 return $subscriptionid;
2434 =head2 old_modsubscription
2438 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2439 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2440 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2441 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2442 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2443 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2445 this function is similar to the ModSubscription subroutine but has a few different
2447 $firstacquidate - date of first serial issue to arrive
2448 $irregularity - the issues not expected separated by a '|'
2449 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2450 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2451 subscription-add.tmpl file
2452 $callnumber - display the callnumber of the serial
2453 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2459 sub old_modsubscription {
2461 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2462 $startdate, $periodicity, $firstacquidate, $dow,
2463 $irregularity, $numberpattern, $numberlength, $weeklength,
2464 $monthlength, $add1, $every1, $whenmorethan1,
2465 $setto1, $lastvalue1, $innerloop1, $add2,
2466 $every2, $whenmorethan2, $setto2, $lastvalue2,
2467 $innerloop2, $add3, $every3, $whenmorethan3,
2468 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2469 $status, $biblionumber, $callnumber, $notes,
2470 $hemisphere, $subscriptionid
2472 my $dbh = C4::Context->dbh;
2473 my $sth = $dbh->prepare(
2474 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2475 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2476 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2477 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2478 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2479 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2482 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2483 $startdate, $periodicity, $firstacquidate, $dow,
2484 $irregularity, $numberpattern, $numberlength, $weeklength,
2485 $monthlength, $add1, $every1, $whenmorethan1,
2486 $setto1, $lastvalue1, $innerloop1, $add2,
2487 $every2, $whenmorethan2, $setto2, $lastvalue2,
2488 $innerloop2, $add3, $every3, $whenmorethan3,
2489 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2490 $status, $biblionumber, $callnumber, $notes,
2491 $hemisphere, $subscriptionid
2496 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2497 $sth->execute($subscriptionid);
2498 my $val = $sth->fetchrow_hashref;
2500 # calculate issue number
2501 my $serialseq = Get_Seq($val);
2503 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2504 $sth->execute( $serialseq, $subscriptionid );
2506 my $enddate = subscriptionexpirationdate($subscriptionid);
2507 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2508 $sth->execute( format_date_in_iso($enddate) );
2511 =head2 old_getserials
2515 ($totalissues,@serials) = &old_getserials($subscriptionid)
2517 this function get a hashref of serials and the total count of them
2520 $totalissues - number of serial lines
2521 the serials into a table. Each line of this table containts a ref to a hash which it containts
2522 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2528 sub old_getserials {
2529 my ($subscriptionid) = @_;
2530 my $dbh = C4::Context->dbh;
2532 # status = 2 is "arrived"
2535 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2537 $sth->execute($subscriptionid);
2540 while ( my $line = $sth->fetchrow_hashref ) {
2541 $line->{ "status" . $line->{status} } =
2542 1; # fills a "statusX" value, used for template status select list
2543 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
2544 $line->{"num"} = $num;
2546 push @serials, $line;
2548 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2549 $sth->execute($subscriptionid);
2550 my ($totalissues) = $sth->fetchrow;
2551 return ( $totalissues, @serials );
2556 ($resultdate) = &GetNextDate($planneddate,$subscription)
2558 this function is an extension of GetNextDate which allows for checking for irregularity
2560 it takes the planneddate and will return the next issue's date and will skip dates if there
2561 exists an irregularity
2562 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2563 skipped then the returned date will be 2007-05-10
2566 $resultdate - then next date in the sequence
2568 Return 0 if periodicity==0
2571 sub in_array { # used in next sub down
2572 my ($val,@elements) = @_;
2573 foreach my $elem(@elements) {
2581 sub GetNextDate(@) {
2582 my ( $planneddate, $subscription ) = @_;
2583 my @irreg = split( /\,/, $subscription->{irregularity} );
2585 #date supposed to be in ISO.
2587 my ( $year, $month, $day ) = split(/-/, $planneddate);
2588 $month=1 unless ($month);
2589 $day=1 unless ($day);
2592 # warn "DOW $dayofweek";
2593 if ( $subscription->{periodicity} == 0 ) {
2596 if ( $subscription->{periodicity} == 1 ) {
2597 my $dayofweek = Day_of_Week( $year,$month, $day );
2598 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2599 $dayofweek = 0 if ( $dayofweek == 7 );
2600 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2601 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2605 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2607 if ( $subscription->{periodicity} == 2 ) {
2608 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2609 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2610 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2611 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2612 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2615 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2617 if ( $subscription->{periodicity} == 3 ) {
2618 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2619 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2620 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2621 ### BUGFIX was previously +1 ^
2622 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2623 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2626 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2628 if ( $subscription->{periodicity} == 4 ) {
2629 my ($wkno,$year) = Week_of_Year( $year,$month, $day );
2630 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2631 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2632 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2633 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2636 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2638 my $tmpmonth=$month;
2639 if ( $subscription->{periodicity} == 5 ) {
2640 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2641 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2642 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2643 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2646 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2648 if ( $subscription->{periodicity} == 6 ) {
2649 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2650 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2651 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2652 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2655 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2657 if ( $subscription->{periodicity} == 7 ) {
2658 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2659 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2660 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2661 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2664 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2666 if ( $subscription->{periodicity} == 8 ) {
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} == 9 ) {
2676 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2677 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2678 ### BUFIX Seems to need more Than One ?
2679 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2680 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2683 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2685 if ( $subscription->{periodicity} == 10 ) {
2686 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2688 if ( $subscription->{periodicity} == 11 ) {
2689 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2691 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2692 # warn "dateNEXTSEQ : ".$resultdate;
2693 return "$resultdate";
2698 $item = &itemdata($barcode);
2700 Looks up the item with the given barcode, and returns a
2701 reference-to-hash containing information about that item. The keys of
2702 the hash are the fields from the C<items> and C<biblioitems> tables in
2710 my $dbh = C4::Context->dbh;
2711 my $sth = $dbh->prepare(
2712 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2715 $sth->execute($barcode);
2716 my $data = $sth->fetchrow_hashref;
2721 END { } # module clean-up code here (global destructor)
2729 Koha Developement team <info@koha.org>