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 setlocale LC_TIME);
27 use C4::Log; # logaction
29 use C4::Serials::Frequency;
30 use C4::Serials::Numberpattern;
32 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
35 $VERSION = 3.07.00.049; # set version for version checking
39 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
40 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
42 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
43 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
44 &GetSubscriptionHistoryFromSubscriptionId
46 &GetNextSeq &GetSeq &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 &GetDistributedTo &SetDistributedTo
55 &getroutinglist &delroutingmember &addroutingmember
57 &check_routing &updateClaim &removeMissingIssue
60 &GetSubscriptionsFromBorrower
67 C4::Serials - Serials Module Functions
75 Functions for handling subscriptions, claims routing etc.
80 =head2 GetSuppliersWithLateIssues
82 $supplierlist = GetSuppliersWithLateIssues()
84 this function get all suppliers with late issues.
87 an array_ref of suppliers each entry is a hash_ref containing id and name
88 the array is in name order
92 sub GetSuppliersWithLateIssues {
93 my $dbh = C4::Context->dbh;
95 SELECT DISTINCT id, name
97 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
98 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
101 (planneddate < now() AND serial.status=1)
102 OR serial.STATUS = 3 OR serial.STATUS = 4
104 AND subscription.closed = 0
106 return $dbh->selectall_arrayref($query, { Slice => {} });
111 @issuelist = GetLateIssues($supplierid)
113 this function selects late issues from the database
116 the issuelist as an array. Each element of this array contains a hashi_ref containing
117 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
122 my ($supplierid) = @_;
123 my $dbh = C4::Context->dbh;
127 SELECT name,title,planneddate,serialseq,serial.subscriptionid
129 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
130 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
131 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
132 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
133 AND subscription.aqbooksellerid=?
134 AND subscription.closed = 0
137 $sth = $dbh->prepare($query);
138 $sth->execute($supplierid);
141 SELECT name,title,planneddate,serialseq,serial.subscriptionid
143 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
144 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
145 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
146 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
147 AND subscription.closed = 0
150 $sth = $dbh->prepare($query);
156 while ( my $line = $sth->fetchrow_hashref ) {
157 $odd++ unless $line->{title} eq $last_title;
158 $line->{title} = "" if $line->{title} eq $last_title;
159 $last_title = $line->{title} if ( $line->{title} );
160 $line->{planneddate} = format_date( $line->{planneddate} );
161 push @issuelist, $line;
166 =head2 GetSubscriptionHistoryFromSubscriptionId
168 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
170 This function returns the subscription history as a hashref
174 sub GetSubscriptionHistoryFromSubscriptionId {
175 my ($subscriptionid) = @_;
177 return unless $subscriptionid;
179 my $dbh = C4::Context->dbh;
182 FROM subscriptionhistory
183 WHERE subscriptionid = ?
185 my $sth = $dbh->prepare($query);
186 $sth->execute($subscriptionid);
187 my $results = $sth->fetchrow_hashref;
193 =head2 GetSerialStatusFromSerialId
195 $sth = GetSerialStatusFromSerialId();
196 this function returns a statement handle
197 After this function, don't forget to execute it by using $sth->execute($serialid)
199 $sth = $dbh->prepare($query).
203 sub GetSerialStatusFromSerialId {
204 my $dbh = C4::Context->dbh;
210 return $dbh->prepare($query);
213 =head2 GetSerialInformation
216 $data = GetSerialInformation($serialid);
217 returns a hash_ref containing :
218 items : items marcrecord (can be an array)
220 subscription table field
221 + information about subscription expiration
225 sub GetSerialInformation {
227 my $dbh = C4::Context->dbh;
229 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
230 if ( C4::Context->preference('IndependantBranches')
231 && C4::Context->userenv
232 && C4::Context->userenv->{'flags'} != 1
233 && C4::Context->userenv->{'branch'} ) {
235 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
238 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
241 my $rq = $dbh->prepare($query);
242 $rq->execute($serialid);
243 my $data = $rq->fetchrow_hashref;
245 # create item information if we have serialsadditems for this subscription
246 if ( $data->{'serialsadditems'} ) {
247 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
248 $queryitem->execute($serialid);
249 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
251 if ( scalar(@$itemnumbers) > 0 ) {
252 foreach my $itemnum (@$itemnumbers) {
254 #It is ASSUMED that GetMarcItem ALWAYS WORK...
255 #Maybe GetMarcItem should return values on failure
256 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
257 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
258 $itemprocessed->{'itemnumber'} = $itemnum->[0];
259 $itemprocessed->{'itemid'} = $itemnum->[0];
260 $itemprocessed->{'serialid'} = $serialid;
261 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
262 push @{ $data->{'items'} }, $itemprocessed;
265 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
266 $itemprocessed->{'itemid'} = "N$serialid";
267 $itemprocessed->{'serialid'} = $serialid;
268 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
269 $itemprocessed->{'countitems'} = 0;
270 push @{ $data->{'items'} }, $itemprocessed;
273 $data->{ "status" . $data->{'serstatus'} } = 1;
274 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
275 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
279 =head2 AddItem2Serial
281 $rows = AddItem2Serial($serialid,$itemnumber);
282 Adds an itemnumber to Serial record
283 returns the number of rows affected
288 my ( $serialid, $itemnumber ) = @_;
289 my $dbh = C4::Context->dbh;
290 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
291 $rq->execute( $serialid, $itemnumber );
295 =head2 UpdateClaimdateIssues
297 UpdateClaimdateIssues($serialids,[$date]);
299 Update Claimdate for issues in @$serialids list with date $date
304 sub UpdateClaimdateIssues {
305 my ( $serialids, $date ) = @_;
306 my $dbh = C4::Context->dbh;
307 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
309 UPDATE serial SET claimdate = ?, status = 7
310 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
311 my $rq = $dbh->prepare($query);
312 $rq->execute($date, @$serialids);
316 =head2 GetSubscription
318 $subs = GetSubscription($subscriptionid)
319 this function returns the subscription which has $subscriptionid as id.
321 a hashref. This hash containts
322 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
326 sub GetSubscription {
327 my ($subscriptionid) = @_;
328 my $dbh = C4::Context->dbh;
330 SELECT subscription.*,
331 subscriptionhistory.*,
332 aqbooksellers.name AS aqbooksellername,
333 biblio.title AS bibliotitle,
334 subscription.biblionumber as bibnum);
335 if ( C4::Context->preference('IndependantBranches')
336 && C4::Context->userenv
337 && C4::Context->userenv->{'flags'} != 1
338 && C4::Context->userenv->{'branch'} ) {
340 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
344 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
345 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
346 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
347 WHERE subscription.subscriptionid = ?
350 # if (C4::Context->preference('IndependantBranches') &&
351 # C4::Context->userenv &&
352 # C4::Context->userenv->{'flags'} != 1){
353 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
354 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
356 $debug and warn "query : $query\nsubsid :$subscriptionid";
357 my $sth = $dbh->prepare($query);
358 $sth->execute($subscriptionid);
359 return $sth->fetchrow_hashref;
362 =head2 GetFullSubscription
364 $array_ref = GetFullSubscription($subscriptionid)
365 this function reads the serial table.
369 sub GetFullSubscription {
370 my ($subscriptionid) = @_;
371 my $dbh = C4::Context->dbh;
373 SELECT serial.serialid,
376 serial.publisheddate,
378 serial.notes as notes,
379 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
380 aqbooksellers.name as aqbooksellername,
381 biblio.title as bibliotitle,
382 subscription.branchcode AS branchcode,
383 subscription.subscriptionid AS subscriptionid |;
384 if ( C4::Context->preference('IndependantBranches')
385 && C4::Context->userenv
386 && C4::Context->userenv->{'flags'} != 1
387 && C4::Context->userenv->{'branch'} ) {
389 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
393 LEFT JOIN subscription ON
394 (serial.subscriptionid=subscription.subscriptionid )
395 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
396 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
397 WHERE serial.subscriptionid = ?
399 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
400 serial.subscriptionid
402 $debug and warn "GetFullSubscription query: $query";
403 my $sth = $dbh->prepare($query);
404 $sth->execute($subscriptionid);
405 return $sth->fetchall_arrayref( {} );
408 =head2 PrepareSerialsData
410 $array_ref = PrepareSerialsData($serialinfomation)
411 where serialinformation is a hashref array
415 sub PrepareSerialsData {
421 my $aqbooksellername;
425 my $previousnote = "";
427 foreach my $subs (@{$lines}) {
428 for my $datefield ( qw(publisheddate planneddate) ) {
429 # handle both undef and undef returned as 0000-00-00
430 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
431 $subs->{$datefield} = 'XXX';
434 $subs->{$datefield} = format_date( $subs->{$datefield} );
437 $subs->{ "status" . $subs->{'status'} } = 1;
438 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
440 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
441 $year = $subs->{'year'};
445 if ( $tmpresults{$year} ) {
446 push @{ $tmpresults{$year}->{'serials'} }, $subs;
448 $tmpresults{$year} = {
450 'aqbooksellername' => $subs->{'aqbooksellername'},
451 'bibliotitle' => $subs->{'bibliotitle'},
452 'serials' => [$subs],
457 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
458 push @res, $tmpresults{$key};
463 =head2 GetSubscriptionsFromBiblionumber
465 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
466 this function get the subscription list. it reads the subscription table.
468 reference to an array of subscriptions which have the biblionumber given on input arg.
469 each element of this array is a hashref containing
470 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
474 sub GetSubscriptionsFromBiblionumber {
475 my ($biblionumber) = @_;
476 my $dbh = C4::Context->dbh;
478 SELECT subscription.*,
480 subscriptionhistory.*,
481 aqbooksellers.name AS aqbooksellername,
482 biblio.title AS bibliotitle
484 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
485 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
486 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
487 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
488 WHERE subscription.biblionumber = ?
490 my $sth = $dbh->prepare($query);
491 $sth->execute($biblionumber);
493 while ( my $subs = $sth->fetchrow_hashref ) {
494 $subs->{startdate} = format_date( $subs->{startdate} );
495 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
496 $subs->{histenddate} = format_date( $subs->{histenddate} );
497 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
498 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
499 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
500 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
501 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
502 $subs->{ "status" . $subs->{'status'} } = 1;
503 $subs->{'cannotedit'} =
504 ( C4::Context->preference('IndependantBranches')
505 && C4::Context->userenv
506 && C4::Context->userenv->{flags} % 2 != 1
507 && C4::Context->userenv->{branch}
508 && $subs->{branchcode}
509 && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
511 if ( $subs->{enddate} eq '0000-00-00' ) {
512 $subs->{enddate} = '';
514 $subs->{enddate} = format_date( $subs->{enddate} );
516 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
517 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
523 =head2 GetFullSubscriptionsFromBiblionumber
525 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
526 this function reads the serial table.
530 sub GetFullSubscriptionsFromBiblionumber {
531 my ($biblionumber) = @_;
532 my $dbh = C4::Context->dbh;
534 SELECT serial.serialid,
537 serial.publisheddate,
539 serial.notes as notes,
540 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
541 biblio.title as bibliotitle,
542 subscription.branchcode AS branchcode,
543 subscription.subscriptionid AS subscriptionid|;
544 if ( C4::Context->preference('IndependantBranches')
545 && C4::Context->userenv
546 && C4::Context->userenv->{'flags'} != 1
547 && C4::Context->userenv->{'branch'} ) {
549 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
554 LEFT JOIN subscription ON
555 (serial.subscriptionid=subscription.subscriptionid)
556 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
557 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
558 WHERE subscription.biblionumber = ?
560 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
561 serial.subscriptionid
563 my $sth = $dbh->prepare($query);
564 $sth->execute($biblionumber);
565 return $sth->fetchall_arrayref( {} );
568 =head2 GetSubscriptions
570 @results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
571 this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
573 a table of hashref. Each hash containt the subscription.
577 sub GetSubscriptions {
578 my ( $string, $issn, $ean, $biblionumber ) = @_;
580 #return unless $title or $ISSN or $biblionumber;
581 my $dbh = C4::Context->dbh;
584 SELECT subscriptionhistory.*, subscription.*, biblio.title,biblioitems.issn,biblio.biblionumber
586 LEFT JOIN subscriptionhistory USING(subscriptionid)
587 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
588 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
593 $sqlwhere = " WHERE biblio.biblionumber=?";
594 push @bind_params, $biblionumber;
598 my @strings_to_search;
599 @strings_to_search = map { "%$_%" } split( / /, $string );
600 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
601 push @bind_params, @strings_to_search;
602 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
603 $debug && warn "$tmpstring";
604 $tmpstring =~ s/^AND //;
605 push @sqlstrings, $tmpstring;
607 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
611 my @strings_to_search;
612 @strings_to_search = map { "%$_%" } split( / /, $issn );
613 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
614 push @bind_params, @strings_to_search;
615 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
616 $debug && warn "$tmpstring";
617 $tmpstring =~ s/^OR //;
618 push @sqlstrings, $tmpstring;
620 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
624 my @strings_to_search;
625 @strings_to_search = map { "$_" } split( / /, $ean );
626 foreach my $index ( qw(biblioitems.ean) ) {
627 push @bind_params, @strings_to_search;
628 my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
629 $debug && warn "$tmpstring";
630 $tmpstring =~ s/^OR //;
631 push @sqlstrings, $tmpstring;
633 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
636 $sql .= "$sqlwhere ORDER BY title";
637 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
638 $sth = $dbh->prepare($sql);
639 $sth->execute(@bind_params);
642 while ( my $line = $sth->fetchrow_hashref ) {
643 $line->{'cannotedit'} =
644 ( C4::Context->preference('IndependantBranches')
645 && C4::Context->userenv
646 && C4::Context->userenv->{flags} % 2 != 1
647 && C4::Context->userenv->{branch}
648 && $line->{branchcode}
649 && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
650 push @results, $line;
655 =head2 SearchSubscriptions
657 @results = SearchSubscriptions($args);
658 $args is a hashref. Its keys can be contained: title, issn, ean, publisher, bookseller and branchcode
660 this function gets all subscriptions which have title like $title, ISSN like $issn, EAN like $ean, publisher like $publisher, bookseller like $bookseller AND branchcode eq $branch.
663 a table of hashref. Each hash containt the subscription.
667 sub SearchSubscriptions {
671 SELECT subscription.*, subscriptionhistory.*, biblio.*, biblioitems.issn
673 LEFT JOIN subscriptionhistory USING(subscriptionid)
674 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
675 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
676 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
680 if( $args->{biblionumber} ) {
681 push @where_strs, "biblio.biblionumber = ?";
682 push @where_args, $args->{biblionumber};
684 if( $args->{title} ){
685 my @words = split / /, $args->{title};
687 foreach my $word (@words) {
688 push @strs, "biblio.title LIKE ?";
689 push @args, "%$word%";
692 push @where_strs, '(' . join (' AND ', @strs) . ')';
693 push @where_args, @args;
697 push @where_strs, "biblioitems.issn LIKE ?";
698 push @where_args, "%$args->{issn}%";
701 push @where_strs, "biblioitems.ean LIKE ?";
702 push @where_args, "%$args->{ean}%";
704 if( $args->{publisher} ){
705 push @where_strs, "biblioitems.publishercode LIKE ?";
706 push @where_args, "%$args->{publisher}%";
708 if( $args->{bookseller} ){
709 push @where_strs, "aqbooksellers.name LIKE ?";
710 push @where_args, "%$args->{bookseller}%";
712 if( $args->{branch} ){
713 push @where_strs, "subscription.branchcode = ?";
714 push @where_args, "$args->{branch}";
716 if( defined $args->{closed} ){
717 push @where_strs, "subscription.closed = ?";
718 push @where_args, "$args->{closed}";
721 $query .= " WHERE " . join(" AND ", @where_strs);
724 my $dbh = C4::Context->dbh;
725 my $sth = $dbh->prepare($query);
726 $sth->execute(@where_args);
727 my $results = $sth->fetchall_arrayref( {} );
736 ($totalissues,@serials) = GetSerials($subscriptionid);
737 this function gets every serial not arrived for a given subscription
738 as well as the number of issues registered in the database (all types)
739 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
741 FIXME: We should return \@serials.
746 my ( $subscriptionid, $count ) = @_;
747 my $dbh = C4::Context->dbh;
749 # status = 2 is "arrived"
751 $count = 5 unless ($count);
753 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
755 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
756 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
757 my $sth = $dbh->prepare($query);
758 $sth->execute($subscriptionid);
760 while ( my $line = $sth->fetchrow_hashref ) {
761 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
762 for my $datefield ( qw( planneddate publisheddate) ) {
763 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
764 $line->{$datefield} = format_date( $line->{$datefield});
766 $line->{$datefield} = q{};
769 push @serials, $line;
772 # OK, now add the last 5 issues arrives/missing
773 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
775 WHERE subscriptionid = ?
776 AND (status in (2,4,5))
777 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
779 $sth = $dbh->prepare($query);
780 $sth->execute($subscriptionid);
781 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
783 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
784 for my $datefield ( qw( planneddate publisheddate) ) {
785 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
786 $line->{$datefield} = format_date( $line->{$datefield});
788 $line->{$datefield} = q{};
792 push @serials, $line;
795 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
796 $sth = $dbh->prepare($query);
797 $sth->execute($subscriptionid);
798 my ($totalissues) = $sth->fetchrow;
799 return ( $totalissues, @serials );
804 @serials = GetSerials2($subscriptionid,$status);
805 this function returns every serial waited for a given subscription
806 as well as the number of issues registered in the database (all types)
807 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
812 my ( $subscription, $status ) = @_;
813 my $dbh = C4::Context->dbh;
815 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
817 WHERE subscriptionid=$subscription AND status IN ($status)
818 ORDER BY publisheddate,serialid DESC
820 $debug and warn "GetSerials2 query: $query";
821 my $sth = $dbh->prepare($query);
825 while ( my $line = $sth->fetchrow_hashref ) {
826 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
827 # Format dates for display
828 for my $datefield ( qw( planneddate publisheddate ) ) {
829 if ($line->{$datefield} =~m/^00/) {
830 $line->{$datefield} = q{};
833 $line->{$datefield} = format_date( $line->{$datefield} );
836 push @serials, $line;
841 =head2 GetLatestSerials
843 \@serials = GetLatestSerials($subscriptionid,$limit)
844 get the $limit's latest serials arrived or missing for a given subscription
846 a ref to an array which contains all of the latest serials stored into a hash.
850 sub GetLatestSerials {
851 my ( $subscriptionid, $limit ) = @_;
852 my $dbh = C4::Context->dbh;
854 # status = 2 is "arrived"
855 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
857 WHERE subscriptionid = ?
858 AND (status =2 or status=4)
859 ORDER BY publisheddate DESC LIMIT 0,$limit
861 my $sth = $dbh->prepare($strsth);
862 $sth->execute($subscriptionid);
864 while ( my $line = $sth->fetchrow_hashref ) {
865 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
866 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
867 push @serials, $line;
873 =head2 GetDistributedTo
875 $distributedto=GetDistributedTo($subscriptionid)
876 This function returns the field distributedto for the subscription matching subscriptionid
880 sub GetDistributedTo {
881 my $dbh = C4::Context->dbh;
883 my $subscriptionid = @_;
884 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
885 my $sth = $dbh->prepare($query);
886 $sth->execute($subscriptionid);
887 return ($distributedto) = $sth->fetchrow;
893 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
894 $newinnerloop1, $newinnerloop2, $newinnerloop3
895 ) = GetNextSeq( $subscription, $pattern, $planneddate );
897 $subscription is a hashref containing all the attributes of the table
899 $pattern is a hashref containing all the attributes of the table
900 'subscription_numberpatterns'.
901 $planneddate is a C4::Dates object.
902 This function get the next issue for the subscription given on input arg
907 my ($subscription, $pattern, $planneddate) = @_;
908 my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
909 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
912 if ($subscription->{'skip_serialseq'}) {
913 my @irreg = split /;/, $subscription->{'irregularity'};
915 my $irregularities = {};
916 $irregularities->{$_} = 1 foreach(@irreg);
917 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
918 while($irregularities->{$issueno}) {
925 my $numberingmethod = $pattern->{numberingmethod};
926 $calculated = $numberingmethod;
927 my $locale = $subscription->{locale};
928 $newlastvalue1 = $subscription->{lastvalue1} || 0;
929 $newlastvalue2 = $subscription->{lastvalue2} || 0;
930 $newlastvalue3 = $subscription->{lastvalue3} || 0;
931 $newinnerloop1 = $subscription->{innerloop1} || 0;
932 $newinnerloop2 = $subscription->{innerloop2} || 0;
933 $newinnerloop3 = $subscription->{innerloop3} || 0;
936 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
939 for(my $i = 0; $i < $count; $i++) {
941 # check if we have to increase the new value.
943 if ($newinnerloop1 >= $pattern->{every1}) {
945 $newlastvalue1 += $pattern->{add1};
947 # reset counter if needed.
948 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
951 # check if we have to increase the new value.
953 if ($newinnerloop2 >= $pattern->{every2}) {
955 $newlastvalue2 += $pattern->{add2};
957 # reset counter if needed.
958 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
961 # check if we have to increase the new value.
963 if ($newinnerloop3 >= $pattern->{every3}) {
965 $newlastvalue3 += $pattern->{add3};
967 # reset counter if needed.
968 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
972 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
973 $calculated =~ s/\{X\}/$newlastvalue1string/g;
976 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
977 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
980 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
981 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
985 $newlastvalue1, $newlastvalue2, $newlastvalue3,
986 $newinnerloop1, $newinnerloop2, $newinnerloop3);
991 $calculated = GetSeq($subscription, $pattern)
992 $subscription is a hashref containing all the attributes of the table 'subscription'
993 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
994 this function transforms {X},{Y},{Z} to 150,0,0 for example.
996 the sequence in string format
1001 my ($subscription, $pattern) = @_;
1002 my $locale = $subscription->{locale};
1004 my $calculated = $pattern->{numberingmethod};
1006 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
1007 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
1008 $calculated =~ s/\{X\}/$newlastvalue1/g;
1010 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1011 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1012 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1014 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1015 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1016 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1020 =head2 GetExpirationDate
1022 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1024 this function return the next expiration date for a subscription given on input args.
1027 the enddate or undef
1031 sub GetExpirationDate {
1032 my ( $subscriptionid, $startdate ) = @_;
1033 my $dbh = C4::Context->dbh;
1034 my $subscription = GetSubscription($subscriptionid);
1037 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1038 $enddate = $startdate || $subscription->{startdate};
1039 my @date = split( /-/, $enddate );
1040 return if ( scalar(@date) != 3 || not check_date(@date) );
1041 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1042 if ( $frequency and $frequency->{unit} ) {
1045 if ( my $length = $subscription->{numberlength} ) {
1047 #calculate the date of the last issue.
1048 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1049 $enddate = GetNextDate( $subscription, $enddate );
1051 } elsif ( $subscription->{monthlength} ) {
1052 if ( $$subscription{startdate} ) {
1053 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1054 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1056 } elsif ( $subscription->{weeklength} ) {
1057 if ( $$subscription{startdate} ) {
1058 my @date = split( /-/, $subscription->{startdate} );
1059 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1060 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1063 $enddate = $subscription->{enddate};
1067 return $subscription->{enddate};
1071 =head2 CountSubscriptionFromBiblionumber
1073 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1074 this returns a count of the subscriptions for a given biblionumber
1076 the number of subscriptions
1080 sub CountSubscriptionFromBiblionumber {
1081 my ($biblionumber) = @_;
1082 my $dbh = C4::Context->dbh;
1083 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1084 my $sth = $dbh->prepare($query);
1085 $sth->execute($biblionumber);
1086 my $subscriptionsnumber = $sth->fetchrow;
1087 return $subscriptionsnumber;
1090 =head2 ModSubscriptionHistory
1092 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1094 this function modifies the history of a subscription. Put your new values on input arg.
1095 returns the number of rows affected
1099 sub ModSubscriptionHistory {
1100 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1101 my $dbh = C4::Context->dbh;
1102 my $query = "UPDATE subscriptionhistory
1103 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1104 WHERE subscriptionid=?
1106 my $sth = $dbh->prepare($query);
1107 $receivedlist =~ s/^; // if $receivedlist;
1108 $missinglist =~ s/^; // if $missinglist;
1109 $opacnote =~ s/^; // if $opacnote;
1110 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1114 # Update missinglist field, used by ModSerialStatus
1115 sub _update_missinglist {
1116 my $subscriptionid = shift;
1118 my $dbh = C4::Context->dbh;
1119 my @missingserials = GetSerials2($subscriptionid, "4,5");
1121 foreach (@missingserials) {
1122 if($_->{'status'} == 4) {
1123 $missinglist .= $_->{'serialseq'} . "; ";
1124 } elsif($_->{'status'} == 5) {
1125 $missinglist .= "not issued " . $_->{'serialseq'} . "; ";
1128 $missinglist =~ s/; $//;
1130 UPDATE subscriptionhistory
1132 WHERE subscriptionid = ?
1134 my $sth = $dbh->prepare($query);
1135 $sth->execute($missinglist, $subscriptionid);
1138 # Update recievedlist field, used by ModSerialStatus
1139 sub _update_receivedlist {
1140 my $subscriptionid = shift;
1142 my $dbh = C4::Context->dbh;
1143 my @receivedserials = GetSerials2($subscriptionid, "2");
1145 foreach (@receivedserials) {
1146 $receivedlist .= $_->{'serialseq'} . "; ";
1148 $receivedlist =~ s/; $//;
1150 UPDATE subscriptionhistory
1151 SET recievedlist = ?
1152 WHERE subscriptionid = ?
1154 my $sth = $dbh->prepare($query);
1155 $sth->execute($receivedlist, $subscriptionid);
1158 =head2 ModSerialStatus
1160 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1162 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1163 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1167 sub ModSerialStatus {
1168 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1171 #It is a usual serial
1172 # 1st, get previous status :
1173 my $dbh = C4::Context->dbh;
1174 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1175 FROM serial, subscription
1176 WHERE serial.subscriptionid=subscription.subscriptionid
1178 my $sth = $dbh->prepare($query);
1179 $sth->execute($serialid);
1180 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1181 my $frequency = GetSubscriptionFrequency($periodicity);
1183 # change status & update subscriptionhistory
1185 if ( $status == 6 ) {
1186 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1189 unless ($frequency->{'unit'}) {
1190 if ( not $planneddate or $planneddate eq '0000-00-00' ) { $planneddate = C4::Dates->new()->output('iso') };
1191 if ( not $publisheddate or $publisheddate eq '0000-00-00' ) { $publisheddate = C4::Dates->new()->output('iso') };
1193 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1194 $sth = $dbh->prepare($query);
1195 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1196 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1197 $sth = $dbh->prepare($query);
1198 $sth->execute($subscriptionid);
1199 my $val = $sth->fetchrow_hashref;
1200 unless ( $val->{manualhistory} ) {
1201 if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) {
1202 _update_receivedlist($subscriptionid);
1204 if($status == 4 || $status == 5
1205 || ($oldstatus == 4 && $status != 4)
1206 || ($oldstatus == 5 && $status != 5)) {
1207 _update_missinglist($subscriptionid);
1212 # create new waited entry if needed (ie : was a "waited" and has changed)
1213 if ( $oldstatus == 1 && $status != 1 ) {
1214 my $subscription = GetSubscription($subscriptionid);
1215 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1219 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1220 $newinnerloop1, $newinnerloop2, $newinnerloop3
1222 = GetNextSeq( $subscription, $pattern, $publisheddate );
1224 # next date (calculated from actual date & frequency parameters)
1225 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1226 my $nextpubdate = $nextpublisheddate;
1227 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1228 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1229 WHERE subscriptionid = ?";
1230 $sth = $dbh->prepare($query);
1231 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1233 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1234 if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) {
1235 require C4::Letters;
1236 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1243 =head2 GetNextExpected
1245 $nextexpected = GetNextExpected($subscriptionid)
1247 Get the planneddate for the current expected issue of the subscription.
1253 planneddate => ISO date
1258 sub GetNextExpected {
1259 my ($subscriptionid) = @_;
1261 my $dbh = C4::Context->dbh;
1265 WHERE subscriptionid = ?
1269 my $sth = $dbh->prepare($query);
1271 # Each subscription has only one 'expected' issue, with serial.status==1.
1272 $sth->execute( $subscriptionid, 1 );
1273 my $nextissue = $sth->fetchrow_hashref;
1274 if ( !$nextissue ) {
1278 WHERE subscriptionid = ?
1279 ORDER BY publisheddate DESC
1282 $sth = $dbh->prepare($query);
1283 $sth->execute($subscriptionid);
1284 $nextissue = $sth->fetchrow_hashref;
1286 foreach(qw/planneddate publisheddate/) {
1287 if ( !defined $nextissue->{$_} ) {
1288 # or should this default to 1st Jan ???
1289 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1291 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1299 =head2 ModNextExpected
1301 ModNextExpected($subscriptionid,$date)
1303 Update the planneddate for the current expected issue of the subscription.
1304 This will modify all future prediction results.
1306 C<$date> is an ISO date.
1312 sub ModNextExpected {
1313 my ( $subscriptionid, $date ) = @_;
1314 my $dbh = C4::Context->dbh;
1316 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1317 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1319 # Each subscription has only one 'expected' issue, with serial.status==1.
1320 $sth->execute( $date, $date, $subscriptionid, 1 );
1325 =head2 GetSubscriptionIrregularities
1329 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1330 get the list of irregularities for a subscription
1336 sub GetSubscriptionIrregularities {
1337 my $subscriptionid = shift;
1339 return unless $subscriptionid;
1341 my $dbh = C4::Context->dbh;
1345 WHERE subscriptionid = ?
1347 my $sth = $dbh->prepare($query);
1348 $sth->execute($subscriptionid);
1350 my ($result) = $sth->fetchrow_array;
1351 my @irreg = split /;/, $result;
1356 =head2 ModSubscription
1358 this function modifies a subscription. Put all new values on input args.
1359 returns the number of rows affected
1363 sub ModSubscription {
1365 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1366 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1367 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1368 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1369 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1370 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1371 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1374 my $dbh = C4::Context->dbh;
1375 my $query = "UPDATE subscription
1376 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1377 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1378 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1379 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1380 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1381 callnumber=?, notes=?, letter=?, manualhistory=?,
1382 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1383 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1385 WHERE subscriptionid = ?";
1387 my $sth = $dbh->prepare($query);
1389 $auser, $branchcode, $aqbooksellerid, $cost,
1390 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1391 $irregularity, $numberpattern, $locale, $numberlength,
1392 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1393 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1394 $status, $biblionumber, $callnumber, $notes,
1395 $letter, ($manualhistory ? $manualhistory : 0),
1396 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1397 $graceperiod, $location, $enddate, $skip_serialseq,
1400 my $rows = $sth->rows;
1402 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1406 =head2 NewSubscription
1408 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1409 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1410 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1411 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1412 $callnumber, $hemisphere, $manualhistory, $internalnotes, $serialsadditems,
1413 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1415 Create a new subscription with value given on input args.
1418 the id of this new subscription
1422 sub NewSubscription {
1424 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1425 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1426 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1427 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1428 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1429 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1430 $location, $enddate, $skip_serialseq
1432 my $dbh = C4::Context->dbh;
1434 #save subscription (insert into database)
1436 INSERT INTO subscription
1437 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1438 biblionumber, startdate, periodicity, numberlength, weeklength,
1439 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1440 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1441 irregularity, numberpattern, locale, callnumber,
1442 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1443 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1444 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1446 my $sth = $dbh->prepare($query);
1448 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1449 $startdate, $periodicity, $numberlength, $weeklength,
1450 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1451 $lastvalue3, $innerloop3, $status, $notes, $letter,
1452 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1453 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1454 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1457 my $subscriptionid = $dbh->{'mysql_insertid'};
1459 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1463 WHERE subscriptionid=?
1465 $sth = $dbh->prepare($query);
1466 $sth->execute( $enddate, $subscriptionid );
1469 # then create the 1st expected number
1471 INSERT INTO subscriptionhistory
1472 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1475 $sth = $dbh->prepare($query);
1476 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1478 # reread subscription to get a hash (for calculation of the 1st issue number)
1479 my $subscription = GetSubscription($subscriptionid);
1480 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1482 # calculate issue number
1483 my $serialseq = GetSeq($subscription, $pattern);
1486 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1487 VALUES (?,?,?,?,?,?)
1489 $sth = $dbh->prepare($query);
1490 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1492 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1494 #set serial flag on biblio if not already set.
1495 my $bib = GetBiblio($biblionumber);
1496 if ( $bib and !$bib->{'serial'} ) {
1497 my $record = GetMarcBiblio($biblionumber);
1498 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1500 eval { $record->field($tag)->update( $subf => 1 ); };
1502 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1504 return $subscriptionid;
1507 =head2 ReNewSubscription
1509 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1511 this function renew a subscription with values given on input args.
1515 sub ReNewSubscription {
1516 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1517 my $dbh = C4::Context->dbh;
1518 my $subscription = GetSubscription($subscriptionid);
1522 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1523 WHERE biblio.biblionumber=?
1525 my $sth = $dbh->prepare($query);
1526 $sth->execute( $subscription->{biblionumber} );
1527 my $biblio = $sth->fetchrow_hashref;
1529 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1530 require C4::Suggestions;
1531 C4::Suggestions::NewSuggestion(
1532 { 'suggestedby' => $user,
1533 'title' => $subscription->{bibliotitle},
1534 'author' => $biblio->{author},
1535 'publishercode' => $biblio->{publishercode},
1536 'note' => $biblio->{note},
1537 'biblionumber' => $subscription->{biblionumber}
1542 # renew subscription
1545 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1546 WHERE subscriptionid=?
1548 $sth = $dbh->prepare($query);
1549 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1550 my $enddate = GetExpirationDate($subscriptionid);
1551 $debug && warn "enddate :$enddate";
1555 WHERE subscriptionid=?
1557 $sth = $dbh->prepare($query);
1558 $sth->execute( $enddate, $subscriptionid );
1560 UPDATE subscriptionhistory
1562 WHERE subscriptionid=?
1564 $sth = $dbh->prepare($query);
1565 $sth->execute( $enddate, $subscriptionid );
1567 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1573 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1575 Create a new issue stored on the database.
1576 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1577 returns the serial id
1582 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1583 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1585 my $dbh = C4::Context->dbh;
1588 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1589 VALUES (?,?,?,?,?,?,?)
1591 my $sth = $dbh->prepare($query);
1592 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1593 my $serialid = $dbh->{'mysql_insertid'};
1595 SELECT missinglist,recievedlist
1596 FROM subscriptionhistory
1597 WHERE subscriptionid=?
1599 $sth = $dbh->prepare($query);
1600 $sth->execute($subscriptionid);
1601 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1603 if ( $status == 2 ) {
1604 ### TODO Add a feature that improves recognition and description.
1605 ### As such count (serialseq) i.e. : N18,2(N19),N20
1606 ### Would use substr and index But be careful to previous presence of ()
1607 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1609 if ( $status == 4 ) {
1610 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1613 UPDATE subscriptionhistory
1614 SET recievedlist=?, missinglist=?
1615 WHERE subscriptionid=?
1617 $sth = $dbh->prepare($query);
1618 $recievedlist =~ s/^; //;
1619 $missinglist =~ s/^; //;
1620 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1624 =head2 ItemizeSerials
1626 ItemizeSerials($serialid, $info);
1627 $info is a hashref containing barcode branch, itemcallnumber, status, location
1628 $serialid the serialid
1630 1 if the itemize is a succes.
1631 0 and @error otherwise. @error containts the list of errors found.
1635 sub ItemizeSerials {
1636 my ( $serialid, $info ) = @_;
1637 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1639 my $dbh = C4::Context->dbh;
1645 my $sth = $dbh->prepare($query);
1646 $sth->execute($serialid);
1647 my $data = $sth->fetchrow_hashref;
1648 if ( C4::Context->preference("RoutingSerials") ) {
1650 # check for existing biblioitem relating to serial issue
1651 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1653 for ( my $i = 0 ; $i < $count ; $i++ ) {
1654 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1655 $bibitemno = $results[$i]->{'biblioitemnumber'};
1659 if ( $bibitemno == 0 ) {
1660 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1661 $sth->execute( $data->{'biblionumber'} );
1662 my $biblioitem = $sth->fetchrow_hashref;
1663 $biblioitem->{'volumedate'} = $data->{planneddate};
1664 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1665 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1669 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1670 if ( $info->{barcode} ) {
1672 if ( is_barcode_in_use( $info->{barcode} ) ) {
1673 push @errors, 'barcode_not_unique';
1675 my $marcrecord = MARC::Record->new();
1676 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1677 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1678 $marcrecord->insert_fields_ordered($newField);
1679 if ( $info->{branch} ) {
1680 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1682 #warn "items.homebranch : $tag , $subfield";
1683 if ( $marcrecord->field($tag) ) {
1684 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1686 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1687 $marcrecord->insert_fields_ordered($newField);
1689 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1691 #warn "items.holdingbranch : $tag , $subfield";
1692 if ( $marcrecord->field($tag) ) {
1693 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1695 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1696 $marcrecord->insert_fields_ordered($newField);
1699 if ( $info->{itemcallnumber} ) {
1700 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1702 if ( $marcrecord->field($tag) ) {
1703 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1705 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1706 $marcrecord->insert_fields_ordered($newField);
1709 if ( $info->{notes} ) {
1710 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1712 if ( $marcrecord->field($tag) ) {
1713 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1715 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1716 $marcrecord->insert_fields_ordered($newField);
1719 if ( $info->{location} ) {
1720 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1722 if ( $marcrecord->field($tag) ) {
1723 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1725 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1726 $marcrecord->insert_fields_ordered($newField);
1729 if ( $info->{status} ) {
1730 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1732 if ( $marcrecord->field($tag) ) {
1733 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1735 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1736 $marcrecord->insert_fields_ordered($newField);
1739 if ( C4::Context->preference("RoutingSerials") ) {
1740 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1741 if ( $marcrecord->field($tag) ) {
1742 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1744 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1745 $marcrecord->insert_fields_ordered($newField);
1749 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1752 return ( 0, @errors );
1756 =head2 HasSubscriptionStrictlyExpired
1758 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1760 the subscription has stricly expired when today > the end subscription date
1763 1 if true, 0 if false, -1 if the expiration date is not set.
1767 sub HasSubscriptionStrictlyExpired {
1769 # Getting end of subscription date
1770 my ($subscriptionid) = @_;
1771 my $dbh = C4::Context->dbh;
1772 my $subscription = GetSubscription($subscriptionid);
1773 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1775 # If the expiration date is set
1776 if ( $expirationdate != 0 ) {
1777 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1779 # Getting today's date
1780 my ( $nowyear, $nowmonth, $nowday ) = Today();
1782 # if today's date > expiration date, then the subscription has stricly expired
1783 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1790 # There are some cases where the expiration date is not set
1791 # As we can't determine if the subscription has expired on a date-basis,
1797 =head2 HasSubscriptionExpired
1799 $has_expired = HasSubscriptionExpired($subscriptionid)
1801 the subscription has expired when the next issue to arrive is out of subscription limit.
1804 0 if the subscription has not expired
1805 1 if the subscription has expired
1806 2 if has subscription does not have a valid expiration date set
1810 sub HasSubscriptionExpired {
1811 my ($subscriptionid) = @_;
1812 my $dbh = C4::Context->dbh;
1813 my $subscription = GetSubscription($subscriptionid);
1814 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1815 if ( $frequency and $frequency->{unit} ) {
1816 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1817 if (!defined $expirationdate) {
1818 $expirationdate = q{};
1821 SELECT max(planneddate)
1823 WHERE subscriptionid=?
1825 my $sth = $dbh->prepare($query);
1826 $sth->execute($subscriptionid);
1827 my ($res) = $sth->fetchrow;
1828 if (!$res || $res=~m/^0000/) {
1831 my @res = split( /-/, $res );
1832 my @endofsubscriptiondate = split( /-/, $expirationdate );
1833 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1835 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1840 if ( $subscription->{'numberlength'} ) {
1841 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1842 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1848 return 0; # Notice that you'll never get here.
1851 =head2 SetDistributedto
1853 SetDistributedto($distributedto,$subscriptionid);
1854 This function update the value of distributedto for a subscription given on input arg.
1858 sub SetDistributedto {
1859 my ( $distributedto, $subscriptionid ) = @_;
1860 my $dbh = C4::Context->dbh;
1864 WHERE subscriptionid=?
1866 my $sth = $dbh->prepare($query);
1867 $sth->execute( $distributedto, $subscriptionid );
1871 =head2 DelSubscription
1873 DelSubscription($subscriptionid)
1874 this function deletes subscription which has $subscriptionid as id.
1878 sub DelSubscription {
1879 my ($subscriptionid) = @_;
1880 my $dbh = C4::Context->dbh;
1881 $subscriptionid = $dbh->quote($subscriptionid);
1882 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1883 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1884 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1886 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1891 DelIssue($serialseq,$subscriptionid)
1892 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1894 returns the number of rows affected
1899 my ($dataissue) = @_;
1900 my $dbh = C4::Context->dbh;
1901 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1906 AND subscriptionid= ?
1908 my $mainsth = $dbh->prepare($query);
1909 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1911 #Delete element from subscription history
1912 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1913 my $sth = $dbh->prepare($query);
1914 $sth->execute( $dataissue->{'subscriptionid'} );
1915 my $val = $sth->fetchrow_hashref;
1916 unless ( $val->{manualhistory} ) {
1918 SELECT * FROM subscriptionhistory
1919 WHERE subscriptionid= ?
1921 my $sth = $dbh->prepare($query);
1922 $sth->execute( $dataissue->{'subscriptionid'} );
1923 my $data = $sth->fetchrow_hashref;
1924 my $serialseq = $dataissue->{'serialseq'};
1925 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1926 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1927 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1928 $sth = $dbh->prepare($strsth);
1929 $sth->execute( $dataissue->{'subscriptionid'} );
1932 return $mainsth->rows;
1935 =head2 GetLateOrMissingIssues
1937 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1939 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1942 the issuelist as an array of hash refs. Each element of this array contains
1943 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1947 sub GetLateOrMissingIssues {
1948 my ( $supplierid, $serialid, $order ) = @_;
1949 my $dbh = C4::Context->dbh;
1953 $byserial = "and serialid = " . $serialid;
1956 $order .= ", title";
1961 $sth = $dbh->prepare(
1963 serialid, aqbooksellerid, name,
1964 biblio.title, planneddate, serialseq,
1965 serial.status, serial.subscriptionid, claimdate,
1966 subscription.branchcode
1968 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1969 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1970 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1971 WHERE subscription.subscriptionid = serial.subscriptionid
1972 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1973 AND subscription.aqbooksellerid=$supplierid
1978 $sth = $dbh->prepare(
1980 serialid, aqbooksellerid, name,
1981 biblio.title, planneddate, serialseq,
1982 serial.status, serial.subscriptionid, claimdate,
1983 subscription.branchcode
1985 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1986 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1987 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1988 WHERE subscription.subscriptionid = serial.subscriptionid
1989 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1996 while ( my $line = $sth->fetchrow_hashref ) {
1998 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1999 $line->{planneddate} = format_date( $line->{planneddate} );
2001 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
2002 $line->{claimdate} = format_date( $line->{claimdate} );
2004 $line->{"status".$line->{status}} = 1;
2005 push @issuelist, $line;
2010 =head2 removeMissingIssue
2012 removeMissingIssue($subscriptionid)
2014 this function removes an issue from being part of the missing string in
2015 subscriptionlist.missinglist column
2017 called when a missing issue is found from the serials-recieve.pl file
2021 sub removeMissingIssue {
2022 my ( $sequence, $subscriptionid ) = @_;
2023 my $dbh = C4::Context->dbh;
2024 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2025 $sth->execute($subscriptionid);
2026 my $data = $sth->fetchrow_hashref;
2027 my $missinglist = $data->{'missinglist'};
2028 my $missinglistbefore = $missinglist;
2030 # warn $missinglist." before";
2031 $missinglist =~ s/($sequence)//;
2033 # warn $missinglist." after";
2034 if ( $missinglist ne $missinglistbefore ) {
2035 $missinglist =~ s/\|\s\|/\|/g;
2036 $missinglist =~ s/^\| //g;
2037 $missinglist =~ s/\|$//g;
2038 my $sth2 = $dbh->prepare(
2039 "UPDATE subscriptionhistory
2041 WHERE subscriptionid = ?"
2043 $sth2->execute( $missinglist, $subscriptionid );
2050 &updateClaim($serialid)
2052 this function updates the time when a claim is issued for late/missing items
2054 called from claims.pl file
2059 my ($serialid) = @_;
2060 my $dbh = C4::Context->dbh;
2061 my $sth = $dbh->prepare(
2062 "UPDATE serial SET claimdate = now()
2066 $sth->execute($serialid);
2070 =head2 getsupplierbyserialid
2072 $result = getsupplierbyserialid($serialid)
2074 this function is used to find the supplier id given a serial id
2077 hashref containing serialid, subscriptionid, and aqbooksellerid
2081 sub getsupplierbyserialid {
2082 my ($serialid) = @_;
2083 my $dbh = C4::Context->dbh;
2084 my $sth = $dbh->prepare(
2085 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2087 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2091 $sth->execute($serialid);
2092 my $line = $sth->fetchrow_hashref;
2093 my $result = $line->{'aqbooksellerid'};
2097 =head2 check_routing
2099 $result = &check_routing($subscriptionid)
2101 this function checks to see if a serial has a routing list and returns the count of routingid
2102 used to show either an 'add' or 'edit' link
2107 my ($subscriptionid) = @_;
2108 my $dbh = C4::Context->dbh;
2109 my $sth = $dbh->prepare(
2110 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2111 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2112 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2115 $sth->execute($subscriptionid);
2116 my $line = $sth->fetchrow_hashref;
2117 my $result = $line->{'routingids'};
2121 =head2 addroutingmember
2123 addroutingmember($borrowernumber,$subscriptionid)
2125 this function takes a borrowernumber and subscriptionid and adds the member to the
2126 routing list for that serial subscription and gives them a rank on the list
2127 of either 1 or highest current rank + 1
2131 sub addroutingmember {
2132 my ( $borrowernumber, $subscriptionid ) = @_;
2134 my $dbh = C4::Context->dbh;
2135 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2136 $sth->execute($subscriptionid);
2137 while ( my $line = $sth->fetchrow_hashref ) {
2138 if ( $line->{'rank'} > 0 ) {
2139 $rank = $line->{'rank'} + 1;
2144 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2145 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2148 =head2 reorder_members
2150 reorder_members($subscriptionid,$routingid,$rank)
2152 this function is used to reorder the routing list
2154 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2155 - it gets all members on list puts their routingid's into an array
2156 - removes the one in the array that is $routingid
2157 - then reinjects $routingid at point indicated by $rank
2158 - then update the database with the routingids in the new order
2162 sub reorder_members {
2163 my ( $subscriptionid, $routingid, $rank ) = @_;
2164 my $dbh = C4::Context->dbh;
2165 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2166 $sth->execute($subscriptionid);
2168 while ( my $line = $sth->fetchrow_hashref ) {
2169 push( @result, $line->{'routingid'} );
2172 # To find the matching index
2174 my $key = -1; # to allow for 0 being a valid response
2175 for ( $i = 0 ; $i < @result ; $i++ ) {
2176 if ( $routingid == $result[$i] ) {
2177 $key = $i; # save the index
2182 # if index exists in array then move it to new position
2183 if ( $key > -1 && $rank > 0 ) {
2184 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2185 my $moving_item = splice( @result, $key, 1 );
2186 splice( @result, $new_rank, 0, $moving_item );
2188 for ( my $j = 0 ; $j < @result ; $j++ ) {
2189 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2195 =head2 delroutingmember
2197 delroutingmember($routingid,$subscriptionid)
2199 this function either deletes one member from routing list if $routingid exists otherwise
2200 deletes all members from the routing list
2204 sub delroutingmember {
2206 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2207 my ( $routingid, $subscriptionid ) = @_;
2208 my $dbh = C4::Context->dbh;
2210 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2211 $sth->execute($routingid);
2212 reorder_members( $subscriptionid, $routingid );
2214 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2215 $sth->execute($subscriptionid);
2220 =head2 getroutinglist
2222 @routinglist = getroutinglist($subscriptionid)
2224 this gets the info from the subscriptionroutinglist for $subscriptionid
2227 the routinglist as an array. Each element of the array contains a hash_ref containing
2228 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2232 sub getroutinglist {
2233 my ($subscriptionid) = @_;
2234 my $dbh = C4::Context->dbh;
2235 my $sth = $dbh->prepare(
2236 'SELECT routingid, borrowernumber, ranking, biblionumber
2238 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2239 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2241 $sth->execute($subscriptionid);
2242 my $routinglist = $sth->fetchall_arrayref({});
2243 return @{$routinglist};
2246 =head2 countissuesfrom
2248 $result = countissuesfrom($subscriptionid,$startdate)
2250 Returns a count of serial rows matching the given subsctiptionid
2251 with published date greater than startdate
2255 sub countissuesfrom {
2256 my ( $subscriptionid, $startdate ) = @_;
2257 my $dbh = C4::Context->dbh;
2261 WHERE subscriptionid=?
2262 AND serial.publisheddate>?
2264 my $sth = $dbh->prepare($query);
2265 $sth->execute( $subscriptionid, $startdate );
2266 my ($countreceived) = $sth->fetchrow;
2267 return $countreceived;
2272 $result = CountIssues($subscriptionid)
2274 Returns a count of serial rows matching the given subsctiptionid
2279 my ($subscriptionid) = @_;
2280 my $dbh = C4::Context->dbh;
2284 WHERE subscriptionid=?
2286 my $sth = $dbh->prepare($query);
2287 $sth->execute($subscriptionid);
2288 my ($countreceived) = $sth->fetchrow;
2289 return $countreceived;
2294 $result = HasItems($subscriptionid)
2296 returns a count of items from serial matching the subscriptionid
2301 my ($subscriptionid) = @_;
2302 my $dbh = C4::Context->dbh;
2304 SELECT COUNT(serialitems.itemnumber)
2306 LEFT JOIN serialitems USING(serialid)
2307 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2309 my $sth=$dbh->prepare($query);
2310 $sth->execute($subscriptionid);
2311 my ($countitems)=$sth->fetchrow_array();
2315 =head2 abouttoexpire
2317 $result = abouttoexpire($subscriptionid)
2319 this function alerts you to the penultimate issue for a serial subscription
2321 returns 1 - if this is the penultimate issue
2327 my ($subscriptionid) = @_;
2328 my $dbh = C4::Context->dbh;
2329 my $subscription = GetSubscription($subscriptionid);
2330 my $per = $subscription->{'periodicity'};
2331 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2332 if ($frequency and $frequency->{unit}){
2333 my $expirationdate = GetExpirationDate($subscriptionid);
2334 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2335 my $nextdate = GetNextDate($subscription, $res);
2336 if(Date::Calc::Delta_Days(
2337 split( /-/, $nextdate ),
2338 split( /-/, $expirationdate )
2342 } elsif ($subscription->{numberlength}>0) {
2343 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2348 sub in_array { # used in next sub down
2349 my ( $val, @elements ) = @_;
2350 foreach my $elem (@elements) {
2351 if ( $val == $elem ) {
2358 =head2 GetSubscriptionsFromBorrower
2360 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2362 this gets the info from subscriptionroutinglist for each $subscriptionid
2365 a count of the serial subscription routing lists to which a patron belongs,
2366 with the titles of those serial subscriptions as an array. Each element of the array
2367 contains a hash_ref with subscriptionID and title of subscription.
2371 sub GetSubscriptionsFromBorrower {
2372 my ($borrowernumber) = @_;
2373 my $dbh = C4::Context->dbh;
2374 my $sth = $dbh->prepare(
2375 "SELECT subscription.subscriptionid, biblio.title
2377 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2378 JOIN subscriptionroutinglist USING (subscriptionid)
2379 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2382 $sth->execute($borrowernumber);
2385 while ( my $line = $sth->fetchrow_hashref ) {
2387 push( @routinglist, $line );
2389 return ( $count, @routinglist );
2393 =head2 GetFictiveIssueNumber
2395 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2397 Get the position of the issue published at $publisheddate, considering the
2398 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2399 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2400 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2401 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2402 depending on how many rows are in serial table.
2403 The issue number calculation is based on subscription frequency, first acquisition
2404 date, and $publisheddate.
2408 sub GetFictiveIssueNumber {
2409 my ($subscription, $publisheddate) = @_;
2411 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2412 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2416 my ($year, $month, $day) = split /-/, $publisheddate;
2417 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2421 if($unit eq 'day') {
2422 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2423 } elsif($unit eq 'week') {
2424 ($wkno, $year) = Week_of_Year($year, $month, $day);
2425 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2426 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2427 } elsif($unit eq 'month') {
2428 $delta = ($fa_year == $year)
2429 ? ($month - $fa_month)
2430 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2431 } elsif($unit eq 'year') {
2432 $delta = $year - $fa_year;
2434 if($frequency->{'unitsperissue'} == 1) {
2435 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2437 # Assuming issuesperunit == 1
2438 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2446 $resultdate = GetNextDate($publisheddate,$subscription)
2448 this function it takes the publisheddate and will return the next issue's date
2449 and will skip dates if there exists an irregularity.
2450 $publisheddate has to be an ISO date
2451 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2452 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2453 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2454 skipped then the returned date will be 2007-05-10
2457 $resultdate - then next date in the sequence (ISO date)
2459 Return $publisheddate if subscription is irregular
2464 my ( $subscription, $publisheddate, $updatecount ) = @_;
2466 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2468 if ($freqdata->{'unit'}) {
2469 my ( $year, $month, $day ) = split /-/, $publisheddate;
2471 # Process an irregularity Hash
2472 # Suppose that irregularities are stored in a string with this structure
2473 # irreg1;irreg2;irreg3
2474 # where irregX is the number of issue which will not be received
2475 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2476 my @irreg = split /;/, $subscription->{'irregularity'} ;
2478 foreach my $irregularity (@irreg) {
2479 $irregularities{$irregularity} = 1;
2482 # Get the 'fictive' next issue number
2483 # It is used to check if next issue is an irregular issue.
2484 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2486 # Then get the next date
2487 my $unit = lc $freqdata->{'unit'};
2488 if ($unit eq 'day') {
2489 while ($irregularities{$issueno}) {
2490 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2491 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
2492 $subscription->{'countissuesperunit'} = 1;
2494 $subscription->{'countissuesperunit'}++;
2498 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2499 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
2500 $subscription->{'countissuesperunit'} = 1;
2502 $subscription->{'countissuesperunit'}++;
2505 elsif ($unit eq 'week') {
2506 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2507 while ($irregularities{$issueno}) {
2508 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2509 $subscription->{'countissuesperunit'} = 1;
2510 $wkno += $freqdata->{"unitsperissue"};
2515 my $dow = Day_of_Week($year, $month, $day);
2516 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2517 if($freqdata->{'issuesperunit'} == 1) {
2518 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2521 $subscription->{'countissuesperunit'}++;
2525 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2526 $subscription->{'countissuesperunit'} = 1;
2527 $wkno += $freqdata->{"unitsperissue"};
2529 $wkno = $wkno % 52 ;
2532 my $dow = Day_of_Week($year, $month, $day);
2533 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2534 if($freqdata->{'issuesperunit'} == 1) {
2535 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2538 $subscription->{'countissuesperunit'}++;
2541 elsif ($unit eq 'month') {
2542 while ($irregularities{$issueno}) {
2543 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2544 $subscription->{'countissuesperunit'} = 1;
2545 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2546 unless($freqdata->{'issuesperunit'} == 1) {
2547 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2550 $subscription->{'countissuesperunit'}++;
2554 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2555 $subscription->{'countissuesperunit'} = 1;
2556 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2557 unless($freqdata->{'issuesperunit'} == 1) {
2558 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2561 $subscription->{'countissuesperunit'}++;
2564 elsif ($unit eq 'year') {
2565 while ($irregularities{$issueno}) {
2566 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2567 $subscription->{'countissuesperunit'} = 1;
2568 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2569 unless($freqdata->{'issuesperunit'} == 1) {
2570 # Jumping to the first day of year, because we don't know what day is expected
2575 $subscription->{'countissuesperunit'}++;
2579 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2580 $subscription->{'countissuesperunit'} = 1;
2581 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2582 unless($freqdata->{'issuesperunit'} == 1) {
2583 # Jumping to the first day of year, because we don't know what day is expected
2588 $subscription->{'countissuesperunit'}++;
2592 my $dbh = C4::Context->dbh;
2595 SET countissuesperunit = ?
2596 WHERE subscriptionid = ?
2598 my $sth = $dbh->prepare($query);
2599 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2601 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2604 return $publisheddate;
2610 $string = &_numeration($value,$num_type,$locale);
2612 _numeration returns the string corresponding to $value in the num_type
2622 my ($value, $num_type, $locale) = @_;
2624 my $initlocale = setlocale(LC_TIME);
2625 if($locale and $locale ne $initlocale) {
2626 $locale = setlocale(LC_TIME, $locale);
2628 $locale ||= $initlocale;
2632 when (/^dayname$/) {
2633 $value = $value % 7;
2634 $string = POSIX::strftime("%A",0,0,0,0,0,0,$value);
2636 when (/^monthname$/) {
2637 $value = $value % 12;
2638 $string = POSIX::strftime("%B",0,0,0,1,$value,0,0,0,0);
2641 my $seasonlocale = ($locale)
2642 ? (substr $locale,0,2)
2646 [qw(Spring Summer Fall Winter)],
2648 [qw(Printemps Été Automne Hiver)],
2650 $value = $value % 4;
2651 $string = ($seasons{$seasonlocale})
2652 ? $seasons{$seasonlocale}->[$value]
2653 : $seasons{'en'}->[$value];
2659 if($locale ne $initlocale) {
2660 setlocale(LC_TIME, $initlocale);
2665 =head2 is_barcode_in_use
2667 Returns number of occurence of the barcode in the items table
2668 Can be used as a boolean test of whether the barcode has
2669 been deployed as yet
2673 sub is_barcode_in_use {
2674 my $barcode = shift;
2675 my $dbh = C4::Context->dbh;
2676 my $occurences = $dbh->selectall_arrayref(
2677 'SELECT itemnumber from items where barcode = ?',
2682 return @{$occurences};
2685 =head2 CloseSubscription
2686 Close a subscription given a subscriptionid
2688 sub CloseSubscription {
2689 my ( $subscriptionid ) = @_;
2690 return unless $subscriptionid;
2691 my $dbh = C4::Context->dbh;
2692 my $sth = $dbh->prepare( qq{
2695 WHERE subscriptionid = ?
2697 $sth->execute( $subscriptionid );
2699 # Set status = missing when status = stopped
2700 $sth = $dbh->prepare( qq{
2703 WHERE subscriptionid = ?
2706 $sth->execute( $subscriptionid );
2709 =head2 ReopenSubscription
2710 Reopen a subscription given a subscriptionid
2712 sub ReopenSubscription {
2713 my ( $subscriptionid ) = @_;
2714 return unless $subscriptionid;
2715 my $dbh = C4::Context->dbh;
2716 my $sth = $dbh->prepare( qq{
2719 WHERE subscriptionid = ?
2721 $sth->execute( $subscriptionid );
2723 # Set status = expected when status = stopped
2724 $sth = $dbh->prepare( qq{
2727 WHERE subscriptionid = ?
2730 $sth->execute( $subscriptionid );
2738 Koha Development Team <http://koha-community.org/>