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} !=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} !=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,
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=?
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,
1309 my $rows=$sth->rows;
1312 logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1316 =head2 NewSubscription
1320 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1321 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1322 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1323 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1324 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1325 $numberingmethod, $status, $notes, $serialsadditems)
1327 Create a new subscription with value given on input args.
1330 the id of this new subscription
1336 sub NewSubscription {
1338 $auser, $branchcode, $aqbooksellerid, $cost,
1339 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1340 $dow, $numberlength, $weeklength, $monthlength,
1341 $add1, $every1, $whenmorethan1, $setto1,
1342 $lastvalue1, $innerloop1, $add2, $every2,
1343 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1344 $add3, $every3, $whenmorethan3, $setto3,
1345 $lastvalue3, $innerloop3, $numberingmethod, $status,
1346 $notes, $letter, $firstacquidate, $irregularity,
1347 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1348 $internalnotes, $serialsadditems,
1350 my $dbh = C4::Context->dbh;
1352 #save subscription (insert into database)
1354 INSERT INTO subscription
1355 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1356 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1357 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1358 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1359 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1360 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1361 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems)
1362 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1364 my $sth = $dbh->prepare($query);
1366 $auser, $branchcode,
1367 $aqbooksellerid, $cost,
1368 $aqbudgetid, $biblionumber,
1369 format_date_in_iso($startdate), $periodicity,
1370 $dow, $numberlength,
1371 $weeklength, $monthlength,
1373 $whenmorethan1, $setto1,
1374 $lastvalue1, $innerloop1,
1376 $whenmorethan2, $setto2,
1377 $lastvalue2, $innerloop2,
1379 $whenmorethan3, $setto3,
1380 $lastvalue3, $innerloop3,
1381 $numberingmethod, "$status",
1383 format_date_in_iso($firstacquidate), $irregularity,
1384 $numberpattern, $callnumber,
1385 $hemisphere, $manualhistory,
1386 $internalnotes, $serialsadditems,
1389 #then create the 1st waited number
1390 my $subscriptionid = $dbh->{'mysql_insertid'};
1392 INSERT INTO subscriptionhistory
1393 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1396 $sth = $dbh->prepare($query);
1397 $sth->execute( $biblionumber, $subscriptionid,
1398 format_date_in_iso($startdate),
1399 $notes,$internalnotes );
1401 # reread subscription to get a hash (for calculation of the 1st issue number)
1405 WHERE subscriptionid = ?
1407 $sth = $dbh->prepare($query);
1408 $sth->execute($subscriptionid);
1409 my $val = $sth->fetchrow_hashref;
1411 # calculate issue number
1412 my $serialseq = GetSeq($val);
1415 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1416 VALUES (?,?,?,?,?,?)
1418 $sth = $dbh->prepare($query);
1420 "$serialseq", $subscriptionid, $biblionumber, 1,
1421 format_date_in_iso($firstacquidate),
1422 format_date_in_iso($firstacquidate)
1425 logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1427 #set serial flag on biblio if not already set.
1428 my ($null, ($bib)) = GetBiblio($biblionumber);
1429 if( ! $bib->{'serial'} ) {
1430 my $record = GetMarcBiblio($biblionumber);
1431 my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1434 $record->field($tag)->update( $subf => 1 );
1437 ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1439 return $subscriptionid;
1442 =head2 ReNewSubscription
1446 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1448 this function renew a subscription with values given on input args.
1454 sub ReNewSubscription {
1455 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1456 $monthlength, $note )
1458 my $dbh = C4::Context->dbh;
1459 my $subscription = GetSubscription($subscriptionid);
1463 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1464 WHERE biblio.biblionumber=?
1466 my $sth = $dbh->prepare($query);
1467 $sth->execute( $subscription->{biblionumber} );
1468 my $biblio = $sth->fetchrow_hashref;
1469 if (C4::Context->preference("RenewSerialAddsSuggestion")){
1471 $user, $subscription->{bibliotitle},
1472 $biblio->{author}, $biblio->{publishercode},
1473 $biblio->{note}, '',
1476 $subscription->{biblionumber}
1480 # renew subscription
1483 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1484 WHERE subscriptionid=?
1486 $sth = $dbh->prepare($query);
1487 $sth->execute( format_date_in_iso($startdate),
1488 $numberlength, $weeklength, $monthlength, $subscriptionid );
1490 logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1497 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1499 Create a new issue stored on the database.
1500 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1507 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1508 $planneddate, $publisheddate, $notes )
1510 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1512 my $dbh = C4::Context->dbh;
1515 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1516 VALUES (?,?,?,?,?,?,?)
1518 my $sth = $dbh->prepare($query);
1519 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1520 $publisheddate, $planneddate,$notes );
1521 my $serialid=$dbh->{'mysql_insertid'};
1523 SELECT missinglist,recievedlist
1524 FROM subscriptionhistory
1525 WHERE subscriptionid=?
1527 $sth = $dbh->prepare($query);
1528 $sth->execute($subscriptionid);
1529 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1531 if ( $status eq 2 ) {
1532 ### TODO Add a feature that improves recognition and description.
1533 ### As such count (serialseq) i.e. : N18,2(N19),N20
1534 ### Would use substr and index But be careful to previous presence of ()
1535 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1537 if ( $status eq 4 ) {
1538 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1541 UPDATE subscriptionhistory
1542 SET recievedlist=?, missinglist=?
1543 WHERE subscriptionid=?
1545 $sth = $dbh->prepare($query);
1546 $recievedlist =~ s/^; //;
1547 $missinglist =~ s/^; //;
1548 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1552 =head2 ItemizeSerials
1556 ItemizeSerials($serialid, $info);
1557 $info is a hashref containing barcode branch, itemcallnumber, status, location
1558 $serialid the serialid
1560 1 if the itemize is a succes.
1561 0 and @error else. @error containts the list of errors found.
1567 sub ItemizeSerials {
1568 my ( $serialid, $info ) = @_;
1569 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1571 my $dbh = C4::Context->dbh;
1577 my $sth = $dbh->prepare($query);
1578 $sth->execute($serialid);
1579 my $data = $sth->fetchrow_hashref;
1580 if ( C4::Context->preference("RoutingSerials") ) {
1582 # check for existing biblioitem relating to serial issue
1583 my ( $count, @results ) =
1584 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1586 for ( my $i = 0 ; $i < $count ; $i++ ) {
1587 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1588 . $data->{'planneddate'}
1591 $bibitemno = $results[$i]->{'biblioitemnumber'};
1595 if ( $bibitemno == 0 ) {
1597 # warn "need to add new biblioitem so copy last one and make minor changes";
1600 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1602 $sth->execute( $data->{'biblionumber'} );
1603 my $biblioitem = $sth->fetchrow_hashref;
1604 $biblioitem->{'volumedate'} =
1605 format_date_in_iso( $data->{planneddate} );
1606 $biblioitem->{'volumeddesc'} =
1607 $data->{serialseq} . ' ('
1608 . format_date( $data->{'planneddate'} ) . ')';
1609 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1611 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1612 # so I comment it, we can speak of it when you want
1613 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1614 # if ( $info->{barcode} )
1615 # { # only make biblioitem if we are going to make item also
1616 # $bibitemno = newbiblioitem($biblioitem);
1621 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1622 if ( $info->{barcode} ) {
1624 my $exists = itemdata( $info->{'barcode'} );
1625 push @errors, "barcode_not_unique" if ($exists);
1627 my $marcrecord = MARC::Record->new();
1628 my ( $tag, $subfield ) =
1629 GetMarcFromKohaField( "items.barcode", $fwk );
1631 MARC::Field->new( "$tag", '', '',
1632 "$subfield" => $info->{barcode} );
1633 $marcrecord->insert_fields_ordered($newField);
1634 if ( $info->{branch} ) {
1635 my ( $tag, $subfield ) =
1636 GetMarcFromKohaField( "items.homebranch",
1639 #warn "items.homebranch : $tag , $subfield";
1640 if ( $marcrecord->field($tag) ) {
1641 $marcrecord->field($tag)
1642 ->add_subfields( "$subfield" => $info->{branch} );
1646 MARC::Field->new( "$tag", '', '',
1647 "$subfield" => $info->{branch} );
1648 $marcrecord->insert_fields_ordered($newField);
1650 ( $tag, $subfield ) =
1651 GetMarcFromKohaField( "items.holdingbranch",
1654 #warn "items.holdingbranch : $tag , $subfield";
1655 if ( $marcrecord->field($tag) ) {
1656 $marcrecord->field($tag)
1657 ->add_subfields( "$subfield" => $info->{branch} );
1661 MARC::Field->new( "$tag", '', '',
1662 "$subfield" => $info->{branch} );
1663 $marcrecord->insert_fields_ordered($newField);
1666 if ( $info->{itemcallnumber} ) {
1667 my ( $tag, $subfield ) =
1668 GetMarcFromKohaField( "items.itemcallnumber",
1671 #warn "items.itemcallnumber : $tag , $subfield";
1672 if ( $marcrecord->field($tag) ) {
1673 $marcrecord->field($tag)
1674 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1678 MARC::Field->new( "$tag", '', '',
1679 "$subfield" => $info->{itemcallnumber} );
1680 $marcrecord->insert_fields_ordered($newField);
1683 if ( $info->{notes} ) {
1684 my ( $tag, $subfield ) =
1685 GetMarcFromKohaField( "items.itemnotes", $fwk );
1687 # warn "items.itemnotes : $tag , $subfield";
1688 if ( $marcrecord->field($tag) ) {
1689 $marcrecord->field($tag)
1690 ->add_subfields( "$subfield" => $info->{notes} );
1694 MARC::Field->new( "$tag", '', '',
1695 "$subfield" => $info->{notes} );
1696 $marcrecord->insert_fields_ordered($newField);
1699 if ( $info->{location} ) {
1700 my ( $tag, $subfield ) =
1701 GetMarcFromKohaField( "items.location", $fwk );
1703 # warn "items.location : $tag , $subfield";
1704 if ( $marcrecord->field($tag) ) {
1705 $marcrecord->field($tag)
1706 ->add_subfields( "$subfield" => $info->{location} );
1710 MARC::Field->new( "$tag", '', '',
1711 "$subfield" => $info->{location} );
1712 $marcrecord->insert_fields_ordered($newField);
1715 if ( $info->{status} ) {
1716 my ( $tag, $subfield ) =
1717 GetMarcFromKohaField( "items.notforloan",
1720 # warn "items.notforloan : $tag , $subfield";
1721 if ( $marcrecord->field($tag) ) {
1722 $marcrecord->field($tag)
1723 ->add_subfields( "$subfield" => $info->{status} );
1727 MARC::Field->new( "$tag", '', '',
1728 "$subfield" => $info->{status} );
1729 $marcrecord->insert_fields_ordered($newField);
1732 if ( C4::Context->preference("RoutingSerials") ) {
1733 my ( $tag, $subfield ) =
1734 GetMarcFromKohaField( "items.dateaccessioned",
1736 if ( $marcrecord->field($tag) ) {
1737 $marcrecord->field($tag)
1738 ->add_subfields( "$subfield" => $now );
1742 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1743 $marcrecord->insert_fields_ordered($newField);
1746 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1749 return ( 0, @errors );
1753 =head2 HasSubscriptionExpired
1757 $has_expired = HasSubscriptionExpired($subscriptionid)
1759 the subscription has expired when the next issue to arrive is out of subscription limit.
1762 0 if the subscription has not expired
1763 1 if the subscription has expired
1764 2 if has subscription does not have a valid expiration date set
1770 sub HasSubscriptionExpired {
1771 my ($subscriptionid) = @_;
1772 my $dbh = C4::Context->dbh;
1773 my $subscription = GetSubscription($subscriptionid);
1774 if (($subscription->{periodicity} % 16)>0){
1775 my $expirationdate = GetExpirationDate($subscriptionid);
1777 SELECT max(planneddate)
1779 WHERE subscriptionid=?
1781 my $sth = $dbh->prepare($query);
1782 $sth->execute($subscriptionid);
1783 my ($res) = $sth->fetchrow ;
1784 my @res=split (/-/,$res);
1785 my @endofsubscriptiondate=split(/-/,$expirationdate);
1786 return 2 if (scalar(@res)!=3 || scalar(@endofsubscriptiondate)!=3||not check_date(@res) || not check_date(@endofsubscriptiondate));
1787 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1788 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1792 if ($subscription->{'numberlength'}){
1793 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1794 return 1 if ($countreceived >$subscription->{'numberlength'});
1800 return 0; # Notice that you'll never get here.
1803 =head2 DelSubscription
1807 DelSubscription($subscriptionid)
1808 this function delete the subscription which has $subscriptionid as id.
1814 sub DelSubscription {
1815 my ($subscriptionid) = @_;
1816 my $dbh = C4::Context->dbh;
1817 $subscriptionid = $dbh->quote($subscriptionid);
1818 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1820 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1821 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1823 logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1830 DelIssue($serialseq,$subscriptionid)
1831 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1838 my ( $dataissue) = @_;
1839 my $dbh = C4::Context->dbh;
1840 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1845 AND subscriptionid= ?
1847 my $mainsth = $dbh->prepare($query);
1848 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1850 #Delete element from subscription history
1851 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1852 my $sth = $dbh->prepare($query);
1853 $sth->execute($dataissue->{'subscriptionid'});
1854 my $val = $sth->fetchrow_hashref;
1855 unless ( $val->{manualhistory} ) {
1857 SELECT * FROM subscriptionhistory
1858 WHERE subscriptionid= ?
1860 my $sth = $dbh->prepare($query);
1861 $sth->execute($dataissue->{'subscriptionid'});
1862 my $data = $sth->fetchrow_hashref;
1863 my $serialseq= $dataissue->{'serialseq'};
1864 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1865 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1866 my $strsth = "UPDATE subscriptionhistory SET "
1868 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1869 . " WHERE subscriptionid=?";
1870 $sth = $dbh->prepare($strsth);
1871 $sth->execute($dataissue->{'subscriptionid'});
1874 return $mainsth->rows;
1877 =head2 GetLateOrMissingIssues
1881 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1883 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1886 a count of the number of missing issues
1887 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1888 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1894 sub GetLateOrMissingIssues {
1895 my ( $supplierid, $serialid,$order ) = @_;
1896 my $dbh = C4::Context->dbh;
1900 $byserial = "and serialid = " . $serialid;
1908 $sth = $dbh->prepare(
1917 serial.subscriptionid,
1920 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1921 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1922 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1923 WHERE subscription.subscriptionid = serial.subscriptionid
1924 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1925 AND subscription.aqbooksellerid=$supplierid
1931 $sth = $dbh->prepare(
1940 serial.subscriptionid,
1943 LEFT JOIN subscription
1944 ON serial.subscriptionid=subscription.subscriptionid
1946 ON subscription.biblionumber=biblio.biblionumber
1947 LEFT JOIN aqbooksellers
1948 ON subscription.aqbooksellerid = aqbooksellers.id
1950 subscription.subscriptionid = serial.subscriptionid
1951 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1961 while ( my $line = $sth->fetchrow_hashref ) {
1962 $odd++ unless $line->{title} eq $last_title;
1963 $last_title = $line->{title} if ( $line->{title} );
1964 $line->{planneddate} = format_date( $line->{planneddate} );
1965 $line->{claimdate} = format_date( $line->{claimdate} );
1966 $line->{"status".$line->{status}} = 1;
1967 $line->{'odd'} = 1 if $odd % 2;
1969 push @issuelist, $line;
1971 return $count, @issuelist;
1974 =head2 removeMissingIssue
1978 removeMissingIssue($subscriptionid)
1980 this function removes an issue from being part of the missing string in
1981 subscriptionlist.missinglist column
1983 called when a missing issue is found from the serials-recieve.pl file
1989 sub removeMissingIssue {
1990 my ( $sequence, $subscriptionid ) = @_;
1991 my $dbh = C4::Context->dbh;
1994 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1995 $sth->execute($subscriptionid);
1996 my $data = $sth->fetchrow_hashref;
1997 my $missinglist = $data->{'missinglist'};
1998 my $missinglistbefore = $missinglist;
2000 # warn $missinglist." before";
2001 $missinglist =~ s/($sequence)//;
2003 # warn $missinglist." after";
2004 if ( $missinglist ne $missinglistbefore ) {
2005 $missinglist =~ s/\|\s\|/\|/g;
2006 $missinglist =~ s/^\| //g;
2007 $missinglist =~ s/\|$//g;
2008 my $sth2 = $dbh->prepare(
2009 "UPDATE subscriptionhistory
2011 WHERE subscriptionid = ?"
2013 $sth2->execute( $missinglist, $subscriptionid );
2021 &updateClaim($serialid)
2023 this function updates the time when a claim is issued for late/missing items
2025 called from claims.pl file
2032 my ($serialid) = @_;
2033 my $dbh = C4::Context->dbh;
2034 my $sth = $dbh->prepare(
2035 "UPDATE serial SET claimdate = now()
2039 $sth->execute($serialid);
2042 =head2 getsupplierbyserialid
2046 ($result) = &getsupplierbyserialid($serialid)
2048 this function is used to find the supplier id given a serial id
2051 hashref containing serialid, subscriptionid, and aqbooksellerid
2057 sub getsupplierbyserialid {
2058 my ($serialid) = @_;
2059 my $dbh = C4::Context->dbh;
2060 my $sth = $dbh->prepare(
2061 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2063 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2067 $sth->execute($serialid);
2068 my $line = $sth->fetchrow_hashref;
2069 my $result = $line->{'aqbooksellerid'};
2073 =head2 check_routing
2077 ($result) = &check_routing($subscriptionid)
2079 this function checks to see if a serial has a routing list and returns the count of routingid
2080 used to show either an 'add' or 'edit' link
2087 my ($subscriptionid) = @_;
2088 my $dbh = C4::Context->dbh;
2089 my $sth = $dbh->prepare(
2090 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2091 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2092 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2095 $sth->execute($subscriptionid);
2096 my $line = $sth->fetchrow_hashref;
2097 my $result = $line->{'routingids'};
2101 =head2 addroutingmember
2105 &addroutingmember($borrowernumber,$subscriptionid)
2107 this function takes a borrowernumber and subscriptionid and add the member to the
2108 routing list for that serial subscription and gives them a rank on the list
2109 of either 1 or highest current rank + 1
2115 sub addroutingmember {
2116 my ( $borrowernumber, $subscriptionid ) = @_;
2118 my $dbh = C4::Context->dbh;
2121 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2123 $sth->execute($subscriptionid);
2124 while ( my $line = $sth->fetchrow_hashref ) {
2125 if ( $line->{'rank'} > 0 ) {
2126 $rank = $line->{'rank'} + 1;
2134 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2136 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2139 =head2 reorder_members
2143 &reorder_members($subscriptionid,$routingid,$rank)
2145 this function is used to reorder the routing list
2147 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2148 - it gets all members on list puts their routingid's into an array
2149 - removes the one in the array that is $routingid
2150 - then reinjects $routingid at point indicated by $rank
2151 - then update the database with the routingids in the new order
2157 sub reorder_members {
2158 my ( $subscriptionid, $routingid, $rank ) = @_;
2159 my $dbh = C4::Context->dbh;
2162 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2164 $sth->execute($subscriptionid);
2166 while ( my $line = $sth->fetchrow_hashref ) {
2167 push( @result, $line->{'routingid'} );
2170 # To find the matching index
2172 my $key = -1; # to allow for 0 being a valid response
2173 for ( $i = 0 ; $i < @result ; $i++ ) {
2174 if ( $routingid == $result[$i] ) {
2175 $key = $i; # save the index
2180 # if index exists in array then move it to new position
2181 if ( $key > -1 && $rank > 0 ) {
2182 my $new_rank = $rank -
2183 1; # $new_rank is what you want the new index to be in the array
2184 my $moving_item = splice( @result, $key, 1 );
2185 splice( @result, $new_rank, 0, $moving_item );
2187 for ( my $j = 0 ; $j < @result ; $j++ ) {
2189 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2191 . "' WHERE routingid = '"
2198 =head2 delroutingmember
2202 &delroutingmember($routingid,$subscriptionid)
2204 this function either deletes one member from routing list if $routingid exists otherwise
2205 deletes all members from the routing list
2211 sub delroutingmember {
2213 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2214 my ( $routingid, $subscriptionid ) = @_;
2215 my $dbh = C4::Context->dbh;
2219 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2220 $sth->execute($routingid);
2221 reorder_members( $subscriptionid, $routingid );
2226 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2227 $sth->execute($subscriptionid);
2231 =head2 getroutinglist
2235 ($count,@routinglist) = &getroutinglist($subscriptionid)
2237 this gets the info from the subscriptionroutinglist for $subscriptionid
2240 a count of the number of members on routinglist
2241 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2242 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2248 sub getroutinglist {
2249 my ($subscriptionid) = @_;
2250 my $dbh = C4::Context->dbh;
2251 my $sth = $dbh->prepare(
2252 "SELECT routingid, borrowernumber,
2253 ranking, biblionumber
2255 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2256 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2259 $sth->execute($subscriptionid);
2262 while ( my $line = $sth->fetchrow_hashref ) {
2264 push( @routinglist, $line );
2266 return ( $count, @routinglist );
2269 =head2 countissuesfrom
2273 $result = &countissuesfrom($subscriptionid,$startdate)
2280 sub countissuesfrom {
2281 my ($subscriptionid,$startdate) = @_;
2282 my $dbh = C4::Context->dbh;
2286 WHERE subscriptionid=?
2287 AND serial.publisheddate>?
2289 my $sth=$dbh->prepare($query);
2290 $sth->execute($subscriptionid, $startdate);
2291 my ($countreceived)=$sth->fetchrow;
2292 return $countreceived;
2295 =head2 abouttoexpire
2299 $result = &abouttoexpire($subscriptionid)
2301 this function alerts you to the penultimate issue for a serial subscription
2303 returns 1 - if this is the penultimate issue
2311 my ($subscriptionid) = @_;
2312 my $dbh = C4::Context->dbh;
2313 my $subscription = GetSubscription($subscriptionid);
2314 my $per = $subscription->{'periodicity'};
2316 my $expirationdate = GetExpirationDate($subscriptionid);
2319 "select max(planneddate) from serial where subscriptionid=?");
2320 $sth->execute($subscriptionid);
2321 my ($res) = $sth->fetchrow ;
2322 # warn "date expiration : ".$expirationdate." date courante ".$res;
2323 my @res=split /-/,$res;
2324 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2325 my @endofsubscriptiondate=split/-/,$expirationdate;
2327 if ( $per == 1 ) {$x=7;}
2328 if ( $per == 2 ) {$x=7; }
2329 if ( $per == 3 ) {$x=14;}
2330 if ( $per == 4 ) { $x = 21; }
2331 if ( $per == 5 ) { $x = 31; }
2332 if ( $per == 6 ) { $x = 62; }
2333 if ( $per == 7 || $per == 8 ) { $x = 93; }
2334 if ( $per == 9 ) { $x = 190; }
2335 if ( $per == 10 ) { $x = 365; }
2336 if ( $per == 11 ) { $x = 730; }
2337 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2338 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2339 # warn "DATE BEFORE END: $datebeforeend";
2340 return 1 if ( @res &&
2342 Delta_Days($res[0],$res[1],$res[2],
2343 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2344 (@endofsubscriptiondate &&
2345 Delta_Days($res[0],$res[1],$res[2],
2346 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2348 } elsif ($subscription->{numberlength}>0) {
2349 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2355 ($resultdate) = &GetNextDate($planneddate,$subscription)
2357 this function is an extension of GetNextDate which allows for checking for irregularity
2359 it takes the planneddate and will return the next issue's date and will skip dates if there
2360 exists an irregularity
2361 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2362 skipped then the returned date will be 2007-05-10
2365 $resultdate - then next date in the sequence
2367 Return 0 if periodicity==0
2370 sub in_array { # used in next sub down
2371 my ($val,@elements) = @_;
2372 foreach my $elem(@elements) {
2380 sub GetNextDate(@) {
2381 my ( $planneddate, $subscription ) = @_;
2382 my @irreg = split( /\,/, $subscription->{irregularity} );
2384 #date supposed to be in ISO.
2386 my ( $year, $month, $day ) = split(/-/, $planneddate);
2387 $month=1 unless ($month);
2388 $day=1 unless ($day);
2391 # warn "DOW $dayofweek";
2392 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2396 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2397 # renaming this pattern from 1/day to " n / week ".
2398 if ( $subscription->{periodicity} == 1 ) {
2399 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2400 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2402 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2403 $dayofweek = 0 if ( $dayofweek == 7 );
2404 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2405 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2409 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2413 if ( $subscription->{periodicity} == 2 ) {
2414 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2415 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2417 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2418 #FIXME: if two consecutive irreg, do we only skip one?
2419 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2420 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2421 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2424 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2428 if ( $subscription->{periodicity} == 3 ) {
2429 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2430 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2432 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2433 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2434 ### BUGFIX was previously +1 ^
2435 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2436 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2439 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2443 if ( $subscription->{periodicity} == 4 ) {
2444 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2445 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2447 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2448 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2449 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2450 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2453 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2456 my $tmpmonth=$month;
2457 if ($year && $month && $day){
2458 if ( $subscription->{periodicity} == 5 ) {
2459 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2460 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2461 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2462 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2465 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2467 if ( $subscription->{periodicity} == 6 ) {
2468 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2469 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2470 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2471 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2474 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2476 if ( $subscription->{periodicity} == 7 ) {
2477 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2478 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2479 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2480 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2483 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2485 if ( $subscription->{periodicity} == 8 ) {
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} == 9 ) {
2495 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2496 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2497 ### BUFIX Seems to need more Than One ?
2498 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2499 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2502 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2504 if ( $subscription->{periodicity} == 10 ) {
2505 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2507 if ( $subscription->{periodicity} == 11 ) {
2508 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2511 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2513 # warn "dateNEXTSEQ : ".$resultdate;
2514 return "$resultdate";
2519 $item = &itemdata($barcode);
2521 Looks up the item with the given barcode, and returns a
2522 reference-to-hash containing information about that item. The keys of
2523 the hash are the fields from the C<items> and C<biblioitems> tables in
2531 my $dbh = C4::Context->dbh;
2532 my $sth = $dbh->prepare(
2533 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2536 $sth->execute($barcode);
2537 my $data = $sth->fetchrow_hashref;
2547 Koha Developement team <info@koha.org>