3 # Copyright 2000-2002 Katipo Communications
4 # Parts Copyright 2010 Biblibre
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 use C4::Dates qw(format_date format_date_in_iso);
24 use Date::Calc qw(:all);
25 use POSIX qw(strftime);
33 use C4::Log; # logaction
36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
39 $VERSION = 3.01; # set version for version checking
43 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
44 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
45 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
46 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
48 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
49 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
50 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
51 &GetSerialInformation &AddItem2Serial
52 &PrepareSerialsData &GetNextExpected &ModNextExpected
54 &UpdateClaimdateIssues
55 &GetSuppliersWithLateIssues &getsupplierbyserialid
56 &GetDistributedTo &SetDistributedTo
57 &getroutinglist &delroutingmember &addroutingmember
59 &check_routing &updateClaim &removeMissingIssue
68 C4::Serials - Serials Module Functions
76 Functions for handling subscriptions, claims routing etc.
81 =head2 GetSuppliersWithLateIssues
83 $supplierlist = GetSuppliersWithLateIssues()
85 this function get all suppliers with late issues.
88 an array_ref of suppliers each entry is a hash_ref containing id and name
89 the array is in name order
93 sub GetSuppliersWithLateIssues {
94 my $dbh = C4::Context->dbh;
96 SELECT DISTINCT id, name
98 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
99 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
100 WHERE id > 0 AND ((planneddate < now() AND serial.status=1) OR serial.STATUS = 3 OR serial.STATUS = 4) ORDER BY name|;
101 return $dbh->selectall_arrayref($query, { Slice => {} });
106 @issuelist = GetLateIssues($supplierid)
108 this function selects late issues from the database
111 the issuelist as an array. Each element of this array contains a hashi_ref containing
112 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
117 my ($supplierid) = @_;
118 my $dbh = C4::Context->dbh;
122 SELECT name,title,planneddate,serialseq,serial.subscriptionid
124 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
125 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
126 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
127 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
128 AND subscription.aqbooksellerid=?
131 $sth = $dbh->prepare($query);
132 $sth->execute($supplierid);
135 SELECT name,title,planneddate,serialseq,serial.subscriptionid
137 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
138 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
139 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
140 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
143 $sth = $dbh->prepare($query);
149 while ( my $line = $sth->fetchrow_hashref ) {
150 $odd++ unless $line->{title} eq $last_title;
151 $line->{title} = "" if $line->{title} eq $last_title;
152 $last_title = $line->{title} if ( $line->{title} );
153 $line->{planneddate} = format_date( $line->{planneddate} );
154 push @issuelist, $line;
159 =head2 GetSubscriptionHistoryFromSubscriptionId
161 $sth = GetSubscriptionHistoryFromSubscriptionId()
162 this function prepares the SQL request and returns the statement handle
163 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
167 sub GetSubscriptionHistoryFromSubscriptionId() {
168 my $dbh = C4::Context->dbh;
171 FROM subscriptionhistory
172 WHERE subscriptionid = ?
174 return $dbh->prepare($query);
177 =head2 GetSerialStatusFromSerialId
179 $sth = GetSerialStatusFromSerialId();
180 this function returns a statement handle
181 After this function, don't forget to execute it by using $sth->execute($serialid)
183 $sth = $dbh->prepare($query).
187 sub GetSerialStatusFromSerialId() {
188 my $dbh = C4::Context->dbh;
194 return $dbh->prepare($query);
197 =head2 GetSerialInformation
200 $data = GetSerialInformation($serialid);
201 returns a hash_ref containing :
202 items : items marcrecord (can be an array)
204 subscription table field
205 + information about subscription expiration
209 sub GetSerialInformation {
211 my $dbh = C4::Context->dbh;
213 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
214 if ( C4::Context->preference('IndependantBranches')
215 && C4::Context->userenv
216 && C4::Context->userenv->{'flags'} != 1
217 && C4::Context->userenv->{'branch'} ) {
219 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
222 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
225 my $rq = $dbh->prepare($query);
226 $rq->execute($serialid);
227 my $data = $rq->fetchrow_hashref;
229 # create item information if we have serialsadditems for this subscription
230 if ( $data->{'serialsadditems'} ) {
231 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
232 $queryitem->execute($serialid);
233 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
234 if ( scalar(@$itemnumbers) > 0 ) {
235 foreach my $itemnum (@$itemnumbers) {
237 #It is ASSUMED that GetMarcItem ALWAYS WORK...
238 #Maybe GetMarcItem should return values on failure
239 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
240 my $itemprocessed = PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
241 $itemprocessed->{'itemnumber'} = $itemnum->[0];
242 $itemprocessed->{'itemid'} = $itemnum->[0];
243 $itemprocessed->{'serialid'} = $serialid;
244 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
245 push @{ $data->{'items'} }, $itemprocessed;
248 my $itemprocessed = PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
249 $itemprocessed->{'itemid'} = "N$serialid";
250 $itemprocessed->{'serialid'} = $serialid;
251 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
252 $itemprocessed->{'countitems'} = 0;
253 push @{ $data->{'items'} }, $itemprocessed;
256 $data->{ "status" . $data->{'serstatus'} } = 1;
257 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
258 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
262 =head2 AddItem2Serial
264 $rows = AddItem2Serial($serialid,$itemnumber);
265 Adds an itemnumber to Serial record
266 returns the number of rows affected
271 my ( $serialid, $itemnumber ) = @_;
272 my $dbh = C4::Context->dbh;
273 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
274 $rq->execute( $serialid, $itemnumber );
278 =head2 UpdateClaimdateIssues
280 UpdateClaimdateIssues($serialids,[$date]);
282 Update Claimdate for issues in @$serialids list with date $date
287 sub UpdateClaimdateIssues {
288 my ( $serialids, $date ) = @_;
289 my $dbh = C4::Context->dbh;
290 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
292 UPDATE serial SET claimdate = ?, status = 7
293 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
294 my $rq = $dbh->prepare($query);
295 $rq->execute($date, @$serialids);
299 =head2 GetSubscription
301 $subs = GetSubscription($subscriptionid)
302 this function returns the subscription which has $subscriptionid as id.
304 a hashref. This hash containts
305 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
309 sub GetSubscription {
310 my ($subscriptionid) = @_;
311 my $dbh = C4::Context->dbh;
313 SELECT subscription.*,
314 subscriptionhistory.*,
315 aqbooksellers.name AS aqbooksellername,
316 biblio.title AS bibliotitle,
317 subscription.biblionumber as bibnum);
318 if ( C4::Context->preference('IndependantBranches')
319 && C4::Context->userenv
320 && C4::Context->userenv->{'flags'} != 1
321 && C4::Context->userenv->{'branch'} ) {
323 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
327 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
328 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
329 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
330 WHERE subscription.subscriptionid = ?
333 # if (C4::Context->preference('IndependantBranches') &&
334 # C4::Context->userenv &&
335 # C4::Context->userenv->{'flags'} != 1){
336 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
337 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
339 $debug and warn "query : $query\nsubsid :$subscriptionid";
340 my $sth = $dbh->prepare($query);
341 $sth->execute($subscriptionid);
342 return $sth->fetchrow_hashref;
345 =head2 GetFullSubscription
347 $array_ref = GetFullSubscription($subscriptionid)
348 this function reads the serial table.
352 sub GetFullSubscription {
353 my ($subscriptionid) = @_;
354 my $dbh = C4::Context->dbh;
356 SELECT serial.serialid,
359 serial.publisheddate,
361 serial.notes as notes,
362 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
363 aqbooksellers.name as aqbooksellername,
364 biblio.title as bibliotitle,
365 subscription.branchcode AS branchcode,
366 subscription.subscriptionid AS subscriptionid |;
367 if ( C4::Context->preference('IndependantBranches')
368 && C4::Context->userenv
369 && C4::Context->userenv->{'flags'} != 1
370 && C4::Context->userenv->{'branch'} ) {
372 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
376 LEFT JOIN subscription ON
377 (serial.subscriptionid=subscription.subscriptionid )
378 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
379 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
380 WHERE serial.subscriptionid = ?
382 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
383 serial.subscriptionid
385 $debug and warn "GetFullSubscription query: $query";
386 my $sth = $dbh->prepare($query);
387 $sth->execute($subscriptionid);
388 return $sth->fetchall_arrayref( {} );
391 =head2 PrepareSerialsData
393 $array_ref = PrepareSerialsData($serialinfomation)
394 where serialinformation is a hashref array
398 sub PrepareSerialsData {
404 my $aqbooksellername;
408 my $previousnote = "";
410 foreach my $subs (@{$lines}) {
411 for my $datefield ( qw(publisheddate planneddate) ) {
412 # handle both undef and undef returned as 0000-00-00
413 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
414 $subs->{$datefield} = 'XXX';
417 $subs->{$datefield} = format_date( $subs->{$datefield} );
420 $subs->{'branchname'} = GetBranchName( $subs->{'branchcode'} );
421 $subs->{ "status" . $subs->{'status'} } = 1;
422 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
424 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
425 $year = $subs->{'year'};
429 if ( $tmpresults{$year} ) {
430 push @{ $tmpresults{$year}->{'serials'} }, $subs;
432 $tmpresults{$year} = {
434 'aqbooksellername' => $subs->{'aqbooksellername'},
435 'bibliotitle' => $subs->{'bibliotitle'},
436 'serials' => [$subs],
441 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
442 push @res, $tmpresults{$key};
444 $res[0]->{'first'} = 1;
448 =head2 GetSubscriptionsFromBiblionumber
450 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
451 this function get the subscription list. it reads the subscription table.
453 reference to an array of subscriptions which have the biblionumber given on input arg.
454 each element of this array is a hashref containing
455 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
459 sub GetSubscriptionsFromBiblionumber {
460 my ($biblionumber) = @_;
461 my $dbh = C4::Context->dbh;
463 SELECT subscription.*,
465 subscriptionhistory.*,
466 aqbooksellers.name AS aqbooksellername,
467 biblio.title AS bibliotitle
469 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
470 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
471 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
472 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
473 WHERE subscription.biblionumber = ?
475 my $sth = $dbh->prepare($query);
476 $sth->execute($biblionumber);
478 while ( my $subs = $sth->fetchrow_hashref ) {
479 $subs->{startdate} = format_date( $subs->{startdate} );
480 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
481 $subs->{histenddate} = format_date( $subs->{histenddate} );
482 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
483 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
484 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
485 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
486 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
487 $subs->{ "status" . $subs->{'status'} } = 1;
488 $subs->{'cannotedit'} =
489 ( C4::Context->preference('IndependantBranches')
490 && C4::Context->userenv
491 && C4::Context->userenv->{flags} % 2 != 1
492 && C4::Context->userenv->{branch}
493 && $subs->{branchcode}
494 && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
496 if ( $subs->{enddate} eq '0000-00-00' ) {
497 $subs->{enddate} = '';
499 $subs->{enddate} = format_date( $subs->{enddate} );
501 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
502 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
508 =head2 GetFullSubscriptionsFromBiblionumber
510 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
511 this function reads the serial table.
515 sub GetFullSubscriptionsFromBiblionumber {
516 my ($biblionumber) = @_;
517 my $dbh = C4::Context->dbh;
519 SELECT serial.serialid,
522 serial.publisheddate,
524 serial.notes as notes,
525 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
526 biblio.title as bibliotitle,
527 subscription.branchcode AS branchcode,
528 subscription.subscriptionid AS subscriptionid|;
529 if ( C4::Context->preference('IndependantBranches')
530 && C4::Context->userenv
531 && C4::Context->userenv->{'flags'} != 1
532 && C4::Context->userenv->{'branch'} ) {
534 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
539 LEFT JOIN subscription ON
540 (serial.subscriptionid=subscription.subscriptionid)
541 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
542 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
543 WHERE subscription.biblionumber = ?
545 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
546 serial.subscriptionid
548 my $sth = $dbh->prepare($query);
549 $sth->execute($biblionumber);
550 return $sth->fetchall_arrayref( {} );
553 =head2 GetSubscriptions
555 @results = GetSubscriptions($title,$ISSN,$biblionumber);
556 this function gets all subscriptions which have title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
558 a table of hashref. Each hash containt the subscription.
562 sub GetSubscriptions {
563 my ( $string, $issn, $biblionumber ) = @_;
565 #return unless $title or $ISSN or $biblionumber;
566 my $dbh = C4::Context->dbh;
569 SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber
571 LEFT JOIN subscriptionhistory USING(subscriptionid)
572 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
573 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
578 $sqlwhere = " WHERE biblio.biblionumber=?";
579 push @bind_params, $biblionumber;
583 my @strings_to_search;
584 @strings_to_search = map { "%$_%" } split( / /, $string );
585 foreach my $index qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes) {
586 push @bind_params, @strings_to_search;
587 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
588 $debug && warn "$tmpstring";
589 $tmpstring =~ s/^AND //;
590 push @sqlstrings, $tmpstring;
592 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "(" . join( ") OR (", @sqlstrings ) . ")";
596 my @strings_to_search;
597 @strings_to_search = map { "%$_%" } split( / /, $issn );
598 foreach my $index qw(biblioitems.issn subscription.callnumber) {
599 push @bind_params, @strings_to_search;
600 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
601 $debug && warn "$tmpstring";
602 $tmpstring =~ s/^OR //;
603 push @sqlstrings, $tmpstring;
605 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "(" . join( ") OR (", @sqlstrings ) . ")";
607 $sql .= "$sqlwhere ORDER BY title";
608 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
609 $sth = $dbh->prepare($sql);
610 $sth->execute(@bind_params);
612 my $previousbiblio = "";
615 while ( my $line = $sth->fetchrow_hashref ) {
616 if ( $previousbiblio eq $line->{biblionumber} ) {
620 $previousbiblio = $line->{biblionumber};
623 $line->{toggle} = 1 if $odd == 1;
624 $line->{'cannotedit'} =
625 ( C4::Context->preference('IndependantBranches')
626 && C4::Context->userenv
627 && C4::Context->userenv->{flags} % 2 != 1
628 && C4::Context->userenv->{branch}
629 && $line->{branchcode}
630 && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
631 push @results, $line;
638 ($totalissues,@serials) = GetSerials($subscriptionid);
639 this function gets every serial not arrived for a given subscription
640 as well as the number of issues registered in the database (all types)
641 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
643 FIXME: We should return \@serials.
648 my ( $subscriptionid, $count ) = @_;
649 my $dbh = C4::Context->dbh;
651 # status = 2 is "arrived"
653 $count = 5 unless ($count);
655 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
657 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
658 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
659 my $sth = $dbh->prepare($query);
660 $sth->execute($subscriptionid);
662 while ( my $line = $sth->fetchrow_hashref ) {
663 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
664 for my $datefield ( qw( planneddate publisheddate) ) {
665 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
666 $line->{$datefield} = format_date( $line->{$datefield});
668 $line->{$datefield} = q{};
671 push @serials, $line;
674 # OK, now add the last 5 issues arrives/missing
675 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
677 WHERE subscriptionid = ?
678 AND (status in (2,4,5))
679 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
681 $sth = $dbh->prepare($query);
682 $sth->execute($subscriptionid);
683 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
685 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
686 for my $datefield ( qw( planneddate publisheddate) ) {
687 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
688 $line->{$datefield} = format_date( $line->{$datefield});
690 $line->{$datefield} = q{};
694 push @serials, $line;
697 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
698 $sth = $dbh->prepare($query);
699 $sth->execute($subscriptionid);
700 my ($totalissues) = $sth->fetchrow;
701 return ( $totalissues, @serials );
706 @serials = GetSerials2($subscriptionid,$status);
707 this function returns every serial waited for a given subscription
708 as well as the number of issues registered in the database (all types)
709 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
714 my ( $subscription, $status ) = @_;
715 my $dbh = C4::Context->dbh;
717 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
719 WHERE subscriptionid=$subscription AND status IN ($status)
720 ORDER BY publisheddate,serialid DESC
722 $debug and warn "GetSerials2 query: $query";
723 my $sth = $dbh->prepare($query);
727 while ( my $line = $sth->fetchrow_hashref ) {
728 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
729 # Format dates for display
730 for my $datefield ( qw( planneddate publisheddate ) ) {
731 if ($line->{$datefield} =~m/^00/) {
732 $line->{$datefield} = q{};
735 $line->{$datefield} = format_date( $line->{$datefield} );
738 push @serials, $line;
743 =head2 GetLatestSerials
745 \@serials = GetLatestSerials($subscriptionid,$limit)
746 get the $limit's latest serials arrived or missing for a given subscription
748 a ref to an array which contains all of the latest serials stored into a hash.
752 sub GetLatestSerials {
753 my ( $subscriptionid, $limit ) = @_;
754 my $dbh = C4::Context->dbh;
756 # status = 2 is "arrived"
757 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
759 WHERE subscriptionid = ?
760 AND (status =2 or status=4)
761 ORDER BY planneddate DESC LIMIT 0,$limit
763 my $sth = $dbh->prepare($strsth);
764 $sth->execute($subscriptionid);
766 while ( my $line = $sth->fetchrow_hashref ) {
767 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
768 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
769 push @serials, $line;
775 =head2 GetDistributedTo
777 $distributedto=GetDistributedTo($subscriptionid)
778 This function returns the field distributedto for the subscription matching subscriptionid
782 sub GetDistributedTo {
783 my $dbh = C4::Context->dbh;
785 my $subscriptionid = @_;
786 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
787 my $sth = $dbh->prepare($query);
788 $sth->execute($subscriptionid);
789 return ($distributedto) = $sth->fetchrow;
795 $val is a hashref containing all the attributes of the table 'subscription'
796 This function get the next issue for the subscription given on input arg
798 a list containing all the input params updated.
804 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
805 # $calculated = $val->{numberingmethod};
806 # # calculate the (expected) value of the next issue recieved.
807 # $newlastvalue1 = $val->{lastvalue1};
808 # # check if we have to increase the new value.
809 # $newinnerloop1 = $val->{innerloop1}+1;
810 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
811 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
812 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
813 # $calculated =~ s/\{X\}/$newlastvalue1/g;
815 # $newlastvalue2 = $val->{lastvalue2};
816 # # check if we have to increase the new value.
817 # $newinnerloop2 = $val->{innerloop2}+1;
818 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
819 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
820 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
821 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
823 # $newlastvalue3 = $val->{lastvalue3};
824 # # check if we have to increase the new value.
825 # $newinnerloop3 = $val->{innerloop3}+1;
826 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
827 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
828 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
829 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
830 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
835 my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
836 my $pattern = $val->{numberpattern};
837 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
838 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
839 $calculated = $val->{numberingmethod};
840 $newlastvalue1 = $val->{lastvalue1};
841 $newlastvalue2 = $val->{lastvalue2};
842 $newlastvalue3 = $val->{lastvalue3};
843 $newlastvalue1 = $val->{lastvalue1};
845 # check if we have to increase the new value.
846 $newinnerloop1 = $val->{innerloop1} + 1;
847 $newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} );
848 $newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 ); # <1 to be true when 0 or empty.
849 $newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} ); # reset counter if needed.
850 $calculated =~ s/\{X\}/$newlastvalue1/g;
852 $newlastvalue2 = $val->{lastvalue2};
854 # check if we have to increase the new value.
855 $newinnerloop2 = $val->{innerloop2} + 1;
856 $newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} );
857 $newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 ); # <1 to be true when 0 or empty.
858 $newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} ); # reset counter if needed.
859 if ( $pattern == 6 ) {
860 if ( $val->{hemisphere} == 2 ) {
861 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
862 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
864 my $newlastvalue2seq = $seasons[$newlastvalue2];
865 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
868 $calculated =~ s/\{Y\}/$newlastvalue2/g;
871 $newlastvalue3 = $val->{lastvalue3};
873 # check if we have to increase the new value.
874 $newinnerloop3 = $val->{innerloop3} + 1;
875 $newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} );
876 $newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 ); # <1 to be true when 0 or empty.
877 $newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} ); # reset counter if needed.
878 $calculated =~ s/\{Z\}/$newlastvalue3/g;
880 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
885 $calculated = GetSeq($val)
886 $val is a hashref containing all the attributes of the table 'subscription'
887 this function transforms {X},{Y},{Z} to 150,0,0 for example.
889 the sequence in integer format
895 my $pattern = $val->{numberpattern};
896 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
897 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
898 my $calculated = $val->{numberingmethod};
899 my $x = $val->{'lastvalue1'};
900 $calculated =~ s/\{X\}/$x/g;
901 my $newlastvalue2 = $val->{'lastvalue2'};
903 if ( $pattern == 6 ) {
904 if ( $val->{hemisphere} == 2 ) {
905 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
906 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
908 my $newlastvalue2seq = $seasons[$newlastvalue2];
909 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
912 $calculated =~ s/\{Y\}/$newlastvalue2/g;
914 my $z = $val->{'lastvalue3'};
915 $calculated =~ s/\{Z\}/$z/g;
919 =head2 GetExpirationDate
921 $enddate = GetExpirationDate($subscriptionid, [$startdate])
923 this function return the next expiration date for a subscription given on input args.
930 sub GetExpirationDate {
931 my ( $subscriptionid, $startdate ) = @_;
932 my $dbh = C4::Context->dbh;
933 my $subscription = GetSubscription($subscriptionid);
936 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
937 $enddate = $startdate || $subscription->{startdate};
938 my @date = split( /-/, $enddate );
939 return if ( scalar(@date) != 3 || not check_date(@date) );
940 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
943 if ( my $length = $subscription->{numberlength} ) {
945 #calculate the date of the last issue.
946 for ( my $i = 1 ; $i <= $length ; $i++ ) {
947 $enddate = GetNextDate( $enddate, $subscription );
949 } elsif ( $subscription->{monthlength} ) {
950 if ( $$subscription{startdate} ) {
951 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
952 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
954 } elsif ( $subscription->{weeklength} ) {
955 if ( $$subscription{startdate} ) {
956 my @date = split( /-/, $subscription->{startdate} );
957 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
958 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
967 =head2 CountSubscriptionFromBiblionumber
969 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
970 this returns a count of the subscriptions for a given biblionumber
972 the number of subscriptions
976 sub CountSubscriptionFromBiblionumber {
977 my ($biblionumber) = @_;
978 my $dbh = C4::Context->dbh;
979 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
980 my $sth = $dbh->prepare($query);
981 $sth->execute($biblionumber);
982 my $subscriptionsnumber = $sth->fetchrow;
983 return $subscriptionsnumber;
986 =head2 ModSubscriptionHistory
988 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
990 this function modifies the history of a subscription. Put your new values on input arg.
991 returns the number of rows affected
995 sub ModSubscriptionHistory {
996 my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_;
997 my $dbh = C4::Context->dbh;
998 my $query = "UPDATE subscriptionhistory
999 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1000 WHERE subscriptionid=?
1002 my $sth = $dbh->prepare($query);
1003 $recievedlist =~ s/^; //;
1004 $missinglist =~ s/^; //;
1005 $opacnote =~ s/^; //;
1006 $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1010 =head2 ModSerialStatus
1012 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1014 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1015 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1019 sub ModSerialStatus {
1020 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1022 #It is a usual serial
1023 # 1st, get previous status :
1024 my $dbh = C4::Context->dbh;
1025 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1026 my $sth = $dbh->prepare($query);
1027 $sth->execute($serialid);
1028 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1030 # change status & update subscriptionhistory
1032 if ( $status == 6 ) {
1033 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1037 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1038 $sth = $dbh->prepare($query);
1039 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1040 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1041 $sth = $dbh->prepare($query);
1042 $sth->execute($subscriptionid);
1043 my $val = $sth->fetchrow_hashref;
1044 unless ( $val->{manualhistory} ) {
1045 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1046 $sth = $dbh->prepare($query);
1047 $sth->execute($subscriptionid);
1048 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1049 if ( $status == 2 ) {
1051 $recievedlist .= "; $serialseq"
1052 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1055 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1056 $missinglist .= "; $serialseq"
1058 and not index( "$missinglist", "$serialseq" ) >= 0 );
1059 $missinglist .= "; not issued $serialseq"
1061 and index( "$missinglist", "$serialseq" ) >= 0 );
1062 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1063 $sth = $dbh->prepare($query);
1064 $recievedlist =~ s/^; //;
1065 $missinglist =~ s/^; //;
1066 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1070 # create new waited entry if needed (ie : was a "waited" and has changed)
1071 if ( $oldstatus == 1 && $status != 1 ) {
1072 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1073 $sth = $dbh->prepare($query);
1074 $sth->execute($subscriptionid);
1075 my $val = $sth->fetchrow_hashref;
1079 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1080 $newinnerloop1, $newinnerloop2, $newinnerloop3
1081 ) = GetNextSeq($val);
1083 # next date (calculated from actual date & frequency parameters)
1084 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1085 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate );
1086 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1087 WHERE subscriptionid = ?";
1088 $sth = $dbh->prepare($query);
1089 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1091 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1092 if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) {
1093 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1099 =head2 GetNextExpected
1101 $nextexpected = GetNextExpected($subscriptionid)
1103 Get the planneddate for the current expected issue of the subscription.
1109 planneddate => C4::Dates object
1114 sub GetNextExpected($) {
1115 my ($subscriptionid) = @_;
1116 my $dbh = C4::Context->dbh;
1117 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1119 # Each subscription has only one 'expected' issue, with serial.status==1.
1120 $sth->execute( $subscriptionid, 1 );
1121 my ( $nextissue ) = $sth->fetchrow_hashref;
1123 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1124 $sth->execute( $subscriptionid );
1125 $nextissue = $sth->fetchrow_hashref;
1127 if (!defined $nextissue->{planneddate}) {
1128 # or should this default to 1st Jan ???
1129 $nextissue->{planneddate} = strftime('%Y-%m-%d',localtime);
1131 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1136 =head2 ModNextExpected
1138 ModNextExpected($subscriptionid,$date)
1140 Update the planneddate for the current expected issue of the subscription.
1141 This will modify all future prediction results.
1143 C<$date> is a C4::Dates object.
1149 sub ModNextExpected($$) {
1150 my ( $subscriptionid, $date ) = @_;
1151 my $dbh = C4::Context->dbh;
1153 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1154 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1156 # Each subscription has only one 'expected' issue, with serial.status==1.
1157 $sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 );
1162 =head2 ModSubscription
1164 this function modifies a subscription. Put all new values on input args.
1165 returns the number of rows affected
1169 sub ModSubscription {
1170 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1171 $dow, $irregularity, $numberpattern, $numberlength, $weeklength, $monthlength, $add1, $every1,
1172 $whenmorethan1, $setto1, $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2,
1173 $lastvalue2, $innerloop2, $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1174 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory,
1175 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid
1178 # warn $irregularity;
1179 my $dbh = C4::Context->dbh;
1180 my $query = "UPDATE subscription
1181 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1182 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1183 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1184 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1185 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1186 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?,
1187 letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
1188 staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1190 WHERE subscriptionid = ?";
1192 #warn "query :".$query;
1193 my $sth = $dbh->prepare($query);
1195 $auser, $branchcode, $aqbooksellerid, $cost,
1196 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1197 $dow, "$irregularity", $numberpattern, $numberlength,
1198 $weeklength, $monthlength, $add1, $every1,
1199 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1200 $add2, $every2, $whenmorethan2, $setto2,
1201 $lastvalue2, $innerloop2, $add3, $every3,
1202 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1203 $numberingmethod, $status, $biblionumber, $callnumber,
1204 $notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ),
1205 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1206 $graceperiod, $location, $enddate, $subscriptionid
1208 my $rows = $sth->rows;
1210 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1214 =head2 NewSubscription
1216 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1217 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1218 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1219 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1220 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1221 $numberingmethod, $status, $notes, $serialsadditems,
1222 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
1224 Create a new subscription with value given on input args.
1227 the id of this new subscription
1231 sub NewSubscription {
1232 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1233 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1234 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1235 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status,
1236 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1237 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1239 my $dbh = C4::Context->dbh;
1241 #save subscription (insert into database)
1243 INSERT INTO subscription
1244 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1245 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1246 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1247 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1248 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1249 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1250 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1251 staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
1252 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1254 my $sth = $dbh->prepare($query);
1256 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1257 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1258 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1259 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, "$status",
1260 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1261 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1264 my $subscriptionid = $dbh->{'mysql_insertid'};
1266 $enddate = GetExpirationDate($subscriptionid,$startdate);
1270 WHERE subscriptionid=?
1272 $sth = $dbh->prepare($query);
1273 $sth->execute( $enddate, $subscriptionid );
1275 #then create the 1st waited number
1277 INSERT INTO subscriptionhistory
1278 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1281 $sth = $dbh->prepare($query);
1282 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1284 # reread subscription to get a hash (for calculation of the 1st issue number)
1288 WHERE subscriptionid = ?
1290 $sth = $dbh->prepare($query);
1291 $sth->execute($subscriptionid);
1292 my $val = $sth->fetchrow_hashref;
1294 # calculate issue number
1295 my $serialseq = GetSeq($val);
1298 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1299 VALUES (?,?,?,?,?,?)
1301 $sth = $dbh->prepare($query);
1302 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1304 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1306 #set serial flag on biblio if not already set.
1307 my ( $null, ($bib) ) = GetBiblio($biblionumber);
1308 if ( !$bib->{'serial'} ) {
1309 my $record = GetMarcBiblio($biblionumber);
1310 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1312 eval { $record->field($tag)->update( $subf => 1 ); };
1314 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1316 return $subscriptionid;
1319 =head2 ReNewSubscription
1321 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1323 this function renew a subscription with values given on input args.
1327 sub ReNewSubscription {
1328 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1329 my $dbh = C4::Context->dbh;
1330 my $subscription = GetSubscription($subscriptionid);
1334 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1335 WHERE biblio.biblionumber=?
1337 my $sth = $dbh->prepare($query);
1338 $sth->execute( $subscription->{biblionumber} );
1339 my $biblio = $sth->fetchrow_hashref;
1341 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1344 { 'suggestedby' => $user,
1345 'title' => $subscription->{bibliotitle},
1346 'author' => $biblio->{author},
1347 'publishercode' => $biblio->{publishercode},
1348 'note' => $biblio->{note},
1349 'biblionumber' => $subscription->{biblionumber}
1354 # renew subscription
1357 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1358 WHERE subscriptionid=?
1360 $sth = $dbh->prepare($query);
1361 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1362 my $enddate = GetExpirationDate($subscriptionid);
1363 $debug && warn "enddate :$enddate";
1367 WHERE subscriptionid=?
1369 $sth = $dbh->prepare($query);
1370 $sth->execute( $enddate, $subscriptionid );
1372 UPDATE subscriptionhistory
1374 WHERE subscriptionid=?
1376 $sth = $dbh->prepare($query);
1377 $sth->execute( $enddate, $subscriptionid );
1379 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1385 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1387 Create a new issue stored on the database.
1388 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1389 returns the serial id
1394 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1395 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1397 my $dbh = C4::Context->dbh;
1400 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1401 VALUES (?,?,?,?,?,?,?)
1403 my $sth = $dbh->prepare($query);
1404 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1405 my $serialid = $dbh->{'mysql_insertid'};
1407 SELECT missinglist,recievedlist
1408 FROM subscriptionhistory
1409 WHERE subscriptionid=?
1411 $sth = $dbh->prepare($query);
1412 $sth->execute($subscriptionid);
1413 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1415 if ( $status == 2 ) {
1416 ### TODO Add a feature that improves recognition and description.
1417 ### As such count (serialseq) i.e. : N18,2(N19),N20
1418 ### Would use substr and index But be careful to previous presence of ()
1419 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1421 if ( $status == 4 ) {
1422 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1425 UPDATE subscriptionhistory
1426 SET recievedlist=?, missinglist=?
1427 WHERE subscriptionid=?
1429 $sth = $dbh->prepare($query);
1430 $recievedlist =~ s/^; //;
1431 $missinglist =~ s/^; //;
1432 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1436 =head2 ItemizeSerials
1438 ItemizeSerials($serialid, $info);
1439 $info is a hashref containing barcode branch, itemcallnumber, status, location
1440 $serialid the serialid
1442 1 if the itemize is a succes.
1443 0 and @error otherwise. @error containts the list of errors found.
1447 sub ItemizeSerials {
1448 my ( $serialid, $info ) = @_;
1449 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1451 my $dbh = C4::Context->dbh;
1457 my $sth = $dbh->prepare($query);
1458 $sth->execute($serialid);
1459 my $data = $sth->fetchrow_hashref;
1460 if ( C4::Context->preference("RoutingSerials") ) {
1462 # check for existing biblioitem relating to serial issue
1463 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1465 for ( my $i = 0 ; $i < $count ; $i++ ) {
1466 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1467 $bibitemno = $results[$i]->{'biblioitemnumber'};
1471 if ( $bibitemno == 0 ) {
1472 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1473 $sth->execute( $data->{'biblionumber'} );
1474 my $biblioitem = $sth->fetchrow_hashref;
1475 $biblioitem->{'volumedate'} = $data->{planneddate};
1476 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1477 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1481 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1482 if ( $info->{barcode} ) {
1484 my $exists = itemdata( $info->{'barcode'} );
1485 push @errors, "barcode_not_unique" if ($exists);
1487 my $marcrecord = MARC::Record->new();
1488 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1489 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1490 $marcrecord->insert_fields_ordered($newField);
1491 if ( $info->{branch} ) {
1492 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1494 #warn "items.homebranch : $tag , $subfield";
1495 if ( $marcrecord->field($tag) ) {
1496 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1498 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1499 $marcrecord->insert_fields_ordered($newField);
1501 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1503 #warn "items.holdingbranch : $tag , $subfield";
1504 if ( $marcrecord->field($tag) ) {
1505 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1507 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1508 $marcrecord->insert_fields_ordered($newField);
1511 if ( $info->{itemcallnumber} ) {
1512 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1514 if ( $marcrecord->field($tag) ) {
1515 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1517 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1518 $marcrecord->insert_fields_ordered($newField);
1521 if ( $info->{notes} ) {
1522 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1524 if ( $marcrecord->field($tag) ) {
1525 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1527 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1528 $marcrecord->insert_fields_ordered($newField);
1531 if ( $info->{location} ) {
1532 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1534 if ( $marcrecord->field($tag) ) {
1535 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1537 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1538 $marcrecord->insert_fields_ordered($newField);
1541 if ( $info->{status} ) {
1542 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1544 if ( $marcrecord->field($tag) ) {
1545 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1547 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1548 $marcrecord->insert_fields_ordered($newField);
1551 if ( C4::Context->preference("RoutingSerials") ) {
1552 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1553 if ( $marcrecord->field($tag) ) {
1554 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1556 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1557 $marcrecord->insert_fields_ordered($newField);
1560 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1563 return ( 0, @errors );
1567 =head2 HasSubscriptionStrictlyExpired
1569 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1571 the subscription has stricly expired when today > the end subscription date
1574 1 if true, 0 if false, -1 if the expiration date is not set.
1578 sub HasSubscriptionStrictlyExpired {
1580 # Getting end of subscription date
1581 my ($subscriptionid) = @_;
1582 my $dbh = C4::Context->dbh;
1583 my $subscription = GetSubscription($subscriptionid);
1584 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1586 # If the expiration date is set
1587 if ( $expirationdate != 0 ) {
1588 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1590 # Getting today's date
1591 my ( $nowyear, $nowmonth, $nowday ) = Today();
1593 # if today's date > expiration date, then the subscription has stricly expired
1594 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1601 # There are some cases where the expiration date is not set
1602 # As we can't determine if the subscription has expired on a date-basis,
1608 =head2 HasSubscriptionExpired
1610 $has_expired = HasSubscriptionExpired($subscriptionid)
1612 the subscription has expired when the next issue to arrive is out of subscription limit.
1615 0 if the subscription has not expired
1616 1 if the subscription has expired
1617 2 if has subscription does not have a valid expiration date set
1621 sub HasSubscriptionExpired {
1622 my ($subscriptionid) = @_;
1623 my $dbh = C4::Context->dbh;
1624 my $subscription = GetSubscription($subscriptionid);
1625 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1626 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1627 if (!defined $expirationdate) {
1628 $expirationdate = q{};
1631 SELECT max(planneddate)
1633 WHERE subscriptionid=?
1635 my $sth = $dbh->prepare($query);
1636 $sth->execute($subscriptionid);
1637 my ($res) = $sth->fetchrow;
1638 return 0 unless $res;
1639 my @res = split( /-/, $res );
1640 my @endofsubscriptiondate = split( /-/, $expirationdate );
1641 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1643 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1647 if ( $subscription->{'numberlength'} ) {
1648 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1649 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1655 return 0; # Notice that you'll never get here.
1658 =head2 SetDistributedto
1660 SetDistributedto($distributedto,$subscriptionid);
1661 This function update the value of distributedto for a subscription given on input arg.
1665 sub SetDistributedto {
1666 my ( $distributedto, $subscriptionid ) = @_;
1667 my $dbh = C4::Context->dbh;
1671 WHERE subscriptionid=?
1673 my $sth = $dbh->prepare($query);
1674 $sth->execute( $distributedto, $subscriptionid );
1678 =head2 DelSubscription
1680 DelSubscription($subscriptionid)
1681 this function deletes subscription which has $subscriptionid as id.
1685 sub DelSubscription {
1686 my ($subscriptionid) = @_;
1687 my $dbh = C4::Context->dbh;
1688 $subscriptionid = $dbh->quote($subscriptionid);
1689 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1690 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1691 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1693 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1698 DelIssue($serialseq,$subscriptionid)
1699 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1701 returns the number of rows affected
1706 my ($dataissue) = @_;
1707 my $dbh = C4::Context->dbh;
1708 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1713 AND subscriptionid= ?
1715 my $mainsth = $dbh->prepare($query);
1716 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1718 #Delete element from subscription history
1719 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1720 my $sth = $dbh->prepare($query);
1721 $sth->execute( $dataissue->{'subscriptionid'} );
1722 my $val = $sth->fetchrow_hashref;
1723 unless ( $val->{manualhistory} ) {
1725 SELECT * FROM subscriptionhistory
1726 WHERE subscriptionid= ?
1728 my $sth = $dbh->prepare($query);
1729 $sth->execute( $dataissue->{'subscriptionid'} );
1730 my $data = $sth->fetchrow_hashref;
1731 my $serialseq = $dataissue->{'serialseq'};
1732 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1733 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1734 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1735 $sth = $dbh->prepare($strsth);
1736 $sth->execute( $dataissue->{'subscriptionid'} );
1739 return $mainsth->rows;
1742 =head2 GetLateOrMissingIssues
1744 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1746 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1749 the issuelist as an array of hash refs. Each element of this array contains
1750 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1754 sub GetLateOrMissingIssues {
1755 my ( $supplierid, $serialid, $order ) = @_;
1756 my $dbh = C4::Context->dbh;
1760 $byserial = "and serialid = " . $serialid;
1763 $order .= ", title";
1768 $sth = $dbh->prepare(
1770 serialid, aqbooksellerid, name,
1771 biblio.title, planneddate, serialseq,
1772 serial.status, serial.subscriptionid, claimdate,
1773 subscription.branchcode
1775 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1776 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1777 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1778 WHERE subscription.subscriptionid = serial.subscriptionid
1779 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1780 AND subscription.aqbooksellerid=$supplierid
1785 $sth = $dbh->prepare(
1787 serialid, aqbooksellerid, name,
1788 biblio.title, planneddate, serialseq,
1789 serial.status, serial.subscriptionid, claimdate,
1790 subscription.branchcode
1792 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1793 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1794 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1795 WHERE subscription.subscriptionid = serial.subscriptionid
1796 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1803 while ( my $line = $sth->fetchrow_hashref ) {
1805 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1806 $line->{planneddate} = format_date( $line->{planneddate} );
1808 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1809 $line->{claimdate} = format_date( $line->{claimdate} );
1811 $line->{"status".$line->{status}} = 1;
1812 push @issuelist, $line;
1817 =head2 removeMissingIssue
1819 removeMissingIssue($subscriptionid)
1821 this function removes an issue from being part of the missing string in
1822 subscriptionlist.missinglist column
1824 called when a missing issue is found from the serials-recieve.pl file
1828 sub removeMissingIssue {
1829 my ( $sequence, $subscriptionid ) = @_;
1830 my $dbh = C4::Context->dbh;
1831 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1832 $sth->execute($subscriptionid);
1833 my $data = $sth->fetchrow_hashref;
1834 my $missinglist = $data->{'missinglist'};
1835 my $missinglistbefore = $missinglist;
1837 # warn $missinglist." before";
1838 $missinglist =~ s/($sequence)//;
1840 # warn $missinglist." after";
1841 if ( $missinglist ne $missinglistbefore ) {
1842 $missinglist =~ s/\|\s\|/\|/g;
1843 $missinglist =~ s/^\| //g;
1844 $missinglist =~ s/\|$//g;
1845 my $sth2 = $dbh->prepare(
1846 "UPDATE subscriptionhistory
1848 WHERE subscriptionid = ?"
1850 $sth2->execute( $missinglist, $subscriptionid );
1857 &updateClaim($serialid)
1859 this function updates the time when a claim is issued for late/missing items
1861 called from claims.pl file
1866 my ($serialid) = @_;
1867 my $dbh = C4::Context->dbh;
1868 my $sth = $dbh->prepare(
1869 "UPDATE serial SET claimdate = now()
1873 $sth->execute($serialid);
1877 =head2 getsupplierbyserialid
1879 $result = getsupplierbyserialid($serialid)
1881 this function is used to find the supplier id given a serial id
1884 hashref containing serialid, subscriptionid, and aqbooksellerid
1888 sub getsupplierbyserialid {
1889 my ($serialid) = @_;
1890 my $dbh = C4::Context->dbh;
1891 my $sth = $dbh->prepare(
1892 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1894 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1898 $sth->execute($serialid);
1899 my $line = $sth->fetchrow_hashref;
1900 my $result = $line->{'aqbooksellerid'};
1904 =head2 check_routing
1906 $result = &check_routing($subscriptionid)
1908 this function checks to see if a serial has a routing list and returns the count of routingid
1909 used to show either an 'add' or 'edit' link
1914 my ($subscriptionid) = @_;
1915 my $dbh = C4::Context->dbh;
1916 my $sth = $dbh->prepare(
1917 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1918 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1919 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1922 $sth->execute($subscriptionid);
1923 my $line = $sth->fetchrow_hashref;
1924 my $result = $line->{'routingids'};
1928 =head2 addroutingmember
1930 addroutingmember($borrowernumber,$subscriptionid)
1932 this function takes a borrowernumber and subscriptionid and adds the member to the
1933 routing list for that serial subscription and gives them a rank on the list
1934 of either 1 or highest current rank + 1
1938 sub addroutingmember {
1939 my ( $borrowernumber, $subscriptionid ) = @_;
1941 my $dbh = C4::Context->dbh;
1942 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
1943 $sth->execute($subscriptionid);
1944 while ( my $line = $sth->fetchrow_hashref ) {
1945 if ( $line->{'rank'} > 0 ) {
1946 $rank = $line->{'rank'} + 1;
1951 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
1952 $sth->execute( $subscriptionid, $borrowernumber, $rank );
1955 =head2 reorder_members
1957 reorder_members($subscriptionid,$routingid,$rank)
1959 this function is used to reorder the routing list
1961 it takes the routingid of the member one wants to re-rank and the rank it is to move to
1962 - it gets all members on list puts their routingid's into an array
1963 - removes the one in the array that is $routingid
1964 - then reinjects $routingid at point indicated by $rank
1965 - then update the database with the routingids in the new order
1969 sub reorder_members {
1970 my ( $subscriptionid, $routingid, $rank ) = @_;
1971 my $dbh = C4::Context->dbh;
1972 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
1973 $sth->execute($subscriptionid);
1975 while ( my $line = $sth->fetchrow_hashref ) {
1976 push( @result, $line->{'routingid'} );
1979 # To find the matching index
1981 my $key = -1; # to allow for 0 being a valid response
1982 for ( $i = 0 ; $i < @result ; $i++ ) {
1983 if ( $routingid == $result[$i] ) {
1984 $key = $i; # save the index
1989 # if index exists in array then move it to new position
1990 if ( $key > -1 && $rank > 0 ) {
1991 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
1992 my $moving_item = splice( @result, $key, 1 );
1993 splice( @result, $new_rank, 0, $moving_item );
1995 for ( my $j = 0 ; $j < @result ; $j++ ) {
1996 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2002 =head2 delroutingmember
2004 delroutingmember($routingid,$subscriptionid)
2006 this function either deletes one member from routing list if $routingid exists otherwise
2007 deletes all members from the routing list
2011 sub delroutingmember {
2013 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2014 my ( $routingid, $subscriptionid ) = @_;
2015 my $dbh = C4::Context->dbh;
2017 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2018 $sth->execute($routingid);
2019 reorder_members( $subscriptionid, $routingid );
2021 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2022 $sth->execute($subscriptionid);
2027 =head2 getroutinglist
2029 ($count,@routinglist) = getroutinglist($subscriptionid)
2031 this gets the info from the subscriptionroutinglist for $subscriptionid
2034 a count of the number of members on routinglist
2035 the routinglist as an array. Each element of the array contains a hash_ref containing
2036 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2040 sub getroutinglist {
2041 my ($subscriptionid) = @_;
2042 my $dbh = C4::Context->dbh;
2043 my $sth = $dbh->prepare(
2044 "SELECT routingid, borrowernumber, ranking, biblionumber
2046 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2047 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2050 $sth->execute($subscriptionid);
2053 while ( my $line = $sth->fetchrow_hashref ) {
2055 push( @routinglist, $line );
2057 return ( $count, @routinglist );
2060 =head2 countissuesfrom
2062 $result = countissuesfrom($subscriptionid,$startdate)
2064 Returns a count of serial rows matching the given subsctiptionid
2065 with published date greater than startdate
2069 sub countissuesfrom {
2070 my ( $subscriptionid, $startdate ) = @_;
2071 my $dbh = C4::Context->dbh;
2075 WHERE subscriptionid=?
2076 AND serial.publisheddate>?
2078 my $sth = $dbh->prepare($query);
2079 $sth->execute( $subscriptionid, $startdate );
2080 my ($countreceived) = $sth->fetchrow;
2081 return $countreceived;
2086 $result = CountIssues($subscriptionid)
2088 Returns a count of serial rows matching the given subsctiptionid
2093 my ($subscriptionid) = @_;
2094 my $dbh = C4::Context->dbh;
2098 WHERE subscriptionid=?
2100 my $sth = $dbh->prepare($query);
2101 $sth->execute($subscriptionid);
2102 my ($countreceived) = $sth->fetchrow;
2103 return $countreceived;
2108 $result = HasItems($subscriptionid)
2110 returns a count of items from serial matching the subscriptionid
2115 my ($subscriptionid) = @_;
2116 my $dbh = C4::Context->dbh;
2118 SELECT COUNT(serialitems.itemnumber)
2120 LEFT JOIN serialitems USING(serialid)
2121 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2123 my $sth=$dbh->prepare($query);
2124 $sth->execute($subscriptionid);
2125 my ($countitems)=$sth->fetchrow_array();
2129 =head2 abouttoexpire
2131 $result = abouttoexpire($subscriptionid)
2133 this function alerts you to the penultimate issue for a serial subscription
2135 returns 1 - if this is the penultimate issue
2141 my ($subscriptionid) = @_;
2142 my $dbh = C4::Context->dbh;
2143 my $subscription = GetSubscription($subscriptionid);
2144 my $per = $subscription->{'periodicity'};
2145 if ($per && $per % 16 > 0){
2146 my $expirationdate = GetExpirationDate($subscriptionid);
2147 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2150 @res=split (/-/,$res);
2151 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2152 } else { # default an undefined value
2153 @res=Date::Calc::Today;
2155 my @endofsubscriptiondate=split(/-/,$expirationdate);
2156 my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 0, 0, 0);
2158 @datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2159 - (3 * $per_list[$per])) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2160 return 1 if ( @res &&
2162 Delta_Days($res[0],$res[1],$res[2],
2163 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2164 (@endofsubscriptiondate &&
2165 Delta_Days($res[0],$res[1],$res[2],
2166 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2168 } elsif ($subscription->{numberlength}>0) {
2169 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2174 sub in_array { # used in next sub down
2175 my ( $val, @elements ) = @_;
2176 foreach my $elem (@elements) {
2177 if ( $val == $elem ) {
2186 $resultdate = GetNextDate($planneddate,$subscription)
2188 this function it takes the planneddate and will return the next issue's date and will skip dates if there
2189 exists an irregularity
2190 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2191 skipped then the returned date will be 2007-05-10
2194 $resultdate - then next date in the sequence
2196 Return 0 if periodicity==0
2200 sub GetNextDate(@) {
2201 my ( $planneddate, $subscription ) = @_;
2202 my @irreg = split( /\,/, $subscription->{irregularity} );
2204 #date supposed to be in ISO.
2206 my ( $year, $month, $day ) = split( /-/, $planneddate );
2207 $month = 1 unless ($month);
2208 $day = 1 unless ($day);
2211 # warn "DOW $dayofweek";
2212 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2217 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2218 # renaming this pattern from 1/day to " n / week ".
2219 if ( $subscription->{periodicity} == 1 ) {
2220 my $dayofweek = eval { Day_of_Week( $year, $month, $day ) };
2221 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2223 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2224 $dayofweek = 0 if ( $dayofweek == 7 );
2225 if ( in_array( ( $dayofweek + 1 ), @irreg ) ) {
2226 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 );
2230 @resultdate = Add_Delta_Days( $year, $month, $day, 1 );
2235 if ( $subscription->{periodicity} == 2 ) {
2236 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2237 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2239 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2241 #FIXME: if two consecutive irreg, do we only skip one?
2242 if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) {
2243 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 );
2244 $wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 );
2247 @resultdate = Add_Delta_Days( $year, $month, $day, 7 );
2252 if ( $subscription->{periodicity} == 3 ) {
2253 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2254 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2256 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2257 if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) {
2258 ### BUGFIX was previously +1 ^
2259 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 );
2260 $wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 );
2263 @resultdate = Add_Delta_Days( $year, $month, $day, 14 );
2268 if ( $subscription->{periodicity} == 4 ) {
2269 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2270 if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; }
2272 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2273 if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) {
2274 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 );
2275 $wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 );
2278 @resultdate = Add_Delta_Days( $year, $month, $day, 21 );
2281 my $tmpmonth = $month;
2282 if ( $year && $month && $day ) {
2283 if ( $subscription->{periodicity} == 5 ) {
2284 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2285 if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) {
2286 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2287 $tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 );
2290 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2292 if ( $subscription->{periodicity} == 6 ) {
2293 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2294 if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) {
2295 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2296 $tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 );
2299 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2301 if ( $subscription->{periodicity} == 7 ) {
2302 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2303 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2304 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2305 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2308 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2310 if ( $subscription->{periodicity} == 8 ) {
2311 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2312 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2313 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2314 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2317 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2319 if ( $subscription->{periodicity} == 9 ) {
2320 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2321 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2322 ### BUFIX Seems to need more Than One ?
2323 ( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 );
2324 $tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 );
2327 @resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 );
2329 if ( $subscription->{periodicity} == 10 ) {
2330 @resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 );
2332 if ( $subscription->{periodicity} == 11 ) {
2333 @resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 );
2336 my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] );
2338 return "$resultdate";
2343 $item = itemdata($barcode);
2345 Looks up the item with the given barcode, and returns a
2346 reference-to-hash containing information about that item. The keys of
2347 the hash are the fields from the C<items> and C<biblioitems> tables in
2355 my $dbh = C4::Context->dbh;
2356 my $sth = $dbh->prepare(
2357 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2360 $sth->execute($barcode);
2361 my $data = $sth->fetchrow_hashref;
2371 Koha Development Team <http://koha-community.org/>