1 package C4
::Serials
; #assumes C4/Serials.pm
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
22 use C4
::Dates
qw(format_date format_date_in_iso);
23 use Date
::Calc
qw(:all);
24 use POSIX
qw(strftime);
31 use C4
::Log
; # logaction
33 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
36 $VERSION = 3.01; # set version for version checking
40 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
41 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
42 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
43 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
45 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
46 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
47 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
48 &GetSerialInformation &AddItem2Serial
51 &UpdateClaimdateIssues
52 &GetSuppliersWithLateIssues &getsupplierbyserialid
53 &GetDistributedTo &SetDistributedTo
54 &getroutinglist &delroutingmember &addroutingmember
56 &check_routing &updateClaim &removeMissingIssue
58 &old_newsubscription &old_modsubscription &old_getserials
62 =head2 GetSuppliersWithLateIssues
66 C4::Serials - Give functions for serializing.
74 Give all XYZ functions
80 %supplierlist = &GetSuppliersWithLateIssues
82 this function get all suppliers with late issues.
85 the supplierlist into a hash. this hash containts id & name of the supplier
91 sub GetSuppliersWithLateIssues
{
92 my $dbh = C4
::Context
->dbh;
94 SELECT DISTINCT id
, name
96 LEFT JOIN serial ON serial
.subscriptionid
=subscription
.subscriptionid
97 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
98 WHERE subscription
.subscriptionid
= serial
.subscriptionid
99 AND
(planneddate
< now
() OR serial
.STATUS
= 3 OR serial
.STATUS
= 4)
102 my $sth = $dbh->prepare($query);
105 while ( my ( $id, $name ) = $sth->fetchrow ) {
106 $supplierlist{$id} = $name;
108 if ( C4
::Context
->preference("RoutingSerials") ) {
109 $supplierlist{''} = "All Suppliers";
111 return %supplierlist;
118 @issuelist = &GetLateIssues($supplierid)
120 this function select late issues on database
123 the issuelist into an table. Each line of this table containts a ref to a hash which it containts
124 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
131 my ($supplierid) = @_;
132 my $dbh = C4
::Context
->dbh;
136 SELECT name
,title
,planneddate
,serialseq
,serial
.subscriptionid
138 LEFT JOIN serial ON subscription
.subscriptionid
= serial
.subscriptionid
139 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
140 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
141 WHERE
((planneddate
< now
() AND serial
.STATUS
=1) OR serial
.STATUS
= 3)
142 AND subscription
.aqbooksellerid
=$supplierid
145 $sth = $dbh->prepare($query);
149 SELECT name
,title
,planneddate
,serialseq
,serial
.subscriptionid
151 LEFT JOIN serial ON subscription
.subscriptionid
= serial
.subscriptionid
152 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
153 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
= aqbooksellers
.id
154 WHERE
((planneddate
< now
() AND serial
.STATUS
=1) OR serial
.STATUS
= 3)
157 $sth = $dbh->prepare($query);
164 while ( my $line = $sth->fetchrow_hashref ) {
165 $odd++ unless $line->{title
} eq $last_title;
166 $line->{title
} = "" if $line->{title
} eq $last_title;
167 $last_title = $line->{title
} if ( $line->{title
} );
168 $line->{planneddate
} = format_date
( $line->{planneddate
} );
170 push @issuelist, $line;
172 return $count, @issuelist;
175 =head2 GetSubscriptionHistoryFromSubscriptionId
179 $sth = GetSubscriptionHistoryFromSubscriptionId()
180 this function just prepare the SQL request.
181 After this function, don't forget to execute it by using $sth->execute($subscriptionid)
183 $sth = $dbh->prepare($query).
189 sub GetSubscriptionHistoryFromSubscriptionId
() {
190 my $dbh = C4
::Context
->dbh;
193 FROM subscriptionhistory
194 WHERE subscriptionid
= ?
196 return $dbh->prepare($query);
199 =head2 GetSerialStatusFromSerialId
203 $sth = GetSerialStatusFromSerialId();
204 this function just prepare the SQL request.
205 After this function, don't forget to execute it by using $sth->execute($serialid)
207 $sth = $dbh->prepare($query).
213 sub GetSerialStatusFromSerialId
() {
214 my $dbh = C4
::Context
->dbh;
220 return $dbh->prepare($query);
223 =head2 GetSerialInformation
227 $data = GetSerialInformation($serialid);
228 returns a hash containing :
229 items : items marcrecord (can be an array)
231 subscription table field
232 + information about subscription expiration
238 sub GetSerialInformation
{
240 my $dbh = C4
::Context
->dbh;
242 SELECT serial
.*, serial
.notes as sernotes
, serial
.status as serstatus
,subscription
.*,subscription
.subscriptionid as subsid
|;
243 if (C4
::Context
->preference('IndependantBranches') &&
244 C4
::Context
->userenv &&
245 C4
::Context
->userenv->{'flags'} != 1 && C4
::Context
->userenv->{'branch'}){
247 , ((subscription.branchcode <>\"".C4
::Context
->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
250 FROM serial LEFT JOIN subscription ON subscription
.subscriptionid
=serial
.subscriptionid
253 my $rq = $dbh->prepare($query);
254 $rq->execute($serialid);
255 my $data = $rq->fetchrow_hashref;
257 if ( C4
::Context
->preference("serialsadditems") ) {
258 if ( $data->{'itemnumber'} ) {
259 my @itemnumbers = split /,/, $data->{'itemnumber'};
260 foreach my $itemnum (@itemnumbers) {
262 #It is ASSUMED that GetMarcItem ALWAYS WORK...
263 #Maybe GetMarcItem should return values on failure
264 # warn "itemnumber :$itemnum, bibnum :".$data->{'biblionumber'};
266 PrepareItemrecordDisplay
( $data->{'biblionumber'}, $itemnum );
267 $itemprocessed->{'itemnumber'} = $itemnum;
268 $itemprocessed->{'itemid'} = $itemnum;
269 $itemprocessed->{'serialid'} = $serialid;
270 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
271 push @
{ $data->{'items'} }, $itemprocessed;
276 PrepareItemrecordDisplay
( $data->{'biblionumber'} );
277 $itemprocessed->{'itemid'} = "N$serialid";
278 $itemprocessed->{'serialid'} = $serialid;
279 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
280 $itemprocessed->{'countitems'} = 0;
281 push @
{ $data->{'items'} }, $itemprocessed;
284 $data->{ "status" . $data->{'serstatus'} } = 1;
285 $data->{'subscriptionexpired'} =
286 HasSubscriptionExpired
( $data->{'subscriptionid'} ) && $data->{'status'}==1;
287 $data->{'abouttoexpire'} =
288 abouttoexpire
( $data->{'subscriptionid'} );
292 =head2 AddItem2Serial
296 $data = AddItem2Serial($serialid,$itemnumber);
297 Adds an itemnumber to Serial record
303 my ( $serialid, $itemnumber ) = @_;
304 my $dbh = C4
::Context
->dbh;
306 UPDATE serial SET itemnumber
=IF
(itemnumber IS NULL
, $itemnumber, CONCAT
(itemnumber
,",",$itemnumber))
309 my $rq = $dbh->prepare($query);
310 $rq->execute($serialid);
314 =head2 UpdateClaimdateIssues
318 UpdateClaimdateIssues($serialids,[$date]);
320 Update Claimdate for issues in @$serialids list with date $date
326 sub UpdateClaimdateIssues
{
327 my ( $serialids, $date ) = @_;
328 my $dbh = C4
::Context
->dbh;
329 $date = strftime
("%Y-%m-%d",localtime) unless ($date);
331 UPDATE serial SET claimdate=$date,status=7
332 WHERE serialid in ".join (",",@
$serialids);
334 my $rq = $dbh->prepare($query);
339 =head2 GetSubscription
343 $subs = GetSubscription($subscriptionid)
344 this function get the subscription which has $subscriptionid as id.
346 a hashref. This hash containts
347 subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
353 sub GetSubscription
{
354 my ($subscriptionid) = @_;
355 my $dbh = C4
::Context
->dbh;
357 SELECT subscription
.*,
358 subscriptionhistory
.*,
360 aqbooksellers
.name AS aqbooksellername
,
361 biblio
.title AS bibliotitle
,
362 subscription
.biblionumber as bibnum
);
363 if (C4
::Context
->preference('IndependantBranches') &&
364 C4
::Context
->userenv &&
365 C4
::Context
->userenv->{'flags'} != 1 && C4
::Context
->userenv->{'branch'}){
367 , ((subscription.branchcode <>\"".C4
::Context
->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
371 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
372 LEFT JOIN aqbudget ON subscription
.aqbudgetid
=aqbudget
.aqbudgetid
373 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
374 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
375 WHERE subscription
.subscriptionid
= ?
377 # if (C4::Context->preference('IndependantBranches') &&
378 # C4::Context->userenv &&
379 # C4::Context->userenv->{'flags'} != 1){
380 # # warn "flags: ".C4::Context->userenv->{'flags'};
381 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
383 # warn "query : $query";
384 my $sth = $dbh->prepare($query);
385 # warn "subsid :$subscriptionid";
386 $sth->execute($subscriptionid);
387 my $subs = $sth->fetchrow_hashref;
391 =head2 GetFullSubscription
395 \@res = GetFullSubscription($subscriptionid)
396 this function read on serial table.
402 sub GetFullSubscription
{
403 my ($subscriptionid) = @_;
404 my $dbh = C4
::Context
->dbh;
406 SELECT serial
.serialid
,
409 serial
.publisheddate
,
411 serial
.notes as notes
,
412 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
413 aqbudget
.bookfundid
,aqbooksellers
.name as aqbooksellername
,
414 biblio
.title as bibliotitle
,
415 subscription
.branchcode AS branchcode
,
416 subscription
.subscriptionid AS subscriptionid
|;
417 if (C4
::Context
->preference('IndependantBranches') &&
418 C4
::Context
->userenv &&
419 C4
::Context
->userenv->{'flags'} != 1 && C4
::Context
->userenv->{'branch'}){
421 , ((subscription.branchcode <>\"".C4
::Context
->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
425 LEFT JOIN subscription ON
426 (serial
.subscriptionid
=subscription
.subscriptionid
)
427 LEFT JOIN aqbudget ON subscription
.aqbudgetid
=aqbudget
.aqbudgetid
428 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
429 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
430 WHERE serial
.subscriptionid
= ?
432 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
433 serial
.subscriptionid
436 my $sth = $dbh->prepare($query);
437 $sth->execute($subscriptionid);
438 my $subs = $sth->fetchall_arrayref({});
443 =head2 PrepareSerialsData
447 \@res = PrepareSerialsData($serialinfomation)
448 where serialinformation is a hashref array
454 sub PrepareSerialsData
{
460 my $aqbooksellername;
464 my $previousnote = "";
466 foreach my $subs ( @
$lines ) {
467 $subs->{'publisheddate'} =
468 ( $subs->{'publisheddate'}
469 ? format_date
( $subs->{'publisheddate'} )
471 $subs->{'planneddate'} = format_date
( $subs->{'planneddate'} );
472 $subs->{ "status" . $subs->{'status'} } = 1;
474 # $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
475 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
476 $year = $subs->{'year'};
481 if ( $tmpresults{$year} ) {
482 push @
{ $tmpresults{$year}->{'serials'} }, $subs;
485 $tmpresults{$year} = {
488 # 'startdate'=>format_date($subs->{'startdate'}),
489 'aqbooksellername' => $subs->{'aqbooksellername'},
490 'bibliotitle' => $subs->{'bibliotitle'},
491 'serials' => [$subs],
493 # 'branchcode' => $subs->{'branchcode'},
494 # 'subscriptionid' => $subs->{'subscriptionid'},
498 # $previousnote=$subs->{notes};
500 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
501 push @res, $tmpresults{$key};
503 $res[0]->{'first'}=1;
507 =head2 GetSubscriptionsFromBiblionumber
509 \@res = GetSubscriptionsFromBiblionumber($biblionumber)
510 this function get the subscription list. it reads on subscription table.
512 table of subscription which has the biblionumber given on input arg.
513 each line of this table is a hashref. All hashes containt
514 startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
518 sub GetSubscriptionsFromBiblionumber
{
519 my ($biblionumber) = @_;
520 my $dbh = C4
::Context
->dbh;
522 SELECT subscription
.*,
524 subscriptionhistory
.*,
526 aqbooksellers
.name AS aqbooksellername
,
527 biblio
.title AS bibliotitle
529 LEFT JOIN subscriptionhistory ON subscription
.subscriptionid
=subscriptionhistory
.subscriptionid
530 LEFT JOIN aqbudget ON subscription
.aqbudgetid
=aqbudget
.aqbudgetid
531 LEFT JOIN aqbooksellers ON subscription
.aqbooksellerid
=aqbooksellers
.id
532 LEFT JOIN biblio ON biblio
.biblionumber
=subscription
.biblionumber
533 LEFT JOIN branches ON branches
.branchcode
=subscription
.branchcode
534 WHERE subscription
.biblionumber
= ?
536 # if (C4::Context->preference('IndependantBranches') &&
537 # C4::Context->userenv &&
538 # C4::Context->userenv->{'flags'} != 1){
539 # $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
541 my $sth = $dbh->prepare($query);
542 $sth->execute($biblionumber);
544 while ( my $subs = $sth->fetchrow_hashref ) {
545 $subs->{startdate
} = format_date
( $subs->{startdate
} );
546 $subs->{histstartdate
} = format_date
( $subs->{histstartdate
} );
547 $subs->{opacnote
} =~ s/\n/\<br\/\
>/g
;
548 $subs->{missinglist
} =~ s/\n/\<br\/\
>/g
;
549 $subs->{recievedlist
} =~ s/\n/\<br\/\
>/g
;
550 $subs->{ "periodicity" . $subs->{periodicity
} } = 1;
551 $subs->{ "numberpattern" . $subs->{numberpattern
} } = 1;
552 $subs->{ "status" . $subs->{'status'} } = 1;
553 $subs->{'cannotedit'}=(C4
::Context
->preference('IndependantBranches') &&
554 C4
::Context
->userenv &&
555 C4
::Context
->userenv->{flags
} !=1 &&
556 C4
::Context
->userenv->{branch
} && $subs->{branchcode
} &&
557 (C4
::Context
->userenv->{branch
} ne $subs->{branchcode
}));
558 if ( $subs->{enddate
} eq '0000-00-00' ) {
559 $subs->{enddate
} = '';
562 $subs->{enddate
} = format_date
( $subs->{enddate
} );
564 $subs->{'abouttoexpire'}=abouttoexpire
($subs->{'subscriptionid'});
565 $subs->{'subscriptionexpired'}=HasSubscriptionExpired
($subs->{'subscriptionid'});
571 =head2 GetFullSubscriptionsFromBiblionumber
575 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
576 this function read on serial table.
582 sub GetFullSubscriptionsFromBiblionumber
{
583 my ($biblionumber) = @_;
584 my $dbh = C4
::Context
->dbh;
586 SELECT serial
.serialid
,
589 serial
.publisheddate
,
591 serial
.notes as notes
,
592 year
(IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
)) as year
,
593 aqbudget
.bookfundid
,aqbooksellers
.name as aqbooksellername
,
594 biblio
.title as bibliotitle
,
595 subscription
.branchcode AS branchcode
,
596 subscription
.subscriptionid AS subscriptionid
|;
597 if (C4
::Context
->preference('IndependantBranches') &&
598 C4
::Context
->userenv &&
599 C4
::Context
->userenv->{'flags'} != 1 && C4
::Context
->userenv->{'branch'}){
601 , ((subscription.branchcode <>\"".C4
::Context
->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
606 LEFT JOIN subscription ON
607 (serial
.subscriptionid
=subscription
.subscriptionid
)
608 LEFT JOIN aqbudget ON subscription
.aqbudgetid
=aqbudget
.aqbudgetid
609 LEFT JOIN aqbooksellers on subscription
.aqbooksellerid
=aqbooksellers
.id
610 LEFT JOIN biblio on biblio
.biblionumber
=subscription
.biblionumber
611 WHERE subscription
.biblionumber
= ?
613 IF
(serial
.publisheddate
="00-00-0000",serial
.planneddate
,serial
.publisheddate
) DESC
,
614 serial
.subscriptionid
616 my $sth = $dbh->prepare($query);
617 $sth->execute($biblionumber);
618 my $subs= $sth->fetchall_arrayref({});
622 =head2 GetSubscriptions
626 @results = GetSubscriptions($title,$ISSN,$biblionumber);
627 this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
629 a table of hashref. Each hash containt the subscription.
635 sub GetSubscriptions
{
636 my ( $title, $ISSN, $biblionumber ) = @_;
637 #return unless $title or $ISSN or $biblionumber;
638 my $dbh = C4
::Context
->dbh;
642 SELECT subscription
.*,biblio
.title
,biblioitems
.issn
,biblio
.biblionumber
644 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
645 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
646 WHERE biblio
.biblionumber
=?
648 $query.=" ORDER BY title";
649 # warn "query :$query";
650 $sth = $dbh->prepare($query);
651 $sth->execute($biblionumber);
654 if ( $ISSN and $title ) {
656 SELECT subscription
.*,biblio
.title
,biblioitems
.issn
,biblio
.biblionumber
658 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
659 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
660 WHERE
(biblioitems
.issn
= ?
or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
661 $query.=" ORDER BY title";
662 $sth = $dbh->prepare($query);
663 $sth->execute( $ISSN );
668 SELECT subscription
.*,biblio
.title
,biblioitems
.issn
,biblio
.biblionumber
670 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
671 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
672 WHERE biblioitems
.issn LIKE ?
674 $query.=" ORDER BY title";
675 # warn "query :$query";
676 $sth = $dbh->prepare($query);
677 $sth->execute( "%" . $ISSN . "%" );
681 SELECT subscription
.*,biblio
.title
,biblioitems
.issn
,biblio
.biblionumber
683 LEFT JOIN biblio ON biblio
.biblionumber
= subscription
.biblionumber
684 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
686 ).($title?
" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
688 $query.=" ORDER BY title";
690 $sth = $dbh->prepare($query);
696 my $previoustitle = "";
698 while ( my $line = $sth->fetchrow_hashref ) {
699 if ( $previoustitle eq $line->{title
} ) {
702 $line->{toggle
} = 1 if $odd == 1;
705 $previoustitle = $line->{title
};
707 $line->{toggle
} = 1 if $odd == 1;
709 $line->{'cannotedit'}=(C4
::Context
->preference('IndependantBranches') &&
710 C4
::Context
->userenv &&
711 C4
::Context
->userenv->{flags
} !=1 &&
712 C4
::Context
->userenv->{branch
} && $line->{branchcode
} &&
713 (C4
::Context
->userenv->{branch
} ne $line->{branchcode
}));
714 push @results, $line;
723 ($totalissues,@serials) = GetSerials($subscriptionid);
724 this function get every serial not arrived for a given subscription
725 as well as the number of issues registered in the database (all types)
726 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
733 my ($subscriptionid,$count) = @_;
734 my $dbh = C4
::Context
->dbh;
736 # status = 2 is "arrived"
738 $count=5 unless ($count);
741 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes
743 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
744 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
745 my $sth = $dbh->prepare($query);
746 $sth->execute($subscriptionid);
747 while ( my $line = $sth->fetchrow_hashref ) {
748 $line->{ "status" . $line->{status
} } =
749 1; # fills a "statusX" value, used for template status select list
750 $line->{"publisheddate"} = format_date
( $line->{"publisheddate"} );
751 $line->{"planneddate"} = format_date
( $line->{"planneddate"} );
752 push @serials, $line;
754 # OK, now add the last 5 issues arrives/missing
756 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
758 WHERE subscriptionid = ?
759 AND (status in (2,4,5))
760 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
762 $sth = $dbh->prepare($query);
763 $sth->execute($subscriptionid);
764 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
766 $line->{ "status" . $line->{status
} } =
767 1; # fills a "statusX" value, used for template status select list
768 $line->{"planneddate"} = format_date
( $line->{"planneddate"} );
769 $line->{"publisheddate"} = format_date
( $line->{"publisheddate"} );
770 push @serials, $line;
773 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
774 $sth = $dbh->prepare($query);
775 $sth->execute($subscriptionid);
776 my ($totalissues) = $sth->fetchrow;
777 return ( $totalissues, @serials );
784 ($totalissues,@serials) = GetSerials2($subscriptionid,$status);
785 this function get every serial waited for a given subscription
786 as well as the number of issues registered in the database (all types)
787 this number is used to see if a subscription can be deleted (=it must have only 1 issue)
793 my ($subscription,$status) = @_;
794 my $dbh = C4
::Context
->dbh;
796 SELECT serialid
,serialseq
, status
, planneddate
, publisheddate
,notes
, routingnotes
798 WHERE subscriptionid
=$subscription AND status IN
($status)
799 ORDER BY publisheddate
,serialid DESC
802 my $sth=$dbh->prepare($query);
805 while(my $line = $sth->fetchrow_hashref) {
806 $line->{"status".$line->{status
}} = 1; # fills a "statusX" value, used for template status select list
807 $line->{"planneddate"} = format_date
($line->{"planneddate"});
808 $line->{"publisheddate"} = format_date
($line->{"publisheddate"});
811 my ($totalissues) = scalar(@serials);
812 return ($totalissues,@serials);
815 =head2 GetLatestSerials
819 \@serials = GetLatestSerials($subscriptionid,$limit)
820 get the $limit's latest serials arrived or missing for a given subscription
822 a ref to a table which it containts all of the latest serials stored into a hash.
828 sub GetLatestSerials
{
829 my ( $subscriptionid, $limit ) = @_;
830 my $dbh = C4
::Context
->dbh;
832 # status = 2 is "arrived"
833 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
835 WHERE subscriptionid = ?
836 AND (status =2 or status=4)
837 ORDER BY planneddate DESC LIMIT 0,$limit
839 my $sth = $dbh->prepare($strsth);
840 $sth->execute($subscriptionid);
842 while ( my $line = $sth->fetchrow_hashref ) {
843 $line->{ "status" . $line->{status
} } =
844 1; # fills a "statusX" value, used for template status select list
845 $line->{"planneddate"} = format_date
( $line->{"planneddate"} );
846 push @serials, $line;
852 # WHERE subscriptionid=?
854 # $sth=$dbh->prepare($query);
855 # $sth->execute($subscriptionid);
856 # my ($totalissues) = $sth->fetchrow;
860 =head2 GetDistributedTo
864 $distributedto=GetDistributedTo($subscriptionid)
865 This function select the old previous value of distributedto in the database.
871 sub GetDistributedTo
{
872 my $dbh = C4
::Context
->dbh;
874 my $subscriptionid = @_;
875 my $query = "SELECT distributedto FROM subscription WHERE subscriptionid=?";
876 my $sth = $dbh->prepare($query);
877 $sth->execute($subscriptionid);
878 return ($distributedto) = $sth->fetchrow;
886 $val is a hashref containing all the attributes of the table 'subscription'
887 This function get the next issue for the subscription given on input arg
889 all the input params updated.
897 # my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
898 # $calculated = $val->{numberingmethod};
899 # # calculate the (expected) value of the next issue recieved.
900 # $newlastvalue1 = $val->{lastvalue1};
901 # # check if we have to increase the new value.
902 # $newinnerloop1 = $val->{innerloop1}+1;
903 # $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
904 # $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
905 # $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
906 # $calculated =~ s/\{X\}/$newlastvalue1/g;
908 # $newlastvalue2 = $val->{lastvalue2};
909 # # check if we have to increase the new value.
910 # $newinnerloop2 = $val->{innerloop2}+1;
911 # $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
912 # $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
913 # $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
914 # $calculated =~ s/\{Y\}/$newlastvalue2/g;
916 # $newlastvalue3 = $val->{lastvalue3};
917 # # check if we have to increase the new value.
918 # $newinnerloop3 = $val->{innerloop3}+1;
919 # $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
920 # $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
921 # $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
922 # $calculated =~ s/\{Z\}/$newlastvalue3/g;
923 # return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
929 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
930 $newinnerloop1, $newinnerloop2, $newinnerloop3
932 my $pattern = $val->{numberpattern
};
933 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
934 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
935 $calculated = $val->{numberingmethod
};
936 $newlastvalue1 = $val->{lastvalue1
};
937 $newlastvalue2 = $val->{lastvalue2
};
938 $newlastvalue3 = $val->{lastvalue3
};
939 $newlastvalue1 = $val->{lastvalue1
};
940 # check if we have to increase the new value.
941 $newinnerloop1 = $val->{innerloop1
} + 1;
942 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1
});
943 $newlastvalue1 += $val->{add1
} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
944 $newlastvalue1=$val->{setto1
} if ($newlastvalue1>$val->{whenmorethan1
}); # reset counter if needed.
945 $calculated =~ s/\{X\}/$newlastvalue1/g;
947 $newlastvalue2 = $val->{lastvalue2
};
948 # check if we have to increase the new value.
949 $newinnerloop2 = $val->{innerloop2
} + 1;
950 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2
});
951 $newlastvalue2 += $val->{add2
} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
952 $newlastvalue2=$val->{setto2
} if ($newlastvalue2>$val->{whenmorethan2
}); # reset counter if needed.
953 if ( $pattern == 6 ) {
954 if ( $val->{hemisphere
} == 2 ) {
955 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
956 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
959 my $newlastvalue2seq = $seasons[$newlastvalue2];
960 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
964 $calculated =~ s/\{Y\}/$newlastvalue2/g;
968 $newlastvalue3 = $val->{lastvalue3
};
969 # check if we have to increase the new value.
970 $newinnerloop3 = $val->{innerloop3
} + 1;
971 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3
});
972 $newlastvalue3 += $val->{add3
} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
973 $newlastvalue3=$val->{setto3
} if ($newlastvalue3>$val->{whenmorethan3
}); # reset counter if needed.
974 $calculated =~ s/\{Z\}/$newlastvalue3/g;
976 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
977 $newinnerloop1, $newinnerloop2, $newinnerloop3);
984 $calculated = GetSeq($val)
985 $val is a hashref containing all the attributes of the table 'subscription'
986 this function transforms {X},{Y},{Z} to 150,0,0 for example.
988 the sequence in integer format
996 my $pattern = $val->{numberpattern
};
997 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
998 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
999 my $calculated = $val->{numberingmethod
};
1000 my $x = $val->{'lastvalue1'};
1001 $calculated =~ s/\{X\}/$x/g;
1002 my $newlastvalue2 = $val->{'lastvalue2'};
1003 if ( $pattern == 6 ) {
1004 if ( $val->{hemisphere
} == 2 ) {
1005 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
1006 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1009 my $newlastvalue2seq = $seasons[$newlastvalue2];
1010 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
1014 $calculated =~ s/\{Y\}/$newlastvalue2/g;
1016 my $z = $val->{'lastvalue3'};
1017 $calculated =~ s/\{Z\}/$z/g;
1021 =head2 GetExpirationDate
1023 $sensddate = GetExpirationDate($subscriptionid)
1025 this function return the expiration date for a subscription given on input args.
1032 sub GetExpirationDate
{
1033 my ($subscriptionid) = @_;
1034 my $dbh = C4
::Context
->dbh;
1035 my $subscription = GetSubscription
($subscriptionid);
1036 my $enddate = $subscription->{startdate
};
1038 # we don't do the same test if the subscription is based on X numbers or on X weeks/months
1039 if (($subscription->{periodicity
} % 16) >0){
1040 if ( $subscription->{numberlength
} ) {
1041 #calculate the date of the last issue.
1042 my $length = $subscription->{numberlength
};
1043 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1044 $enddate = GetNextDate
( $enddate, $subscription );
1047 elsif ( $subscription->{monthlength
} ){
1048 my @date=split (/-/,$subscription->{startdate
});
1049 my @enddate = Add_Delta_YM
($date[0],$date[1],$date[2],0,$subscription->{monthlength
});
1050 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1051 } elsif ( $subscription->{weeklength
} ){
1052 my @date=split (/-/,$subscription->{startdate
});
1053 my @enddate = Add_Delta_Days
($date[0],$date[1],$date[2],$subscription->{weeklength
}*7);
1054 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1062 =head2 CountSubscriptionFromBiblionumber
1066 $subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1067 this count the number of subscription for a biblionumber given.
1069 the number of subscriptions with biblionumber given on input arg.
1075 sub CountSubscriptionFromBiblionumber
{
1076 my ($biblionumber) = @_;
1077 my $dbh = C4
::Context
->dbh;
1078 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1079 my $sth = $dbh->prepare($query);
1080 $sth->execute($biblionumber);
1081 my $subscriptionsnumber = $sth->fetchrow;
1082 return $subscriptionsnumber;
1085 =head2 ModSubscriptionHistory
1089 ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1091 this function modify the history of a subscription. Put your new values on input arg.
1097 sub ModSubscriptionHistory
{
1099 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1100 $missinglist, $opacnote, $librariannote
1102 my $dbh = C4
::Context
->dbh;
1103 my $query = "UPDATE subscriptionhistory
1104 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1105 WHERE subscriptionid=?
1107 my $sth = $dbh->prepare($query);
1108 $recievedlist =~ s/^,//g;
1109 $missinglist =~ s/^,//g;
1110 $opacnote =~ s/^,//g;
1112 $histstartdate, $enddate, $recievedlist, $missinglist,
1113 $opacnote, $librariannote, $subscriptionid
1118 =head2 ModSerialStatus
1122 ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1124 This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1125 Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1131 sub ModSerialStatus
{
1132 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1135 #It is a usual serial
1136 # 1st, get previous status :
1137 my $dbh = C4
::Context
->dbh;
1138 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1139 my $sth = $dbh->prepare($query);
1140 $sth->execute($serialid);
1141 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1143 # change status & update subscriptionhistory
1145 if ( $status eq 6 ) {
1146 DelIssue
( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1150 "UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1151 $sth = $dbh->prepare($query);
1152 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1153 $notes, $serialid );
1154 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1155 $sth = $dbh->prepare($query);
1156 $sth->execute($subscriptionid);
1157 my $val = $sth->fetchrow_hashref;
1158 unless ( $val->{manualhistory
} ) {
1160 "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1161 $sth = $dbh->prepare($query);
1162 $sth->execute($subscriptionid);
1163 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1164 if ( $status eq 2 ) {
1166 # warn "receivedlist : $recievedlist serialseq :$serialseq, ".index("$recievedlist","$serialseq");
1167 $recievedlist .= ",$serialseq"
1168 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1171 # warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1172 $missinglist .= ",$serialseq"
1174 and not index( "$missinglist", "$serialseq" ) >= 0 );
1175 $missinglist .= ",not issued $serialseq"
1177 and index( "$missinglist", "$serialseq" ) >= 0 );
1179 "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1180 $sth = $dbh->prepare($query);
1181 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1185 # create new waited entry if needed (ie : was a "waited" and has changed)
1186 if ( $oldstatus eq 1 && $status ne 1 ) {
1187 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1188 $sth = $dbh->prepare($query);
1189 $sth->execute($subscriptionid);
1190 my $val = $sth->fetchrow_hashref;
1195 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1196 $newinnerloop1, $newinnerloop2, $newinnerloop3
1197 ) = GetNextSeq
($val);
1198 # warn "Next Seq End";
1200 # next date (calculated from actual date & frequency parameters)
1201 # warn "publisheddate :$publisheddate ";
1202 my $nextpublisheddate = GetNextDate
( $publisheddate, $val );
1203 NewIssue
( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1204 1, $nextpublisheddate, $nextpublisheddate );
1206 "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1207 WHERE subscriptionid = ?";
1208 $sth = $dbh->prepare($query);
1210 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1211 $newinnerloop2, $newinnerloop3, $subscriptionid
1214 # check if an alert must be sent... (= a letter is defined & status became "arrived"
1215 if ( $val->{letter
} && $status eq 2 && $oldstatus ne 2 ) {
1216 SendAlerts
( 'issue', $val->{subscriptionid
}, $val->{letter
} );
1221 =head2 ModSubscription
1225 this function modify a subscription. Put all new values on input args.
1231 sub ModSubscription
{
1233 $auser, $branchcode, $aqbooksellerid, $cost,
1234 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1235 $dow, $irregularity, $numberpattern, $numberlength,
1236 $weeklength, $monthlength, $add1, $every1,
1237 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1238 $add2, $every2, $whenmorethan2, $setto2,
1239 $lastvalue2, $innerloop2, $add3, $every3,
1240 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1241 $numberingmethod, $status, $biblionumber, $callnumber,
1242 $notes, $letter, $hemisphere, $manualhistory,
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=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?
1255 WHERE subscriptionid = ?";
1256 # warn "query :".$query;
1257 my $sth = $dbh->prepare($query);
1259 $auser, $branchcode, $aqbooksellerid, $cost,
1260 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1261 $dow, "$irregularity", $numberpattern, $numberlength,
1262 $weeklength, $monthlength, $add1, $every1,
1263 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1264 $add2, $every2, $whenmorethan2, $setto2,
1265 $lastvalue2, $innerloop2, $add3, $every3,
1266 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1267 $numberingmethod, $status, $biblionumber, $callnumber,
1268 $notes, $letter, $hemisphere, ($manualhistory?
$manualhistory:0),
1272 my $rows=$sth->rows;
1275 &logaction
(C4
::Context
->userenv->{'number'},"SERIAL","MODIFY",$subscriptionid,"")
1276 if C4
::Context
->preference("SubscriptionLog");
1280 =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)
1291 Create a new subscription with value given on input args.
1294 the id of this new subscription
1300 sub NewSubscription
{
1302 $auser, $branchcode, $aqbooksellerid, $cost,
1303 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1304 $dow, $numberlength, $weeklength, $monthlength,
1305 $add1, $every1, $whenmorethan1, $setto1,
1306 $lastvalue1, $innerloop1, $add2, $every2,
1307 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1308 $add3, $every3, $whenmorethan3, $setto3,
1309 $lastvalue3, $innerloop3, $numberingmethod, $status,
1310 $notes, $letter, $firstacquidate, $irregularity,
1311 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1314 my $dbh = C4
::Context
->dbh;
1316 #save subscription (insert into database)
1318 INSERT INTO subscription
1319 (librarian
,branchcode
,aqbooksellerid
,cost
,aqbudgetid
,biblionumber
,
1320 startdate
,periodicity
,dow
,numberlength
,weeklength
,monthlength
,
1321 add1
,every1
,whenmorethan1
,setto1
,lastvalue1
,innerloop1
,
1322 add2
,every2
,whenmorethan2
,setto2
,lastvalue2
,innerloop2
,
1323 add3
,every3
,whenmorethan3
,setto3
,lastvalue3
,innerloop3
,
1324 numberingmethod
, status
, notes
, letter
,firstacquidate
,irregularity
,
1325 numberpattern
, callnumber
, hemisphere
,manualhistory
,internalnotes
)
1326 VALUES
(?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
,?
)
1328 my $sth = $dbh->prepare($query);
1330 $auser, $branchcode,
1331 $aqbooksellerid, $cost,
1332 $aqbudgetid, $biblionumber,
1333 format_date_in_iso
($startdate), $periodicity,
1334 $dow, $numberlength,
1335 $weeklength, $monthlength,
1337 $whenmorethan1, $setto1,
1338 $lastvalue1, $innerloop1,
1340 $whenmorethan2, $setto2,
1341 $lastvalue2, $innerloop2,
1343 $whenmorethan3, $setto3,
1344 $lastvalue3, $innerloop3,
1345 $numberingmethod, "$status",
1347 format_date_in_iso
($firstacquidate), $irregularity,
1348 $numberpattern, $callnumber,
1349 $hemisphere, $manualhistory,
1353 #then create the 1st waited number
1354 my $subscriptionid = $dbh->{'mysql_insertid'};
1356 INSERT INTO subscriptionhistory
1357 (biblionumber
, subscriptionid
, histstartdate
, opacnote
, librariannote
)
1358 VALUES
(?
,?
,?
,?
,?
,?
,?
,?
)
1360 $sth = $dbh->prepare($query);
1361 $sth->execute( $biblionumber, $subscriptionid,
1362 format_date_in_iso
($startdate),
1363 $notes,$internalnotes );
1365 # reread subscription to get a hash (for calculation of the 1st issue number)
1369 WHERE subscriptionid
= ?
1371 $sth = $dbh->prepare($query);
1372 $sth->execute($subscriptionid);
1373 my $val = $sth->fetchrow_hashref;
1375 # calculate issue number
1376 my $serialseq = GetSeq
($val);
1379 (serialseq
,subscriptionid
,biblionumber
,status
, planneddate
, publisheddate
)
1380 VALUES
(?
,?
,?
,?
,?
,?
)
1382 $sth = $dbh->prepare($query);
1384 "$serialseq", $subscriptionid, $biblionumber, 1,
1385 format_date_in_iso
($startdate),
1386 format_date_in_iso
($startdate)
1389 &logaction
(C4
::Context
->userenv->{'number'},"SERIAL","ADD",$subscriptionid,"")
1390 if C4
::Context
->preference("SubscriptionLog");
1392 #set serial flag on biblio if not already set.
1393 my ($null, ($bib)) = GetBiblio
($biblionumber);
1394 if( ! $bib->{'serial'} ) {
1395 my $record = GetMarcBiblio
($biblionumber);
1396 my ($tag,$subf) = GetMarcFromKohaField
('biblio.serial',$bib->{'frameworkcode'});
1398 $record->field($tag)->update( $subf => 1 );
1400 ModBiblio
($record,$biblionumber,$bib->{'frameworkcode'});
1402 return $subscriptionid;
1405 =head2 ReNewSubscription
1409 ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1411 this function renew a subscription with values given on input args.
1417 sub ReNewSubscription
{
1418 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1419 $monthlength, $note )
1421 my $dbh = C4
::Context
->dbh;
1422 my $subscription = GetSubscription
($subscriptionid);
1426 LEFT JOIN biblioitems ON biblio
.biblionumber
=biblioitems
.biblionumber
1427 WHERE biblio
.biblionumber
=?
1429 my $sth = $dbh->prepare($query);
1430 $sth->execute( $subscription->{biblionumber
} );
1431 my $biblio = $sth->fetchrow_hashref;
1433 $user, $subscription->{bibliotitle
},
1434 $biblio->{author
}, $biblio->{publishercode
},
1435 $biblio->{note
}, '',
1438 $subscription->{biblionumber
}
1441 # renew subscription
1444 SET startdate
=?
,numberlength
=?
,weeklength
=?
,monthlength
=?
1445 WHERE subscriptionid
=?
1447 $sth = $dbh->prepare($query);
1448 $sth->execute( format_date_in_iso
($startdate),
1449 $numberlength, $weeklength, $monthlength, $subscriptionid );
1451 &logaction
(C4
::Context
->userenv->{'number'},"SERIAL","RENEW",$subscriptionid,"")
1452 if C4
::Context
->preference("SubscriptionLog");
1459 NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1461 Create a new issue stored on the database.
1462 Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1469 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1470 $planneddate, $publisheddate, $notes )
1472 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1474 my $dbh = C4
::Context
->dbh;
1477 (serialseq
,subscriptionid
,biblionumber
,status
,publisheddate
,planneddate
,notes
)
1478 VALUES
(?
,?
,?
,?
,?
,?
,?
)
1480 my $sth = $dbh->prepare($query);
1481 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1482 $publisheddate, $planneddate,$notes );
1483 my $serialid=$dbh->{'mysql_insertid'};
1485 SELECT missinglist
,recievedlist
1486 FROM subscriptionhistory
1487 WHERE subscriptionid
=?
1489 $sth = $dbh->prepare($query);
1490 $sth->execute($subscriptionid);
1491 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1493 if ( $status eq 2 ) {
1494 ### TODO Add a feature that improves recognition and description.
1495 ### As such count (serialseq) i.e. : N18,2(N19),N20
1496 ### Would use substr and index But be careful to previous presence of ()
1497 $recievedlist .= ",$serialseq" unless (index($recievedlist,$serialseq)>0);
1499 if ( $status eq 4 ) {
1500 $missinglist .= ",$serialseq" unless (index($missinglist,$serialseq)>0);
1503 UPDATE subscriptionhistory
1504 SET recievedlist
=?
, missinglist
=?
1505 WHERE subscriptionid
=?
1507 $sth = $dbh->prepare($query);
1508 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1512 =head2 ItemizeSerials
1516 ItemizeSerials($serialid, $info);
1517 $info is a hashref containing barcode branch, itemcallnumber, status, location
1518 $serialid the serialid
1520 1 if the itemize is a succes.
1521 0 and @error else. @error containts the list of errors found.
1527 sub ItemizeSerials
{
1528 my ( $serialid, $info ) = @_;
1529 my $now = POSIX
::strftime
( "%Y-%m-%d",localtime );
1531 my $dbh = C4
::Context
->dbh;
1537 my $sth = $dbh->prepare($query);
1538 $sth->execute($serialid);
1539 my $data = $sth->fetchrow_hashref;
1540 if ( C4
::Context
->preference("RoutingSerials") ) {
1542 # check for existing biblioitem relating to serial issue
1543 my ( $count, @results ) =
1544 GetBiblioItemByBiblioNumber
( $data->{'biblionumber'} );
1546 for ( my $i = 0 ; $i < $count ; $i++ ) {
1547 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1548 . $data->{'planneddate'}
1551 $bibitemno = $results[$i]->{'biblioitemnumber'};
1555 if ( $bibitemno == 0 ) {
1557 # warn "need to add new biblioitem so copy last one and make minor changes";
1560 "SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1562 $sth->execute( $data->{'biblionumber'} );
1563 my $biblioitem = $sth->fetchrow_hashref;
1564 $biblioitem->{'volumedate'} =
1565 format_date_in_iso
( $data->{planneddate
} );
1566 $biblioitem->{'volumeddesc'} =
1567 $data->{serialseq
} . ' ('
1568 . format_date
( $data->{'planneddate'} ) . ')';
1569 $biblioitem->{'dewey'} = $info->{itemcallnumber
};
1571 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1572 # so I comment it, we can speak of it when you want
1573 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1574 # if ( $info->{barcode} )
1575 # { # only make biblioitem if we are going to make item also
1576 # $bibitemno = newbiblioitem($biblioitem);
1581 my $fwk = GetFrameworkCode
( $data->{'biblionumber'} );
1582 if ( $info->{barcode
} ) {
1584 my $exists = itemdata
( $info->{'barcode'} );
1585 push @errors, "barcode_not_unique" if ($exists);
1587 my $marcrecord = MARC
::Record
->new();
1588 my ( $tag, $subfield ) =
1589 GetMarcFromKohaField
( "items.barcode", $fwk );
1591 MARC
::Field
->new( "$tag", '', '',
1592 "$subfield" => $info->{barcode
} );
1593 $marcrecord->insert_fields_ordered($newField);
1594 if ( $info->{branch
} ) {
1595 my ( $tag, $subfield ) =
1596 GetMarcFromKohaField
( "items.homebranch",
1599 #warn "items.homebranch : $tag , $subfield";
1600 if ( $marcrecord->field($tag) ) {
1601 $marcrecord->field($tag)
1602 ->add_subfields( "$subfield" => $info->{branch
} );
1606 MARC
::Field
->new( "$tag", '', '',
1607 "$subfield" => $info->{branch
} );
1608 $marcrecord->insert_fields_ordered($newField);
1610 ( $tag, $subfield ) =
1611 GetMarcFromKohaField
( "items.holdingbranch",
1614 #warn "items.holdingbranch : $tag , $subfield";
1615 if ( $marcrecord->field($tag) ) {
1616 $marcrecord->field($tag)
1617 ->add_subfields( "$subfield" => $info->{branch
} );
1621 MARC
::Field
->new( "$tag", '', '',
1622 "$subfield" => $info->{branch
} );
1623 $marcrecord->insert_fields_ordered($newField);
1626 if ( $info->{itemcallnumber
} ) {
1627 my ( $tag, $subfield ) =
1628 GetMarcFromKohaField
( "items.itemcallnumber",
1631 #warn "items.itemcallnumber : $tag , $subfield";
1632 if ( $marcrecord->field($tag) ) {
1633 $marcrecord->field($tag)
1634 ->add_subfields( "$subfield" => $info->{itemcallnumber
} );
1638 MARC
::Field
->new( "$tag", '', '',
1639 "$subfield" => $info->{itemcallnumber
} );
1640 $marcrecord->insert_fields_ordered($newField);
1643 if ( $info->{notes
} ) {
1644 my ( $tag, $subfield ) =
1645 GetMarcFromKohaField
( "items.itemnotes", $fwk );
1647 # warn "items.itemnotes : $tag , $subfield";
1648 if ( $marcrecord->field($tag) ) {
1649 $marcrecord->field($tag)
1650 ->add_subfields( "$subfield" => $info->{notes
} );
1654 MARC
::Field
->new( "$tag", '', '',
1655 "$subfield" => $info->{notes
} );
1656 $marcrecord->insert_fields_ordered($newField);
1659 if ( $info->{location
} ) {
1660 my ( $tag, $subfield ) =
1661 GetMarcFromKohaField
( "items.location", $fwk );
1663 # warn "items.location : $tag , $subfield";
1664 if ( $marcrecord->field($tag) ) {
1665 $marcrecord->field($tag)
1666 ->add_subfields( "$subfield" => $info->{location
} );
1670 MARC
::Field
->new( "$tag", '', '',
1671 "$subfield" => $info->{location
} );
1672 $marcrecord->insert_fields_ordered($newField);
1675 if ( $info->{status
} ) {
1676 my ( $tag, $subfield ) =
1677 GetMarcFromKohaField
( "items.notforloan",
1680 # warn "items.notforloan : $tag , $subfield";
1681 if ( $marcrecord->field($tag) ) {
1682 $marcrecord->field($tag)
1683 ->add_subfields( "$subfield" => $info->{status
} );
1687 MARC
::Field
->new( "$tag", '', '',
1688 "$subfield" => $info->{status
} );
1689 $marcrecord->insert_fields_ordered($newField);
1692 if ( C4
::Context
->preference("RoutingSerials") ) {
1693 my ( $tag, $subfield ) =
1694 GetMarcFromKohaField
( "items.dateaccessioned",
1696 if ( $marcrecord->field($tag) ) {
1697 $marcrecord->field($tag)
1698 ->add_subfields( "$subfield" => $now );
1702 MARC
::Field
->new( "$tag", '', '', "$subfield" => $now );
1703 $marcrecord->insert_fields_ordered($newField);
1706 AddItemFromMarc
( $marcrecord, $data->{'biblionumber'} );
1709 return ( 0, @errors );
1713 =head2 HasSubscriptionExpired
1717 1 or 0 = HasSubscriptionExpired($subscriptionid)
1719 the subscription has expired when the next issue to arrive is out of subscription limit.
1722 1 if true, 0 if false.
1728 sub HasSubscriptionExpired
{
1729 my ($subscriptionid) = @_;
1730 my $dbh = C4
::Context
->dbh;
1731 my $subscription = GetSubscription
($subscriptionid);
1732 if (($subscription->{periodicity
} % 16)>0){
1733 my $expirationdate = GetExpirationDate
($subscriptionid);
1735 SELECT max
(planneddate
)
1737 WHERE subscriptionid
=?
1739 my $sth = $dbh->prepare($query);
1740 $sth->execute($subscriptionid);
1741 my ($res) = $sth->fetchrow ;
1742 my @res=split (/-/,$res);
1743 # warn "date expiration :$expirationdate";
1744 my @endofsubscriptiondate=split(/-/,$expirationdate);
1745 return 1 if ( (@endofsubscriptiondate && Delta_Days
($res[0],$res[1],$res[2],
1746 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1750 if ($subscription->{'numberlength'}){
1751 my $countreceived=countissuesfrom
($subscriptionid,$subscription->{'startdate'});
1752 return 1 if ($countreceived >$subscription->{'numberlentgh'});
1761 =head2 SetDistributedto
1765 SetDistributedto($distributedto,$subscriptionid);
1766 This function update the value of distributedto for a subscription given on input arg.
1772 sub SetDistributedto
{
1773 my ( $distributedto, $subscriptionid ) = @_;
1774 my $dbh = C4
::Context
->dbh;
1778 WHERE subscriptionid
=?
1780 my $sth = $dbh->prepare($query);
1781 $sth->execute( $distributedto, $subscriptionid );
1784 =head2 DelSubscription
1788 DelSubscription($subscriptionid)
1789 this function delete the subscription which has $subscriptionid as id.
1795 sub DelSubscription
{
1796 my ($subscriptionid) = @_;
1797 my $dbh = C4
::Context
->dbh;
1798 $subscriptionid = $dbh->quote($subscriptionid);
1799 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1801 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1802 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1804 &logaction
(C4
::Context
->userenv->{'number'},"SERIAL","DELETE",$subscriptionid,"")
1805 if C4
::Context
->preference("SubscriptionLog");
1812 DelIssue($serialseq,$subscriptionid)
1813 this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1820 my ( $dataissue) = @_;
1821 my $dbh = C4
::Context
->dbh;
1822 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1827 AND subscriptionid
= ?
1829 my $mainsth = $dbh->prepare($query);
1830 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1832 #Delete element from subscription history
1833 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1834 my $sth = $dbh->prepare($query);
1835 $sth->execute($dataissue->{'subscriptionid'});
1836 my $val = $sth->fetchrow_hashref;
1837 unless ( $val->{manualhistory
} ) {
1839 SELECT
* FROM subscriptionhistory
1840 WHERE subscriptionid
= ?
1842 my $sth = $dbh->prepare($query);
1843 $sth->execute($dataissue->{'subscriptionid'});
1844 my $data = $sth->fetchrow_hashref;
1845 my $serialseq= $dataissue->{'serialseq'};
1846 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1847 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1848 my $strsth = "UPDATE subscriptionhistory SET "
1850 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1851 . " WHERE subscriptionid=?";
1852 $sth = $dbh->prepare($strsth);
1853 $sth->execute($dataissue->{'subscriptionid'});
1856 return $mainsth->rows;
1859 =head2 GetLateOrMissingIssues
1863 ($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1865 this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1868 a count of the number of missing issues
1869 the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1870 name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1876 sub GetLateOrMissingIssues
{
1877 my ( $supplierid, $serialid,$order ) = @_;
1878 my $dbh = C4
::Context
->dbh;
1882 $byserial = "and serialid = " . $serialid;
1890 $sth = $dbh->prepare(
1899 serial.subscriptionid,
1902 LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1903 LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1904 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1905 WHERE subscription.subscriptionid = serial.subscriptionid
1906 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1907 AND subscription.aqbooksellerid=$supplierid
1913 $sth = $dbh->prepare(
1922 serial.subscriptionid,
1925 LEFT JOIN subscription
1926 ON serial.subscriptionid=subscription.subscriptionid
1928 ON subscription.biblionumber=biblio.biblionumber
1929 LEFT JOIN aqbooksellers
1930 ON subscription.aqbooksellerid = aqbooksellers.id
1932 subscription.subscriptionid = serial.subscriptionid
1933 AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1943 while ( my $line = $sth->fetchrow_hashref ) {
1944 $odd++ unless $line->{title
} eq $last_title;
1945 $last_title = $line->{title
} if ( $line->{title
} );
1946 $line->{planneddate
} = format_date
( $line->{planneddate
} );
1947 $line->{claimdate
} = format_date
( $line->{claimdate
} );
1948 $line->{"status".$line->{status
}} = 1;
1949 $line->{'odd'} = 1 if $odd % 2;
1951 push @issuelist, $line;
1953 return $count, @issuelist;
1956 =head2 removeMissingIssue
1960 removeMissingIssue($subscriptionid)
1962 this function removes an issue from being part of the missing string in
1963 subscriptionlist.missinglist column
1965 called when a missing issue is found from the serials-recieve.pl file
1971 sub removeMissingIssue
{
1972 my ( $sequence, $subscriptionid ) = @_;
1973 my $dbh = C4
::Context
->dbh;
1976 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
1977 $sth->execute($subscriptionid);
1978 my $data = $sth->fetchrow_hashref;
1979 my $missinglist = $data->{'missinglist'};
1980 my $missinglistbefore = $missinglist;
1982 # warn $missinglist." before";
1983 $missinglist =~ s/($sequence)//;
1985 # warn $missinglist." after";
1986 if ( $missinglist ne $missinglistbefore ) {
1987 $missinglist =~ s/\|\s\|/\|/g;
1988 $missinglist =~ s/^\| //g;
1989 $missinglist =~ s/\|$//g;
1990 my $sth2 = $dbh->prepare(
1991 "UPDATE subscriptionhistory
1993 WHERE subscriptionid = ?"
1995 $sth2->execute( $missinglist, $subscriptionid );
2003 &updateClaim($serialid)
2005 this function updates the time when a claim is issued for late/missing items
2007 called from claims.pl file
2014 my ($serialid) = @_;
2015 my $dbh = C4
::Context
->dbh;
2016 my $sth = $dbh->prepare(
2017 "UPDATE serial SET claimdate = now()
2021 $sth->execute($serialid);
2024 =head2 getsupplierbyserialid
2028 ($result) = &getsupplierbyserialid($serialid)
2030 this function is used to find the supplier id given a serial id
2033 hashref containing serialid, subscriptionid, and aqbooksellerid
2039 sub getsupplierbyserialid
{
2040 my ($serialid) = @_;
2041 my $dbh = C4
::Context
->dbh;
2042 my $sth = $dbh->prepare(
2043 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2045 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2049 $sth->execute($serialid);
2050 my $line = $sth->fetchrow_hashref;
2051 my $result = $line->{'aqbooksellerid'};
2055 =head2 check_routing
2059 ($result) = &check_routing($subscriptionid)
2061 this function checks to see if a serial has a routing list and returns the count of routingid
2062 used to show either an 'add' or 'edit' link
2068 my ($subscriptionid) = @_;
2069 my $dbh = C4
::Context
->dbh;
2070 my $sth = $dbh->prepare(
2071 "SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2072 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2073 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2076 $sth->execute($subscriptionid);
2077 my $line = $sth->fetchrow_hashref;
2078 my $result = $line->{'routingids'};
2082 =head2 addroutingmember
2086 &addroutingmember($borrowernumber,$subscriptionid)
2088 this function takes a borrowernumber and subscriptionid and add the member to the
2089 routing list for that serial subscription and gives them a rank on the list
2090 of either 1 or highest current rank + 1
2096 sub addroutingmember
{
2097 my ( $borrowernumber, $subscriptionid ) = @_;
2099 my $dbh = C4
::Context
->dbh;
2102 "SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2104 $sth->execute($subscriptionid);
2105 while ( my $line = $sth->fetchrow_hashref ) {
2106 if ( $line->{'rank'} > 0 ) {
2107 $rank = $line->{'rank'} + 1;
2115 "INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2117 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2120 =head2 reorder_members
2124 &reorder_members($subscriptionid,$routingid,$rank)
2126 this function is used to reorder the routing list
2128 it takes the routingid of the member one wants to re-rank and the rank it is to move to
2129 - it gets all members on list puts their routingid's into an array
2130 - removes the one in the array that is $routingid
2131 - then reinjects $routingid at point indicated by $rank
2132 - then update the database with the routingids in the new order
2138 sub reorder_members
{
2139 my ( $subscriptionid, $routingid, $rank ) = @_;
2140 my $dbh = C4
::Context
->dbh;
2143 "SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2145 $sth->execute($subscriptionid);
2147 while ( my $line = $sth->fetchrow_hashref ) {
2148 push( @result, $line->{'routingid'} );
2151 # To find the matching index
2153 my $key = -1; # to allow for 0 being a valid response
2154 for ( $i = 0 ; $i < @result ; $i++ ) {
2155 if ( $routingid == $result[$i] ) {
2156 $key = $i; # save the index
2161 # if index exists in array then move it to new position
2162 if ( $key > -1 && $rank > 0 ) {
2163 my $new_rank = $rank -
2164 1; # $new_rank is what you want the new index to be in the array
2165 my $moving_item = splice( @result, $key, 1 );
2166 splice( @result, $new_rank, 0, $moving_item );
2168 for ( my $j = 0 ; $j < @result ; $j++ ) {
2170 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2172 . "' WHERE routingid = '"
2179 =head2 delroutingmember
2183 &delroutingmember($routingid,$subscriptionid)
2185 this function either deletes one member from routing list if $routingid exists otherwise
2186 deletes all members from the routing list
2192 sub delroutingmember
{
2194 # if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2195 my ( $routingid, $subscriptionid ) = @_;
2196 my $dbh = C4
::Context
->dbh;
2200 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2201 $sth->execute($routingid);
2202 reorder_members
( $subscriptionid, $routingid );
2207 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2208 $sth->execute($subscriptionid);
2212 =head2 getroutinglist
2216 ($count,@routinglist) = &getroutinglist($subscriptionid)
2218 this gets the info from the subscriptionroutinglist for $subscriptionid
2221 a count of the number of members on routinglist
2222 the routinglist into a table. Each line of this table containts a ref to a hash which containts
2223 routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2229 sub getroutinglist
{
2230 my ($subscriptionid) = @_;
2231 my $dbh = C4
::Context
->dbh;
2232 my $sth = $dbh->prepare(
2233 "SELECT routingid, borrowernumber,
2234 ranking, biblionumber
2236 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2237 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2240 $sth->execute($subscriptionid);
2243 while ( my $line = $sth->fetchrow_hashref ) {
2245 push( @routinglist, $line );
2247 return ( $count, @routinglist );
2250 =head2 countissuesfrom
2254 $result = &countissuesfrom($subscriptionid,$startdate)
2261 sub countissuesfrom
{
2262 my ($subscriptionid,$startdate) = @_;
2263 my $dbh = C4
::Context
->dbh;
2267 WHERE subscriptionid
=?
2268 AND serial
.publisheddate
>?
2270 my $sth=$dbh->prepare($query);
2271 $sth->execute($subscriptionid, $startdate);
2272 my ($countreceived)=$sth->fetchrow;
2273 return $countreceived;
2276 =head2 abouttoexpire
2280 $result = &abouttoexpire($subscriptionid)
2282 this function alerts you to the penultimate issue for a serial subscription
2284 returns 1 - if this is the penultimate issue
2292 my ($subscriptionid) = @_;
2293 my $dbh = C4
::Context
->dbh;
2294 my $subscription = GetSubscription
($subscriptionid);
2295 my $per = $subscription->{'periodicity'};
2297 my $expirationdate = GetExpirationDate
($subscriptionid);
2300 "select max(planneddate) from serial where subscriptionid=?");
2301 $sth->execute($subscriptionid);
2302 my ($res) = $sth->fetchrow ;
2303 # warn "date expiration : ".$expirationdate." date courante ".$res;
2304 my @res=split /-/,$res;
2305 @res=Date
::Calc
::Today
if ($res[0]*$res[1]==0);
2306 my @endofsubscriptiondate=split/-/,$expirationdate;
2308 if ( $per == 1 ) {$x=7;}
2309 if ( $per == 2 ) {$x=7; }
2310 if ( $per == 3 ) {$x=14;}
2311 if ( $per == 4 ) { $x = 21; }
2312 if ( $per == 5 ) { $x = 31; }
2313 if ( $per == 6 ) { $x = 62; }
2314 if ( $per == 7 || $per == 8 ) { $x = 93; }
2315 if ( $per == 9 ) { $x = 190; }
2316 if ( $per == 10 ) { $x = 365; }
2317 if ( $per == 11 ) { $x = 730; }
2318 my @datebeforeend=Add_Delta_Days
( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2319 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2320 # warn "DATE BEFORE END: $datebeforeend";
2321 return 1 if ( @res &&
2323 Delta_Days
($res[0],$res[1],$res[2],
2324 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2325 (@endofsubscriptiondate &&
2326 Delta_Days
($res[0],$res[1],$res[2],
2327 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2329 } elsif ($subscription->{numberlength
}>0) {
2330 return (countissuesfrom
($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength
}-1);
2334 =head2 old_newsubscription
2338 ($subscriptionid) = &old_newsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2339 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2340 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2341 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2342 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2343 $numberingmethod, $status, $callnumber, $notes, $hemisphere)
2345 this function is similar to the NewSubscription subroutine but has a few different
2347 $firstacquidate - date of first serial issue to arrive
2348 $irregularity - the issues not expected separated by a '|'
2349 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2350 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2351 subscription-add.tmpl file
2352 $callnumber - display the callnumber of the serial
2353 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2356 the $subscriptionid number of the new subscription
2362 sub old_newsubscription
{
2364 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2365 $biblionumber, $startdate, $periodicity, $firstacquidate,
2366 $dow, $irregularity, $numberpattern, $numberlength,
2367 $weeklength, $monthlength, $add1, $every1,
2368 $whenmorethan1, $setto1, $lastvalue1, $add2,
2369 $every2, $whenmorethan2, $setto2, $lastvalue2,
2370 $add3, $every3, $whenmorethan3, $setto3,
2371 $lastvalue3, $numberingmethod, $status, $callnumber,
2374 my $dbh = C4
::Context
->dbh;
2377 my $sth = $dbh->prepare(
2378 "insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
2379 startdate,periodicity,firstacquidate,dow,irregularity,numberpattern,numberlength,weeklength,monthlength,
2380 add1,every1,whenmorethan1,setto1,lastvalue1,
2381 add2,every2,whenmorethan2,setto2,lastvalue2,
2382 add3,every3,whenmorethan3,setto3,lastvalue3,
2383 numberingmethod, status, callnumber, notes, hemisphere) values
2384 (?,?,?,?,?,?,?,?,?,?,?,
2385 ?,?,?,?,?,?,?,?,?,?,?,
2386 ?,?,?,?,?,?,?,?,?,?,?,?)"
2389 $auser, $aqbooksellerid,
2391 $biblionumber, format_date_in_iso
($startdate),
2392 $periodicity, format_date_in_iso
($firstacquidate),
2393 $dow, $irregularity,
2394 $numberpattern, $numberlength,
2395 $weeklength, $monthlength,
2397 $whenmorethan1, $setto1,
2399 $every2, $whenmorethan2,
2400 $setto2, $lastvalue2,
2402 $whenmorethan3, $setto3,
2403 $lastvalue3, $numberingmethod,
2404 $status, $callnumber,
2408 #then create the 1st waited number
2409 my $subscriptionid = $dbh->{'mysql_insertid'};
2410 my $enddate = GetExpirationDate
($subscriptionid);
2414 "insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)"
2417 $biblionumber, $subscriptionid,
2418 format_date_in_iso
($startdate),
2419 format_date_in_iso
($enddate),
2423 # reread subscription to get a hash (for calculation of the 1st issue number)
2425 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2426 $sth->execute($subscriptionid);
2427 my $val = $sth->fetchrow_hashref;
2429 # calculate issue number
2430 my $serialseq = GetSeq
($val);
2433 "insert into serial (serialseq,subscriptionid,biblionumber,status, planneddate) values (?,?,?,?,?)"
2435 $sth->execute( $serialseq, $subscriptionid, $val->{'biblionumber'},
2436 1, format_date_in_iso
($startdate) );
2437 return $subscriptionid;
2440 =head2 old_modsubscription
2444 ($subscriptionid) = &old_modsubscription($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
2445 $startdate,$periodicity,$firstacquidate,$dow,$irregularity,$numberpattern,$numberlength,$weeklength,$monthlength,
2446 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
2447 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
2448 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
2449 $numberingmethod, $status, $callnumber, $notes, $hemisphere, $subscriptionid)
2451 this function is similar to the ModSubscription subroutine but has a few different
2453 $firstacquidate - date of first serial issue to arrive
2454 $irregularity - the issues not expected separated by a '|'
2455 - eg. monthly issue but not expecting issue for june and july would have $irregularity of '6|7'
2456 $numberpattern - the number for an array of labels to reconstruct the javascript correctly in the
2457 subscription-add.tmpl file
2458 $callnumber - display the callnumber of the serial
2459 $hemisphere - either 2 = southern hemisphere or 1 = northern hemisphere - used for quarterly serials
2465 sub old_modsubscription
{
2467 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2468 $startdate, $periodicity, $firstacquidate, $dow,
2469 $irregularity, $numberpattern, $numberlength, $weeklength,
2470 $monthlength, $add1, $every1, $whenmorethan1,
2471 $setto1, $lastvalue1, $innerloop1, $add2,
2472 $every2, $whenmorethan2, $setto2, $lastvalue2,
2473 $innerloop2, $add3, $every3, $whenmorethan3,
2474 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2475 $status, $biblionumber, $callnumber, $notes,
2476 $hemisphere, $subscriptionid
2478 my $dbh = C4
::Context
->dbh;
2479 my $sth = $dbh->prepare(
2480 "update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
2481 periodicity=?,firstacquidate=?,dow=?,irregularity=?,numberpattern=?,numberlength=?,weeklength=?,monthlength=?,
2482 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
2483 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
2484 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
2485 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, hemisphere=? where subscriptionid = ?"
2488 $auser, $aqbooksellerid, $cost, $aqbudgetid,
2489 $startdate, $periodicity, $firstacquidate, $dow,
2490 $irregularity, $numberpattern, $numberlength, $weeklength,
2491 $monthlength, $add1, $every1, $whenmorethan1,
2492 $setto1, $lastvalue1, $innerloop1, $add2,
2493 $every2, $whenmorethan2, $setto2, $lastvalue2,
2494 $innerloop2, $add3, $every3, $whenmorethan3,
2495 $setto3, $lastvalue3, $innerloop3, $numberingmethod,
2496 $status, $biblionumber, $callnumber, $notes,
2497 $hemisphere, $subscriptionid
2502 $dbh->prepare("select * from subscription where subscriptionid = ? ");
2503 $sth->execute($subscriptionid);
2504 my $val = $sth->fetchrow_hashref;
2506 # calculate issue number
2507 my $serialseq = Get_Seq
($val);
2509 $dbh->prepare("UPDATE serial SET serialseq = ? WHERE subscriptionid = ?");
2510 $sth->execute( $serialseq, $subscriptionid );
2512 my $enddate = subscriptionexpirationdate
($subscriptionid);
2513 $sth = $dbh->prepare("update subscriptionhistory set enddate=?");
2514 $sth->execute( format_date_in_iso
($enddate) );
2517 =head2 old_getserials
2521 ($totalissues,@serials) = &old_getserials($subscriptionid)
2523 this function get a hashref of serials and the total count of them
2526 $totalissues - number of serial lines
2527 the serials into a table. Each line of this table containts a ref to a hash which it containts
2528 serialid, serialseq, status,planneddate,notes,routingnotes from tables : serial where status is not 2, 4, or 5
2534 sub old_getserials
{
2535 my ($subscriptionid) = @_;
2536 my $dbh = C4
::Context
->dbh;
2538 # status = 2 is "arrived"
2541 "select serialid,serialseq, status, planneddate,notes,routingnotes from serial where subscriptionid = ? and status <>2 and status <>4 and status <>5"
2543 $sth->execute($subscriptionid);
2546 while ( my $line = $sth->fetchrow_hashref ) {
2547 $line->{ "status" . $line->{status
} } =
2548 1; # fills a "statusX" value, used for template status select list
2549 $line->{"planneddate"} = format_date
( $line->{"planneddate"} );
2550 $line->{"num"} = $num;
2552 push @serials, $line;
2554 $sth = $dbh->prepare("select count(*) from serial where subscriptionid=?");
2555 $sth->execute($subscriptionid);
2556 my ($totalissues) = $sth->fetchrow;
2557 return ( $totalissues, @serials );
2562 ($resultdate) = &GetNextDate($planneddate,$subscription)
2564 this function is an extension of GetNextDate which allows for checking for irregularity
2566 it takes the planneddate and will return the next issue's date and will skip dates if there
2567 exists an irregularity
2568 - eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2569 skipped then the returned date will be 2007-05-10
2572 $resultdate - then next date in the sequence
2574 Return 0 if periodicity==0
2577 sub in_array
{ # used in next sub down
2578 my ($val,@elements) = @_;
2579 foreach my $elem(@elements) {
2587 sub GetNextDate
(@
) {
2588 my ( $planneddate, $subscription ) = @_;
2589 my @irreg = split( /\,/, $subscription->{irregularity
} );
2591 #date supposed to be in ISO.
2593 my ( $year, $month, $day ) = split(/-/, $planneddate);
2594 $month=1 unless ($month);
2595 $day=1 unless ($day);
2598 # warn "DOW $dayofweek";
2599 if ( $subscription->{periodicity
} % 16 == 0 ) {
2602 if ( $subscription->{periodicity
} == 1 ) {
2603 my $dayofweek = eval{Day_of_Week
( $year,$month, $day )};
2604 if ($@
){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2606 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2607 $dayofweek = 0 if ( $dayofweek == 7 );
2608 if ( in_array
( ($dayofweek + 1), @irreg ) ) {
2609 ($year,$month,$day) = Add_Delta_Days
($year,$month, $day , 1 );
2613 @resultdate = Add_Delta_Days
($year,$month, $day , 1 );
2616 if ( $subscription->{periodicity
} == 2 ) {
2617 my ($wkno,$year) = eval {Week_of_Year
( $year,$month, $day )};
2618 if ($@
){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2620 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2621 if ( $irreg[$i] == (($wkno!=51)?
($wkno +1) % 52 :52)) {
2622 ($year,$month,$day) = Add_Delta_Days
($year,$month, $day , 7 );
2623 $wkno=(($wkno!=51)?
($wkno +1) % 52 :52);
2626 @resultdate = Add_Delta_Days
( $year,$month, $day, 7);
2629 if ( $subscription->{periodicity
} == 3 ) {
2630 my ($wkno,$year) = eval {Week_of_Year
( $year,$month, $day )};
2631 if ($@
){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2633 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2634 if ( $irreg[$i] == (($wkno!=50)?
($wkno +2) % 52 :52)) {
2635 ### BUGFIX was previously +1 ^
2636 ($year,$month,$day) = Add_Delta_Days
($year,$month, $day , 14 );
2637 $wkno=(($wkno!=50)?
($wkno +2) % 52 :52);
2640 @resultdate = Add_Delta_Days
($year,$month, $day , 14 );
2643 if ( $subscription->{periodicity
} == 4 ) {
2644 my ($wkno,$year) = eval {Week_of_Year
( $year,$month, $day )};
2645 if ($@
){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2647 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2648 if ( $irreg[$i] == (($wkno!=49)?
($wkno +3) % 52 :52)) {
2649 ($year,$month,$day) = Add_Delta_Days
($year,$month, $day , 21 );
2650 $wkno=(($wkno!=49)?
($wkno +3) % 52 :52);
2653 @resultdate = Add_Delta_Days
($year,$month, $day , 21 );
2656 my $tmpmonth=$month;
2657 if ($year && $month && $day){
2658 if ( $subscription->{periodicity
} == 5 ) {
2659 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2660 if ( $irreg[$i] == (($tmpmonth!=11)?
($tmpmonth +1) % 12 :12)) {
2661 ($year,$month,$day) = Add_Delta_YMD
($year,$month, $day ,0,1,0 );
2662 $tmpmonth=(($tmpmonth!=11)?
($tmpmonth +1) % 12 :12);
2665 @resultdate = Add_Delta_YMD
($year,$month, $day ,0,1,0 );
2667 if ( $subscription->{periodicity
} == 6 ) {
2668 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2669 if ( $irreg[$i] == (($tmpmonth!=10)?
($tmpmonth +2) % 12 :12)) {
2670 ($year,$month,$day) = Add_Delta_YMD
($year,$month, $day ,0,2,0 );
2671 $tmpmonth=(($tmpmonth!=10)?
($tmpmonth + 2) % 12 :12);
2674 @resultdate = Add_Delta_YMD
($year,$month, $day, 0, 2,0 );
2676 if ( $subscription->{periodicity
} == 7 ) {
2677 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2678 if ( $irreg[$i] == (($tmpmonth!=9)?
($tmpmonth +3) % 12 :12)) {
2679 ($year,$month,$day) = Add_Delta_YMD
($year,$month, $day, 0, 3,0 );
2680 $tmpmonth=(($tmpmonth!=9)?
($tmpmonth + 3) % 12 :12);
2683 @resultdate = Add_Delta_YMD
($year,$month, $day, 0, 3, 0);
2685 if ( $subscription->{periodicity
} == 8 ) {
2686 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2687 if ( $irreg[$i] == (($tmpmonth!=9)?
($tmpmonth +3) % 12 :12)) {
2688 ($year,$month,$day) = Add_Delta_YMD
($year,$month, $day, 0, 3,0 );
2689 $tmpmonth=(($tmpmonth!=9)?
($tmpmonth + 3) % 12 :12);
2692 @resultdate = Add_Delta_YMD
($year,$month, $day, 0, 3, 0);
2694 if ( $subscription->{periodicity
} == 9 ) {
2695 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2696 if ( $irreg[$i] == (($tmpmonth!=9)?
($tmpmonth +3) % 12 :12)) {
2697 ### BUFIX Seems to need more Than One ?
2698 ($year,$month,$day) = Add_Delta_YM
($year,$month, $day, 0, 6 );
2699 $tmpmonth=(($tmpmonth!=6)?
($tmpmonth + 6) % 12 :12);
2702 @resultdate = Add_Delta_YM
($year,$month, $day, 0, 6);
2704 if ( $subscription->{periodicity
} == 10 ) {
2705 @resultdate = Add_Delta_YM
($year,$month, $day, 1, 0 );
2707 if ( $subscription->{periodicity
} == 11 ) {
2708 @resultdate = Add_Delta_YM
($year,$month, $day, 2, 0 );
2711 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2713 # warn "dateNEXTSEQ : ".$resultdate;
2714 return "$resultdate";
2719 $item = &itemdata($barcode);
2721 Looks up the item with the given barcode, and returns a
2722 reference-to-hash containing information about that item. The keys of
2723 the hash are the fields from the C<items> and C<biblioitems> tables in
2731 my $dbh = C4
::Context
->dbh;
2732 my $sth = $dbh->prepare(
2733 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2736 $sth->execute($barcode);
2737 my $data = $sth->fetchrow_hashref;
2749 Koha Developement team <info@koha.org>