|
Lines 18-31
package C4::Serials;
Link Here
|
| 18 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
18 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
| 19 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
19 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
| 20 |
|
20 |
|
| 21 |
use strict; |
21 |
use Modern::Perl; |
| 22 |
use warnings; |
22 |
|
| 23 |
use C4::Dates qw(format_date format_date_in_iso); |
23 |
use C4::Dates qw(format_date format_date_in_iso); |
| 24 |
use Date::Calc qw(:all); |
24 |
use Date::Calc qw(:all); |
| 25 |
use POSIX qw(strftime); |
25 |
use POSIX qw(strftime setlocale LC_TIME); |
| 26 |
use C4::Biblio; |
26 |
use C4::Biblio; |
| 27 |
use C4::Log; # logaction |
27 |
use C4::Log; # logaction |
| 28 |
use C4::Debug; |
28 |
use C4::Debug; |
|
|
29 |
use C4::Serials::Frequency; |
| 30 |
use C4::Serials::Numberpattern; |
| 29 |
|
31 |
|
| 30 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
32 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
| 31 |
|
33 |
|
|
Lines 39-46
BEGIN {
Link Here
|
| 39 |
&SearchSubscriptions |
41 |
&SearchSubscriptions |
| 40 |
&GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory |
42 |
&GetFullSubscriptionsFromBiblionumber &GetFullSubscription &ModSubscriptionHistory |
| 41 |
&HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire |
43 |
&HasSubscriptionStrictlyExpired &HasSubscriptionExpired &GetExpirationDate &abouttoexpire |
|
|
44 |
&GetSubscriptionHistoryFromSubscriptionId |
| 42 |
|
45 |
|
| 43 |
&GetNextSeq &NewIssue &ItemizeSerials &GetSerials |
46 |
&GetNextSeq &GetSeq &NewIssue &ItemizeSerials &GetSerials |
| 44 |
&GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2 |
47 |
&GetLatestSerials &ModSerialStatus &GetNextDate &GetSerials2 |
| 45 |
&ReNewSubscription &GetLateIssues &GetLateOrMissingIssues |
48 |
&ReNewSubscription &GetLateIssues &GetLateOrMissingIssues |
| 46 |
&GetSerialInformation &AddItem2Serial |
49 |
&GetSerialInformation &AddItem2Serial |
|
Lines 163-182
sub GetLateIssues {
Link Here
|
| 163 |
|
166 |
|
| 164 |
=head2 GetSubscriptionHistoryFromSubscriptionId |
167 |
=head2 GetSubscriptionHistoryFromSubscriptionId |
| 165 |
|
168 |
|
| 166 |
$sth = GetSubscriptionHistoryFromSubscriptionId() |
169 |
$history = GetSubscriptionHistoryFromSubscriptionId($subscriptionid); |
| 167 |
this function prepares the SQL request and returns the statement handle |
170 |
|
| 168 |
After this function, don't forget to execute it by using $sth->execute($subscriptionid) |
171 |
This function returns the subscription history as a hashref |
| 169 |
|
172 |
|
| 170 |
=cut |
173 |
=cut |
| 171 |
|
174 |
|
| 172 |
sub GetSubscriptionHistoryFromSubscriptionId { |
175 |
sub GetSubscriptionHistoryFromSubscriptionId { |
|
|
176 |
my ($subscriptionid) = @_; |
| 177 |
|
| 178 |
return unless $subscriptionid; |
| 179 |
|
| 173 |
my $dbh = C4::Context->dbh; |
180 |
my $dbh = C4::Context->dbh; |
| 174 |
my $query = qq| |
181 |
my $query = qq| |
| 175 |
SELECT * |
182 |
SELECT * |
| 176 |
FROM subscriptionhistory |
183 |
FROM subscriptionhistory |
| 177 |
WHERE subscriptionid = ? |
184 |
WHERE subscriptionid = ? |
| 178 |
|; |
185 |
|; |
| 179 |
return $dbh->prepare($query); |
186 |
my $sth = $dbh->prepare($query); |
|
|
187 |
$sth->execute($subscriptionid); |
| 188 |
my $results = $sth->fetchrow_hashref; |
| 189 |
$sth->finish; |
| 190 |
|
| 191 |
return $results; |
| 180 |
} |
192 |
} |
| 181 |
|
193 |
|
| 182 |
=head2 GetSerialStatusFromSerialId |
194 |
=head2 GetSerialStatusFromSerialId |
|
Lines 570-576
sub GetSubscriptions {
Link Here
|
| 570 |
my $dbh = C4::Context->dbh; |
582 |
my $dbh = C4::Context->dbh; |
| 571 |
my $sth; |
583 |
my $sth; |
| 572 |
my $sql = qq( |
584 |
my $sql = qq( |
| 573 |
SELECT subscription.*, subscriptionhistory.*, biblio.title,biblioitems.issn,biblio.biblionumber |
585 |
SELECT subscriptionhistory.*, subscription.*, biblio.title,biblioitems.issn,biblio.biblionumber |
| 574 |
FROM subscription |
586 |
FROM subscription |
| 575 |
LEFT JOIN subscriptionhistory USING(subscriptionid) |
587 |
LEFT JOIN subscriptionhistory USING(subscriptionid) |
| 576 |
LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber |
588 |
LEFT JOIN biblio ON biblio.biblionumber = subscription.biblionumber |
|
Lines 878-1005
sub GetDistributedTo {
Link Here
|
| 878 |
|
890 |
|
| 879 |
=head2 GetNextSeq |
891 |
=head2 GetNextSeq |
| 880 |
|
892 |
|
| 881 |
GetNextSeq($val) |
893 |
my ( |
| 882 |
$val is a hashref containing all the attributes of the table 'subscription' |
894 |
$nextseq, $newlastvalue1, $newlastvalue2, $newlastvalue3, |
|
|
895 |
$newinnerloop1, $newinnerloop2, $newinnerloop3 |
| 896 |
) = GetNextSeq( $subscription, $pattern, $planneddate ); |
| 897 |
|
| 898 |
$subscription is a hashref containing all the attributes of the table |
| 899 |
'subscription'. |
| 900 |
$pattern is a hashref containing all the attributes of the table |
| 901 |
'subscription_numberpatterns'. |
| 902 |
$planneddate is a C4::Dates object. |
| 883 |
This function get the next issue for the subscription given on input arg |
903 |
This function get the next issue for the subscription given on input arg |
| 884 |
return: |
|
|
| 885 |
a list containing all the input params updated. |
| 886 |
|
904 |
|
| 887 |
=cut |
905 |
=cut |
| 888 |
|
906 |
|
| 889 |
# sub GetNextSeq { |
|
|
| 890 |
# my ($val) =@_; |
| 891 |
# my ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3); |
| 892 |
# $calculated = $val->{numberingmethod}; |
| 893 |
# # calculate the (expected) value of the next issue recieved. |
| 894 |
# $newlastvalue1 = $val->{lastvalue1}; |
| 895 |
# # check if we have to increase the new value. |
| 896 |
# $newinnerloop1 = $val->{innerloop1}+1; |
| 897 |
# $newinnerloop1=0 if ($newinnerloop1 >= $val->{every1}); |
| 898 |
# $newlastvalue1 += $val->{add1} if ($newinnerloop1<1); # <1 to be true when 0 or empty. |
| 899 |
# $newlastvalue1=$val->{setto1} if ($newlastvalue1>$val->{whenmorethan1}); # reset counter if needed. |
| 900 |
# $calculated =~ s/\{X\}/$newlastvalue1/g; |
| 901 |
# |
| 902 |
# $newlastvalue2 = $val->{lastvalue2}; |
| 903 |
# # check if we have to increase the new value. |
| 904 |
# $newinnerloop2 = $val->{innerloop2}+1; |
| 905 |
# $newinnerloop2=0 if ($newinnerloop2 >= $val->{every2}); |
| 906 |
# $newlastvalue2 += $val->{add2} if ($newinnerloop2<1); # <1 to be true when 0 or empty. |
| 907 |
# $newlastvalue2=$val->{setto2} if ($newlastvalue2>$val->{whenmorethan2}); # reset counter if needed. |
| 908 |
# $calculated =~ s/\{Y\}/$newlastvalue2/g; |
| 909 |
# |
| 910 |
# $newlastvalue3 = $val->{lastvalue3}; |
| 911 |
# # check if we have to increase the new value. |
| 912 |
# $newinnerloop3 = $val->{innerloop3}+1; |
| 913 |
# $newinnerloop3=0 if ($newinnerloop3 >= $val->{every3}); |
| 914 |
# $newlastvalue3 += $val->{add3} if ($newinnerloop3<1); # <1 to be true when 0 or empty. |
| 915 |
# $newlastvalue3=$val->{setto3} if ($newlastvalue3>$val->{whenmorethan3}); # reset counter if needed. |
| 916 |
# $calculated =~ s/\{Z\}/$newlastvalue3/g; |
| 917 |
# return ($calculated,$newlastvalue1,$newlastvalue2,$newlastvalue3,$newinnerloop1,$newinnerloop2,$newinnerloop3); |
| 918 |
# } |
| 919 |
|
| 920 |
sub GetNextSeq { |
907 |
sub GetNextSeq { |
| 921 |
my ($val) = @_; |
908 |
my ($subscription, $pattern, $planneddate) = @_; |
| 922 |
my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 ); |
909 |
my ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, |
| 923 |
my $pattern = $val->{numberpattern}; |
910 |
$newinnerloop1, $newinnerloop2, $newinnerloop3 ); |
| 924 |
my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' ); |
911 |
my $count = 1; |
| 925 |
my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' ); |
912 |
|
| 926 |
$calculated = $val->{numberingmethod}; |
913 |
if ($subscription->{'skip_serialseq'}) { |
| 927 |
$newlastvalue1 = $val->{lastvalue1}; |
914 |
my @irreg = split /;/, $subscription->{'irregularity'}; |
| 928 |
$newlastvalue2 = $val->{lastvalue2}; |
915 |
if(@irreg > 0) { |
| 929 |
$newlastvalue3 = $val->{lastvalue3}; |
916 |
my $irregularities = {}; |
| 930 |
$newlastvalue1 = $val->{lastvalue1}; |
917 |
$irregularities->{$_} = 1 foreach(@irreg); |
| 931 |
|
918 |
my $issueno = GetFictiveIssueNumber($subscription, $planneddate) + 1; |
| 932 |
# check if we have to increase the new value. |
919 |
while($irregularities->{$issueno}) { |
| 933 |
$newinnerloop1 = $val->{innerloop1} + 1; |
920 |
$count++; |
| 934 |
$newinnerloop1 = 0 if ( $newinnerloop1 >= $val->{every1} ); |
921 |
$issueno++; |
| 935 |
$newlastvalue1 += $val->{add1} if ( $newinnerloop1 < 1 ); # <1 to be true when 0 or empty. |
922 |
} |
| 936 |
$newlastvalue1 = $val->{setto1} if ( $newlastvalue1 > $val->{whenmorethan1} ); # reset counter if needed. |
|
|
| 937 |
$calculated =~ s/\{X\}/$newlastvalue1/g; |
| 938 |
|
| 939 |
$newlastvalue2 = $val->{lastvalue2}; |
| 940 |
|
| 941 |
# check if we have to increase the new value. |
| 942 |
$newinnerloop2 = $val->{innerloop2} + 1; |
| 943 |
$newinnerloop2 = 0 if ( $newinnerloop2 >= $val->{every2} ); |
| 944 |
$newlastvalue2 += $val->{add2} if ( $newinnerloop2 < 1 ); # <1 to be true when 0 or empty. |
| 945 |
$newlastvalue2 = $val->{setto2} if ( $newlastvalue2 > $val->{whenmorethan2} ); # reset counter if needed. |
| 946 |
if ( $pattern == 6 ) { |
| 947 |
if ( $val->{hemisphere} == 2 ) { |
| 948 |
my $newlastvalue2seq = $southern_seasons[$newlastvalue2]; |
| 949 |
$calculated =~ s/\{Y\}/$newlastvalue2seq/g; |
| 950 |
} else { |
| 951 |
my $newlastvalue2seq = $seasons[$newlastvalue2]; |
| 952 |
$calculated =~ s/\{Y\}/$newlastvalue2seq/g; |
| 953 |
} |
923 |
} |
| 954 |
} else { |
|
|
| 955 |
$calculated =~ s/\{Y\}/$newlastvalue2/g; |
| 956 |
} |
924 |
} |
| 957 |
|
925 |
|
| 958 |
$newlastvalue3 = $val->{lastvalue3}; |
926 |
my $numberingmethod = $pattern->{numberingmethod}; |
| 959 |
|
927 |
$calculated = $numberingmethod; |
| 960 |
# check if we have to increase the new value. |
928 |
my $locale = $subscription->{locale}; |
| 961 |
$newinnerloop3 = $val->{innerloop3} + 1; |
929 |
$newlastvalue1 = $subscription->{lastvalue1} || 0; |
| 962 |
$newinnerloop3 = 0 if ( $newinnerloop3 >= $val->{every3} ); |
930 |
$newlastvalue2 = $subscription->{lastvalue2} || 0; |
| 963 |
$newlastvalue3 += $val->{add3} if ( $newinnerloop3 < 1 ); # <1 to be true when 0 or empty. |
931 |
$newlastvalue3 = $subscription->{lastvalue3} || 0; |
| 964 |
$newlastvalue3 = $val->{setto3} if ( $newlastvalue3 > $val->{whenmorethan3} ); # reset counter if needed. |
932 |
$newinnerloop1 = $subscription->{innerloop1} || 0; |
| 965 |
$calculated =~ s/\{Z\}/$newlastvalue3/g; |
933 |
$newinnerloop2 = $subscription->{innerloop2} || 0; |
|
|
934 |
$newinnerloop3 = $subscription->{innerloop3} || 0; |
| 935 |
my %calc; |
| 936 |
foreach(qw/X Y Z/) { |
| 937 |
$calc{$_} = 1 if ($numberingmethod =~ /\{$_\}/); |
| 938 |
} |
| 939 |
|
| 940 |
for(my $i = 0; $i < $count; $i++) { |
| 941 |
if($calc{'X'}) { |
| 942 |
# check if we have to increase the new value. |
| 943 |
$newinnerloop1 += 1; |
| 944 |
if ($newinnerloop1 >= $pattern->{every1}) { |
| 945 |
$newinnerloop1 = 0; |
| 946 |
$newlastvalue1 += $pattern->{add1}; |
| 947 |
} |
| 948 |
# reset counter if needed. |
| 949 |
$newlastvalue1 = $pattern->{setto1} if ($newlastvalue1 > $pattern->{whenmorethan1}); |
| 950 |
} |
| 951 |
if($calc{'Y'}) { |
| 952 |
# check if we have to increase the new value. |
| 953 |
$newinnerloop2 += 1; |
| 954 |
if ($newinnerloop2 >= $pattern->{every2}) { |
| 955 |
$newinnerloop2 = 0; |
| 956 |
$newlastvalue2 += $pattern->{add2}; |
| 957 |
} |
| 958 |
# reset counter if needed. |
| 959 |
$newlastvalue2 = $pattern->{setto2} if ($newlastvalue2 > $pattern->{whenmorethan2}); |
| 960 |
} |
| 961 |
if($calc{'Z'}) { |
| 962 |
# check if we have to increase the new value. |
| 963 |
$newinnerloop3 += 1; |
| 964 |
if ($newinnerloop3 >= $pattern->{every3}) { |
| 965 |
$newinnerloop3 = 0; |
| 966 |
$newlastvalue3 += $pattern->{add3}; |
| 967 |
} |
| 968 |
# reset counter if needed. |
| 969 |
$newlastvalue3 = $pattern->{setto3} if ($newlastvalue3 > $pattern->{whenmorethan3}); |
| 970 |
} |
| 971 |
} |
| 972 |
if($calc{'X'}) { |
| 973 |
my $newlastvalue1string = _numeration( $newlastvalue1, $pattern->{numbering1}, $locale ); |
| 974 |
$calculated =~ s/\{X\}/$newlastvalue1string/g; |
| 975 |
} |
| 976 |
if($calc{'Y'}) { |
| 977 |
my $newlastvalue2string = _numeration( $newlastvalue2, $pattern->{numbering2}, $locale ); |
| 978 |
$calculated =~ s/\{Y\}/$newlastvalue2string/g; |
| 979 |
} |
| 980 |
if($calc{'Z'}) { |
| 981 |
my $newlastvalue3string = _numeration( $newlastvalue3, $pattern->{numbering3}, $locale ); |
| 982 |
$calculated =~ s/\{Z\}/$newlastvalue3string/g; |
| 983 |
} |
| 966 |
|
984 |
|
| 967 |
return ( $calculated, $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3 ); |
985 |
return ($calculated, |
|
|
986 |
$newlastvalue1, $newlastvalue2, $newlastvalue3, |
| 987 |
$newinnerloop1, $newinnerloop2, $newinnerloop3); |
| 968 |
} |
988 |
} |
| 969 |
|
989 |
|
| 970 |
=head2 GetSeq |
990 |
=head2 GetSeq |
| 971 |
|
991 |
|
| 972 |
$calculated = GetSeq($val) |
992 |
$calculated = GetSeq($subscription, $pattern) |
| 973 |
$val is a hashref containing all the attributes of the table 'subscription' |
993 |
$subscription is a hashref containing all the attributes of the table 'subscription' |
|
|
994 |
$pattern is a hashref containing all the attributes of the table 'subscription_numberpatterns' |
| 974 |
this function transforms {X},{Y},{Z} to 150,0,0 for example. |
995 |
this function transforms {X},{Y},{Z} to 150,0,0 for example. |
| 975 |
return: |
996 |
return: |
| 976 |
the sequence in integer format |
997 |
the sequence in string format |
| 977 |
|
998 |
|
| 978 |
=cut |
999 |
=cut |
| 979 |
|
1000 |
|
| 980 |
sub GetSeq { |
1001 |
sub GetSeq { |
| 981 |
my ($val) = @_; |
1002 |
my ($subscription, $pattern) = @_; |
| 982 |
my $pattern = $val->{numberpattern}; |
1003 |
my $locale = $subscription->{locale}; |
| 983 |
my @seasons = ( 'nothing', 'Winter', 'Spring', 'Summer', 'Autumn' ); |
1004 |
|
| 984 |
my @southern_seasons = ( '', 'Summer', 'Autumn', 'Winter', 'Spring' ); |
1005 |
my $calculated = $pattern->{numberingmethod}; |
| 985 |
my $calculated = $val->{numberingmethod}; |
1006 |
|
| 986 |
my $x = $val->{'lastvalue1'}; |
1007 |
my $newlastvalue1 = $subscription->{'lastvalue1'} || 0; |
| 987 |
$calculated =~ s/\{X\}/$x/g; |
1008 |
$newlastvalue1 = _numeration($newlastvalue1, $pattern->{numbering1}, $locale) if ($pattern->{numbering1}); # reset counter if needed. |
| 988 |
my $newlastvalue2 = $val->{'lastvalue2'}; |
1009 |
$calculated =~ s/\{X\}/$newlastvalue1/g; |
| 989 |
|
1010 |
|
| 990 |
if ( $pattern == 6 ) { |
1011 |
my $newlastvalue2 = $subscription->{'lastvalue2'} || 0; |
| 991 |
if ( $val->{hemisphere} == 2 ) { |
1012 |
$newlastvalue2 = _numeration($newlastvalue2, $pattern->{numbering2}, $locale) if ($pattern->{numbering2}); # reset counter if needed. |
| 992 |
my $newlastvalue2seq = $southern_seasons[$newlastvalue2]; |
1013 |
$calculated =~ s/\{Y\}/$newlastvalue2/g; |
| 993 |
$calculated =~ s/\{Y\}/$newlastvalue2seq/g; |
1014 |
|
| 994 |
} else { |
1015 |
my $newlastvalue3 = $subscription->{'lastvalue3'} || 0; |
| 995 |
my $newlastvalue2seq = $seasons[$newlastvalue2]; |
1016 |
$newlastvalue3 = _numeration($newlastvalue3, $pattern->{numbering3}, $locale) if ($pattern->{numbering3}); # reset counter if needed. |
| 996 |
$calculated =~ s/\{Y\}/$newlastvalue2seq/g; |
1017 |
$calculated =~ s/\{Z\}/$newlastvalue3/g; |
| 997 |
} |
|
|
| 998 |
} else { |
| 999 |
$calculated =~ s/\{Y\}/$newlastvalue2/g; |
| 1000 |
} |
| 1001 |
my $z = $val->{'lastvalue3'}; |
| 1002 |
$calculated =~ s/\{Z\}/$z/g; |
| 1003 |
return $calculated; |
1018 |
return $calculated; |
| 1004 |
} |
1019 |
} |
| 1005 |
|
1020 |
|
|
Lines 1024-1037
sub GetExpirationDate {
Link Here
|
| 1024 |
$enddate = $startdate || $subscription->{startdate}; |
1039 |
$enddate = $startdate || $subscription->{startdate}; |
| 1025 |
my @date = split( /-/, $enddate ); |
1040 |
my @date = split( /-/, $enddate ); |
| 1026 |
return if ( scalar(@date) != 3 || not check_date(@date) ); |
1041 |
return if ( scalar(@date) != 3 || not check_date(@date) ); |
| 1027 |
if ( ( $subscription->{periodicity} % 16 ) > 0 ) { |
1042 |
my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity}); |
|
|
1043 |
if ( $frequency and $frequency->{unit} ) { |
| 1028 |
|
1044 |
|
| 1029 |
# If Not Irregular |
1045 |
# If Not Irregular |
| 1030 |
if ( my $length = $subscription->{numberlength} ) { |
1046 |
if ( my $length = $subscription->{numberlength} ) { |
| 1031 |
|
1047 |
|
| 1032 |
#calculate the date of the last issue. |
1048 |
#calculate the date of the last issue. |
| 1033 |
for ( my $i = 1 ; $i <= $length ; $i++ ) { |
1049 |
for ( my $i = 1 ; $i <= $length ; $i++ ) { |
| 1034 |
$enddate = GetNextDate( $enddate, $subscription ); |
1050 |
$enddate = GetNextDate( $subscription, $enddate ); |
| 1035 |
} |
1051 |
} |
| 1036 |
} elsif ( $subscription->{monthlength} ) { |
1052 |
} elsif ( $subscription->{monthlength} ) { |
| 1037 |
if ( $$subscription{startdate} ) { |
1053 |
if ( $$subscription{startdate} ) { |
|
Lines 1044-1053
sub GetExpirationDate {
Link Here
|
| 1044 |
my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 ); |
1060 |
my @enddate = Add_Delta_Days( $date[0], $date[1], $date[2], $subscription->{weeklength} * 7 ); |
| 1045 |
$enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] ); |
1061 |
$enddate = sprintf( "%04d-%02d-%02d", $enddate[0], $enddate[1], $enddate[2] ); |
| 1046 |
} |
1062 |
} |
|
|
1063 |
} else { |
| 1064 |
$enddate = $subscription->{enddate}; |
| 1047 |
} |
1065 |
} |
| 1048 |
return $enddate; |
1066 |
return $enddate; |
| 1049 |
} else { |
1067 |
} else { |
| 1050 |
return; |
1068 |
return $subscription->{enddate}; |
| 1051 |
} |
1069 |
} |
| 1052 |
} |
1070 |
} |
| 1053 |
|
1071 |
|
|
Lines 1080-1099
returns the number of rows affected
Link Here
|
| 1080 |
=cut |
1098 |
=cut |
| 1081 |
|
1099 |
|
| 1082 |
sub ModSubscriptionHistory { |
1100 |
sub ModSubscriptionHistory { |
| 1083 |
my ( $subscriptionid, $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote ) = @_; |
1101 |
my ( $subscriptionid, $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote ) = @_; |
| 1084 |
my $dbh = C4::Context->dbh; |
1102 |
my $dbh = C4::Context->dbh; |
| 1085 |
my $query = "UPDATE subscriptionhistory |
1103 |
my $query = "UPDATE subscriptionhistory |
| 1086 |
SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? |
1104 |
SET histstartdate=?,histenddate=?,recievedlist=?,missinglist=?,opacnote=?,librariannote=? |
| 1087 |
WHERE subscriptionid=? |
1105 |
WHERE subscriptionid=? |
| 1088 |
"; |
1106 |
"; |
| 1089 |
my $sth = $dbh->prepare($query); |
1107 |
my $sth = $dbh->prepare($query); |
| 1090 |
$recievedlist =~ s/^; //; |
1108 |
$receivedlist =~ s/^; // if $receivedlist; |
| 1091 |
$missinglist =~ s/^; //; |
1109 |
$missinglist =~ s/^; // if $missinglist; |
| 1092 |
$opacnote =~ s/^; //; |
1110 |
$opacnote =~ s/^; // if $opacnote; |
| 1093 |
$sth->execute( $histstartdate, $enddate, $recievedlist, $missinglist, $opacnote, $librariannote, $subscriptionid ); |
1111 |
$sth->execute( $histstartdate, $enddate, $receivedlist, $missinglist, $opacnote, $librariannote, $subscriptionid ); |
| 1094 |
return $sth->rows; |
1112 |
return $sth->rows; |
| 1095 |
} |
1113 |
} |
| 1096 |
|
1114 |
|
|
|
1115 |
# Update missinglist field, used by ModSerialStatus |
| 1116 |
sub _update_missinglist { |
| 1117 |
my $subscriptionid = shift; |
| 1118 |
|
| 1119 |
my $dbh = C4::Context->dbh; |
| 1120 |
my @missingserials = GetSerials2($subscriptionid, "4,5"); |
| 1121 |
my $missinglist; |
| 1122 |
foreach (@missingserials) { |
| 1123 |
if($_->{'status'} == 4) { |
| 1124 |
$missinglist .= $_->{'serialseq'} . "; "; |
| 1125 |
} elsif($_->{'status'} == 5) { |
| 1126 |
$missinglist .= "not issued " . $_->{'serialseq'} . "; "; |
| 1127 |
} |
| 1128 |
} |
| 1129 |
$missinglist =~ s/; $//; |
| 1130 |
my $query = qq{ |
| 1131 |
UPDATE subscriptionhistory |
| 1132 |
SET missinglist = ? |
| 1133 |
WHERE subscriptionid = ? |
| 1134 |
}; |
| 1135 |
my $sth = $dbh->prepare($query); |
| 1136 |
$sth->execute($missinglist, $subscriptionid); |
| 1137 |
} |
| 1138 |
|
| 1139 |
# Update recievedlist field, used by ModSerialStatus |
| 1140 |
sub _update_receivedlist { |
| 1141 |
my $subscriptionid = shift; |
| 1142 |
|
| 1143 |
my $dbh = C4::Context->dbh; |
| 1144 |
my @receivedserials = GetSerials2($subscriptionid, "2"); |
| 1145 |
my $receivedlist; |
| 1146 |
foreach (@receivedserials) { |
| 1147 |
$receivedlist .= $_->{'serialseq'} . "; "; |
| 1148 |
} |
| 1149 |
$receivedlist =~ s/; $//; |
| 1150 |
my $query = qq{ |
| 1151 |
UPDATE subscriptionhistory |
| 1152 |
SET recievedlist = ? |
| 1153 |
WHERE subscriptionid = ? |
| 1154 |
}; |
| 1155 |
my $sth = $dbh->prepare($query); |
| 1156 |
$sth->execute($receivedlist, $subscriptionid); |
| 1157 |
} |
| 1158 |
|
| 1097 |
=head2 ModSerialStatus |
1159 |
=head2 ModSerialStatus |
| 1098 |
|
1160 |
|
| 1099 |
ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes) |
1161 |
ModSerialStatus($serialid,$serialseq, $planneddate,$publisheddate,$status,$notes) |
|
Lines 1106-1127
Note : if we change from "waited" to something else,then we will have to create
Link Here
|
| 1106 |
sub ModSerialStatus { |
1168 |
sub ModSerialStatus { |
| 1107 |
my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_; |
1169 |
my ( $serialid, $serialseq, $planneddate, $publisheddate, $status, $notes ) = @_; |
| 1108 |
|
1170 |
|
|
|
1171 |
|
| 1109 |
#It is a usual serial |
1172 |
#It is a usual serial |
| 1110 |
# 1st, get previous status : |
1173 |
# 1st, get previous status : |
| 1111 |
my $dbh = C4::Context->dbh; |
1174 |
my $dbh = C4::Context->dbh; |
| 1112 |
my $query = "SELECT subscriptionid,status FROM serial WHERE serialid=?"; |
1175 |
my $query = "SELECT serial.subscriptionid,serial.status,subscription.periodicity |
|
|
1176 |
FROM serial, subscription |
| 1177 |
WHERE serial.subscriptionid=subscription.subscriptionid |
| 1178 |
AND serialid=?"; |
| 1113 |
my $sth = $dbh->prepare($query); |
1179 |
my $sth = $dbh->prepare($query); |
| 1114 |
$sth->execute($serialid); |
1180 |
$sth->execute($serialid); |
| 1115 |
my ( $subscriptionid, $oldstatus ) = $sth->fetchrow; |
1181 |
my ( $subscriptionid, $oldstatus, $periodicity ) = $sth->fetchrow; |
|
|
1182 |
my $frequency = GetSubscriptionFrequency($periodicity); |
| 1116 |
|
1183 |
|
| 1117 |
# change status & update subscriptionhistory |
1184 |
# change status & update subscriptionhistory |
| 1118 |
my $val; |
1185 |
my $val; |
| 1119 |
if ( $status == 6 ) { |
1186 |
if ( $status == 6 ) { |
| 1120 |
DelIssue( {'serialid'=>$serialid, 'subscriptionid'=>$subscriptionid,'serialseq'=>$serialseq} ); |
1187 |
DelIssue( { 'serialid' => $serialid, 'subscriptionid' => $subscriptionid, 'serialseq' => $serialseq } ); |
| 1121 |
} |
1188 |
} else { |
| 1122 |
else { |
1189 |
|
| 1123 |
my $query = |
1190 |
unless ($frequency->{'unit'}) { |
| 1124 |
'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?'; |
1191 |
if ( not $planneddate or $planneddate eq '0000-00-00' ) { $planneddate = C4::Dates->new()->output('iso') }; |
|
|
1192 |
if ( not $publisheddate or $publisheddate eq '0000-00-00' ) { $publisheddate = C4::Dates->new()->output('iso') }; |
| 1193 |
} |
| 1194 |
my $query = 'UPDATE serial SET serialseq=?,publisheddate=?,planneddate=?,status=?,notes=? WHERE serialid = ?'; |
| 1125 |
$sth = $dbh->prepare($query); |
1195 |
$sth = $dbh->prepare($query); |
| 1126 |
$sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid ); |
1196 |
$sth->execute( $serialseq, $publisheddate, $planneddate, $status, $notes, $serialid ); |
| 1127 |
$query = "SELECT * FROM subscription WHERE subscriptionid = ?"; |
1197 |
$query = "SELECT * FROM subscription WHERE subscriptionid = ?"; |
|
Lines 1129-1186
sub ModSerialStatus {
Link Here
|
| 1129 |
$sth->execute($subscriptionid); |
1199 |
$sth->execute($subscriptionid); |
| 1130 |
my $val = $sth->fetchrow_hashref; |
1200 |
my $val = $sth->fetchrow_hashref; |
| 1131 |
unless ( $val->{manualhistory} ) { |
1201 |
unless ( $val->{manualhistory} ) { |
| 1132 |
$query = "SELECT missinglist,recievedlist FROM subscriptionhistory WHERE subscriptionid=?"; |
1202 |
if ( $status == 2 || ($oldstatus == 2 && $status != 2) ) { |
| 1133 |
$sth = $dbh->prepare($query); |
1203 |
_update_receivedlist($subscriptionid); |
| 1134 |
$sth->execute($subscriptionid); |
1204 |
} |
| 1135 |
my ( $missinglist, $recievedlist ) = $sth->fetchrow; |
1205 |
if($status == 4 || $status == 5 |
| 1136 |
if ( $status == 2 ) { |
1206 |
|| ($oldstatus == 4 && $status != 4) |
| 1137 |
|
1207 |
|| ($oldstatus == 5 && $status != 5)) { |
| 1138 |
$recievedlist .= "; $serialseq" |
1208 |
_update_missinglist($subscriptionid); |
| 1139 |
unless ( index( "$recievedlist", "$serialseq" ) >= 0 ); |
|
|
| 1140 |
} |
1209 |
} |
| 1141 |
|
|
|
| 1142 |
# warn "missinglist : $missinglist serialseq :$serialseq, ".index("$missinglist","$serialseq"); |
| 1143 |
$missinglist .= "; $serialseq" |
| 1144 |
if ( $status == 4 |
| 1145 |
and not index( "$missinglist", "$serialseq" ) >= 0 ); |
| 1146 |
$missinglist .= "; not issued $serialseq" |
| 1147 |
if ( $status == 5 |
| 1148 |
and index( "$missinglist", "$serialseq" ) >= 0 ); |
| 1149 |
$query = "UPDATE subscriptionhistory SET recievedlist=?, missinglist=? WHERE subscriptionid=?"; |
| 1150 |
$sth = $dbh->prepare($query); |
| 1151 |
$recievedlist =~ s/^; //; |
| 1152 |
$missinglist =~ s/^; //; |
| 1153 |
$sth->execute( $recievedlist, $missinglist, $subscriptionid ); |
| 1154 |
} |
1210 |
} |
| 1155 |
} |
1211 |
} |
| 1156 |
|
1212 |
|
| 1157 |
# create new waited entry if needed (ie : was a "waited" and has changed) |
1213 |
# create new waited entry if needed (ie : was a "waited" and has changed) |
| 1158 |
if ( $oldstatus == 1 && $status != 1 ) { |
1214 |
if ( $oldstatus == 1 && $status != 1 ) { |
| 1159 |
my $query = "SELECT * FROM subscription WHERE subscriptionid = ?"; |
1215 |
my $subscription = GetSubscription($subscriptionid); |
| 1160 |
$sth = $dbh->prepare($query); |
1216 |
my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern}); |
| 1161 |
$sth->execute($subscriptionid); |
|
|
| 1162 |
my $val = $sth->fetchrow_hashref; |
| 1163 |
|
1217 |
|
| 1164 |
# next issue number |
1218 |
# next issue number |
| 1165 |
my ( |
1219 |
my ( |
| 1166 |
$newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3, |
1220 |
$newserialseq, $newlastvalue1, $newlastvalue2, $newlastvalue3, |
| 1167 |
$newinnerloop1, $newinnerloop2, $newinnerloop3 |
1221 |
$newinnerloop1, $newinnerloop2, $newinnerloop3 |
| 1168 |
) = GetNextSeq($val); |
1222 |
) |
|
|
1223 |
= GetNextSeq( $subscription, $pattern, $publisheddate ); |
| 1169 |
|
1224 |
|
| 1170 |
# next date (calculated from actual date & frequency parameters) |
1225 |
# next date (calculated from actual date & frequency parameters) |
| 1171 |
my $nextpublisheddate = GetNextDate( $publisheddate, $val ); |
1226 |
my $nextpublisheddate = GetNextDate($subscription, $publisheddate, 1); |
| 1172 |
NewIssue( $newserialseq, $subscriptionid, $val->{'biblionumber'}, 1, $nextpublisheddate, $nextpublisheddate ); |
1227 |
my $nextpubdate = $nextpublisheddate; |
|
|
1228 |
NewIssue( $newserialseq, $subscriptionid, $subscription->{'biblionumber'}, 1, $nextpubdate, $nextpubdate ); |
| 1173 |
$query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=? |
1229 |
$query = "UPDATE subscription SET lastvalue1=?, lastvalue2=?, lastvalue3=?, innerloop1=?, innerloop2=?, innerloop3=? |
| 1174 |
WHERE subscriptionid = ?"; |
1230 |
WHERE subscriptionid = ?"; |
| 1175 |
$sth = $dbh->prepare($query); |
1231 |
$sth = $dbh->prepare($query); |
| 1176 |
$sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid ); |
1232 |
$sth->execute( $newlastvalue1, $newlastvalue2, $newlastvalue3, $newinnerloop1, $newinnerloop2, $newinnerloop3, $subscriptionid ); |
| 1177 |
|
1233 |
|
| 1178 |
# check if an alert must be sent... (= a letter is defined & status became "arrived" |
1234 |
# check if an alert must be sent... (= a letter is defined & status became "arrived" |
| 1179 |
if ( $val->{letter} && $status == 2 && $oldstatus != 2 ) { |
1235 |
if ( $subscription->{letter} && $status == 2 && $oldstatus != 2 ) { |
| 1180 |
require C4::Letters; |
1236 |
require C4::Letters; |
| 1181 |
C4::Letters::SendAlerts( 'issue', $val->{subscriptionid}, $val->{letter} ); |
1237 |
C4::Letters::SendAlerts( 'issue', $subscription->{subscriptionid}, $subscription->{letter} ); |
| 1182 |
} |
1238 |
} |
| 1183 |
} |
1239 |
} |
|
|
1240 |
|
| 1184 |
return; |
1241 |
return; |
| 1185 |
} |
1242 |
} |
| 1186 |
|
1243 |
|
|
Lines 1194-1224
returns a hashref:
Link Here
|
| 1194 |
|
1251 |
|
| 1195 |
$nextexepected = { |
1252 |
$nextexepected = { |
| 1196 |
serialid => int |
1253 |
serialid => int |
| 1197 |
planneddate => C4::Dates object |
1254 |
planneddate => ISO date |
| 1198 |
} |
1255 |
} |
| 1199 |
|
1256 |
|
| 1200 |
=cut |
1257 |
=cut |
| 1201 |
|
1258 |
|
| 1202 |
sub GetNextExpected { |
1259 |
sub GetNextExpected { |
| 1203 |
my ($subscriptionid) = @_; |
1260 |
my ($subscriptionid) = @_; |
| 1204 |
my $dbh = C4::Context->dbh; |
1261 |
|
| 1205 |
my $sth = $dbh->prepare('SELECT serialid, planneddate FROM serial WHERE subscriptionid=? AND status=?'); |
1262 |
my $dbh = C4::Context->dbh; |
|
|
1263 |
my $query = qq{ |
| 1264 |
SELECT * |
| 1265 |
FROM serial |
| 1266 |
WHERE subscriptionid = ? |
| 1267 |
AND status = ? |
| 1268 |
LIMIT 1 |
| 1269 |
}; |
| 1270 |
my $sth = $dbh->prepare($query); |
| 1206 |
|
1271 |
|
| 1207 |
# Each subscription has only one 'expected' issue, with serial.status==1. |
1272 |
# Each subscription has only one 'expected' issue, with serial.status==1. |
| 1208 |
$sth->execute( $subscriptionid, 1 ); |
1273 |
$sth->execute( $subscriptionid, 1 ); |
| 1209 |
my ( $nextissue ) = $sth->fetchrow_hashref; |
1274 |
my $nextissue = $sth->fetchrow_hashref; |
| 1210 |
if( !$nextissue){ |
1275 |
if ( !$nextissue ) { |
| 1211 |
$sth = $dbh->prepare('SELECT serialid,planneddate FROM serial WHERE subscriptionid = ? ORDER BY planneddate DESC LIMIT 1'); |
1276 |
$query = qq{ |
| 1212 |
$sth->execute( $subscriptionid ); |
1277 |
SELECT * |
| 1213 |
$nextissue = $sth->fetchrow_hashref; |
1278 |
FROM serial |
|
|
1279 |
WHERE subscriptionid = ? |
| 1280 |
ORDER BY publisheddate DESC |
| 1281 |
LIMIT 1 |
| 1282 |
}; |
| 1283 |
$sth = $dbh->prepare($query); |
| 1284 |
$sth->execute($subscriptionid); |
| 1285 |
$nextissue = $sth->fetchrow_hashref; |
| 1214 |
} |
1286 |
} |
| 1215 |
if (!defined $nextissue->{planneddate}) { |
1287 |
foreach(qw/planneddate publisheddate/) { |
| 1216 |
# or should this default to 1st Jan ??? |
1288 |
if ( !defined $nextissue->{$_} ) { |
| 1217 |
$nextissue->{planneddate} = strftime('%Y-%m-%d',localtime); |
1289 |
# or should this default to 1st Jan ??? |
|
|
1290 |
$nextissue->{$_} = strftime( '%Y-%m-%d', localtime ); |
| 1291 |
} |
| 1292 |
$nextissue->{$_} = ($nextissue->{$_} ne '0000-00-00') |
| 1293 |
? $nextissue->{$_} |
| 1294 |
: undef; |
| 1218 |
} |
1295 |
} |
| 1219 |
$nextissue->{planneddate} = C4::Dates->new($nextissue->{planneddate},'iso'); |
|
|
| 1220 |
return $nextissue; |
| 1221 |
|
1296 |
|
|
|
1297 |
return $nextissue; |
| 1222 |
} |
1298 |
} |
| 1223 |
|
1299 |
|
| 1224 |
=head2 ModNextExpected |
1300 |
=head2 ModNextExpected |
|
Lines 1228-1234
ModNextExpected($subscriptionid,$date)
Link Here
|
| 1228 |
Update the planneddate for the current expected issue of the subscription. |
1304 |
Update the planneddate for the current expected issue of the subscription. |
| 1229 |
This will modify all future prediction results. |
1305 |
This will modify all future prediction results. |
| 1230 |
|
1306 |
|
| 1231 |
C<$date> is a C4::Dates object. |
1307 |
C<$date> is an ISO date. |
| 1232 |
|
1308 |
|
| 1233 |
returns 0 |
1309 |
returns 0 |
| 1234 |
|
1310 |
|
|
Lines 1242-1252
sub ModNextExpected {
Link Here
|
| 1242 |
my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?'); |
1318 |
my $sth = $dbh->prepare('UPDATE serial SET planneddate=?,publisheddate=? WHERE subscriptionid=? AND status=?'); |
| 1243 |
|
1319 |
|
| 1244 |
# Each subscription has only one 'expected' issue, with serial.status==1. |
1320 |
# Each subscription has only one 'expected' issue, with serial.status==1. |
| 1245 |
$sth->execute( $date->output('iso'), $date->output('iso'), $subscriptionid, 1 ); |
1321 |
$sth->execute( $date, $date, $subscriptionid, 1 ); |
| 1246 |
return 0; |
1322 |
return 0; |
| 1247 |
|
1323 |
|
| 1248 |
} |
1324 |
} |
| 1249 |
|
1325 |
|
|
|
1326 |
=head2 GetSubscriptionIrregularities |
| 1327 |
|
| 1328 |
=over 4 |
| 1329 |
|
| 1330 |
=item @irreg = &GetSubscriptionIrregularities($subscriptionid); |
| 1331 |
get the list of irregularities for a subscription |
| 1332 |
|
| 1333 |
=back |
| 1334 |
|
| 1335 |
=cut |
| 1336 |
|
| 1337 |
sub GetSubscriptionIrregularities { |
| 1338 |
my $subscriptionid = shift; |
| 1339 |
|
| 1340 |
return unless $subscriptionid; |
| 1341 |
|
| 1342 |
my $dbh = C4::Context->dbh; |
| 1343 |
my $query = qq{ |
| 1344 |
SELECT irregularity |
| 1345 |
FROM subscription |
| 1346 |
WHERE subscriptionid = ? |
| 1347 |
}; |
| 1348 |
my $sth = $dbh->prepare($query); |
| 1349 |
$sth->execute($subscriptionid); |
| 1350 |
|
| 1351 |
my ($result) = $sth->fetchrow_array; |
| 1352 |
my @irreg = split /;/, $result; |
| 1353 |
|
| 1354 |
return @irreg; |
| 1355 |
} |
| 1356 |
|
| 1250 |
=head2 ModSubscription |
1357 |
=head2 ModSubscription |
| 1251 |
|
1358 |
|
| 1252 |
this function modifies a subscription. Put all new values on input args. |
1359 |
this function modifies a subscription. Put all new values on input args. |
|
Lines 1255-1297
returns the number of rows affected
Link Here
|
| 1255 |
=cut |
1362 |
=cut |
| 1256 |
|
1363 |
|
| 1257 |
sub ModSubscription { |
1364 |
sub ModSubscription { |
| 1258 |
my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate, |
1365 |
my ( |
| 1259 |
$dow, $irregularity, $numberpattern, $numberlength, $weeklength, $monthlength, $add1, $every1, |
1366 |
$auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, |
| 1260 |
$whenmorethan1, $setto1, $lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, |
1367 |
$periodicity, $firstacquidate, $irregularity, $numberpattern, $locale, |
| 1261 |
$lastvalue2, $innerloop2, $add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, |
1368 |
$numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1, |
| 1262 |
$numberingmethod, $status, $biblionumber, $callnumber, $notes, $letter, $hemisphere, $manualhistory, |
1369 |
$lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status, |
| 1263 |
$internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid |
1370 |
$biblionumber, $callnumber, $notes, $letter, $manualhistory, |
|
|
1371 |
$internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, |
| 1372 |
$graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq |
| 1264 |
) = @_; |
1373 |
) = @_; |
| 1265 |
|
1374 |
|
| 1266 |
# warn $irregularity; |
|
|
| 1267 |
my $dbh = C4::Context->dbh; |
1375 |
my $dbh = C4::Context->dbh; |
| 1268 |
my $query = "UPDATE subscription |
1376 |
my $query = "UPDATE subscription |
| 1269 |
SET librarian=?, branchcode=?,aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?, |
1377 |
SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?, |
| 1270 |
periodicity=?,firstacquidate=?,dow=?,irregularity=?, numberpattern=?, numberlength=?,weeklength=?,monthlength=?, |
1378 |
startdate=?, periodicity=?, firstacquidate=?, irregularity=?, |
| 1271 |
add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?, |
1379 |
numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?, |
| 1272 |
add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?, |
1380 |
lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?, |
| 1273 |
add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?, |
1381 |
lastvalue3=?, innerloop3=?, status=?, biblionumber=?, |
| 1274 |
numberingmethod=?, status=?, biblionumber=?, callnumber=?, notes=?, |
1382 |
callnumber=?, notes=?, letter=?, manualhistory=?, |
| 1275 |
letter=?, hemisphere=?,manualhistory=?,internalnotes=?,serialsadditems=?, |
1383 |
internalnotes=?, serialsadditems=?, staffdisplaycount=?, |
| 1276 |
staffdisplaycount = ?,opacdisplaycount = ?, graceperiod = ?, location = ? |
1384 |
opacdisplaycount=?, graceperiod=?, location = ?, enddate=?, |
| 1277 |
,enddate=? |
1385 |
skip_serialseq=? |
| 1278 |
WHERE subscriptionid = ?"; |
1386 |
WHERE subscriptionid = ?"; |
| 1279 |
|
1387 |
|
| 1280 |
#warn "query :".$query; |
|
|
| 1281 |
my $sth = $dbh->prepare($query); |
1388 |
my $sth = $dbh->prepare($query); |
| 1282 |
$sth->execute( |
1389 |
$sth->execute( |
| 1283 |
$auser, $branchcode, $aqbooksellerid, $cost, |
1390 |
$auser, $branchcode, $aqbooksellerid, $cost, |
| 1284 |
$aqbudgetid, $startdate, $periodicity, $firstacquidate, |
1391 |
$aqbudgetid, $startdate, $periodicity, $firstacquidate, |
| 1285 |
$dow, "$irregularity", $numberpattern, $numberlength, |
1392 |
$irregularity, $numberpattern, $locale, $numberlength, |
| 1286 |
$weeklength, $monthlength, $add1, $every1, |
1393 |
$weeklength, $monthlength, $lastvalue1, $innerloop1, |
| 1287 |
$whenmorethan1, $setto1, $lastvalue1, $innerloop1, |
1394 |
$lastvalue2, $innerloop2, $lastvalue3, $innerloop3, |
| 1288 |
$add2, $every2, $whenmorethan2, $setto2, |
1395 |
$status, $biblionumber, $callnumber, $notes, |
| 1289 |
$lastvalue2, $innerloop2, $add3, $every3, |
1396 |
$letter, ($manualhistory ? $manualhistory : 0), |
| 1290 |
$whenmorethan3, $setto3, $lastvalue3, $innerloop3, |
|
|
| 1291 |
$numberingmethod, $status, $biblionumber, $callnumber, |
| 1292 |
$notes, $letter, $hemisphere, ( $manualhistory ? $manualhistory : 0 ), |
| 1293 |
$internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, |
1397 |
$internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, |
| 1294 |
$graceperiod, $location, $enddate, $subscriptionid |
1398 |
$graceperiod, $location, $enddate, $skip_serialseq, |
|
|
1399 |
$subscriptionid |
| 1295 |
); |
1400 |
); |
| 1296 |
my $rows = $sth->rows; |
1401 |
my $rows = $sth->rows; |
| 1297 |
|
1402 |
|
|
Lines 1303-1313
sub ModSubscription {
Link Here
|
| 1303 |
|
1408 |
|
| 1304 |
$subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, |
1409 |
$subscriptionid = &NewSubscription($auser,branchcode,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber, |
| 1305 |
$startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength, |
1410 |
$startdate,$periodicity,$dow,$numberlength,$weeklength,$monthlength, |
| 1306 |
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1, |
1411 |
$lastvalue1,$innerloop1,$lastvalue2,$innerloop2,$lastvalue3,$innerloop3, |
| 1307 |
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2, |
1412 |
$status, $notes, $letter, $firstacquidate, $irregularity, $numberpattern, |
| 1308 |
$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3, |
1413 |
$callnumber, $hemisphere, $manualhistory, $internalnotes, $serialsadditems, |
| 1309 |
$numberingmethod, $status, $notes, $serialsadditems, |
1414 |
$staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq); |
| 1310 |
$staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate); |
|
|
| 1311 |
|
1415 |
|
| 1312 |
Create a new subscription with value given on input args. |
1416 |
Create a new subscription with value given on input args. |
| 1313 |
|
1417 |
|
|
Lines 1317-1358
the id of this new subscription
Link Here
|
| 1317 |
=cut |
1421 |
=cut |
| 1318 |
|
1422 |
|
| 1319 |
sub NewSubscription { |
1423 |
sub NewSubscription { |
| 1320 |
my ($auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity, |
1424 |
my ( |
| 1321 |
$dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1, |
1425 |
$auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, |
| 1322 |
$lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2, |
1426 |
$startdate, $periodicity, $numberlength, $weeklength, $monthlength, |
| 1323 |
$add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, $status, |
1427 |
$lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3, |
| 1324 |
$notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory, |
1428 |
$innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity, |
| 1325 |
$internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate |
1429 |
$numberpattern, $locale, $callnumber, $manualhistory, $internalnotes, |
|
|
1430 |
$serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, |
| 1431 |
$location, $enddate, $skip_serialseq |
| 1326 |
) = @_; |
1432 |
) = @_; |
| 1327 |
my $dbh = C4::Context->dbh; |
1433 |
my $dbh = C4::Context->dbh; |
| 1328 |
|
1434 |
|
| 1329 |
#save subscription (insert into database) |
1435 |
#save subscription (insert into database) |
| 1330 |
my $query = qq| |
1436 |
my $query = qq| |
| 1331 |
INSERT INTO subscription |
1437 |
INSERT INTO subscription |
| 1332 |
(librarian,branchcode,aqbooksellerid,cost,aqbudgetid,biblionumber, |
1438 |
(librarian, branchcode, aqbooksellerid, cost, aqbudgetid, |
| 1333 |
startdate,periodicity,dow,numberlength,weeklength,monthlength, |
1439 |
biblionumber, startdate, periodicity, numberlength, weeklength, |
| 1334 |
add1,every1,whenmorethan1,setto1,lastvalue1,innerloop1, |
1440 |
monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2, |
| 1335 |
add2,every2,whenmorethan2,setto2,lastvalue2,innerloop2, |
1441 |
lastvalue3, innerloop3, status, notes, letter, firstacquidate, |
| 1336 |
add3,every3,whenmorethan3,setto3,lastvalue3,innerloop3, |
1442 |
irregularity, numberpattern, locale, callnumber, |
| 1337 |
numberingmethod, status, notes, letter,firstacquidate,irregularity, |
1443 |
manualhistory, internalnotes, serialsadditems, staffdisplaycount, |
| 1338 |
numberpattern, callnumber, hemisphere,manualhistory,internalnotes,serialsadditems, |
1444 |
opacdisplaycount, graceperiod, location, enddate, skip_serialseq) |
| 1339 |
staffdisplaycount,opacdisplaycount,graceperiod,location,enddate) |
1445 |
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |
| 1340 |
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |
|
|
| 1341 |
|; |
1446 |
|; |
| 1342 |
my $sth = $dbh->prepare($query); |
1447 |
my $sth = $dbh->prepare($query); |
| 1343 |
$sth->execute( |
1448 |
$sth->execute( |
| 1344 |
$auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, $startdate, $periodicity, |
1449 |
$auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $biblionumber, |
| 1345 |
$dow, $numberlength, $weeklength, $monthlength, $add1, $every1, $whenmorethan1, $setto1, |
1450 |
$startdate, $periodicity, $numberlength, $weeklength, |
| 1346 |
$lastvalue1, $innerloop1, $add2, $every2, $whenmorethan2, $setto2, $lastvalue2, $innerloop2, |
1451 |
$monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, |
| 1347 |
$add3, $every3, $whenmorethan3, $setto3, $lastvalue3, $innerloop3, $numberingmethod, "$status", |
1452 |
$lastvalue3, $innerloop3, $status, $notes, $letter, |
| 1348 |
$notes, $letter, $firstacquidate, $irregularity, $numberpattern, $callnumber, $hemisphere, $manualhistory, |
1453 |
$firstacquidate, $irregularity, $numberpattern, $locale, $callnumber, |
| 1349 |
$internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate |
1454 |
$manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount, |
|
|
1455 |
$opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq |
| 1350 |
); |
1456 |
); |
| 1351 |
|
1457 |
|
| 1352 |
my $subscriptionid = $dbh->{'mysql_insertid'}; |
1458 |
my $subscriptionid = $dbh->{'mysql_insertid'}; |
| 1353 |
unless ($enddate){ |
1459 |
unless ($enddate) { |
| 1354 |
$enddate = GetExpirationDate($subscriptionid,$startdate); |
1460 |
$enddate = GetExpirationDate( $subscriptionid, $startdate ); |
| 1355 |
$query = q| |
1461 |
$query = qq| |
| 1356 |
UPDATE subscription |
1462 |
UPDATE subscription |
| 1357 |
SET enddate=? |
1463 |
SET enddate=? |
| 1358 |
WHERE subscriptionid=? |
1464 |
WHERE subscriptionid=? |
|
Lines 1360-1366
sub NewSubscription {
Link Here
|
| 1360 |
$sth = $dbh->prepare($query); |
1466 |
$sth = $dbh->prepare($query); |
| 1361 |
$sth->execute( $enddate, $subscriptionid ); |
1467 |
$sth->execute( $enddate, $subscriptionid ); |
| 1362 |
} |
1468 |
} |
| 1363 |
#then create the 1st waited number |
1469 |
|
|
|
1470 |
# then create the 1st expected number |
| 1364 |
$query = qq( |
1471 |
$query = qq( |
| 1365 |
INSERT INTO subscriptionhistory |
1472 |
INSERT INTO subscriptionhistory |
| 1366 |
(biblionumber, subscriptionid, histstartdate, opacnote, librariannote) |
1473 |
(biblionumber, subscriptionid, histstartdate, opacnote, librariannote) |
|
Lines 1370-1386
sub NewSubscription {
Link Here
|
| 1370 |
$sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes ); |
1477 |
$sth->execute( $biblionumber, $subscriptionid, $startdate, $notes, $internalnotes ); |
| 1371 |
|
1478 |
|
| 1372 |
# reread subscription to get a hash (for calculation of the 1st issue number) |
1479 |
# reread subscription to get a hash (for calculation of the 1st issue number) |
| 1373 |
$query = qq( |
1480 |
my $subscription = GetSubscription($subscriptionid); |
| 1374 |
SELECT * |
1481 |
my $pattern = C4::Serials::Numberpattern::GetSubscriptionNumberpattern($subscription->{numberpattern}); |
| 1375 |
FROM subscription |
|
|
| 1376 |
WHERE subscriptionid = ? |
| 1377 |
); |
| 1378 |
$sth = $dbh->prepare($query); |
| 1379 |
$sth->execute($subscriptionid); |
| 1380 |
my $val = $sth->fetchrow_hashref; |
| 1381 |
|
1482 |
|
| 1382 |
# calculate issue number |
1483 |
# calculate issue number |
| 1383 |
my $serialseq = GetSeq($val); |
1484 |
my $serialseq = GetSeq($subscription, $pattern); |
| 1384 |
$query = qq| |
1485 |
$query = qq| |
| 1385 |
INSERT INTO serial |
1486 |
INSERT INTO serial |
| 1386 |
(serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate) |
1487 |
(serialseq,subscriptionid,biblionumber,status, planneddate, publisheddate) |
|
Lines 1393-1399
sub NewSubscription {
Link Here
|
| 1393 |
|
1494 |
|
| 1394 |
#set serial flag on biblio if not already set. |
1495 |
#set serial flag on biblio if not already set. |
| 1395 |
my $bib = GetBiblio($biblionumber); |
1496 |
my $bib = GetBiblio($biblionumber); |
| 1396 |
if ( !$bib->{'serial'} ) { |
1497 |
if ( $bib and !$bib->{'serial'} ) { |
| 1397 |
my $record = GetMarcBiblio($biblionumber); |
1498 |
my $record = GetMarcBiblio($biblionumber); |
| 1398 |
my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} ); |
1499 |
my ( $tag, $subf ) = GetMarcFromKohaField( 'biblio.serial', $bib->{'frameworkcode'} ); |
| 1399 |
if ($tag) { |
1500 |
if ($tag) { |
|
Lines 1711-1717
sub HasSubscriptionExpired {
Link Here
|
| 1711 |
my ($subscriptionid) = @_; |
1812 |
my ($subscriptionid) = @_; |
| 1712 |
my $dbh = C4::Context->dbh; |
1813 |
my $dbh = C4::Context->dbh; |
| 1713 |
my $subscription = GetSubscription($subscriptionid); |
1814 |
my $subscription = GetSubscription($subscriptionid); |
| 1714 |
if ( ( $subscription->{periodicity} % 16 ) > 0 ) { |
1815 |
my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($subscription->{periodicity}); |
|
|
1816 |
if ( $frequency and $frequency->{unit} ) { |
| 1715 |
my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid); |
1817 |
my $expirationdate = $subscription->{enddate} || GetExpirationDate($subscriptionid); |
| 1716 |
if (!defined $expirationdate) { |
1818 |
if (!defined $expirationdate) { |
| 1717 |
$expirationdate = q{}; |
1819 |
$expirationdate = q{}; |
|
Lines 1735-1740
sub HasSubscriptionExpired {
Link Here
|
| 1735 |
|| ( !$res ) ); |
1837 |
|| ( !$res ) ); |
| 1736 |
return 0; |
1838 |
return 0; |
| 1737 |
} else { |
1839 |
} else { |
|
|
1840 |
# Irregular |
| 1738 |
if ( $subscription->{'numberlength'} ) { |
1841 |
if ( $subscription->{'numberlength'} ) { |
| 1739 |
my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} ); |
1842 |
my $countreceived = countissuesfrom( $subscriptionid, $subscription->{'startdate'} ); |
| 1740 |
return 1 if ( $countreceived > $subscription->{'numberlength'} ); |
1843 |
return 1 if ( $countreceived > $subscription->{'numberlength'} ); |
|
Lines 2226-2254
sub abouttoexpire {
Link Here
|
| 2226 |
my $dbh = C4::Context->dbh; |
2329 |
my $dbh = C4::Context->dbh; |
| 2227 |
my $subscription = GetSubscription($subscriptionid); |
2330 |
my $subscription = GetSubscription($subscriptionid); |
| 2228 |
my $per = $subscription->{'periodicity'}; |
2331 |
my $per = $subscription->{'periodicity'}; |
| 2229 |
if ($per && $per % 16 > 0){ |
2332 |
my $frequency = C4::Serials::Frequency::GetSubscriptionFrequency($per); |
| 2230 |
my $expirationdate = GetExpirationDate($subscriptionid); |
2333 |
if ($frequency and $frequency->{unit}){ |
|
|
2334 |
my $expirationdate = GetExpirationDate($subscriptionid); |
| 2231 |
my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid); |
2335 |
my ($res) = $dbh->selectrow_array('select max(planneddate) from serial where subscriptionid = ?', undef, $subscriptionid); |
| 2232 |
my @res; |
2336 |
my $nextdate = GetNextDate($subscription, $res); |
| 2233 |
if (defined $res) { |
2337 |
if(Date::Calc::Delta_Days( |
| 2234 |
@res=split (/-/,$res); |
2338 |
split( /-/, $nextdate ), |
| 2235 |
@res=Date::Calc::Today if ($res[0]*$res[1]==0); |
2339 |
split( /-/, $expirationdate ) |
| 2236 |
} else { # default an undefined value |
2340 |
) <= 0) { |
| 2237 |
@res=Date::Calc::Today; |
2341 |
return 1; |
| 2238 |
} |
2342 |
} |
| 2239 |
my @endofsubscriptiondate=split(/-/,$expirationdate); |
|
|
| 2240 |
my @per_list = (0, 7, 7, 14, 21, 31, 62, 93, 93, 190, 365, 730, 0, 124, 0, 0); |
| 2241 |
my @datebeforeend; |
| 2242 |
@datebeforeend = Add_Delta_Days( $endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2], |
| 2243 |
- (3 * $per_list[$per])) if (@endofsubscriptiondate && $endofsubscriptiondate[0]*$endofsubscriptiondate[1]*$endofsubscriptiondate[2]); |
| 2244 |
return 1 if ( @res && |
| 2245 |
(@datebeforeend && |
| 2246 |
Delta_Days($res[0],$res[1],$res[2], |
| 2247 |
$datebeforeend[0],$datebeforeend[1],$datebeforeend[2]) <= 0) && |
| 2248 |
(@endofsubscriptiondate && |
| 2249 |
Delta_Days($res[0],$res[1],$res[2], |
| 2250 |
$endofsubscriptiondate[0],$endofsubscriptiondate[1],$endofsubscriptiondate[2]) >= 0) ); |
| 2251 |
return 0; |
| 2252 |
} elsif ($subscription->{numberlength}>0) { |
2343 |
} elsif ($subscription->{numberlength}>0) { |
| 2253 |
return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1); |
2344 |
return (countissuesfrom($subscriptionid,$subscription->{'startdate'}) >=$subscription->{numberlength}-1); |
| 2254 |
} |
2345 |
} |
|
Lines 2299-2468
sub GetSubscriptionsFromBorrower {
Link Here
|
| 2299 |
return ( $count, @routinglist ); |
2390 |
return ( $count, @routinglist ); |
| 2300 |
} |
2391 |
} |
| 2301 |
|
2392 |
|
| 2302 |
=head2 GetNextDate |
|
|
| 2303 |
|
| 2304 |
$resultdate = GetNextDate($planneddate,$subscription) |
| 2305 |
|
2393 |
|
| 2306 |
this function it takes the planneddate and will return the next issue's date and will skip dates if there |
2394 |
=head2 GetFictiveIssueNumber |
| 2307 |
exists an irregularity |
|
|
| 2308 |
- eg if periodicity is monthly and $planneddate is 2007-02-10 but if March and April is to be |
| 2309 |
skipped then the returned date will be 2007-05-10 |
| 2310 |
|
2395 |
|
| 2311 |
return : |
2396 |
$issueno = GetFictiveIssueNumber($subscription, $publishedate); |
| 2312 |
$resultdate - then next date in the sequence |
|
|
| 2313 |
|
2397 |
|
| 2314 |
Return 0 if periodicity==0 |
2398 |
Get the position of the issue published at $publisheddate, considering the |
|
|
2399 |
first issue (at firstacquidate) is at position 1, the next is at position 2, etc... |
| 2400 |
This issuenumber doesn't take into account irregularities, so, for instance, if the 3rd |
| 2401 |
issue is declared as 'irregular' (will be skipped at receipt), the next issue number |
| 2402 |
will be 4, not 3. It's why it is called 'fictive'. It is NOT a serial seq, and is not |
| 2403 |
depending on how many rows are in serial table. |
| 2404 |
The issue number calculation is based on subscription frequency, first acquisition |
| 2405 |
date, and $publisheddate. |
| 2315 |
|
2406 |
|
| 2316 |
=cut |
2407 |
=cut |
| 2317 |
|
2408 |
|
| 2318 |
sub GetNextDate { |
2409 |
sub GetFictiveIssueNumber { |
| 2319 |
my ( $planneddate, $subscription ) = @_; |
2410 |
my ($subscription, $publisheddate) = @_; |
| 2320 |
my @irreg = split( /\,/, $subscription->{irregularity} ); |
2411 |
|
|
|
2412 |
my $frequency = GetSubscriptionFrequency($subscription->{'periodicity'}); |
| 2413 |
my $unit = $frequency->{unit} ? lc $frequency->{'unit'} : undef; |
| 2414 |
my $issueno = 0; |
| 2415 |
|
| 2416 |
if($unit) { |
| 2417 |
my ($year, $month, $day) = split /-/, $publisheddate; |
| 2418 |
my ($fa_year, $fa_month, $fa_day) = split /-/, $subscription->{'firstacquidate'}; |
| 2419 |
my $wkno; |
| 2420 |
my $delta; |
| 2421 |
|
| 2422 |
if($unit eq 'day') { |
| 2423 |
$delta = Delta_Days($fa_year, $fa_month, $fa_day, $year, $month, $day); |
| 2424 |
} elsif($unit eq 'week') { |
| 2425 |
($wkno, $year) = Week_of_Year($year, $month, $day); |
| 2426 |
my ($fa_wkno, $fa_yr) = Week_of_Year($fa_year, $fa_month, $fa_day); |
| 2427 |
$delta = ($fa_yr == $year) ? ($wkno - $fa_wkno) : ( ($year-$fa_yr-1)*52 + (52-$fa_wkno+$wkno) ); |
| 2428 |
} elsif($unit eq 'month') { |
| 2429 |
$delta = ($fa_year == $year) |
| 2430 |
? ($month - $fa_month) |
| 2431 |
: ( ($year-$fa_year-1)*12 + (12-$fa_month+$month) ); |
| 2432 |
} elsif($unit eq 'year') { |
| 2433 |
$delta = $year - $fa_year; |
| 2434 |
} |
| 2435 |
if($frequency->{'unitsperissue'} == 1) { |
| 2436 |
$issueno = $delta * $frequency->{'issuesperunit'} + $subscription->{'countissuesperunit'}; |
| 2437 |
} else { |
| 2438 |
# Assuming issuesperunit == 1 |
| 2439 |
$issueno = int( ($delta + $frequency->{'unitsperissue'}) / $frequency->{'unitsperissue'} ); |
| 2440 |
} |
| 2441 |
} |
| 2442 |
return $issueno; |
| 2443 |
} |
| 2321 |
|
2444 |
|
| 2322 |
#date supposed to be in ISO. |
2445 |
=head2 GetNextDate |
| 2323 |
|
2446 |
|
| 2324 |
my ( $year, $month, $day ) = split( /-/, $planneddate ); |
2447 |
$resultdate = GetNextDate($publisheddate,$subscription) |
| 2325 |
$month = 1 unless ($month); |
|
|
| 2326 |
$day = 1 unless ($day); |
| 2327 |
my @resultdate; |
| 2328 |
|
2448 |
|
| 2329 |
# warn "DOW $dayofweek"; |
2449 |
this function it takes the publisheddate and will return the next issue's date |
| 2330 |
if ( $subscription->{periodicity} % 16 == 0 ) { # 'without regularity' || 'irregular' |
2450 |
and will skip dates if there exists an irregularity. |
| 2331 |
return 0; |
2451 |
$publisheddate has to be an ISO date |
| 2332 |
} |
2452 |
$subscription is a hashref containing at least 'periodicity', 'firstacquidate', 'irregularity', and 'countissuesperunit' |
|
|
2453 |
$updatecount is a boolean value which, when set to true, update the 'countissuesperunit' in database |
| 2454 |
- eg if periodicity is monthly and $publisheddate is 2007-02-10 but if March and April is to be |
| 2455 |
skipped then the returned date will be 2007-05-10 |
| 2333 |
|
2456 |
|
| 2334 |
# daily : n / week |
2457 |
return : |
| 2335 |
# Since we're interpreting irregularity here as which days of the week to skip an issue, |
2458 |
$resultdate - then next date in the sequence (ISO date) |
| 2336 |
# renaming this pattern from 1/day to " n / week ". |
|
|
| 2337 |
if ( $subscription->{periodicity} == 1 ) { |
| 2338 |
my $dayofweek = eval { Day_of_Week( $year, $month, $day ) }; |
| 2339 |
if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; } |
| 2340 |
else { |
| 2341 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
| 2342 |
$dayofweek = 0 if ( $dayofweek == 7 ); |
| 2343 |
if ( in_array( ( $dayofweek + 1 ), @irreg ) ) { |
| 2344 |
( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 1 ); |
| 2345 |
$dayofweek++; |
| 2346 |
} |
| 2347 |
} |
| 2348 |
@resultdate = Add_Delta_Days( $year, $month, $day, 1 ); |
| 2349 |
} |
| 2350 |
} |
| 2351 |
|
2459 |
|
| 2352 |
# 1 week |
2460 |
Return $publisheddate if subscription is irregular |
| 2353 |
if ( $subscription->{periodicity} == 2 ) { |
|
|
| 2354 |
my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) }; |
| 2355 |
if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; } |
| 2356 |
else { |
| 2357 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
| 2358 |
|
2461 |
|
| 2359 |
#FIXME: if two consecutive irreg, do we only skip one? |
2462 |
=cut |
| 2360 |
if ( $irreg[$i] == ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ) ) { |
|
|
| 2361 |
( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 7 ); |
| 2362 |
$wkno = ( ( $wkno != 51 ) ? ( $wkno + 1 ) % 52 : 52 ); |
| 2363 |
} |
| 2364 |
} |
| 2365 |
@resultdate = Add_Delta_Days( $year, $month, $day, 7 ); |
| 2366 |
} |
| 2367 |
} |
| 2368 |
|
2463 |
|
| 2369 |
# 1 / 2 weeks |
2464 |
sub GetNextDate { |
| 2370 |
if ( $subscription->{periodicity} == 3 ) { |
2465 |
my ( $subscription, $publisheddate, $updatecount ) = @_; |
| 2371 |
my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) }; |
2466 |
|
| 2372 |
if ($@) { warn "year month day : $year $month $day $subscription->{subscriptionid} : $@"; } |
2467 |
my $freqdata = GetSubscriptionFrequency($subscription->{'periodicity'}); |
| 2373 |
else { |
2468 |
|
| 2374 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2469 |
if ($freqdata->{'unit'}) { |
| 2375 |
if ( $irreg[$i] == ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ) ) { |
2470 |
my ( $year, $month, $day ) = split /-/, $publisheddate; |
| 2376 |
### BUGFIX was previously +1 ^ |
2471 |
|
| 2377 |
( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 14 ); |
2472 |
# Process an irregularity Hash |
| 2378 |
$wkno = ( ( $wkno != 50 ) ? ( $wkno + 2 ) % 52 : 52 ); |
2473 |
# Suppose that irregularities are stored in a string with this structure |
| 2379 |
} |
2474 |
# irreg1;irreg2;irreg3 |
| 2380 |
} |
2475 |
# where irregX is the number of issue which will not be received |
| 2381 |
@resultdate = Add_Delta_Days( $year, $month, $day, 14 ); |
2476 |
# (the first issue takes the number 1, the 2nd the number 2 and so on) |
|
|
2477 |
my @irreg = split /;/, $subscription->{'irregularity'} ; |
| 2478 |
my %irregularities; |
| 2479 |
foreach my $irregularity (@irreg) { |
| 2480 |
$irregularities{$irregularity} = 1; |
| 2382 |
} |
2481 |
} |
| 2383 |
} |
|
|
| 2384 |
|
2482 |
|
| 2385 |
# 1 / 3 weeks |
2483 |
# Get the 'fictive' next issue number |
| 2386 |
if ( $subscription->{periodicity} == 4 ) { |
2484 |
# It is used to check if next issue is an irregular issue. |
| 2387 |
my ( $wkno, $year ) = eval { Week_of_Year( $year, $month, $day ) }; |
2485 |
my $issueno = GetFictiveIssueNumber($subscription, $publisheddate) + 1; |
| 2388 |
if ($@) { warn "année mois jour : $year $month $day $subscription->{subscriptionid} : $@"; } |
2486 |
|
| 2389 |
else { |
2487 |
# Then get the next date |
| 2390 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2488 |
my $unit = lc $freqdata->{'unit'}; |
| 2391 |
if ( $irreg[$i] == ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ) ) { |
2489 |
if ($unit eq 'day') { |
| 2392 |
( $year, $month, $day ) = Add_Delta_Days( $year, $month, $day, 21 ); |
2490 |
while ($irregularities{$issueno}) { |
| 2393 |
$wkno = ( ( $wkno != 49 ) ? ( $wkno + 3 ) % 52 : 52 ); |
2491 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
|
|
2492 |
($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{'unitsperissue'} ); |
| 2493 |
$subscription->{'countissuesperunit'} = 1; |
| 2494 |
} else { |
| 2495 |
$subscription->{'countissuesperunit'}++; |
| 2394 |
} |
2496 |
} |
|
|
2497 |
$issueno++; |
| 2498 |
} |
| 2499 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
| 2500 |
($year,$month,$day) = Add_Delta_Days($year,$month, $day , $freqdata->{"unitsperissue"} ); |
| 2501 |
$subscription->{'countissuesperunit'} = 1; |
| 2502 |
} else { |
| 2503 |
$subscription->{'countissuesperunit'}++; |
| 2395 |
} |
2504 |
} |
| 2396 |
@resultdate = Add_Delta_Days( $year, $month, $day, 21 ); |
|
|
| 2397 |
} |
2505 |
} |
| 2398 |
} |
2506 |
elsif ($unit eq 'week') { |
| 2399 |
my $tmpmonth = $month; |
2507 |
my ($wkno, $yr) = Week_of_Year($year, $month, $day); |
| 2400 |
if ( $year && $month && $day ) { |
2508 |
while ($irregularities{$issueno}) { |
| 2401 |
if ( $subscription->{periodicity} == 5 ) { |
2509 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
| 2402 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2510 |
$subscription->{'countissuesperunit'} = 1; |
| 2403 |
if ( $irreg[$i] == ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ) ) { |
2511 |
$wkno += $freqdata->{"unitsperissue"}; |
| 2404 |
( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 ); |
2512 |
if($wkno > 52){ |
| 2405 |
$tmpmonth = ( ( $tmpmonth != 11 ) ? ( $tmpmonth + 1 ) % 12 : 12 ); |
2513 |
$wkno = $wkno % 52; |
|
|
2514 |
$yr++; |
| 2515 |
} |
| 2516 |
my $dow = Day_of_Week($year, $month, $day); |
| 2517 |
($year,$month,$day) = Monday_of_Week($wkno, $yr); |
| 2518 |
if($freqdata->{'issuesperunit'} == 1) { |
| 2519 |
($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1); |
| 2520 |
} |
| 2521 |
} else { |
| 2522 |
$subscription->{'countissuesperunit'}++; |
| 2406 |
} |
2523 |
} |
|
|
2524 |
$issueno++; |
| 2407 |
} |
2525 |
} |
| 2408 |
@resultdate = Add_Delta_YMD( $year, $month, $day, 0, 1, 0 ); |
2526 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
| 2409 |
} |
2527 |
$subscription->{'countissuesperunit'} = 1; |
| 2410 |
if ( $subscription->{periodicity} == 6 ) { |
2528 |
$wkno += $freqdata->{"unitsperissue"}; |
| 2411 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2529 |
if($wkno > 52){ |
| 2412 |
if ( $irreg[$i] == ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ) ) { |
2530 |
$wkno = $wkno % 52 ; |
| 2413 |
( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 ); |
2531 |
$yr++; |
| 2414 |
$tmpmonth = ( ( $tmpmonth != 10 ) ? ( $tmpmonth + 2 ) % 12 : 12 ); |
2532 |
} |
|
|
2533 |
my $dow = Day_of_Week($year, $month, $day); |
| 2534 |
($year,$month,$day) = Monday_of_Week($wkno, $yr); |
| 2535 |
if($freqdata->{'issuesperunit'} == 1) { |
| 2536 |
($year, $month, $day) = Add_Delta_Days($year, $month, $day, $dow - 1); |
| 2415 |
} |
2537 |
} |
|
|
2538 |
} else { |
| 2539 |
$subscription->{'countissuesperunit'}++; |
| 2416 |
} |
2540 |
} |
| 2417 |
@resultdate = Add_Delta_YMD( $year, $month, $day, 0, 2, 0 ); |
|
|
| 2418 |
} |
2541 |
} |
| 2419 |
if ( $subscription->{periodicity} == 7 ) { |
2542 |
elsif ($unit eq 'month') { |
| 2420 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2543 |
while ($irregularities{$issueno}) { |
| 2421 |
if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) { |
2544 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
| 2422 |
( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 ); |
2545 |
$subscription->{'countissuesperunit'} = 1; |
| 2423 |
$tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ); |
2546 |
($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"}); |
|
|
2547 |
unless($freqdata->{'issuesperunit'} == 1) { |
| 2548 |
$day = 1; # Jumping to the first day of month, because we don't know what day is expected |
| 2549 |
} |
| 2550 |
} else { |
| 2551 |
$subscription->{'countissuesperunit'}++; |
| 2424 |
} |
2552 |
} |
|
|
2553 |
$issueno++; |
| 2425 |
} |
2554 |
} |
| 2426 |
@resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 ); |
2555 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
| 2427 |
} |
2556 |
$subscription->{'countissuesperunit'} = 1; |
| 2428 |
if ( $subscription->{periodicity} == 8 ) { |
2557 |
($year,$month,$day) = Add_Delta_YM($year,$month,$day, 0,$freqdata->{"unitsperissue"}); |
| 2429 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2558 |
unless($freqdata->{'issuesperunit'} == 1) { |
| 2430 |
if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) { |
2559 |
$day = 1; # Jumping to the first day of month, because we don't know what day is expected |
| 2431 |
( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 ); |
|
|
| 2432 |
$tmpmonth = ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ); |
| 2433 |
} |
2560 |
} |
|
|
2561 |
} else { |
| 2562 |
$subscription->{'countissuesperunit'}++; |
| 2434 |
} |
2563 |
} |
| 2435 |
@resultdate = Add_Delta_YMD( $year, $month, $day, 0, 3, 0 ); |
|
|
| 2436 |
} |
2564 |
} |
| 2437 |
if ( $subscription->{periodicity} == 13 ) { |
2565 |
elsif ($unit eq 'year') { |
| 2438 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2566 |
while ($irregularities{$issueno}) { |
| 2439 |
if ( $irreg[$i] == ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 ) ) { |
2567 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
| 2440 |
( $year, $month, $day ) = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 ); |
2568 |
$subscription->{'countissuesperunit'} = 1; |
| 2441 |
$tmpmonth = ( ( $tmpmonth != 8 ) ? ( $tmpmonth + 4 ) % 12 : 12 ); |
2569 |
($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0); |
|
|
2570 |
unless($freqdata->{'issuesperunit'} == 1) { |
| 2571 |
# Jumping to the first day of year, because we don't know what day is expected |
| 2572 |
$month = 1; |
| 2573 |
$day = 1; |
| 2574 |
} |
| 2575 |
} else { |
| 2576 |
$subscription->{'countissuesperunit'}++; |
| 2442 |
} |
2577 |
} |
|
|
2578 |
$issueno++; |
| 2443 |
} |
2579 |
} |
| 2444 |
@resultdate = Add_Delta_YMD( $year, $month, $day, 0, 4, 0 ); |
2580 |
if ($subscription->{'countissuesperunit'} + 1 > $freqdata->{'issuesperunit'}){ |
| 2445 |
} |
2581 |
$subscription->{'countissuesperunit'} = 1; |
| 2446 |
if ( $subscription->{periodicity} == 9 ) { |
2582 |
($year,$month,$day) = Add_Delta_YM($year,$month,$day, $freqdata->{"unitsperissue"},0); |
| 2447 |
for ( my $i = 0 ; $i < @irreg ; $i++ ) { |
2583 |
unless($freqdata->{'issuesperunit'} == 1) { |
| 2448 |
if ( $irreg[$i] == ( ( $tmpmonth != 9 ) ? ( $tmpmonth + 3 ) % 12 : 12 ) ) { |
2584 |
# Jumping to the first day of year, because we don't know what day is expected |
| 2449 |
### BUFIX Seems to need more Than One ? |
2585 |
$month = 1; |
| 2450 |
( $year, $month, $day ) = Add_Delta_YM( $year, $month, $day, 0, 6 ); |
2586 |
$day = 1; |
| 2451 |
$tmpmonth = ( ( $tmpmonth != 6 ) ? ( $tmpmonth + 6 ) % 12 : 12 ); |
|
|
| 2452 |
} |
2587 |
} |
|
|
2588 |
} else { |
| 2589 |
$subscription->{'countissuesperunit'}++; |
| 2453 |
} |
2590 |
} |
| 2454 |
@resultdate = Add_Delta_YM( $year, $month, $day, 0, 6 ); |
|
|
| 2455 |
} |
| 2456 |
if ( $subscription->{periodicity} == 10 ) { |
| 2457 |
@resultdate = Add_Delta_YM( $year, $month, $day, 1, 0 ); |
| 2458 |
} |
2591 |
} |
| 2459 |
if ( $subscription->{periodicity} == 11 ) { |
2592 |
if ($updatecount){ |
| 2460 |
@resultdate = Add_Delta_YM( $year, $month, $day, 2, 0 ); |
2593 |
my $dbh = C4::Context->dbh; |
|
|
2594 |
my $query = qq{ |
| 2595 |
UPDATE subscription |
| 2596 |
SET countissuesperunit = ? |
| 2597 |
WHERE subscriptionid = ? |
| 2598 |
}; |
| 2599 |
my $sth = $dbh->prepare($query); |
| 2600 |
$sth->execute($subscription->{'countissuesperunit'}, $subscription->{'subscriptionid'}); |
| 2461 |
} |
2601 |
} |
|
|
2602 |
return sprintf("%04d-%02d-%02d", $year, $month, $day); |
| 2603 |
} |
| 2604 |
else { |
| 2605 |
return $publisheddate; |
| 2462 |
} |
2606 |
} |
| 2463 |
my $resultdate = sprintf( "%04d-%02d-%02d", $resultdate[0], $resultdate[1], $resultdate[2] ); |
2607 |
} |
|
|
2608 |
|
| 2609 |
=head2 _numeration |
| 2610 |
|
| 2611 |
$string = &_numeration($value,$num_type,$locale); |
| 2464 |
|
2612 |
|
| 2465 |
return "$resultdate"; |
2613 |
_numeration returns the string corresponding to $value in the num_type |
|
|
2614 |
num_type can take : |
| 2615 |
-dayname |
| 2616 |
-monthname |
| 2617 |
-season |
| 2618 |
=cut |
| 2619 |
|
| 2620 |
#' |
| 2621 |
|
| 2622 |
sub _numeration { |
| 2623 |
my ($value, $num_type, $locale) = @_; |
| 2624 |
$value ||= 0; |
| 2625 |
my $initlocale = setlocale(LC_TIME); |
| 2626 |
if($locale and $locale ne $initlocale) { |
| 2627 |
$locale = setlocale(LC_TIME, $locale); |
| 2628 |
} |
| 2629 |
$locale ||= $initlocale; |
| 2630 |
my $string; |
| 2631 |
$num_type //= ''; |
| 2632 |
given ($num_type) { |
| 2633 |
when (/^dayname$/) { |
| 2634 |
$value = $value % 7; |
| 2635 |
$string = POSIX::strftime("%A",0,0,0,0,0,0,$value); |
| 2636 |
} |
| 2637 |
when (/^monthname$/) { |
| 2638 |
$value = $value % 12; |
| 2639 |
$string = POSIX::strftime("%B",0,0,0,1,$value,0,0,0,0); |
| 2640 |
} |
| 2641 |
when (/^season$/) { |
| 2642 |
my $seasonlocale = ($locale) |
| 2643 |
? (substr $locale,0,2) |
| 2644 |
: "en"; |
| 2645 |
my %seasons=( |
| 2646 |
"en" => |
| 2647 |
[qw(Spring Summer Fall Winter)], |
| 2648 |
"fr"=> |
| 2649 |
[qw(Printemps Été Automne Hiver)], |
| 2650 |
); |
| 2651 |
$value = $value % 4; |
| 2652 |
$string = ($seasons{$seasonlocale}) |
| 2653 |
? $seasons{$seasonlocale}->[$value] |
| 2654 |
: $seasons{'en'}->[$value]; |
| 2655 |
} |
| 2656 |
default { |
| 2657 |
$string = $value; |
| 2658 |
} |
| 2659 |
} |
| 2660 |
if($locale ne $initlocale) { |
| 2661 |
setlocale(LC_TIME, $initlocale); |
| 2662 |
} |
| 2663 |
return $string; |
| 2466 |
} |
2664 |
} |
| 2467 |
|
2665 |
|
| 2468 |
=head2 is_barcode_in_use |
2666 |
=head2 is_barcode_in_use |