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 ) = @_;
323 my $dbh = C4::Context->dbh;
324 $date = strftime("%Y-%m-%d",localtime) unless ($date);
326 UPDATE serial SET claimdate=$date,status=7
327 WHERE serialid in ".join (",",@$serialids);
329 my $rq = $dbh->prepare($query);
334 =head2 GetSubscription
338 $subs = GetSubscription($subscriptionid)
339 this function get the subscription which has $subscriptionid as id.
341 a hashref. This hash containts
342 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
348 sub GetSubscription {
349 my ($subscriptionid) = @_;
350 my $dbh = C4::Context->dbh;
352 SELECT subscription.*,
353 subscriptionhistory.*,
354 subscriptionhistory.enddate as histenddate,
356 aqbooksellers.name AS aqbooksellername,
357 biblio.title AS bibliotitle,
358 subscription.biblionumber as bibnum);
359 if (C4::Context->preference('IndependantBranches') &&
360 C4::Context->userenv &&
361 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
363 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
367 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
368 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
369 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
370 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
371 WHERE subscription.subscriptionid = ?
373 # if (C4::Context->preference('IndependantBranches') &&
374 # C4::Context->userenv &&
375 # C4::Context->userenv->{'flags'} != 1){
376 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
377 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
379 $debug and warn "query : $query\nsubsid :$subscriptionid";
380 my $sth = $dbh->prepare($query);
381 $sth->execute($subscriptionid);
382 return $sth->fetchrow_hashref;
385 =head2 GetFullSubscription
389 \@res = GetFullSubscription($subscriptionid)
390 this function read on serial table.
396 sub GetFullSubscription {
397 my ($subscriptionid) = @_;
398 my $dbh = C4::Context->dbh;
400 SELECT serial.serialid,
403 serial.publisheddate,
405 serial.notes as notes,
406 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
407 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
408 biblio.title as bibliotitle,
409 subscription.branchcode AS branchcode,
410 subscription.subscriptionid AS subscriptionid |;
411 if (C4::Context->preference('IndependantBranches') &&
412 C4::Context->userenv &&
413 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
415 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
419 LEFT JOIN subscription ON
420 (serial.subscriptionid=subscription.subscriptionid )
421 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
422 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
423 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
424 WHERE serial.subscriptionid = ?
426 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
427 serial.subscriptionid
429 $debug and warn "GetFullSubscription query: $query";
430 my $sth = $dbh->prepare($query);
431 $sth->execute($subscriptionid);
432 return $sth->fetchall_arrayref({});
436 =head2 PrepareSerialsData
440 \@res = PrepareSerialsData($serialinfomation)
441 where serialinformation is a hashref array
447 sub PrepareSerialsData{
453 my $aqbooksellername;
457 my $previousnote = "";
459 foreach my $subs ( @$lines ) {
460 $subs->{'publisheddate'} =
461 ( $subs->{'publisheddate'}
462 ? format_date( $subs->{'publisheddate'} )
464 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
465 $subs->{ "status" . $subs->{'status'} } = 1;
467 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
468 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
469 $year = $subs->{'year'};
474 if ( $tmpresults{$year} ) {
475 push @{ $tmpresults{$year}->{'serials'} }, $subs;
478 $tmpresults{$year} = {
481 # 'startdate'=>format_date($subs->{'startdate'}),
482 'aqbooksellername' => $subs->{'aqbooksellername'},
483 'bibliotitle' => $subs->{'bibliotitle'},
484 'serials' => [$subs],
486 # 'branchcode' => $subs->{'branchcode'},
487 # 'subscriptionid' => $subs->{'subscriptionid'},
491 # $previousnote=$subs->{notes};
493 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
494 push @res, $tmpresults{$key};
496 $res[0]->{'first'}=1;
500 =head2 GetSubscriptionsFromBiblionumber
502 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
503 this function get the subscription list. it reads on subscription table.
505 table of subscription which has the biblionumber given on input arg.
506 each line of this table is a hashref. All hashes containt
507 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
511 sub GetSubscriptionsFromBiblionumber {
512 my ($biblionumber) = @_;
513 my $dbh = C4::Context->dbh;
515 SELECT subscription.*,
517 subscriptionhistory.*,
518 subscriptionhistory.enddate as histenddate,
520 aqbooksellers.name AS aqbooksellername,
521 biblio.title AS bibliotitle
523 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
524 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
525 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
526 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
527 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
528 WHERE subscription.biblionumber = ?
530 # if (C4::Context->preference('IndependantBranches') &&
531 # C4::Context->userenv &&
532 # C4::Context->userenv->{'flags'} != 1){
533 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
535 my $sth = $dbh->prepare($query);
536 $sth->execute($biblionumber);
538 while ( my $subs = $sth->fetchrow_hashref ) {
539 $subs->{startdate} = format_date( $subs->{startdate} );
540 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
541 $subs->{histenddate} = format_date( $subs->{histenddate} );
542 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
543 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
544 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
545 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
546 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
547 $subs->{ "status" . $subs->{'status'} } = 1;
548 $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
549 C4::Context->userenv &&
550 C4::Context->userenv->{flags} % 2 !=1 &&
551 C4::Context->userenv->{branch} && $subs->{branchcode} &&
552 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
553 if ( $subs->{enddate} eq '0000-00-00' ) {
554 $subs->{enddate} = '';
557 $subs->{enddate} = format_date( $subs->{enddate} );
559 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
560 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
566 =head2 GetFullSubscriptionsFromBiblionumber
570 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
571 this function read on serial table.
577 sub GetFullSubscriptionsFromBiblionumber {
578 my ($biblionumber) = @_;
579 my $dbh = C4::Context->dbh;
581 SELECT serial.serialid,
584 serial.publisheddate,
586 serial.notes as notes,
587 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
588 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
589 biblio.title as bibliotitle,
590 subscription.branchcode AS branchcode,
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 biblio on biblio.biblionumber=subscription.biblionumber
606 WHERE subscription.biblionumber = ?
608 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
609 serial.subscriptionid
611 my $sth = $dbh->prepare($query);
612 $sth->execute($biblionumber);
613 return $sth->fetchall_arrayref({});
616 =head2 GetSubscriptions
620 @results = GetSubscriptions($title,$ISSN,$biblionumber);
621 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
623 a table of hashref. Each hash containt the subscription.
629 sub GetSubscriptions {
630 my ( $title, $ISSN, $biblionumber ) = @_;
631 #return unless $title or $ISSN or $biblionumber;
632 my $dbh = C4::Context->dbh;
636 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
638 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
639 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
640 WHERE biblio.biblionumber=?
642 $query.=" ORDER BY title";
643 $debug and warn "GetSubscriptions query: $query";
644 $sth = $dbh->prepare($query);
645 $sth->execute($biblionumber);
648 if ( $ISSN and $title ) {
650 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
652 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
653 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
654 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
655 $query.=" ORDER BY title";
656 $debug and warn "GetSubscriptions query: $query";
657 $sth = $dbh->prepare($query);
658 $sth->execute( $ISSN );
663 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
665 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
666 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
667 WHERE biblioitems.issn LIKE ?
669 $query.=" ORDER BY title";
670 $debug and warn "GetSubscriptions query: $query";
671 $sth = $dbh->prepare($query);
672 $sth->execute( "%" . $ISSN . "%" );
676 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
678 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
679 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
681 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
683 $query.=" ORDER BY title";
684 $debug and warn "GetSubscriptions query: $query";
685 $sth = $dbh->prepare($query);
691 my $previoustitle = "";
693 while ( my $line = $sth->fetchrow_hashref ) {
694 if ( $previoustitle eq $line->{title} ) {
699 $previoustitle = $line->{title};
702 $line->{toggle} = 1 if $odd == 1;
703 $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
704 C4::Context->userenv &&
705 C4::Context->userenv->{flags} % 2 !=1 &&
706 C4::Context->userenv->{branch} && $line->{branchcode} &&
707 (C4::Context->userenv->{branch} ne $line->{branchcode}));
708 push @results, $line;
717 ($totalissues,@serials) = GetSerials($subscriptionid);
718 this function get every serial not arrived for a given subscription
719 as well as the number of issues registered in the database (all types)
720 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
722 FIXME: We should return \@serials.
729 my ($subscriptionid,$count) = @_;
730 my $dbh = C4::Context->dbh;
732 # status = 2 is "arrived"
734 $count=5 unless ($count);
737 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
739 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
740 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
741 my $sth = $dbh->prepare($query);
742 $sth->execute($subscriptionid);
743 while ( my $line = $sth->fetchrow_hashref ) {
744 $line->{ "status" . $line->{status} } =
745 1; # fills a "statusX" value, used for template status select list
746 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
747 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
748 push @serials, $line;
750 # OK, now add the last 5 issues arrives/missing
752 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
754 WHERE subscriptionid = ?
755 AND (status in (2,4,5))
756 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
758 $sth = $dbh->prepare($query);
759 $sth->execute($subscriptionid);
760 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
762 $line->{ "status" . $line->{status} } =
763 1; # fills a "statusX" value, used for template status select list
764 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
765 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
766 push @serials, $line;
769 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
770 $sth = $dbh->prepare($query);
771 $sth->execute($subscriptionid);
772 my ($totalissues) = $sth->fetchrow;
773 return ( $totalissues, @serials );
780 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
781 this function get every serial waited for a given subscription
782 as well as the number of issues registered in the database (all types)
783 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
789 my ($subscription,$status) = @_;
790 my $dbh = C4::Context->dbh;
792 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
794 WHERE subscriptionid=$subscription AND status IN ($status)
795 ORDER BY publisheddate,serialid DESC
797 $debug and warn "GetSerials2 query: $query";
798 my $sth=$dbh->prepare($query);
801 while(my $line = $sth->fetchrow_hashref) {
802 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
803 $line->{"planneddate"} = format_date($line->{"planneddate"});
804 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
807 my ($totalissues) = scalar(@serials);
808 return ($totalissues,@serials);
811 =head2 GetLatestSerials
815 \@serials = GetLatestSerials($subscriptionid,$limit)
816 get the $limit's latest serials arrived or missing for a given subscription
818 a ref to a table which it containts all of the latest serials stored into a hash.
824 sub GetLatestSerials {
825 my ( $subscriptionid, $limit ) = @_;
826 my $dbh = C4::Context->dbh;
828 # status = 2 is "arrived"
829 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
831 WHERE subscriptionid = ?
832 AND (status =2 or status=4)
833 ORDER BY publisheddate DESC LIMIT 0,$limit
835 my $sth = $dbh->prepare($strsth);
836 $sth->execute($subscriptionid);
838 while ( my $line = $sth->fetchrow_hashref ) {
839 $line->{ "status" . $line->{status} } =
840 1; # fills a "statusX" value, used for template status select list
841 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
842 push @serials, $line;
848 # WHERE subscriptionid=?
850 # $sth=$dbh->prepare($query);
851 # $sth->execute($subscriptionid);
852 # my ($totalissues) = $sth->fetchrow;
861 $val is a hashref containing all the attributes of the table 'subscription'
862 This function get the next issue for the subscription given on input arg
864 all the input params updated.
872 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
873 # $calculated = $val->{numberingmethod};
874 # # calculate the (expected) value of the next issue recieved.
875 # $newlastvalue1 = $val->{lastvalue1};
876 # # check if we have to increase the new value.
877 # $newinnerloop1 = $val->{innerloop1}+1;
878 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
879 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
880 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
881 # $calculated =~ s/\{X\}/$newlastvalue1/g;
883 # $newlastvalue2 = $val->{lastvalue2};
884 # # check if we have to increase the new value.
885 # $newinnerloop2 = $val->{innerloop2}+1;
886 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
887 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
888 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
889 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
891 # $newlastvalue3 = $val->{lastvalue3};
892 # # check if we have to increase the new value.
893 # $newinnerloop3 = $val->{innerloop3}+1;
894 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
895 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
896 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
897 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
898 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
904 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
905 $newinnerloop1, $newinnerloop2, $newinnerloop3
907 my $pattern = $val->{numberpattern};
908 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
909 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
910 $calculated = $val->{numberingmethod};
911 $newlastvalue1 = $val->{lastvalue1};
912 $newlastvalue2 = $val->{lastvalue2};
913 $newlastvalue3 = $val->{lastvalue3};
914 $newlastvalue1 = $val->{lastvalue1};
915 # check if we have to increase the new value.
916 $newinnerloop1 = $val->{innerloop1} + 1;
917 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
918 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
919 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
920 $calculated =~ s/\{X\}/$newlastvalue1/g;
922 $newlastvalue2 = $val->{lastvalue2};
923 # check if we have to increase the new value.
924 $newinnerloop2 = $val->{innerloop2} + 1;
925 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
926 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
927 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
928 if ( $pattern == 6 ) {
929 if ( $val->{hemisphere} == 2 ) {
930 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
931 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
934 my $newlastvalue2seq = $seasons[$newlastvalue2];
935 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
939 $calculated =~ s/\{Y\}/$newlastvalue2/g;
943 $newlastvalue3 = $val->{lastvalue3};
944 # check if we have to increase the new value.
945 $newinnerloop3 = $val->{innerloop3} + 1;
946 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
947 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
948 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
949 $calculated =~ s/\{Z\}/$newlastvalue3/g;
951 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
952 $newinnerloop1, $newinnerloop2, $newinnerloop3);
959 $calculated = GetSeq($val)
960 $val is a hashref containing all the attributes of the table 'subscription'
961 this function transforms {X},{Y},{Z} to 150,0,0 for example.
963 the sequence in integer format
971 my $pattern = $val->{numberpattern};
972 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
973 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
974 my $calculated = $val->{numberingmethod};
975 my $x = $val->{'lastvalue1'};
976 $calculated =~ s/\{X\}/$x/g;
977 my $newlastvalue2 = $val->{'lastvalue2'};
978 if ( $pattern == 6 ) {
979 if ( $val->{hemisphere} == 2 ) {
980 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
981 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
984 my $newlastvalue2seq = $seasons[$newlastvalue2];
985 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
989 $calculated =~ s/\{Y\}/$newlastvalue2/g;
991 my $z = $val->{'lastvalue3'};
992 $calculated =~ s/\{Z\}/$z/g;
996 =head2 GetExpirationDate
998 $sensddate = GetExpirationDate($subscriptionid)
1000 this function return the expiration date for a subscription given on input args.
1007 sub GetExpirationDate {
1008 my ($subscriptionid) = @_;
1009 my $dbh = C4::Context->dbh;
1010 my $subscription = GetSubscription($subscriptionid);
1011 my $enddate = $subscription->{startdate};
1013 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1014 if (($subscription->{periodicity} % 16) >0){
1015 if ( $subscription->{numberlength} ) {
1016 #calculate the date of the last issue.
1017 my $length = $subscription->{numberlength};
1018 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1019 $enddate = GetNextDate( $enddate, $subscription );
1022 elsif ( $subscription->{monthlength} ){
1023 my @date=split (/-/,$subscription->{startdate});
1024 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1025 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1026 } elsif ( $subscription->{weeklength} ){
1027 my @date=split (/-/,$subscription->{startdate});
1028 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1029 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1037 =head2 CountSubscriptionFromBiblionumber
1041 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1042 this count the number of subscription for a biblionumber given.
1044 the number of subscriptions with biblionumber given on input arg.
1050 sub CountSubscriptionFromBiblionumber {
1051 my ($biblionumber) = @_;
1052 my $dbh = C4::Context->dbh;
1053 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1054 my $sth = $dbh->prepare($query);
1055 $sth->execute($biblionumber);
1056 my $subscriptionsnumber = $sth->fetchrow;
1057 return $subscriptionsnumber;
1060 =head2 ModSubscriptionHistory
1064 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1066 this function modify the history of a subscription. Put your new values on input arg.
1072 sub ModSubscriptionHistory {
1074 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1075 $missinglist, $opacnote, $librariannote
1077 my $dbh = C4::Context->dbh;
1078 my $query = "UPDATE subscriptionhistory
1079 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1080 WHERE subscriptionid=?
1082 my $sth = $dbh->prepare($query);
1083 $recievedlist =~ s/^; //;
1084 $missinglist =~ s/^; //;
1085 $opacnote =~ s/^; //;
1087 $histstartdate, $enddate, $recievedlist, $missinglist,
1088 $opacnote, $librariannote, $subscriptionid
1093 =head2 ModSerialStatus
1097 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1099 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1100 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1106 sub ModSerialStatus {
1107 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1110 #It is a usual serial
1111 # 1st, get previous status :
1112 my $dbh = C4::Context->dbh;
1113 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1114 my $sth = $dbh->prepare($query);
1115 $sth->execute($serialid);
1116 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1118 # change status & update subscriptionhistory
1120 if ( $status eq 6 ) {
1121 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1125 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1126 $sth = $dbh->prepare($query);
1127 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1128 $notes, $serialid );
1129 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1130 $sth = $dbh->prepare($query);
1131 $sth->execute($subscriptionid);
1132 my $val = $sth->fetchrow_hashref;
1133 unless ( $val->{manualhistory} ) {
1135 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1136 $sth = $dbh->prepare($query);
1137 $sth->execute($subscriptionid);
1138 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1139 if ( $status eq 2 ) {
1141 $recievedlist .= "; $serialseq"
1142 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1145 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1146 $missinglist .= "; $serialseq"
1148 and not index( "$missinglist", "$serialseq" ) >= 0 );
1149 $missinglist .= "; not issued $serialseq"
1151 and index( "$missinglist", "$serialseq" ) >= 0 );
1153 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1154 $sth = $dbh->prepare($query);
1155 $recievedlist =~ s/^; //;
1156 $missinglist =~ s/^; //;
1157 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1161 # create new waited entry if needed (ie : was a "waited" and has changed)
1162 if ( $oldstatus eq 1 && $status ne 1 ) {
1163 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1164 $sth = $dbh->prepare($query);
1165 $sth->execute($subscriptionid);
1166 my $val = $sth->fetchrow_hashref;
1171 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1172 $newinnerloop1, $newinnerloop2, $newinnerloop3
1173 ) = GetNextSeq($val);
1174 # warn "Next Seq End";
1176 # next date (calculated from actual date & frequency parameters)
1177 # warn "publisheddate :$publisheddate ";
1178 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1179 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1180 1, $nextpublisheddate, $nextpublisheddate );
1182 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1183 WHERE subscriptionid = ?";
1184 $sth = $dbh->prepare($query);
1186 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1187 $newinnerloop2, $newinnerloop3, $subscriptionid
1190 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1191 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1192 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1197 =head2 GetNextExpected
1201 $nextexpected = GetNextExpected($subscriptionid)
1203 Get the planneddate for the current expected issue of the subscription.
1209 planneddate => C4::Dates object
1216 sub GetNextExpected($) {
1217 my ($subscriptionid) = @_;
1218 my $dbh = C4::Context->dbh;
1219 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1220 # Each subscription has only one 'expected' issue, with serial.status==1.
1221 $sth->execute( $subscriptionid, 1 );
1222 my ( $nextissue ) = $sth->fetchrow_hashref;
1224 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1225 $sth->execute( $subscriptionid );
1226 $nextissue = $sth->fetchrow_hashref;
1228 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1232 =head2 ModNextExpected
1236 ModNextExpected($subscriptionid,$date)
1238 Update the planneddate for the current expected issue of the subscription.
1239 This will modify all future prediction results.
1241 C<$date> is a C4::Dates object.
1247 sub ModNextExpected($$) {
1248 my ($subscriptionid,$date) = @_;
1249 my $dbh = C4::Context->dbh;
1250 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1251 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1252 # Each subscription has only one 'expected' issue, with serial.status==1.
1253 $sth->execute( $date->output('iso'),$date->output('iso'), $subscriptionid, 1);
1258 =head2 ModSubscription
1262 this function modify a subscription. Put all new values on input args.
1268 sub ModSubscription {
1270 $auser, $branchcode, $aqbooksellerid, $cost,
1271 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1272 $dow, $irregularity, $numberpattern, $numberlength,
1273 $weeklength, $monthlength, $add1, $every1,
1274 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1275 $add2, $every2, $whenmorethan2, $setto2,
1276 $lastvalue2, $innerloop2, $add3, $every3,
1277 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1278 $numberingmethod, $status, $biblionumber, $callnumber,
1279 $notes, $letter, $hemisphere, $manualhistory,
1280 $internalnotes, $serialsadditems,$subscriptionid,
1281 $staffdisplaycount,$opacdisplaycount, $graceperiod, $location
1283 # warn $irregularity;
1284 my $dbh = C4::Context->dbh;
1285 my $query = "UPDATE subscription
1286 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1287 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, 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=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1292 WHERE subscriptionid = ?";
1293 #warn "query :".$query;
1294 my $sth = $dbh->prepare($query);
1296 $auser, $branchcode, $aqbooksellerid, $cost,
1297 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1298 $dow, "$irregularity", $numberpattern, $numberlength,
1299 $weeklength, $monthlength, $add1, $every1,
1300 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1301 $add2, $every2, $whenmorethan2, $setto2,
1302 $lastvalue2, $innerloop2, $add3, $every3,
1303 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1304 $numberingmethod, $status, $biblionumber, $callnumber,
1305 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1306 $internalnotes, $serialsadditems,
1307 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location,
1310 my $rows=$sth->rows;
1313 logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1317 =head2 NewSubscription
1321 $subscriptionid = &NewSubscription($auser,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, $serialsadditems,
1327 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location);
1329 Create a new subscription with value given on input args.
1332 the id of this new subscription
1338 sub NewSubscription {
1340 $auser, $branchcode, $aqbooksellerid, $cost,
1341 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1342 $dow, $numberlength, $weeklength, $monthlength,
1343 $add1, $every1, $whenmorethan1, $setto1,
1344 $lastvalue1, $innerloop1, $add2, $every2,
1345 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1346 $add3, $every3, $whenmorethan3, $setto3,
1347 $lastvalue3, $innerloop3, $numberingmethod, $status,
1348 $notes, $letter, $firstacquidate, $irregularity,
1349 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1350 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1351 $graceperiod, $location
1353 my $dbh = C4::Context->dbh;
1355 #save subscription (insert into database)
1357 INSERT INTO subscription
1358 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1359 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1360 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1361 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1362 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1363 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1364 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1365 staffdisplaycount,opacdisplaycount,graceperiod,location)
1366 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1368 my $sth = $dbh->prepare($query);
1370 $auser, $branchcode,
1371 $aqbooksellerid, $cost,
1372 $aqbudgetid, $biblionumber,
1373 format_date_in_iso($startdate), $periodicity,
1374 $dow, $numberlength,
1375 $weeklength, $monthlength,
1377 $whenmorethan1, $setto1,
1378 $lastvalue1, $innerloop1,
1380 $whenmorethan2, $setto2,
1381 $lastvalue2, $innerloop2,
1383 $whenmorethan3, $setto3,
1384 $lastvalue3, $innerloop3,
1385 $numberingmethod, "$status",
1387 format_date_in_iso($firstacquidate), $irregularity,
1388 $numberpattern, $callnumber,
1389 $hemisphere, $manualhistory,
1390 $internalnotes, $serialsadditems,
1391 $staffdisplaycount, $opacdisplaycount,
1392 $graceperiod, $location,
1395 #then create the 1st waited number
1396 my $subscriptionid = $dbh->{'mysql_insertid'};
1398 INSERT INTO subscriptionhistory
1399 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1402 $sth = $dbh->prepare($query);
1403 $sth->execute( $biblionumber, $subscriptionid,
1404 format_date_in_iso($startdate),
1405 $notes,$internalnotes );
1407 # reread subscription to get a hash (for calculation of the 1st issue number)
1411 WHERE subscriptionid = ?
1413 $sth = $dbh->prepare($query);
1414 $sth->execute($subscriptionid);
1415 my $val = $sth->fetchrow_hashref;
1417 # calculate issue number
1418 my $serialseq = GetSeq($val);
1421 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1422 VALUES (?,?,?,?,?,?)
1424 $sth = $dbh->prepare($query);
1426 "$serialseq", $subscriptionid, $biblionumber, 1,
1427 format_date_in_iso($firstacquidate),
1428 format_date_in_iso($firstacquidate)
1431 logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1433 #set serial flag on biblio if not already set.
1434 my ($null, ($bib)) = GetBiblio($biblionumber);
1435 if( ! $bib->{'serial'} ) {
1436 my $record = GetMarcBiblio($biblionumber);
1437 my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1440 $record->field($tag)->update( $subf => 1 );
1443 ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1445 return $subscriptionid;
1448 =head2 ReNewSubscription
1452 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1454 this function renew a subscription with values given on input args.
1460 sub ReNewSubscription {
1461 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1462 $monthlength, $note )
1464 my $dbh = C4::Context->dbh;
1465 my $subscription = GetSubscription($subscriptionid);
1469 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1470 WHERE biblio.biblionumber=?
1472 my $sth = $dbh->prepare($query);
1473 $sth->execute( $subscription->{biblionumber} );
1474 my $biblio = $sth->fetchrow_hashref;
1475 if (C4::Context->preference("RenewSerialAddsSuggestion")){
1477 $user, $subscription->{bibliotitle},
1478 $biblio->{author}, $biblio->{publishercode},
1479 $biblio->{note}, '',
1482 $subscription->{biblionumber}
1486 # renew subscription
1489 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1490 WHERE subscriptionid=?
1492 $sth = $dbh->prepare($query);
1493 $sth->execute( format_date_in_iso($startdate),
1494 $numberlength, $weeklength, $monthlength, $subscriptionid );
1496 logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1503 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1505 Create a new issue stored on the database.
1506 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1513 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1514 $planneddate, $publisheddate, $notes )
1516 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1518 my $dbh = C4::Context->dbh;
1521 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1522 VALUES (?,?,?,?,?,?,?)
1524 my $sth = $dbh->prepare($query);
1525 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1526 $publisheddate, $planneddate,$notes );
1527 my $serialid=$dbh->{'mysql_insertid'};
1529 SELECT missinglist,recievedlist
1530 FROM subscriptionhistory
1531 WHERE subscriptionid=?
1533 $sth = $dbh->prepare($query);
1534 $sth->execute($subscriptionid);
1535 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1537 if ( $status eq 2 ) {
1538 ### TODO Add a feature that improves recognition and description.
1539 ### As such count (serialseq) i.e. : N18,2(N19),N20
1540 ### Would use substr and index But be careful to previous presence of ()
1541 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1543 if ( $status eq 4 ) {
1544 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1547 UPDATE subscriptionhistory
1548 SET recievedlist=?, missinglist=?
1549 WHERE subscriptionid=?
1551 $sth = $dbh->prepare($query);
1552 $recievedlist =~ s/^; //;
1553 $missinglist =~ s/^; //;
1554 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1558 =head2 ItemizeSerials
1562 ItemizeSerials($serialid, $info);
1563 $info is a hashref containing barcode branch, itemcallnumber, status, location
1564 $serialid the serialid
1566 1 if the itemize is a succes.
1567 0 and @error else. @error containts the list of errors found.
1573 sub ItemizeSerials {
1574 my ( $serialid, $info ) = @_;
1575 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1577 my $dbh = C4::Context->dbh;
1583 my $sth = $dbh->prepare($query);
1584 $sth->execute($serialid);
1585 my $data = $sth->fetchrow_hashref;
1586 if ( C4::Context->preference("RoutingSerials") ) {
1588 # check for existing biblioitem relating to serial issue
1589 my ( $count, @results ) =
1590 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1592 for ( my $i = 0 ; $i < $count ; $i++ ) {
1593 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1594 . $data->{'planneddate'}
1597 $bibitemno = $results[$i]->{'biblioitemnumber'};
1601 if ( $bibitemno == 0 ) {
1603 # warn "need to add new biblioitem so copy last one and make minor changes";
1606 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1608 $sth->execute( $data->{'biblionumber'} );
1609 my $biblioitem = $sth->fetchrow_hashref;
1610 $biblioitem->{'volumedate'} =
1611 format_date_in_iso( $data->{planneddate} );
1612 $biblioitem->{'volumeddesc'} =
1613 $data->{serialseq} . ' ('
1614 . format_date( $data->{'planneddate'} ) . ')';
1615 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1617 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1618 # so I comment it, we can speak of it when you want
1619 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1620 # if ( $info->{barcode} )
1621 # { # only make biblioitem if we are going to make item also
1622 # $bibitemno = newbiblioitem($biblioitem);
1627 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1628 if ( $info->{barcode} ) {
1630 my $exists = itemdata( $info->{'barcode'} );
1631 push @errors, "barcode_not_unique" if ($exists);
1633 my $marcrecord = MARC::Record->new();
1634 my ( $tag, $subfield ) =
1635 GetMarcFromKohaField( "items.barcode", $fwk );
1637 MARC::Field->new( "$tag", '', '',
1638 "$subfield" => $info->{barcode} );
1639 $marcrecord->insert_fields_ordered($newField);
1640 if ( $info->{branch} ) {
1641 my ( $tag, $subfield ) =
1642 GetMarcFromKohaField( "items.homebranch",
1645 #warn "items.homebranch : $tag , $subfield";
1646 if ( $marcrecord->field($tag) ) {
1647 $marcrecord->field($tag)
1648 ->add_subfields( "$subfield" => $info->{branch} );
1652 MARC::Field->new( "$tag", '', '',
1653 "$subfield" => $info->{branch} );
1654 $marcrecord->insert_fields_ordered($newField);
1656 ( $tag, $subfield ) =
1657 GetMarcFromKohaField( "items.holdingbranch",
1660 #warn "items.holdingbranch : $tag , $subfield";
1661 if ( $marcrecord->field($tag) ) {
1662 $marcrecord->field($tag)
1663 ->add_subfields( "$subfield" => $info->{branch} );
1667 MARC::Field->new( "$tag", '', '',
1668 "$subfield" => $info->{branch} );
1669 $marcrecord->insert_fields_ordered($newField);
1672 if ( $info->{itemcallnumber} ) {
1673 my ( $tag, $subfield ) =
1674 GetMarcFromKohaField( "items.itemcallnumber",
1677 #warn "items.itemcallnumber : $tag , $subfield";
1678 if ( $marcrecord->field($tag) ) {
1679 $marcrecord->field($tag)
1680 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1684 MARC::Field->new( "$tag", '', '',
1685 "$subfield" => $info->{itemcallnumber} );
1686 $marcrecord->insert_fields_ordered($newField);
1689 if ( $info->{notes} ) {
1690 my ( $tag, $subfield ) =
1691 GetMarcFromKohaField( "items.itemnotes", $fwk );
1693 # warn "items.itemnotes : $tag , $subfield";
1694 if ( $marcrecord->field($tag) ) {
1695 $marcrecord->field($tag)
1696 ->add_subfields( "$subfield" => $info->{notes} );
1700 MARC::Field->new( "$tag", '', '',
1701 "$subfield" => $info->{notes} );
1702 $marcrecord->insert_fields_ordered($newField);
1705 if ( $info->{location} ) {
1706 my ( $tag, $subfield ) =
1707 GetMarcFromKohaField( "items.location", $fwk );
1709 # warn "items.location : $tag , $subfield";
1710 if ( $marcrecord->field($tag) ) {
1711 $marcrecord->field($tag)
1712 ->add_subfields( "$subfield" => $info->{location} );
1716 MARC::Field->new( "$tag", '', '',
1717 "$subfield" => $info->{location} );
1718 $marcrecord->insert_fields_ordered($newField);
1721 if ( $info->{status} ) {
1722 my ( $tag, $subfield ) =
1723 GetMarcFromKohaField( "items.notforloan",
1726 # warn "items.notforloan : $tag , $subfield";
1727 if ( $marcrecord->field($tag) ) {
1728 $marcrecord->field($tag)
1729 ->add_subfields( "$subfield" => $info->{status} );
1733 MARC::Field->new( "$tag", '', '',
1734 "$subfield" => $info->{status} );
1735 $marcrecord->insert_fields_ordered($newField);
1738 if ( C4::Context->preference("RoutingSerials") ) {
1739 my ( $tag, $subfield ) =
1740 GetMarcFromKohaField( "items.dateaccessioned",
1742 if ( $marcrecord->field($tag) ) {
1743 $marcrecord->field($tag)
1744 ->add_subfields( "$subfield" => $now );
1748 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1749 $marcrecord->insert_fields_ordered($newField);
1752 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1755 return ( 0, @errors );
1759 =head2 HasSubscriptionExpired
1763 $has_expired = HasSubscriptionExpired($subscriptionid)
1765 the subscription has expired when the next issue to arrive is out of subscription limit.
1768 0 if the subscription has not expired
1769 1 if the subscription has expired
1770 2 if has subscription does not have a valid expiration date set
1776 sub HasSubscriptionExpired {
1777 my ($subscriptionid) = @_;
1778 my $dbh = C4::Context->dbh;
1779 my $subscription = GetSubscription($subscriptionid);
1780 if (($subscription->{periodicity} % 16)>0){
1781 my $expirationdate = GetExpirationDate($subscriptionid);
1783 SELECT max(planneddate)
1785 WHERE subscriptionid=?
1787 my $sth = $dbh->prepare($query);
1788 $sth->execute($subscriptionid);
1789 my ($res) = $sth->fetchrow ;
1790 return 0 unless $res;
1791 my @res=split (/-/,$res);
1792 my @endofsubscriptiondate=split(/-/,$expirationdate);
1793 return 2 if (scalar(@res)!=3 || scalar(@endofsubscriptiondate)!=3||not check_date(@res) || not check_date(@endofsubscriptiondate));
1794 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1795 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1799 if ($subscription->{'numberlength'}){
1800 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1801 return 1 if ($countreceived >$subscription->{'numberlength'});
1807 return 0; # Notice that you'll never get here.
1810 =head2 DelSubscription
1814 DelSubscription($subscriptionid)
1815 this function delete the subscription which has $subscriptionid as id.
1821 sub DelSubscription {
1822 my ($subscriptionid) = @_;
1823 my $dbh = C4::Context->dbh;
1824 $subscriptionid = $dbh->quote($subscriptionid);
1825 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1827 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1828 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1830 logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1837 DelIssue($serialseq,$subscriptionid)
1838 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1845 my ( $dataissue) = @_;
1846 my $dbh = C4::Context->dbh;
1847 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1852 AND subscriptionid= ?
1854 my $mainsth = $dbh->prepare($query);
1855 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1857 #Delete element from subscription history
1858 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1859 my $sth = $dbh->prepare($query);
1860 $sth->execute($dataissue->{'subscriptionid'});
1861 my $val = $sth->fetchrow_hashref;
1862 unless ( $val->{manualhistory} ) {
1864 SELECT * FROM subscriptionhistory
1865 WHERE subscriptionid= ?
1867 my $sth = $dbh->prepare($query);
1868 $sth->execute($dataissue->{'subscriptionid'});
1869 my $data = $sth->fetchrow_hashref;
1870 my $serialseq= $dataissue->{'serialseq'};
1871 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1872 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1873 my $strsth = "UPDATE subscriptionhistory SET "
1875 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1876 . " WHERE subscriptionid=?";
1877 $sth = $dbh->prepare($strsth);
1878 $sth->execute($dataissue->{'subscriptionid'});
1881 return $mainsth->rows;
1884 =head2 GetLateOrMissingIssues
1888 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1890 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1893 a count of the number of missing issues
1894 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1895 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1901 sub GetLateOrMissingIssues {
1902 my ( $supplierid, $serialid,$order ) = @_;
1903 my $dbh = C4::Context->dbh;
1907 $byserial = "and serialid = " . $serialid;
1915 $sth = $dbh->prepare(
1924 serial.subscriptionid,
1927 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1928 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1929 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1930 WHERE subscription.subscriptionid = serial.subscriptionid
1931 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1932 AND subscription.aqbooksellerid=$supplierid
1938 $sth = $dbh->prepare(
1947 serial.subscriptionid,
1950 LEFT JOIN subscription
1951 ON serial.subscriptionid=subscription.subscriptionid
1953 ON subscription.biblionumber=biblio.biblionumber
1954 LEFT JOIN aqbooksellers
1955 ON subscription.aqbooksellerid = aqbooksellers.id
1957 subscription.subscriptionid = serial.subscriptionid
1958 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1968 while ( my $line = $sth->fetchrow_hashref ) {
1969 $odd++ unless $line->{title} eq $last_title;
1970 $last_title = $line->{title} if ( $line->{title} );
1971 $line->{planneddate} = format_date( $line->{planneddate} );
1972 $line->{claimdate} = format_date( $line->{claimdate} );
1973 $line->{"status".$line->{status}} = 1;
1974 $line->{'odd'} = 1 if $odd % 2;
1976 push @issuelist, $line;
1978 return $count, @issuelist;
1981 =head2 removeMissingIssue
1985 removeMissingIssue($subscriptionid)
1987 this function removes an issue from being part of the missing string in
1988 subscriptionlist.missinglist column
1990 called when a missing issue is found from the serials-recieve.pl file
1996 sub removeMissingIssue {
1997 my ( $sequence, $subscriptionid ) = @_;
1998 my $dbh = C4::Context->dbh;
2001 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2002 $sth->execute($subscriptionid);
2003 my $data = $sth->fetchrow_hashref;
2004 my $missinglist = $data->{'missinglist'};
2005 my $missinglistbefore = $missinglist;
2007 # warn $missinglist." before";
2008 $missinglist =~ s/($sequence)//;
2010 # warn $missinglist." after";
2011 if ( $missinglist ne $missinglistbefore ) {
2012 $missinglist =~ s/\|\s\|/\|/g;
2013 $missinglist =~ s/^\| //g;
2014 $missinglist =~ s/\|$//g;
2015 my $sth2 = $dbh->prepare(
2016 "UPDATE subscriptionhistory
2018 WHERE subscriptionid = ?"
2020 $sth2->execute( $missinglist, $subscriptionid );
2028 &updateClaim($serialid)
2030 this function updates the time when a claim is issued for late/missing items
2032 called from claims.pl file
2039 my ($serialid) = @_;
2040 my $dbh = C4::Context->dbh;
2041 my $sth = $dbh->prepare(
2042 "UPDATE serial SET claimdate = now()
2046 $sth->execute($serialid);
2049 =head2 getsupplierbyserialid
2053 ($result) = &getsupplierbyserialid($serialid)
2055 this function is used to find the supplier id given a serial id
2058 hashref containing serialid, subscriptionid, and aqbooksellerid
2064 sub getsupplierbyserialid {
2065 my ($serialid) = @_;
2066 my $dbh = C4::Context->dbh;
2067 my $sth = $dbh->prepare(
2068 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2070 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2074 $sth->execute($serialid);
2075 my $line = $sth->fetchrow_hashref;
2076 my $result = $line->{'aqbooksellerid'};
2080 =head2 check_routing
2084 ($result) = &check_routing($subscriptionid)
2086 this function checks to see if a serial has a routing list and returns the count of routingid
2087 used to show either an 'add' or 'edit' link
2094 my ($subscriptionid) = @_;
2095 my $dbh = C4::Context->dbh;
2096 my $sth = $dbh->prepare(
2097 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2098 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2099 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2102 $sth->execute($subscriptionid);
2103 my $line = $sth->fetchrow_hashref;
2104 my $result = $line->{'routingids'};
2108 =head2 addroutingmember
2112 &addroutingmember($borrowernumber,$subscriptionid)
2114 this function takes a borrowernumber and subscriptionid and add the member to the
2115 routing list for that serial subscription and gives them a rank on the list
2116 of either 1 or highest current rank + 1
2122 sub addroutingmember {
2123 my ( $borrowernumber, $subscriptionid ) = @_;
2125 my $dbh = C4::Context->dbh;
2128 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2130 $sth->execute($subscriptionid);
2131 while ( my $line = $sth->fetchrow_hashref ) {
2132 if ( $line->{'rank'} > 0 ) {
2133 $rank = $line->{'rank'} + 1;
2141 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2143 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2146 =head2 reorder_members
2150 &reorder_members($subscriptionid,$routingid,$rank)
2152 this function is used to reorder the routing list
2154 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2155 - it gets all members on list puts their routingid's into an array
2156 - removes the one in the array that is $routingid
2157 - then reinjects $routingid at point indicated by $rank
2158 - then update the database with the routingids in the new order
2164 sub reorder_members {
2165 my ( $subscriptionid, $routingid, $rank ) = @_;
2166 my $dbh = C4::Context->dbh;
2169 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2171 $sth->execute($subscriptionid);
2173 while ( my $line = $sth->fetchrow_hashref ) {
2174 push( @result, $line->{'routingid'} );
2177 # To find the matching index
2179 my $key = -1; # to allow for 0 being a valid response
2180 for ( $i = 0 ; $i < @result ; $i++ ) {
2181 if ( $routingid == $result[$i] ) {
2182 $key = $i; # save the index
2187 # if index exists in array then move it to new position
2188 if ( $key > -1 && $rank > 0 ) {
2189 my $new_rank = $rank -
2190 1; # $new_rank is what you want the new index to be in the array
2191 my $moving_item = splice( @result, $key, 1 );
2192 splice( @result, $new_rank, 0, $moving_item );
2194 for ( my $j = 0 ; $j < @result ; $j++ ) {
2196 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2198 . "' WHERE routingid = '"
2205 =head2 delroutingmember
2209 &delroutingmember($routingid,$subscriptionid)
2211 this function either deletes one member from routing list if $routingid exists otherwise
2212 deletes all members from the routing list
2218 sub delroutingmember {
2220 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2221 my ( $routingid, $subscriptionid ) = @_;
2222 my $dbh = C4::Context->dbh;
2226 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2227 $sth->execute($routingid);
2228 reorder_members( $subscriptionid, $routingid );
2233 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2234 $sth->execute($subscriptionid);
2238 =head2 getroutinglist
2242 ($count,@routinglist) = &getroutinglist($subscriptionid)
2244 this gets the info from the subscriptionroutinglist for $subscriptionid
2247 a count of the number of members on routinglist
2248 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2249 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2255 sub getroutinglist {
2256 my ($subscriptionid) = @_;
2257 my $dbh = C4::Context->dbh;
2258 my $sth = $dbh->prepare(
2259 "SELECT routingid, borrowernumber,
2260 ranking, biblionumber
2262 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2263 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2266 $sth->execute($subscriptionid);
2269 while ( my $line = $sth->fetchrow_hashref ) {
2271 push( @routinglist, $line );
2273 return ( $count, @routinglist );
2276 =head2 countissuesfrom
2280 $result = &countissuesfrom($subscriptionid,$startdate)
2287 sub countissuesfrom {
2288 my ($subscriptionid,$startdate) = @_;
2289 my $dbh = C4::Context->dbh;
2293 WHERE subscriptionid=?
2294 AND serial.publisheddate>?
2296 my $sth=$dbh->prepare($query);
2297 $sth->execute($subscriptionid, $startdate);
2298 my ($countreceived)=$sth->fetchrow;
2299 return $countreceived;
2302 =head2 abouttoexpire
2306 $result = &abouttoexpire($subscriptionid)
2308 this function alerts you to the penultimate issue for a serial subscription
2310 returns 1 - if this is the penultimate issue
2318 my ($subscriptionid) = @_;
2319 my $dbh = C4::Context->dbh;
2320 my $subscription = GetSubscription($subscriptionid);
2321 my $per = $subscription->{'periodicity'};
2323 my $expirationdate = GetExpirationDate($subscriptionid);
2326 "select max(planneddate) from serial where subscriptionid=?");
2327 $sth->execute($subscriptionid);
2328 my ($res) = $sth->fetchrow ;
2329 # warn "date expiration : ".$expirationdate." date courante ".$res;
2330 my @res=split (/-/,$res);
2331 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2332 my @endofsubscriptiondate=split(/-/,$expirationdate);
2334 if ( $per == 1 ) {$x=7;}
2335 if ( $per == 2 ) {$x=7; }
2336 if ( $per == 3 ) {$x=14;}
2337 if ( $per == 4 ) { $x = 21; }
2338 if ( $per == 5 ) { $x = 31; }
2339 if ( $per == 6 ) { $x = 62; }
2340 if ( $per == 7 || $per == 8 ) { $x = 93; }
2341 if ( $per == 9 ) { $x = 190; }
2342 if ( $per == 10 ) { $x = 365; }
2343 if ( $per == 11 ) { $x = 730; }
2344 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2345 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2346 # warn "DATE BEFORE END: $datebeforeend";
2347 return 1 if ( @res &&
2349 Delta_Days($res[0],$res[1],$res[2],
2350 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2351 (@endofsubscriptiondate &&
2352 Delta_Days($res[0],$res[1],$res[2],
2353 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2355 } elsif ($subscription->{numberlength}>0) {
2356 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2362 ($resultdate) = &GetNextDate($planneddate,$subscription)
2364 this function is an extension of GetNextDate which allows for checking for irregularity
2366 it takes the planneddate and will return the next issue's date and will skip dates if there
2367 exists an irregularity
2368 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2369 skipped then the returned date will be 2007-05-10
2372 $resultdate - then next date in the sequence
2374 Return 0 if periodicity==0
2377 sub in_array { # used in next sub down
2378 my ($val,@elements) = @_;
2379 foreach my $elem(@elements) {
2387 sub GetNextDate(@) {
2388 my ( $planneddate, $subscription ) = @_;
2389 my @irreg = split( /\,/, $subscription->{irregularity} );
2391 #date supposed to be in ISO.
2393 my ( $year, $month, $day ) = split(/-/, $planneddate);
2394 $month=1 unless ($month);
2395 $day=1 unless ($day);
2398 # warn "DOW $dayofweek";
2399 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2403 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2404 # renaming this pattern from 1/day to " n / week ".
2405 if ( $subscription->{periodicity} == 1 ) {
2406 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2407 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2409 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2410 $dayofweek = 0 if ( $dayofweek == 7 );
2411 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2412 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2416 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2420 if ( $subscription->{periodicity} == 2 ) {
2421 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2422 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2424 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2425 #FIXME: if two consecutive irreg, do we only skip one?
2426 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2427 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2428 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2431 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2435 if ( $subscription->{periodicity} == 3 ) {
2436 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2437 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2439 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2440 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2441 ### BUGFIX was previously +1 ^
2442 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2443 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2446 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2450 if ( $subscription->{periodicity} == 4 ) {
2451 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2452 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2454 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2455 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2456 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2457 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2460 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2463 my $tmpmonth=$month;
2464 if ($year && $month && $day){
2465 if ( $subscription->{periodicity} == 5 ) {
2466 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2467 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2468 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2469 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2472 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2474 if ( $subscription->{periodicity} == 6 ) {
2475 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2476 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2477 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2478 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2481 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2483 if ( $subscription->{periodicity} == 7 ) {
2484 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2485 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2486 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2487 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2490 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2492 if ( $subscription->{periodicity} == 8 ) {
2493 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2494 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2495 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2496 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2499 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2501 if ( $subscription->{periodicity} == 9 ) {
2502 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2503 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2504 ### BUFIX Seems to need more Than One ?
2505 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2506 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2509 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2511 if ( $subscription->{periodicity} == 10 ) {
2512 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2514 if ( $subscription->{periodicity} == 11 ) {
2515 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2518 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2520 # warn "dateNEXTSEQ : ".$resultdate;
2521 return "$resultdate";
2526 $item = &itemdata($barcode);
2528 Looks up the item with the given barcode, and returns a
2529 reference-to-hash containing information about that item. The keys of
2530 the hash are the fields from the C<items> and C<biblioitems> tables in
2538 my $dbh = C4::Context->dbh;
2539 my $sth = $dbh->prepare(
2540 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2543 $sth->execute($barcode);
2544 my $data = $sth->fetchrow_hashref;
2554 Koha Developement team <info@koha.org>