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
61 &subscriptionCurrentlyOnOrder
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
102 (planneddate < now() AND serial.status=1)
103 OR serial.STATUS = 3 OR serial.STATUS = 4
105 AND subscription.closed = 0
107 return $dbh->selectall_arrayref($query, { Slice => {} });
112 @issuelist = GetLateIssues($supplierid)
114 this function selects late issues from the database
117 the issuelist as an array. Each element of this array contains a hashi_ref containing
118 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
123 my ($supplierid) = @_;
124 my $dbh = C4::Context->dbh;
128 SELECT name,title,planneddate,serialseq,serial.subscriptionid
130 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
131 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
132 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
133 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
134 AND subscription.aqbooksellerid=?
135 AND subscription.closed = 0
138 $sth = $dbh->prepare($query);
139 $sth->execute($supplierid);
142 SELECT name,title,planneddate,serialseq,serial.subscriptionid
144 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
145 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
146 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
147 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
148 AND subscription.closed = 0
151 $sth = $dbh->prepare($query);
157 while ( my $line = $sth->fetchrow_hashref ) {
158 $odd++ unless $line->{title} eq $last_title;
159 $line->{title} = "" if $line->{title} eq $last_title;
160 $last_title = $line->{title} if ( $line->{title} );
161 $line->{planneddate} = format_date( $line->{planneddate} );
162 push @issuelist, $line;
167 =head2 GetSubscriptionHistoryFromSubscriptionId
169 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
171 This function returns the subscription history as a hashref
175 sub GetSubscriptionHistoryFromSubscriptionId {
176 my ($subscriptionid) = @_;
178 return unless $subscriptionid;
180 my $dbh = C4::Context->dbh;
183 FROM subscriptionhistory
184 WHERE subscriptionid = ?
186 my $sth = $dbh->prepare($query);
187 $sth->execute($subscriptionid);
188 my $results = $sth->fetchrow_hashref;
194 =head2 GetSerialStatusFromSerialId
196 $sth = GetSerialStatusFromSerialId();
197 this function returns a statement handle
198 After this function, don't forget to execute it by using $sth->execute($serialid)
200 $sth = $dbh->prepare($query).
204 sub GetSerialStatusFromSerialId {
205 my $dbh = C4::Context->dbh;
211 return $dbh->prepare($query);
214 =head2 GetSerialInformation
217 $data = GetSerialInformation($serialid);
218 returns a hash_ref containing :
219 items : items marcrecord (can be an array)
221 subscription table field
222 + information about subscription expiration
226 sub GetSerialInformation {
228 my $dbh = C4::Context->dbh;
230 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
231 if ( C4::Context->preference('IndependantBranches')
232 && C4::Context->userenv
233 && C4::Context->userenv->{'flags'} != 1
234 && C4::Context->userenv->{'branch'} ) {
236 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
239 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
242 my $rq = $dbh->prepare($query);
243 $rq->execute($serialid);
244 my $data = $rq->fetchrow_hashref;
246 # create item information if we have serialsadditems for this subscription
247 if ( $data->{'serialsadditems'} ) {
248 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
249 $queryitem->execute($serialid);
250 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
252 if ( scalar(@$itemnumbers) > 0 ) {
253 foreach my $itemnum (@$itemnumbers) {
255 #It is ASSUMED that GetMarcItem ALWAYS WORK...
256 #Maybe GetMarcItem should return values on failure
257 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
258 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
259 $itemprocessed->{'itemnumber'} = $itemnum->[0];
260 $itemprocessed->{'itemid'} = $itemnum->[0];
261 $itemprocessed->{'serialid'} = $serialid;
262 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
263 push @{ $data->{'items'} }, $itemprocessed;
266 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
267 $itemprocessed->{'itemid'} = "N$serialid";
268 $itemprocessed->{'serialid'} = $serialid;
269 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
270 $itemprocessed->{'countitems'} = 0;
271 push @{ $data->{'items'} }, $itemprocessed;
274 $data->{ "status" . $data->{'serstatus'} } = 1;
275 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
276 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
280 =head2 AddItem2Serial
282 $rows = AddItem2Serial($serialid,$itemnumber);
283 Adds an itemnumber to Serial record
284 returns the number of rows affected
289 my ( $serialid, $itemnumber ) = @_;
290 my $dbh = C4::Context->dbh;
291 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
292 $rq->execute( $serialid, $itemnumber );
296 =head2 UpdateClaimdateIssues
298 UpdateClaimdateIssues($serialids,[$date]);
300 Update Claimdate for issues in @$serialids list with date $date
305 sub UpdateClaimdateIssues {
306 my ( $serialids, $date ) = @_;
307 my $dbh = C4::Context->dbh;
308 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
310 UPDATE serial SET claimdate = ?, status = 7
311 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
312 my $rq = $dbh->prepare($query);
313 $rq->execute($date, @$serialids);
317 =head2 GetSubscription
319 $subs = GetSubscription($subscriptionid)
320 this function returns the subscription which has $subscriptionid as id.
322 a hashref. This hash containts
323 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
327 sub GetSubscription {
328 my ($subscriptionid) = @_;
329 my $dbh = C4::Context->dbh;
331 SELECT subscription.*,
332 subscriptionhistory.*,
333 aqbooksellers.name AS aqbooksellername,
334 biblio.title AS bibliotitle,
335 subscription.biblionumber as bibnum);
336 if ( C4::Context->preference('IndependantBranches')
337 && C4::Context->userenv
338 && C4::Context->userenv->{'flags'} != 1
339 && C4::Context->userenv->{'branch'} ) {
341 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
345 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
346 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
347 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
348 WHERE subscription.subscriptionid = ?
351 # if (C4::Context->preference('IndependantBranches') &&
352 # C4::Context->userenv &&
353 # C4::Context->userenv->{'flags'} != 1){
354 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
355 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
357 $debug and warn "query : $query\nsubsid :$subscriptionid";
358 my $sth = $dbh->prepare($query);
359 $sth->execute($subscriptionid);
360 return $sth->fetchrow_hashref;
363 =head2 GetFullSubscription
365 $array_ref = GetFullSubscription($subscriptionid)
366 this function reads the serial table.
370 sub GetFullSubscription {
371 my ($subscriptionid) = @_;
372 my $dbh = C4::Context->dbh;
374 SELECT serial.serialid,
377 serial.publisheddate,
379 serial.notes as notes,
380 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
381 aqbooksellers.name as aqbooksellername,
382 biblio.title as bibliotitle,
383 subscription.branchcode AS branchcode,
384 subscription.subscriptionid AS subscriptionid |;
385 if ( C4::Context->preference('IndependantBranches')
386 && C4::Context->userenv
387 && C4::Context->userenv->{'flags'} != 1
388 && C4::Context->userenv->{'branch'} ) {
390 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
394 LEFT JOIN subscription ON
395 (serial.subscriptionid=subscription.subscriptionid )
396 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
397 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
398 WHERE serial.subscriptionid = ?
400 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
401 serial.subscriptionid
403 $debug and warn "GetFullSubscription query: $query";
404 my $sth = $dbh->prepare($query);
405 $sth->execute($subscriptionid);
406 return $sth->fetchall_arrayref( {} );
409 =head2 PrepareSerialsData
411 $array_ref = PrepareSerialsData($serialinfomation)
412 where serialinformation is a hashref array
416 sub PrepareSerialsData {
422 my $aqbooksellername;
426 my $previousnote = "";
428 foreach my $subs (@{$lines}) {
429 for my $datefield ( qw(publisheddate planneddate) ) {
430 # handle both undef and undef returned as 0000-00-00
431 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
432 $subs->{$datefield} = 'XXX';
435 $subs->{$datefield} = format_date( $subs->{$datefield} );
438 $subs->{ "status" . $subs->{'status'} } = 1;
439 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
441 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
442 $year = $subs->{'year'};
446 if ( $tmpresults{$year} ) {
447 push @{ $tmpresults{$year}->{'serials'} }, $subs;
449 $tmpresults{$year} = {
451 'aqbooksellername' => $subs->{'aqbooksellername'},
452 'bibliotitle' => $subs->{'bibliotitle'},
453 'serials' => [$subs],
458 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
459 push @res, $tmpresults{$key};
464 =head2 GetSubscriptionsFromBiblionumber
466 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
467 this function get the subscription list. it reads the subscription table.
469 reference to an array of subscriptions which have the biblionumber given on input arg.
470 each element of this array is a hashref containing
471 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
475 sub GetSubscriptionsFromBiblionumber {
476 my ($biblionumber) = @_;
477 my $dbh = C4::Context->dbh;
479 SELECT subscription.*,
481 subscriptionhistory.*,
482 aqbooksellers.name AS aqbooksellername,
483 biblio.title AS bibliotitle
485 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
486 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
487 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
488 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
489 WHERE subscription.biblionumber = ?
491 my $sth = $dbh->prepare($query);
492 $sth->execute($biblionumber);
494 while ( my $subs = $sth->fetchrow_hashref ) {
495 $subs->{startdate} = format_date( $subs->{startdate} );
496 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
497 $subs->{histenddate} = format_date( $subs->{histenddate} );
498 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
499 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
500 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
501 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
502 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
503 $subs->{ "status" . $subs->{'status'} } = 1;
504 $subs->{'cannotedit'} =
505 ( C4::Context->preference('IndependantBranches')
506 && C4::Context->userenv
507 && C4::Context->userenv->{flags} % 2 != 1
508 && C4::Context->userenv->{branch}
509 && $subs->{branchcode}
510 && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
512 if ( $subs->{enddate} eq '0000-00-00' ) {
513 $subs->{enddate} = '';
515 $subs->{enddate} = format_date( $subs->{enddate} );
517 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
518 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
524 =head2 GetFullSubscriptionsFromBiblionumber
526 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
527 this function reads the serial table.
531 sub GetFullSubscriptionsFromBiblionumber {
532 my ($biblionumber) = @_;
533 my $dbh = C4::Context->dbh;
535 SELECT serial.serialid,
538 serial.publisheddate,
540 serial.notes as notes,
541 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
542 biblio.title as bibliotitle,
543 subscription.branchcode AS branchcode,
544 subscription.subscriptionid AS subscriptionid|;
545 if ( C4::Context->preference('IndependantBranches')
546 && C4::Context->userenv
547 && C4::Context->userenv->{'flags'} != 1
548 && C4::Context->userenv->{'branch'} ) {
550 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
555 LEFT JOIN subscription ON
556 (serial.subscriptionid=subscription.subscriptionid)
557 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
558 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
559 WHERE subscription.biblionumber = ?
561 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
562 serial.subscriptionid
564 my $sth = $dbh->prepare($query);
565 $sth->execute($biblionumber);
566 return $sth->fetchall_arrayref( {} );
569 =head2 GetSubscriptions
571 @results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
572 this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
574 a table of hashref. Each hash containt the subscription.
578 sub GetSubscriptions {
579 my ( $string, $issn, $ean, $biblionumber ) = @_;
581 #return unless $title or $ISSN or $biblionumber;
582 my $dbh = C4::Context->dbh;
585 SELECT subscriptionhistory.*, subscription.*, biblio.title,biblioitems.issn,biblio.biblionumber
587 LEFT JOIN subscriptionhistory USING(subscriptionid)
588 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
589 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
594 $sqlwhere = " WHERE biblio.biblionumber=?";
595 push @bind_params, $biblionumber;
599 my @strings_to_search;
600 @strings_to_search = map { "%$_%" } split( / /, $string );
601 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
602 push @bind_params, @strings_to_search;
603 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
604 $debug && warn "$tmpstring";
605 $tmpstring =~ s/^AND //;
606 push @sqlstrings, $tmpstring;
608 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
612 my @strings_to_search;
613 @strings_to_search = map { "%$_%" } split( / /, $issn );
614 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
615 push @bind_params, @strings_to_search;
616 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
617 $debug && warn "$tmpstring";
618 $tmpstring =~ s/^OR //;
619 push @sqlstrings, $tmpstring;
621 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
625 my @strings_to_search;
626 @strings_to_search = map { "$_" } split( / /, $ean );
627 foreach my $index ( qw(biblioitems.ean) ) {
628 push @bind_params, @strings_to_search;
629 my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
630 $debug && warn "$tmpstring";
631 $tmpstring =~ s/^OR //;
632 push @sqlstrings, $tmpstring;
634 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
637 $sql .= "$sqlwhere ORDER BY title";
638 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
639 $sth = $dbh->prepare($sql);
640 $sth->execute(@bind_params);
643 while ( my $line = $sth->fetchrow_hashref ) {
644 $line->{'cannotedit'} =
645 ( C4::Context->preference('IndependantBranches')
646 && C4::Context->userenv
647 && C4::Context->userenv->{flags} % 2 != 1
648 && C4::Context->userenv->{branch}
649 && $line->{branchcode}
650 && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
651 push @results, $line;
656 =head2 SearchSubscriptions
658 @results = SearchSubscriptions($args);
659 $args is a hashref. Its keys can be contained: title, issn, ean, publisher, bookseller and branchcode
661 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.
664 a table of hashref. Each hash containt the subscription.
668 sub SearchSubscriptions {
672 SELECT subscription.*, subscriptionhistory.*, biblio.*, biblioitems.issn
674 LEFT JOIN subscriptionhistory USING(subscriptionid)
675 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
676 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
677 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
681 if( $args->{biblionumber} ) {
682 push @where_strs, "biblio.biblionumber = ?";
683 push @where_args, $args->{biblionumber};
685 if( $args->{title} ){
686 my @words = split / /, $args->{title};
688 foreach my $word (@words) {
689 push @strs, "biblio.title LIKE ?";
690 push @args, "%$word%";
693 push @where_strs, '(' . join (' AND ', @strs) . ')';
694 push @where_args, @args;
698 push @where_strs, "biblioitems.issn LIKE ?";
699 push @where_args, "%$args->{issn}%";
702 push @where_strs, "biblioitems.ean LIKE ?";
703 push @where_args, "%$args->{ean}%";
705 if( $args->{publisher} ){
706 push @where_strs, "biblioitems.publishercode LIKE ?";
707 push @where_args, "%$args->{publisher}%";
709 if( $args->{bookseller} ){
710 push @where_strs, "aqbooksellers.name LIKE ?";
711 push @where_args, "%$args->{bookseller}%";
713 if( $args->{branch} ){
714 push @where_strs, "subscription.branchcode = ?";
715 push @where_args, "$args->{branch}";
717 if( defined $args->{closed} ){
718 push @where_strs, "subscription.closed = ?";
719 push @where_args, "$args->{closed}";
722 $query .= " WHERE " . join(" AND ", @where_strs);
725 my $dbh = C4::Context->dbh;
726 my $sth = $dbh->prepare($query);
727 $sth->execute(@where_args);
728 my $results = $sth->fetchall_arrayref( {} );
737 ($totalissues,@serials) = GetSerials($subscriptionid);
738 this function gets every serial not arrived for a given subscription
739 as well as the number of issues registered in the database (all types)
740 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
742 FIXME: We should return \@serials.
747 my ( $subscriptionid, $count ) = @_;
748 my $dbh = C4::Context->dbh;
750 # status = 2 is "arrived"
752 $count = 5 unless ($count);
754 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
756 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
757 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
758 my $sth = $dbh->prepare($query);
759 $sth->execute($subscriptionid);
761 while ( my $line = $sth->fetchrow_hashref ) {
762 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
763 for my $datefield ( qw( planneddate publisheddate) ) {
764 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
765 $line->{$datefield} = format_date( $line->{$datefield});
767 $line->{$datefield} = q{};
770 push @serials, $line;
773 # OK, now add the last 5 issues arrives/missing
774 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
776 WHERE subscriptionid = ?
777 AND (status in (2,4,5))
778 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
780 $sth = $dbh->prepare($query);
781 $sth->execute($subscriptionid);
782 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
784 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
785 for my $datefield ( qw( planneddate publisheddate) ) {
786 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
787 $line->{$datefield} = format_date( $line->{$datefield});
789 $line->{$datefield} = q{};
793 push @serials, $line;
796 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
797 $sth = $dbh->prepare($query);
798 $sth->execute($subscriptionid);
799 my ($totalissues) = $sth->fetchrow;
800 return ( $totalissues, @serials );
805 @serials = GetSerials2($subscriptionid,$status);
806 this function returns every serial waited for a given subscription
807 as well as the number of issues registered in the database (all types)
808 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
813 my ( $subscription, $status ) = @_;
814 my $dbh = C4::Context->dbh;
816 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
818 WHERE subscriptionid=$subscription AND status IN ($status)
819 ORDER BY publisheddate,serialid DESC
821 $debug and warn "GetSerials2 query: $query";
822 my $sth = $dbh->prepare($query);
826 while ( my $line = $sth->fetchrow_hashref ) {
827 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
828 # Format dates for display
829 for my $datefield ( qw( planneddate publisheddate ) ) {
830 if ($line->{$datefield} =~m/^00/) {
831 $line->{$datefield} = q{};
834 $line->{$datefield} = format_date( $line->{$datefield} );
837 push @serials, $line;
842 =head2 GetLatestSerials
844 \@serials = GetLatestSerials($subscriptionid,$limit)
845 get the $limit's latest serials arrived or missing for a given subscription
847 a ref to an array which contains all of the latest serials stored into a hash.
851 sub GetLatestSerials {
852 my ( $subscriptionid, $limit ) = @_;
853 my $dbh = C4::Context->dbh;
855 # status = 2 is "arrived"
856 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
858 WHERE subscriptionid = ?
859 AND (status =2 or status=4)
860 ORDER BY publisheddate DESC LIMIT 0,$limit
862 my $sth = $dbh->prepare($strsth);
863 $sth->execute($subscriptionid);
865 while ( my $line = $sth->fetchrow_hashref ) {
866 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
867 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
868 push @serials, $line;
874 =head2 GetDistributedTo
876 $distributedto=GetDistributedTo($subscriptionid)
877 This function returns the field distributedto for the subscription matching subscriptionid
881 sub GetDistributedTo {
882 my $dbh = C4::Context->dbh;
884 my $subscriptionid = @_;
885 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
886 my $sth = $dbh->prepare($query);
887 $sth->execute($subscriptionid);
888 return ($distributedto) = $sth->fetchrow;
894 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
895 $newinnerloop1, $newinnerloop2, $newinnerloop3
896 ) = GetNextSeq( $subscription, $pattern, $planneddate );
898 $subscription is a hashref containing all the attributes of the table
900 $pattern is a hashref containing all the attributes of the table
901 'subscription_numberpatterns'.
902 $planneddate is a C4::Dates object.
903 This function get the next issue for the subscription given on input arg
908 my ($subscription, $pattern, $planneddate) = @_;
909 my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
910 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
913 if ($subscription->{'skip_serialseq'}) {
914 my @irreg = split /;/, $subscription->{'irregularity'};
916 my $irregularities = {};
917 $irregularities->{$_} = 1 foreach(@irreg);
918 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
919 while($irregularities->{$issueno}) {
926 my $numberingmethod = $pattern->{numberingmethod};
927 $calculated = $numberingmethod;
928 my $locale = $subscription->{locale};
929 $newlastvalue1 = $subscription->{lastvalue1} || 0;
930 $newlastvalue2 = $subscription->{lastvalue2} || 0;
931 $newlastvalue3 = $subscription->{lastvalue3} || 0;
932 $newinnerloop1 = $subscription->{innerloop1} || 0;
933 $newinnerloop2 = $subscription->{innerloop2} || 0;
934 $newinnerloop3 = $subscription->{innerloop3} || 0;
937 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
940 for(my $i = 0; $i < $count; $i++) {
942 # check if we have to increase the new value.
944 if ($newinnerloop1 >= $pattern->{every1}) {
946 $newlastvalue1 += $pattern->{add1};
948 # reset counter if needed.
949 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
952 # check if we have to increase the new value.
954 if ($newinnerloop2 >= $pattern->{every2}) {
956 $newlastvalue2 += $pattern->{add2};
958 # reset counter if needed.
959 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
962 # check if we have to increase the new value.
964 if ($newinnerloop3 >= $pattern->{every3}) {
966 $newlastvalue3 += $pattern->{add3};
968 # reset counter if needed.
969 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
973 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
974 $calculated =~ s/\{X\}/$newlastvalue1string/g;
977 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
978 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
981 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
982 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
986 $newlastvalue1, $newlastvalue2, $newlastvalue3,
987 $newinnerloop1, $newinnerloop2, $newinnerloop3);
992 $calculated = GetSeq($subscription, $pattern)
993 $subscription is a hashref containing all the attributes of the table 'subscription'
994 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
995 this function transforms {X},{Y},{Z} to 150,0,0 for example.
997 the sequence in string format
1002 my ($subscription, $pattern) = @_;
1003 my $locale = $subscription->{locale};
1005 my $calculated = $pattern->{numberingmethod};
1007 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
1008 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
1009 $calculated =~ s/\{X\}/$newlastvalue1/g;
1011 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
1012 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
1013 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1015 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
1016 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
1017 $calculated =~ s/\{Z\}/$newlastvalue3/g;
1021 =head2 GetExpirationDate
1023 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1025 this function return the next expiration date for a subscription given on input args.
1028 the enddate or undef
1032 sub GetExpirationDate {
1033 my ( $subscriptionid, $startdate ) = @_;
1034 my $dbh = C4::Context->dbh;
1035 my $subscription = GetSubscription($subscriptionid);
1038 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1039 $enddate = $startdate || $subscription->{startdate};
1040 my @date = split( /-/, $enddate );
1041 return if ( scalar(@date) != 3 || not check_date(@date) );
1042 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1043 if ( $frequency and $frequency->{unit} ) {
1046 if ( my $length = $subscription->{numberlength} ) {
1048 #calculate the date of the last issue.
1049 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1050 $enddate = GetNextDate( $subscription, $enddate );
1052 } elsif ( $subscription->{monthlength} ) {
1053 if ( $$subscription{startdate} ) {
1054 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1055 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1057 } elsif ( $subscription->{weeklength} ) {
1058 if ( $$subscription{startdate} ) {
1059 my @date = split( /-/, $subscription->{startdate} );
1060 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1061 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1064 $enddate = $subscription->{enddate};
1068 return $subscription->{enddate};
1072 =head2 CountSubscriptionFromBiblionumber
1074 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1075 this returns a count of the subscriptions for a given biblionumber
1077 the number of subscriptions
1081 sub CountSubscriptionFromBiblionumber {
1082 my ($biblionumber) = @_;
1083 my $dbh = C4::Context->dbh;
1084 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1085 my $sth = $dbh->prepare($query);
1086 $sth->execute($biblionumber);
1087 my $subscriptionsnumber = $sth->fetchrow;
1088 return $subscriptionsnumber;
1091 =head2 ModSubscriptionHistory
1093 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1095 this function modifies the history of a subscription. Put your new values on input arg.
1096 returns the number of rows affected
1100 sub ModSubscriptionHistory {
1101 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1102 my $dbh = C4::Context->dbh;
1103 my $query = "UPDATE subscriptionhistory
1104 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1105 WHERE subscriptionid=?
1107 my $sth = $dbh->prepare($query);
1108 $receivedlist =~ s/^; // if $receivedlist;
1109 $missinglist =~ s/^; // if $missinglist;
1110 $opacnote =~ s/^; // if $opacnote;
1111 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1115 # Update missinglist field, used by ModSerialStatus
1116 sub _update_missinglist {
1117 my $subscriptionid = shift;
1119 my $dbh = C4::Context->dbh;
1120 my @missingserials = GetSerials2($subscriptionid, "4,5");
1122 foreach (@missingserials) {
1123 if($_->{'status'} == 4) {
1124 $missinglist .= $_->{'serialseq'} . "; ";
1125 } elsif($_->{'status'} == 5) {
1126 $missinglist .= "not issued " . $_->{'serialseq'} . "; ";
1129 $missinglist =~ s/; $//;
1131 UPDATE subscriptionhistory
1133 WHERE subscriptionid = ?
1135 my $sth = $dbh->prepare($query);
1136 $sth->execute($missinglist, $subscriptionid);
1139 # Update recievedlist field, used by ModSerialStatus
1140 sub _update_receivedlist {
1141 my $subscriptionid = shift;
1143 my $dbh = C4::Context->dbh;
1144 my @receivedserials = GetSerials2($subscriptionid, "2");
1146 foreach (@receivedserials) {
1147 $receivedlist .= $_->{'serialseq'} . "; ";
1149 $receivedlist =~ s/; $//;
1151 UPDATE subscriptionhistory
1152 SET recievedlist = ?
1153 WHERE subscriptionid = ?
1155 my $sth = $dbh->prepare($query);
1156 $sth->execute($receivedlist, $subscriptionid);
1159 =head2 ModSerialStatus
1161 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1163 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1164 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1168 sub ModSerialStatus {
1169 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1172 #It is a usual serial
1173 # 1st, get previous status :
1174 my $dbh = C4::Context->dbh;
1175 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1176 FROM serial, subscription
1177 WHERE serial.subscriptionid=subscription.subscriptionid
1179 my $sth = $dbh->prepare($query);
1180 $sth->execute($serialid);
1181 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1182 my $frequency = GetSubscriptionFrequency($periodicity);
1184 # change status & update subscriptionhistory
1186 if ( $status == 6 ) {
1187 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1190 unless ($frequency->{'unit'}) {
1191 if ( not $planneddate or $planneddate eq '0000-00-00' ) { $planneddate = C4::Dates->new()->output('iso') };
1192 if ( not $publisheddate or $publisheddate eq '0000-00-00' ) { $publisheddate = C4::Dates->new()->output('iso') };
1194 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1195 $sth = $dbh->prepare($query);
1196 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1197 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1198 $sth = $dbh->prepare($query);
1199 $sth->execute($subscriptionid);
1200 my $val = $sth->fetchrow_hashref;
1201 unless ( $val->{manualhistory} ) {
1202 if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) {
1203 _update_receivedlist($subscriptionid);
1205 if($status == 4 || $status == 5
1206 || ($oldstatus == 4 && $status != 4)
1207 || ($oldstatus == 5 && $status != 5)) {
1208 _update_missinglist($subscriptionid);
1213 # create new waited entry if needed (ie : was a "waited" and has changed)
1214 if ( $oldstatus == 1 && $status != 1 ) {
1215 my $subscription = GetSubscription($subscriptionid);
1216 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1220 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1221 $newinnerloop1, $newinnerloop2, $newinnerloop3
1223 = GetNextSeq( $subscription, $pattern, $publisheddate );
1225 # next date (calculated from actual date & frequency parameters)
1226 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1227 my $nextpubdate = $nextpublisheddate;
1228 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1229 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1230 WHERE subscriptionid = ?";
1231 $sth = $dbh->prepare($query);
1232 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1234 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1235 if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) {
1236 require C4::Letters;
1237 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1244 =head2 GetNextExpected
1246 $nextexpected = GetNextExpected($subscriptionid)
1248 Get the planneddate for the current expected issue of the subscription.
1254 planneddate => ISO date
1259 sub GetNextExpected {
1260 my ($subscriptionid) = @_;
1262 my $dbh = C4::Context->dbh;
1266 WHERE subscriptionid = ?
1270 my $sth = $dbh->prepare($query);
1272 # Each subscription has only one 'expected' issue, with serial.status==1.
1273 $sth->execute( $subscriptionid, 1 );
1274 my $nextissue = $sth->fetchrow_hashref;
1275 if ( !$nextissue ) {
1279 WHERE subscriptionid = ?
1280 ORDER BY publisheddate DESC
1283 $sth = $dbh->prepare($query);
1284 $sth->execute($subscriptionid);
1285 $nextissue = $sth->fetchrow_hashref;
1287 foreach(qw/planneddate publisheddate/) {
1288 if ( !defined $nextissue->{$_} ) {
1289 # or should this default to 1st Jan ???
1290 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1292 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1300 =head2 ModNextExpected
1302 ModNextExpected($subscriptionid,$date)
1304 Update the planneddate for the current expected issue of the subscription.
1305 This will modify all future prediction results.
1307 C<$date> is an ISO date.
1313 sub ModNextExpected {
1314 my ( $subscriptionid, $date ) = @_;
1315 my $dbh = C4::Context->dbh;
1317 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1318 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1320 # Each subscription has only one 'expected' issue, with serial.status==1.
1321 $sth->execute( $date, $date, $subscriptionid, 1 );
1326 =head2 GetSubscriptionIrregularities
1330 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1331 get the list of irregularities for a subscription
1337 sub GetSubscriptionIrregularities {
1338 my $subscriptionid = shift;
1340 return unless $subscriptionid;
1342 my $dbh = C4::Context->dbh;
1346 WHERE subscriptionid = ?
1348 my $sth = $dbh->prepare($query);
1349 $sth->execute($subscriptionid);
1351 my ($result) = $sth->fetchrow_array;
1352 my @irreg = split /;/, $result;
1357 =head2 ModSubscription
1359 this function modifies a subscription. Put all new values on input args.
1360 returns the number of rows affected
1364 sub ModSubscription {
1366 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1367 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1368 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1369 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1370 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1371 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1372 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1375 my $dbh = C4::Context->dbh;
1376 my $query = "UPDATE subscription
1377 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1378 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1379 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1380 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1381 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1382 callnumber=?, notes=?, letter=?, manualhistory=?,
1383 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1384 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1386 WHERE subscriptionid = ?";
1388 my $sth = $dbh->prepare($query);
1390 $auser, $branchcode, $aqbooksellerid, $cost,
1391 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1392 $irregularity, $numberpattern, $locale, $numberlength,
1393 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1394 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1395 $status, $biblionumber, $callnumber, $notes,
1396 $letter, ($manualhistory ? $manualhistory : 0),
1397 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1398 $graceperiod, $location, $enddate, $skip_serialseq,
1401 my $rows = $sth->rows;
1403 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1407 =head2 NewSubscription
1409 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1410 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1411 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1412 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1413 $callnumber, $hemisphere, $manualhistory, $internalnotes, $serialsadditems,
1414 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1416 Create a new subscription with value given on input args.
1419 the id of this new subscription
1423 sub NewSubscription {
1425 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1426 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1427 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1428 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1429 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1430 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1431 $location, $enddate, $skip_serialseq
1433 my $dbh = C4::Context->dbh;
1435 #save subscription (insert into database)
1437 INSERT INTO subscription
1438 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1439 biblionumber, startdate, periodicity, numberlength, weeklength,
1440 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1441 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1442 irregularity, numberpattern, locale, callnumber,
1443 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1444 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1445 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1447 my $sth = $dbh->prepare($query);
1449 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1450 $startdate, $periodicity, $numberlength, $weeklength,
1451 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1452 $lastvalue3, $innerloop3, $status, $notes, $letter,
1453 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1454 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1455 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1458 my $subscriptionid = $dbh->{'mysql_insertid'};
1460 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1464 WHERE subscriptionid=?
1466 $sth = $dbh->prepare($query);
1467 $sth->execute( $enddate, $subscriptionid );
1470 # then create the 1st expected number
1472 INSERT INTO subscriptionhistory
1473 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1476 $sth = $dbh->prepare($query);
1477 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1479 # reread subscription to get a hash (for calculation of the 1st issue number)
1480 my $subscription = GetSubscription($subscriptionid);
1481 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1483 # calculate issue number
1484 my $serialseq = GetSeq($subscription, $pattern);
1487 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1488 VALUES (?,?,?,?,?,?)
1490 $sth = $dbh->prepare($query);
1491 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1493 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1495 #set serial flag on biblio if not already set.
1496 my $bib = GetBiblio($biblionumber);
1497 if ( $bib and !$bib->{'serial'} ) {
1498 my $record = GetMarcBiblio($biblionumber);
1499 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1501 eval { $record->field($tag)->update( $subf => 1 ); };
1503 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1505 return $subscriptionid;
1508 =head2 ReNewSubscription
1510 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1512 this function renew a subscription with values given on input args.
1516 sub ReNewSubscription {
1517 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1518 my $dbh = C4::Context->dbh;
1519 my $subscription = GetSubscription($subscriptionid);
1523 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1524 WHERE biblio.biblionumber=?
1526 my $sth = $dbh->prepare($query);
1527 $sth->execute( $subscription->{biblionumber} );
1528 my $biblio = $sth->fetchrow_hashref;
1530 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1531 require C4::Suggestions;
1532 C4::Suggestions::NewSuggestion(
1533 { 'suggestedby' => $user,
1534 'title' => $subscription->{bibliotitle},
1535 'author' => $biblio->{author},
1536 'publishercode' => $biblio->{publishercode},
1537 'note' => $biblio->{note},
1538 'biblionumber' => $subscription->{biblionumber}
1543 # renew subscription
1546 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1547 WHERE subscriptionid=?
1549 $sth = $dbh->prepare($query);
1550 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1551 my $enddate = GetExpirationDate($subscriptionid);
1552 $debug && warn "enddate :$enddate";
1556 WHERE subscriptionid=?
1558 $sth = $dbh->prepare($query);
1559 $sth->execute( $enddate, $subscriptionid );
1561 UPDATE subscriptionhistory
1563 WHERE subscriptionid=?
1565 $sth = $dbh->prepare($query);
1566 $sth->execute( $enddate, $subscriptionid );
1568 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1574 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1576 Create a new issue stored on the database.
1577 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1578 returns the serial id
1583 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1584 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1586 my $dbh = C4::Context->dbh;
1589 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1590 VALUES (?,?,?,?,?,?,?)
1592 my $sth = $dbh->prepare($query);
1593 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1594 my $serialid = $dbh->{'mysql_insertid'};
1596 SELECT missinglist,recievedlist
1597 FROM subscriptionhistory
1598 WHERE subscriptionid=?
1600 $sth = $dbh->prepare($query);
1601 $sth->execute($subscriptionid);
1602 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1604 if ( $status == 2 ) {
1605 ### TODO Add a feature that improves recognition and description.
1606 ### As such count (serialseq) i.e. : N18,2(N19),N20
1607 ### Would use substr and index But be careful to previous presence of ()
1608 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1610 if ( $status == 4 ) {
1611 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1614 UPDATE subscriptionhistory
1615 SET recievedlist=?, missinglist=?
1616 WHERE subscriptionid=?
1618 $sth = $dbh->prepare($query);
1619 $recievedlist =~ s/^; //;
1620 $missinglist =~ s/^; //;
1621 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1625 =head2 ItemizeSerials
1627 ItemizeSerials($serialid, $info);
1628 $info is a hashref containing barcode branch, itemcallnumber, status, location
1629 $serialid the serialid
1631 1 if the itemize is a succes.
1632 0 and @error otherwise. @error containts the list of errors found.
1636 sub ItemizeSerials {
1637 my ( $serialid, $info ) = @_;
1638 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1640 my $dbh = C4::Context->dbh;
1646 my $sth = $dbh->prepare($query);
1647 $sth->execute($serialid);
1648 my $data = $sth->fetchrow_hashref;
1649 if ( C4::Context->preference("RoutingSerials") ) {
1651 # check for existing biblioitem relating to serial issue
1652 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1654 for ( my $i = 0 ; $i < $count ; $i++ ) {
1655 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1656 $bibitemno = $results[$i]->{'biblioitemnumber'};
1660 if ( $bibitemno == 0 ) {
1661 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1662 $sth->execute( $data->{'biblionumber'} );
1663 my $biblioitem = $sth->fetchrow_hashref;
1664 $biblioitem->{'volumedate'} = $data->{planneddate};
1665 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1666 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1670 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1671 if ( $info->{barcode} ) {
1673 if ( is_barcode_in_use( $info->{barcode} ) ) {
1674 push @errors, 'barcode_not_unique';
1676 my $marcrecord = MARC::Record->new();
1677 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1678 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1679 $marcrecord->insert_fields_ordered($newField);
1680 if ( $info->{branch} ) {
1681 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1683 #warn "items.homebranch : $tag , $subfield";
1684 if ( $marcrecord->field($tag) ) {
1685 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1687 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1688 $marcrecord->insert_fields_ordered($newField);
1690 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1692 #warn "items.holdingbranch : $tag , $subfield";
1693 if ( $marcrecord->field($tag) ) {
1694 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1696 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1697 $marcrecord->insert_fields_ordered($newField);
1700 if ( $info->{itemcallnumber} ) {
1701 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1703 if ( $marcrecord->field($tag) ) {
1704 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1706 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1707 $marcrecord->insert_fields_ordered($newField);
1710 if ( $info->{notes} ) {
1711 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1713 if ( $marcrecord->field($tag) ) {
1714 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1716 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1717 $marcrecord->insert_fields_ordered($newField);
1720 if ( $info->{location} ) {
1721 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1723 if ( $marcrecord->field($tag) ) {
1724 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1726 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1727 $marcrecord->insert_fields_ordered($newField);
1730 if ( $info->{status} ) {
1731 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1733 if ( $marcrecord->field($tag) ) {
1734 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1736 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1737 $marcrecord->insert_fields_ordered($newField);
1740 if ( C4::Context->preference("RoutingSerials") ) {
1741 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1742 if ( $marcrecord->field($tag) ) {
1743 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1745 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1746 $marcrecord->insert_fields_ordered($newField);
1750 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1753 return ( 0, @errors );
1757 =head2 HasSubscriptionStrictlyExpired
1759 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1761 the subscription has stricly expired when today > the end subscription date
1764 1 if true, 0 if false, -1 if the expiration date is not set.
1768 sub HasSubscriptionStrictlyExpired {
1770 # Getting end of subscription date
1771 my ($subscriptionid) = @_;
1772 my $dbh = C4::Context->dbh;
1773 my $subscription = GetSubscription($subscriptionid);
1774 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1776 # If the expiration date is set
1777 if ( $expirationdate != 0 ) {
1778 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1780 # Getting today's date
1781 my ( $nowyear, $nowmonth, $nowday ) = Today();
1783 # if today's date > expiration date, then the subscription has stricly expired
1784 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1791 # There are some cases where the expiration date is not set
1792 # As we can't determine if the subscription has expired on a date-basis,
1798 =head2 HasSubscriptionExpired
1800 $has_expired = HasSubscriptionExpired($subscriptionid)
1802 the subscription has expired when the next issue to arrive is out of subscription limit.
1805 0 if the subscription has not expired
1806 1 if the subscription has expired
1807 2 if has subscription does not have a valid expiration date set
1811 sub HasSubscriptionExpired {
1812 my ($subscriptionid) = @_;
1813 my $dbh = C4::Context->dbh;
1814 my $subscription = GetSubscription($subscriptionid);
1815 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1816 if ( $frequency and $frequency->{unit} ) {
1817 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1818 if (!defined $expirationdate) {
1819 $expirationdate = q{};
1822 SELECT max(planneddate)
1824 WHERE subscriptionid=?
1826 my $sth = $dbh->prepare($query);
1827 $sth->execute($subscriptionid);
1828 my ($res) = $sth->fetchrow;
1829 if (!$res || $res=~m/^0000/) {
1832 my @res = split( /-/, $res );
1833 my @endofsubscriptiondate = split( /-/, $expirationdate );
1834 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1836 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1841 if ( $subscription->{'numberlength'} ) {
1842 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1843 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1849 return 0; # Notice that you'll never get here.
1852 =head2 SetDistributedto
1854 SetDistributedto($distributedto,$subscriptionid);
1855 This function update the value of distributedto for a subscription given on input arg.
1859 sub SetDistributedto {
1860 my ( $distributedto, $subscriptionid ) = @_;
1861 my $dbh = C4::Context->dbh;
1865 WHERE subscriptionid=?
1867 my $sth = $dbh->prepare($query);
1868 $sth->execute( $distributedto, $subscriptionid );
1872 =head2 DelSubscription
1874 DelSubscription($subscriptionid)
1875 this function deletes subscription which has $subscriptionid as id.
1879 sub DelSubscription {
1880 my ($subscriptionid) = @_;
1881 my $dbh = C4::Context->dbh;
1882 $subscriptionid = $dbh->quote($subscriptionid);
1883 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1884 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1885 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1887 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1892 DelIssue($serialseq,$subscriptionid)
1893 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1895 returns the number of rows affected
1900 my ($dataissue) = @_;
1901 my $dbh = C4::Context->dbh;
1902 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1907 AND subscriptionid= ?
1909 my $mainsth = $dbh->prepare($query);
1910 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1912 #Delete element from subscription history
1913 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1914 my $sth = $dbh->prepare($query);
1915 $sth->execute( $dataissue->{'subscriptionid'} );
1916 my $val = $sth->fetchrow_hashref;
1917 unless ( $val->{manualhistory} ) {
1919 SELECT * FROM subscriptionhistory
1920 WHERE subscriptionid= ?
1922 my $sth = $dbh->prepare($query);
1923 $sth->execute( $dataissue->{'subscriptionid'} );
1924 my $data = $sth->fetchrow_hashref;
1925 my $serialseq = $dataissue->{'serialseq'};
1926 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1927 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1928 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1929 $sth = $dbh->prepare($strsth);
1930 $sth->execute( $dataissue->{'subscriptionid'} );
1933 return $mainsth->rows;
1936 =head2 GetLateOrMissingIssues
1938 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1940 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1943 the issuelist as an array of hash refs. Each element of this array contains
1944 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1948 sub GetLateOrMissingIssues {
1949 my ( $supplierid, $serialid, $order ) = @_;
1950 my $dbh = C4::Context->dbh;
1954 $byserial = "and serialid = " . $serialid;
1957 $order .= ", title";
1962 $sth = $dbh->prepare(
1964 serialid, aqbooksellerid, name,
1965 biblio.title, planneddate, serialseq,
1966 serial.status, serial.subscriptionid, claimdate,
1967 subscription.branchcode
1969 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1970 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1971 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1972 WHERE subscription.subscriptionid = serial.subscriptionid
1973 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1974 AND subscription.aqbooksellerid=$supplierid
1979 $sth = $dbh->prepare(
1981 serialid, aqbooksellerid, name,
1982 biblio.title, planneddate, serialseq,
1983 serial.status, serial.subscriptionid, claimdate,
1984 subscription.branchcode
1986 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1987 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1988 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1989 WHERE subscription.subscriptionid = serial.subscriptionid
1990 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1997 while ( my $line = $sth->fetchrow_hashref ) {
1999 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
2000 $line->{planneddate} = format_date( $line->{planneddate} );
2002 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
2003 $line->{claimdate} = format_date( $line->{claimdate} );
2005 $line->{"status".$line->{status}} = 1;
2006 push @issuelist, $line;
2011 =head2 removeMissingIssue
2013 removeMissingIssue($subscriptionid)
2015 this function removes an issue from being part of the missing string in
2016 subscriptionlist.missinglist column
2018 called when a missing issue is found from the serials-recieve.pl file
2022 sub removeMissingIssue {
2023 my ( $sequence, $subscriptionid ) = @_;
2024 my $dbh = C4::Context->dbh;
2025 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2026 $sth->execute($subscriptionid);
2027 my $data = $sth->fetchrow_hashref;
2028 my $missinglist = $data->{'missinglist'};
2029 my $missinglistbefore = $missinglist;
2031 # warn $missinglist." before";
2032 $missinglist =~ s/($sequence)//;
2034 # warn $missinglist." after";
2035 if ( $missinglist ne $missinglistbefore ) {
2036 $missinglist =~ s/\|\s\|/\|/g;
2037 $missinglist =~ s/^\| //g;
2038 $missinglist =~ s/\|$//g;
2039 my $sth2 = $dbh->prepare(
2040 "UPDATE subscriptionhistory
2042 WHERE subscriptionid = ?"
2044 $sth2->execute( $missinglist, $subscriptionid );
2051 &updateClaim($serialid)
2053 this function updates the time when a claim is issued for late/missing items
2055 called from claims.pl file
2060 my ($serialid) = @_;
2061 my $dbh = C4::Context->dbh;
2062 my $sth = $dbh->prepare(
2063 "UPDATE serial SET claimdate = now()
2067 $sth->execute($serialid);
2071 =head2 getsupplierbyserialid
2073 $result = getsupplierbyserialid($serialid)
2075 this function is used to find the supplier id given a serial id
2078 hashref containing serialid, subscriptionid, and aqbooksellerid
2082 sub getsupplierbyserialid {
2083 my ($serialid) = @_;
2084 my $dbh = C4::Context->dbh;
2085 my $sth = $dbh->prepare(
2086 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2088 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2092 $sth->execute($serialid);
2093 my $line = $sth->fetchrow_hashref;
2094 my $result = $line->{'aqbooksellerid'};
2098 =head2 check_routing
2100 $result = &check_routing($subscriptionid)
2102 this function checks to see if a serial has a routing list and returns the count of routingid
2103 used to show either an 'add' or 'edit' link
2108 my ($subscriptionid) = @_;
2109 my $dbh = C4::Context->dbh;
2110 my $sth = $dbh->prepare(
2111 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2112 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2113 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2116 $sth->execute($subscriptionid);
2117 my $line = $sth->fetchrow_hashref;
2118 my $result = $line->{'routingids'};
2122 =head2 addroutingmember
2124 addroutingmember($borrowernumber,$subscriptionid)
2126 this function takes a borrowernumber and subscriptionid and adds the member to the
2127 routing list for that serial subscription and gives them a rank on the list
2128 of either 1 or highest current rank + 1
2132 sub addroutingmember {
2133 my ( $borrowernumber, $subscriptionid ) = @_;
2135 my $dbh = C4::Context->dbh;
2136 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2137 $sth->execute($subscriptionid);
2138 while ( my $line = $sth->fetchrow_hashref ) {
2139 if ( $line->{'rank'} > 0 ) {
2140 $rank = $line->{'rank'} + 1;
2145 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2146 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2149 =head2 reorder_members
2151 reorder_members($subscriptionid,$routingid,$rank)
2153 this function is used to reorder the routing list
2155 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2156 - it gets all members on list puts their routingid's into an array
2157 - removes the one in the array that is $routingid
2158 - then reinjects $routingid at point indicated by $rank
2159 - then update the database with the routingids in the new order
2163 sub reorder_members {
2164 my ( $subscriptionid, $routingid, $rank ) = @_;
2165 my $dbh = C4::Context->dbh;
2166 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2167 $sth->execute($subscriptionid);
2169 while ( my $line = $sth->fetchrow_hashref ) {
2170 push( @result, $line->{'routingid'} );
2173 # To find the matching index
2175 my $key = -1; # to allow for 0 being a valid response
2176 for ( $i = 0 ; $i < @result ; $i++ ) {
2177 if ( $routingid == $result[$i] ) {
2178 $key = $i; # save the index
2183 # if index exists in array then move it to new position
2184 if ( $key > -1 && $rank > 0 ) {
2185 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2186 my $moving_item = splice( @result, $key, 1 );
2187 splice( @result, $new_rank, 0, $moving_item );
2189 for ( my $j = 0 ; $j < @result ; $j++ ) {
2190 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2196 =head2 delroutingmember
2198 delroutingmember($routingid,$subscriptionid)
2200 this function either deletes one member from routing list if $routingid exists otherwise
2201 deletes all members from the routing list
2205 sub delroutingmember {
2207 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2208 my ( $routingid, $subscriptionid ) = @_;
2209 my $dbh = C4::Context->dbh;
2211 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2212 $sth->execute($routingid);
2213 reorder_members( $subscriptionid, $routingid );
2215 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2216 $sth->execute($subscriptionid);
2221 =head2 getroutinglist
2223 @routinglist = getroutinglist($subscriptionid)
2225 this gets the info from the subscriptionroutinglist for $subscriptionid
2228 the routinglist as an array. Each element of the array contains a hash_ref containing
2229 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2233 sub getroutinglist {
2234 my ($subscriptionid) = @_;
2235 my $dbh = C4::Context->dbh;
2236 my $sth = $dbh->prepare(
2237 'SELECT routingid, borrowernumber, ranking, biblionumber
2239 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2240 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2242 $sth->execute($subscriptionid);
2243 my $routinglist = $sth->fetchall_arrayref({});
2244 return @{$routinglist};
2247 =head2 countissuesfrom
2249 $result = countissuesfrom($subscriptionid,$startdate)
2251 Returns a count of serial rows matching the given subsctiptionid
2252 with published date greater than startdate
2256 sub countissuesfrom {
2257 my ( $subscriptionid, $startdate ) = @_;
2258 my $dbh = C4::Context->dbh;
2262 WHERE subscriptionid=?
2263 AND serial.publisheddate>?
2265 my $sth = $dbh->prepare($query);
2266 $sth->execute( $subscriptionid, $startdate );
2267 my ($countreceived) = $sth->fetchrow;
2268 return $countreceived;
2273 $result = CountIssues($subscriptionid)
2275 Returns a count of serial rows matching the given subsctiptionid
2280 my ($subscriptionid) = @_;
2281 my $dbh = C4::Context->dbh;
2285 WHERE subscriptionid=?
2287 my $sth = $dbh->prepare($query);
2288 $sth->execute($subscriptionid);
2289 my ($countreceived) = $sth->fetchrow;
2290 return $countreceived;
2295 $result = HasItems($subscriptionid)
2297 returns a count of items from serial matching the subscriptionid
2302 my ($subscriptionid) = @_;
2303 my $dbh = C4::Context->dbh;
2305 SELECT COUNT(serialitems.itemnumber)
2307 LEFT JOIN serialitems USING(serialid)
2308 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2310 my $sth=$dbh->prepare($query);
2311 $sth->execute($subscriptionid);
2312 my ($countitems)=$sth->fetchrow_array();
2316 =head2 abouttoexpire
2318 $result = abouttoexpire($subscriptionid)
2320 this function alerts you to the penultimate issue for a serial subscription
2322 returns 1 - if this is the penultimate issue
2328 my ($subscriptionid) = @_;
2329 my $dbh = C4::Context->dbh;
2330 my $subscription = GetSubscription($subscriptionid);
2331 my $per = $subscription->{'periodicity'};
2332 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2333 if ($frequency and $frequency->{unit}){
2334 my $expirationdate = GetExpirationDate($subscriptionid);
2335 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2336 my $nextdate = GetNextDate($subscription, $res);
2337 if(Date::Calc::Delta_Days(
2338 split( /-/, $nextdate ),
2339 split( /-/, $expirationdate )
2343 } elsif ($subscription->{numberlength}>0) {
2344 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2349 sub in_array { # used in next sub down
2350 my ( $val, @elements ) = @_;
2351 foreach my $elem (@elements) {
2352 if ( $val == $elem ) {
2359 =head2 GetSubscriptionsFromBorrower
2361 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2363 this gets the info from subscriptionroutinglist for each $subscriptionid
2366 a count of the serial subscription routing lists to which a patron belongs,
2367 with the titles of those serial subscriptions as an array. Each element of the array
2368 contains a hash_ref with subscriptionID and title of subscription.
2372 sub GetSubscriptionsFromBorrower {
2373 my ($borrowernumber) = @_;
2374 my $dbh = C4::Context->dbh;
2375 my $sth = $dbh->prepare(
2376 "SELECT subscription.subscriptionid, biblio.title
2378 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2379 JOIN subscriptionroutinglist USING (subscriptionid)
2380 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2383 $sth->execute($borrowernumber);
2386 while ( my $line = $sth->fetchrow_hashref ) {
2388 push( @routinglist, $line );
2390 return ( $count, @routinglist );
2394 =head2 GetFictiveIssueNumber
2396 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2398 Get the position of the issue published at $publisheddate, considering the
2399 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2400 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2401 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2402 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2403 depending on how many rows are in serial table.
2404 The issue number calculation is based on subscription frequency, first acquisition
2405 date, and $publisheddate.
2409 sub GetFictiveIssueNumber {
2410 my ($subscription, $publisheddate) = @_;
2412 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2413 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2417 my ($year, $month, $day) = split /-/, $publisheddate;
2418 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2422 if($unit eq 'day') {
2423 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2424 } elsif($unit eq 'week') {
2425 ($wkno, $year) = Week_of_Year($year, $month, $day);
2426 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2427 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2428 } elsif($unit eq 'month') {
2429 $delta = ($fa_year == $year)
2430 ? ($month - $fa_month)
2431 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2432 } elsif($unit eq 'year') {
2433 $delta = $year - $fa_year;
2435 if($frequency->{'unitsperissue'} == 1) {
2436 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2438 # Assuming issuesperunit == 1
2439 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2447 $resultdate = GetNextDate($publisheddate,$subscription)
2449 this function it takes the publisheddate and will return the next issue's date
2450 and will skip dates if there exists an irregularity.
2451 $publisheddate has to be an ISO date
2452 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2453 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2454 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2455 skipped then the returned date will be 2007-05-10
2458 $resultdate - then next date in the sequence (ISO date)
2460 Return $publisheddate if subscription is irregular
2465 my ( $subscription, $publisheddate, $updatecount ) = @_;
2467 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2469 if ($freqdata->{'unit'}) {
2470 my ( $year, $month, $day ) = split /-/, $publisheddate;
2472 # Process an irregularity Hash
2473 # Suppose that irregularities are stored in a string with this structure
2474 # irreg1;irreg2;irreg3
2475 # where irregX is the number of issue which will not be received
2476 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2477 my @irreg = split /;/, $subscription->{'irregularity'} ;
2479 foreach my $irregularity (@irreg) {
2480 $irregularities{$irregularity} = 1;
2483 # Get the 'fictive' next issue number
2484 # It is used to check if next issue is an irregular issue.
2485 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2487 # Then get the next date
2488 my $unit = lc $freqdata->{'unit'};
2489 if ($unit eq 'day') {
2490 while ($irregularities{$issueno}) {
2491 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2492 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} );
2493 $subscription->{'countissuesperunit'} = 1;
2495 $subscription->{'countissuesperunit'}++;
2499 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2500 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} );
2501 $subscription->{'countissuesperunit'} = 1;
2503 $subscription->{'countissuesperunit'}++;
2506 elsif ($unit eq 'week') {
2507 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2508 while ($irregularities{$issueno}) {
2509 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2510 $subscription->{'countissuesperunit'} = 1;
2511 $wkno += $freqdata->{"unitsperissue"};
2516 my $dow = Day_of_Week($year, $month, $day);
2517 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2518 if($freqdata->{'issuesperunit'} == 1) {
2519 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2522 $subscription->{'countissuesperunit'}++;
2526 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2527 $subscription->{'countissuesperunit'} = 1;
2528 $wkno += $freqdata->{"unitsperissue"};
2530 $wkno = $wkno % 52 ;
2533 my $dow = Day_of_Week($year, $month, $day);
2534 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2535 if($freqdata->{'issuesperunit'} == 1) {
2536 ($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1);
2539 $subscription->{'countissuesperunit'}++;
2542 elsif ($unit eq 'month') {
2543 while ($irregularities{$issueno}) {
2544 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2545 $subscription->{'countissuesperunit'} = 1;
2546 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2547 unless($freqdata->{'issuesperunit'} == 1) {
2548 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2551 $subscription->{'countissuesperunit'}++;
2555 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2556 $subscription->{'countissuesperunit'} = 1;
2557 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"});
2558 unless($freqdata->{'issuesperunit'} == 1) {
2559 $day = 1; # Jumping to the first day of month, because we don't know what day is expected
2562 $subscription->{'countissuesperunit'}++;
2565 elsif ($unit eq 'year') {
2566 while ($irregularities{$issueno}) {
2567 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2568 $subscription->{'countissuesperunit'} = 1;
2569 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2570 unless($freqdata->{'issuesperunit'} == 1) {
2571 # Jumping to the first day of year, because we don't know what day is expected
2576 $subscription->{'countissuesperunit'}++;
2580 if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){
2581 $subscription->{'countissuesperunit'} = 1;
2582 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2583 unless($freqdata->{'issuesperunit'} == 1) {
2584 # Jumping to the first day of year, because we don't know what day is expected
2589 $subscription->{'countissuesperunit'}++;
2593 my $dbh = C4::Context->dbh;
2596 SET countissuesperunit = ?
2597 WHERE subscriptionid = ?
2599 my $sth = $dbh->prepare($query);
2600 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2602 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2605 return $publisheddate;
2611 $string = &_numeration($value,$num_type,$locale);
2613 _numeration returns the string corresponding to $value in the num_type
2623 my ($value, $num_type, $locale) = @_;
2625 my $initlocale = setlocale(LC_TIME);
2626 if($locale and $locale ne $initlocale) {
2627 $locale = setlocale(LC_TIME, $locale);
2629 $locale ||= $initlocale;
2633 when (/^dayname$/) {
2634 $value = $value % 7;
2635 $string = POSIX::strftime("%A",0,0,0,0,0,0,$value);
2637 when (/^monthname$/) {
2638 $value = $value % 12;
2639 $string = POSIX::strftime("%B",0,0,0,1,$value,0,0,0,0);
2642 my $seasonlocale = ($locale)
2643 ? (substr $locale,0,2)
2647 [qw(Spring Summer Fall Winter)],
2649 [qw(Printemps Été Automne Hiver)],
2651 $value = $value % 4;
2652 $string = ($seasons{$seasonlocale})
2653 ? $seasons{$seasonlocale}->[$value]
2654 : $seasons{'en'}->[$value];
2660 if($locale ne $initlocale) {
2661 setlocale(LC_TIME, $initlocale);
2666 =head2 is_barcode_in_use
2668 Returns number of occurence of the barcode in the items table
2669 Can be used as a boolean test of whether the barcode has
2670 been deployed as yet
2674 sub is_barcode_in_use {
2675 my $barcode = shift;
2676 my $dbh = C4::Context->dbh;
2677 my $occurences = $dbh->selectall_arrayref(
2678 'SELECT itemnumber from items where barcode = ?',
2683 return @{$occurences};
2686 =head2 CloseSubscription
2687 Close a subscription given a subscriptionid
2689 sub CloseSubscription {
2690 my ( $subscriptionid ) = @_;
2691 return unless $subscriptionid;
2692 my $dbh = C4::Context->dbh;
2693 my $sth = $dbh->prepare( qq{
2696 WHERE subscriptionid = ?
2698 $sth->execute( $subscriptionid );
2700 # Set status = missing when status = stopped
2701 $sth = $dbh->prepare( qq{
2704 WHERE subscriptionid = ?
2707 $sth->execute( $subscriptionid );
2710 =head2 ReopenSubscription
2711 Reopen a subscription given a subscriptionid
2713 sub ReopenSubscription {
2714 my ( $subscriptionid ) = @_;
2715 return unless $subscriptionid;
2716 my $dbh = C4::Context->dbh;
2717 my $sth = $dbh->prepare( qq{
2720 WHERE subscriptionid = ?
2722 $sth->execute( $subscriptionid );
2724 # Set status = expected when status = stopped
2725 $sth = $dbh->prepare( qq{
2728 WHERE subscriptionid = ?
2731 $sth->execute( $subscriptionid );
2734 =head2 subscriptionCurrentlyOnOrder
2736 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2738 Return 1 if subscription is currently on order else 0.
2742 sub subscriptionCurrentlyOnOrder {
2743 my ( $subscriptionid ) = @_;
2744 my $dbh = C4::Context->dbh;
2746 SELECT COUNT(*) FROM aqorders
2747 WHERE subscriptionid = ?
2748 AND datereceived IS NULL
2749 AND datecancellationprinted IS NULL
2751 my $sth = $dbh->prepare( $query );
2752 $sth->execute($subscriptionid);
2753 return $sth->fetchrow_array;
2761 Koha Development Team <http://koha-community.org/>