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);
27 use C4::Log; # logaction
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
33 $VERSION = 3.07.00.049; # set version for version checking
37 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
38 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
40 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
41 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
43 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
44 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
45 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
46 &GetSerialInformation &AddItem2Serial
47 &PrepareSerialsData &GetNextExpected &ModNextExpected
49 &UpdateClaimdateIssues
50 &GetSuppliersWithLateIssues &getsupplierbyserialid
51 &GetDistributedTo &SetDistributedTo
52 &getroutinglist &delroutingmember &addroutingmember
54 &check_routing &updateClaim &removeMissingIssue
57 &GetSubscriptionsFromBorrower
58 &subscriptionCurrentlyOnOrder
65 C4::Serials - Serials Module Functions
73 Functions for handling subscriptions, claims routing etc.
78 =head2 GetSuppliersWithLateIssues
80 $supplierlist = GetSuppliersWithLateIssues()
82 this function get all suppliers with late issues.
85 an array_ref of suppliers each entry is a hash_ref containing id and name
86 the array is in name order
90 sub GetSuppliersWithLateIssues {
91 my $dbh = C4::Context->dbh;
93 SELECT DISTINCT id, name
95 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
96 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
99 (planneddate < now() AND serial.status=1)
100 OR serial.STATUS = 3 OR serial.STATUS = 4
102 AND subscription.closed = 0
104 return $dbh->selectall_arrayref($query, { Slice => {} });
109 @issuelist = GetLateIssues($supplierid)
111 this function selects late issues from the database
114 the issuelist as an array. Each element of this array contains a hashi_ref containing
115 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
120 my ($supplierid) = @_;
121 my $dbh = C4::Context->dbh;
125 SELECT name,title,planneddate,serialseq,serial.subscriptionid
127 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
128 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
129 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
130 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
131 AND subscription.aqbooksellerid=?
132 AND subscription.closed = 0
135 $sth = $dbh->prepare($query);
136 $sth->execute($supplierid);
139 SELECT name,title,planneddate,serialseq,serial.subscriptionid
141 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
142 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
143 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
144 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
145 AND subscription.closed = 0
148 $sth = $dbh->prepare($query);
154 while ( my $line = $sth->fetchrow_hashref ) {
155 $odd++ unless $line->{title} eq $last_title;
156 $line->{title} = "" if $line->{title} eq $last_title;
157 $last_title = $line->{title} if ( $line->{title} );
158 $line->{planneddate} = format_date( $line->{planneddate} );
159 push @issuelist, $line;
164 =head2 GetSubscriptionHistoryFromSubscriptionId
166 $sth = GetSubscriptionHistoryFromSubscriptionId()
167 this function prepares the SQL request and returns the statement handle
168 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
172 sub GetSubscriptionHistoryFromSubscriptionId {
173 my $dbh = C4::Context->dbh;
176 FROM subscriptionhistory
177 WHERE subscriptionid = ?
179 return $dbh->prepare($query);
182 =head2 GetSerialStatusFromSerialId
184 $sth = GetSerialStatusFromSerialId();
185 this function returns a statement handle
186 After this function, don't forget to execute it by using $sth->execute($serialid)
188 $sth = $dbh->prepare($query).
192 sub GetSerialStatusFromSerialId {
193 my $dbh = C4::Context->dbh;
199 return $dbh->prepare($query);
202 =head2 GetSerialInformation
205 $data = GetSerialInformation($serialid);
206 returns a hash_ref containing :
207 items : items marcrecord (can be an array)
209 subscription table field
210 + information about subscription expiration
214 sub GetSerialInformation {
216 my $dbh = C4::Context->dbh;
218 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
219 if ( C4::Context->preference('IndependentBranches')
220 && C4::Context->userenv
221 && C4::Context->userenv->{'flags'} != 1
222 && C4::Context->userenv->{'branch'} ) {
224 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
227 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
230 my $rq = $dbh->prepare($query);
231 $rq->execute($serialid);
232 my $data = $rq->fetchrow_hashref;
234 # create item information if we have serialsadditems for this subscription
235 if ( $data->{'serialsadditems'} ) {
236 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
237 $queryitem->execute($serialid);
238 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
240 if ( scalar(@$itemnumbers) > 0 ) {
241 foreach my $itemnum (@$itemnumbers) {
243 #It is ASSUMED that GetMarcItem ALWAYS WORK...
244 #Maybe GetMarcItem should return values on failure
245 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
246 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
247 $itemprocessed->{'itemnumber'} = $itemnum->[0];
248 $itemprocessed->{'itemid'} = $itemnum->[0];
249 $itemprocessed->{'serialid'} = $serialid;
250 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
251 push @{ $data->{'items'} }, $itemprocessed;
254 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
255 $itemprocessed->{'itemid'} = "N$serialid";
256 $itemprocessed->{'serialid'} = $serialid;
257 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
258 $itemprocessed->{'countitems'} = 0;
259 push @{ $data->{'items'} }, $itemprocessed;
262 $data->{ "status" . $data->{'serstatus'} } = 1;
263 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
264 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
268 =head2 AddItem2Serial
270 $rows = AddItem2Serial($serialid,$itemnumber);
271 Adds an itemnumber to Serial record
272 returns the number of rows affected
277 my ( $serialid, $itemnumber ) = @_;
278 my $dbh = C4::Context->dbh;
279 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
280 $rq->execute( $serialid, $itemnumber );
284 =head2 UpdateClaimdateIssues
286 UpdateClaimdateIssues($serialids,[$date]);
288 Update Claimdate for issues in @$serialids list with date $date
293 sub UpdateClaimdateIssues {
294 my ( $serialids, $date ) = @_;
295 my $dbh = C4::Context->dbh;
296 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
298 UPDATE serial SET claimdate = ?, status = 7
299 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
300 my $rq = $dbh->prepare($query);
301 $rq->execute($date, @$serialids);
305 =head2 GetSubscription
307 $subs = GetSubscription($subscriptionid)
308 this function returns the subscription which has $subscriptionid as id.
310 a hashref. This hash containts
311 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
315 sub GetSubscription {
316 my ($subscriptionid) = @_;
317 my $dbh = C4::Context->dbh;
319 SELECT subscription.*,
320 subscriptionhistory.*,
321 aqbooksellers.name AS aqbooksellername,
322 biblio.title AS bibliotitle,
323 subscription.biblionumber as bibnum);
324 if ( C4::Context->preference('IndependentBranches')
325 && C4::Context->userenv
326 && C4::Context->userenv->{'flags'} != 1
327 && C4::Context->userenv->{'branch'} ) {
329 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
333 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
334 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
335 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
336 WHERE subscription.subscriptionid = ?
339 # if (C4::Context->preference('IndependentBranches') &&
340 # C4::Context->userenv &&
341 # C4::Context->userenv->{'flags'} != 1){
342 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
343 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
345 $debug and warn "query : $query\nsubsid :$subscriptionid";
346 my $sth = $dbh->prepare($query);
347 $sth->execute($subscriptionid);
348 return $sth->fetchrow_hashref;
351 =head2 GetFullSubscription
353 $array_ref = GetFullSubscription($subscriptionid)
354 this function reads the serial table.
358 sub GetFullSubscription {
359 my ($subscriptionid) = @_;
360 my $dbh = C4::Context->dbh;
362 SELECT serial.serialid,
365 serial.publisheddate,
367 serial.notes as notes,
368 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
369 aqbooksellers.name as aqbooksellername,
370 biblio.title as bibliotitle,
371 subscription.branchcode AS branchcode,
372 subscription.subscriptionid AS subscriptionid |;
373 if ( C4::Context->preference('IndependentBranches')
374 && C4::Context->userenv
375 && C4::Context->userenv->{'flags'} != 1
376 && C4::Context->userenv->{'branch'} ) {
378 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
382 LEFT JOIN subscription ON
383 (serial.subscriptionid=subscription.subscriptionid )
384 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
385 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
386 WHERE serial.subscriptionid = ?
388 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
389 serial.subscriptionid
391 $debug and warn "GetFullSubscription query: $query";
392 my $sth = $dbh->prepare($query);
393 $sth->execute($subscriptionid);
394 return $sth->fetchall_arrayref( {} );
397 =head2 PrepareSerialsData
399 $array_ref = PrepareSerialsData($serialinfomation)
400 where serialinformation is a hashref array
404 sub PrepareSerialsData {
410 my $aqbooksellername;
414 my $previousnote = "";
416 foreach my $subs (@{$lines}) {
417 for my $datefield ( qw(publisheddate planneddate) ) {
418 # handle both undef and undef returned as 0000-00-00
419 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
420 $subs->{$datefield} = 'XXX';
423 $subs->{ "status" . $subs->{'status'} } = 1;
424 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
426 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
427 $year = $subs->{'year'};
431 if ( $tmpresults{$year} ) {
432 push @{ $tmpresults{$year}->{'serials'} }, $subs;
434 $tmpresults{$year} = {
436 'aqbooksellername' => $subs->{'aqbooksellername'},
437 'bibliotitle' => $subs->{'bibliotitle'},
438 'serials' => [$subs],
443 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
444 push @res, $tmpresults{$key};
449 =head2 GetSubscriptionsFromBiblionumber
451 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
452 this function get the subscription list. it reads the subscription table.
454 reference to an array of subscriptions which have the biblionumber given on input arg.
455 each element of this array is a hashref containing
456 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
460 sub GetSubscriptionsFromBiblionumber {
461 my ($biblionumber) = @_;
462 my $dbh = C4::Context->dbh;
464 SELECT subscription.*,
466 subscriptionhistory.*,
467 aqbooksellers.name AS aqbooksellername,
468 biblio.title AS bibliotitle
470 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
471 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
472 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
473 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
474 WHERE subscription.biblionumber = ?
476 my $sth = $dbh->prepare($query);
477 $sth->execute($biblionumber);
479 while ( my $subs = $sth->fetchrow_hashref ) {
480 $subs->{startdate} = format_date( $subs->{startdate} );
481 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
482 $subs->{histenddate} = format_date( $subs->{histenddate} );
483 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
484 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
485 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
486 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
487 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
488 $subs->{ "status" . $subs->{'status'} } = 1;
489 $subs->{'cannotedit'} =
490 ( C4::Context->preference('IndependentBranches')
491 && C4::Context->userenv
492 && C4::Context->userenv->{flags} % 2 != 1
493 && C4::Context->userenv->{branch}
494 && $subs->{branchcode}
495 && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
497 if ( $subs->{enddate} eq '0000-00-00' ) {
498 $subs->{enddate} = '';
500 $subs->{enddate} = format_date( $subs->{enddate} );
502 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
503 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
509 =head2 GetFullSubscriptionsFromBiblionumber
511 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
512 this function reads the serial table.
516 sub GetFullSubscriptionsFromBiblionumber {
517 my ($biblionumber) = @_;
518 my $dbh = C4::Context->dbh;
520 SELECT serial.serialid,
523 serial.publisheddate,
525 serial.notes as notes,
526 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
527 biblio.title as bibliotitle,
528 subscription.branchcode AS branchcode,
529 subscription.subscriptionid AS subscriptionid|;
530 if ( C4::Context->preference('IndependentBranches')
531 && C4::Context->userenv
532 && C4::Context->userenv->{'flags'} != 1
533 && C4::Context->userenv->{'branch'} ) {
535 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
540 LEFT JOIN subscription ON
541 (serial.subscriptionid=subscription.subscriptionid)
542 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
543 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
544 WHERE subscription.biblionumber = ?
546 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
547 serial.subscriptionid
549 my $sth = $dbh->prepare($query);
550 $sth->execute($biblionumber);
551 return $sth->fetchall_arrayref( {} );
554 =head2 GetSubscriptions
556 @results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
557 this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
559 a table of hashref. Each hash containt the subscription.
563 sub GetSubscriptions {
564 my ( $string, $issn, $ean, $biblionumber ) = @_;
566 #return unless $title or $ISSN or $biblionumber;
567 my $dbh = C4::Context->dbh;
570 SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber
572 LEFT JOIN subscriptionhistory USING(subscriptionid)
573 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
574 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
579 $sqlwhere = " WHERE biblio.biblionumber=?";
580 push @bind_params, $biblionumber;
584 my @strings_to_search;
585 @strings_to_search = map { "%$_%" } split( / /, $string );
586 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
587 push @bind_params, @strings_to_search;
588 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
589 $debug && warn "$tmpstring";
590 $tmpstring =~ s/^AND //;
591 push @sqlstrings, $tmpstring;
593 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
597 my @strings_to_search;
598 @strings_to_search = map { "%$_%" } split( / /, $issn );
599 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
600 push @bind_params, @strings_to_search;
601 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
602 $debug && warn "$tmpstring";
603 $tmpstring =~ s/^OR //;
604 push @sqlstrings, $tmpstring;
606 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
610 my @strings_to_search;
611 @strings_to_search = map { "$_" } split( / /, $ean );
612 foreach my $index ( qw(biblioitems.ean) ) {
613 push @bind_params, @strings_to_search;
614 my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
615 $debug && warn "$tmpstring";
616 $tmpstring =~ s/^OR //;
617 push @sqlstrings, $tmpstring;
619 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
622 $sql .= "$sqlwhere ORDER BY title";
623 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
624 $sth = $dbh->prepare($sql);
625 $sth->execute(@bind_params);
628 while ( my $line = $sth->fetchrow_hashref ) {
629 $line->{'cannotedit'} =
630 ( C4::Context->preference('IndependentBranches')
631 && C4::Context->userenv
632 && C4::Context->userenv->{flags} % 2 != 1
633 && C4::Context->userenv->{branch}
634 && $line->{branchcode}
635 && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
636 push @results, $line;
641 =head2 SearchSubscriptions
643 @results = SearchSubscriptions($args);
644 $args is a hashref. Its keys can be contained: title, issn, ean, publisher, bookseller and branchcode
646 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.
649 a table of hashref. Each hash containt the subscription.
653 sub SearchSubscriptions {
657 SELECT subscription.*, subscriptionhistory.*, biblio.*, biblioitems.issn
659 LEFT JOIN subscriptionhistory USING(subscriptionid)
660 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
661 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
662 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
666 if( $args->{biblionumber} ) {
667 push @where_strs, "biblio.biblionumber = ?";
668 push @where_args, $args->{biblionumber};
670 if( $args->{title} ){
671 my @words = split / /, $args->{title};
673 foreach my $word (@words) {
674 push @strs, "biblio.title LIKE ?";
675 push @args, "%$word%";
678 push @where_strs, '(' . join (' AND ', @strs) . ')';
679 push @where_args, @args;
683 push @where_strs, "biblioitems.issn LIKE ?";
684 push @where_args, "%$args->{issn}%";
687 push @where_strs, "biblioitems.ean LIKE ?";
688 push @where_args, "%$args->{ean}%";
690 if( $args->{publisher} ){
691 push @where_strs, "biblioitems.publishercode LIKE ?";
692 push @where_args, "%$args->{publisher}%";
694 if( $args->{bookseller} ){
695 push @where_strs, "aqbooksellers.name LIKE ?";
696 push @where_args, "%$args->{bookseller}%";
698 if( $args->{branch} ){
699 push @where_strs, "subscription.branchcode = ?";
700 push @where_args, "$args->{branch}";
702 if( defined $args->{closed} ){
703 push @where_strs, "subscription.closed = ?";
704 push @where_args, "$args->{closed}";
707 $query .= " WHERE " . join(" AND ", @where_strs);
710 my $dbh = C4::Context->dbh;
711 my $sth = $dbh->prepare($query);
712 $sth->execute(@where_args);
713 my $results = $sth->fetchall_arrayref( {} );
722 ($totalissues,@serials) = GetSerials($subscriptionid);
723 this function gets every serial not arrived for a given subscription
724 as well as the number of issues registered in the database (all types)
725 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
727 FIXME: We should return \@serials.
732 my ( $subscriptionid, $count ) = @_;
733 my $dbh = C4::Context->dbh;
735 # status = 2 is "arrived"
737 $count = 5 unless ($count);
739 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
741 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
742 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
743 my $sth = $dbh->prepare($query);
744 $sth->execute($subscriptionid);
746 while ( my $line = $sth->fetchrow_hashref ) {
747 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
748 for my $datefield ( qw( planneddate publisheddate) ) {
749 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
750 $line->{$datefield} = format_date( $line->{$datefield});
752 $line->{$datefield} = q{};
755 push @serials, $line;
758 # OK, now add the last 5 issues arrives/missing
759 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
761 WHERE subscriptionid = ?
762 AND (status in (2,4,5))
763 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
765 $sth = $dbh->prepare($query);
766 $sth->execute($subscriptionid);
767 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
769 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
770 for my $datefield ( qw( planneddate publisheddate) ) {
771 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
772 $line->{$datefield} = format_date( $line->{$datefield});
774 $line->{$datefield} = q{};
778 push @serials, $line;
781 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
782 $sth = $dbh->prepare($query);
783 $sth->execute($subscriptionid);
784 my ($totalissues) = $sth->fetchrow;
785 return ( $totalissues, @serials );
790 @serials = GetSerials2($subscriptionid,$status);
791 this function returns every serial waited for a given subscription
792 as well as the number of issues registered in the database (all types)
793 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
798 my ( $subscription, $status ) = @_;
799 my $dbh = C4::Context->dbh;
801 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
803 WHERE subscriptionid=$subscription AND status IN ($status)
804 ORDER BY publisheddate,serialid DESC
806 $debug and warn "GetSerials2 query: $query";
807 my $sth = $dbh->prepare($query);
811 while ( my $line = $sth->fetchrow_hashref ) {
812 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
813 # Format dates for display
814 for my $datefield ( qw( planneddate publisheddate ) ) {
815 if ($line->{$datefield} =~m/^00/) {
816 $line->{$datefield} = q{};
819 $line->{$datefield} = format_date( $line->{$datefield} );
822 push @serials, $line;
827 =head2 GetLatestSerials
829 \@serials = GetLatestSerials($subscriptionid,$limit)
830 get the $limit's latest serials arrived or missing for a given subscription
832 a ref to an array which contains all of the latest serials stored into a hash.
836 sub GetLatestSerials {
837 my ( $subscriptionid, $limit ) = @_;
838 my $dbh = C4::Context->dbh;
840 # status = 2 is "arrived"
841 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
843 WHERE subscriptionid = ?
844 AND (status =2 or status=4)
845 ORDER BY publisheddate DESC LIMIT 0,$limit
847 my $sth = $dbh->prepare($strsth);
848 $sth->execute($subscriptionid);
850 while ( my $line = $sth->fetchrow_hashref ) {
851 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
852 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
853 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
854 push @serials, $line;
860 =head2 GetDistributedTo
862 $distributedto=GetDistributedTo($subscriptionid)
863 This function returns the field distributedto for the subscription matching subscriptionid
867 sub GetDistributedTo {
868 my $dbh = C4::Context->dbh;
870 my $subscriptionid = @_;
871 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
872 my $sth = $dbh->prepare($query);
873 $sth->execute($subscriptionid);
874 return ($distributedto) = $sth->fetchrow;
880 $val is a hashref containing all the attributes of the table 'subscription'
881 This function get the next issue for the subscription given on input arg
883 a list containing all the input params updated.
889 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
890 # $calculated = $val->{numberingmethod};
891 # # calculate the (expected) value of the next issue recieved.
892 # $newlastvalue1 = $val->{lastvalue1};
893 # # check if we have to increase the new value.
894 # $newinnerloop1 = $val->{innerloop1}+1;
895 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
896 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
897 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
898 # $calculated =~ s/\{X\}/$newlastvalue1/g;
900 # $newlastvalue2 = $val->{lastvalue2};
901 # # check if we have to increase the new value.
902 # $newinnerloop2 = $val->{innerloop2}+1;
903 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
904 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
905 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
906 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
908 # $newlastvalue3 = $val->{lastvalue3};
909 # # check if we have to increase the new value.
910 # $newinnerloop3 = $val->{innerloop3}+1;
911 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
912 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
913 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
914 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
915 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
920 my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
921 my $pattern = $val->{numberpattern};
922 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
923 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
924 $calculated = $val->{numberingmethod};
925 $newlastvalue1 = $val->{lastvalue1};
926 $newlastvalue2 = $val->{lastvalue2};
927 $newlastvalue3 = $val->{lastvalue3};
928 $newlastvalue1 = $val->{lastvalue1};
930 # check if we have to increase the new value.
931 $newinnerloop1 = $val->{innerloop1} + 1;
932 $newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} );
933 $newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 ); # <1 to be true when 0 or empty.
934 $newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} ); # reset counter if needed.
935 $calculated =~ s/\{X\}/$newlastvalue1/g;
937 $newlastvalue2 = $val->{lastvalue2};
939 # check if we have to increase the new value.
940 $newinnerloop2 = $val->{innerloop2} + 1;
941 $newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} );
942 $newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 ); # <1 to be true when 0 or empty.
943 $newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} ); # reset counter if needed.
944 if ( $pattern == 6 ) {
945 if ( $val->{hemisphere} == 2 ) {
946 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
947 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
949 my $newlastvalue2seq = $seasons[$newlastvalue2];
950 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
953 $calculated =~ s/\{Y\}/$newlastvalue2/g;
956 $newlastvalue3 = $val->{lastvalue3};
958 # check if we have to increase the new value.
959 $newinnerloop3 = $val->{innerloop3} + 1;
960 $newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} );
961 $newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 ); # <1 to be true when 0 or empty.
962 $newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} ); # reset counter if needed.
963 $calculated =~ s/\{Z\}/$newlastvalue3/g;
965 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
970 $calculated = GetSeq($val)
971 $val is a hashref containing all the attributes of the table 'subscription'
972 this function transforms {X},{Y},{Z} to 150,0,0 for example.
974 the sequence in integer format
980 my $pattern = $val->{numberpattern};
981 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
982 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
983 my $calculated = $val->{numberingmethod};
984 my $x = $val->{'lastvalue1'};
985 $calculated =~ s/\{X\}/$x/g;
986 my $newlastvalue2 = $val->{'lastvalue2'};
988 if ( $pattern == 6 ) {
989 if ( $val->{hemisphere} == 2 ) {
990 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
991 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
993 my $newlastvalue2seq = $seasons[$newlastvalue2];
994 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
997 $calculated =~ s/\{Y\}/$newlastvalue2/g;
999 my $z = $val->{'lastvalue3'};
1000 $calculated =~ s/\{Z\}/$z/g;
1004 =head2 GetExpirationDate
1006 $enddate = GetExpirationDate($subscriptionid, [$startdate])
1008 this function return the next expiration date for a subscription given on input args.
1011 the enddate or undef
1015 sub GetExpirationDate {
1016 my ( $subscriptionid, $startdate ) = @_;
1017 my $dbh = C4::Context->dbh;
1018 my $subscription = GetSubscription($subscriptionid);
1021 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1022 $enddate = $startdate || $subscription->{startdate};
1023 my @date = split( /-/, $enddate );
1024 return if ( scalar(@date) != 3 || not check_date(@date) );
1025 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1028 if ( my $length = $subscription->{numberlength} ) {
1030 #calculate the date of the last issue.
1031 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1032 $enddate = GetNextDate( $enddate, $subscription );
1034 } elsif ( $subscription->{monthlength} ) {
1035 if ( $$subscription{startdate} ) {
1036 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1037 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1039 } elsif ( $subscription->{weeklength} ) {
1040 if ( $$subscription{startdate} ) {
1041 my @date = split( /-/, $subscription->{startdate} );
1042 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1043 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1052 =head2 CountSubscriptionFromBiblionumber
1054 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1055 this returns a count of the subscriptions for a given biblionumber
1057 the number of subscriptions
1061 sub CountSubscriptionFromBiblionumber {
1062 my ($biblionumber) = @_;
1063 my $dbh = C4::Context->dbh;
1064 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1065 my $sth = $dbh->prepare($query);
1066 $sth->execute($biblionumber);
1067 my $subscriptionsnumber = $sth->fetchrow;
1068 return $subscriptionsnumber;
1071 =head2 ModSubscriptionHistory
1073 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1075 this function modifies the history of a subscription. Put your new values on input arg.
1076 returns the number of rows affected
1080 sub ModSubscriptionHistory {
1081 my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_;
1082 my $dbh = C4::Context->dbh;
1083 my $query = "UPDATE subscriptionhistory
1084 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1085 WHERE subscriptionid=?
1087 my $sth = $dbh->prepare($query);
1088 $recievedlist =~ s/^; //;
1089 $missinglist =~ s/^; //;
1090 $opacnote =~ s/^; //;
1091 $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1095 =head2 ModSerialStatus
1097 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1099 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1100 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1104 sub ModSerialStatus {
1105 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1107 #It is a usual serial
1108 # 1st, get previous status :
1109 my $dbh = C4::Context->dbh;
1110 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1111 my $sth = $dbh->prepare($query);
1112 $sth->execute($serialid);
1113 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1115 # change status & update subscriptionhistory
1117 if ( $status == 6 ) {
1118 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1122 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1123 $sth = $dbh->prepare($query);
1124 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1125 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1126 $sth = $dbh->prepare($query);
1127 $sth->execute($subscriptionid);
1128 my $val = $sth->fetchrow_hashref;
1129 unless ( $val->{manualhistory} ) {
1130 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1131 $sth = $dbh->prepare($query);
1132 $sth->execute($subscriptionid);
1133 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1134 if ( $status == 2 ) {
1135 $recievedlist .= "; $serialseq"
1136 if $recievedlist!~/(^|;)\s*$serialseq(?=;|$)/;
1138 # in case serial has been previously marked as missing
1139 if (grep /$status/, (1,2,3,7)) {
1140 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1142 $missinglist .= "; $serialseq"
1143 if $status==4 && $missinglist!~/(^|;)\s*$serialseq(?=;|$)/;
1144 $missinglist .= "; not issued $serialseq"
1145 if $status==5 && $missinglist!~/(^|;)\s*$serialseq(?=;|$)/;
1147 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1148 $sth = $dbh->prepare($query);
1149 $recievedlist =~ s/^; //;
1150 $missinglist =~ s/^; //;
1151 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1155 # create new waited entry if needed (ie : was a "waited" and has changed)
1156 if ( $oldstatus == 1 && $status != 1 ) {
1157 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1158 $sth = $dbh->prepare($query);
1159 $sth->execute($subscriptionid);
1160 my $val = $sth->fetchrow_hashref;
1164 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1165 $newinnerloop1, $newinnerloop2, $newinnerloop3
1166 ) = GetNextSeq($val);
1168 # next date (calculated from actual date & frequency parameters)
1169 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1170 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate );
1171 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1172 WHERE subscriptionid = ?";
1173 $sth = $dbh->prepare($query);
1174 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1176 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1177 if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) {
1178 require C4::Letters;
1179 C4::Letters::SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1185 =head2 GetNextExpected
1187 $nextexpected = GetNextExpected($subscriptionid)
1189 Get the planneddate for the current expected issue of the subscription.
1195 planneddate => C4::Dates object
1200 sub GetNextExpected {
1201 my ($subscriptionid) = @_;
1202 my $dbh = C4::Context->dbh;
1203 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1205 # Each subscription has only one 'expected' issue, with serial.status==1.
1206 $sth->execute( $subscriptionid, 1 );
1207 my ( $nextissue ) = $sth->fetchrow_hashref;
1209 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1210 $sth->execute( $subscriptionid );
1211 $nextissue = $sth->fetchrow_hashref;
1213 if (!defined $nextissue->{planneddate}) {
1214 # or should this default to 1st Jan ???
1215 $nextissue->{planneddate} = strftime('%Y-%m-%d',localtime);
1217 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1222 =head2 ModNextExpected
1224 ModNextExpected($subscriptionid,$date)
1226 Update the planneddate for the current expected issue of the subscription.
1227 This will modify all future prediction results.
1229 C<$date> is a C4::Dates object.
1235 sub ModNextExpected {
1236 my ( $subscriptionid, $date ) = @_;
1237 my $dbh = C4::Context->dbh;
1239 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1240 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1242 # Each subscription has only one 'expected' issue, with serial.status==1.
1243 $sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 );
1248 =head2 ModSubscription
1250 this function modifies a subscription. Put all new values on input args.
1251 returns the number of rows affected
1255 sub ModSubscription {
1256 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1257 $dow, $irregularity, $numberpattern, $numberlength, $weeklength, $monthlength, $add1, $every1,
1258 $whenmorethan1, $setto1, $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2,
1259 $lastvalue2, $innerloop2, $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1260 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory,
1261 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid
1264 # warn $irregularity;
1265 my $dbh = C4::Context->dbh;
1266 my $query = "UPDATE subscription
1267 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1268 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1269 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1270 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1271 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1272 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?,
1273 letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
1274 staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1276 WHERE subscriptionid = ?";
1278 #warn "query :".$query;
1279 my $sth = $dbh->prepare($query);
1281 $auser, $branchcode, $aqbooksellerid, $cost,
1282 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1283 $dow, "$irregularity", $numberpattern, $numberlength,
1284 $weeklength, $monthlength, $add1, $every1,
1285 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1286 $add2, $every2, $whenmorethan2, $setto2,
1287 $lastvalue2, $innerloop2, $add3, $every3,
1288 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1289 $numberingmethod, $status, $biblionumber, $callnumber,
1290 $notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ),
1291 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1292 $graceperiod, $location, $enddate, $subscriptionid
1294 my $rows = $sth->rows;
1296 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1300 =head2 NewSubscription
1302 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1303 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1304 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1305 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1306 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1307 $numberingmethod, $status, $notes, $serialsadditems,
1308 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
1310 Create a new subscription with value given on input args.
1313 the id of this new subscription
1317 sub NewSubscription {
1318 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1319 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1320 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1321 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status,
1322 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1323 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1325 my $dbh = C4::Context->dbh;
1327 #save subscription (insert into database)
1329 INSERT INTO subscription
1330 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1331 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1332 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1333 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1334 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1335 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1336 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1337 staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
1338 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1340 my $sth = $dbh->prepare($query);
1342 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1343 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1344 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1345 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, "$status",
1346 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1347 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1350 my $subscriptionid = $dbh->{'mysql_insertid'};
1352 $enddate = GetExpirationDate($subscriptionid,$startdate);
1356 WHERE subscriptionid=?
1358 $sth = $dbh->prepare($query);
1359 $sth->execute( $enddate, $subscriptionid );
1361 #then create the 1st waited number
1363 INSERT INTO subscriptionhistory
1364 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1367 $sth = $dbh->prepare($query);
1368 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1370 # reread subscription to get a hash (for calculation of the 1st issue number)
1374 WHERE subscriptionid = ?
1376 $sth = $dbh->prepare($query);
1377 $sth->execute($subscriptionid);
1378 my $val = $sth->fetchrow_hashref;
1380 # calculate issue number
1381 my $serialseq = GetSeq($val);
1384 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1385 VALUES (?,?,?,?,?,?)
1387 $sth = $dbh->prepare($query);
1388 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1390 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1392 #set serial flag on biblio if not already set.
1393 my $bib = GetBiblio($biblionumber);
1394 if ( !$bib->{'serial'} ) {
1395 my $record = GetMarcBiblio($biblionumber);
1396 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1398 eval { $record->field($tag)->update( $subf => 1 ); };
1400 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1402 return $subscriptionid;
1405 =head2 ReNewSubscription
1407 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1409 this function renew a subscription with values given on input args.
1413 sub ReNewSubscription {
1414 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1415 my $dbh = C4::Context->dbh;
1416 my $subscription = GetSubscription($subscriptionid);
1420 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1421 WHERE biblio.biblionumber=?
1423 my $sth = $dbh->prepare($query);
1424 $sth->execute( $subscription->{biblionumber} );
1425 my $biblio = $sth->fetchrow_hashref;
1427 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1428 require C4::Suggestions;
1429 C4::Suggestions::NewSuggestion(
1430 { 'suggestedby' => $user,
1431 'title' => $subscription->{bibliotitle},
1432 'author' => $biblio->{author},
1433 'publishercode' => $biblio->{publishercode},
1434 'note' => $biblio->{note},
1435 'biblionumber' => $subscription->{biblionumber}
1440 # renew subscription
1443 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1444 WHERE subscriptionid=?
1446 $sth = $dbh->prepare($query);
1447 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1448 my $enddate = GetExpirationDate($subscriptionid);
1449 $debug && warn "enddate :$enddate";
1453 WHERE subscriptionid=?
1455 $sth = $dbh->prepare($query);
1456 $sth->execute( $enddate, $subscriptionid );
1458 UPDATE subscriptionhistory
1460 WHERE subscriptionid=?
1462 $sth = $dbh->prepare($query);
1463 $sth->execute( $enddate, $subscriptionid );
1465 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1471 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1473 Create a new issue stored on the database.
1474 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1475 returns the serial id
1480 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1481 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1483 my $dbh = C4::Context->dbh;
1486 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1487 VALUES (?,?,?,?,?,?,?)
1489 my $sth = $dbh->prepare($query);
1490 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1491 my $serialid = $dbh->{'mysql_insertid'};
1493 SELECT missinglist,recievedlist
1494 FROM subscriptionhistory
1495 WHERE subscriptionid=?
1497 $sth = $dbh->prepare($query);
1498 $sth->execute($subscriptionid);
1499 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1501 if ( $status == 2 ) {
1502 ### TODO Add a feature that improves recognition and description.
1503 ### As such count (serialseq) i.e. : N18,2(N19),N20
1504 ### Would use substr and index But be careful to previous presence of ()
1505 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1507 if ( $status == 4 ) {
1508 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1511 UPDATE subscriptionhistory
1512 SET recievedlist=?, missinglist=?
1513 WHERE subscriptionid=?
1515 $sth = $dbh->prepare($query);
1516 $recievedlist =~ s/^; //;
1517 $missinglist =~ s/^; //;
1518 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1522 =head2 ItemizeSerials
1524 ItemizeSerials($serialid, $info);
1525 $info is a hashref containing barcode branch, itemcallnumber, status, location
1526 $serialid the serialid
1528 1 if the itemize is a succes.
1529 0 and @error otherwise. @error containts the list of errors found.
1533 sub ItemizeSerials {
1534 my ( $serialid, $info ) = @_;
1535 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1537 my $dbh = C4::Context->dbh;
1543 my $sth = $dbh->prepare($query);
1544 $sth->execute($serialid);
1545 my $data = $sth->fetchrow_hashref;
1546 if ( C4::Context->preference("RoutingSerials") ) {
1548 # check for existing biblioitem relating to serial issue
1549 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1551 for ( my $i = 0 ; $i < $count ; $i++ ) {
1552 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1553 $bibitemno = $results[$i]->{'biblioitemnumber'};
1557 if ( $bibitemno == 0 ) {
1558 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1559 $sth->execute( $data->{'biblionumber'} );
1560 my $biblioitem = $sth->fetchrow_hashref;
1561 $biblioitem->{'volumedate'} = $data->{planneddate};
1562 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1563 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1567 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1568 if ( $info->{barcode} ) {
1570 if ( is_barcode_in_use( $info->{barcode} ) ) {
1571 push @errors, 'barcode_not_unique';
1573 my $marcrecord = MARC::Record->new();
1574 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1575 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1576 $marcrecord->insert_fields_ordered($newField);
1577 if ( $info->{branch} ) {
1578 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1580 #warn "items.homebranch : $tag , $subfield";
1581 if ( $marcrecord->field($tag) ) {
1582 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1584 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1585 $marcrecord->insert_fields_ordered($newField);
1587 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1589 #warn "items.holdingbranch : $tag , $subfield";
1590 if ( $marcrecord->field($tag) ) {
1591 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1593 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1594 $marcrecord->insert_fields_ordered($newField);
1597 if ( $info->{itemcallnumber} ) {
1598 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1600 if ( $marcrecord->field($tag) ) {
1601 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1603 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1604 $marcrecord->insert_fields_ordered($newField);
1607 if ( $info->{notes} ) {
1608 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1610 if ( $marcrecord->field($tag) ) {
1611 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1613 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1614 $marcrecord->insert_fields_ordered($newField);
1617 if ( $info->{location} ) {
1618 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1620 if ( $marcrecord->field($tag) ) {
1621 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1623 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1624 $marcrecord->insert_fields_ordered($newField);
1627 if ( $info->{status} ) {
1628 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1630 if ( $marcrecord->field($tag) ) {
1631 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1633 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1634 $marcrecord->insert_fields_ordered($newField);
1637 if ( C4::Context->preference("RoutingSerials") ) {
1638 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1639 if ( $marcrecord->field($tag) ) {
1640 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1642 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1643 $marcrecord->insert_fields_ordered($newField);
1647 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1650 return ( 0, @errors );
1654 =head2 HasSubscriptionStrictlyExpired
1656 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1658 the subscription has stricly expired when today > the end subscription date
1661 1 if true, 0 if false, -1 if the expiration date is not set.
1665 sub HasSubscriptionStrictlyExpired {
1667 # Getting end of subscription date
1668 my ($subscriptionid) = @_;
1669 my $dbh = C4::Context->dbh;
1670 my $subscription = GetSubscription($subscriptionid);
1671 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1673 # If the expiration date is set
1674 if ( $expirationdate != 0 ) {
1675 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1677 # Getting today's date
1678 my ( $nowyear, $nowmonth, $nowday ) = Today();
1680 # if today's date > expiration date, then the subscription has stricly expired
1681 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1688 # There are some cases where the expiration date is not set
1689 # As we can't determine if the subscription has expired on a date-basis,
1695 =head2 HasSubscriptionExpired
1697 $has_expired = HasSubscriptionExpired($subscriptionid)
1699 the subscription has expired when the next issue to arrive is out of subscription limit.
1702 0 if the subscription has not expired
1703 1 if the subscription has expired
1704 2 if has subscription does not have a valid expiration date set
1708 sub HasSubscriptionExpired {
1709 my ($subscriptionid) = @_;
1710 my $dbh = C4::Context->dbh;
1711 my $subscription = GetSubscription($subscriptionid);
1712 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1713 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1714 if (!defined $expirationdate) {
1715 $expirationdate = q{};
1718 SELECT max(planneddate)
1720 WHERE subscriptionid=?
1722 my $sth = $dbh->prepare($query);
1723 $sth->execute($subscriptionid);
1724 my ($res) = $sth->fetchrow;
1725 if (!$res || $res=~m/^0000/) {
1728 my @res = split( /-/, $res );
1729 my @endofsubscriptiondate = split( /-/, $expirationdate );
1730 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1732 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1736 if ( $subscription->{'numberlength'} ) {
1737 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1738 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1744 return 0; # Notice that you'll never get here.
1747 =head2 SetDistributedto
1749 SetDistributedto($distributedto,$subscriptionid);
1750 This function update the value of distributedto for a subscription given on input arg.
1754 sub SetDistributedto {
1755 my ( $distributedto, $subscriptionid ) = @_;
1756 my $dbh = C4::Context->dbh;
1760 WHERE subscriptionid=?
1762 my $sth = $dbh->prepare($query);
1763 $sth->execute( $distributedto, $subscriptionid );
1767 =head2 DelSubscription
1769 DelSubscription($subscriptionid)
1770 this function deletes subscription which has $subscriptionid as id.
1774 sub DelSubscription {
1775 my ($subscriptionid) = @_;
1776 my $dbh = C4::Context->dbh;
1777 $subscriptionid = $dbh->quote($subscriptionid);
1778 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1779 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1780 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1782 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1787 DelIssue($serialseq,$subscriptionid)
1788 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1790 returns the number of rows affected
1795 my ($dataissue) = @_;
1796 my $dbh = C4::Context->dbh;
1797 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1802 AND subscriptionid= ?
1804 my $mainsth = $dbh->prepare($query);
1805 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1807 #Delete element from subscription history
1808 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1809 my $sth = $dbh->prepare($query);
1810 $sth->execute( $dataissue->{'subscriptionid'} );
1811 my $val = $sth->fetchrow_hashref;
1812 unless ( $val->{manualhistory} ) {
1814 SELECT * FROM subscriptionhistory
1815 WHERE subscriptionid= ?
1817 my $sth = $dbh->prepare($query);
1818 $sth->execute( $dataissue->{'subscriptionid'} );
1819 my $data = $sth->fetchrow_hashref;
1820 my $serialseq = $dataissue->{'serialseq'};
1821 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1822 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1823 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1824 $sth = $dbh->prepare($strsth);
1825 $sth->execute( $dataissue->{'subscriptionid'} );
1828 return $mainsth->rows;
1831 =head2 GetLateOrMissingIssues
1833 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1835 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1838 the issuelist as an array of hash refs. Each element of this array contains
1839 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1843 sub GetLateOrMissingIssues {
1844 my ( $supplierid, $serialid, $order ) = @_;
1845 my $dbh = C4::Context->dbh;
1849 $byserial = "and serialid = " . $serialid;
1852 $order .= ", title";
1857 $sth = $dbh->prepare(
1859 serialid, aqbooksellerid, name,
1860 biblio.title, planneddate, serialseq,
1861 serial.status, serial.subscriptionid, claimdate,
1862 subscription.branchcode
1864 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1865 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1866 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1867 WHERE subscription.subscriptionid = serial.subscriptionid
1868 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1869 AND subscription.aqbooksellerid=$supplierid
1874 $sth = $dbh->prepare(
1876 serialid, aqbooksellerid, name,
1877 biblio.title, planneddate, serialseq,
1878 serial.status, serial.subscriptionid, claimdate,
1879 subscription.branchcode
1881 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1882 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1883 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1884 WHERE subscription.subscriptionid = serial.subscriptionid
1885 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1892 while ( my $line = $sth->fetchrow_hashref ) {
1894 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1895 $line->{planneddate} = format_date( $line->{planneddate} );
1897 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1898 $line->{claimdate} = format_date( $line->{claimdate} );
1900 $line->{"status".$line->{status}} = 1;
1901 push @issuelist, $line;
1906 =head2 removeMissingIssue
1908 removeMissingIssue($subscriptionid)
1910 this function removes an issue from being part of the missing string in
1911 subscriptionlist.missinglist column
1913 called when a missing issue is found from the serials-recieve.pl file
1917 sub removeMissingIssue {
1918 my ( $sequence, $subscriptionid ) = @_;
1919 my $dbh = C4::Context->dbh;
1920 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1921 $sth->execute($subscriptionid);
1922 my $data = $sth->fetchrow_hashref;
1923 my $missinglist = $data->{'missinglist'};
1924 my $missinglistbefore = $missinglist;
1926 # warn $missinglist." before";
1927 $missinglist =~ s/($sequence)//;
1929 # warn $missinglist." after";
1930 if ( $missinglist ne $missinglistbefore ) {
1931 $missinglist =~ s/\|\s\|/\|/g;
1932 $missinglist =~ s/^\| //g;
1933 $missinglist =~ s/\|$//g;
1934 my $sth2 = $dbh->prepare(
1935 "UPDATE subscriptionhistory
1937 WHERE subscriptionid = ?"
1939 $sth2->execute( $missinglist, $subscriptionid );
1946 &updateClaim($serialid)
1948 this function updates the time when a claim is issued for late/missing items
1950 called from claims.pl file
1955 my ($serialid) = @_;
1956 my $dbh = C4::Context->dbh;
1957 my $sth = $dbh->prepare(
1958 "UPDATE serial SET claimdate = now()
1962 $sth->execute($serialid);
1966 =head2 getsupplierbyserialid
1968 $result = getsupplierbyserialid($serialid)
1970 this function is used to find the supplier id given a serial id
1973 hashref containing serialid, subscriptionid, and aqbooksellerid
1977 sub getsupplierbyserialid {
1978 my ($serialid) = @_;
1979 my $dbh = C4::Context->dbh;
1980 my $sth = $dbh->prepare(
1981 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1983 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1987 $sth->execute($serialid);
1988 my $line = $sth->fetchrow_hashref;
1989 my $result = $line->{'aqbooksellerid'};
1993 =head2 check_routing
1995 $result = &check_routing($subscriptionid)
1997 this function checks to see if a serial has a routing list and returns the count of routingid
1998 used to show either an 'add' or 'edit' link
2003 my ($subscriptionid) = @_;
2004 my $dbh = C4::Context->dbh;
2005 my $sth = $dbh->prepare(
2006 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2007 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2008 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2011 $sth->execute($subscriptionid);
2012 my $line = $sth->fetchrow_hashref;
2013 my $result = $line->{'routingids'};
2017 =head2 addroutingmember
2019 addroutingmember($borrowernumber,$subscriptionid)
2021 this function takes a borrowernumber and subscriptionid and adds the member to the
2022 routing list for that serial subscription and gives them a rank on the list
2023 of either 1 or highest current rank + 1
2027 sub addroutingmember {
2028 my ( $borrowernumber, $subscriptionid ) = @_;
2030 my $dbh = C4::Context->dbh;
2031 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2032 $sth->execute($subscriptionid);
2033 while ( my $line = $sth->fetchrow_hashref ) {
2034 if ( $line->{'rank'} > 0 ) {
2035 $rank = $line->{'rank'} + 1;
2040 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2041 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2044 =head2 reorder_members
2046 reorder_members($subscriptionid,$routingid,$rank)
2048 this function is used to reorder the routing list
2050 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2051 - it gets all members on list puts their routingid's into an array
2052 - removes the one in the array that is $routingid
2053 - then reinjects $routingid at point indicated by $rank
2054 - then update the database with the routingids in the new order
2058 sub reorder_members {
2059 my ( $subscriptionid, $routingid, $rank ) = @_;
2060 my $dbh = C4::Context->dbh;
2061 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2062 $sth->execute($subscriptionid);
2064 while ( my $line = $sth->fetchrow_hashref ) {
2065 push( @result, $line->{'routingid'} );
2068 # To find the matching index
2070 my $key = -1; # to allow for 0 being a valid response
2071 for ( $i = 0 ; $i < @result ; $i++ ) {
2072 if ( $routingid == $result[$i] ) {
2073 $key = $i; # save the index
2078 # if index exists in array then move it to new position
2079 if ( $key > -1 && $rank > 0 ) {
2080 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2081 my $moving_item = splice( @result, $key, 1 );
2082 splice( @result, $new_rank, 0, $moving_item );
2084 for ( my $j = 0 ; $j < @result ; $j++ ) {
2085 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2091 =head2 delroutingmember
2093 delroutingmember($routingid,$subscriptionid)
2095 this function either deletes one member from routing list if $routingid exists otherwise
2096 deletes all members from the routing list
2100 sub delroutingmember {
2102 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2103 my ( $routingid, $subscriptionid ) = @_;
2104 my $dbh = C4::Context->dbh;
2106 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2107 $sth->execute($routingid);
2108 reorder_members( $subscriptionid, $routingid );
2110 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2111 $sth->execute($subscriptionid);
2116 =head2 getroutinglist
2118 @routinglist = getroutinglist($subscriptionid)
2120 this gets the info from the subscriptionroutinglist for $subscriptionid
2123 the routinglist as an array. Each element of the array contains a hash_ref containing
2124 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2128 sub getroutinglist {
2129 my ($subscriptionid) = @_;
2130 my $dbh = C4::Context->dbh;
2131 my $sth = $dbh->prepare(
2132 'SELECT routingid, borrowernumber, ranking, biblionumber
2134 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2135 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2137 $sth->execute($subscriptionid);
2138 my $routinglist = $sth->fetchall_arrayref({});
2139 return @{$routinglist};
2142 =head2 countissuesfrom
2144 $result = countissuesfrom($subscriptionid,$startdate)
2146 Returns a count of serial rows matching the given subsctiptionid
2147 with published date greater than startdate
2151 sub countissuesfrom {
2152 my ( $subscriptionid, $startdate ) = @_;
2153 my $dbh = C4::Context->dbh;
2157 WHERE subscriptionid=?
2158 AND serial.publisheddate>?
2160 my $sth = $dbh->prepare($query);
2161 $sth->execute( $subscriptionid, $startdate );
2162 my ($countreceived) = $sth->fetchrow;
2163 return $countreceived;
2168 $result = CountIssues($subscriptionid)
2170 Returns a count of serial rows matching the given subsctiptionid
2175 my ($subscriptionid) = @_;
2176 my $dbh = C4::Context->dbh;
2180 WHERE subscriptionid=?
2182 my $sth = $dbh->prepare($query);
2183 $sth->execute($subscriptionid);
2184 my ($countreceived) = $sth->fetchrow;
2185 return $countreceived;
2190 $result = HasItems($subscriptionid)
2192 returns a count of items from serial matching the subscriptionid
2197 my ($subscriptionid) = @_;
2198 my $dbh = C4::Context->dbh;
2200 SELECT COUNT(serialitems.itemnumber)
2202 LEFT JOIN serialitems USING(serialid)
2203 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2205 my $sth=$dbh->prepare($query);
2206 $sth->execute($subscriptionid);
2207 my ($countitems)=$sth->fetchrow_array();
2211 =head2 abouttoexpire
2213 $result = abouttoexpire($subscriptionid)
2215 this function alerts you to the penultimate issue for a serial subscription
2217 returns 1 - if this is the penultimate issue
2223 my ($subscriptionid) = @_;
2224 my $dbh = C4::Context->dbh;
2225 my $subscription = GetSubscription($subscriptionid);
2226 my $per = $subscription->{'periodicity'};
2227 if ($per && $per % 16 > 0){
2228 my $expirationdate = GetExpirationDate($subscriptionid);
2229 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2232 @res=split (/-/,$res);
2233 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2234 } else { # default an undefined value
2235 @res=Date::Calc::Today;
2237 my @endofsubscriptiondate=split(/-/,$expirationdate);
2238 my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 124, 0, 0);
2240 @datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2241 - (3 * $per_list[$per])) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2242 return 1 if ( @res &&
2244 Delta_Days($res[0],$res[1],$res[2],
2245 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2246 (@endofsubscriptiondate &&
2247 Delta_Days($res[0],$res[1],$res[2],
2248 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2250 } elsif ($subscription->{numberlength}>0) {
2251 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2256 sub in_array { # used in next sub down
2257 my ( $val, @elements ) = @_;
2258 foreach my $elem (@elements) {
2259 if ( $val == $elem ) {
2266 =head2 GetSubscriptionsFromBorrower
2268 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2270 this gets the info from subscriptionroutinglist for each $subscriptionid
2273 a count of the serial subscription routing lists to which a patron belongs,
2274 with the titles of those serial subscriptions as an array. Each element of the array
2275 contains a hash_ref with subscriptionID and title of subscription.
2279 sub GetSubscriptionsFromBorrower {
2280 my ($borrowernumber) = @_;
2281 my $dbh = C4::Context->dbh;
2282 my $sth = $dbh->prepare(
2283 "SELECT subscription.subscriptionid, biblio.title
2285 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2286 JOIN subscriptionroutinglist USING (subscriptionid)
2287 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2290 $sth->execute($borrowernumber);
2293 while ( my $line = $sth->fetchrow_hashref ) {
2295 push( @routinglist, $line );
2297 return ( $count, @routinglist );
2302 $resultdate = GetNextDate($planneddate,$subscription)
2304 this function it takes the planneddate and will return the next issue's date and will skip dates if there
2305 exists an irregularity
2306 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2307 skipped then the returned date will be 2007-05-10
2310 $resultdate - then next date in the sequence
2312 Return 0 if periodicity==0
2317 my ( $planneddate, $subscription ) = @_;
2318 my @irreg = split( /\,/, $subscription->{irregularity} );
2320 #date supposed to be in ISO.
2322 my ( $year, $month, $day ) = split( /-/, $planneddate );
2323 $month = 1 unless ($month);
2324 $day = 1 unless ($day);
2327 # warn "DOW $dayofweek";
2328 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2333 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2334 # renaming this pattern from 1/day to " n / week ".
2335 if ( $subscription->{periodicity} == 1 ) {
2336 my $dayofweek = eval { Day_of_Week( $year, $month, $day ) };
2337 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2339 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2340 $dayofweek = 0 if ( $dayofweek == 7 );
2341 if ( in_array( ( $dayofweek + 1 ), @irreg ) ) {
2342 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 );
2346 @resultdate = Add_Delta_Days( $year, $month, $day, 1 );
2351 if ( $subscription->{periodicity} == 2 ) {
2352 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2353 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2355 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2357 #FIXME: if two consecutive irreg, do we only skip one?
2358 if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) {
2359 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 );
2360 $wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 );
2363 @resultdate = Add_Delta_Days( $year, $month, $day, 7 );
2368 if ( $subscription->{periodicity} == 3 ) {
2369 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2370 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2372 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2373 if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) {
2374 ### BUGFIX was previously +1 ^
2375 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 );
2376 $wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 );
2379 @resultdate = Add_Delta_Days( $year, $month, $day, 14 );
2384 if ( $subscription->{periodicity} == 4 ) {
2385 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2386 if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; }
2388 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2389 if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) {
2390 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 );
2391 $wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 );
2394 @resultdate = Add_Delta_Days( $year, $month, $day, 21 );
2397 my $tmpmonth = $month;
2398 if ( $year && $month && $day ) {
2399 if ( $subscription->{periodicity} == 5 ) {
2400 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2401 if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) {
2402 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2403 $tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 );
2406 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2408 if ( $subscription->{periodicity} == 6 ) {
2409 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2410 if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) {
2411 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2412 $tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 );
2415 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2417 if ( $subscription->{periodicity} == 7 ) {
2418 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2419 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2420 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2421 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2424 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2426 if ( $subscription->{periodicity} == 8 ) {
2427 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2428 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2429 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2430 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2433 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2435 if ( $subscription->{periodicity} == 13 ) {
2436 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2437 if ( $irreg[$i] == ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 ) ) {
2438 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2439 $tmpmonth = ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 );
2442 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2444 if ( $subscription->{periodicity} == 9 ) {
2445 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2446 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2447 ### BUFIX Seems to need more Than One ?
2448 ( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 );
2449 $tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 );
2452 @resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 );
2454 if ( $subscription->{periodicity} == 10 ) {
2455 @resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 );
2457 if ( $subscription->{periodicity} == 11 ) {
2458 @resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 );
2461 my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] );
2463 return "$resultdate";
2466 =head2 is_barcode_in_use
2468 Returns number of occurence of the barcode in the items table
2469 Can be used as a boolean test of whether the barcode has
2470 been deployed as yet
2474 sub is_barcode_in_use {
2475 my $barcode = shift;
2476 my $dbh = C4::Context->dbh;
2477 my $occurences = $dbh->selectall_arrayref(
2478 'SELECT itemnumber from items where barcode = ?',
2483 return @{$occurences};
2486 =head2 CloseSubscription
2487 Close a subscription given a subscriptionid
2489 sub CloseSubscription {
2490 my ( $subscriptionid ) = @_;
2491 return unless $subscriptionid;
2492 my $dbh = C4::Context->dbh;
2493 my $sth = $dbh->prepare( qq{
2496 WHERE subscriptionid = ?
2498 $sth->execute( $subscriptionid );
2500 # Set status = missing when status = stopped
2501 $sth = $dbh->prepare( qq{
2504 WHERE subscriptionid = ?
2507 $sth->execute( $subscriptionid );
2510 =head2 ReopenSubscription
2511 Reopen a subscription given a subscriptionid
2513 sub ReopenSubscription {
2514 my ( $subscriptionid ) = @_;
2515 return unless $subscriptionid;
2516 my $dbh = C4::Context->dbh;
2517 my $sth = $dbh->prepare( qq{
2520 WHERE subscriptionid = ?
2522 $sth->execute( $subscriptionid );
2524 # Set status = expected when status = stopped
2525 $sth = $dbh->prepare( qq{
2528 WHERE subscriptionid = ?
2531 $sth->execute( $subscriptionid );
2534 =head2 subscriptionCurrentlyOnOrder
2536 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2538 Return 1 if subscription is currently on order else 0.
2542 sub subscriptionCurrentlyOnOrder {
2543 my ( $subscriptionid ) = @_;
2544 my $dbh = C4::Context->dbh;
2546 SELECT COUNT(*) FROM aqorders
2547 WHERE subscriptionid = ?
2548 AND datereceived IS NULL
2549 AND datecancellationprinted IS NULL
2551 my $sth = $dbh->prepare( $query );
2552 $sth->execute($subscriptionid);
2553 return $sth->fetchrow_array;
2561 Koha Development Team <http://koha-community.org/>