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
64 C4::Serials - Serials Module Functions
72 Functions for handling subscriptions, claims routing etc.
77 =head2 GetSuppliersWithLateIssues
79 $supplierlist = GetSuppliersWithLateIssues()
81 this function get all suppliers with late issues.
84 an array_ref of suppliers each entry is a hash_ref containing id and name
85 the array is in name order
89 sub GetSuppliersWithLateIssues {
90 my $dbh = C4::Context->dbh;
92 SELECT DISTINCT id, name
94 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
95 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
96 WHERE id > 0 AND ((planneddate < now() AND serial.status=1) OR serial.STATUS = 3 OR serial.STATUS = 4) ORDER BY name|;
97 return $dbh->selectall_arrayref($query, { Slice => {} });
102 @issuelist = GetLateIssues($supplierid)
104 this function selects late issues from the database
107 the issuelist as an array. Each element of this array contains a hashi_ref containing
108 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
113 my ($supplierid) = @_;
114 my $dbh = C4::Context->dbh;
118 SELECT name,title,planneddate,serialseq,serial.subscriptionid
120 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
121 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
122 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
123 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
124 AND subscription.aqbooksellerid=?
127 $sth = $dbh->prepare($query);
128 $sth->execute($supplierid);
131 SELECT name,title,planneddate,serialseq,serial.subscriptionid
133 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
134 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
135 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
136 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
139 $sth = $dbh->prepare($query);
145 while ( my $line = $sth->fetchrow_hashref ) {
146 $odd++ unless $line->{title} eq $last_title;
147 $line->{title} = "" if $line->{title} eq $last_title;
148 $last_title = $line->{title} if ( $line->{title} );
149 $line->{planneddate} = format_date( $line->{planneddate} );
150 push @issuelist, $line;
155 =head2 GetSubscriptionHistoryFromSubscriptionId
157 $sth = GetSubscriptionHistoryFromSubscriptionId()
158 this function prepares the SQL request and returns the statement handle
159 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
163 sub GetSubscriptionHistoryFromSubscriptionId {
164 my $dbh = C4::Context->dbh;
167 FROM subscriptionhistory
168 WHERE subscriptionid = ?
170 return $dbh->prepare($query);
173 =head2 GetSerialStatusFromSerialId
175 $sth = GetSerialStatusFromSerialId();
176 this function returns a statement handle
177 After this function, don't forget to execute it by using $sth->execute($serialid)
179 $sth = $dbh->prepare($query).
183 sub GetSerialStatusFromSerialId {
184 my $dbh = C4::Context->dbh;
190 return $dbh->prepare($query);
193 =head2 GetSerialInformation
196 $data = GetSerialInformation($serialid);
197 returns a hash_ref containing :
198 items : items marcrecord (can be an array)
200 subscription table field
201 + information about subscription expiration
205 sub GetSerialInformation {
207 my $dbh = C4::Context->dbh;
209 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
210 if ( C4::Context->preference('IndependantBranches')
211 && C4::Context->userenv
212 && C4::Context->userenv->{'flags'} != 1
213 && C4::Context->userenv->{'branch'} ) {
215 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
218 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
221 my $rq = $dbh->prepare($query);
222 $rq->execute($serialid);
223 my $data = $rq->fetchrow_hashref;
225 # create item information if we have serialsadditems for this subscription
226 if ( $data->{'serialsadditems'} ) {
227 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
228 $queryitem->execute($serialid);
229 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
231 if ( scalar(@$itemnumbers) > 0 ) {
232 foreach my $itemnum (@$itemnumbers) {
234 #It is ASSUMED that GetMarcItem ALWAYS WORK...
235 #Maybe GetMarcItem should return values on failure
236 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
237 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
238 $itemprocessed->{'itemnumber'} = $itemnum->[0];
239 $itemprocessed->{'itemid'} = $itemnum->[0];
240 $itemprocessed->{'serialid'} = $serialid;
241 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
242 push @{ $data->{'items'} }, $itemprocessed;
245 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
246 $itemprocessed->{'itemid'} = "N$serialid";
247 $itemprocessed->{'serialid'} = $serialid;
248 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
249 $itemprocessed->{'countitems'} = 0;
250 push @{ $data->{'items'} }, $itemprocessed;
253 $data->{ "status" . $data->{'serstatus'} } = 1;
254 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
255 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
259 =head2 AddItem2Serial
261 $rows = AddItem2Serial($serialid,$itemnumber);
262 Adds an itemnumber to Serial record
263 returns the number of rows affected
268 my ( $serialid, $itemnumber ) = @_;
269 my $dbh = C4::Context->dbh;
270 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
271 $rq->execute( $serialid, $itemnumber );
275 =head2 UpdateClaimdateIssues
277 UpdateClaimdateIssues($serialids,[$date]);
279 Update Claimdate for issues in @$serialids list with date $date
284 sub UpdateClaimdateIssues {
285 my ( $serialids, $date ) = @_;
286 my $dbh = C4::Context->dbh;
287 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
289 UPDATE serial SET claimdate = ?, status = 7
290 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")";
291 my $rq = $dbh->prepare($query);
292 $rq->execute($date, @$serialids);
296 =head2 GetSubscription
298 $subs = GetSubscription($subscriptionid)
299 this function returns the subscription which has $subscriptionid as id.
301 a hashref. This hash containts
302 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
306 sub GetSubscription {
307 my ($subscriptionid) = @_;
308 my $dbh = C4::Context->dbh;
310 SELECT subscription.*,
311 subscriptionhistory.*,
312 aqbooksellers.name AS aqbooksellername,
313 biblio.title AS bibliotitle,
314 subscription.biblionumber as bibnum);
315 if ( C4::Context->preference('IndependantBranches')
316 && C4::Context->userenv
317 && C4::Context->userenv->{'flags'} != 1
318 && C4::Context->userenv->{'branch'} ) {
320 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
324 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
325 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
326 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
327 WHERE subscription.subscriptionid = ?
330 # if (C4::Context->preference('IndependantBranches') &&
331 # C4::Context->userenv &&
332 # C4::Context->userenv->{'flags'} != 1){
333 # # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
334 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
336 $debug and warn "query : $query\nsubsid :$subscriptionid";
337 my $sth = $dbh->prepare($query);
338 $sth->execute($subscriptionid);
339 return $sth->fetchrow_hashref;
342 =head2 GetFullSubscription
344 $array_ref = GetFullSubscription($subscriptionid)
345 this function reads the serial table.
349 sub GetFullSubscription {
350 my ($subscriptionid) = @_;
351 my $dbh = C4::Context->dbh;
353 SELECT serial.serialid,
356 serial.publisheddate,
358 serial.notes as notes,
359 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
360 aqbooksellers.name as aqbooksellername,
361 biblio.title as bibliotitle,
362 subscription.branchcode AS branchcode,
363 subscription.subscriptionid AS subscriptionid |;
364 if ( C4::Context->preference('IndependantBranches')
365 && C4::Context->userenv
366 && C4::Context->userenv->{'flags'} != 1
367 && C4::Context->userenv->{'branch'} ) {
369 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
373 LEFT JOIN subscription ON
374 (serial.subscriptionid=subscription.subscriptionid )
375 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
376 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
377 WHERE serial.subscriptionid = ?
379 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
380 serial.subscriptionid
382 $debug and warn "GetFullSubscription query: $query";
383 my $sth = $dbh->prepare($query);
384 $sth->execute($subscriptionid);
385 return $sth->fetchall_arrayref( {} );
388 =head2 PrepareSerialsData
390 $array_ref = PrepareSerialsData($serialinfomation)
391 where serialinformation is a hashref array
395 sub PrepareSerialsData {
401 my $aqbooksellername;
405 my $previousnote = "";
407 foreach my $subs (@{$lines}) {
408 for my $datefield ( qw(publisheddate planneddate) ) {
409 # handle both undef and undef returned as 0000-00-00
410 if (!defined $subs->{$datefield} or $subs->{$datefield}=~m/^00/) {
411 $subs->{$datefield} = 'XXX';
414 $subs->{$datefield} = format_date( $subs->{$datefield} );
417 $subs->{ "status" . $subs->{'status'} } = 1;
418 $subs->{"checked"} = $subs->{'status'} =~ /1|3|4|7/;
420 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
421 $year = $subs->{'year'};
425 if ( $tmpresults{$year} ) {
426 push @{ $tmpresults{$year}->{'serials'} }, $subs;
428 $tmpresults{$year} = {
430 'aqbooksellername' => $subs->{'aqbooksellername'},
431 'bibliotitle' => $subs->{'bibliotitle'},
432 'serials' => [$subs],
437 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
438 push @res, $tmpresults{$key};
443 =head2 GetSubscriptionsFromBiblionumber
445 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
446 this function get the subscription list. it reads the subscription table.
448 reference to an array of subscriptions which have the biblionumber given on input arg.
449 each element of this array is a hashref containing
450 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
454 sub GetSubscriptionsFromBiblionumber {
455 my ($biblionumber) = @_;
456 my $dbh = C4::Context->dbh;
458 SELECT subscription.*,
460 subscriptionhistory.*,
461 aqbooksellers.name AS aqbooksellername,
462 biblio.title AS bibliotitle
464 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
465 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
466 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
467 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
468 WHERE subscription.biblionumber = ?
470 my $sth = $dbh->prepare($query);
471 $sth->execute($biblionumber);
473 while ( my $subs = $sth->fetchrow_hashref ) {
474 $subs->{startdate} = format_date( $subs->{startdate} );
475 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
476 $subs->{histenddate} = format_date( $subs->{histenddate} );
477 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
478 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
479 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
480 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
481 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
482 $subs->{ "status" . $subs->{'status'} } = 1;
483 $subs->{'cannotedit'} =
484 ( C4::Context->preference('IndependantBranches')
485 && C4::Context->userenv
486 && C4::Context->userenv->{flags} % 2 != 1
487 && C4::Context->userenv->{branch}
488 && $subs->{branchcode}
489 && ( C4::Context->userenv->{branch} ne $subs->{branchcode} ) );
491 if ( $subs->{enddate} eq '0000-00-00' ) {
492 $subs->{enddate} = '';
494 $subs->{enddate} = format_date( $subs->{enddate} );
496 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
497 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
503 =head2 GetFullSubscriptionsFromBiblionumber
505 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
506 this function reads the serial table.
510 sub GetFullSubscriptionsFromBiblionumber {
511 my ($biblionumber) = @_;
512 my $dbh = C4::Context->dbh;
514 SELECT serial.serialid,
517 serial.publisheddate,
519 serial.notes as notes,
520 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
521 biblio.title as bibliotitle,
522 subscription.branchcode AS branchcode,
523 subscription.subscriptionid AS subscriptionid|;
524 if ( C4::Context->preference('IndependantBranches')
525 && C4::Context->userenv
526 && C4::Context->userenv->{'flags'} != 1
527 && C4::Context->userenv->{'branch'} ) {
529 , ((subscription.branchcode <>\"" . C4::Context->userenv->{'branch'} . "\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
534 LEFT JOIN subscription ON
535 (serial.subscriptionid=subscription.subscriptionid)
536 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
537 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
538 WHERE subscription.biblionumber = ?
540 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
541 serial.subscriptionid
543 my $sth = $dbh->prepare($query);
544 $sth->execute($biblionumber);
545 return $sth->fetchall_arrayref( {} );
548 =head2 GetSubscriptions
550 @results = GetSubscriptions($title,$ISSN,$ean,$biblionumber);
551 this function gets all subscriptions which have title like $title,ISSN like $ISSN,EAN like $ean and biblionumber like $biblionumber.
553 a table of hashref. Each hash containt the subscription.
557 sub GetSubscriptions {
558 my ( $string, $issn, $ean, $biblionumber ) = @_;
560 #return unless $title or $ISSN or $biblionumber;
561 my $dbh = C4::Context->dbh;
564 SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber
566 LEFT JOIN subscriptionhistory USING(subscriptionid)
567 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
568 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
573 $sqlwhere = " WHERE biblio.biblionumber=?";
574 push @bind_params, $biblionumber;
578 my @strings_to_search;
579 @strings_to_search = map { "%$_%" } split( / /, $string );
580 foreach my $index (qw(biblio.title subscription.callnumber subscription.location subscription.notes subscription.internalnotes)) {
581 push @bind_params, @strings_to_search;
582 my $tmpstring = "AND $index LIKE ? " x scalar(@strings_to_search);
583 $debug && warn "$tmpstring";
584 $tmpstring =~ s/^AND //;
585 push @sqlstrings, $tmpstring;
587 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
591 my @strings_to_search;
592 @strings_to_search = map { "%$_%" } split( / /, $issn );
593 foreach my $index ( qw(biblioitems.issn subscription.callnumber)) {
594 push @bind_params, @strings_to_search;
595 my $tmpstring = "OR $index LIKE ? " x scalar(@strings_to_search);
596 $debug && warn "$tmpstring";
597 $tmpstring =~ s/^OR //;
598 push @sqlstrings, $tmpstring;
600 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
604 my @strings_to_search;
605 @strings_to_search = map { "$_" } split( / /, $ean );
606 foreach my $index ( qw(biblioitems.ean) ) {
607 push @bind_params, @strings_to_search;
608 my $tmpstring = "OR $index = ? " x scalar(@strings_to_search);
609 $debug && warn "$tmpstring";
610 $tmpstring =~ s/^OR //;
611 push @sqlstrings, $tmpstring;
613 $sqlwhere .= ( $sqlwhere ? " AND " : " WHERE " ) . "((" . join( ") OR (", @sqlstrings ) . "))";
616 $sql .= "$sqlwhere ORDER BY title";
617 $debug and warn "GetSubscriptions query: $sql params : ", join( " ", @bind_params );
618 $sth = $dbh->prepare($sql);
619 $sth->execute(@bind_params);
622 while ( my $line = $sth->fetchrow_hashref ) {
623 $line->{'cannotedit'} =
624 ( C4::Context->preference('IndependantBranches')
625 && C4::Context->userenv
626 && C4::Context->userenv->{flags} % 2 != 1
627 && C4::Context->userenv->{branch}
628 && $line->{branchcode}
629 && ( C4::Context->userenv->{branch} ne $line->{branchcode} ) );
630 push @results, $line;
635 =head2 SearchSubscriptions
637 @results = SearchSubscriptions($args);
638 $args is a hashref. Its keys can be contained: title, issn, ean, publisher, bookseller and branchcode
640 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.
643 a table of hashref. Each hash containt the subscription.
647 sub SearchSubscriptions {
651 SELECT subscription.*, subscriptionhistory.*, biblio.*, biblioitems.issn
653 LEFT JOIN subscriptionhistory USING(subscriptionid)
654 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
655 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
656 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
660 if( $args->{biblionumber} ) {
661 push @where_strs, "biblio.biblionumber = ?";
662 push @where_args, $args->{biblionumber};
664 if( $args->{title} ){
665 push @where_strs, "biblio.title LIKE ?";
666 push @where_args, "%$args->{title}%";
669 push @where_strs, "biblioitems.issn LIKE ?";
670 push @where_args, "%$args->{issn}%";
673 push @where_strs, "biblioitems.ean LIKE ?";
674 push @where_args, "%$args->{ean}%";
676 if( $args->{publisher} ){
677 push @where_strs, "biblioitems.publishercode LIKE ?";
678 push @where_args, "%$args->{publisher}%";
680 if( $args->{bookseller} ){
681 push @where_strs, "aqbooksellers.name LIKE ?";
682 push @where_args, "%$args->{bookseller}%";
684 if( $args->{branch} ){
685 push @where_strs, "subscription.branchcode = ?";
686 push @where_args, "$args->{branch}";
690 $query .= " WHERE " . join(" AND ", @where_strs);
693 my $dbh = C4::Context->dbh;
694 my $sth = $dbh->prepare($query);
695 $sth->execute(@where_args);
696 my $results = $sth->fetchall_arrayref( {} );
705 ($totalissues,@serials) = GetSerials($subscriptionid);
706 this function gets every serial not arrived for a given subscription
707 as well as the number of issues registered in the database (all types)
708 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
710 FIXME: We should return \@serials.
715 my ( $subscriptionid, $count ) = @_;
716 my $dbh = C4::Context->dbh;
718 # status = 2 is "arrived"
720 $count = 5 unless ($count);
722 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
724 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
725 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
726 my $sth = $dbh->prepare($query);
727 $sth->execute($subscriptionid);
729 while ( my $line = $sth->fetchrow_hashref ) {
730 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
731 for my $datefield ( qw( planneddate publisheddate) ) {
732 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
733 $line->{$datefield} = format_date( $line->{$datefield});
735 $line->{$datefield} = q{};
738 push @serials, $line;
741 # OK, now add the last 5 issues arrives/missing
742 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
744 WHERE subscriptionid = ?
745 AND (status in (2,4,5))
746 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
748 $sth = $dbh->prepare($query);
749 $sth->execute($subscriptionid);
750 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
752 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
753 for my $datefield ( qw( planneddate publisheddate) ) {
754 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
755 $line->{$datefield} = format_date( $line->{$datefield});
757 $line->{$datefield} = q{};
761 push @serials, $line;
764 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
765 $sth = $dbh->prepare($query);
766 $sth->execute($subscriptionid);
767 my ($totalissues) = $sth->fetchrow;
768 return ( $totalissues, @serials );
773 @serials = GetSerials2($subscriptionid,$status);
774 this function returns every serial waited for a given subscription
775 as well as the number of issues registered in the database (all types)
776 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
781 my ( $subscription, $status ) = @_;
782 my $dbh = C4::Context->dbh;
784 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
786 WHERE subscriptionid=$subscription AND status IN ($status)
787 ORDER BY publisheddate,serialid DESC
789 $debug and warn "GetSerials2 query: $query";
790 my $sth = $dbh->prepare($query);
794 while ( my $line = $sth->fetchrow_hashref ) {
795 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
796 # Format dates for display
797 for my $datefield ( qw( planneddate publisheddate ) ) {
798 if ($line->{$datefield} =~m/^00/) {
799 $line->{$datefield} = q{};
802 $line->{$datefield} = format_date( $line->{$datefield} );
805 push @serials, $line;
810 =head2 GetLatestSerials
812 \@serials = GetLatestSerials($subscriptionid,$limit)
813 get the $limit's latest serials arrived or missing for a given subscription
815 a ref to an array which contains all of the latest serials stored into a hash.
819 sub GetLatestSerials {
820 my ( $subscriptionid, $limit ) = @_;
821 my $dbh = C4::Context->dbh;
823 # status = 2 is "arrived"
824 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
826 WHERE subscriptionid = ?
827 AND (status =2 or status=4)
828 ORDER BY publisheddate DESC LIMIT 0,$limit
830 my $sth = $dbh->prepare($strsth);
831 $sth->execute($subscriptionid);
833 while ( my $line = $sth->fetchrow_hashref ) {
834 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
835 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
836 push @serials, $line;
842 =head2 GetDistributedTo
844 $distributedto=GetDistributedTo($subscriptionid)
845 This function returns the field distributedto for the subscription matching subscriptionid
849 sub GetDistributedTo {
850 my $dbh = C4::Context->dbh;
852 my $subscriptionid = @_;
853 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
854 my $sth = $dbh->prepare($query);
855 $sth->execute($subscriptionid);
856 return ($distributedto) = $sth->fetchrow;
862 $val is a hashref containing all the attributes of the table 'subscription'
863 This function get the next issue for the subscription given on input arg
865 a list containing all the input params updated.
871 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
872 # $calculated = $val->{numberingmethod};
873 # # calculate the (expected) value of the next issue recieved.
874 # $newlastvalue1 = $val->{lastvalue1};
875 # # check if we have to increase the new value.
876 # $newinnerloop1 = $val->{innerloop1}+1;
877 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
878 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
879 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
880 # $calculated =~ s/\{X\}/$newlastvalue1/g;
882 # $newlastvalue2 = $val->{lastvalue2};
883 # # check if we have to increase the new value.
884 # $newinnerloop2 = $val->{innerloop2}+1;
885 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
886 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
887 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
888 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
890 # $newlastvalue3 = $val->{lastvalue3};
891 # # check if we have to increase the new value.
892 # $newinnerloop3 = $val->{innerloop3}+1;
893 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
894 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
895 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
896 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
897 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
902 my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
903 my $pattern = $val->{numberpattern};
904 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
905 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
906 $calculated = $val->{numberingmethod};
907 $newlastvalue1 = $val->{lastvalue1};
908 $newlastvalue2 = $val->{lastvalue2};
909 $newlastvalue3 = $val->{lastvalue3};
910 $newlastvalue1 = $val->{lastvalue1};
912 # check if we have to increase the new value.
913 $newinnerloop1 = $val->{innerloop1} + 1;
914 $newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} );
915 $newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 ); # <1 to be true when 0 or empty.
916 $newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} ); # reset counter if needed.
917 $calculated =~ s/\{X\}/$newlastvalue1/g;
919 $newlastvalue2 = $val->{lastvalue2};
921 # check if we have to increase the new value.
922 $newinnerloop2 = $val->{innerloop2} + 1;
923 $newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} );
924 $newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 ); # <1 to be true when 0 or empty.
925 $newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} ); # reset counter if needed.
926 if ( $pattern == 6 ) {
927 if ( $val->{hemisphere} == 2 ) {
928 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
929 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
931 my $newlastvalue2seq = $seasons[$newlastvalue2];
932 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
935 $calculated =~ s/\{Y\}/$newlastvalue2/g;
938 $newlastvalue3 = $val->{lastvalue3};
940 # check if we have to increase the new value.
941 $newinnerloop3 = $val->{innerloop3} + 1;
942 $newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} );
943 $newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 ); # <1 to be true when 0 or empty.
944 $newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} ); # reset counter if needed.
945 $calculated =~ s/\{Z\}/$newlastvalue3/g;
947 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 );
952 $calculated = GetSeq($val)
953 $val is a hashref containing all the attributes of the table 'subscription'
954 this function transforms {X},{Y},{Z} to 150,0,0 for example.
956 the sequence in integer format
962 my $pattern = $val->{numberpattern};
963 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
964 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
965 my $calculated = $val->{numberingmethod};
966 my $x = $val->{'lastvalue1'};
967 $calculated =~ s/\{X\}/$x/g;
968 my $newlastvalue2 = $val->{'lastvalue2'};
970 if ( $pattern == 6 ) {
971 if ( $val->{hemisphere} == 2 ) {
972 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
973 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
975 my $newlastvalue2seq = $seasons[$newlastvalue2];
976 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
979 $calculated =~ s/\{Y\}/$newlastvalue2/g;
981 my $z = $val->{'lastvalue3'};
982 $calculated =~ s/\{Z\}/$z/g;
986 =head2 GetExpirationDate
988 $enddate = GetExpirationDate($subscriptionid, [$startdate])
990 this function return the next expiration date for a subscription given on input args.
997 sub GetExpirationDate {
998 my ( $subscriptionid, $startdate ) = @_;
999 my $dbh = C4::Context->dbh;
1000 my $subscription = GetSubscription($subscriptionid);
1003 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1004 $enddate = $startdate || $subscription->{startdate};
1005 my @date = split( /-/, $enddate );
1006 return if ( scalar(@date) != 3 || not check_date(@date) );
1007 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1010 if ( my $length = $subscription->{numberlength} ) {
1012 #calculate the date of the last issue.
1013 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1014 $enddate = GetNextDate( $enddate, $subscription );
1016 } elsif ( $subscription->{monthlength} ) {
1017 if ( $$subscription{startdate} ) {
1018 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
1019 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1021 } elsif ( $subscription->{weeklength} ) {
1022 if ( $$subscription{startdate} ) {
1023 my @date = split( /-/, $subscription->{startdate} );
1024 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1025 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1034 =head2 CountSubscriptionFromBiblionumber
1036 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1037 this returns a count of the subscriptions for a given biblionumber
1039 the number of subscriptions
1043 sub CountSubscriptionFromBiblionumber {
1044 my ($biblionumber) = @_;
1045 my $dbh = C4::Context->dbh;
1046 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1047 my $sth = $dbh->prepare($query);
1048 $sth->execute($biblionumber);
1049 my $subscriptionsnumber = $sth->fetchrow;
1050 return $subscriptionsnumber;
1053 =head2 ModSubscriptionHistory
1055 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1057 this function modifies the history of a subscription. Put your new values on input arg.
1058 returns the number of rows affected
1062 sub ModSubscriptionHistory {
1063 my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_;
1064 my $dbh = C4::Context->dbh;
1065 my $query = "UPDATE subscriptionhistory
1066 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1067 WHERE subscriptionid=?
1069 my $sth = $dbh->prepare($query);
1070 $recievedlist =~ s/^; //;
1071 $missinglist =~ s/^; //;
1072 $opacnote =~ s/^; //;
1073 $sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1077 =head2 ModSerialStatus
1079 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1081 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1082 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1086 sub ModSerialStatus {
1087 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1089 #It is a usual serial
1090 # 1st, get previous status :
1091 my $dbh = C4::Context->dbh;
1092 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1093 my $sth = $dbh->prepare($query);
1094 $sth->execute($serialid);
1095 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1097 # change status & update subscriptionhistory
1099 if ( $status == 6 ) {
1100 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1104 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1105 $sth = $dbh->prepare($query);
1106 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1107 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1108 $sth = $dbh->prepare($query);
1109 $sth->execute($subscriptionid);
1110 my $val = $sth->fetchrow_hashref;
1111 unless ( $val->{manualhistory} ) {
1112 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1113 $sth = $dbh->prepare($query);
1114 $sth->execute($subscriptionid);
1115 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1116 if ( $status == 2 ) {
1118 $recievedlist .= "; $serialseq"
1119 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1122 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1123 $missinglist .= "; $serialseq"
1125 and not index( "$missinglist", "$serialseq" ) >= 0 );
1126 $missinglist .= "; not issued $serialseq"
1128 and index( "$missinglist", "$serialseq" ) >= 0 );
1129 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1130 $sth = $dbh->prepare($query);
1131 $recievedlist =~ s/^; //;
1132 $missinglist =~ s/^; //;
1133 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1137 # create new waited entry if needed (ie : was a "waited" and has changed)
1138 if ( $oldstatus == 1 && $status != 1 ) {
1139 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1140 $sth = $dbh->prepare($query);
1141 $sth->execute($subscriptionid);
1142 my $val = $sth->fetchrow_hashref;
1146 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1147 $newinnerloop1, $newinnerloop2, $newinnerloop3
1148 ) = GetNextSeq($val);
1150 # next date (calculated from actual date & frequency parameters)
1151 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1152 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate );
1153 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1154 WHERE subscriptionid = ?";
1155 $sth = $dbh->prepare($query);
1156 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1158 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1159 if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) {
1160 require C4::Letters;
1161 C4::Letters::SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1167 =head2 GetNextExpected
1169 $nextexpected = GetNextExpected($subscriptionid)
1171 Get the planneddate for the current expected issue of the subscription.
1177 planneddate => C4::Dates object
1182 sub GetNextExpected {
1183 my ($subscriptionid) = @_;
1184 my $dbh = C4::Context->dbh;
1185 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1187 # Each subscription has only one 'expected' issue, with serial.status==1.
1188 $sth->execute( $subscriptionid, 1 );
1189 my ( $nextissue ) = $sth->fetchrow_hashref;
1191 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1192 $sth->execute( $subscriptionid );
1193 $nextissue = $sth->fetchrow_hashref;
1195 if (!defined $nextissue->{planneddate}) {
1196 # or should this default to 1st Jan ???
1197 $nextissue->{planneddate} = strftime('%Y-%m-%d',localtime);
1199 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1204 =head2 ModNextExpected
1206 ModNextExpected($subscriptionid,$date)
1208 Update the planneddate for the current expected issue of the subscription.
1209 This will modify all future prediction results.
1211 C<$date> is a C4::Dates object.
1217 sub ModNextExpected {
1218 my ( $subscriptionid, $date ) = @_;
1219 my $dbh = C4::Context->dbh;
1221 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1222 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1224 # Each subscription has only one 'expected' issue, with serial.status==1.
1225 $sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 );
1230 =head2 ModSubscription
1232 this function modifies a subscription. Put all new values on input args.
1233 returns the number of rows affected
1237 sub ModSubscription {
1238 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1239 $dow, $irregularity, $numberpattern, $numberlength, $weeklength, $monthlength, $add1, $every1,
1240 $whenmorethan1, $setto1, $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2,
1241 $lastvalue2, $innerloop2, $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1242 $numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory,
1243 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid
1246 # warn $irregularity;
1247 my $dbh = C4::Context->dbh;
1248 my $query = "UPDATE subscription
1249 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1250 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1251 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1252 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1253 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1254 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?,
1255 letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,
1256 staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1258 WHERE subscriptionid = ?";
1260 #warn "query :".$query;
1261 my $sth = $dbh->prepare($query);
1263 $auser, $branchcode, $aqbooksellerid, $cost,
1264 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1265 $dow, "$irregularity", $numberpattern, $numberlength,
1266 $weeklength, $monthlength, $add1, $every1,
1267 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1268 $add2, $every2, $whenmorethan2, $setto2,
1269 $lastvalue2, $innerloop2, $add3, $every3,
1270 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1271 $numberingmethod, $status, $biblionumber, $callnumber,
1272 $notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ),
1273 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1274 $graceperiod, $location, $enddate, $subscriptionid
1276 my $rows = $sth->rows;
1278 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1282 =head2 NewSubscription
1284 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1285 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1286 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1287 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1288 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1289 $numberingmethod, $status, $notes, $serialsadditems,
1290 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate);
1292 Create a new subscription with value given on input args.
1295 the id of this new subscription
1299 sub NewSubscription {
1300 my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1301 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1302 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1303 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status,
1304 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1305 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1307 my $dbh = C4::Context->dbh;
1309 #save subscription (insert into database)
1311 INSERT INTO subscription
1312 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1313 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1314 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1315 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1316 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1317 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1318 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1319 staffdisplaycount,opacdisplaycount,graceperiod,location,enddate)
1320 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1322 my $sth = $dbh->prepare($query);
1324 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity,
1325 $dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1,
1326 $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1327 $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, "$status",
1328 $notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory,
1329 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate
1332 my $subscriptionid = $dbh->{'mysql_insertid'};
1334 $enddate = GetExpirationDate($subscriptionid,$startdate);
1338 WHERE subscriptionid=?
1340 $sth = $dbh->prepare($query);
1341 $sth->execute( $enddate, $subscriptionid );
1343 #then create the 1st waited number
1345 INSERT INTO subscriptionhistory
1346 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1349 $sth = $dbh->prepare($query);
1350 $sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes );
1352 # reread subscription to get a hash (for calculation of the 1st issue number)
1356 WHERE subscriptionid = ?
1358 $sth = $dbh->prepare($query);
1359 $sth->execute($subscriptionid);
1360 my $val = $sth->fetchrow_hashref;
1362 # calculate issue number
1363 my $serialseq = GetSeq($val);
1366 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1367 VALUES (?,?,?,?,?,?)
1369 $sth = $dbh->prepare($query);
1370 $sth->execute( "$serialseq", $subscriptionid, $biblionumber, 1, $firstacquidate, $firstacquidate );
1372 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1374 #set serial flag on biblio if not already set.
1375 my $bib = GetBiblio($biblionumber);
1376 if ( !$bib->{'serial'} ) {
1377 my $record = GetMarcBiblio($biblionumber);
1378 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1380 eval { $record->field($tag)->update( $subf => 1 ); };
1382 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1384 return $subscriptionid;
1387 =head2 ReNewSubscription
1389 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1391 this function renew a subscription with values given on input args.
1395 sub ReNewSubscription {
1396 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1397 my $dbh = C4::Context->dbh;
1398 my $subscription = GetSubscription($subscriptionid);
1402 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1403 WHERE biblio.biblionumber=?
1405 my $sth = $dbh->prepare($query);
1406 $sth->execute( $subscription->{biblionumber} );
1407 my $biblio = $sth->fetchrow_hashref;
1409 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1410 require C4::Suggestions;
1411 C4::Suggestions::NewSuggestion(
1412 { 'suggestedby' => $user,
1413 'title' => $subscription->{bibliotitle},
1414 'author' => $biblio->{author},
1415 'publishercode' => $biblio->{publishercode},
1416 'note' => $biblio->{note},
1417 'biblionumber' => $subscription->{biblionumber}
1422 # renew subscription
1425 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1426 WHERE subscriptionid=?
1428 $sth = $dbh->prepare($query);
1429 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1430 my $enddate = GetExpirationDate($subscriptionid);
1431 $debug && warn "enddate :$enddate";
1435 WHERE subscriptionid=?
1437 $sth = $dbh->prepare($query);
1438 $sth->execute( $enddate, $subscriptionid );
1440 UPDATE subscriptionhistory
1442 WHERE subscriptionid=?
1444 $sth = $dbh->prepare($query);
1445 $sth->execute( $enddate, $subscriptionid );
1447 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1453 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1455 Create a new issue stored on the database.
1456 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1457 returns the serial id
1462 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1463 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1465 my $dbh = C4::Context->dbh;
1468 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1469 VALUES (?,?,?,?,?,?,?)
1471 my $sth = $dbh->prepare($query);
1472 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1473 my $serialid = $dbh->{'mysql_insertid'};
1475 SELECT missinglist,recievedlist
1476 FROM subscriptionhistory
1477 WHERE subscriptionid=?
1479 $sth = $dbh->prepare($query);
1480 $sth->execute($subscriptionid);
1481 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1483 if ( $status == 2 ) {
1484 ### TODO Add a feature that improves recognition and description.
1485 ### As such count (serialseq) i.e. : N18,2(N19),N20
1486 ### Would use substr and index But be careful to previous presence of ()
1487 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1489 if ( $status == 4 ) {
1490 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1493 UPDATE subscriptionhistory
1494 SET recievedlist=?, missinglist=?
1495 WHERE subscriptionid=?
1497 $sth = $dbh->prepare($query);
1498 $recievedlist =~ s/^; //;
1499 $missinglist =~ s/^; //;
1500 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1504 =head2 ItemizeSerials
1506 ItemizeSerials($serialid, $info);
1507 $info is a hashref containing barcode branch, itemcallnumber, status, location
1508 $serialid the serialid
1510 1 if the itemize is a succes.
1511 0 and @error otherwise. @error containts the list of errors found.
1515 sub ItemizeSerials {
1516 my ( $serialid, $info ) = @_;
1517 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1519 my $dbh = C4::Context->dbh;
1525 my $sth = $dbh->prepare($query);
1526 $sth->execute($serialid);
1527 my $data = $sth->fetchrow_hashref;
1528 if ( C4::Context->preference("RoutingSerials") ) {
1530 # check for existing biblioitem relating to serial issue
1531 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1533 for ( my $i = 0 ; $i < $count ; $i++ ) {
1534 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1535 $bibitemno = $results[$i]->{'biblioitemnumber'};
1539 if ( $bibitemno == 0 ) {
1540 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1541 $sth->execute( $data->{'biblionumber'} );
1542 my $biblioitem = $sth->fetchrow_hashref;
1543 $biblioitem->{'volumedate'} = $data->{planneddate};
1544 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1545 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1549 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1550 if ( $info->{barcode} ) {
1552 if ( is_barcode_in_use( $info->{barcode} ) ) {
1553 push @errors, 'barcode_not_unique';
1555 my $marcrecord = MARC::Record->new();
1556 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1557 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1558 $marcrecord->insert_fields_ordered($newField);
1559 if ( $info->{branch} ) {
1560 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1562 #warn "items.homebranch : $tag , $subfield";
1563 if ( $marcrecord->field($tag) ) {
1564 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1566 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1567 $marcrecord->insert_fields_ordered($newField);
1569 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1571 #warn "items.holdingbranch : $tag , $subfield";
1572 if ( $marcrecord->field($tag) ) {
1573 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1575 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1576 $marcrecord->insert_fields_ordered($newField);
1579 if ( $info->{itemcallnumber} ) {
1580 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1582 if ( $marcrecord->field($tag) ) {
1583 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1585 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1586 $marcrecord->insert_fields_ordered($newField);
1589 if ( $info->{notes} ) {
1590 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1592 if ( $marcrecord->field($tag) ) {
1593 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1595 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1596 $marcrecord->insert_fields_ordered($newField);
1599 if ( $info->{location} ) {
1600 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1602 if ( $marcrecord->field($tag) ) {
1603 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1605 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1606 $marcrecord->insert_fields_ordered($newField);
1609 if ( $info->{status} ) {
1610 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1612 if ( $marcrecord->field($tag) ) {
1613 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1615 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1616 $marcrecord->insert_fields_ordered($newField);
1619 if ( C4::Context->preference("RoutingSerials") ) {
1620 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1621 if ( $marcrecord->field($tag) ) {
1622 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1624 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1625 $marcrecord->insert_fields_ordered($newField);
1629 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1632 return ( 0, @errors );
1636 =head2 HasSubscriptionStrictlyExpired
1638 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1640 the subscription has stricly expired when today > the end subscription date
1643 1 if true, 0 if false, -1 if the expiration date is not set.
1647 sub HasSubscriptionStrictlyExpired {
1649 # Getting end of subscription date
1650 my ($subscriptionid) = @_;
1651 my $dbh = C4::Context->dbh;
1652 my $subscription = GetSubscription($subscriptionid);
1653 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1655 # If the expiration date is set
1656 if ( $expirationdate != 0 ) {
1657 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1659 # Getting today's date
1660 my ( $nowyear, $nowmonth, $nowday ) = Today();
1662 # if today's date > expiration date, then the subscription has stricly expired
1663 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1670 # There are some cases where the expiration date is not set
1671 # As we can't determine if the subscription has expired on a date-basis,
1677 =head2 HasSubscriptionExpired
1679 $has_expired = HasSubscriptionExpired($subscriptionid)
1681 the subscription has expired when the next issue to arrive is out of subscription limit.
1684 0 if the subscription has not expired
1685 1 if the subscription has expired
1686 2 if has subscription does not have a valid expiration date set
1690 sub HasSubscriptionExpired {
1691 my ($subscriptionid) = @_;
1692 my $dbh = C4::Context->dbh;
1693 my $subscription = GetSubscription($subscriptionid);
1694 if ( ( $subscription->{periodicity} % 16 ) > 0 ) {
1695 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1696 if (!defined $expirationdate) {
1697 $expirationdate = q{};
1700 SELECT max(planneddate)
1702 WHERE subscriptionid=?
1704 my $sth = $dbh->prepare($query);
1705 $sth->execute($subscriptionid);
1706 my ($res) = $sth->fetchrow;
1707 if (!$res || $res=~m/^0000/) {
1710 my @res = split( /-/, $res );
1711 my @endofsubscriptiondate = split( /-/, $expirationdate );
1712 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1714 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1718 if ( $subscription->{'numberlength'} ) {
1719 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1720 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1726 return 0; # Notice that you'll never get here.
1729 =head2 SetDistributedto
1731 SetDistributedto($distributedto,$subscriptionid);
1732 This function update the value of distributedto for a subscription given on input arg.
1736 sub SetDistributedto {
1737 my ( $distributedto, $subscriptionid ) = @_;
1738 my $dbh = C4::Context->dbh;
1742 WHERE subscriptionid=?
1744 my $sth = $dbh->prepare($query);
1745 $sth->execute( $distributedto, $subscriptionid );
1749 =head2 DelSubscription
1751 DelSubscription($subscriptionid)
1752 this function deletes subscription which has $subscriptionid as id.
1756 sub DelSubscription {
1757 my ($subscriptionid) = @_;
1758 my $dbh = C4::Context->dbh;
1759 $subscriptionid = $dbh->quote($subscriptionid);
1760 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1761 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1762 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1764 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1769 DelIssue($serialseq,$subscriptionid)
1770 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1772 returns the number of rows affected
1777 my ($dataissue) = @_;
1778 my $dbh = C4::Context->dbh;
1779 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1784 AND subscriptionid= ?
1786 my $mainsth = $dbh->prepare($query);
1787 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1789 #Delete element from subscription history
1790 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1791 my $sth = $dbh->prepare($query);
1792 $sth->execute( $dataissue->{'subscriptionid'} );
1793 my $val = $sth->fetchrow_hashref;
1794 unless ( $val->{manualhistory} ) {
1796 SELECT * FROM subscriptionhistory
1797 WHERE subscriptionid= ?
1799 my $sth = $dbh->prepare($query);
1800 $sth->execute( $dataissue->{'subscriptionid'} );
1801 my $data = $sth->fetchrow_hashref;
1802 my $serialseq = $dataissue->{'serialseq'};
1803 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1804 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1805 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1806 $sth = $dbh->prepare($strsth);
1807 $sth->execute( $dataissue->{'subscriptionid'} );
1810 return $mainsth->rows;
1813 =head2 GetLateOrMissingIssues
1815 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1817 this function selects missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1820 the issuelist as an array of hash refs. Each element of this array contains
1821 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1825 sub GetLateOrMissingIssues {
1826 my ( $supplierid, $serialid, $order ) = @_;
1827 my $dbh = C4::Context->dbh;
1831 $byserial = "and serialid = " . $serialid;
1834 $order .= ", title";
1839 $sth = $dbh->prepare(
1841 serialid, aqbooksellerid, name,
1842 biblio.title, planneddate, serialseq,
1843 serial.status, serial.subscriptionid, claimdate,
1844 subscription.branchcode
1846 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1847 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1848 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1849 WHERE subscription.subscriptionid = serial.subscriptionid
1850 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1851 AND subscription.aqbooksellerid=$supplierid
1856 $sth = $dbh->prepare(
1858 serialid, aqbooksellerid, name,
1859 biblio.title, planneddate, serialseq,
1860 serial.status, serial.subscriptionid, claimdate,
1861 subscription.branchcode
1863 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1864 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1865 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1866 WHERE subscription.subscriptionid = serial.subscriptionid
1867 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3 OR serial.STATUS = 7))
1874 while ( my $line = $sth->fetchrow_hashref ) {
1876 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1877 $line->{planneddate} = format_date( $line->{planneddate} );
1879 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1880 $line->{claimdate} = format_date( $line->{claimdate} );
1882 $line->{"status".$line->{status}} = 1;
1883 push @issuelist, $line;
1888 =head2 removeMissingIssue
1890 removeMissingIssue($subscriptionid)
1892 this function removes an issue from being part of the missing string in
1893 subscriptionlist.missinglist column
1895 called when a missing issue is found from the serials-recieve.pl file
1899 sub removeMissingIssue {
1900 my ( $sequence, $subscriptionid ) = @_;
1901 my $dbh = C4::Context->dbh;
1902 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1903 $sth->execute($subscriptionid);
1904 my $data = $sth->fetchrow_hashref;
1905 my $missinglist = $data->{'missinglist'};
1906 my $missinglistbefore = $missinglist;
1908 # warn $missinglist." before";
1909 $missinglist =~ s/($sequence)//;
1911 # warn $missinglist." after";
1912 if ( $missinglist ne $missinglistbefore ) {
1913 $missinglist =~ s/\|\s\|/\|/g;
1914 $missinglist =~ s/^\| //g;
1915 $missinglist =~ s/\|$//g;
1916 my $sth2 = $dbh->prepare(
1917 "UPDATE subscriptionhistory
1919 WHERE subscriptionid = ?"
1921 $sth2->execute( $missinglist, $subscriptionid );
1928 &updateClaim($serialid)
1930 this function updates the time when a claim is issued for late/missing items
1932 called from claims.pl file
1937 my ($serialid) = @_;
1938 my $dbh = C4::Context->dbh;
1939 my $sth = $dbh->prepare(
1940 "UPDATE serial SET claimdate = now()
1944 $sth->execute($serialid);
1948 =head2 getsupplierbyserialid
1950 $result = getsupplierbyserialid($serialid)
1952 this function is used to find the supplier id given a serial id
1955 hashref containing serialid, subscriptionid, and aqbooksellerid
1959 sub getsupplierbyserialid {
1960 my ($serialid) = @_;
1961 my $dbh = C4::Context->dbh;
1962 my $sth = $dbh->prepare(
1963 "SELECT serialid, serial.subscriptionid, aqbooksellerid
1965 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
1969 $sth->execute($serialid);
1970 my $line = $sth->fetchrow_hashref;
1971 my $result = $line->{'aqbooksellerid'};
1975 =head2 check_routing
1977 $result = &check_routing($subscriptionid)
1979 this function checks to see if a serial has a routing list and returns the count of routingid
1980 used to show either an 'add' or 'edit' link
1985 my ($subscriptionid) = @_;
1986 my $dbh = C4::Context->dbh;
1987 my $sth = $dbh->prepare(
1988 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
1989 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
1990 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
1993 $sth->execute($subscriptionid);
1994 my $line = $sth->fetchrow_hashref;
1995 my $result = $line->{'routingids'};
1999 =head2 addroutingmember
2001 addroutingmember($borrowernumber,$subscriptionid)
2003 this function takes a borrowernumber and subscriptionid and adds the member to the
2004 routing list for that serial subscription and gives them a rank on the list
2005 of either 1 or highest current rank + 1
2009 sub addroutingmember {
2010 my ( $borrowernumber, $subscriptionid ) = @_;
2012 my $dbh = C4::Context->dbh;
2013 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2014 $sth->execute($subscriptionid);
2015 while ( my $line = $sth->fetchrow_hashref ) {
2016 if ( $line->{'rank'} > 0 ) {
2017 $rank = $line->{'rank'} + 1;
2022 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2023 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2026 =head2 reorder_members
2028 reorder_members($subscriptionid,$routingid,$rank)
2030 this function is used to reorder the routing list
2032 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2033 - it gets all members on list puts their routingid's into an array
2034 - removes the one in the array that is $routingid
2035 - then reinjects $routingid at point indicated by $rank
2036 - then update the database with the routingids in the new order
2040 sub reorder_members {
2041 my ( $subscriptionid, $routingid, $rank ) = @_;
2042 my $dbh = C4::Context->dbh;
2043 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2044 $sth->execute($subscriptionid);
2046 while ( my $line = $sth->fetchrow_hashref ) {
2047 push( @result, $line->{'routingid'} );
2050 # To find the matching index
2052 my $key = -1; # to allow for 0 being a valid response
2053 for ( $i = 0 ; $i < @result ; $i++ ) {
2054 if ( $routingid == $result[$i] ) {
2055 $key = $i; # save the index
2060 # if index exists in array then move it to new position
2061 if ( $key > -1 && $rank > 0 ) {
2062 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2063 my $moving_item = splice( @result, $key, 1 );
2064 splice( @result, $new_rank, 0, $moving_item );
2066 for ( my $j = 0 ; $j < @result ; $j++ ) {
2067 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2073 =head2 delroutingmember
2075 delroutingmember($routingid,$subscriptionid)
2077 this function either deletes one member from routing list if $routingid exists otherwise
2078 deletes all members from the routing list
2082 sub delroutingmember {
2084 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2085 my ( $routingid, $subscriptionid ) = @_;
2086 my $dbh = C4::Context->dbh;
2088 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2089 $sth->execute($routingid);
2090 reorder_members( $subscriptionid, $routingid );
2092 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2093 $sth->execute($subscriptionid);
2098 =head2 getroutinglist
2100 @routinglist = getroutinglist($subscriptionid)
2102 this gets the info from the subscriptionroutinglist for $subscriptionid
2105 the routinglist as an array. Each element of the array contains a hash_ref containing
2106 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2110 sub getroutinglist {
2111 my ($subscriptionid) = @_;
2112 my $dbh = C4::Context->dbh;
2113 my $sth = $dbh->prepare(
2114 'SELECT routingid, borrowernumber, ranking, biblionumber
2116 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2117 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2119 $sth->execute($subscriptionid);
2120 my $routinglist = $sth->fetchall_arrayref({});
2121 return @{$routinglist};
2124 =head2 countissuesfrom
2126 $result = countissuesfrom($subscriptionid,$startdate)
2128 Returns a count of serial rows matching the given subsctiptionid
2129 with published date greater than startdate
2133 sub countissuesfrom {
2134 my ( $subscriptionid, $startdate ) = @_;
2135 my $dbh = C4::Context->dbh;
2139 WHERE subscriptionid=?
2140 AND serial.publisheddate>?
2142 my $sth = $dbh->prepare($query);
2143 $sth->execute( $subscriptionid, $startdate );
2144 my ($countreceived) = $sth->fetchrow;
2145 return $countreceived;
2150 $result = CountIssues($subscriptionid)
2152 Returns a count of serial rows matching the given subsctiptionid
2157 my ($subscriptionid) = @_;
2158 my $dbh = C4::Context->dbh;
2162 WHERE subscriptionid=?
2164 my $sth = $dbh->prepare($query);
2165 $sth->execute($subscriptionid);
2166 my ($countreceived) = $sth->fetchrow;
2167 return $countreceived;
2172 $result = HasItems($subscriptionid)
2174 returns a count of items from serial matching the subscriptionid
2179 my ($subscriptionid) = @_;
2180 my $dbh = C4::Context->dbh;
2182 SELECT COUNT(serialitems.itemnumber)
2184 LEFT JOIN serialitems USING(serialid)
2185 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2187 my $sth=$dbh->prepare($query);
2188 $sth->execute($subscriptionid);
2189 my ($countitems)=$sth->fetchrow_array();
2193 =head2 abouttoexpire
2195 $result = abouttoexpire($subscriptionid)
2197 this function alerts you to the penultimate issue for a serial subscription
2199 returns 1 - if this is the penultimate issue
2205 my ($subscriptionid) = @_;
2206 my $dbh = C4::Context->dbh;
2207 my $subscription = GetSubscription($subscriptionid);
2208 my $per = $subscription->{'periodicity'};
2209 if ($per && $per % 16 > 0){
2210 my $expirationdate = GetExpirationDate($subscriptionid);
2211 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2214 @res=split (/-/,$res);
2215 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2216 } else { # default an undefined value
2217 @res=Date::Calc::Today;
2219 my @endofsubscriptiondate=split(/-/,$expirationdate);
2220 my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 124, 0, 0);
2222 @datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2223 - (3 * $per_list[$per])) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2224 return 1 if ( @res &&
2226 Delta_Days($res[0],$res[1],$res[2],
2227 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2228 (@endofsubscriptiondate &&
2229 Delta_Days($res[0],$res[1],$res[2],
2230 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2232 } elsif ($subscription->{numberlength}>0) {
2233 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2238 sub in_array { # used in next sub down
2239 my ( $val, @elements ) = @_;
2240 foreach my $elem (@elements) {
2241 if ( $val == $elem ) {
2248 =head2 GetSubscriptionsFromBorrower
2250 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2252 this gets the info from subscriptionroutinglist for each $subscriptionid
2255 a count of the serial subscription routing lists to which a patron belongs,
2256 with the titles of those serial subscriptions as an array. Each element of the array
2257 contains a hash_ref with subscriptionID and title of subscription.
2261 sub GetSubscriptionsFromBorrower {
2262 my ($borrowernumber) = @_;
2263 my $dbh = C4::Context->dbh;
2264 my $sth = $dbh->prepare(
2265 "SELECT subscription.subscriptionid, biblio.title
2267 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2268 JOIN subscriptionroutinglist USING (subscriptionid)
2269 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2272 $sth->execute($borrowernumber);
2275 while ( my $line = $sth->fetchrow_hashref ) {
2277 push( @routinglist, $line );
2279 return ( $count, @routinglist );
2284 $resultdate = GetNextDate($planneddate,$subscription)
2286 this function it takes the planneddate and will return the next issue's date and will skip dates if there
2287 exists an irregularity
2288 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2289 skipped then the returned date will be 2007-05-10
2292 $resultdate - then next date in the sequence
2294 Return 0 if periodicity==0
2299 my ( $planneddate, $subscription ) = @_;
2300 my @irreg = split( /\,/, $subscription->{irregularity} );
2302 #date supposed to be in ISO.
2304 my ( $year, $month, $day ) = split( /-/, $planneddate );
2305 $month = 1 unless ($month);
2306 $day = 1 unless ($day);
2309 # warn "DOW $dayofweek";
2310 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2315 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2316 # renaming this pattern from 1/day to " n / week ".
2317 if ( $subscription->{periodicity} == 1 ) {
2318 my $dayofweek = eval { Day_of_Week( $year, $month, $day ) };
2319 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2321 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2322 $dayofweek = 0 if ( $dayofweek == 7 );
2323 if ( in_array( ( $dayofweek + 1 ), @irreg ) ) {
2324 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 );
2328 @resultdate = Add_Delta_Days( $year, $month, $day, 1 );
2333 if ( $subscription->{periodicity} == 2 ) {
2334 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2335 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2337 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2339 #FIXME: if two consecutive irreg, do we only skip one?
2340 if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) {
2341 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 );
2342 $wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 );
2345 @resultdate = Add_Delta_Days( $year, $month, $day, 7 );
2350 if ( $subscription->{periodicity} == 3 ) {
2351 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2352 if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; }
2354 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2355 if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) {
2356 ### BUGFIX was previously +1 ^
2357 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 );
2358 $wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 );
2361 @resultdate = Add_Delta_Days( $year, $month, $day, 14 );
2366 if ( $subscription->{periodicity} == 4 ) {
2367 my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) };
2368 if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; }
2370 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2371 if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) {
2372 ( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 );
2373 $wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 );
2376 @resultdate = Add_Delta_Days( $year, $month, $day, 21 );
2379 my $tmpmonth = $month;
2380 if ( $year && $month && $day ) {
2381 if ( $subscription->{periodicity} == 5 ) {
2382 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2383 if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) {
2384 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2385 $tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 );
2388 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 );
2390 if ( $subscription->{periodicity} == 6 ) {
2391 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2392 if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) {
2393 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2394 $tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 );
2397 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 );
2399 if ( $subscription->{periodicity} == 7 ) {
2400 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2401 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2402 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2403 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2406 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2408 if ( $subscription->{periodicity} == 8 ) {
2409 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2410 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2411 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2412 $tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 );
2415 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 );
2417 if ( $subscription->{periodicity} == 13 ) {
2418 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2419 if ( $irreg[$i] == ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 ) ) {
2420 ( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2421 $tmpmonth = ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 );
2424 @resultdate = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 );
2426 if ( $subscription->{periodicity} == 9 ) {
2427 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2428 if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) {
2429 ### BUFIX Seems to need more Than One ?
2430 ( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 );
2431 $tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 );
2434 @resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 );
2436 if ( $subscription->{periodicity} == 10 ) {
2437 @resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 );
2439 if ( $subscription->{periodicity} == 11 ) {
2440 @resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 );
2443 my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] );
2445 return "$resultdate";
2448 =head2 is_barcode_in_use
2450 Returns number of occurence of the barcode in the items table
2451 Can be used as a boolean test of whether the barcode has
2452 been deployed as yet
2456 sub is_barcode_in_use {
2457 my $barcode = shift;
2458 my $dbh = C4::Context->dbh;
2459 my $occurences = $dbh->selectall_arrayref(
2460 'SELECT itemnumber from items where barcode = ?',
2465 return @{$occurences};
2473 Koha Development Team <http://koha-community.org/>