← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Mon Aug 24 11:28:47 2009
Reported on Mon Aug 24 11:29:16 2009

File /home/chris/git/koha.git/C4/Serials.pm
Statements Executed 45
Total Time 0.0119512 seconds
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
0000s0sC4::Serials::::AddItem2SerialC4::Serials::AddItem2Serial
0000s0sC4::Serials::::BEGINC4::Serials::BEGIN
0000s0sC4::Serials::::CountSubscriptionFromBiblionumberC4::Serials::CountSubscriptionFromBiblionumber
0000s0sC4::Serials::::DelIssueC4::Serials::DelIssue
0000s0sC4::Serials::::DelSubscriptionC4::Serials::DelSubscription
0000s0sC4::Serials::::GetExpirationDateC4::Serials::GetExpirationDate
0000s0sC4::Serials::::GetFullSubscriptionC4::Serials::GetFullSubscription
0000s0sC4::Serials::::GetFullSubscriptionsFromBiblionumberC4::Serials::GetFullSubscriptionsFromBiblionumber
0000s0sC4::Serials::::GetLateIssuesC4::Serials::GetLateIssues
0000s0sC4::Serials::::GetLateOrMissingIssuesC4::Serials::GetLateOrMissingIssues
0000s0sC4::Serials::::GetLatestSerialsC4::Serials::GetLatestSerials
0000s0sC4::Serials::::GetNextDateC4::Serials::GetNextDate
0000s0sC4::Serials::::GetNextExpectedC4::Serials::GetNextExpected
0000s0sC4::Serials::::GetNextSeqC4::Serials::GetNextSeq
0000s0sC4::Serials::::GetSeqC4::Serials::GetSeq
0000s0sC4::Serials::::GetSerialInformationC4::Serials::GetSerialInformation
0000s0sC4::Serials::::GetSerialStatusFromSerialIdC4::Serials::GetSerialStatusFromSerialId
0000s0sC4::Serials::::GetSerialsC4::Serials::GetSerials
0000s0sC4::Serials::::GetSerials2C4::Serials::GetSerials2
0000s0sC4::Serials::::GetSubscriptionC4::Serials::GetSubscription
0000s0sC4::Serials::::GetSubscriptionHistoryFromSubscriptionIdC4::Serials::GetSubscriptionHistoryFromSubscriptionId
0000s0sC4::Serials::::GetSubscriptionsC4::Serials::GetSubscriptions
0000s0sC4::Serials::::GetSubscriptionsFromBiblionumberC4::Serials::GetSubscriptionsFromBiblionumber
0000s0sC4::Serials::::GetSuppliersWithLateIssuesC4::Serials::GetSuppliersWithLateIssues
0000s0sC4::Serials::::HasSubscriptionExpiredC4::Serials::HasSubscriptionExpired
0000s0sC4::Serials::::ItemizeSerialsC4::Serials::ItemizeSerials
0000s0sC4::Serials::::ModNextExpectedC4::Serials::ModNextExpected
0000s0sC4::Serials::::ModSerialStatusC4::Serials::ModSerialStatus
0000s0sC4::Serials::::ModSubscriptionC4::Serials::ModSubscription
0000s0sC4::Serials::::ModSubscriptionHistoryC4::Serials::ModSubscriptionHistory
0000s0sC4::Serials::::NewIssueC4::Serials::NewIssue
0000s0sC4::Serials::::NewSubscriptionC4::Serials::NewSubscription
0000s0sC4::Serials::::PrepareSerialsDataC4::Serials::PrepareSerialsData
0000s0sC4::Serials::::ReNewSubscriptionC4::Serials::ReNewSubscription
0000s0sC4::Serials::::UpdateClaimdateIssuesC4::Serials::UpdateClaimdateIssues
0000s0sC4::Serials::::abouttoexpireC4::Serials::abouttoexpire
0000s0sC4::Serials::::addroutingmemberC4::Serials::addroutingmember
0000s0sC4::Serials::::check_routingC4::Serials::check_routing
0000s0sC4::Serials::::countissuesfromC4::Serials::countissuesfrom
0000s0sC4::Serials::::delroutingmemberC4::Serials::delroutingmember
0000s0sC4::Serials::::getroutinglistC4::Serials::getroutinglist
0000s0sC4::Serials::::getsupplierbyserialidC4::Serials::getsupplierbyserialid
0000s0sC4::Serials::::in_arrayC4::Serials::in_array
0000s0sC4::Serials::::itemdataC4::Serials::itemdata
0000s0sC4::Serials::::removeMissingIssueC4::Serials::removeMissingIssue
0000s0sC4::Serials::::reorder_membersC4::Serials::reorder_members
0000s0sC4::Serials::::updateClaimC4::Serials::updateClaim
LineStmts.Exclusive
Time		Avg.Code
1package C4::Serials; #assumes C4/Serials.pm
2
3# Copyright 2000-2002 Katipo Communications
4#
5# This file is part of Koha.
6#
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
10# version.
11#
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.
15#
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
19
20
21338µs13µsuse strict;
# spent 13µs making 1 call to strict::import
22331µs10µsuse C4::Dates qw(format_date format_date_in_iso);
# spent 50µs making 1 call to Exporter::import
23336µs12µsuse Date::Calc qw(:all);
# spent 512µs making 1 call to Exporter::import
24333µs11µsuse POSIX qw(strftime);
# spent 52µs making 1 call to POSIX::import
253212µs71µsuse C4::Suggestions;
# spent 150µs making 1 call to Exporter::import
26332µs11µsuse C4::Koha;
# spent 297µs making 1 call to Exporter::import
27348µs16µsuse C4::Biblio;
# spent 377µs making 1 call to Exporter::import
28334µs11µsuse C4::Items;
# spent 133µs making 1 call to Exporter::import
29331µs10µsuse C4::Search;
# spent 119µs making 1 call to Exporter::import
303253µs84µsuse C4::Letters;
# spent 166µs making 1 call to Exporter::import
31330µs10µsuse C4::Log; # logaction
# spent 94µs making 1 call to Exporter::import
32335µs12µsuse C4::Debug;
# spent 82µs making 1 call to Exporter::import
33
34387µs29µsuse vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# spent 65µs making 1 call to vars::import
35
36BEGIN {
371600ns600ns $VERSION = 3.01; # set version for version checking
381800ns800ns require Exporter;
3918µs8µs @ISA = qw(Exporter);
40118µs18µs @EXPORT = qw(
41 &NewSubscription &ModSubscription &DelSubscription &GetSubscriptions
42 &GetSubscription &CountSubscriptionFromBiblionumber &GetSubscriptionsFromBiblionumber
43 &GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory
44 &HasSubscriptionExpired &GetExpirationDate &abouttoexpire
45
46 &GetNextSeq &NewIssue &ItemizeSerials &GetSerials
47 &GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2
48 &ReNewSubscription &GetLateIssues &GetLateOrMissingIssues
49 &GetSerialInformation &AddItem2Serial
50 &PrepareSerialsData &GetNextExpected &ModNextExpected
51
52 &UpdateClaimdateIssues
53 &GetSuppliersWithLateIssues &getsupplierbyserialid
54 &getroutinglist &delroutingmember &addroutingmember
55 &reorder_members
56 &check_routing &updateClaim &removeMissingIssue
57
58 );
59111.0ms11.0ms}
60
61=head2 GetSuppliersWithLateIssues
62
63=head1 NAME
64
65C4::Serials - Give functions for serializing.
66
67=head1 SYNOPSIS
68
69 use C4::Serials;
70
71=head1 DESCRIPTION
72
73Give all XYZ functions
74
75=head1 FUNCTIONS
76
77=over 4
78
79%supplierlist = &GetSuppliersWithLateIssues
80
81this function get all suppliers with late issues.
82
83return :
84the supplierlist into a hash. this hash containts id & name of the supplier
85
86=back
87
88=cut
89
90sub GetSuppliersWithLateIssues {
91 my $dbh = C4::Context->dbh;
92 my $query = qq|
93 SELECT DISTINCT id, name
94 FROM subscription
95 LEFT JOIN serial ON serial.subscriptionid=subscription.subscriptionid
96 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
97 WHERE subscription.subscriptionid = serial.subscriptionid
98 AND (planneddate < now() OR serial.STATUS = 3 OR serial.STATUS = 4)
99 ORDER BY name
100 |;
101 my $sth = $dbh->prepare($query);
102 $sth->execute;
103 my %supplierlist;
104 while ( my ( $id, $name ) = $sth->fetchrow ) {
105 $supplierlist{$id} = $name;
106 }
107 return %supplierlist;
108}
109
110=head2 GetLateIssues
111
112=over 4
113
114@issuelist = &GetLateIssues($supplierid)
115
116this function select late issues on database
117
118return :
119the issuelist into an table. Each line of this table containts a ref to a hash which it containts
120name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
121
122=back
123
124=cut
125
126sub GetLateIssues {
127 my ($supplierid) = @_;
128 my $dbh = C4::Context->dbh;
129 my $sth;
130 if ($supplierid) {
131 my $query = qq|
132 SELECT name,title,planneddate,serialseq,serial.subscriptionid
133 FROM subscription
134 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
135 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
136 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
137 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
138 AND subscription.aqbooksellerid=$supplierid
139 ORDER BY title
140 |;
141 $sth = $dbh->prepare($query);
142 }
143 else {
144 my $query = qq|
145 SELECT name,title,planneddate,serialseq,serial.subscriptionid
146 FROM subscription
147 LEFT JOIN serial ON subscription.subscriptionid = serial.subscriptionid
148 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
149 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
150 WHERE ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3)
151 ORDER BY title
152 |;
153 $sth = $dbh->prepare($query);
154 }
155 $sth->execute;
156 my @issuelist;
157 my $last_title;
158 my $odd = 0;
159 my $count = 0;
160 while ( my $line = $sth->fetchrow_hashref ) {
161 $odd++ unless $line->{title} eq $last_title;
162 $line->{title} = "" if $line->{title} eq $last_title;
163 $last_title = $line->{title} if ( $line->{title} );
164 $line->{planneddate} = format_date( $line->{planneddate} );
165 $count++;
166 push @issuelist, $line;
167 }
168 return $count, @issuelist;
169}
170
171=head2 GetSubscriptionHistoryFromSubscriptionId
172
173=over 4
174
175$sth = GetSubscriptionHistoryFromSubscriptionId()
176this function just prepare the SQL request.
177After this function, don't forget to execute it by using $sth->execute($subscriptionid)
178return :
179$sth = $dbh->prepare($query).
180
181=back
182
183=cut
184
185sub GetSubscriptionHistoryFromSubscriptionId() {
186 my $dbh = C4::Context->dbh;
187 my $query = qq|
188 SELECT *
189 FROM subscriptionhistory
190 WHERE subscriptionid = ?
191 |;
192 return $dbh->prepare($query);
193}
194
195=head2 GetSerialStatusFromSerialId
196
197=over 4
198
199$sth = GetSerialStatusFromSerialId();
200this function just prepare the SQL request.
201After this function, don't forget to execute it by using $sth->execute($serialid)
202return :
203$sth = $dbh->prepare($query).
204
205=back
206
207=cut
208
209sub GetSerialStatusFromSerialId() {
210 my $dbh = C4::Context->dbh;
211 my $query = qq|
212 SELECT status
213 FROM serial
214 WHERE serialid = ?
215 |;
216 return $dbh->prepare($query);
217}
218
219=head2 GetSerialInformation
220
221=over 4
222
223$data = GetSerialInformation($serialid);
224returns a hash containing :
225 items : items marcrecord (can be an array)
226 serial table field
227 subscription table field
228 + information about subscription expiration
229
230=back
231
232=cut
233
234sub GetSerialInformation {
235 my ($serialid) = @_;
236 my $dbh = C4::Context->dbh;
237 my $query = qq|
238 SELECT serial.*, serial.notes as sernotes, serial.status as serstatus,subscription.*,subscription.subscriptionid as subsid |;
239 if (C4::Context->preference('IndependantBranches') &&
240 C4::Context->userenv &&
241 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
242 $query.="
243 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
244 }
245 $query .= qq|
246 FROM serial LEFT JOIN subscription ON subscription.subscriptionid=serial.subscriptionid
247 WHERE serialid = ?
248 |;
249 my $rq = $dbh->prepare($query);
250 $rq->execute($serialid);
251 my $data = $rq->fetchrow_hashref;
252 # create item information if we have serialsadditems for this subscription
253 if ( $data->{'serialsadditems'} ) {
254 my $queryitem=$dbh->prepare("SELECT itemnumber from serialitems where serialid=?");
255 $queryitem->execute($serialid);
256 my $itemnumbers=$queryitem->fetchall_arrayref([0]);
257 if (scalar(@$itemnumbers)>0){
258 foreach my $itemnum (@$itemnumbers) {
259 #It is ASSUMED that GetMarcItem ALWAYS WORK...
260 #Maybe GetMarcItem should return values on failure
261 $debug and warn "itemnumber :$itemnum->[0], bibnum :".$data->{'biblionumber'};
262 my $itemprocessed =
263 PrepareItemrecordDisplay( $data->{'biblionumber'}, $itemnum->[0] , $data );
264 $itemprocessed->{'itemnumber'} = $itemnum->[0];
265 $itemprocessed->{'itemid'} = $itemnum->[0];
266 $itemprocessed->{'serialid'} = $serialid;
267 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
268 push @{ $data->{'items'} }, $itemprocessed;
269 }
270 }
271 else {
272 my $itemprocessed =
273 PrepareItemrecordDisplay( $data->{'biblionumber'}, '', $data );
274 $itemprocessed->{'itemid'} = "N$serialid";
275 $itemprocessed->{'serialid'} = $serialid;
276 $itemprocessed->{'biblionumber'} = $data->{'biblionumber'};
277 $itemprocessed->{'countitems'} = 0;
278 push @{ $data->{'items'} }, $itemprocessed;
279 }
280 }
281 $data->{ "status" . $data->{'serstatus'} } = 1;
282 $data->{'subscriptionexpired'} =
283 HasSubscriptionExpired( $data->{'subscriptionid'} ) && $data->{'status'}==1;
284 $data->{'abouttoexpire'} =
285 abouttoexpire( $data->{'subscriptionid'} );
286 return $data;
287}
288
289=head2 AddItem2Serial
290
291=over 4
292
293$data = AddItem2Serial($serialid,$itemnumber);
294Adds an itemnumber to Serial record
295
296=back
297
298=cut
299
300sub AddItem2Serial {
301 my ( $serialid, $itemnumber ) = @_;
302 my $dbh = C4::Context->dbh;
303 my $rq = $dbh->prepare("INSERT INTO `serialitems` SET serialid=? , itemnumber=?");
304 $rq->execute($serialid, $itemnumber);
305 return $rq->rows;
306}
307
308=head2 UpdateClaimdateIssues
309
310=over 4
311
312UpdateClaimdateIssues($serialids,[$date]);
313
314Update Claimdate for issues in @$serialids list with date $date
315(Take Today if none)
316
317=back
318
319=cut
320
321sub UpdateClaimdateIssues {
322 my ( $serialids, $date ) = @_;
323 if (!$date) {
324 $date = strftime('%Y-%m-%d',localtime);
325 }
326 my $dbh = C4::Context->dbh;
327 my $ids_str = join ',', @{$serialids};
328 my $query = 'UPDATE serial SET claimdate=? ,status=7 WHERE serialid IN ( '
329 . $ids_str . ' )';
330 return $dbh->do($query,undef, $date);
331}
332
333=head2 GetSubscription
334
335=over 4
336
337$subs = GetSubscription($subscriptionid)
338this function get the subscription which has $subscriptionid as id.
339return :
340a hashref. This hash containts
341subscription, subscriptionhistory, aqbudget.bookfundid, biblio.title
342
343=back
344
345=cut
346
347sub GetSubscription {
348 my ($subscriptionid) = @_;
349 my $dbh = C4::Context->dbh;
350 my $query = qq(
351 SELECT subscription.*,
352 subscriptionhistory.*,
353 subscriptionhistory.enddate as histenddate,
354 aqbudget.bookfundid,
355 aqbooksellers.name AS aqbooksellername,
356 biblio.title AS bibliotitle,
357 subscription.biblionumber as bibnum);
358 if (C4::Context->preference('IndependantBranches') &&
359 C4::Context->userenv &&
360 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
361 $query.="
362 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
363 }
364 $query .= qq(
365 FROM subscription
366 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
367 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
368 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
369 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
370 WHERE subscription.subscriptionid = ?
371 );
372# if (C4::Context->preference('IndependantBranches') &&
373# C4::Context->userenv &&
374# C4::Context->userenv->{'flags'} != 1){
375# # $debug and warn "flags: ".C4::Context->userenv->{'flags'};
376# $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
377# }
378 $debug and warn "query : $query\nsubsid :$subscriptionid";
379 my $sth = $dbh->prepare($query);
380 $sth->execute($subscriptionid);
381 return $sth->fetchrow_hashref;
382}
383
384=head2 GetFullSubscription
385
386=over 4
387
388 \@res = GetFullSubscription($subscriptionid)
389 this function read on serial table.
390
391=back
392
393=cut
394
395sub GetFullSubscription {
396 my ($subscriptionid) = @_;
397 my $dbh = C4::Context->dbh;
398 my $query = qq|
399 SELECT serial.serialid,
400 serial.serialseq,
401 serial.planneddate,
402 serial.publisheddate,
403 serial.status,
404 serial.notes as notes,
405 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
406 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
407 biblio.title as bibliotitle,
408 subscription.branchcode AS branchcode,
409 subscription.subscriptionid AS subscriptionid |;
410 if (C4::Context->preference('IndependantBranches') &&
411 C4::Context->userenv &&
412 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
413 $query.="
414 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
415 }
416 $query.=qq|
417 FROM serial
418 LEFT JOIN subscription ON
419 (serial.subscriptionid=subscription.subscriptionid )
420 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
421 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
422 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
423 WHERE serial.subscriptionid = ?
424 ORDER BY year DESC,
425 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
426 serial.subscriptionid
427 |;
428 $debug and warn "GetFullSubscription query: $query";
429 my $sth = $dbh->prepare($query);
430 $sth->execute($subscriptionid);
431 return $sth->fetchall_arrayref({});
432}
433
434
435=head2 PrepareSerialsData
436
437=over 4
438
439 \@res = PrepareSerialsData($serialinfomation)
440 where serialinformation is a hashref array
441
442=back
443
444=cut
445
446sub PrepareSerialsData{
447 my ($lines)=@_;
448 my %tmpresults;
449 my $year;
450 my @res;
451 my $startdate;
452 my $aqbooksellername;
453 my $bibliotitle;
454 my @loopissues;
455 my $first;
456 my $previousnote = "";
457
458 foreach my $subs ( @$lines ) {
459 $subs->{'publisheddate'} =
460 ( $subs->{'publisheddate'}
461 ? format_date( $subs->{'publisheddate'} )
462 : "XXX" );
463 $subs->{'planneddate'} = format_date( $subs->{'planneddate'} );
464 $subs->{ "status" . $subs->{'status'} } = 1;
465
466# $subs->{'notes'} = $subs->{'notes'} eq $previousnote?"":$subs->{notes};
467 if ( $subs->{'year'} && $subs->{'year'} ne "" ) {
468 $year = $subs->{'year'};
469 }
470 else {
471 $year = "manage";
472 }
473 if ( $tmpresults{$year} ) {
474 push @{ $tmpresults{$year}->{'serials'} }, $subs;
475 }
476 else {
477 $tmpresults{$year} = {
478 'year' => $year,
479
480 # 'startdate'=>format_date($subs->{'startdate'}),
481 'aqbooksellername' => $subs->{'aqbooksellername'},
482 'bibliotitle' => $subs->{'bibliotitle'},
483 'serials' => [$subs],
484 'first' => $first,
485# 'branchcode' => $subs->{'branchcode'},
486# 'subscriptionid' => $subs->{'subscriptionid'},
487 };
488 }
489
490 # $previousnote=$subs->{notes};
491 }
492 foreach my $key ( sort { $b cmp $a } keys %tmpresults ) {
493 push @res, $tmpresults{$key};
494 }
495 $res[0]->{'first'}=1;
496 return \@res;
497}
498
499=head2 GetSubscriptionsFromBiblionumber
500
501\@res = GetSubscriptionsFromBiblionumber($biblionumber)
502this function get the subscription list. it reads on subscription table.
503return :
504table of subscription which has the biblionumber given on input arg.
505each line of this table is a hashref. All hashes containt
506startdate, histstartdate,opacnote,missinglist,recievedlist,periodicity,status & enddate
507
508=cut
509
510sub GetSubscriptionsFromBiblionumber {
511 my ($biblionumber) = @_;
512 my $dbh = C4::Context->dbh;
513 my $query = qq(
514 SELECT subscription.*,
515 branches.branchname,
516 subscriptionhistory.*,
517 subscriptionhistory.enddate as histenddate,
518 aqbudget.bookfundid,
519 aqbooksellers.name AS aqbooksellername,
520 biblio.title AS bibliotitle
521 FROM subscription
522 LEFT JOIN subscriptionhistory ON subscription.subscriptionid=subscriptionhistory.subscriptionid
523 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
524 LEFT JOIN aqbooksellers ON subscription.aqbooksellerid=aqbooksellers.id
525 LEFT JOIN biblio ON biblio.biblionumber=subscription.biblionumber
526 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
527 WHERE subscription.biblionumber = ?
528 );
529# if (C4::Context->preference('IndependantBranches') &&
530# C4::Context->userenv &&
531# C4::Context->userenv->{'flags'} != 1){
532# $query.=" AND subscription.branchcode IN ('".C4::Context->userenv->{'branch'}."',\"\")";
533# }
534 my $sth = $dbh->prepare($query);
535 $sth->execute($biblionumber);
536 my @res;
537 while ( my $subs = $sth->fetchrow_hashref ) {
538 $subs->{startdate} = format_date( $subs->{startdate} );
539 $subs->{histstartdate} = format_date( $subs->{histstartdate} );
540 $subs->{histenddate} = format_date( $subs->{histenddate} );
541 $subs->{opacnote} =~ s/\n/\<br\/\>/g;
542 $subs->{missinglist} =~ s/\n/\<br\/\>/g;
543 $subs->{recievedlist} =~ s/\n/\<br\/\>/g;
544 $subs->{ "periodicity" . $subs->{periodicity} } = 1;
545 $subs->{ "numberpattern" . $subs->{numberpattern} } = 1;
546 $subs->{ "status" . $subs->{'status'} } = 1;
547 $subs->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
548 C4::Context->userenv &&
549 C4::Context->userenv->{flags} % 2 !=1 &&
550 C4::Context->userenv->{branch} && $subs->{branchcode} &&
551 (C4::Context->userenv->{branch} ne $subs->{branchcode}));
552 if ( $subs->{enddate} eq '0000-00-00' ) {
553 $subs->{enddate} = '';
554 }
555 else {
556 $subs->{enddate} = format_date( $subs->{enddate} );
557 }
558 $subs->{'abouttoexpire'}=abouttoexpire($subs->{'subscriptionid'});
559 $subs->{'subscriptionexpired'}=HasSubscriptionExpired($subs->{'subscriptionid'});
560 push @res, $subs;
561 }
562 return \@res;
563}
564
565=head2 GetFullSubscriptionsFromBiblionumber
566
567=over 4
568
569 \@res = GetFullSubscriptionsFromBiblionumber($biblionumber)
570 this function read on serial table.
571
572=back
573
574=cut
575
576sub GetFullSubscriptionsFromBiblionumber {
577 my ($biblionumber) = @_;
578 my $dbh = C4::Context->dbh;
579 my $query = qq|
580 SELECT serial.serialid,
581 serial.serialseq,
582 serial.planneddate,
583 serial.publisheddate,
584 serial.status,
585 serial.notes as notes,
586 year(IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate)) as year,
587 aqbudget.bookfundid,aqbooksellers.name as aqbooksellername,
588 biblio.title as bibliotitle,
589 subscription.branchcode AS branchcode,
590 branches.branchname AS branchname,
591 subscription.subscriptionid AS subscriptionid|;
592 if (C4::Context->preference('IndependantBranches') &&
593 C4::Context->userenv &&
594 C4::Context->userenv->{'flags'} != 1 && C4::Context->userenv->{'branch'}){
595 $query.="
596 , ((subscription.branchcode <>\"".C4::Context->userenv->{'branch'}."\") and subscription.branchcode <>\"\" and subscription.branchcode IS NOT NULL) as cannotedit ";
597 }
598
599 $query.=qq|
600 FROM serial
601 LEFT JOIN subscription ON
602 (serial.subscriptionid=subscription.subscriptionid)
603 LEFT JOIN aqbudget ON subscription.aqbudgetid=aqbudget.aqbudgetid
604 LEFT JOIN aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
605 LEFT JOIN branches ON branches.branchcode=subscription.branchcode
606 LEFT JOIN biblio on biblio.biblionumber=subscription.biblionumber
607 WHERE subscription.biblionumber = ?
608 ORDER BY year DESC,
609 IF(serial.publisheddate="00-00-0000",serial.planneddate,serial.publisheddate) DESC,
610 serial.subscriptionid
611 |;
612 my $sth = $dbh->prepare($query);
613 $sth->execute($biblionumber);
614 return $sth->fetchall_arrayref({});
615}
616
617=head2 GetSubscriptions
618
619=over 4
620
621@results = GetSubscriptions($title,$ISSN,$biblionumber);
622this function get all subscriptions which has title like $title,ISSN like $ISSN and biblionumber like $biblionumber.
623return:
624a table of hashref. Each hash containt the subscription.
625
626=back
627
628=cut
629
630sub GetSubscriptions {
631 my ( $title, $ISSN, $biblionumber ) = @_;
632 #return unless $title or $ISSN or $biblionumber;
633 my $dbh = C4::Context->dbh;
634 my $sth;
635 if ($biblionumber) {
636 my $query = qq(
637 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
638 FROM subscription
639 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
640 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
641 WHERE biblio.biblionumber=?
642 );
643 $query.=" ORDER BY title";
644 $debug and warn "GetSubscriptions query: $query";
645 $sth = $dbh->prepare($query);
646 $sth->execute($biblionumber);
647 }
648 else {
649 if ( $ISSN and $title ) {
650 my $query = qq|
651 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
652 FROM subscription
653 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
654 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
655 WHERE (biblioitems.issn = ? or|. join('and ',map{"biblio.title LIKE \"%$_%\""}split (" ",$title))." )";
656 $query.=" ORDER BY title";
657 $debug and warn "GetSubscriptions query: $query";
658 $sth = $dbh->prepare($query);
659 $sth->execute( $ISSN );
660 }
661 else {
662 if ($ISSN) {
663 my $query = qq(
664 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
665 FROM subscription
666 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
667 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
668 WHERE biblioitems.issn LIKE ?
669 );
670 $query.=" ORDER BY title";
671 $debug and warn "GetSubscriptions query: $query";
672 $sth = $dbh->prepare($query);
673 $sth->execute( "%" . $ISSN . "%" );
674 }
675 else {
676 my $query = qq(
677 SELECT subscription.*,biblio.title,biblioitems.issn,biblio.biblionumber
678 FROM subscription
679 LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber
680 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
681 WHERE 1
682 ).($title?" and ":""). join('and ',map{"biblio.title LIKE \"%$_%\""} split (" ",$title) );
683
684 $query.=" ORDER BY title";
685 $debug and warn "GetSubscriptions query: $query";
686 $sth = $dbh->prepare($query);
687 $sth->execute;
688 }
689 }
690 }
691 my @results;
692 my $previoustitle = "";
693 my $odd = 1;
694 while ( my $line = $sth->fetchrow_hashref ) {
695 if ( $previoustitle eq $line->{title} ) {
696 $line->{title} = "";
697 $line->{issn} = "";
698 }
699 else {
700 $previoustitle = $line->{title};
701 $odd = -$odd;
702 }
703 $line->{toggle} = 1 if $odd == 1;
704 $line->{'cannotedit'}=(C4::Context->preference('IndependantBranches') &&
705 C4::Context->userenv &&
706 C4::Context->userenv->{flags} % 2 !=1 &&
707 C4::Context->userenv->{branch} && $line->{branchcode} &&
708 (C4::Context->userenv->{branch} ne $line->{branchcode}));
709 push @results, $line;
710 }
711 return @results;
712}
713
714=head2 GetSerials
715
716=over 4
717
718($totalissues,@serials) = GetSerials($subscriptionid);
719this function get every serial not arrived for a given subscription
720as well as the number of issues registered in the database (all types)
721this number is used to see if a subscription can be deleted (=it must have only 1 issue)
722
723FIXME: We should return \@serials.
724
725=back
726
727=cut
728
729sub GetSerials {
730 my ($subscriptionid,$count) = @_;
731 my $dbh = C4::Context->dbh;
732
733 # status = 2 is "arrived"
734 my $counter = 0;
735 $count=5 unless ($count);
736 my @serials;
737 my $query =
738 "SELECT serialid,serialseq, status, publisheddate, planneddate,notes, routingnotes, claimdate
739 FROM serial
740 WHERE subscriptionid = ? AND status NOT IN (2,4,5)
741 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC";
742 my $sth = $dbh->prepare($query);
743 $sth->execute($subscriptionid);
744 while ( my $line = $sth->fetchrow_hashref ) {
745 $line->{ "status" . $line->{status} } =
746 1; # fills a "statusX" value, used for template status select list
747 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
748 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
749 $line->{claimdate} = format_date( $line->{claimdate} );
750 push @serials, $line;
751 }
752 # OK, now add the last 5 issues arrives/missing
753 $query =
754 "SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
755 FROM serial
756 WHERE subscriptionid = ?
757 AND (status in (2,4,5))
758 ORDER BY IF(publisheddate<>'0000-00-00',publisheddate,planneddate) DESC
759 ";
760 $sth = $dbh->prepare($query);
761 $sth->execute($subscriptionid);
762 while ( ( my $line = $sth->fetchrow_hashref ) && $counter < $count ) {
763 $counter++;
764 $line->{ "status" . $line->{status} } =
765 1; # fills a "statusX" value, used for template status select list
766 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
767 $line->{"publisheddate"} = format_date( $line->{"publisheddate"} );
768 push @serials, $line;
769 }
770
771 $query = "SELECT count(*) FROM serial WHERE subscriptionid=?";
772 $sth = $dbh->prepare($query);
773 $sth->execute($subscriptionid);
774 my ($totalissues) = $sth->fetchrow;
775 return ( $totalissues, @serials );
776}
777
778=head2 GetSerials2
779
780=over 4
781
782($totalissues,@serials) = GetSerials2($subscriptionid,$status);
783this function get every serial waited for a given subscription
784as well as the number of issues registered in the database (all types)
785this number is used to see if a subscription can be deleted (=it must have only 1 issue)
786
787=back
788
789=cut
790sub GetSerials2 {
791 my ($subscription,$status) = @_;
792 my $dbh = C4::Context->dbh;
793 my $query = qq|
794 SELECT serialid,serialseq, status, planneddate, publisheddate,notes, routingnotes
795 FROM serial
796 WHERE subscriptionid=$subscription AND status IN ($status)
797 ORDER BY publisheddate,serialid DESC
798 |;
799 $debug and warn "GetSerials2 query: $query";
800 my $sth=$dbh->prepare($query);
801 $sth->execute;
802 my @serials;
803 while(my $line = $sth->fetchrow_hashref) {
804 $line->{"status".$line->{status}} = 1; # fills a "statusX" value, used for template status select list
805 $line->{"planneddate"} = format_date($line->{"planneddate"});
806 $line->{"publisheddate"} = format_date($line->{"publisheddate"});
807 push @serials,$line;
808 }
809 my ($totalissues) = scalar(@serials);
810 return ($totalissues,@serials);
811}
812
813=head2 GetLatestSerials
814
815=over 4
816
817\@serials = GetLatestSerials($subscriptionid,$limit)
818get the $limit's latest serials arrived or missing for a given subscription
819return :
820a ref to a table which it containts all of the latest serials stored into a hash.
821
822=back
823
824=cut
825
826sub GetLatestSerials {
827 my ( $subscriptionid, $limit ) = @_;
828 my $dbh = C4::Context->dbh;
829
830 # status = 2 is "arrived"
831 my $strsth = "SELECT serialid,serialseq, status, planneddate, notes
832 FROM serial
833 WHERE subscriptionid = ?
834 AND (status =2 or status=4)
835 ORDER BY publisheddate DESC LIMIT 0,$limit
836 ";
837 my $sth = $dbh->prepare($strsth);
838 $sth->execute($subscriptionid);
839 my @serials;
840 while ( my $line = $sth->fetchrow_hashref ) {
841 $line->{ "status" . $line->{status} } =
842 1; # fills a "statusX" value, used for template status select list
843 $line->{"planneddate"} = format_date( $line->{"planneddate"} );
844 push @serials, $line;
845 }
846
847 # my $query = qq|
848 # SELECT count(*)
849 # FROM serial
850 # WHERE subscriptionid=?
851 # |;
852 # $sth=$dbh->prepare($query);
853 # $sth->execute($subscriptionid);
854 # my ($totalissues) = $sth->fetchrow;
855 return \@serials;
856}
857
858=head2 GetNextSeq
859
860=over 4
861
862GetNextSeq($val)
863$val is a hashref containing all the attributes of the table 'subscription'
864This function get the next issue for the subscription given on input arg
865return:
866all the input params updated.
867
868=back
869
870=cut
871
872# sub GetNextSeq {
873# my ($val) =@_;
874# my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
875# $calculated = $val->{numberingmethod};
876# # calculate the (expected) value of the next issue recieved.
877# $newlastvalue1 = $val->{lastvalue1};
878# # check if we have to increase the new value.
879# $newinnerloop1 = $val->{innerloop1}+1;
880# $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
881# $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
882# $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
883# $calculated =~ s/\{X\}/$newlastvalue1/g;
884#
885# $newlastvalue2 = $val->{lastvalue2};
886# # check if we have to increase the new value.
887# $newinnerloop2 = $val->{innerloop2}+1;
888# $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
889# $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
890# $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
891# $calculated =~ s/\{Y\}/$newlastvalue2/g;
892#
893# $newlastvalue3 = $val->{lastvalue3};
894# # check if we have to increase the new value.
895# $newinnerloop3 = $val->{innerloop3}+1;
896# $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
897# $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
898# $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
899# $calculated =~ s/\{Z\}/$newlastvalue3/g;
900# return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3);
901# }
902
903sub GetNextSeq {
904 my ($val) = @_;
905 my (
906 $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3,
907 $newinnerloop1, $newinnerloop2, $newinnerloop3
908 );
909 my $pattern = $val->{numberpattern};
910 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
911 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
912 $calculated = $val->{numberingmethod};
913 $newlastvalue1 = $val->{lastvalue1};
914 $newlastvalue2 = $val->{lastvalue2};
915 $newlastvalue3 = $val->{lastvalue3};
916 $newlastvalue1 = $val->{lastvalue1};
917 # check if we have to increase the new value.
918 $newinnerloop1 = $val->{innerloop1} + 1;
919 $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1});
920 $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty.
921 $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed.
922 $calculated =~ s/\{X\}/$newlastvalue1/g;
923
924 $newlastvalue2 = $val->{lastvalue2};
925 # check if we have to increase the new value.
926 $newinnerloop2 = $val->{innerloop2} + 1;
927 $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2});
928 $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty.
929 $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed.
930 if ( $pattern == 6 ) {
931 if ( $val->{hemisphere} == 2 ) {
932 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
933 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
934 }
935 else {
936 my $newlastvalue2seq = $seasons[$newlastvalue2];
937 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
938 }
939 }
940 else {
941 $calculated =~ s/\{Y\}/$newlastvalue2/g;
942 }
943
944
945 $newlastvalue3 = $val->{lastvalue3};
946 # check if we have to increase the new value.
947 $newinnerloop3 = $val->{innerloop3} + 1;
948 $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3});
949 $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty.
950 $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed.
951 $calculated =~ s/\{Z\}/$newlastvalue3/g;
952
953 return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3 ,
954 $newinnerloop1, $newinnerloop2, $newinnerloop3);
955}
956
957=head2 GetSeq
958
959=over 4
960
961$calculated = GetSeq($val)
962$val is a hashref containing all the attributes of the table 'subscription'
963this function transforms {X},{Y},{Z} to 150,0,0 for example.
964return:
965the sequence in integer format
966
967=back
968
969=cut
970
971sub GetSeq {
972 my ($val) = @_;
973 my $pattern = $val->{numberpattern};
974 my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' );
975 my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' );
976 my $calculated = $val->{numberingmethod};
977 my $x = $val->{'lastvalue1'};
978 $calculated =~ s/\{X\}/$x/g;
979 my $newlastvalue2 = $val->{'lastvalue2'};
980 if ( $pattern == 6 ) {
981 if ( $val->{hemisphere} == 2 ) {
982 my $newlastvalue2seq = $southern_seasons[$newlastvalue2];
983 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
984 }
985 else {
986 my $newlastvalue2seq = $seasons[$newlastvalue2];
987 $calculated =~ s/\{Y\}/$newlastvalue2seq/g;
988 }
989 }
990 else {
991 $calculated =~ s/\{Y\}/$newlastvalue2/g;
992 }
993 my $z = $val->{'lastvalue3'};
994 $calculated =~ s/\{Z\}/$z/g;
995 return $calculated;
996}
997
998=head2 GetExpirationDate
999
1000$sensddate = GetExpirationDate($subscriptionid)
1001
1002this function return the expiration date for a subscription given on input args.
1003
1004return
1005the enddate
1006
1007=cut
1008
1009sub GetExpirationDate {
1010 my ($subscriptionid) = @_;
1011 my $dbh = C4::Context->dbh;
1012 my $subscription = GetSubscription($subscriptionid);
1013 my $enddate = $subscription->{startdate};
1014
1015# we don't do the same test if the subscription is based on X numbers or on X weeks/months
1016 if (($subscription->{periodicity} % 16) >0){
1017 if ( $subscription->{numberlength} ) {
1018 #calculate the date of the last issue.
1019 my $length = $subscription->{numberlength};
1020 for ( my $i = 1 ; $i <= $length ; $i++ ) {
1021 $enddate = GetNextDate( $enddate, $subscription );
1022 }
1023 }
1024 elsif ( $subscription->{monthlength} ){
1025 my @date=split (/-/,$subscription->{startdate});
1026 my @enddate = Add_Delta_YM($date[0],$date[1],$date[2],0,$subscription->{monthlength});
1027 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1028 } elsif ( $subscription->{weeklength} ){
1029 my @date=split (/-/,$subscription->{startdate});
1030 my @enddate = Add_Delta_Days($date[0],$date[1],$date[2],$subscription->{weeklength}*7);
1031 $enddate=sprintf("%04d-%02d-%02d",$enddate[0],$enddate[1],$enddate[2]);
1032 }
1033 return $enddate;
1034 } else {
1035 return 0;
1036 }
1037}
1038
1039=head2 CountSubscriptionFromBiblionumber
1040
1041=over 4
1042
1043$subscriptionsnumber = CountSubscriptionFromBiblionumber($biblionumber)
1044this count the number of subscription for a biblionumber given.
1045return :
1046the number of subscriptions with biblionumber given on input arg.
1047
1048=back
1049
1050=cut
1051
1052sub CountSubscriptionFromBiblionumber {
1053 my ($biblionumber) = @_;
1054 my $dbh = C4::Context->dbh;
1055 my $query = "SELECT count(*) FROM subscription WHERE biblionumber=?";
1056 my $sth = $dbh->prepare($query);
1057 $sth->execute($biblionumber);
1058 my $subscriptionsnumber = $sth->fetchrow;
1059 return $subscriptionsnumber;
1060}
1061
1062=head2 ModSubscriptionHistory
1063
1064=over 4
1065
1066ModSubscriptionHistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
1067
1068this function modify the history of a subscription. Put your new values on input arg.
1069
1070=back
1071
1072=cut
1073
1074sub ModSubscriptionHistory {
1075 my (
1076 $subscriptionid, $histstartdate, $enddate, $recievedlist,
1077 $missinglist, $opacnote, $librariannote
1078 ) = @_;
1079 my $dbh = C4::Context->dbh;
1080 my $query = "UPDATE subscriptionhistory
1081 SET histstartdate=?,enddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=?
1082 WHERE subscriptionid=?
1083 ";
1084 my $sth = $dbh->prepare($query);
1085 $recievedlist =~ s/^; //;
1086 $missinglist =~ s/^; //;
1087 $opacnote =~ s/^; //;
1088 $sth->execute(
1089 $histstartdate, $enddate, $recievedlist, $missinglist,
1090 $opacnote, $librariannote, $subscriptionid
1091 );
1092 return $sth->rows;
1093}
1094
1095=head2 ModSerialStatus
1096
1097=over 4
1098
1099ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes)
1100
1101This function modify the serial status. Serial status is a number.(eg 2 is "arrived")
1102Note : if we change from "waited" to something else,then we will have to create a new "waited" entry
1103
1104=back
1105
1106=cut
1107
1108sub ModSerialStatus {
1109 my ( $serialid, $serialseq, $planneddate,$publisheddate, $status, $notes )
1110 = @_;
1111
1112 #It is a usual serial
1113 # 1st, get previous status :
1114 my $dbh = C4::Context->dbh;
1115 my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?";
1116 my $sth = $dbh->prepare($query);
1117 $sth->execute($serialid);
1118 my ( $subscriptionid, $oldstatus ) = $sth->fetchrow;
1119
1120 # change status & update subscriptionhistory
1121 my $val;
1122 if ( $status eq 6 ) {
1123 DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} );
1124 }
1125 else {
1126 my $query =
1127"UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?";
1128 $sth = $dbh->prepare($query);
1129 $sth->execute( $serialseq, $publisheddate, $planneddate, $status,
1130 $notes, $serialid );
1131 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1132 $sth = $dbh->prepare($query);
1133 $sth->execute($subscriptionid);
1134 my $val = $sth->fetchrow_hashref;
1135 unless ( $val->{manualhistory} ) {
1136 $query =
1137"SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?";
1138 $sth = $dbh->prepare($query);
1139 $sth->execute($subscriptionid);
1140 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1141 if ( $status eq 2 ) {
1142
1143 $recievedlist .= "; $serialseq"
1144 unless ( index( "$recievedlist", "$serialseq" ) >= 0 );
1145 }
1146
1147# warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq");
1148 $missinglist .= "; $serialseq"
1149 if ( $status eq 4
1150 and not index( "$missinglist", "$serialseq" ) >= 0 );
1151 $missinglist .= "; not issued $serialseq"
1152 if ( $status eq 5
1153 and index( "$missinglist", "$serialseq" ) >= 0 );
1154 $query =
1155"UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?";
1156 $sth = $dbh->prepare($query);
1157 $recievedlist =~ s/^; //;
1158 $missinglist =~ s/^; //;
1159 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1160 }
1161 }
1162
1163 # create new waited entry if needed (ie : was a "waited" and has changed)
1164 if ( $oldstatus eq 1 && $status ne 1 ) {
1165 my $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1166 $sth = $dbh->prepare($query);
1167 $sth->execute($subscriptionid);
1168 my $val = $sth->fetchrow_hashref;
1169
1170 # next issue number
1171# warn "Next Seq";
1172 my (
1173 $newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3,
1174 $newinnerloop1, $newinnerloop2, $newinnerloop3
1175 ) = GetNextSeq($val);
1176# warn "Next Seq End";
1177
1178 # next date (calculated from actual date & frequency parameters)
1179# warn "publisheddate :$publisheddate ";
1180 my $nextpublisheddate = GetNextDate( $publisheddate, $val );
1181 NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'},
1182 1, $nextpublisheddate, $nextpublisheddate );
1183 $query =
1184"UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=?
1185 WHERE subscriptionid = ?";
1186 $sth = $dbh->prepare($query);
1187 $sth->execute(
1188 $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1,
1189 $newinnerloop2, $newinnerloop3, $subscriptionid
1190 );
1191
1192# check if an alert must be sent... (= a letter is defined & status became "arrived"
1193 if ( $val->{letter} && $status eq 2 && $oldstatus ne 2 ) {
1194 SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} );
1195 }
1196 }
1197}
1198
1199=head2 GetNextExpected
1200
1201=over 4
1202
1203$nextexpected = GetNextExpected($subscriptionid)
1204
1205Get the planneddate for the current expected issue of the subscription.
1206
1207returns a hashref:
1208
1209$nextexepected = {
1210 serialid => int
1211 planneddate => C4::Dates object
1212 }
1213
1214=back
1215
1216=cut
1217
1218sub GetNextExpected($) {
1219 my ($subscriptionid) = @_;
1220 my $dbh = C4::Context->dbh;
1221 my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?');
1222 # Each subscription has only one 'expected' issue, with serial.status==1.
1223 $sth->execute( $subscriptionid, 1 );
1224 my ( $nextissue ) = $sth->fetchrow_hashref;
1225 if(not $nextissue){
1226 $sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1');
1227 $sth->execute( $subscriptionid );
1228 $nextissue = $sth->fetchrow_hashref;
1229 }
1230 $nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso');
1231 return $nextissue;
1232
1233}
1234=head2 ModNextExpected
1235
1236=over 4
1237
1238ModNextExpected($subscriptionid,$date)
1239
1240Update the planneddate for the current expected issue of the subscription.
1241This will modify all future prediction results.
1242
1243C<$date> is a C4::Dates object.
1244
1245=back
1246
1247=cut
1248
1249sub ModNextExpected($$) {
1250 my ($subscriptionid,$date) = @_;
1251 my $dbh = C4::Context->dbh;
1252 #FIXME: Would expect to only set planneddate, but we set both on new issue creation, so updating it here
1253 my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?');
1254 # Each subscription has only one 'expected' issue, with serial.status==1.
1255 $sth->execute( $date->output('iso'),$date->output('iso'), $subscriptionid, 1);
1256 return 0;
1257
1258}
1259
1260=head2 ModSubscription
1261
1262=over 4
1263
1264this function modify a subscription. Put all new values on input args.
1265
1266=back
1267
1268=cut
1269
1270sub ModSubscription {
1271 my (
1272 $auser, $branchcode, $aqbooksellerid, $cost,
1273 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1274 $dow, $irregularity, $numberpattern, $numberlength,
1275 $weeklength, $monthlength, $add1, $every1,
1276 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1277 $add2, $every2, $whenmorethan2, $setto2,
1278 $lastvalue2, $innerloop2, $add3, $every3,
1279 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1280 $numberingmethod, $status, $biblionumber, $callnumber,
1281 $notes, $letter, $hemisphere, $manualhistory,
1282 $internalnotes, $serialsadditems,$subscriptionid,
1283 $staffdisplaycount,$opacdisplaycount, $graceperiod, $location
1284 ) = @_;
1285# warn $irregularity;
1286 my $dbh = C4::Context->dbh;
1287 my $query = "UPDATE subscription
1288 SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
1289 periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?,
1290 add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
1291 add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
1292 add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
1293 numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?,staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ?
1294 WHERE subscriptionid = ?";
1295 #warn "query :".$query;
1296 my $sth = $dbh->prepare($query);
1297 $sth->execute(
1298 $auser, $branchcode, $aqbooksellerid, $cost,
1299 $aqbudgetid, $startdate, $periodicity, $firstacquidate,
1300 $dow, "$irregularity", $numberpattern, $numberlength,
1301 $weeklength, $monthlength, $add1, $every1,
1302 $whenmorethan1, $setto1, $lastvalue1, $innerloop1,
1303 $add2, $every2, $whenmorethan2, $setto2,
1304 $lastvalue2, $innerloop2, $add3, $every3,
1305 $whenmorethan3, $setto3, $lastvalue3, $innerloop3,
1306 $numberingmethod, $status, $biblionumber, $callnumber,
1307 $notes, $letter, $hemisphere, ($manualhistory?$manualhistory:0),
1308 $internalnotes, $serialsadditems,
1309 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location,
1310 $subscriptionid
1311 );
1312 my $rows=$sth->rows;
1313 $sth->finish;
1314
1315 logaction("SERIAL", "MODIFY", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1316 return $rows;
1317}
1318
1319=head2 NewSubscription
1320
1321=over 4
1322
1323$subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
1324 $startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength,
1325 $add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
1326 $add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
1327 $add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
1328 $numberingmethod, $status, $notes, $serialsadditems,
1329 $staffdisplaycount, $opacdisplaycount, $graceperiod, $location);
1330
1331Create a new subscription with value given on input args.
1332
1333return :
1334the id of this new subscription
1335
1336=back
1337
1338=cut
1339
1340sub NewSubscription {
1341 my (
1342 $auser, $branchcode, $aqbooksellerid, $cost,
1343 $aqbudgetid, $biblionumber, $startdate, $periodicity,
1344 $dow, $numberlength, $weeklength, $monthlength,
1345 $add1, $every1, $whenmorethan1, $setto1,
1346 $lastvalue1, $innerloop1, $add2, $every2,
1347 $whenmorethan2, $setto2, $lastvalue2, $innerloop2,
1348 $add3, $every3, $whenmorethan3, $setto3,
1349 $lastvalue3, $innerloop3, $numberingmethod, $status,
1350 $notes, $letter, $firstacquidate, $irregularity,
1351 $numberpattern, $callnumber, $hemisphere, $manualhistory,
1352 $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount,
1353 $graceperiod, $location
1354 ) = @_;
1355 my $dbh = C4::Context->dbh;
1356
1357 #save subscription (insert into database)
1358 my $query = qq|
1359 INSERT INTO subscription
1360 (librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber,
1361 startdate,periodicity,dow,numberlength,weeklength,monthlength,
1362 add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1,
1363 add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2,
1364 add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3,
1365 numberingmethod, status, notes, letter,firstacquidate,irregularity,
1366 numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems,
1367 staffdisplaycount,opacdisplaycount,graceperiod,location)
1368 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
1369 |;
1370 my $sth = $dbh->prepare($query);
1371 $sth->execute(
1372 $auser, $branchcode,
1373 $aqbooksellerid, $cost,
1374 $aqbudgetid, $biblionumber,
1375 format_date_in_iso($startdate), $periodicity,
1376 $dow, $numberlength,
1377 $weeklength, $monthlength,
1378 $add1, $every1,
1379 $whenmorethan1, $setto1,
1380 $lastvalue1, $innerloop1,
1381 $add2, $every2,
1382 $whenmorethan2, $setto2,
1383 $lastvalue2, $innerloop2,
1384 $add3, $every3,
1385 $whenmorethan3, $setto3,
1386 $lastvalue3, $innerloop3,
1387 $numberingmethod, "$status",
1388 $notes, $letter,
1389 format_date_in_iso($firstacquidate), $irregularity,
1390 $numberpattern, $callnumber,
1391 $hemisphere, $manualhistory,
1392 $internalnotes, $serialsadditems,
1393 $staffdisplaycount, $opacdisplaycount,
1394 $graceperiod, $location,
1395 );
1396
1397 #then create the 1st waited number
1398 my $subscriptionid = $dbh->{'mysql_insertid'};
1399 $query = qq(
1400 INSERT INTO subscriptionhistory
1401 (biblionumber, subscriptionid, histstartdate, opacnote, librariannote)
1402 VALUES (?,?,?,?,?)
1403 );
1404 $sth = $dbh->prepare($query);
1405 $sth->execute( $biblionumber, $subscriptionid,
1406 format_date_in_iso($startdate),
1407 $notes,$internalnotes );
1408
1409 # reread subscription to get a hash (for calculation of the 1st issue number)
1410 $query = qq(
1411 SELECT *
1412 FROM subscription
1413 WHERE subscriptionid = ?
1414 );
1415 $sth = $dbh->prepare($query);
1416 $sth->execute($subscriptionid);
1417 my $val = $sth->fetchrow_hashref;
1418
1419 # calculate issue number
1420 my $serialseq = GetSeq($val);
1421 $query = qq|
1422 INSERT INTO serial
1423 (serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate)
1424 VALUES (?,?,?,?,?,?)
1425 |;
1426 $sth = $dbh->prepare($query);
1427 $sth->execute(
1428 "$serialseq", $subscriptionid, $biblionumber, 1,
1429 format_date_in_iso($firstacquidate),
1430 format_date_in_iso($firstacquidate)
1431 );
1432
1433 logaction("SERIAL", "ADD", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1434
1435#set serial flag on biblio if not already set.
1436 my ($null, ($bib)) = GetBiblio($biblionumber);
1437 if( ! $bib->{'serial'} ) {
1438 my $record = GetMarcBiblio($biblionumber);
1439 my ($tag,$subf) = GetMarcFromKohaField('biblio.serial',$bib->{'frameworkcode'});
1440 if($tag) {
1441 eval {
1442 $record->field($tag)->update( $subf => 1 );
1443 };
1444 }
1445 ModBiblio($record,$biblionumber,$bib->{'frameworkcode'});
1446 }
1447 return $subscriptionid;
1448}
1449
1450=head2 ReNewSubscription
1451
1452=over 4
1453
1454ReNewSubscription($subscriptionid,$user,$startdate,$numberlength,$weeklength,$monthlength,$note)
1455
1456this function renew a subscription with values given on input args.
1457
1458=back
1459
1460=cut
1461
1462sub ReNewSubscription {
1463 my ( $subscriptionid, $user, $startdate, $numberlength, $weeklength,
1464 $monthlength, $note )
1465 = @_;
1466 my $dbh = C4::Context->dbh;
1467 my $subscription = GetSubscription($subscriptionid);
1468 my $query = qq|
1469 SELECT *
1470 FROM biblio
1471 LEFT JOIN biblioitems ON biblio.biblionumber=biblioitems.biblionumber
1472 WHERE biblio.biblionumber=?
1473 |;
1474 my $sth = $dbh->prepare($query);
1475 $sth->execute( $subscription->{biblionumber} );
1476 my $biblio = $sth->fetchrow_hashref;
1477 if (C4::Context->preference("RenewSerialAddsSuggestion")){
1478 NewSuggestion(
1479 $user, $subscription->{bibliotitle},
1480 $biblio->{author}, $biblio->{publishercode},
1481 $biblio->{note}, '',
1482 '', '',
1483 '', '',
1484 $subscription->{biblionumber}
1485 );
1486 }
1487
1488 # renew subscription
1489 $query = qq|
1490 UPDATE subscription
1491 SET startdate=?,numberlength=?,weeklength=?,monthlength=?
1492 WHERE subscriptionid=?
1493 |;
1494 $sth = $dbh->prepare($query);
1495 $sth->execute( format_date_in_iso($startdate),
1496 $numberlength, $weeklength, $monthlength, $subscriptionid );
1497
1498 logaction("SERIAL", "RENEW", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1499}
1500
1501=head2 NewIssue
1502
1503=over 4
1504
1505NewIssue($serialseq,$subscriptionid,$biblionumber,$status, $planneddate, $publisheddate, $notes)
1506
1507Create a new issue stored on the database.
1508Note : we have to update the recievedlist and missinglist on subscriptionhistory for this subscription.
1509
1510=back
1511
1512=cut
1513
1514sub NewIssue {
1515 my ( $serialseq, $subscriptionid, $biblionumber, $status,
1516 $planneddate, $publisheddate, $notes )
1517 = @_;
1518 ### FIXME biblionumber CAN be provided by subscriptionid. So Do we STILL NEED IT ?
1519
1520 my $dbh = C4::Context->dbh;
1521 my $query = qq|
1522 INSERT INTO serial
1523 (serialseq,subscriptionid,biblionumber,status,publisheddate,planneddate,notes)
1524 VALUES (?,?,?,?,?,?,?)
1525 |;
1526 my $sth = $dbh->prepare($query);
1527 $sth->execute( $serialseq, $subscriptionid, $biblionumber, $status,
1528 $publisheddate, $planneddate,$notes );
1529 my $serialid=$dbh->{'mysql_insertid'};
1530 $query = qq|
1531 SELECT missinglist,recievedlist
1532 FROM subscriptionhistory
1533 WHERE subscriptionid=?
1534 |;
1535 $sth = $dbh->prepare($query);
1536 $sth->execute($subscriptionid);
1537 my ( $missinglist, $recievedlist ) = $sth->fetchrow;
1538
1539 if ( $status eq 2 ) {
1540 ### TODO Add a feature that improves recognition and description.
1541 ### As such count (serialseq) i.e. : N18,2(N19),N20
1542 ### Would use substr and index But be careful to previous presence of ()
1543 $recievedlist .= "; $serialseq" unless (index($recievedlist,$serialseq)>0);
1544 }
1545 if ( $status eq 4 ) {
1546 $missinglist .= "; $serialseq" unless (index($missinglist,$serialseq)>0);
1547 }
1548 $query = qq|
1549 UPDATE subscriptionhistory
1550 SET recievedlist=?, missinglist=?
1551 WHERE subscriptionid=?
1552 |;
1553 $sth = $dbh->prepare($query);
1554 $recievedlist =~ s/^; //;
1555 $missinglist =~ s/^; //;
1556 $sth->execute( $recievedlist, $missinglist, $subscriptionid );
1557 return $serialid;
1558}
1559
1560=head2 ItemizeSerials
1561
1562=over 4
1563
1564ItemizeSerials($serialid, $info);
1565$info is a hashref containing barcode branch, itemcallnumber, status, location
1566$serialid the serialid
1567return :
15681 if the itemize is a succes.
15690 and @error else. @error containts the list of errors found.
1570
1571=back
1572
1573=cut
1574
1575sub ItemizeSerials {
1576 my ( $serialid, $info ) = @_;
1577 my $now = POSIX::strftime( "%Y-%m-%d",localtime );
1578
1579 my $dbh = C4::Context->dbh;
1580 my $query = qq|
1581 SELECT *
1582 FROM serial
1583 WHERE serialid=?
1584 |;
1585 my $sth = $dbh->prepare($query);
1586 $sth->execute($serialid);
1587 my $data = $sth->fetchrow_hashref;
1588 if ( C4::Context->preference("RoutingSerials") ) {
1589
1590 # check for existing biblioitem relating to serial issue
1591 my ( $count, @results ) =
1592 GetBiblioItemByBiblioNumber( $data->{'biblionumber'} );
1593 my $bibitemno = 0;
1594 for ( my $i = 0 ; $i < $count ; $i++ ) {
1595 if ( $results[$i]->{'volumeddesc'} eq $data->{'serialseq'} . ' ('
1596 . $data->{'planneddate'}
1597 . ')' )
1598 {
1599 $bibitemno = $results[$i]->{'biblioitemnumber'};
1600 last;
1601 }
1602 }
1603 if ( $bibitemno == 0 ) {
1604
1605 # warn "need to add new biblioitem so copy last one and make minor changes";
1606 my $sth =
1607 $dbh->prepare(
1608"SELECT * FROM biblioitems WHERE biblionumber = ? ORDER BY biblioitemnumber DESC"
1609 );
1610 $sth->execute( $data->{'biblionumber'} );
1611 my $biblioitem = $sth->fetchrow_hashref;
1612 $biblioitem->{'volumedate'} =
1613 format_date_in_iso( $data->{planneddate} );
1614 $biblioitem->{'volumeddesc'} =
1615 $data->{serialseq} . ' ('
1616 . format_date( $data->{'planneddate'} ) . ')';
1617 $biblioitem->{'dewey'} = $info->{itemcallnumber};
1618
1619 #FIXME HDL : I don't understand why you need to call newbiblioitem, as the biblioitem should already be somewhere.
1620 # so I comment it, we can speak of it when you want
1621 # newbiblioitems has been removed from Biblio.pm, as it has a deprecated API now
1622# if ( $info->{barcode} )
1623# { # only make biblioitem if we are going to make item also
1624# $bibitemno = newbiblioitem($biblioitem);
1625# }
1626 }
1627 }
1628
1629 my $fwk = GetFrameworkCode( $data->{'biblionumber'} );
1630 if ( $info->{barcode} ) {
1631 my @errors;
1632 my $exists = itemdata( $info->{'barcode'} );
1633 push @errors, "barcode_not_unique" if ($exists);
1634 unless ($exists) {
1635 my $marcrecord = MARC::Record->new();
1636 my ( $tag, $subfield ) =
1637 GetMarcFromKohaField( "items.barcode", $fwk );
1638 my $newField =
1639 MARC::Field->new( "$tag", '', '',
1640 "$subfield" => $info->{barcode} );
1641 $marcrecord->insert_fields_ordered($newField);
1642 if ( $info->{branch} ) {
1643 my ( $tag, $subfield ) =
1644 GetMarcFromKohaField( "items.homebranch",
1645 $fwk );
1646
1647 #warn "items.homebranch : $tag , $subfield";
1648 if ( $marcrecord->field($tag) ) {
1649 $marcrecord->field($tag)
1650 ->add_subfields( "$subfield" => $info->{branch} );
1651 }
1652 else {
1653 my $newField =
1654 MARC::Field->new( "$tag", '', '',
1655 "$subfield" => $info->{branch} );
1656 $marcrecord->insert_fields_ordered($newField);
1657 }
1658 ( $tag, $subfield ) =
1659 GetMarcFromKohaField( "items.holdingbranch",
1660 $fwk );
1661
1662 #warn "items.holdingbranch : $tag , $subfield";
1663 if ( $marcrecord->field($tag) ) {
1664 $marcrecord->field($tag)
1665 ->add_subfields( "$subfield" => $info->{branch} );
1666 }
1667 else {
1668 my $newField =
1669 MARC::Field->new( "$tag", '', '',
1670 "$subfield" => $info->{branch} );
1671 $marcrecord->insert_fields_ordered($newField);
1672 }
1673 }
1674 if ( $info->{itemcallnumber} ) {
1675 my ( $tag, $subfield ) =
1676 GetMarcFromKohaField( "items.itemcallnumber",
1677 $fwk );
1678
1679 #warn "items.itemcallnumber : $tag , $subfield";
1680 if ( $marcrecord->field($tag) ) {
1681 $marcrecord->field($tag)
1682 ->add_subfields( "$subfield" => $info->{itemcallnumber} );
1683 }
1684 else {
1685 my $newField =
1686 MARC::Field->new( "$tag", '', '',
1687 "$subfield" => $info->{itemcallnumber} );
1688 $marcrecord->insert_fields_ordered($newField);
1689 }
1690 }
1691 if ( $info->{notes} ) {
1692 my ( $tag, $subfield ) =
1693 GetMarcFromKohaField( "items.itemnotes", $fwk );
1694
1695 # warn "items.itemnotes : $tag , $subfield";
1696 if ( $marcrecord->field($tag) ) {
1697 $marcrecord->field($tag)
1698 ->add_subfields( "$subfield" => $info->{notes} );
1699 }
1700 else {
1701 my $newField =
1702 MARC::Field->new( "$tag", '', '',
1703 "$subfield" => $info->{notes} );
1704 $marcrecord->insert_fields_ordered($newField);
1705 }
1706 }
1707 if ( $info->{location} ) {
1708 my ( $tag, $subfield ) =
1709 GetMarcFromKohaField( "items.location", $fwk );
1710
1711 # warn "items.location : $tag , $subfield";
1712 if ( $marcrecord->field($tag) ) {
1713 $marcrecord->field($tag)
1714 ->add_subfields( "$subfield" => $info->{location} );
1715 }
1716 else {
1717 my $newField =
1718 MARC::Field->new( "$tag", '', '',
1719 "$subfield" => $info->{location} );
1720 $marcrecord->insert_fields_ordered($newField);
1721 }
1722 }
1723 if ( $info->{status} ) {
1724 my ( $tag, $subfield ) =
1725 GetMarcFromKohaField( "items.notforloan",
1726 $fwk );
1727
1728 # warn "items.notforloan : $tag , $subfield";
1729 if ( $marcrecord->field($tag) ) {
1730 $marcrecord->field($tag)
1731 ->add_subfields( "$subfield" => $info->{status} );
1732 }
1733 else {
1734 my $newField =
1735 MARC::Field->new( "$tag", '', '',
1736 "$subfield" => $info->{status} );
1737 $marcrecord->insert_fields_ordered($newField);
1738 }
1739 }
1740 if ( C4::Context->preference("RoutingSerials") ) {
1741 my ( $tag, $subfield ) =
1742 GetMarcFromKohaField( "items.dateaccessioned",
1743 $fwk );
1744 if ( $marcrecord->field($tag) ) {
1745 $marcrecord->field($tag)
1746 ->add_subfields( "$subfield" => $now );
1747 }
1748 else {
1749 my $newField =
1750 MARC::Field->new( "$tag", '', '', "$subfield" => $now );
1751 $marcrecord->insert_fields_ordered($newField);
1752 }
1753 }
1754 AddItemFromMarc( $marcrecord, $data->{'biblionumber'} );
1755 return 1;
1756 }
1757 return ( 0, @errors );
1758 }
1759}
1760
1761=head2 HasSubscriptionExpired
1762
1763=over 4
1764
1765$has_expired = HasSubscriptionExpired($subscriptionid)
1766
1767the subscription has expired when the next issue to arrive is out of subscription limit.
1768
1769return :
17700 if the subscription has not expired
17711 if the subscription has expired
17722 if has subscription does not have a valid expiration date set
1773
1774=back
1775
1776=cut
1777
1778sub HasSubscriptionExpired {
1779 my ($subscriptionid) = @_;
1780 my $dbh = C4::Context->dbh;
1781 my $subscription = GetSubscription($subscriptionid);
1782 if (($subscription->{periodicity} % 16)>0){
1783 my $expirationdate = GetExpirationDate($subscriptionid);
1784 my $query = qq|
1785 SELECT max(planneddate)
1786 FROM serial
1787 WHERE subscriptionid=?
1788 |;
1789 my $sth = $dbh->prepare($query);
1790 $sth->execute($subscriptionid);
1791 my ($res) = $sth->fetchrow ;
1792 return 0 unless $res;
1793 my @res=split (/-/,$res);
1794 my @endofsubscriptiondate=split(/-/,$expirationdate);
1795 return 2 if (scalar(@res)!=3 || scalar(@endofsubscriptiondate)!=3||not check_date(@res) || not check_date(@endofsubscriptiondate));
1796 return 1 if ( (@endofsubscriptiondate && Delta_Days($res[0],$res[1],$res[2],
1797 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) <= 0)
1798 || (!$res));
1799 return 0;
1800 } else {
1801 if ($subscription->{'numberlength'}){
1802 my $countreceived=countissuesfrom($subscriptionid,$subscription->{'startdate'});
1803 return 1 if ($countreceived >$subscription->{'numberlength'});
1804 return 0;
1805 } else {
1806 return 0;
1807 }
1808 }
1809 return 0; # Notice that you'll never get here.
1810}
1811
1812=head2 DelSubscription
1813
1814=over 4
1815
1816DelSubscription($subscriptionid)
1817this function delete the subscription which has $subscriptionid as id.
1818
1819=back
1820
1821=cut
1822
1823sub DelSubscription {
1824 my ($subscriptionid) = @_;
1825 my $dbh = C4::Context->dbh;
1826 $subscriptionid = $dbh->quote($subscriptionid);
1827 $dbh->do("DELETE FROM subscription WHERE subscriptionid=$subscriptionid");
1828 $dbh->do(
1829 "DELETE FROM subscriptionhistory WHERE subscriptionid=$subscriptionid");
1830 $dbh->do("DELETE FROM serial WHERE subscriptionid=$subscriptionid");
1831
1832 logaction("SERIAL", "DELETE", $subscriptionid, "") if C4::Context->preference("SubscriptionLog");
1833}
1834
1835=head2 DelIssue
1836
1837=over 4
1838
1839DelIssue($serialseq,$subscriptionid)
1840this function delete an issue which has $serialseq and $subscriptionid given on input arg.
1841
1842=back
1843
1844=cut
1845
1846sub DelIssue {
1847 my ( $dataissue) = @_;
1848 my $dbh = C4::Context->dbh;
1849 ### TODO Add itemdeletion. Would need to get itemnumbers. Should be in a pref ?
1850
1851 my $query = qq|
1852 DELETE FROM serial
1853 WHERE serialid= ?
1854 AND subscriptionid= ?
1855 |;
1856 my $mainsth = $dbh->prepare($query);
1857 $mainsth->execute( $dataissue->{'serialid'}, $dataissue->{'subscriptionid'});
1858
1859 #Delete element from subscription history
1860 $query = "SELECT * FROM subscription WHERE subscriptionid = ?";
1861 my $sth = $dbh->prepare($query);
1862 $sth->execute($dataissue->{'subscriptionid'});
1863 my $val = $sth->fetchrow_hashref;
1864 unless ( $val->{manualhistory} ) {
1865 my $query = qq|
1866 SELECT * FROM subscriptionhistory
1867 WHERE subscriptionid= ?
1868 |;
1869 my $sth = $dbh->prepare($query);
1870 $sth->execute($dataissue->{'subscriptionid'});
1871 my $data = $sth->fetchrow_hashref;
1872 my $serialseq= $dataissue->{'serialseq'};
1873 $data->{'missinglist'} =~ s/\b$serialseq\b//;
1874 $data->{'recievedlist'} =~ s/\b$serialseq\b//;
1875 my $strsth = "UPDATE subscriptionhistory SET "
1876 . join( ",",
1877 map { join( "=", $_, $dbh->quote( $data->{$_} ) ) } keys %$data )
1878 . " WHERE subscriptionid=?";
1879 $sth = $dbh->prepare($strsth);
1880 $sth->execute($dataissue->{'subscriptionid'});
1881 }
1882
1883 return $mainsth->rows;
1884}
1885
1886=head2 GetLateOrMissingIssues
1887
1888=over 4
1889
1890($count,@issuelist) = &GetLateMissingIssues($supplierid,$serialid)
1891
1892this function select missing issues on database - where serial.status = 4 or serial.status=3 or planneddate<now
1893
1894return :
1895a count of the number of missing issues
1896the issuelist into a table. Each line of this table containts a ref to a hash which it containts
1897name,title,planneddate,serialseq,serial.subscriptionid from tables : subscription, serial & biblio
1898
1899=back
1900
1901=cut
1902
1903sub GetLateOrMissingIssues {
1904 my ( $supplierid, $serialid,$order ) = @_;
1905 my $dbh = C4::Context->dbh;
1906 my $sth;
1907 my $byserial = '';
1908 if ($serialid) {
1909 $byserial = "and serialid = " . $serialid;
1910 }
1911 if ($order){
1912 $order.=", title";
1913 } else {
1914 $order="title";
1915 }
1916 if ($supplierid) {
1917 $sth = $dbh->prepare(
1918"SELECT
1919 serialid,
1920 aqbooksellerid,
1921 name,
1922 biblio.title,
1923 planneddate,
1924 serialseq,
1925 serial.status,
1926 serial.subscriptionid,
1927 claimdate
1928FROM serial
1929LEFT JOIN subscription ON serial.subscriptionid=subscription.subscriptionid
1930LEFT JOIN biblio ON subscription.biblionumber=biblio.biblionumber
1931LEFT JOIN aqbooksellers ON subscription.aqbooksellerid = aqbooksellers.id
1932WHERE subscription.subscriptionid = serial.subscriptionid
1933AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1934AND subscription.aqbooksellerid=$supplierid
1935$byserial
1936ORDER BY $order"
1937 );
1938 }
1939 else {
1940 $sth = $dbh->prepare(
1941"SELECT
1942 serialid,
1943 aqbooksellerid,
1944 name,
1945 biblio.title,
1946 planneddate,
1947 serialseq,
1948 serial.status,
1949 serial.subscriptionid,
1950 claimdate
1951FROM serial
1952LEFT JOIN subscription
1953ON serial.subscriptionid=subscription.subscriptionid
1954LEFT JOIN biblio
1955ON subscription.biblionumber=biblio.biblionumber
1956LEFT JOIN aqbooksellers
1957ON subscription.aqbooksellerid = aqbooksellers.id
1958WHERE
1959 subscription.subscriptionid = serial.subscriptionid
1960AND (serial.STATUS = 4 OR ((planneddate < now() AND serial.STATUS =1) OR serial.STATUS = 3))
1961$byserial
1962ORDER BY $order"
1963 );
1964 }
1965 $sth->execute;
1966 my @issuelist;
1967 my $last_title;
1968 my $odd = 0;
1969 my $count = 0;
1970 while ( my $line = $sth->fetchrow_hashref ) {
1971 $odd++ unless $line->{title} eq $last_title;
1972 $last_title = $line->{title} if ( $line->{title} );
1973 $line->{planneddate} = format_date( $line->{planneddate} );
1974 $line->{claimdate} = format_date( $line->{claimdate} );
1975 $line->{"status".$line->{status}} = 1;
1976 $line->{'odd'} = 1 if $odd % 2;
1977 $count++;
1978 push @issuelist, $line;
1979 }
1980 return $count, @issuelist;
1981}
1982
1983=head2 removeMissingIssue
1984
1985=over 4
1986
1987removeMissingIssue($subscriptionid)
1988
1989this function removes an issue from being part of the missing string in
1990subscriptionlist.missinglist column
1991
1992called when a missing issue is found from the serials-recieve.pl file
1993
1994=back
1995
1996=cut
1997
1998sub removeMissingIssue {
1999 my ( $sequence, $subscriptionid ) = @_;
2000 my $dbh = C4::Context->dbh;
2001 my $sth =
2002 $dbh->prepare(
2003 "SELECT * FROM subscriptionhistory WHERE subscriptionid = ?");
2004 $sth->execute($subscriptionid);
2005 my $data = $sth->fetchrow_hashref;
2006 my $missinglist = $data->{'missinglist'};
2007 my $missinglistbefore = $missinglist;
2008
2009 # warn $missinglist." before";
2010 $missinglist =~ s/($sequence)//;
2011
2012 # warn $missinglist." after";
2013 if ( $missinglist ne $missinglistbefore ) {
2014 $missinglist =~ s/\|\s\|/\|/g;
2015 $missinglist =~ s/^\| //g;
2016 $missinglist =~ s/\|$//g;
2017 my $sth2 = $dbh->prepare(
2018 "UPDATE subscriptionhistory
2019 SET missinglist = ?
2020 WHERE subscriptionid = ?"
2021 );
2022 $sth2->execute( $missinglist, $subscriptionid );
2023 }
2024}
2025
2026=head2 updateClaim
2027
2028=over 4
2029
2030&updateClaim($serialid)
2031
2032this function updates the time when a claim is issued for late/missing items
2033
2034called from claims.pl file
2035
2036=back
2037
2038=cut
2039
2040sub updateClaim {
2041 my ($serialid) = @_;
2042 my $dbh = C4::Context->dbh;
2043 my $sth = $dbh->prepare(
2044 "UPDATE serial SET claimdate = now()
2045 WHERE serialid = ?
2046 "
2047 );
2048 $sth->execute($serialid);
2049}
2050
2051=head2 getsupplierbyserialid
2052
2053=over 4
2054
2055($result) = &getsupplierbyserialid($serialid)
2056
2057this function is used to find the supplier id given a serial id
2058
2059return :
2060hashref containing serialid, subscriptionid, and aqbooksellerid
2061
2062=back
2063
2064=cut
2065
2066sub getsupplierbyserialid {
2067 my ($serialid) = @_;
2068 my $dbh = C4::Context->dbh;
2069 my $sth = $dbh->prepare(
2070 "SELECT serialid, serial.subscriptionid, aqbooksellerid
2071 FROM serial
2072 LEFT JOIN subscription ON serial.subscriptionid = subscription.subscriptionid
2073 WHERE serialid = ?
2074 "
2075 );
2076 $sth->execute($serialid);
2077 my $line = $sth->fetchrow_hashref;
2078 my $result = $line->{'aqbooksellerid'};
2079 return $result;
2080}
2081
2082=head2 check_routing
2083
2084=over 4
2085
2086($result) = &check_routing($subscriptionid)
2087
2088this function checks to see if a serial has a routing list and returns the count of routingid
2089used to show either an 'add' or 'edit' link
2090
2091=back
2092
2093=cut
2094
2095sub check_routing {
2096 my ($subscriptionid) = @_;
2097 my $dbh = C4::Context->dbh;
2098 my $sth = $dbh->prepare(
2099"SELECT count(routingid) routingids FROM subscription LEFT JOIN subscriptionroutinglist
2100 ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2101 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2102 "
2103 );
2104 $sth->execute($subscriptionid);
2105 my $line = $sth->fetchrow_hashref;
2106 my $result = $line->{'routingids'};
2107 return $result;
2108}
2109
2110=head2 addroutingmember
2111
2112=over 4
2113
2114&addroutingmember($borrowernumber,$subscriptionid)
2115
2116this function takes a borrowernumber and subscriptionid and add the member to the
2117routing list for that serial subscription and gives them a rank on the list
2118of either 1 or highest current rank + 1
2119
2120=back
2121
2122=cut
2123
2124sub addroutingmember {
2125 my ( $borrowernumber, $subscriptionid ) = @_;
2126 my $rank;
2127 my $dbh = C4::Context->dbh;
2128 my $sth =
2129 $dbh->prepare(
2130"SELECT max(ranking) rank FROM subscriptionroutinglist WHERE subscriptionid = ?"
2131 );
2132 $sth->execute($subscriptionid);
2133 while ( my $line = $sth->fetchrow_hashref ) {
2134 if ( $line->{'rank'} > 0 ) {
2135 $rank = $line->{'rank'} + 1;
2136 }
2137 else {
2138 $rank = 1;
2139 }
2140 }
2141 $sth =
2142 $dbh->prepare(
2143"INSERT INTO subscriptionroutinglist (subscriptionid,borrowernumber,ranking) VALUES (?,?,?)"
2144 );
2145 $sth->execute( $subscriptionid, $borrowernumber, $rank );
2146}
2147
2148=head2 reorder_members
2149
2150=over 4
2151
2152&reorder_members($subscriptionid,$routingid,$rank)
2153
2154this function is used to reorder the routing list
2155
2156it takes the routingid of the member one wants to re-rank and the rank it is to move to
2157- it gets all members on list puts their routingid's into an array
2158- removes the one in the array that is $routingid
2159- then reinjects $routingid at point indicated by $rank
2160- then update the database with the routingids in the new order
2161
2162=back
2163
2164=cut
2165
2166sub reorder_members {
2167 my ( $subscriptionid, $routingid, $rank ) = @_;
2168 my $dbh = C4::Context->dbh;
2169 my $sth =
2170 $dbh->prepare(
2171"SELECT * FROM subscriptionroutinglist WHERE subscriptionid = ? ORDER BY ranking ASC"
2172 );
2173 $sth->execute($subscriptionid);
2174 my @result;
2175 while ( my $line = $sth->fetchrow_hashref ) {
2176 push( @result, $line->{'routingid'} );
2177 }
2178
2179 # To find the matching index
2180 my $i;
2181 my $key = -1; # to allow for 0 being a valid response
2182 for ( $i = 0 ; $i < @result ; $i++ ) {
2183 if ( $routingid == $result[$i] ) {
2184 $key = $i; # save the index
2185 last;
2186 }
2187 }
2188
2189 # if index exists in array then move it to new position
2190 if ( $key > -1 && $rank > 0 ) {
2191 my $new_rank = $rank -
2192 1; # $new_rank is what you want the new index to be in the array
2193 my $moving_item = splice( @result, $key, 1 );
2194 splice( @result, $new_rank, 0, $moving_item );
2195 }
2196 for ( my $j = 0 ; $j < @result ; $j++ ) {
2197 my $sth =
2198 $dbh->prepare( "UPDATE subscriptionroutinglist SET ranking = '"
2199 . ( $j + 1 )
2200 . "' WHERE routingid = '"
2201 . $result[$j]
2202 . "'" );
2203 $sth->execute;
2204 }
2205}
2206
2207=head2 delroutingmember
2208
2209=over 4
2210
2211&delroutingmember($routingid,$subscriptionid)
2212
2213this function either deletes one member from routing list if $routingid exists otherwise
2214deletes all members from the routing list
2215
2216=back
2217
2218=cut
2219
2220sub delroutingmember {
2221
2222# if $routingid exists then deletes that row otherwise deletes all with $subscriptionid
2223 my ( $routingid, $subscriptionid ) = @_;
2224 my $dbh = C4::Context->dbh;
2225 if ($routingid) {
2226 my $sth =
2227 $dbh->prepare(
2228 "DELETE FROM subscriptionroutinglist WHERE routingid = ?");
2229 $sth->execute($routingid);
2230 reorder_members( $subscriptionid, $routingid );
2231 }
2232 else {
2233 my $sth =
2234 $dbh->prepare(
2235 "DELETE FROM subscriptionroutinglist WHERE subscriptionid = ?");
2236 $sth->execute($subscriptionid);
2237 }
2238}
2239
2240=head2 getroutinglist
2241
2242=over 4
2243
2244($count,@routinglist) = &getroutinglist($subscriptionid)
2245
2246this gets the info from the subscriptionroutinglist for $subscriptionid
2247
2248return :
2249a count of the number of members on routinglist
2250the routinglist into a table. Each line of this table containts a ref to a hash which containts
2251routingid - a unique id, borrowernumber, ranking, and biblionumber of subscription
2252
2253=back
2254
2255=cut
2256
2257sub getroutinglist {
2258 my ($subscriptionid) = @_;
2259 my $dbh = C4::Context->dbh;
2260 my $sth = $dbh->prepare(
2261 "SELECT routingid, borrowernumber,
2262 ranking, biblionumber
2263 FROM subscription
2264 LEFT JOIN subscriptionroutinglist ON subscription.subscriptionid = subscriptionroutinglist.subscriptionid
2265 WHERE subscription.subscriptionid = ? ORDER BY ranking ASC
2266 "
2267 );
2268 $sth->execute($subscriptionid);
2269 my @routinglist;
2270 my $count = 0;
2271 while ( my $line = $sth->fetchrow_hashref ) {
2272 $count++;
2273 push( @routinglist, $line );
2274 }
2275 return ( $count, @routinglist );
2276}
2277
2278=head2 countissuesfrom
2279
2280=over 4
2281
2282$result = &countissuesfrom($subscriptionid,$startdate)
2283
2284
2285=back
2286
2287=cut
2288
2289sub countissuesfrom {
2290 my ($subscriptionid,$startdate) = @_;
2291 my $dbh = C4::Context->dbh;
2292 my $query = qq|
2293 SELECT count(*)
2294 FROM serial
2295 WHERE subscriptionid=?
2296 AND serial.publisheddate>?
2297 |;
2298 my $sth=$dbh->prepare($query);
2299 $sth->execute($subscriptionid, $startdate);
2300 my ($countreceived)=$sth->fetchrow;
2301 return $countreceived;
2302}
2303
2304=head2 abouttoexpire
2305
2306=over 4
2307
2308$result = &abouttoexpire($subscriptionid)
2309
2310this function alerts you to the penultimate issue for a serial subscription
2311
2312returns 1 - if this is the penultimate issue
2313returns 0 - if not
2314
2315=back
2316
2317=cut
2318
2319sub abouttoexpire {
2320 my ($subscriptionid) = @_;
2321 my $dbh = C4::Context->dbh;
2322 my $subscription = GetSubscription($subscriptionid);
2323 my $per = $subscription->{'periodicity'};
2324 if ($per % 16>0){
2325 my $expirationdate = GetExpirationDate($subscriptionid);
2326 my $sth =
2327 $dbh->prepare(
2328 "select max(planneddate) from serial where subscriptionid=?");
2329 $sth->execute($subscriptionid);
2330 my ($res) = $sth->fetchrow ;
2331# warn "date expiration : ".$expirationdate." date courante ".$res;
2332 my @res=split (/-/,$res);
2333 @res=Date::Calc::Today if ($res[0]*$res[1]==0);
2334 my @endofsubscriptiondate=split(/-/,$expirationdate);
2335 my $x;
2336 if ( $per == 1 ) {$x=7;}
2337 if ( $per == 2 ) {$x=7; }
2338 if ( $per == 3 ) {$x=14;}
2339 if ( $per == 4 ) { $x = 21; }
2340 if ( $per == 5 ) { $x = 31; }
2341 if ( $per == 6 ) { $x = 62; }
2342 if ( $per == 7 || $per == 8 ) { $x = 93; }
2343 if ( $per == 9 ) { $x = 190; }
2344 if ( $per == 10 ) { $x = 365; }
2345 if ( $per == 11 ) { $x = 730; }
2346 my @datebeforeend=Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2],
2347 - (3 * $x)) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]);
2348 # warn "DATE BEFORE END: $datebeforeend";
2349 return 1 if ( @res &&
2350 (@datebeforeend &&
2351 Delta_Days($res[0],$res[1],$res[2],
2352 $datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) &&
2353 (@endofsubscriptiondate &&
2354 Delta_Days($res[0],$res[1],$res[2],
2355 $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) );
2356 return 0;
2357 } elsif ($subscription->{numberlength}>0) {
2358 return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1);
2359 } else {return 0}
2360}
2361
2362=head2 GetNextDate
2363
2364($resultdate) = &GetNextDate($planneddate,$subscription)
2365
2366this function is an extension of GetNextDate which allows for checking for irregularity
2367
2368it takes the planneddate and will return the next issue's date and will skip dates if there
2369exists an irregularity
2370- eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be
2371skipped then the returned date will be 2007-05-10
2372
2373return :
2374$resultdate - then next date in the sequence
2375
2376Return 0 if periodicity==0
2377
2378=cut
2379sub in_array { # used in next sub down
2380 my ($val,@elements) = @_;
2381 foreach my $elem(@elements) {
2382 if($val == $elem) {
2383 return 1;
2384 }
2385 }
2386 return 0;
2387}
2388
2389sub GetNextDate(@) {
2390 my ( $planneddate, $subscription ) = @_;
2391 my @irreg = split( /\,/, $subscription->{irregularity} );
2392
2393 #date supposed to be in ISO.
2394
2395 my ( $year, $month, $day ) = split(/-/, $planneddate);
2396 $month=1 unless ($month);
2397 $day=1 unless ($day);
2398 my @resultdate;
2399
2400 # warn "DOW $dayofweek";
2401 if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular'
2402 return 0;
2403 }
2404 # daily : n / week
2405 # Since we're interpreting irregularity here as which days of the week to skip an issue,
2406 # renaming this pattern from 1/day to " n / week ".
2407 if ( $subscription->{periodicity} == 1 ) {
2408 my $dayofweek = eval{Day_of_Week( $year,$month, $day )};
2409 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2410 else {
2411 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2412 $dayofweek = 0 if ( $dayofweek == 7 );
2413 if ( in_array( ($dayofweek + 1), @irreg ) ) {
2414 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 1 );
2415 $dayofweek++;
2416 }
2417 }
2418 @resultdate = Add_Delta_Days($year,$month, $day , 1 );
2419 }
2420 }
2421 # 1 week
2422 if ( $subscription->{periodicity} == 2 ) {
2423 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2424 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2425 else {
2426 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2427 #FIXME: if two consecutive irreg, do we only skip one?
2428 if ( $irreg[$i] == (($wkno!=51)?($wkno +1) % 52 :52)) {
2429 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 7 );
2430 $wkno=(($wkno!=51)?($wkno +1) % 52 :52);
2431 }
2432 }
2433 @resultdate = Add_Delta_Days( $year,$month, $day, 7);
2434 }
2435 }
2436 # 1 / 2 weeks
2437 if ( $subscription->{periodicity} == 3 ) {
2438 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2439 if ($@){warn "year month day : $year $month $day $subscription->{subscriptionid} : $@";}
2440 else {
2441 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2442 if ( $irreg[$i] == (($wkno!=50)?($wkno +2) % 52 :52)) {
2443 ### BUGFIX was previously +1 ^
2444 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 14 );
2445 $wkno=(($wkno!=50)?($wkno +2) % 52 :52);
2446 }
2447 }
2448 @resultdate = Add_Delta_Days($year,$month, $day , 14 );
2449 }
2450 }
2451 # 1 / 3 weeks
2452 if ( $subscription->{periodicity} == 4 ) {
2453 my ($wkno,$year) = eval {Week_of_Year( $year,$month, $day )};
2454 if ($@){warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@";}
2455 else {
2456 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2457 if ( $irreg[$i] == (($wkno!=49)?($wkno +3) % 52 :52)) {
2458 ($year,$month,$day) = Add_Delta_Days($year,$month, $day , 21 );
2459 $wkno=(($wkno!=49)?($wkno +3) % 52 :52);
2460 }
2461 }
2462 @resultdate = Add_Delta_Days($year,$month, $day , 21 );
2463 }
2464 }
2465 my $tmpmonth=$month;
2466 if ($year && $month && $day){
2467 if ( $subscription->{periodicity} == 5 ) {
2468 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2469 if ( $irreg[$i] == (($tmpmonth!=11)?($tmpmonth +1) % 12 :12)) {
2470 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2471 $tmpmonth=(($tmpmonth!=11)?($tmpmonth +1) % 12 :12);
2472 }
2473 }
2474 @resultdate = Add_Delta_YMD($year,$month, $day ,0,1,0 );
2475 }
2476 if ( $subscription->{periodicity} == 6 ) {
2477 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2478 if ( $irreg[$i] == (($tmpmonth!=10)?($tmpmonth +2) % 12 :12)) {
2479 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day ,0,2,0 );
2480 $tmpmonth=(($tmpmonth!=10)?($tmpmonth + 2) % 12 :12);
2481 }
2482 }
2483 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 2,0 );
2484 }
2485 if ( $subscription->{periodicity} == 7 ) {
2486 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2487 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2488 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2489 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2490 }
2491 }
2492 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2493 }
2494 if ( $subscription->{periodicity} == 8 ) {
2495 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2496 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2497 ($year,$month,$day) = Add_Delta_YMD($year,$month, $day, 0, 3,0 );
2498 $tmpmonth=(($tmpmonth!=9)?($tmpmonth + 3) % 12 :12);
2499 }
2500 }
2501 @resultdate = Add_Delta_YMD($year,$month, $day, 0, 3, 0);
2502 }
2503 if ( $subscription->{periodicity} == 9 ) {
2504 for ( my $i = 0 ; $i < @irreg ; $i++ ) {
2505 if ( $irreg[$i] == (($tmpmonth!=9)?($tmpmonth +3) % 12 :12)) {
2506 ### BUFIX Seems to need more Than One ?
2507 ($year,$month,$day) = Add_Delta_YM($year,$month, $day, 0, 6 );
2508 $tmpmonth=(($tmpmonth!=6)?($tmpmonth + 6) % 12 :12);
2509 }
2510 }
2511 @resultdate = Add_Delta_YM($year,$month, $day, 0, 6);
2512 }
2513 if ( $subscription->{periodicity} == 10 ) {
2514 @resultdate = Add_Delta_YM($year,$month, $day, 1, 0 );
2515 }
2516 if ( $subscription->{periodicity} == 11 ) {
2517 @resultdate = Add_Delta_YM($year,$month, $day, 2, 0 );
2518 }
2519 }
2520 my $resultdate=sprintf("%04d-%02d-%02d",$resultdate[0],$resultdate[1],$resultdate[2]);
2521
2522# warn "dateNEXTSEQ : ".$resultdate;
2523 return "$resultdate";
2524}
2525
2526=head2 itemdata
2527
2528 $item = &itemdata($barcode);
2529
2530Looks up the item with the given barcode, and returns a
2531reference-to-hash containing information about that item. The keys of
2532the hash are the fields from the C<items> and C<biblioitems> tables in
2533the Koha database.
2534
2535=cut
2536
2537#'
2538sub itemdata {
2539 my ($barcode) = @_;
2540 my $dbh = C4::Context->dbh;
2541 my $sth = $dbh->prepare(
2542 "Select * from items LEFT JOIN biblioitems ON items.biblioitemnumber=biblioitems.biblioitemnumber
2543 WHERE barcode=?"
2544 );
2545 $sth->execute($barcode);
2546 my $data = $sth->fetchrow_hashref;
2547 $sth->finish;
2548 return ($data);
2549}
2550
255115µs5µs1;
2552__END__
2553
2554=head1 AUTHOR
2555
2556Koha Developement team <info@koha.org>
2557
2558=cut
Report produced by the NYTProf 2.10 Perl profiler, developed by Tim Bunce and Adam Kaplan.