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
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 use C4::Auth qw(haspermission);
25 use C4::Dates qw(format_date format_date_in_iso);
27 use Date::Calc qw(:all);
28 use POSIX qw(strftime);
30 use C4::Log; # logaction
32 use C4::Serials::Frequency;
33 use C4::Serials::Numberpattern;
35 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
43 MISSING_NEVER_RECIEVED => 41,
44 MISSING_SOLD_OUT => 42,
45 MISSING_DAMAGED => 43,
53 use constant MISSING_STATUSES => (
54 MISSING, MISSING_NEVER_RECIEVED,
55 MISSING_SOLD_OUT, MISSING_DAMAGED,
60 $VERSION = 3.07.00.049; # set version for version checking
64 &NewSubscription &ModSubscription &DelSubscription
65 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
67 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
68 &HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
69 &GetSubscriptionHistoryFromSubscriptionId
71 &GetNextSeq &GetSeq &NewIssue &ItemizeSerials &GetSerials
72 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
73 &ReNewSubscription &GetLateOrMissingIssues
74 &GetSerialInformation &AddItem2Serial
75 &PrepareSerialsData &GetNextExpected &ModNextExpected
77 &UpdateClaimdateIssues
78 &GetSuppliersWithLateIssues &getsupplierbyserialid
79 &GetDistributedTo &SetDistributedTo
80 &getroutinglist &delroutingmember &addroutingmember
82 &check_routing &updateClaim &removeMissingIssue
85 &GetSubscriptionsFromBorrower
86 &subscriptionCurrentlyOnOrder
93 C4::Serials - Serials Module Functions
101 Functions for handling subscriptions, claims routing etc.
106 =head2 GetSuppliersWithLateIssues
108 $supplierlist = GetSuppliersWithLateIssues()
110 this function get all suppliers with late issues.
113 an array_ref of suppliers each entry is a hash_ref containing id and name
114 the array is in name order
118 sub GetSuppliersWithLateIssues {
119 my $dbh = C4::Context->dbh;
120 my $statuses = join(',', ( LATE, MISSING_STATUSES, CLAIMED ) );
122 SELECT DISTINCT id, name
124 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
125 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
128 (planneddate < now() AND serial.status=1)
129 OR serial.STATUS IN ( $statuses )
131 AND subscription.closed = 0
133 return $dbh->selectall_arrayref($query, { Slice => {} });
136 =head2 GetSubscriptionHistoryFromSubscriptionId
138 $history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid);
140 This function returns the subscription history as a hashref
144 sub GetSubscriptionHistoryFromSubscriptionId {
145 my ($subscriptionid) = @_;
147 return unless $subscriptionid;
149 my $dbh = C4::Context->dbh;
152 FROM subscriptionhistory
153 WHERE subscriptionid = ?
155 my $sth = $dbh->prepare($query);
156 $sth->execute($subscriptionid);
157 my $results = $sth->fetchrow_hashref;
163 =head2 GetSerialStatusFromSerialId
165 $sth = GetSerialStatusFromSerialId();
166 this function returns a statement handle
167 After this function, don't forget to execute it by using $sth->execute($serialid)
169 $sth = $dbh->prepare($query).
173 sub GetSerialStatusFromSerialId {
174 my $dbh = C4::Context->dbh;
180 return $dbh->prepare($query);
183 =head2 GetSerialInformation
186 $data = GetSerialInformation($serialid);
187 returns a hash_ref containing :
188 items : items marcrecord (can be an array)
190 subscription table field
191 + information about subscription expiration
195 sub GetSerialInformation {
197 my $dbh = C4::Context->dbh;
199 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid
200 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
203 my $rq = $dbh->prepare($query);
204 $rq->execute($serialid);
205 my $data = $rq->fetchrow_hashref;
207 # create item information if we have serialsadditems for this subscription
208 if ( $data->{'serialsadditems'} ) {
209 my $queryitem = $dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
210 $queryitem->execute($serialid);
211 my $itemnumbers = $queryitem->fetchall_arrayref( [0] );
213 if ( scalar(@$itemnumbers) > 0 ) {
214 foreach my $itemnum (@$itemnumbers) {
216 #It is ASSUMED that GetMarcItem ALWAYS WORK...
217 #Maybe GetMarcItem should return values on failure
218 $debug and warn "itemnumber :$itemnum->[0], bibnum :" . $data->{'biblionumber'};
219 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0], $data );
220 $itemprocessed->{'itemnumber'} = $itemnum->[0];
221 $itemprocessed->{'itemid'} = $itemnum->[0];
222 $itemprocessed->{'serialid'} = $serialid;
223 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
224 push @{ $data->{'items'} }, $itemprocessed;
227 my $itemprocessed = C4::Items::PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
228 $itemprocessed->{'itemid'} = "N$serialid";
229 $itemprocessed->{'serialid'} = $serialid;
230 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
231 $itemprocessed->{'countitems'} = 0;
232 push @{ $data->{'items'} }, $itemprocessed;
235 $data->{ "status" . $data->{'serstatus'} } = 1;
236 $data->{'subscriptionexpired'} = HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'} == 1;
237 $data->{'abouttoexpire'} = abouttoexpire( $data->{'subscriptionid'} );
238 $data->{cannotedit} = not can_edit_subscription( $data );
242 =head2 AddItem2Serial
244 $rows = AddItem2Serial($serialid,$itemnumber);
245 Adds an itemnumber to Serial record
246 returns the number of rows affected
251 my ( $serialid, $itemnumber ) = @_;
253 return unless ($serialid and $itemnumber);
255 my $dbh = C4::Context->dbh;
256 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
257 $rq->execute( $serialid, $itemnumber );
261 =head2 UpdateClaimdateIssues
263 UpdateClaimdateIssues($serialids,[$date]);
265 Update Claimdate for issues in @$serialids list with date $date
270 sub UpdateClaimdateIssues {
271 my ( $serialids, $date ) = @_;
273 return unless ($serialids);
275 my $dbh = C4::Context->dbh;
276 $date = strftime( "%Y-%m-%d", localtime ) unless ($date);
281 claims_count = claims_count + 1
282 WHERE serialid in (" . join( ",", map { '?' } @$serialids ) . ")
284 my $rq = $dbh->prepare($query);
285 $rq->execute($date, CLAIMED, @$serialids);
289 =head2 GetSubscription
291 $subs = GetSubscription($subscriptionid)
292 this function returns the subscription which has $subscriptionid as id.
294 a hashref. This hash containts
295 subscription, subscriptionhistory, aqbooksellers.name, biblio.title
299 sub GetSubscription {
300 my ($subscriptionid) = @_;
301 my $dbh = C4::Context->dbh;
303 SELECT subscription.*,
304 subscriptionhistory.*,
305 aqbooksellers.name AS aqbooksellername,
306 biblio.title AS bibliotitle,
307 subscription.biblionumber as bibnum
309 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
310 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
311 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
312 WHERE subscription.subscriptionid = ?
315 $debug and warn "query : $query\nsubsid :$subscriptionid";
316 my $sth = $dbh->prepare($query);
317 $sth->execute($subscriptionid);
318 my $subscription = $sth->fetchrow_hashref;
319 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
320 return $subscription;
323 =head2 GetFullSubscription
325 $array_ref = GetFullSubscription($subscriptionid)
326 this function reads the serial table.
330 sub GetFullSubscription {
331 my ($subscriptionid) = @_;
333 return unless ($subscriptionid);
335 my $dbh = C4::Context->dbh;
337 SELECT serial.serialid,
340 serial.publisheddate,
342 serial.notes as notes,
343 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
344 aqbooksellers.name as aqbooksellername,
345 biblio.title as bibliotitle,
346 subscription.branchcode AS branchcode,
347 subscription.subscriptionid AS subscriptionid
349 LEFT JOIN subscription ON
350 (serial.subscriptionid=subscription.subscriptionid )
351 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
352 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
353 WHERE serial.subscriptionid = ?
355 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
356 serial.subscriptionid
358 $debug and warn "GetFullSubscription query: $query";
359 my $sth = $dbh->prepare($query);
360 $sth->execute($subscriptionid);
361 my $subscriptions = $sth->fetchall_arrayref( {} );
362 for my $subscription ( @$subscriptions ) {
363 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
365 return $subscriptions;
368 =head2 PrepareSerialsData
370 $array_ref = PrepareSerialsData($serialinfomation)
371 where serialinformation is a hashref array
375 sub PrepareSerialsData {
378 return unless ($lines);
384 my $aqbooksellername;
388 my $previousnote = "";
390 foreach my $subs (@{$lines}) {
391 for my $datefield ( qw(publisheddate planneddate) ) {
392 # handle 0000-00-00 dates
393 if (defined $subs->{$datefield} and $subs->{$datefield} =~ m/^00/) {
394 $subs->{$datefield} = undef;
397 $subs->{ "status" . $subs->{'status'} } = 1;
398 if ( grep { $_ == $subs->{status} } ( EXPECTED, LATE, MISSING_STATUSES, CLAIMED ) ) {
399 $subs->{"checked"} = 1;
402 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
403 $year = $subs->{'year'};
407 if ( $tmpresults{$year} ) {
408 push @{ $tmpresults{$year}->{'serials'} }, $subs;
410 $tmpresults{$year} = {
412 'aqbooksellername' => $subs->{'aqbooksellername'},
413 'bibliotitle' => $subs->{'bibliotitle'},
414 'serials' => [$subs],
419 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
420 push @res, $tmpresults{$key};
425 =head2 GetSubscriptionsFromBiblionumber
427 $array_ref = GetSubscriptionsFromBiblionumber($biblionumber)
428 this function get the subscription list. it reads the subscription table.
430 reference to an array of subscriptions which have the biblionumber given on input arg.
431 each element of this array is a hashref containing
432 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
436 sub GetSubscriptionsFromBiblionumber {
437 my ($biblionumber) = @_;
439 return unless ($biblionumber);
441 my $dbh = C4::Context->dbh;
443 SELECT subscription.*,
445 subscriptionhistory.*,
446 aqbooksellers.name AS aqbooksellername,
447 biblio.title AS bibliotitle
449 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
450 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
451 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
452 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
453 WHERE subscription.biblionumber = ?
455 my $sth = $dbh->prepare($query);
456 $sth->execute($biblionumber);
458 while ( my $subs = $sth->fetchrow_hashref ) {
459 $subs->{startdate} = format_date( $subs->{startdate} );
460 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
461 $subs->{histenddate} = format_date( $subs->{histenddate} );
462 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
463 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
464 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
465 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
466 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
467 $subs->{ "status" . $subs->{'status'} } = 1;
469 if ( $subs->{enddate} eq '0000-00-00' ) {
470 $subs->{enddate} = '';
472 $subs->{enddate} = format_date( $subs->{enddate} );
474 $subs->{'abouttoexpire'} = abouttoexpire( $subs->{'subscriptionid'} );
475 $subs->{'subscriptionexpired'} = HasSubscriptionExpired( $subs->{'subscriptionid'} );
476 $subs->{cannotedit} = not can_edit_subscription( $subs );
482 =head2 GetFullSubscriptionsFromBiblionumber
484 $array_ref = GetFullSubscriptionsFromBiblionumber($biblionumber)
485 this function reads the serial table.
489 sub GetFullSubscriptionsFromBiblionumber {
490 my ($biblionumber) = @_;
491 my $dbh = C4::Context->dbh;
493 SELECT serial.serialid,
496 serial.publisheddate,
498 serial.notes as notes,
499 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
500 biblio.title as bibliotitle,
501 subscription.branchcode AS branchcode,
502 subscription.subscriptionid AS subscriptionid
504 LEFT JOIN subscription ON
505 (serial.subscriptionid=subscription.subscriptionid)
506 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
507 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
508 WHERE subscription.biblionumber = ?
510 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
511 serial.subscriptionid
513 my $sth = $dbh->prepare($query);
514 $sth->execute($biblionumber);
515 my $subscriptions = $sth->fetchall_arrayref( {} );
516 for my $subscription ( @$subscriptions ) {
517 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
519 return $subscriptions;
522 =head2 SearchSubscriptions
524 @results = SearchSubscriptions($args);
526 This function returns a list of hashrefs, one for each subscription
527 that meets the conditions specified by the $args hashref.
529 The valid search fields are:
543 The expiration_date search field is special; it specifies the maximum
544 subscription expiration date.
548 sub SearchSubscriptions {
553 subscription.notes AS publicnotes,
554 subscriptionhistory.*,
556 biblio.notes AS biblionotes,
562 LEFT JOIN subscriptionhistory USING(subscriptionid)
563 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
564 LEFT JOIN biblioitems ON biblioitems.biblionumber = subscription.biblionumber
565 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
569 if( $args->{biblionumber} ) {
570 push @where_strs, "biblio.biblionumber = ?";
571 push @where_args, $args->{biblionumber};
573 if( $args->{title} ){
574 my @words = split / /, $args->{title};
576 foreach my $word (@words) {
577 push @strs, "biblio.title LIKE ?";
578 push @args, "%$word%";
581 push @where_strs, '(' . join (' AND ', @strs) . ')';
582 push @where_args, @args;
586 push @where_strs, "biblioitems.issn LIKE ?";
587 push @where_args, "%$args->{issn}%";
590 push @where_strs, "biblioitems.ean LIKE ?";
591 push @where_args, "%$args->{ean}%";
593 if ( $args->{callnumber} ) {
594 push @where_strs, "subscription.callnumber LIKE ?";
595 push @where_args, "%$args->{callnumber}%";
597 if( $args->{publisher} ){
598 push @where_strs, "biblioitems.publishercode LIKE ?";
599 push @where_args, "%$args->{publisher}%";
601 if( $args->{bookseller} ){
602 push @where_strs, "aqbooksellers.name LIKE ?";
603 push @where_args, "%$args->{bookseller}%";
605 if( $args->{branch} ){
606 push @where_strs, "subscription.branchcode = ?";
607 push @where_args, "$args->{branch}";
609 if ( $args->{location} ) {
610 push @where_strs, "subscription.location = ?";
611 push @where_args, "$args->{location}";
613 if ( $args->{expiration_date} ) {
614 push @where_strs, "subscription.enddate <= ?";
615 push @where_args, "$args->{expiration_date}";
617 if( defined $args->{closed} ){
618 push @where_strs, "subscription.closed = ?";
619 push @where_args, "$args->{closed}";
622 $query .= " WHERE " . join(" AND ", @where_strs);
625 $query .= " ORDER BY " . $args->{orderby} if $args->{orderby};
627 my $dbh = C4::Context->dbh;
628 my $sth = $dbh->prepare($query);
629 $sth->execute(@where_args);
630 my $results = $sth->fetchall_arrayref( {} );
633 for my $subscription ( @$results ) {
634 $subscription->{cannotedit} = not can_edit_subscription( $subscription );
635 $subscription->{cannotdisplay} = not can_show_subscription( $subscription );
644 ($totalissues,@serials) = GetSerials($subscriptionid);
645 this function gets every serial not arrived for a given subscription
646 as well as the number of issues registered in the database (all types)
647 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
649 FIXME: We should return \@serials.
654 my ( $subscriptionid, $count ) = @_;
656 return unless $subscriptionid;
658 my $dbh = C4::Context->dbh;
660 # status = 2 is "arrived"
662 $count = 5 unless ($count);
664 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES, NOT_ISSUED ) );
665 my $query = "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
667 WHERE subscriptionid = ? AND status NOT IN ( $statuses )
668 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
669 my $sth = $dbh->prepare($query);
670 $sth->execute($subscriptionid);
672 while ( my $line = $sth->fetchrow_hashref ) {
673 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
674 for my $datefield ( qw( planneddate publisheddate) ) {
675 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
676 $line->{$datefield} = format_date( $line->{$datefield});
678 $line->{$datefield} = q{};
681 push @serials, $line;
684 # OK, now add the last 5 issues arrives/missing
685 $query = "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
687 WHERE subscriptionid = ?
688 AND status IN ( $statuses )
689 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
691 $sth = $dbh->prepare($query);
692 $sth->execute($subscriptionid);
693 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
695 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
696 for my $datefield ( qw( planneddate publisheddate) ) {
697 if ($line->{$datefield} && $line->{$datefield}!~m/^00/) {
698 $line->{$datefield} = format_date( $line->{$datefield});
700 $line->{$datefield} = q{};
704 push @serials, $line;
707 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
708 $sth = $dbh->prepare($query);
709 $sth->execute($subscriptionid);
710 my ($totalissues) = $sth->fetchrow;
711 return ( $totalissues, @serials );
716 @serials = GetSerials2($subscriptionid,$statuses);
717 this function returns every serial waited for a given subscription
718 as well as the number of issues registered in the database (all types)
719 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
721 $statuses is an arrayref of statuses and is mandatory.
726 my ( $subscription, $statuses ) = @_;
728 return unless ($subscription and @$statuses);
730 my $statuses_string = join ',', @$statuses;
732 my $dbh = C4::Context->dbh;
734 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
736 WHERE subscriptionid=$subscription AND status IN ($statuses_string)
737 ORDER BY publisheddate,serialid DESC
739 $debug and warn "GetSerials2 query: $query";
740 my $sth = $dbh->prepare($query);
744 while ( my $line = $sth->fetchrow_hashref ) {
745 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
746 # Format dates for display
747 for my $datefield ( qw( planneddate publisheddate ) ) {
748 if (!defined($line->{$datefield}) || $line->{$datefield} =~m/^00/) {
749 $line->{$datefield} = q{};
752 $line->{$datefield} = format_date( $line->{$datefield} );
755 push @serials, $line;
760 =head2 GetLatestSerials
762 \@serials = GetLatestSerials($subscriptionid,$limit)
763 get the $limit's latest serials arrived or missing for a given subscription
765 a ref to an array which contains all of the latest serials stored into a hash.
769 sub GetLatestSerials {
770 my ( $subscriptionid, $limit ) = @_;
772 return unless ($subscriptionid and $limit);
774 my $dbh = C4::Context->dbh;
776 my $statuses = join( ',', ( ARRIVED, MISSING_STATUSES ) );
777 my $strsth = "SELECT serialid,serialseq, status, planneddate, publisheddate, notes
779 WHERE subscriptionid = ?
780 AND status IN ($statuses)
781 ORDER BY publisheddate DESC LIMIT 0,$limit
783 my $sth = $dbh->prepare($strsth);
784 $sth->execute($subscriptionid);
786 while ( my $line = $sth->fetchrow_hashref ) {
787 $line->{ "status" . $line->{status} } = 1; # fills a "statusX" value, used for template status select list
788 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
789 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
790 push @serials, $line;
796 =head2 GetDistributedTo
798 $distributedto=GetDistributedTo($subscriptionid)
799 This function returns the field distributedto for the subscription matching subscriptionid
803 sub GetDistributedTo {
804 my $dbh = C4::Context->dbh;
806 my ($subscriptionid) = @_;
808 return unless ($subscriptionid);
810 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
811 my $sth = $dbh->prepare($query);
812 $sth->execute($subscriptionid);
813 return ($distributedto) = $sth->fetchrow;
819 $nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
820 $newinnerloop1, $newinnerloop2, $newinnerloop3
821 ) = GetNextSeq( $subscription, $pattern, $planneddate );
823 $subscription is a hashref containing all the attributes of the table
825 $pattern is a hashref containing all the attributes of the table
826 'subscription_numberpatterns'.
827 $planneddate is a C4::Dates object.
828 This function get the next issue for the subscription given on input arg
833 my ($subscription, $pattern, $planneddate) = @_;
835 return unless ($subscription and $pattern);
837 my ( $newlastvalue1, $newlastvalue2, $newlastvalue3,
838 $newinnerloop1, $newinnerloop2, $newinnerloop3 );
841 if ($subscription->{'skip_serialseq'}) {
842 my @irreg = split /;/, $subscription->{'irregularity'};
844 my $irregularities = {};
845 $irregularities->{$_} = 1 foreach(@irreg);
846 my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1;
847 while($irregularities->{$issueno}) {
854 my $numberingmethod = $pattern->{numberingmethod};
856 if ($numberingmethod) {
857 $calculated = $numberingmethod;
858 my $locale = $subscription->{locale};
859 $newlastvalue1 = $subscription->{lastvalue1} || 0;
860 $newlastvalue2 = $subscription->{lastvalue2} || 0;
861 $newlastvalue3 = $subscription->{lastvalue3} || 0;
862 $newinnerloop1 = $subscription->{innerloop1} || 0;
863 $newinnerloop2 = $subscription->{innerloop2} || 0;
864 $newinnerloop3 = $subscription->{innerloop3} || 0;
867 $calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/);
870 for(my $i = 0; $i < $count; $i++) {
872 # check if we have to increase the new value.
874 if ($newinnerloop1 >= $pattern->{every1}) {
876 $newlastvalue1 += $pattern->{add1};
878 # reset counter if needed.
879 $newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1});
882 # check if we have to increase the new value.
884 if ($newinnerloop2 >= $pattern->{every2}) {
886 $newlastvalue2 += $pattern->{add2};
888 # reset counter if needed.
889 $newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2});
892 # check if we have to increase the new value.
894 if ($newinnerloop3 >= $pattern->{every3}) {
896 $newlastvalue3 += $pattern->{add3};
898 # reset counter if needed.
899 $newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3});
903 my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale );
904 $calculated =~ s/\{X\}/$newlastvalue1string/g;
907 my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale );
908 $calculated =~ s/\{Y\}/$newlastvalue2string/g;
911 my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale );
912 $calculated =~ s/\{Z\}/$newlastvalue3string/g;
917 $newlastvalue1, $newlastvalue2, $newlastvalue3,
918 $newinnerloop1, $newinnerloop2, $newinnerloop3);
923 $calculated = GetSeq($subscription, $pattern)
924 $subscription is a hashref containing all the attributes of the table 'subscription'
925 $pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns'
926 this function transforms {X},{Y},{Z} to 150,0,0 for example.
928 the sequence in string format
933 my ($subscription, $pattern) = @_;
935 return unless ($subscription and $pattern);
937 my $locale = $subscription->{locale};
939 my $calculated = $pattern->{numberingmethod};
941 my $newlastvalue1 = $subscription->{'lastvalue1'} || 0;
942 $newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed.
943 $calculated =~ s/\{X\}/$newlastvalue1/g;
945 my $newlastvalue2 = $subscription->{'lastvalue2'} || 0;
946 $newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed.
947 $calculated =~ s/\{Y\}/$newlastvalue2/g;
949 my $newlastvalue3 = $subscription->{'lastvalue3'} || 0;
950 $newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed.
951 $calculated =~ s/\{Z\}/$newlastvalue3/g;
955 =head2 GetExpirationDate
957 $enddate = GetExpirationDate($subscriptionid, [$startdate])
959 this function return the next expiration date for a subscription given on input args.
966 sub GetExpirationDate {
967 my ( $subscriptionid, $startdate ) = @_;
969 return unless ($subscriptionid);
971 my $dbh = C4::Context->dbh;
972 my $subscription = GetSubscription($subscriptionid);
975 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
976 $enddate = $startdate || $subscription->{startdate};
977 my @date = split( /-/, $enddate );
979 return if ( scalar(@date) != 3 || not check_date(@date) );
981 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
982 if ( $frequency and $frequency->{unit} ) {
985 if ( my $length = $subscription->{numberlength} ) {
987 #calculate the date of the last issue.
988 for ( my $i = 1 ; $i <= $length ; $i++ ) {
989 $enddate = GetNextDate( $subscription, $enddate );
991 } elsif ( $subscription->{monthlength} ) {
992 if ( $$subscription{startdate} ) {
993 my @enddate = Add_Delta_YM( $date[0], $date[1], $date[2], 0, $subscription->{monthlength} );
994 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
996 } elsif ( $subscription->{weeklength} ) {
997 if ( $$subscription{startdate} ) {
998 my @date = split( /-/, $subscription->{startdate} );
999 my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 );
1000 $enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] );
1003 $enddate = $subscription->{enddate};
1007 return $subscription->{enddate};
1011 =head2 CountSubscriptionFromBiblionumber
1013 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1014 this returns a count of the subscriptions for a given biblionumber
1016 the number of subscriptions
1020 sub CountSubscriptionFromBiblionumber {
1021 my ($biblionumber) = @_;
1023 return unless ($biblionumber);
1025 my $dbh = C4::Context->dbh;
1026 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1027 my $sth = $dbh->prepare($query);
1028 $sth->execute($biblionumber);
1029 my $subscriptionsnumber = $sth->fetchrow;
1030 return $subscriptionsnumber;
1033 =head2 ModSubscriptionHistory
1035 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1037 this function modifies the history of a subscription. Put your new values on input arg.
1038 returns the number of rows affected
1042 sub ModSubscriptionHistory {
1043 my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_;
1045 return unless ($subscriptionid);
1047 my $dbh = C4::Context->dbh;
1048 my $query = "UPDATE subscriptionhistory
1049 SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1050 WHERE subscriptionid=?
1052 my $sth = $dbh->prepare($query);
1053 $receivedlist =~ s/^; // if $receivedlist;
1054 $missinglist =~ s/^; // if $missinglist;
1055 $opacnote =~ s/^; // if $opacnote;
1056 $sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid );
1060 =head2 ModSerialStatus
1062 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1064 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1065 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1069 sub ModSerialStatus {
1070 my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_;
1072 return unless ($serialid);
1074 #It is a usual serial
1075 # 1st, get previous status :
1076 my $dbh = C4::Context->dbh;
1077 my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity
1078 FROM serial, subscription
1079 WHERE serial.subscriptionid=subscription.subscriptionid
1081 my $sth = $dbh->prepare($query);
1082 $sth->execute($serialid);
1083 my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow;
1084 my $frequency = GetSubscriptionFrequency($periodicity);
1086 # change status & update subscriptionhistory
1088 if ( $status == DELETED ) {
1089 DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } );
1092 my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?';
1093 $sth = $dbh->prepare($query);
1094 $sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid );
1095 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1096 $sth = $dbh->prepare($query);
1097 $sth->execute($subscriptionid);
1098 my $val = $sth->fetchrow_hashref;
1099 unless ( $val->{manualhistory} ) {
1100 $query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1101 $sth = $dbh->prepare($query);
1102 $sth->execute($subscriptionid);
1103 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1105 if ( $status == ARRIVED || ($oldstatus == ARRIVED && $status != ARRIVED) ) {
1106 $recievedlist .= "; $serialseq"
1107 if ($recievedlist !~ /(^|;)\s*$serialseq(?=;|$)/);
1110 # in case serial has been previously marked as missing
1111 if (grep /$status/, (EXPECTED, ARRIVED, LATE, CLAIMED)) {
1112 $missinglist=~ s/(^|;)\s*$serialseq(?=;|$)//g;
1115 $missinglist .= "; $serialseq"
1116 if ( ( grep { $_ == $status } ( MISSING_STATUSES ) ) && ( $missinglist !~/(^|;)\s*$serialseq(?=;|$)/ ) );
1117 $missinglist .= "; not issued $serialseq"
1118 if ( $status == NOT_ISSUED && $missinglist !~ /(^|;)\s*$serialseq(?=;|$)/ );
1120 $query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1121 $sth = $dbh->prepare($query);
1122 $recievedlist =~ s/^; //;
1123 $missinglist =~ s/^; //;
1124 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1128 # create new waited entry if needed (ie : was a "waited" and has changed)
1129 if ( $oldstatus == EXPECTED && $status != EXPECTED ) {
1130 my $subscription = GetSubscription($subscriptionid);
1131 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1135 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1136 $newinnerloop1, $newinnerloop2, $newinnerloop3
1138 = GetNextSeq( $subscription, $pattern, $publisheddate );
1140 # next date (calculated from actual date & frequency parameters)
1141 my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1);
1142 my $nextpubdate = $nextpublisheddate;
1143 NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate );
1144 $query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1145 WHERE subscriptionid = ?";
1146 $sth = $dbh->prepare($query);
1147 $sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid );
1149 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1150 if ( $subscription->{letter} && $status == ARRIVED && $oldstatus != ARRIVED ) {
1151 require C4::Letters;
1152 C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} );
1159 =head2 GetNextExpected
1161 $nextexpected = GetNextExpected($subscriptionid)
1163 Get the planneddate for the current expected issue of the subscription.
1169 planneddate => ISO date
1174 sub GetNextExpected {
1175 my ($subscriptionid) = @_;
1177 my $dbh = C4::Context->dbh;
1181 WHERE subscriptionid = ?
1185 my $sth = $dbh->prepare($query);
1187 # Each subscription has only one 'expected' issue.
1188 $sth->execute( $subscriptionid, EXPECTED );
1189 my $nextissue = $sth->fetchrow_hashref;
1190 if ( !$nextissue ) {
1194 WHERE subscriptionid = ?
1195 ORDER BY publisheddate DESC
1198 $sth = $dbh->prepare($query);
1199 $sth->execute($subscriptionid);
1200 $nextissue = $sth->fetchrow_hashref;
1202 foreach(qw/planneddate publisheddate/) {
1203 if ( !defined $nextissue->{$_} ) {
1204 # or should this default to 1st Jan ???
1205 $nextissue->{$_} = strftime( '%Y-%m-%d', localtime );
1207 $nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00')
1215 =head2 ModNextExpected
1217 ModNextExpected($subscriptionid,$date)
1219 Update the planneddate for the current expected issue of the subscription.
1220 This will modify all future prediction results.
1222 C<$date> is an ISO date.
1228 sub ModNextExpected {
1229 my ( $subscriptionid, $date ) = @_;
1230 my $dbh = C4::Context->dbh;
1232 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1233 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1235 # Each subscription has only one 'expected' issue.
1236 $sth->execute( $date, $date, $subscriptionid, EXPECTED );
1241 =head2 GetSubscriptionIrregularities
1245 =item @irreg = &GetSubscriptionIrregularities($subscriptionid);
1246 get the list of irregularities for a subscription
1252 sub GetSubscriptionIrregularities {
1253 my $subscriptionid = shift;
1255 return unless $subscriptionid;
1257 my $dbh = C4::Context->dbh;
1261 WHERE subscriptionid = ?
1263 my $sth = $dbh->prepare($query);
1264 $sth->execute($subscriptionid);
1266 my ($result) = $sth->fetchrow_array;
1267 my @irreg = split /;/, $result;
1272 =head2 ModSubscription
1274 this function modifies a subscription. Put all new values on input args.
1275 returns the number of rows affected
1279 sub ModSubscription {
1281 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate,
1282 $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale,
1283 $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1,
1284 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status,
1285 $biblionumber, $callnumber, $notes, $letter, $manualhistory,
1286 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1287 $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq
1290 my $dbh = C4::Context->dbh;
1291 my $query = "UPDATE subscription
1292 SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?,
1293 startdate=?, periodicity=?, firstacquidate=?, irregularity=?,
1294 numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?,
1295 lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?,
1296 lastvalue3=?, innerloop3=?, status=?, biblionumber=?,
1297 callnumber=?, notes=?, letter=?, manualhistory=?,
1298 internalnotes=?, serialsadditems=?, staffdisplaycount=?,
1299 opacdisplaycount=?, graceperiod=?, location = ?, enddate=?,
1301 WHERE subscriptionid = ?";
1303 my $sth = $dbh->prepare($query);
1305 $auser, $branchcode, $aqbooksellerid, $cost,
1306 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1307 $irregularity, $numberpattern, $locale, $numberlength,
1308 $weeklength, $monthlength, $lastvalue1, $innerloop1,
1309 $lastvalue2, $innerloop2, $lastvalue3, $innerloop3,
1310 $status, $biblionumber, $callnumber, $notes,
1311 $letter, ($manualhistory ? $manualhistory : 0),
1312 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1313 $graceperiod, $location, $enddate, $skip_serialseq,
1316 my $rows = $sth->rows;
1318 logaction( "SERIAL", "MODIFY", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1322 =head2 NewSubscription
1324 $subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1325 $startdate,$periodicity,$numberlength,$weeklength,$monthlength,
1326 $lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3,
1327 $status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern,
1328 $locale, $callnumber, $manualhistory, $internalnotes, $serialsadditems,
1329 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq);
1331 Create a new subscription with value given on input args.
1334 the id of this new subscription
1338 sub NewSubscription {
1340 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1341 $startdate, $periodicity, $numberlength, $weeklength, $monthlength,
1342 $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3,
1343 $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity,
1344 $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes,
1345 $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod,
1346 $location, $enddate, $skip_serialseq
1348 my $dbh = C4::Context->dbh;
1350 #save subscription (insert into database)
1352 INSERT INTO subscription
1353 (librarian, branchcode, aqbooksellerid, cost, aqbudgetid,
1354 biblionumber, startdate, periodicity, numberlength, weeklength,
1355 monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2,
1356 lastvalue3, innerloop3, status, notes, letter, firstacquidate,
1357 irregularity, numberpattern, locale, callnumber,
1358 manualhistory, internalnotes, serialsadditems, staffdisplaycount,
1359 opacdisplaycount, graceperiod, location, enddate, skip_serialseq)
1360 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1362 my $sth = $dbh->prepare($query);
1364 $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber,
1365 $startdate, $periodicity, $numberlength, $weeklength,
1366 $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2,
1367 $lastvalue3, $innerloop3, $status, $notes, $letter,
1368 $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber,
1369 $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount,
1370 $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq
1373 my $subscriptionid = $dbh->{'mysql_insertid'};
1375 $enddate = GetExpirationDate( $subscriptionid, $startdate );
1379 WHERE subscriptionid=?
1381 $sth = $dbh->prepare($query);
1382 $sth->execute( $enddate, $subscriptionid );
1385 # then create the 1st expected number
1387 INSERT INTO subscriptionhistory
1388 (biblionumber, subscriptionid, histstartdate)
1391 $sth = $dbh->prepare($query);
1392 $sth->execute( $biblionumber, $subscriptionid, $startdate);
1394 # reread subscription to get a hash (for calculation of the 1st issue number)
1395 my $subscription = GetSubscription($subscriptionid);
1396 my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern});
1398 # calculate issue number
1399 my $serialseq = GetSeq($subscription, $pattern) || q{};
1402 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1403 VALUES (?,?,?,?,?,?)
1405 $sth = $dbh->prepare($query);
1406 $sth->execute( $serialseq, $subscriptionid, $biblionumber, EXPECTED, $firstacquidate, $firstacquidate );
1408 logaction( "SERIAL", "ADD", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1410 #set serial flag on biblio if not already set.
1411 my $bib = GetBiblio($biblionumber);
1412 if ( $bib and !$bib->{'serial'} ) {
1413 my $record = GetMarcBiblio($biblionumber);
1414 my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} );
1416 eval { $record->field($tag)->update( $subf => 1 ); };
1418 ModBiblio( $record, $biblionumber, $bib->{'frameworkcode'} );
1420 return $subscriptionid;
1423 =head2 ReNewSubscription
1425 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1427 this function renew a subscription with values given on input args.
1431 sub ReNewSubscription {
1432 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength, $monthlength, $note ) = @_;
1433 my $dbh = C4::Context->dbh;
1434 my $subscription = GetSubscription($subscriptionid);
1438 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1439 WHERE biblio.biblionumber=?
1441 my $sth = $dbh->prepare($query);
1442 $sth->execute( $subscription->{biblionumber} );
1443 my $biblio = $sth->fetchrow_hashref;
1445 if ( C4::Context->preference("RenewSerialAddsSuggestion") ) {
1446 require C4::Suggestions;
1447 C4::Suggestions::NewSuggestion(
1448 { 'suggestedby' => $user,
1449 'title' => $subscription->{bibliotitle},
1450 'author' => $biblio->{author},
1451 'publishercode' => $biblio->{publishercode},
1452 'note' => $biblio->{note},
1453 'biblionumber' => $subscription->{biblionumber}
1458 # renew subscription
1461 SET startdate=?,numberlength=?,weeklength=?,monthlength=?,reneweddate=NOW()
1462 WHERE subscriptionid=?
1464 $sth = $dbh->prepare($query);
1465 $sth->execute( $startdate, $numberlength, $weeklength, $monthlength, $subscriptionid );
1466 my $enddate = GetExpirationDate($subscriptionid);
1467 $debug && warn "enddate :$enddate";
1471 WHERE subscriptionid=?
1473 $sth = $dbh->prepare($query);
1474 $sth->execute( $enddate, $subscriptionid );
1476 UPDATE subscriptionhistory
1478 WHERE subscriptionid=?
1480 $sth = $dbh->prepare($query);
1481 $sth->execute( $enddate, $subscriptionid );
1483 logaction( "SERIAL", "RENEW", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1489 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1491 Create a new issue stored on the database.
1492 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1493 returns the serial id
1498 my ( $serialseq, $subscriptionid, $biblionumber, $status, $planneddate, $publisheddate, $notes ) = @_;
1499 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1501 return unless ($subscriptionid);
1503 my $dbh = C4::Context->dbh;
1506 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1507 VALUES (?,?,?,?,?,?,?)
1509 my $sth = $dbh->prepare($query);
1510 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status, $publisheddate, $planneddate, $notes );
1511 my $serialid = $dbh->{'mysql_insertid'};
1513 SELECT missinglist,recievedlist
1514 FROM subscriptionhistory
1515 WHERE subscriptionid=?
1517 $sth = $dbh->prepare($query);
1518 $sth->execute($subscriptionid);
1519 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1521 if ( $status == ARRIVED ) {
1522 ### TODO Add a feature that improves recognition and description.
1523 ### As such count (serialseq) i.e. : N18,2(N19),N20
1524 ### Would use substr and index But be careful to previous presence of ()
1525 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1527 if ( grep {/^$status$/} ( MISSING_STATUSES ) ) {
1528 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1531 UPDATE subscriptionhistory
1532 SET recievedlist=?, missinglist=?
1533 WHERE subscriptionid=?
1535 $sth = $dbh->prepare($query);
1536 $recievedlist =~ s/^; //;
1537 $missinglist =~ s/^; //;
1538 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1542 =head2 ItemizeSerials
1544 ItemizeSerials($serialid, $info);
1545 $info is a hashref containing barcode branch, itemcallnumber, status, location
1546 $serialid the serialid
1548 1 if the itemize is a succes.
1549 0 and @error otherwise. @error containts the list of errors found.
1553 sub ItemizeSerials {
1554 my ( $serialid, $info ) = @_;
1556 return unless ($serialid);
1558 my $now = POSIX::strftime( "%Y-%m-%d", localtime );
1560 my $dbh = C4::Context->dbh;
1566 my $sth = $dbh->prepare($query);
1567 $sth->execute($serialid);
1568 my $data = $sth->fetchrow_hashref;
1569 if ( C4::Context->preference("RoutingSerials") ) {
1571 # check for existing biblioitem relating to serial issue
1572 my ( $count, @results ) = GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1574 for ( my $i = 0 ; $i < $count ; $i++ ) {
1575 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' (' . $data->{'planneddate'} . ')' ) {
1576 $bibitemno = $results[$i]->{'biblioitemnumber'};
1580 if ( $bibitemno == 0 ) {
1581 my $sth = $dbh->prepare( "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC" );
1582 $sth->execute( $data->{'biblionumber'} );
1583 my $biblioitem = $sth->fetchrow_hashref;
1584 $biblioitem->{'volumedate'} = $data->{planneddate};
1585 $biblioitem->{'volumeddesc'} = $data->{serialseq} . ' (' . format_date( $data->{'planneddate'} ) . ')';
1586 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1590 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1591 if ( $info->{barcode} ) {
1593 if ( is_barcode_in_use( $info->{barcode} ) ) {
1594 push @errors, 'barcode_not_unique';
1596 my $marcrecord = MARC::Record->new();
1597 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.barcode", $fwk );
1598 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{barcode} );
1599 $marcrecord->insert_fields_ordered($newField);
1600 if ( $info->{branch} ) {
1601 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.homebranch", $fwk );
1603 #warn "items.homebranch : $tag , $subfield";
1604 if ( $marcrecord->field($tag) ) {
1605 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1607 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1608 $marcrecord->insert_fields_ordered($newField);
1610 ( $tag, $subfield ) = GetMarcFromKohaField( "items.holdingbranch", $fwk );
1612 #warn "items.holdingbranch : $tag , $subfield";
1613 if ( $marcrecord->field($tag) ) {
1614 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{branch} );
1616 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{branch} );
1617 $marcrecord->insert_fields_ordered($newField);
1620 if ( $info->{itemcallnumber} ) {
1621 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemcallnumber", $fwk );
1623 if ( $marcrecord->field($tag) ) {
1624 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{itemcallnumber} );
1626 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{itemcallnumber} );
1627 $marcrecord->insert_fields_ordered($newField);
1630 if ( $info->{notes} ) {
1631 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.itemnotes", $fwk );
1633 if ( $marcrecord->field($tag) ) {
1634 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{notes} );
1636 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{notes} );
1637 $marcrecord->insert_fields_ordered($newField);
1640 if ( $info->{location} ) {
1641 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.location", $fwk );
1643 if ( $marcrecord->field($tag) ) {
1644 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{location} );
1646 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{location} );
1647 $marcrecord->insert_fields_ordered($newField);
1650 if ( $info->{status} ) {
1651 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.notforloan", $fwk );
1653 if ( $marcrecord->field($tag) ) {
1654 $marcrecord->field($tag)->add_subfields( "$subfield" => $info->{status} );
1656 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $info->{status} );
1657 $marcrecord->insert_fields_ordered($newField);
1660 if ( C4::Context->preference("RoutingSerials") ) {
1661 my ( $tag, $subfield ) = GetMarcFromKohaField( "items.dateaccessioned", $fwk );
1662 if ( $marcrecord->field($tag) ) {
1663 $marcrecord->field($tag)->add_subfields( "$subfield" => $now );
1665 my $newField = MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1666 $marcrecord->insert_fields_ordered($newField);
1670 C4::Items::AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1673 return ( 0, @errors );
1677 =head2 HasSubscriptionStrictlyExpired
1679 1 or 0 = HasSubscriptionStrictlyExpired($subscriptionid)
1681 the subscription has stricly expired when today > the end subscription date
1684 1 if true, 0 if false, -1 if the expiration date is not set.
1688 sub HasSubscriptionStrictlyExpired {
1690 # Getting end of subscription date
1691 my ($subscriptionid) = @_;
1693 return unless ($subscriptionid);
1695 my $dbh = C4::Context->dbh;
1696 my $subscription = GetSubscription($subscriptionid);
1697 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1699 # If the expiration date is set
1700 if ( $expirationdate != 0 ) {
1701 my ( $endyear, $endmonth, $endday ) = split( '-', $expirationdate );
1703 # Getting today's date
1704 my ( $nowyear, $nowmonth, $nowday ) = Today();
1706 # if today's date > expiration date, then the subscription has stricly expired
1707 if ( Delta_Days( $nowyear, $nowmonth, $nowday, $endyear, $endmonth, $endday ) < 0 ) {
1714 # There are some cases where the expiration date is not set
1715 # As we can't determine if the subscription has expired on a date-basis,
1721 =head2 HasSubscriptionExpired
1723 $has_expired = HasSubscriptionExpired($subscriptionid)
1725 the subscription has expired when the next issue to arrive is out of subscription limit.
1728 0 if the subscription has not expired
1729 1 if the subscription has expired
1730 2 if has subscription does not have a valid expiration date set
1734 sub HasSubscriptionExpired {
1735 my ($subscriptionid) = @_;
1737 return unless ($subscriptionid);
1739 my $dbh = C4::Context->dbh;
1740 my $subscription = GetSubscription($subscriptionid);
1741 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity});
1742 if ( $frequency and $frequency->{unit} ) {
1743 my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid);
1744 if (!defined $expirationdate) {
1745 $expirationdate = q{};
1748 SELECT max(planneddate)
1750 WHERE subscriptionid=?
1752 my $sth = $dbh->prepare($query);
1753 $sth->execute($subscriptionid);
1754 my ($res) = $sth->fetchrow;
1755 if (!$res || $res=~m/^0000/) {
1758 my @res = split( /-/, $res );
1759 my @endofsubscriptiondate = split( /-/, $expirationdate );
1760 return 2 if ( scalar(@res) != 3 || scalar(@endofsubscriptiondate) != 3 || not check_date(@res) || not check_date(@endofsubscriptiondate) );
1762 if ( ( @endofsubscriptiondate && Delta_Days( $res[0], $res[1], $res[2], $endofsubscriptiondate[0], $endofsubscriptiondate[1], $endofsubscriptiondate[2] ) <= 0 )
1767 if ( $subscription->{'numberlength'} ) {
1768 my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} );
1769 return 1 if ( $countreceived > $subscription->{'numberlength'} );
1775 return 0; # Notice that you'll never get here.
1778 =head2 SetDistributedto
1780 SetDistributedto($distributedto,$subscriptionid);
1781 This function update the value of distributedto for a subscription given on input arg.
1785 sub SetDistributedto {
1786 my ( $distributedto, $subscriptionid ) = @_;
1787 my $dbh = C4::Context->dbh;
1791 WHERE subscriptionid=?
1793 my $sth = $dbh->prepare($query);
1794 $sth->execute( $distributedto, $subscriptionid );
1798 =head2 DelSubscription
1800 DelSubscription($subscriptionid)
1801 this function deletes subscription which has $subscriptionid as id.
1805 sub DelSubscription {
1806 my ($subscriptionid) = @_;
1807 my $dbh = C4::Context->dbh;
1808 $subscriptionid = $dbh->quote($subscriptionid);
1809 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1810 $dbh->do("DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1811 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1813 logaction( "SERIAL", "DELETE", $subscriptionid, "" ) if C4::Context->preference("SubscriptionLog");
1818 DelIssue($serialseq,$subscriptionid)
1819 this function deletes an issue which has $serialseq and $subscriptionid given on input arg.
1821 returns the number of rows affected
1826 my ($dataissue) = @_;
1827 my $dbh = C4::Context->dbh;
1828 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1833 AND subscriptionid= ?
1835 my $mainsth = $dbh->prepare($query);
1836 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'} );
1838 #Delete element from subscription history
1839 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1840 my $sth = $dbh->prepare($query);
1841 $sth->execute( $dataissue->{'subscriptionid'} );
1842 my $val = $sth->fetchrow_hashref;
1843 unless ( $val->{manualhistory} ) {
1845 SELECT * FROM subscriptionhistory
1846 WHERE subscriptionid= ?
1848 my $sth = $dbh->prepare($query);
1849 $sth->execute( $dataissue->{'subscriptionid'} );
1850 my $data = $sth->fetchrow_hashref;
1851 my $serialseq = $dataissue->{'serialseq'};
1852 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1853 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1854 my $strsth = "UPDATE subscriptionhistory SET " . join( ",", map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data ) . " WHERE subscriptionid=?";
1855 $sth = $dbh->prepare($strsth);
1856 $sth->execute( $dataissue->{'subscriptionid'} );
1859 return $mainsth->rows;
1862 =head2 GetLateOrMissingIssues
1864 @issuelist = GetLateMissingIssues($supplierid,$serialid)
1866 this function selects missing issues on database - where serial.status = MISSING* or serial.status = LATE or planneddate<now
1869 the issuelist as an array of hash refs. Each element of this array contains
1870 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1874 sub GetLateOrMissingIssues {
1875 my ( $supplierid, $serialid, $order ) = @_;
1877 return unless ( $supplierid or $serialid );
1879 my $dbh = C4::Context->dbh;
1883 $byserial = "and serialid = " . $serialid;
1886 $order .= ", title";
1890 my $missing_statuses_string = join ',', (MISSING_STATUSES);
1892 $sth = $dbh->prepare(
1894 serialid, aqbooksellerid, name,
1895 biblio.title, biblioitems.issn, planneddate, serialseq,
1896 serial.status, serial.subscriptionid, claimdate, claims_count,
1897 subscription.branchcode
1899 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1900 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1901 LEFT JOIN biblioitems ON subscription.biblionumber=biblioitems.biblionumber
1902 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1903 WHERE subscription.subscriptionid = serial.subscriptionid
1904 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1905 AND subscription.aqbooksellerid=$supplierid
1910 $sth = $dbh->prepare(
1912 serialid, aqbooksellerid, name,
1913 biblio.title, planneddate, serialseq,
1914 serial.status, serial.subscriptionid, claimdate, claims_count,
1915 subscription.branchcode
1917 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1918 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1919 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1920 WHERE subscription.subscriptionid = serial.subscriptionid
1921 AND (serial.STATUS IN ($missing_statuses_string) OR ((planneddate < now() AND serial.STATUS = ?) OR serial.STATUS = ? OR serial.STATUS = ?))
1926 $sth->execute( EXPECTED, LATE, CLAIMED );
1928 while ( my $line = $sth->fetchrow_hashref ) {
1930 if ($line->{planneddate} && $line->{planneddate} !~/^0+\-/) {
1931 $line->{planneddateISO} = $line->{planneddate};
1932 $line->{planneddate} = format_date( $line->{planneddate} );
1934 if ($line->{claimdate} && $line->{claimdate} !~/^0+\-/) {
1935 $line->{claimdateISO} = $line->{claimdate};
1936 $line->{claimdate} = format_date( $line->{claimdate} );
1938 $line->{"status".$line->{status}} = 1;
1939 push @issuelist, $line;
1944 =head2 removeMissingIssue
1946 removeMissingIssue($subscriptionid)
1948 this function removes an issue from being part of the missing string in
1949 subscriptionlist.missinglist column
1951 called when a missing issue is found from the serials-recieve.pl file
1955 sub removeMissingIssue {
1956 my ( $sequence, $subscriptionid ) = @_;
1958 return unless ($sequence and $subscriptionid);
1960 my $dbh = C4::Context->dbh;
1961 my $sth = $dbh->prepare("SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1962 $sth->execute($subscriptionid);
1963 my $data = $sth->fetchrow_hashref;
1964 my $missinglist = $data->{'missinglist'};
1965 my $missinglistbefore = $missinglist;
1967 # warn $missinglist." before";
1968 $missinglist =~ s/($sequence)//;
1970 # warn $missinglist." after";
1971 if ( $missinglist ne $missinglistbefore ) {
1972 $missinglist =~ s/\|\s\|/\|/g;
1973 $missinglist =~ s/^\| //g;
1974 $missinglist =~ s/\|$//g;
1975 my $sth2 = $dbh->prepare(
1976 "UPDATE subscriptionhistory
1978 WHERE subscriptionid = ?"
1980 $sth2->execute( $missinglist, $subscriptionid );
1987 &updateClaim($serialid)
1989 this function updates the time when a claim is issued for late/missing items
1991 called from claims.pl file
1996 my ($serialid) = @_;
1997 my $dbh = C4::Context->dbh;
2000 SET claimdate = NOW(),
2001 claims_count = claims_count + 1
2007 =head2 getsupplierbyserialid
2009 $result = getsupplierbyserialid($serialid)
2011 this function is used to find the supplier id given a serial id
2014 hashref containing serialid, subscriptionid, and aqbooksellerid
2018 sub getsupplierbyserialid {
2019 my ($serialid) = @_;
2020 my $dbh = C4::Context->dbh;
2021 my $sth = $dbh->prepare(
2022 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2024 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2028 $sth->execute($serialid);
2029 my $line = $sth->fetchrow_hashref;
2030 my $result = $line->{'aqbooksellerid'};
2034 =head2 check_routing
2036 $result = &check_routing($subscriptionid)
2038 this function checks to see if a serial has a routing list and returns the count of routingid
2039 used to show either an 'add' or 'edit' link
2044 my ($subscriptionid) = @_;
2046 return unless ($subscriptionid);
2048 my $dbh = C4::Context->dbh;
2049 my $sth = $dbh->prepare(
2050 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2051 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2052 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2055 $sth->execute($subscriptionid);
2056 my $line = $sth->fetchrow_hashref;
2057 my $result = $line->{'routingids'};
2061 =head2 addroutingmember
2063 addroutingmember($borrowernumber,$subscriptionid)
2065 this function takes a borrowernumber and subscriptionid and adds the member to the
2066 routing list for that serial subscription and gives them a rank on the list
2067 of either 1 or highest current rank + 1
2071 sub addroutingmember {
2072 my ( $borrowernumber, $subscriptionid ) = @_;
2074 return unless ($borrowernumber and $subscriptionid);
2077 my $dbh = C4::Context->dbh;
2078 my $sth = $dbh->prepare( "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?" );
2079 $sth->execute($subscriptionid);
2080 while ( my $line = $sth->fetchrow_hashref ) {
2081 if ( $line->{'rank'} > 0 ) {
2082 $rank = $line->{'rank'} + 1;
2087 $sth = $dbh->prepare( "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)" );
2088 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2091 =head2 reorder_members
2093 reorder_members($subscriptionid,$routingid,$rank)
2095 this function is used to reorder the routing list
2097 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2098 - it gets all members on list puts their routingid's into an array
2099 - removes the one in the array that is $routingid
2100 - then reinjects $routingid at point indicated by $rank
2101 - then update the database with the routingids in the new order
2105 sub reorder_members {
2106 my ( $subscriptionid, $routingid, $rank ) = @_;
2107 my $dbh = C4::Context->dbh;
2108 my $sth = $dbh->prepare( "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC" );
2109 $sth->execute($subscriptionid);
2111 while ( my $line = $sth->fetchrow_hashref ) {
2112 push( @result, $line->{'routingid'} );
2115 # To find the matching index
2117 my $key = -1; # to allow for 0 being a valid response
2118 for ( $i = 0 ; $i < @result ; $i++ ) {
2119 if ( $routingid == $result[$i] ) {
2120 $key = $i; # save the index
2125 # if index exists in array then move it to new position
2126 if ( $key > -1 && $rank > 0 ) {
2127 my $new_rank = $rank - 1; # $new_rank is what you want the new index to be in the array
2128 my $moving_item = splice( @result, $key, 1 );
2129 splice( @result, $new_rank, 0, $moving_item );
2131 for ( my $j = 0 ; $j < @result ; $j++ ) {
2132 my $sth = $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '" . ( $j + 1 ) . "' WHERE routingid = '" . $result[$j] . "'" );
2138 =head2 delroutingmember
2140 delroutingmember($routingid,$subscriptionid)
2142 this function either deletes one member from routing list if $routingid exists otherwise
2143 deletes all members from the routing list
2147 sub delroutingmember {
2149 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2150 my ( $routingid, $subscriptionid ) = @_;
2151 my $dbh = C4::Context->dbh;
2153 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2154 $sth->execute($routingid);
2155 reorder_members( $subscriptionid, $routingid );
2157 my $sth = $dbh->prepare("DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2158 $sth->execute($subscriptionid);
2163 =head2 getroutinglist
2165 @routinglist = getroutinglist($subscriptionid)
2167 this gets the info from the subscriptionroutinglist for $subscriptionid
2170 the routinglist as an array. Each element of the array contains a hash_ref containing
2171 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2175 sub getroutinglist {
2176 my ($subscriptionid) = @_;
2177 my $dbh = C4::Context->dbh;
2178 my $sth = $dbh->prepare(
2179 'SELECT routingid, borrowernumber, ranking, biblionumber
2181 JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2182 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC'
2184 $sth->execute($subscriptionid);
2185 my $routinglist = $sth->fetchall_arrayref({});
2186 return @{$routinglist};
2189 =head2 countissuesfrom
2191 $result = countissuesfrom($subscriptionid,$startdate)
2193 Returns a count of serial rows matching the given subsctiptionid
2194 with published date greater than startdate
2198 sub countissuesfrom {
2199 my ( $subscriptionid, $startdate ) = @_;
2200 my $dbh = C4::Context->dbh;
2204 WHERE subscriptionid=?
2205 AND serial.publisheddate>?
2207 my $sth = $dbh->prepare($query);
2208 $sth->execute( $subscriptionid, $startdate );
2209 my ($countreceived) = $sth->fetchrow;
2210 return $countreceived;
2215 $result = CountIssues($subscriptionid)
2217 Returns a count of serial rows matching the given subsctiptionid
2222 my ($subscriptionid) = @_;
2223 my $dbh = C4::Context->dbh;
2227 WHERE subscriptionid=?
2229 my $sth = $dbh->prepare($query);
2230 $sth->execute($subscriptionid);
2231 my ($countreceived) = $sth->fetchrow;
2232 return $countreceived;
2237 $result = HasItems($subscriptionid)
2239 returns a count of items from serial matching the subscriptionid
2244 my ($subscriptionid) = @_;
2245 my $dbh = C4::Context->dbh;
2247 SELECT COUNT(serialitems.itemnumber)
2249 LEFT JOIN serialitems USING(serialid)
2250 WHERE subscriptionid=? AND serialitems.serialid IS NOT NULL
2252 my $sth=$dbh->prepare($query);
2253 $sth->execute($subscriptionid);
2254 my ($countitems)=$sth->fetchrow_array();
2258 =head2 abouttoexpire
2260 $result = abouttoexpire($subscriptionid)
2262 this function alerts you to the penultimate issue for a serial subscription
2264 returns 1 - if this is the penultimate issue
2270 my ($subscriptionid) = @_;
2271 my $dbh = C4::Context->dbh;
2272 my $subscription = GetSubscription($subscriptionid);
2273 my $per = $subscription->{'periodicity'};
2274 my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per);
2275 if ($frequency and $frequency->{unit}){
2277 my $expirationdate = GetExpirationDate($subscriptionid);
2279 my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid);
2280 my $nextdate = GetNextDate($subscription, $res);
2282 # only compare dates if both dates exist.
2283 if ($nextdate and $expirationdate) {
2284 if(Date::Calc::Delta_Days(
2285 split( /-/, $nextdate ),
2286 split( /-/, $expirationdate )
2292 } elsif ($subscription->{numberlength}>0) {
2293 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2299 sub in_array { # used in next sub down
2300 my ( $val, @elements ) = @_;
2301 foreach my $elem (@elements) {
2302 if ( $val == $elem ) {
2309 =head2 GetSubscriptionsFromBorrower
2311 ($count,@routinglist) = GetSubscriptionsFromBorrower($borrowernumber)
2313 this gets the info from subscriptionroutinglist for each $subscriptionid
2316 a count of the serial subscription routing lists to which a patron belongs,
2317 with the titles of those serial subscriptions as an array. Each element of the array
2318 contains a hash_ref with subscriptionID and title of subscription.
2322 sub GetSubscriptionsFromBorrower {
2323 my ($borrowernumber) = @_;
2324 my $dbh = C4::Context->dbh;
2325 my $sth = $dbh->prepare(
2326 "SELECT subscription.subscriptionid, biblio.title
2328 JOIN biblio ON biblio.biblionumber = subscription.biblionumber
2329 JOIN subscriptionroutinglist USING (subscriptionid)
2330 WHERE subscriptionroutinglist.borrowernumber = ? ORDER BY title ASC
2333 $sth->execute($borrowernumber);
2336 while ( my $line = $sth->fetchrow_hashref ) {
2338 push( @routinglist, $line );
2340 return ( $count, @routinglist );
2344 =head2 GetFictiveIssueNumber
2346 $issueno = GetFictiveIssueNumber($subscription, $publishedate);
2348 Get the position of the issue published at $publisheddate, considering the
2349 first issue (at firstacquidate) is at position 1, the next is at position 2, etc...
2350 This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd
2351 issue is declared as 'irregular' (will be skipped at receipt), the next issue number
2352 will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not
2353 depending on how many rows are in serial table.
2354 The issue number calculation is based on subscription frequency, first acquisition
2355 date, and $publisheddate.
2359 sub GetFictiveIssueNumber {
2360 my ($subscription, $publisheddate) = @_;
2362 my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'});
2363 my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef;
2367 my ($year, $month, $day) = split /-/, $publisheddate;
2368 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'};
2372 if($unit eq 'day') {
2373 $delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day);
2374 } elsif($unit eq 'week') {
2375 ($wkno, $year) = Week_of_Year($year, $month, $day);
2376 my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day);
2377 $delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) );
2378 } elsif($unit eq 'month') {
2379 $delta = ($fa_year == $year)
2380 ? ($month - $fa_month)
2381 : ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) );
2382 } elsif($unit eq 'year') {
2383 $delta = $year - $fa_year;
2385 if($frequency->{'unitsperissue'} == 1) {
2386 $issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'};
2388 # Assuming issuesperunit == 1
2389 $issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} );
2395 sub _get_next_date_day {
2396 my ($subscription, $freqdata, $year, $month, $day) = @_;
2398 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2399 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{unitsperissue} );
2400 $subscription->{countissuesperunit} = 1;
2402 $subscription->{countissuesperunit}++;
2405 return ($year, $month, $day);
2408 sub _get_next_date_week {
2409 my ($subscription, $freqdata, $year, $month, $day) = @_;
2411 my ($wkno, $yr) = Week_of_Year($year, $month, $day);
2412 my $fa_dow = Day_of_Week(split /-/, $subscription->{firstacquidate});
2414 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2415 $subscription->{countissuesperunit} = 1;
2416 $wkno += $freqdata->{unitsperissue};
2421 ($year,$month,$day) = Monday_of_Week($wkno, $yr);
2422 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $fa_dow - 1);
2424 # Try to guess the next day of week
2425 my $delta_days = int((7 - ($fa_dow - 1)) / $freqdata->{issuesperunit});
2426 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2427 $subscription->{countissuesperunit}++;
2430 return ($year, $month, $day);
2433 sub _get_next_date_month {
2434 my ($subscription, $freqdata, $year, $month, $day) = @_;
2437 (undef, undef, $fa_day) = split /-/, $subscription->{firstacquidate};
2439 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2440 $subscription->{countissuesperunit} = 1;
2441 ($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,
2442 $freqdata->{unitsperissue});
2443 my $days_in_month = Days_in_Month($year, $month);
2444 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2446 # Try to guess the next day in month
2447 my $days_in_month = Days_in_Month($year, $month);
2448 my $delta_days = int(($days_in_month - ($fa_day - 1)) / $freqdata->{issuesperunit});
2449 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2450 $subscription->{countissuesperunit}++;
2453 return ($year, $month, $day);
2456 sub _get_next_date_year {
2457 my ($subscription, $freqdata, $year, $month, $day) = @_;
2459 my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{firstacquidate};
2461 if ($subscription->{countissuesperunit} + 1 > $freqdata->{issuesperunit}){
2462 $subscription->{countissuesperunit} = 1;
2463 ($year) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0);
2465 my $days_in_month = Days_in_Month($year, $month);
2466 $day = $fa_day <= $days_in_month ? $fa_day : $days_in_month;
2468 # Try to guess the next day in year
2469 my $days_in_year = Days_in_Year($year,12); #Sum the days of all the months of this year
2470 my $delta_days = int(($days_in_year - ($fa_day - 1)) / $freqdata->{issuesperunit});
2471 ($year,$month,$day) = Add_Delta_Days($year, $month, $day, $delta_days);
2472 $subscription->{countissuesperunit}++;
2475 return ($year, $month, $day);
2480 $resultdate = GetNextDate($publisheddate,$subscription)
2482 this function it takes the publisheddate and will return the next issue's date
2483 and will skip dates if there exists an irregularity.
2484 $publisheddate has to be an ISO date
2485 $subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit'
2486 $updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database
2487 - eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be
2488 skipped then the returned date will be 2007-05-10
2491 $resultdate - then next date in the sequence (ISO date)
2493 Return undef if subscription is irregular
2498 my ( $subscription, $publisheddate, $updatecount ) = @_;
2500 return unless $subscription and $publisheddate;
2502 my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'});
2504 if ($freqdata->{'unit'}) {
2505 my ( $year, $month, $day ) = split /-/, $publisheddate;
2507 # Process an irregularity Hash
2508 # Suppose that irregularities are stored in a string with this structure
2509 # irreg1;irreg2;irreg3
2510 # where irregX is the number of issue which will not be received
2511 # (the first issue takes the number 1, the 2nd the number 2 and so on)
2513 if ( $subscription->{irregularity} ) {
2514 my @irreg = split /;/, $subscription->{'irregularity'} ;
2515 foreach my $irregularity (@irreg) {
2516 $irregularities{$irregularity} = 1;
2520 # Get the 'fictive' next issue number
2521 # It is used to check if next issue is an irregular issue.
2522 my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1;
2524 # Then get the next date
2525 my $unit = lc $freqdata->{'unit'};
2526 if ($unit eq 'day') {
2527 while ($irregularities{$issueno}) {
2528 ($year, $month, $day) = _get_next_date_day($subscription,
2529 $freqdata, $year, $month, $day);
2532 ($year, $month, $day) = _get_next_date_day($subscription, $freqdata,
2533 $year, $month, $day);
2535 elsif ($unit eq 'week') {
2536 while ($irregularities{$issueno}) {
2537 ($year, $month, $day) = _get_next_date_week($subscription,
2538 $freqdata, $year, $month, $day);
2541 ($year, $month, $day) = _get_next_date_week($subscription,
2542 $freqdata, $year, $month, $day);
2544 elsif ($unit eq 'month') {
2545 while ($irregularities{$issueno}) {
2546 ($year, $month, $day) = _get_next_date_month($subscription,
2547 $freqdata, $year, $month, $day);
2550 ($year, $month, $day) = _get_next_date_month($subscription,
2551 $freqdata, $year, $month, $day);
2553 elsif ($unit eq 'year') {
2554 while ($irregularities{$issueno}) {
2555 ($year, $month, $day) = _get_next_date_year($subscription,
2556 $freqdata, $year, $month, $day);
2559 ($year, $month, $day) = _get_next_date_year($subscription,
2560 $freqdata, $year, $month, $day);
2564 my $dbh = C4::Context->dbh;
2567 SET countissuesperunit = ?
2568 WHERE subscriptionid = ?
2570 my $sth = $dbh->prepare($query);
2571 $sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'});
2574 return sprintf("%04d-%02d-%02d", $year, $month, $day);
2580 $string = &_numeration($value,$num_type,$locale);
2582 _numeration returns the string corresponding to $value in the num_type
2592 my ($value, $num_type, $locale) = @_;
2597 if ( $num_type =~ /^dayname$/ ) {
2598 # 1970-11-01 was a Sunday
2599 $value = $value % 7;
2600 my $dt = DateTime->new(
2606 $string = $dt->strftime("%A");
2607 } elsif ( $num_type =~ /^monthname$/ ) {
2608 $value = $value % 12;
2609 my $dt = DateTime->new(
2611 month => $value + 1,
2614 $string = $dt->strftime("%B");
2615 } elsif ( $num_type =~ /^season$/ ) {
2616 my @seasons= qw( Spring Summer Fall Winter );
2617 $value = $value % 4;
2618 $string = $seasons[$value];
2626 =head2 is_barcode_in_use
2628 Returns number of occurence of the barcode in the items table
2629 Can be used as a boolean test of whether the barcode has
2630 been deployed as yet
2634 sub is_barcode_in_use {
2635 my $barcode = shift;
2636 my $dbh = C4::Context->dbh;
2637 my $occurences = $dbh->selectall_arrayref(
2638 'SELECT itemnumber from items where barcode = ?',
2643 return @{$occurences};
2646 =head2 CloseSubscription
2647 Close a subscription given a subscriptionid
2649 sub CloseSubscription {
2650 my ( $subscriptionid ) = @_;
2651 return unless $subscriptionid;
2652 my $dbh = C4::Context->dbh;
2653 my $sth = $dbh->prepare( q{
2656 WHERE subscriptionid = ?
2658 $sth->execute( $subscriptionid );
2660 # Set status = missing when status = stopped
2661 $sth = $dbh->prepare( q{
2664 WHERE subscriptionid = ?
2667 $sth->execute( STOPPED, $subscriptionid, EXPECTED );
2670 =head2 ReopenSubscription
2671 Reopen a subscription given a subscriptionid
2673 sub ReopenSubscription {
2674 my ( $subscriptionid ) = @_;
2675 return unless $subscriptionid;
2676 my $dbh = C4::Context->dbh;
2677 my $sth = $dbh->prepare( q{
2680 WHERE subscriptionid = ?
2682 $sth->execute( $subscriptionid );
2684 # Set status = expected when status = stopped
2685 $sth = $dbh->prepare( q{
2688 WHERE subscriptionid = ?
2691 $sth->execute( EXPECTED, $subscriptionid, STOPPED );
2694 =head2 subscriptionCurrentlyOnOrder
2696 $bool = subscriptionCurrentlyOnOrder( $subscriptionid );
2698 Return 1 if subscription is currently on order else 0.
2702 sub subscriptionCurrentlyOnOrder {
2703 my ( $subscriptionid ) = @_;
2704 my $dbh = C4::Context->dbh;
2706 SELECT COUNT(*) FROM aqorders
2707 WHERE subscriptionid = ?
2708 AND datereceived IS NULL
2709 AND datecancellationprinted IS NULL
2711 my $sth = $dbh->prepare( $query );
2712 $sth->execute($subscriptionid);
2713 return $sth->fetchrow_array;
2716 =head2 can_edit_subscription
2718 $can = can_edit_subscription( $subscriptionid[, $userid] );
2720 Return 1 if the subscription can be edited by the current logged user (or a given $userid), else 0.
2724 sub can_edit_subscription {
2725 my ( $subscription, $userid ) = @_;
2726 return _can_do_on_subscription( $subscription, $userid, 'edit_subscription' );
2729 =head2 can_show_subscription
2731 $can = can_show_subscription( $subscriptionid[, $userid] );
2733 Return 1 if the subscription can be shown by the current logged user (or a given $userid), else 0.
2737 sub can_show_subscription {
2738 my ( $subscription, $userid ) = @_;
2739 return _can_do_on_subscription( $subscription, $userid, '*' );
2742 sub _can_do_on_subscription {
2743 my ( $subscription, $userid, $permission ) = @_;
2744 return 0 unless C4::Context->userenv;
2745 my $flags = C4::Context->userenv->{flags};
2746 $userid ||= C4::Context->userenv->{'id'};
2748 if ( C4::Context->preference('IndependentBranches') ) {
2750 if C4::Context->IsSuperLibrarian()
2752 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2754 C4::Auth::haspermission( $userid,
2755 { serials => $permission } )
2756 and ( not defined $subscription->{branchcode}
2757 or $subscription->{branchcode} eq ''
2758 or $subscription->{branchcode} eq
2759 C4::Context->userenv->{'branch'} )
2764 if C4::Context->IsSuperLibrarian()
2766 C4::Auth::haspermission( $userid, { serials => 'superserials' } )
2767 or C4::Auth::haspermission(
2768 $userid, { serials => $permission }
2780 Koha Development Team <http://koha-community.org/>