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
34 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
37 $VERSION = 3.01; # set version for version checking
41 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
42 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
43 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
44 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
46 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
47 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
48 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
49 &GetSerialInformation &AddItem2Serial
50 &PrepareSerialsData &GetNextExpected &ModNextExpected
52 &UpdateClaimdateIssues
53 &GetSuppliersWithLateIssues &getsupplierbyserialid
54 &getroutinglist &delroutingmember &addroutingmember
56 &check_routing &updateClaim &removeMissingIssue
61 =head2 GetSuppliersWithLateIssues
65 C4::Serials - Give functions for serializing.
73 Give all XYZ functions
79 %supplierlist = &GetSuppliersWithLateIssues
81 this function get all suppliers with late issues.
84 the supplierlist into a hash. this hash containts id & name of the supplier
90 sub GetSuppliersWithLateIssues {
91 my $dbh = C4::Context->dbh;
93 SELECT DISTINCT id, name
95 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
96 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
97 WHERE subscription.subscriptionid = serial.subscriptionid
98 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
101 my $sth = $dbh->prepare($query);
104 while ( my ( $id, $name ) = $sth->fetchrow ) {
105 $supplierlist{$id} = $name;
107 return %supplierlist;
114 @issuelist = &GetLateIssues($supplierid)
116 this function select late issues on database
119 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
120 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
127 my ($supplierid) = @_;
128 my $dbh = C4::Context->dbh;
132 SELECT name,title,planneddate,serialseq,serial.subscriptionid
134 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
135 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
136 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
137 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
138 AND subscription.aqbooksellerid=$supplierid
141 $sth = $dbh->prepare($query);
145 SELECT name,title,planneddate,serialseq,serial.subscriptionid
147 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
148 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
149 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
150 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
153 $sth = $dbh->prepare($query);
160 while ( my $line = $sth->fetchrow_hashref ) {
161 $odd++ unless $line->{title} eq $last_title;
162 $line->{title} = "" if $line->{title} eq $last_title;
163 $last_title = $line->{title} if ( $line->{title} );
164 $line->{planneddate} = format_date( $line->{planneddate} );
166 push @issuelist, $line;
168 return $count, @issuelist;
171 =head2 GetSubscriptionHistoryFromSubscriptionId
175 $sth = GetSubscriptionHistoryFromSubscriptionId()
176 this function just prepare the SQL request.
177 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
179 $sth = $dbh->prepare($query).
185 sub GetSubscriptionHistoryFromSubscriptionId() {
186 my $dbh = C4::Context->dbh;
189 FROM subscriptionhistory
190 WHERE subscriptionid = ?
192 return $dbh->prepare($query);
195 =head2 GetSerialStatusFromSerialId
199 $sth = GetSerialStatusFromSerialId();
200 this function just prepare the SQL request.
201 After this function, don't forget to execute it by using $sth->execute($serialid)
203 $sth = $dbh->prepare($query).
209 sub GetSerialStatusFromSerialId() {
210 my $dbh = C4::Context->dbh;
216 return $dbh->prepare($query);
219 =head2 GetSerialInformation
223 $data = GetSerialInformation($serialid);
224 returns a hash containing :
225 items : items marcrecord (can be an array)
227 subscription table field
228 + information about subscription expiration
234 sub GetSerialInformation {
236 my $dbh = C4::Context->dbh;
238 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
239 if (C4::Context->preference('IndependantBranches') &&
240 C4::Context->userenv &&
241 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
243 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
246 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
249 my $rq = $dbh->prepare($query);
250 $rq->execute($serialid);
251 my $data = $rq->fetchrow_hashref;
252 # create item information if we have serialsadditems for this subscription
253 if ( $data->{'serialsadditems'} ) {
254 my $queryitem=$dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
255 $queryitem->execute($serialid);
256 my $itemnumbers=$queryitem->fetchall_arrayref([0]);
257 if (scalar(@$itemnumbers)>0){
258 foreach my $itemnum (@$itemnumbers) {
259 #It is ASSUMED that GetMarcItem ALWAYS WORK...
260 #Maybe GetMarcItem should return values on failure
261 $debug and warn "itemnumber :$itemnum->[0], bibnum :".$data->{'biblionumber'};
263 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0] , $data );
264 $itemprocessed->{'itemnumber'} = $itemnum->[0];
265 $itemprocessed->{'itemid'} = $itemnum->[0];
266 $itemprocessed->{'serialid'} = $serialid;
267 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
268 push @{ $data->{'items'} }, $itemprocessed;
273 PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
274 $itemprocessed->{'itemid'} = "N$serialid";
275 $itemprocessed->{'serialid'} = $serialid;
276 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
277 $itemprocessed->{'countitems'} = 0;
278 push @{ $data->{'items'} }, $itemprocessed;
281 $data->{ "status" . $data->{'serstatus'} } = 1;
282 $data->{'subscriptionexpired'} =
283 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
284 $data->{'abouttoexpire'} =
285 abouttoexpire( $data->{'subscriptionid'} );
289 =head2 AddItem2Serial
293 $data = AddItem2Serial($serialid,$itemnumber);
294 Adds an itemnumber to Serial record
301 my ( $serialid, $itemnumber ) = @_;
302 my $dbh = C4::Context->dbh;
303 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
304 $rq->execute($serialid, $itemnumber);
308 =head2 UpdateClaimdateIssues
312 UpdateClaimdateIssues($serialids,[$date]);
314 Update Claimdate for issues in @$serialids list with date $date
321 sub UpdateClaimdateIssues {
322 my ( $serialids, $date ) = @_;
324 $date = strftime('%Y-%m-%d',localtime);
326 my $dbh = C4::Context->dbh;
327 my $ids_str = join ',', @{$serialids};
328 my $query = 'UPDATE serial SET claimdate=? ,status=7 WHERE serialid IN ( '
330 return $dbh->do($query,undef, $date);
333 =head2 GetSubscription
337 $subs = GetSubscription($subscriptionid)
338 this function get the subscription which has $subscriptionid as id.
340 a hashref. This hash containts
341 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
347 sub GetSubscription {
348 my ($subscriptionid) = @_;
349 my $dbh = C4::Context->dbh;
351 SELECT subscription.*,
352 subscriptionhistory.*,
353 subscriptionhistory.enddate as histenddate,
355 aqbooksellers.name AS aqbooksellername,
356 biblio.title AS bibliotitle,
357 subscription.biblionumber as bibnum);
358 if (C4::Context->preference('IndependantBranches') &&
359 C4::Context->userenv &&
360 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
362 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
366 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
367 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
368 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
369 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
370 WHERE subscription.subscriptionid = ?
372 # if (C4::Context->preference('IndependantBranches') &&
373 # C4::Context->userenv &&
374 # C4::Context->userenv->{'flags'} != 1){
375 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
376 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
378 $debug and warn "query : $query\nsubsid :$subscriptionid";
379 my $sth = $dbh->prepare($query);
380 $sth->execute($subscriptionid);
381 return $sth->fetchrow_hashref;
384 =head2 GetFullSubscription
388 \@res = GetFullSubscription($subscriptionid)
389 this function read on serial table.
395 sub GetFullSubscription {
396 my ($subscriptionid) = @_;
397 my $dbh = C4::Context->dbh;
399 SELECT serial.serialid,
402 serial.publisheddate,
404 serial.notes as notes,
405 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
406 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
407 biblio.title as bibliotitle,
408 subscription.branchcode AS branchcode,
409 subscription.subscriptionid AS subscriptionid |;
410 if (C4::Context->preference('IndependantBranches') &&
411 C4::Context->userenv &&
412 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
414 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
418 LEFT JOIN subscription ON
419 (serial.subscriptionid=subscription.subscriptionid )
420 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
421 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
422 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
423 WHERE serial.subscriptionid = ?
425 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
426 serial.subscriptionid
428 $debug and warn "GetFullSubscription query: $query";
429 my $sth = $dbh->prepare($query);
430 $sth->execute($subscriptionid);
431 return $sth->fetchall_arrayref({});
435 =head2 PrepareSerialsData
439 \@res = PrepareSerialsData($serialinfomation)
440 where serialinformation is a hashref array
446 sub PrepareSerialsData{
452 my $aqbooksellername;
456 my $previousnote = "";
458 foreach my $subs ( @$lines ) {
459 $subs->{'publisheddate'} =
460 ( $subs->{'publisheddate'}
461 ? format_date( $subs->{'publisheddate'} )
463 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
464 $subs->{ "status" . $subs->{'status'} } = 1;
466 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
467 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
468 $year = $subs->{'year'};
473 if ( $tmpresults{$year} ) {
474 push @{ $tmpresults{$year}->{'serials'} }, $subs;
477 $tmpresults{$year} = {
480 # 'startdate'=>format_date($subs->{'startdate'}),
481 'aqbooksellername' => $subs->{'aqbooksellername'},
482 'bibliotitle' => $subs->{'bibliotitle'},
483 'serials' => [$subs],
485 # 'branchcode' => $subs->{'branchcode'},
486 # 'subscriptionid' => $subs->{'subscriptionid'},
490 # $previousnote=$subs->{notes};
492 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
493 push @res, $tmpresults{$key};
495 $res[0]->{'first'}=1;
499 =head2 GetSubscriptionsFromBiblionumber
501 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
502 this function get the subscription list. it reads on subscription table.
504 table of subscription which has the biblionumber given on input arg.
505 each line of this table is a hashref. All hashes containt
506 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
510 sub GetSubscriptionsFromBiblionumber {
511 my ($biblionumber) = @_;
512 my $dbh = C4::Context->dbh;
514 SELECT subscription.*,
516 subscriptionhistory.*,
517 subscriptionhistory.enddate as histenddate,
519 aqbooksellers.name AS aqbooksellername,
520 biblio.title AS bibliotitle
522 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
523 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
524 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
525 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
526 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
527 WHERE subscription.biblionumber = ?
529 # if (C4::Context->preference('IndependantBranches') &&
530 # C4::Context->userenv &&
531 # C4::Context->userenv->{'flags'} != 1){
532 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
534 my $sth = $dbh->prepare($query);
535 $sth->execute($biblionumber);
537 while ( my $subs = $sth->fetchrow_hashref ) {
538 $subs->{startdate} = format_date( $subs->{startdate} );
539 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
540 $subs->{histenddate} = format_date( $subs->{histenddate} );
541 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
542 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
543 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
544 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
545 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
546 $subs->{ "status" . $subs->{'status'} } = 1;
547 $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
548 C4::Context->userenv &&
549 C4::Context->userenv->{flags} % 2 !=1 &&
550 C4::Context->userenv->{branch} && $subs->{branchcode} &&
551 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
552 if ( $subs->{enddate} eq '0000-00-00' ) {
553 $subs->{enddate} = '';
556 $subs->{enddate} = format_date( $subs->{enddate} );
558 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
559 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
565 =head2 GetFullSubscriptionsFromBiblionumber
569 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
570 this function read on serial table.
576 sub GetFullSubscriptionsFromBiblionumber {
577 my ($biblionumber) = @_;
578 my $dbh = C4::Context->dbh;
580 SELECT serial.serialid,
583 serial.publisheddate,
585 serial.notes as notes,
586 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
587 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
588 biblio.title as bibliotitle,
589 subscription.branchcode AS branchcode,
590 branches.branchname AS branchname,
591 subscription.subscriptionid AS subscriptionid|;
592 if (C4::Context->preference('IndependantBranches') &&
593 C4::Context->userenv &&
594 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
596 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
601 LEFT JOIN subscription ON
602 (serial.subscriptionid=subscription.subscriptionid)
603 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
604 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
605 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
606 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
607 WHERE subscription.biblionumber = ?
609 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
610 serial.subscriptionid
612 my $sth = $dbh->prepare($query);
613 $sth->execute($biblionumber);
614 return $sth->fetchall_arrayref({});
617 =head2 GetSubscriptions
621 @results = GetSubscriptions($title,$ISSN,$biblionumber);
622 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
624 a table of hashref. Each hash containt the subscription.
630 sub GetSubscriptions {
631 my ( $title, $ISSN, $biblionumber ) = @_;
632 #return unless $title or $ISSN or $biblionumber;
633 my $dbh = C4::Context->dbh;
637 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
639 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
640 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
641 WHERE biblio.biblionumber=?
643 $query.=" ORDER BY title";
644 $debug and warn "GetSubscriptions query: $query";
645 $sth = $dbh->prepare($query);
646 $sth->execute($biblionumber);
649 if ( $ISSN and $title ) {
651 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
653 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
654 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
655 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
656 $query.=" ORDER BY title";
657 $debug and warn "GetSubscriptions query: $query";
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 $query.=" ORDER BY title";
671 $debug and warn "GetSubscriptions query: $query";
672 $sth = $dbh->prepare($query);
673 $sth->execute( "%" . $ISSN . "%" );
677 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
679 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
680 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
682 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
684 $query.=" ORDER BY title";
685 $debug and warn "GetSubscriptions query: $query";
686 $sth = $dbh->prepare($query);
692 my $previoustitle = "";
694 while ( my $line = $sth->fetchrow_hashref ) {
695 if ( $previoustitle eq $line->{title} ) {
700 $previoustitle = $line->{title};
703 $line->{toggle} = 1 if $odd == 1;
704 $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
705 C4::Context->userenv &&
706 C4::Context->userenv->{flags} % 2 !=1 &&
707 C4::Context->userenv->{branch} && $line->{branchcode} &&
708 (C4::Context->userenv->{branch} ne $line->{branchcode}));
709 push @results, $line;
718 ($totalissues,@serials) = GetSerials($subscriptionid);
719 this function get every serial not arrived for a given subscription
720 as well as the number of issues registered in the database (all types)
721 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
723 FIXME: We should return \@serials.
730 my ($subscriptionid,$count) = @_;
731 my $dbh = C4::Context->dbh;
733 # status = 2 is "arrived"
735 $count=5 unless ($count);
738 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes, claimdate
740 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
741 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
742 my $sth = $dbh->prepare($query);
743 $sth->execute($subscriptionid);
744 while ( my $line = $sth->fetchrow_hashref ) {
745 $line->{ "status" . $line->{status} } =
746 1; # fills a "statusX" value, used for template status select list
747 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
748 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
749 $line->{claimdate} = format_date( $line->{claimdate} );
750 push @serials, $line;
752 # OK, now add the last 5 issues arrives/missing
754 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
756 WHERE subscriptionid = ?
757 AND (status in (2,4,5))
758 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
760 $sth = $dbh->prepare($query);
761 $sth->execute($subscriptionid);
762 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
764 $line->{ "status" . $line->{status} } =
765 1; # fills a "statusX" value, used for template status select list
766 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
767 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
768 push @serials, $line;
771 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
772 $sth = $dbh->prepare($query);
773 $sth->execute($subscriptionid);
774 my ($totalissues) = $sth->fetchrow;
775 return ( $totalissues, @serials );
782 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
783 this function get every serial waited for a given subscription
784 as well as the number of issues registered in the database (all types)
785 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
791 my ($subscription,$status) = @_;
792 my $dbh = C4::Context->dbh;
794 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
796 WHERE subscriptionid=$subscription AND status IN ($status)
797 ORDER BY publisheddate,serialid DESC
799 $debug and warn "GetSerials2 query: $query";
800 my $sth=$dbh->prepare($query);
803 while(my $line = $sth->fetchrow_hashref) {
804 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
805 $line->{"planneddate"} = format_date($line->{"planneddate"});
806 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
809 my ($totalissues) = scalar(@serials);
810 return ($totalissues,@serials);
813 =head2 GetLatestSerials
817 \@serials = GetLatestSerials($subscriptionid,$limit)
818 get the $limit's latest serials arrived or missing for a given subscription
820 a ref to a table which it containts all of the latest serials stored into a hash.
826 sub GetLatestSerials {
827 my ( $subscriptionid, $limit ) = @_;
828 my $dbh = C4::Context->dbh;
830 # status = 2 is "arrived"
831 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
833 WHERE subscriptionid = ?
834 AND (status =2 or status=4)
835 ORDER BY publisheddate DESC LIMIT 0,$limit
837 my $sth = $dbh->prepare($strsth);
838 $sth->execute($subscriptionid);
840 while ( my $line = $sth->fetchrow_hashref ) {
841 $line->{ "status" . $line->{status} } =
842 1; # fills a "statusX" value, used for template status select list
843 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
844 push @serials, $line;
850 # WHERE subscriptionid=?
852 # $sth=$dbh->prepare($query);
853 # $sth->execute($subscriptionid);
854 # my ($totalissues) = $sth->fetchrow;
863 $val is a hashref containing all the attributes of the table 'subscription'
864 This function get the next issue for the subscription given on input arg
866 all the input params updated.
874 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
875 # $calculated = $val->{numberingmethod};
876 # # calculate the (expected) value of the next issue recieved.
877 # $newlastvalue1 = $val->{lastvalue1};
878 # # check if we have to increase the new value.
879 # $newinnerloop1 = $val->{innerloop1}+1;
880 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
881 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
882 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
883 # $calculated =~ s/\{X\}/$newlastvalue1/g;
885 # $newlastvalue2 = $val->{lastvalue2};
886 # # check if we have to increase the new value.
887 # $newinnerloop2 = $val->{innerloop2}+1;
888 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
889 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
890 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
891 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
893 # $newlastvalue3 = $val->{lastvalue3};
894 # # check if we have to increase the new value.
895 # $newinnerloop3 = $val->{innerloop3}+1;
896 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
897 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
898 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
899 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
900 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
906 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
907 $newinnerloop1, $newinnerloop2, $newinnerloop3
909 my $pattern = $val->{numberpattern};
910 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
911 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
912 $calculated = $val->{numberingmethod};
913 $newlastvalue1 = $val->{lastvalue1};
914 $newlastvalue2 = $val->{lastvalue2};
915 $newlastvalue3 = $val->{lastvalue3};
916 $newlastvalue1 = $val->{lastvalue1};
917 # check if we have to increase the new value.
918 $newinnerloop1 = $val->{innerloop1} + 1;
919 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
920 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
921 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
922 $calculated =~ s/\{X\}/$newlastvalue1/g;
924 $newlastvalue2 = $val->{lastvalue2};
925 # check if we have to increase the new value.
926 $newinnerloop2 = $val->{innerloop2} + 1;
927 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
928 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
929 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
930 if ( $pattern == 6 ) {
931 if ( $val->{hemisphere} == 2 ) {
932 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
933 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
936 my $newlastvalue2seq = $seasons[$newlastvalue2];
937 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
941 $calculated =~ s/\{Y\}/$newlastvalue2/g;
945 $newlastvalue3 = $val->{lastvalue3};
946 # check if we have to increase the new value.
947 $newinnerloop3 = $val->{innerloop3} + 1;
948 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
949 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
950 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
951 $calculated =~ s/\{Z\}/$newlastvalue3/g;
953 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
954 $newinnerloop1, $newinnerloop2, $newinnerloop3);
961 $calculated = GetSeq($val)
962 $val is a hashref containing all the attributes of the table 'subscription'
963 this function transforms {X},{Y},{Z} to 150,0,0 for example.
965 the sequence in integer format
973 my $pattern = $val->{numberpattern};
974 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
975 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
976 my $calculated = $val->{numberingmethod};
977 my $x = $val->{'lastvalue1'};
978 $calculated =~ s/\{X\}/$x/g;
979 my $newlastvalue2 = $val->{'lastvalue2'};
980 if ( $pattern == 6 ) {
981 if ( $val->{hemisphere} == 2 ) {
982 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
983 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
986 my $newlastvalue2seq = $seasons[$newlastvalue2];
987 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
991 $calculated =~ s/\{Y\}/$newlastvalue2/g;
993 my $z = $val->{'lastvalue3'};
994 $calculated =~ s/\{Z\}/$z/g;
998 =head2 GetExpirationDate
1000 $sensddate = GetExpirationDate($subscriptionid)
1002 this function return the expiration date for a subscription given on input args.
1009 sub GetExpirationDate {
1010 my ($subscriptionid) = @_;
1011 my $dbh = C4::Context->dbh;
1012 my $subscription = GetSubscription($subscriptionid);
1013 my $enddate = $subscription->{startdate};
1015 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1016 if (($subscription->{periodicity} % 16) >0){
1017 if ( $subscription->{numberlength} ) {
1018 #calculate the date of the last issue.
1019 my $length = $subscription->{numberlength};
1020 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1021 $enddate = GetNextDate( $enddate, $subscription );
1024 elsif ( $subscription->{monthlength} ){
1025 my @date=split (/-/,$subscription->{startdate});
1026 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1027 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1028 } elsif ( $subscription->{weeklength} ){
1029 my @date=split (/-/,$subscription->{startdate});
1030 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1031 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1039 =head2 CountSubscriptionFromBiblionumber
1043 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1044 this count the number of subscription for a biblionumber given.
1046 the number of subscriptions with biblionumber given on input arg.
1052 sub CountSubscriptionFromBiblionumber {
1053 my ($biblionumber) = @_;
1054 my $dbh = C4::Context->dbh;
1055 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1056 my $sth = $dbh->prepare($query);
1057 $sth->execute($biblionumber);
1058 my $subscriptionsnumber = $sth->fetchrow;
1059 return $subscriptionsnumber;
1062 =head2 ModSubscriptionHistory
1066 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1068 this function modify the history of a subscription. Put your new values on input arg.
1074 sub ModSubscriptionHistory {
1076 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1077 $missinglist, $opacnote, $librariannote
1079 my $dbh = C4::Context->dbh;
1080 my $query = "UPDATE subscriptionhistory
1081 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1082 WHERE subscriptionid=?
1084 my $sth = $dbh->prepare($query);
1085 $recievedlist =~ s/^; //;
1086 $missinglist =~ s/^; //;
1087 $opacnote =~ s/^; //;
1089 $histstartdate, $enddate, $recievedlist, $missinglist,
1090 $opacnote, $librariannote, $subscriptionid
1095 =head2 ModSerialStatus
1099 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1101 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1102 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1108 sub ModSerialStatus {
1109 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1112 #It is a usual serial
1113 # 1st, get previous status :
1114 my $dbh = C4::Context->dbh;
1115 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1116 my $sth = $dbh->prepare($query);
1117 $sth->execute($serialid);
1118 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1120 # change status & update subscriptionhistory
1122 if ( $status eq 6 ) {
1123 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1127 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1128 $sth = $dbh->prepare($query);
1129 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1130 $notes, $serialid );
1131 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1132 $sth = $dbh->prepare($query);
1133 $sth->execute($subscriptionid);
1134 my $val = $sth->fetchrow_hashref;
1135 unless ( $val->{manualhistory} ) {
1137 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1138 $sth = $dbh->prepare($query);
1139 $sth->execute($subscriptionid);
1140 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1141 if ( $status eq 2 ) {
1143 $recievedlist .= "; $serialseq"
1144 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1147 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1148 $missinglist .= "; $serialseq"
1150 and not index( "$missinglist", "$serialseq" ) >= 0 );
1151 $missinglist .= "; not issued $serialseq"
1153 and index( "$missinglist", "$serialseq" ) >= 0 );
1155 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1156 $sth = $dbh->prepare($query);
1157 $recievedlist =~ s/^; //;
1158 $missinglist =~ s/^; //;
1159 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1163 # create new waited entry if needed (ie : was a "waited" and has changed)
1164 if ( $oldstatus eq 1 && $status ne 1 ) {
1165 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1166 $sth = $dbh->prepare($query);
1167 $sth->execute($subscriptionid);
1168 my $val = $sth->fetchrow_hashref;
1173 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1174 $newinnerloop1, $newinnerloop2, $newinnerloop3
1175 ) = GetNextSeq($val);
1176 # warn "Next Seq End";
1178 # next date (calculated from actual date & frequency parameters)
1179 # warn "publisheddate :$publisheddate ";
1180 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1181 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1182 1, $nextpublisheddate, $nextpublisheddate );
1184 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1185 WHERE subscriptionid = ?";
1186 $sth = $dbh->prepare($query);
1188 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1189 $newinnerloop2, $newinnerloop3, $subscriptionid
1192 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1193 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1194 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1199 =head2 GetNextExpected
1203 $nextexpected = GetNextExpected($subscriptionid)
1205 Get the planneddate for the current expected issue of the subscription.
1211 planneddate => C4::Dates object
1218 sub GetNextExpected($) {
1219 my ($subscriptionid) = @_;
1220 my $dbh = C4::Context->dbh;
1221 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1222 # Each subscription has only one 'expected' issue, with serial.status==1.
1223 $sth->execute( $subscriptionid, 1 );
1224 my ( $nextissue ) = $sth->fetchrow_hashref;
1226 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1227 $sth->execute( $subscriptionid );
1228 $nextissue = $sth->fetchrow_hashref;
1230 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1234 =head2 ModNextExpected
1238 ModNextExpected($subscriptionid,$date)
1240 Update the planneddate for the current expected issue of the subscription.
1241 This will modify all future prediction results.
1243 C<$date> is a C4::Dates object.
1249 sub ModNextExpected($$) {
1250 my ($subscriptionid,$date) = @_;
1251 my $dbh = C4::Context->dbh;
1252 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1253 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1254 # Each subscription has only one 'expected' issue, with serial.status==1.
1255 $sth->execute( $date->output('iso'),$date->output('iso'), $subscriptionid, 1);
1260 =head2 ModSubscription
1264 this function modify a subscription. Put all new values on input args.
1270 sub ModSubscription {
1272 $auser, $branchcode, $aqbooksellerid, $cost,
1273 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1274 $dow, $irregularity, $numberpattern, $numberlength,
1275 $weeklength, $monthlength, $add1, $every1,
1276 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1277 $add2, $every2, $whenmorethan2, $setto2,
1278 $lastvalue2, $innerloop2, $add3, $every3,
1279 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1280 $numberingmethod, $status, $biblionumber, $callnumber,
1281 $notes, $letter, $hemisphere, $manualhistory,
1282 $internalnotes, $serialsadditems,$subscriptionid,
1283 $staffdisplaycount,$opacdisplaycount, $graceperiod, $location
1285 # warn $irregularity;
1286 my $dbh = C4::Context->dbh;
1287 my $query = "UPDATE subscription
1288 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1289 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1290 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1291 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1292 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1293 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1294 WHERE subscriptionid = ?";
1295 #warn "query :".$query;
1296 my $sth = $dbh->prepare($query);
1298 $auser, $branchcode, $aqbooksellerid, $cost,
1299 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1300 $dow, "$irregularity", $numberpattern, $numberlength,
1301 $weeklength, $monthlength, $add1, $every1,
1302 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1303 $add2, $every2, $whenmorethan2, $setto2,
1304 $lastvalue2, $innerloop2, $add3, $every3,
1305 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1306 $numberingmethod, $status, $biblionumber, $callnumber,
1307 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1308 $internalnotes, $serialsadditems,
1309 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location,
1312 my $rows=$sth->rows;
1315 logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1319 =head2 NewSubscription
1323 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1324 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1325 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1326 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1327 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1328 $numberingmethod, $status, $notes, $serialsadditems,
1329 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location);
1331 Create a new subscription with value given on input args.
1334 the id of this new subscription
1340 sub NewSubscription {
1342 $auser, $branchcode, $aqbooksellerid, $cost,
1343 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1344 $dow, $numberlength, $weeklength, $monthlength,
1345 $add1, $every1, $whenmorethan1, $setto1,
1346 $lastvalue1, $innerloop1, $add2, $every2,
1347 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1348 $add3, $every3, $whenmorethan3, $setto3,
1349 $lastvalue3, $innerloop3, $numberingmethod, $status,
1350 $notes, $letter, $firstacquidate, $irregularity,
1351 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1352 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1353 $graceperiod, $location
1355 my $dbh = C4::Context->dbh;
1357 #save subscription (insert into database)
1359 INSERT INTO subscription
1360 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1361 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1362 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1363 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1364 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1365 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1366 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1367 staffdisplaycount,opacdisplaycount,graceperiod,location)
1368 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1370 my $sth = $dbh->prepare($query);
1372 $auser, $branchcode,
1373 $aqbooksellerid, $cost,
1374 $aqbudgetid, $biblionumber,
1375 format_date_in_iso($startdate), $periodicity,
1376 $dow, $numberlength,
1377 $weeklength, $monthlength,
1379 $whenmorethan1, $setto1,
1380 $lastvalue1, $innerloop1,
1382 $whenmorethan2, $setto2,
1383 $lastvalue2, $innerloop2,
1385 $whenmorethan3, $setto3,
1386 $lastvalue3, $innerloop3,
1387 $numberingmethod, "$status",
1389 format_date_in_iso($firstacquidate), $irregularity,
1390 $numberpattern, $callnumber,
1391 $hemisphere, $manualhistory,
1392 $internalnotes, $serialsadditems,
1393 $staffdisplaycount, $opacdisplaycount,
1394 $graceperiod, $location,
1397 #then create the 1st waited number
1398 my $subscriptionid = $dbh->{'mysql_insertid'};
1400 INSERT INTO subscriptionhistory
1401 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1404 $sth = $dbh->prepare($query);
1405 $sth->execute( $biblionumber, $subscriptionid,
1406 format_date_in_iso($startdate),
1407 $notes,$internalnotes );
1409 # reread subscription to get a hash (for calculation of the 1st issue number)
1413 WHERE subscriptionid = ?
1415 $sth = $dbh->prepare($query);
1416 $sth->execute($subscriptionid);
1417 my $val = $sth->fetchrow_hashref;
1419 # calculate issue number
1420 my $serialseq = GetSeq($val);
1423 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1424 VALUES (?,?,?,?,?,?)
1426 $sth = $dbh->prepare($query);
1428 "$serialseq", $subscriptionid, $biblionumber, 1,
1429 format_date_in_iso($firstacquidate),
1430 format_date_in_iso($firstacquidate)
1433 logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1435 #set serial flag on biblio if not already set.
1436 my ($null, ($bib)) = GetBiblio($biblionumber);
1437 if( ! $bib->{'serial'} ) {
1438 my $record = GetMarcBiblio($biblionumber);
1439 my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1442 $record->field($tag)->update( $subf => 1 );
1445 ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1447 return $subscriptionid;
1450 =head2 ReNewSubscription
1454 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1456 this function renew a subscription with values given on input args.
1462 sub ReNewSubscription {
1463 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1464 $monthlength, $note )
1466 my $dbh = C4::Context->dbh;
1467 my $subscription = GetSubscription($subscriptionid);
1471 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1472 WHERE biblio.biblionumber=?
1474 my $sth = $dbh->prepare($query);
1475 $sth->execute( $subscription->{biblionumber} );
1476 my $biblio = $sth->fetchrow_hashref;
1477 if (C4::Context->preference("RenewSerialAddsSuggestion")){
1479 $user, $subscription->{bibliotitle},
1480 $biblio->{author}, $biblio->{publishercode},
1481 $biblio->{note}, '',
1484 $subscription->{biblionumber}
1488 # renew subscription
1491 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1492 WHERE subscriptionid=?
1494 $sth = $dbh->prepare($query);
1495 $sth->execute( format_date_in_iso($startdate),
1496 $numberlength, $weeklength, $monthlength, $subscriptionid );
1498 logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1505 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1507 Create a new issue stored on the database.
1508 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1515 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1516 $planneddate, $publisheddate, $notes )
1518 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1520 my $dbh = C4::Context->dbh;
1523 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1524 VALUES (?,?,?,?,?,?,?)
1526 my $sth = $dbh->prepare($query);
1527 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1528 $publisheddate, $planneddate,$notes );
1529 my $serialid=$dbh->{'mysql_insertid'};
1531 SELECT missinglist,recievedlist
1532 FROM subscriptionhistory
1533 WHERE subscriptionid=?
1535 $sth = $dbh->prepare($query);
1536 $sth->execute($subscriptionid);
1537 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1539 if ( $status eq 2 ) {
1540 ### TODO Add a feature that improves recognition and description.
1541 ### As such count (serialseq) i.e. : N18,2(N19),N20
1542 ### Would use substr and index But be careful to previous presence of ()
1543 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1545 if ( $status eq 4 ) {
1546 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1549 UPDATE subscriptionhistory
1550 SET recievedlist=?, missinglist=?
1551 WHERE subscriptionid=?
1553 $sth = $dbh->prepare($query);
1554 $recievedlist =~ s/^; //;
1555 $missinglist =~ s/^; //;
1556 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1560 =head2 ItemizeSerials
1564 ItemizeSerials($serialid, $info);
1565 $info is a hashref containing barcode branch, itemcallnumber, status, location
1566 $serialid the serialid
1568 1 if the itemize is a succes.
1569 0 and @error else. @error containts the list of errors found.
1575 sub ItemizeSerials {
1576 my ( $serialid, $info ) = @_;
1577 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1579 my $dbh = C4::Context->dbh;
1585 my $sth = $dbh->prepare($query);
1586 $sth->execute($serialid);
1587 my $data = $sth->fetchrow_hashref;
1588 if ( C4::Context->preference("RoutingSerials") ) {
1590 # check for existing biblioitem relating to serial issue
1591 my ( $count, @results ) =
1592 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1594 for ( my $i = 0 ; $i < $count ; $i++ ) {
1595 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1596 . $data->{'planneddate'}
1599 $bibitemno = $results[$i]->{'biblioitemnumber'};
1603 if ( $bibitemno == 0 ) {
1605 # warn "need to add new biblioitem so copy last one and make minor changes";
1608 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1610 $sth->execute( $data->{'biblionumber'} );
1611 my $biblioitem = $sth->fetchrow_hashref;
1612 $biblioitem->{'volumedate'} =
1613 format_date_in_iso( $data->{planneddate} );
1614 $biblioitem->{'volumeddesc'} =
1615 $data->{serialseq} . ' ('
1616 . format_date( $data->{'planneddate'} ) . ')';
1617 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1619 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1620 # so I comment it, we can speak of it when you want
1621 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1622 # if ( $info->{barcode} )
1623 # { # only make biblioitem if we are going to make item also
1624 # $bibitemno = newbiblioitem($biblioitem);
1629 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1630 if ( $info->{barcode} ) {
1632 my $exists = itemdata( $info->{'barcode'} );
1633 push @errors, "barcode_not_unique" if ($exists);
1635 my $marcrecord = MARC::Record->new();
1636 my ( $tag, $subfield ) =
1637 GetMarcFromKohaField( "items.barcode", $fwk );
1639 MARC::Field->new( "$tag", '', '',
1640 "$subfield" => $info->{barcode} );
1641 $marcrecord->insert_fields_ordered($newField);
1642 if ( $info->{branch} ) {
1643 my ( $tag, $subfield ) =
1644 GetMarcFromKohaField( "items.homebranch",
1647 #warn "items.homebranch : $tag , $subfield";
1648 if ( $marcrecord->field($tag) ) {
1649 $marcrecord->field($tag)
1650 ->add_subfields( "$subfield" => $info->{branch} );
1654 MARC::Field->new( "$tag", '', '',
1655 "$subfield" => $info->{branch} );
1656 $marcrecord->insert_fields_ordered($newField);
1658 ( $tag, $subfield ) =
1659 GetMarcFromKohaField( "items.holdingbranch",
1662 #warn "items.holdingbranch : $tag , $subfield";
1663 if ( $marcrecord->field($tag) ) {
1664 $marcrecord->field($tag)
1665 ->add_subfields( "$subfield" => $info->{branch} );
1669 MARC::Field->new( "$tag", '', '',
1670 "$subfield" => $info->{branch} );
1671 $marcrecord->insert_fields_ordered($newField);
1674 if ( $info->{itemcallnumber} ) {
1675 my ( $tag, $subfield ) =
1676 GetMarcFromKohaField( "items.itemcallnumber",
1679 #warn "items.itemcallnumber : $tag , $subfield";
1680 if ( $marcrecord->field($tag) ) {
1681 $marcrecord->field($tag)
1682 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1686 MARC::Field->new( "$tag", '', '',
1687 "$subfield" => $info->{itemcallnumber} );
1688 $marcrecord->insert_fields_ordered($newField);
1691 if ( $info->{notes} ) {
1692 my ( $tag, $subfield ) =
1693 GetMarcFromKohaField( "items.itemnotes", $fwk );
1695 # warn "items.itemnotes : $tag , $subfield";
1696 if ( $marcrecord->field($tag) ) {
1697 $marcrecord->field($tag)
1698 ->add_subfields( "$subfield" => $info->{notes} );
1702 MARC::Field->new( "$tag", '', '',
1703 "$subfield" => $info->{notes} );
1704 $marcrecord->insert_fields_ordered($newField);
1707 if ( $info->{location} ) {
1708 my ( $tag, $subfield ) =
1709 GetMarcFromKohaField( "items.location", $fwk );
1711 # warn "items.location : $tag , $subfield";
1712 if ( $marcrecord->field($tag) ) {
1713 $marcrecord->field($tag)
1714 ->add_subfields( "$subfield" => $info->{location} );
1718 MARC::Field->new( "$tag", '', '',
1719 "$subfield" => $info->{location} );
1720 $marcrecord->insert_fields_ordered($newField);
1723 if ( $info->{status} ) {
1724 my ( $tag, $subfield ) =
1725 GetMarcFromKohaField( "items.notforloan",
1728 # warn "items.notforloan : $tag , $subfield";
1729 if ( $marcrecord->field($tag) ) {
1730 $marcrecord->field($tag)
1731 ->add_subfields( "$subfield" => $info->{status} );
1735 MARC::Field->new( "$tag", '', '',
1736 "$subfield" => $info->{status} );
1737 $marcrecord->insert_fields_ordered($newField);
1740 if ( C4::Context->preference("RoutingSerials") ) {
1741 my ( $tag, $subfield ) =
1742 GetMarcFromKohaField( "items.dateaccessioned",
1744 if ( $marcrecord->field($tag) ) {
1745 $marcrecord->field($tag)
1746 ->add_subfields( "$subfield" => $now );
1750 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1751 $marcrecord->insert_fields_ordered($newField);
1754 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1757 return ( 0, @errors );
1761 =head2 HasSubscriptionExpired
1765 $has_expired = HasSubscriptionExpired($subscriptionid)
1767 the subscription has expired when the next issue to arrive is out of subscription limit.
1770 0 if the subscription has not expired
1771 1 if the subscription has expired
1772 2 if has subscription does not have a valid expiration date set
1778 sub HasSubscriptionExpired {
1779 my ($subscriptionid) = @_;
1780 my $dbh = C4::Context->dbh;
1781 my $subscription = GetSubscription($subscriptionid);
1782 if (($subscription->{periodicity} % 16)>0){
1783 my $expirationdate = GetExpirationDate($subscriptionid);
1785 SELECT max(planneddate)
1787 WHERE subscriptionid=?
1789 my $sth = $dbh->prepare($query);
1790 $sth->execute($subscriptionid);
1791 my ($res) = $sth->fetchrow ;
1792 return 0 unless $res;
1793 my @res=split (/-/,$res);
1794 my @endofsubscriptiondate=split(/-/,$expirationdate);
1795 return 2 if (scalar(@res)!=3 || scalar(@endofsubscriptiondate)!=3||not check_date(@res) || not check_date(@endofsubscriptiondate));
1796 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1797 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1801 if ($subscription->{'numberlength'}){
1802 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1803 return 1 if ($countreceived >$subscription->{'numberlength'});
1809 return 0; # Notice that you'll never get here.
1812 =head2 DelSubscription
1816 DelSubscription($subscriptionid)
1817 this function delete the subscription which has $subscriptionid as id.
1823 sub DelSubscription {
1824 my ($subscriptionid) = @_;
1825 my $dbh = C4::Context->dbh;
1826 $subscriptionid = $dbh->quote($subscriptionid);
1827 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1829 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1830 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1832 logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1839 DelIssue($serialseq,$subscriptionid)
1840 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1847 my ( $dataissue) = @_;
1848 my $dbh = C4::Context->dbh;
1849 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1854 AND subscriptionid= ?
1856 my $mainsth = $dbh->prepare($query);
1857 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1859 #Delete element from subscription history
1860 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1861 my $sth = $dbh->prepare($query);
1862 $sth->execute($dataissue->{'subscriptionid'});
1863 my $val = $sth->fetchrow_hashref;
1864 unless ( $val->{manualhistory} ) {
1866 SELECT * FROM subscriptionhistory
1867 WHERE subscriptionid= ?
1869 my $sth = $dbh->prepare($query);
1870 $sth->execute($dataissue->{'subscriptionid'});
1871 my $data = $sth->fetchrow_hashref;
1872 my $serialseq= $dataissue->{'serialseq'};
1873 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1874 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1875 my $strsth = "UPDATE subscriptionhistory SET "
1877 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1878 . " WHERE subscriptionid=?";
1879 $sth = $dbh->prepare($strsth);
1880 $sth->execute($dataissue->{'subscriptionid'});
1883 return $mainsth->rows;
1886 =head2 GetLateOrMissingIssues
1890 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1892 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1895 a count of the number of missing issues
1896 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1897 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1903 sub GetLateOrMissingIssues {
1904 my ( $supplierid, $serialid,$order ) = @_;
1905 my $dbh = C4::Context->dbh;
1909 $byserial = "and serialid = " . $serialid;
1917 $sth = $dbh->prepare(
1926 serial.subscriptionid,
1929 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1930 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1931 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1932 WHERE subscription.subscriptionid = serial.subscriptionid
1933 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1934 AND subscription.aqbooksellerid=$supplierid
1940 $sth = $dbh->prepare(
1949 serial.subscriptionid,
1952 LEFT JOIN subscription
1953 ON serial.subscriptionid=subscription.subscriptionid
1955 ON subscription.biblionumber=biblio.biblionumber
1956 LEFT JOIN aqbooksellers
1957 ON subscription.aqbooksellerid = aqbooksellers.id
1959 subscription.subscriptionid = serial.subscriptionid
1960 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1970 while ( my $line = $sth->fetchrow_hashref ) {
1971 $odd++ unless $line->{title} eq $last_title;
1972 $last_title = $line->{title} if ( $line->{title} );
1973 $line->{planneddate} = format_date( $line->{planneddate} );
1974 $line->{claimdate} = format_date( $line->{claimdate} );
1975 $line->{"status".$line->{status}} = 1;
1976 $line->{'odd'} = 1 if $odd % 2;
1978 push @issuelist, $line;
1980 return $count, @issuelist;
1983 =head2 removeMissingIssue
1987 removeMissingIssue($subscriptionid)
1989 this function removes an issue from being part of the missing string in
1990 subscriptionlist.missinglist column
1992 called when a missing issue is found from the serials-recieve.pl file
1998 sub removeMissingIssue {
1999 my ( $sequence, $subscriptionid ) = @_;
2000 my $dbh = C4::Context->dbh;
2003 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2004 $sth->execute($subscriptionid);
2005 my $data = $sth->fetchrow_hashref;
2006 my $missinglist = $data->{'missinglist'};
2007 my $missinglistbefore = $missinglist;
2009 # warn $missinglist." before";
2010 $missinglist =~ s/($sequence)//;
2012 # warn $missinglist." after";
2013 if ( $missinglist ne $missinglistbefore ) {
2014 $missinglist =~ s/\|\s\|/\|/g;
2015 $missinglist =~ s/^\| //g;
2016 $missinglist =~ s/\|$//g;
2017 my $sth2 = $dbh->prepare(
2018 "UPDATE subscriptionhistory
2020 WHERE subscriptionid = ?"
2022 $sth2->execute( $missinglist, $subscriptionid );
2030 &updateClaim($serialid)
2032 this function updates the time when a claim is issued for late/missing items
2034 called from claims.pl file
2041 my ($serialid) = @_;
2042 my $dbh = C4::Context->dbh;
2043 my $sth = $dbh->prepare(
2044 "UPDATE serial SET claimdate = now()
2048 $sth->execute($serialid);
2051 =head2 getsupplierbyserialid
2055 ($result) = &getsupplierbyserialid($serialid)
2057 this function is used to find the supplier id given a serial id
2060 hashref containing serialid, subscriptionid, and aqbooksellerid
2066 sub getsupplierbyserialid {
2067 my ($serialid) = @_;
2068 my $dbh = C4::Context->dbh;
2069 my $sth = $dbh->prepare(
2070 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2072 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2076 $sth->execute($serialid);
2077 my $line = $sth->fetchrow_hashref;
2078 my $result = $line->{'aqbooksellerid'};
2082 =head2 check_routing
2086 ($result) = &check_routing($subscriptionid)
2088 this function checks to see if a serial has a routing list and returns the count of routingid
2089 used to show either an 'add' or 'edit' link
2096 my ($subscriptionid) = @_;
2097 my $dbh = C4::Context->dbh;
2098 my $sth = $dbh->prepare(
2099 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2100 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2101 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2104 $sth->execute($subscriptionid);
2105 my $line = $sth->fetchrow_hashref;
2106 my $result = $line->{'routingids'};
2110 =head2 addroutingmember
2114 &addroutingmember($borrowernumber,$subscriptionid)
2116 this function takes a borrowernumber and subscriptionid and add the member to the
2117 routing list for that serial subscription and gives them a rank on the list
2118 of either 1 or highest current rank + 1
2124 sub addroutingmember {
2125 my ( $borrowernumber, $subscriptionid ) = @_;
2127 my $dbh = C4::Context->dbh;
2130 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2132 $sth->execute($subscriptionid);
2133 while ( my $line = $sth->fetchrow_hashref ) {
2134 if ( $line->{'rank'} > 0 ) {
2135 $rank = $line->{'rank'} + 1;
2143 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2145 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2148 =head2 reorder_members
2152 &reorder_members($subscriptionid,$routingid,$rank)
2154 this function is used to reorder the routing list
2156 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2157 - it gets all members on list puts their routingid's into an array
2158 - removes the one in the array that is $routingid
2159 - then reinjects $routingid at point indicated by $rank
2160 - then update the database with the routingids in the new order
2166 sub reorder_members {
2167 my ( $subscriptionid, $routingid, $rank ) = @_;
2168 my $dbh = C4::Context->dbh;
2171 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2173 $sth->execute($subscriptionid);
2175 while ( my $line = $sth->fetchrow_hashref ) {
2176 push( @result, $line->{'routingid'} );
2179 # To find the matching index
2181 my $key = -1; # to allow for 0 being a valid response
2182 for ( $i = 0 ; $i < @result ; $i++ ) {
2183 if ( $routingid == $result[$i] ) {
2184 $key = $i; # save the index
2189 # if index exists in array then move it to new position
2190 if ( $key > -1 && $rank > 0 ) {
2191 my $new_rank = $rank -
2192 1; # $new_rank is what you want the new index to be in the array
2193 my $moving_item = splice( @result, $key, 1 );
2194 splice( @result, $new_rank, 0, $moving_item );
2196 for ( my $j = 0 ; $j < @result ; $j++ ) {
2198 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2200 . "' WHERE routingid = '"
2207 =head2 delroutingmember
2211 &delroutingmember($routingid,$subscriptionid)
2213 this function either deletes one member from routing list if $routingid exists otherwise
2214 deletes all members from the routing list
2220 sub delroutingmember {
2222 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2223 my ( $routingid, $subscriptionid ) = @_;
2224 my $dbh = C4::Context->dbh;
2228 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2229 $sth->execute($routingid);
2230 reorder_members( $subscriptionid, $routingid );
2235 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2236 $sth->execute($subscriptionid);
2240 =head2 getroutinglist
2244 ($count,@routinglist) = &getroutinglist($subscriptionid)
2246 this gets the info from the subscriptionroutinglist for $subscriptionid
2249 a count of the number of members on routinglist
2250 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2251 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2257 sub getroutinglist {
2258 my ($subscriptionid) = @_;
2259 my $dbh = C4::Context->dbh;
2260 my $sth = $dbh->prepare(
2261 "SELECT routingid, borrowernumber,
2262 ranking, biblionumber
2264 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2265 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2268 $sth->execute($subscriptionid);
2271 while ( my $line = $sth->fetchrow_hashref ) {
2273 push( @routinglist, $line );
2275 return ( $count, @routinglist );
2278 =head2 countissuesfrom
2282 $result = &countissuesfrom($subscriptionid,$startdate)
2289 sub countissuesfrom {
2290 my ($subscriptionid,$startdate) = @_;
2291 my $dbh = C4::Context->dbh;
2295 WHERE subscriptionid=?
2296 AND serial.publisheddate>?
2298 my $sth=$dbh->prepare($query);
2299 $sth->execute($subscriptionid, $startdate);
2300 my ($countreceived)=$sth->fetchrow;
2301 return $countreceived;
2304 =head2 abouttoexpire
2308 $result = &abouttoexpire($subscriptionid)
2310 this function alerts you to the penultimate issue for a serial subscription
2312 returns 1 - if this is the penultimate issue
2320 my ($subscriptionid) = @_;
2321 my $dbh = C4::Context->dbh;
2322 my $subscription = GetSubscription($subscriptionid);
2323 my $per = $subscription->{'periodicity'};
2325 my $expirationdate = GetExpirationDate($subscriptionid);
2328 "select max(planneddate) from serial where subscriptionid=?");
2329 $sth->execute($subscriptionid);
2330 my ($res) = $sth->fetchrow ;
2331 # warn "date expiration : ".$expirationdate." date courante ".$res;
2332 my @res=split (/-/,$res);
2333 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2334 my @endofsubscriptiondate=split(/-/,$expirationdate);
2336 if ( $per == 1 ) {$x=7;}
2337 if ( $per == 2 ) {$x=7; }
2338 if ( $per == 3 ) {$x=14;}
2339 if ( $per == 4 ) { $x = 21; }
2340 if ( $per == 5 ) { $x = 31; }
2341 if ( $per == 6 ) { $x = 62; }
2342 if ( $per == 7 || $per == 8 ) { $x = 93; }
2343 if ( $per == 9 ) { $x = 190; }
2344 if ( $per == 10 ) { $x = 365; }
2345 if ( $per == 11 ) { $x = 730; }
2346 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2347 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2348 # warn "DATE BEFORE END: $datebeforeend";
2349 return 1 if ( @res &&
2351 Delta_Days($res[0],$res[1],$res[2],
2352 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2353 (@endofsubscriptiondate &&
2354 Delta_Days($res[0],$res[1],$res[2],
2355 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2357 } elsif ($subscription->{numberlength}>0) {
2358 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2364 ($resultdate) = &GetNextDate($planneddate,$subscription)
2366 this function is an extension of GetNextDate which allows for checking for irregularity
2368 it takes the planneddate and will return the next issue's date and will skip dates if there
2369 exists an irregularity
2370 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2371 skipped then the returned date will be 2007-05-10
2374 $resultdate - then next date in the sequence
2376 Return 0 if periodicity==0
2379 sub in_array { # used in next sub down
2380 my ($val,@elements) = @_;
2381 foreach my $elem(@elements) {
2389 sub GetNextDate(@) {
2390 my ( $planneddate, $subscription ) = @_;
2391 my @irreg = split( /\,/, $subscription->{irregularity} );
2393 #date supposed to be in ISO.
2395 my ( $year, $month, $day ) = split(/-/, $planneddate);
2396 $month=1 unless ($month);
2397 $day=1 unless ($day);
2400 # warn "DOW $dayofweek";
2401 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2405 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2406 # renaming this pattern from 1/day to " n / week ".
2407 if ( $subscription->{periodicity} == 1 ) {
2408 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2409 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2411 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2412 $dayofweek = 0 if ( $dayofweek == 7 );
2413 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2414 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2418 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2422 if ( $subscription->{periodicity} == 2 ) {
2423 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2424 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2426 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2427 #FIXME: if two consecutive irreg, do we only skip one?
2428 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2429 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2430 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2433 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2437 if ( $subscription->{periodicity} == 3 ) {
2438 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2439 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2441 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2442 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2443 ### BUGFIX was previously +1 ^
2444 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2445 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2448 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2452 if ( $subscription->{periodicity} == 4 ) {
2453 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2454 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2456 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2457 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2458 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2459 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2462 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2465 my $tmpmonth=$month;
2466 if ($year && $month && $day){
2467 if ( $subscription->{periodicity} == 5 ) {
2468 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2469 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2470 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2471 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2474 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2476 if ( $subscription->{periodicity} == 6 ) {
2477 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2478 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2479 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2480 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2483 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2485 if ( $subscription->{periodicity} == 7 ) {
2486 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2487 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2488 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2489 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2492 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2494 if ( $subscription->{periodicity} == 8 ) {
2495 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2496 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2497 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2498 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2501 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2503 if ( $subscription->{periodicity} == 9 ) {
2504 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2505 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2506 ### BUFIX Seems to need more Than One ?
2507 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2508 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2511 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2513 if ( $subscription->{periodicity} == 10 ) {
2514 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2516 if ( $subscription->{periodicity} == 11 ) {
2517 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2520 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2522 # warn "dateNEXTSEQ : ".$resultdate;
2523 return "$resultdate";
2528 $item = &itemdata($barcode);
2530 Looks up the item with the given barcode, and returns a
2531 reference-to-hash containing information about that item. The keys of
2532 the hash are the fields from the C<items> and C<biblioitems> tables in
2540 my $dbh = C4::Context->dbh;
2541 my $sth = $dbh->prepare(
2542 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2545 $sth->execute($barcode);
2546 my $data = $sth->fetchrow_hashref;
2556 Koha Developement team <info@koha.org>