@@ -, +, @@ - Apply this patch, - Launch installer/data/mysql/updatedatabase.pl - Launch misc/devel/update_dbix_class_files.pl - Create a daily subscription. i.e: - From: 2017-10-09, To: 2017-10-15, - Frequency: 1/day, - 7 issues, - test prediction pattern - check Wednesday and Thursday as irregularity, - save - Edit subscription, - Check that Wednesday and Thursday are still checked - Renew subscription from 2017-10-16 - Edit subscription, - Make sure that Wednesday and Thursday are still checked with corresponding serials - Do the same for a monthly subscription --- C4/Serials.pm | 102 ++++++++------------- Koha/Subscription.pm | 24 +++++ .../Bug_17656-add-permanent-irregularities.sql | 1 + .../en/modules/serials/showpredictionpattern.tt | 44 +++++---- serials/showpredictionpattern.pl | 19 +++- serials/subscription-add.pl | 13 ++- t/db_dependent/Serials/SubscriptionIrregularity.pm | 35 +++++++ 7 files changed, 145 insertions(+), 93 deletions(-) create mode 100644 installer/data/mysql/atomicupdate/Bug_17656-add-permanent-irregularities.sql create mode 100644 t/db_dependent/Serials/SubscriptionIrregularity.pm --- a/C4/Serials.pm +++ a/C4/Serials.pm @@ -1301,37 +1301,6 @@ sub ModNextExpected { } -=head2 GetSubscriptionIrregularities - -=over 4 - -=item @irreg = &GetSubscriptionIrregularities($subscriptionid); -get the list of irregularities for a subscription - -=back - -=cut - -sub GetSubscriptionIrregularities { - my $subscriptionid = shift; - - return unless $subscriptionid; - - my $dbh = C4::Context->dbh; - my $query = qq{ - SELECT irregularity - FROM subscription - WHERE subscriptionid = ? - }; - my $sth = $dbh->prepare($query); - $sth->execute($subscriptionid); - - my ($result) = $sth->fetchrow_array; - my @irreg = split /;/, $result; - - return @irreg; -} - =head2 ModSubscription this function modifies a subscription. Put all new values on input args. @@ -1342,23 +1311,23 @@ returns the number of rows affected sub ModSubscription { my ( $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, - $periodicity, $firstacquidate, $irregularity, $numberpattern, $locale, - $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1, - $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status, - $biblionumber, $callnumber, $notes, $letter, $manualhistory, - $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, - $graceperiod, $location, $enddate, $subscriptionid, $skip_serialseq, - $itemtype, $previousitemtype + $periodicity, $firstacquidate, $irregularity, $permanent_irregularity, + $numberpattern, $locale, $numberlength, $weeklength, $monthlength, + $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3, + $innerloop3, $status, $biblionumber, $callnumber, $notes, $letter, + $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount, + $opacdisplaycount, $graceperiod, $location, $enddate, $subscriptionid, + $skip_serialseq, $itemtype, $previousitemtype ) = @_; my $dbh = C4::Context->dbh; my $query = "UPDATE subscription SET librarian=?, branchcode=?, aqbooksellerid=?, cost=?, aqbudgetid=?, startdate=?, periodicity=?, firstacquidate=?, irregularity=?, - numberpattern=?, locale=?, numberlength=?, weeklength=?, monthlength=?, - lastvalue1=?, innerloop1=?, lastvalue2=?, innerloop2=?, - lastvalue3=?, innerloop3=?, status=?, biblionumber=?, - callnumber=?, notes=?, letter=?, manualhistory=?, + permanent_irregularity=?, numberpattern=?, locale=?, numberlength=?, + weeklength=?, monthlength=?, lastvalue1=?, innerloop1=?, + lastvalue2=?, innerloop2=?, lastvalue3=?, innerloop3=?, status=?, + biblionumber=?, callnumber=?, notes=?, letter=?, manualhistory=?, internalnotes=?, serialsadditems=?, staffdisplaycount=?, opacdisplaycount=?, graceperiod=?, location = ?, enddate=?, skip_serialseq=?, itemtype=?, previousitemtype=? @@ -1366,17 +1335,19 @@ sub ModSubscription { my $sth = $dbh->prepare($query); $sth->execute( - $auser, $branchcode, $aqbooksellerid, $cost, - $aqbudgetid, $startdate, $periodicity, $firstacquidate, - $irregularity, $numberpattern, $locale, $numberlength, - $weeklength, $monthlength, $lastvalue1, $innerloop1, - $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, - $status, $biblionumber, $callnumber, $notes, - $letter, ($manualhistory ? $manualhistory : 0), - $internalnotes, $serialsadditems, $staffdisplaycount, $opacdisplaycount, - $graceperiod, $location, $enddate, $skip_serialseq, - $itemtype, $previousitemtype, - $subscriptionid + $auser, $branchcode, $aqbooksellerid, + $cost, $aqbudgetid, $startdate, + $periodicity, $firstacquidate, $irregularity, + $permanent_irregularity, $numberpattern, $locale, + $numberlength, $weeklength, $monthlength, + $lastvalue1, $innerloop1, $lastvalue2, + $innerloop2, $lastvalue3, $innerloop3, + $status, $biblionumber, $callnumber, + $notes, $letter, ($manualhistory ? $manualhistory : 0), + $internalnotes, $serialsadditems, $staffdisplaycount, + $opacdisplaycount, $graceperiod, $location, + $enddate, $skip_serialseq, $itemtype, + $previousitemtype, $subscriptionid ); my $rows = $sth->rows; @@ -1407,9 +1378,10 @@ sub NewSubscription { $startdate, $periodicity, $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status, $notes, $letter, $firstacquidate, $irregularity, - $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes, - $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, - $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype + $permanent_irregularity, $numberpattern, $locale, $callnumber, + $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount, + $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq, + $itemtype, $previousitemtype ) = @_; my $dbh = C4::Context->dbh; @@ -1420,11 +1392,11 @@ sub NewSubscription { biblionumber, startdate, periodicity, numberlength, weeklength, monthlength, lastvalue1, innerloop1, lastvalue2, innerloop2, lastvalue3, innerloop3, status, notes, letter, firstacquidate, - irregularity, numberpattern, locale, callnumber, - manualhistory, internalnotes, serialsadditems, staffdisplaycount, - opacdisplaycount, graceperiod, location, enddate, skip_serialseq, - itemtype, previousitemtype) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + irregularity, permanent_irregularity, numberpattern, locale, + callnumber, manualhistory, internalnotes, serialsadditems, + staffdisplaycount, opacdisplaycount, graceperiod, location, + enddate, skip_serialseq, itemtype, previousitemtype) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |; my $sth = $dbh->prepare($query); $sth->execute( @@ -1432,10 +1404,10 @@ sub NewSubscription { $startdate, $periodicity, $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status, $notes, $letter, - $firstacquidate, $irregularity, $numberpattern, $locale, $callnumber, - $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount, - $opacdisplaycount, $graceperiod, $location, $enddate, $skip_serialseq, - $itemtype, $previousitemtype + $firstacquidate, $irregularity, $permanent_irregularity, + $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes, + $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, + $location, $enddate, $skip_serialseq, $itemtype, $previousitemtype ); my $subscriptionid = $dbh->{'mysql_insertid'}; --- a/Koha/Subscription.pm +++ a/Koha/Subscription.pm @@ -48,6 +48,30 @@ sub biblio { return scalar Koha::Biblios->find($self->biblionumber); } +=head2 irregularities + +Returns an array containing irregularities + +=cut + +sub irregularities { + my ($self) = @_; + + return split(';', $self->irregularity); +} + +=head2 permanent_irregularities + +Returns an array containing permanent irregularities + +=cut + +sub permanent_irregularities { + my ($self) = @_; + + return split(';', $self->permanent_irregularity); +} + =head3 type =cut --- a/installer/data/mysql/atomicupdate/Bug_17656-add-permanent-irregularities.sql +++ a/installer/data/mysql/atomicupdate/Bug_17656-add-permanent-irregularities.sql @@ -0,0 +1, @@ +ALTER TABLE `subscription` ADD permanent_irregularity text AFTER irregularity; --- a/koha-tmpl/intranet-tmpl/prog/en/modules/serials/showpredictionpattern.tt +++ a/koha-tmpl/intranet-tmpl/prog/en/modules/serials/showpredictionpattern.tt @@ -6,7 +6,7 @@ [% END %] [% IF (ask_for_irregularities) %]

Please check issues that are NOT published (irregularities)

- [% IF (daily_options) %] + [% IF (daily_options OR monthly_options) %] -

- If there is a day (or more) in the week where issues are never - published, you can check corresponding boxes below. -

- - - - - - - - - - - - - - + [% IF (daily_options) %] + [% INCLUDE 'serials/subscription_daily_choice.inc' %] + [% ELSIF (monthly_options) %] + [% INCLUDE 'serials/subscription_monthly_choice.inc' %] + [% END %] [% END %] [% END %] [% IF (predictions_loop) %] --- a/serials/showpredictionpattern.pl +++ a/serials/showpredictionpattern.pl @@ -112,15 +112,20 @@ if(defined $subscriptionid) { my @predictions_loop; my ($calculated) = GetSeq(\%subscription, \%pattern); +( my $month_number = (split/-/, $date)[1] ) =~ s/^0//; +my $dow = $frequency->{unit} == 'month' ? $month_number : Day_of_Week(split /-/, $date); push @predictions_loop, { number => $calculated, publicationdate => $date, issuenumber => $issuenumber, - dow => Day_of_Week(split /-/, $date), + dow => $dow, }; my @irreg = (); +my @permanent_irreg = (); if(defined $subscriptionid) { - @irreg = C4::Serials::GetSubscriptionIrregularities($subscriptionid); + my $subscription_o = Koha::Subscriptions->find($subscriptionid); + @irreg = $subscription_o->irregularities; + @permanent_irreg = $subscription_o->permanent_irregularities; while(@irreg && $issuenumber > $irreg[0]) { shift @irreg; } @@ -139,7 +144,10 @@ while( $i < 1000 ) { } if(defined $date){ $line{'publicationdate'} = $date; - $line{'dow'} = Day_of_Week(split /-/, $date); + ( my $month_number = (split/-/, $date)[1] ) =~ s/^0//; + $line{'dow'} = $frequency->{unit} == 'month' + ? $month_number + : Day_of_Week(split /-/, $date); } # Check if we don't have exceed end date @@ -177,6 +185,11 @@ if ( $frequency->{unit} and not $custompattern ) { $template->param( ask_for_irregularities => 1 ); if ( $frequency->{unit} eq 'day' and $frequency->{unitsperissue} == 1 ) { $template->param( daily_options => 1 ); + $template->param( selected_days => \@permanent_irreg ); + } + if ( $frequency->{unit} eq 'month' and $frequency->{unitsperissue} == 1 ) { + $template->param( monthly_options => 1 ); + $template->param( selected_monthes => \@permanent_irreg ); } } --- a/serials/subscription-add.pl +++ a/serials/subscription-add.pl @@ -294,6 +294,7 @@ sub redirect_add_subscription { my $aqbudgetid = $query->param('aqbudgetid'); my $periodicity = $query->param('frequency'); my @irregularity = $query->multi_param('irregularity'); + my @permanent_irregularity = $query->multi_param('permanent_irregularity'); my $numberpattern = $query->param('numbering_pattern'); my $locale = $query->param('locale'); my $graceperiod = $query->param('graceperiod') || 0; @@ -341,10 +342,10 @@ sub redirect_add_subscription { $startdate, $periodicity, $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status, $notes, $letter, $firstacquidate, - join(";",@irregularity), $numberpattern, $locale, $callnumber, - $manualhistory, $internalnotes, $serialsadditems, - $staffdisplaycount, $opacdisplaycount, $graceperiod, $location, $enddate, - $skip_serialseq + join(";",@irregularity), join(';', @permanent_irregularity), + $numberpattern, $locale, $callnumber, $manualhistory, $internalnotes, + $serialsadditems, $staffdisplaycount, $opacdisplaycount, $graceperiod, + $location, $enddate, $skip_serialseq ); my $additional_fields = Koha::AdditionalField->all( { tablename => 'subscription' } ); @@ -357,6 +358,7 @@ sub redirect_add_subscription { sub redirect_mod_subscription { my $subscriptionid = $query->param('subscriptionid'); my @irregularity = $query->multi_param('irregularity'); + my @permanent_irregularity = $query->multi_param('permanent_irregularity'); my $auser = $query->param('user'); my $librarian => scalar $query->param('librarian'), my $branchcode = $query->param('branchcode'); @@ -423,7 +425,8 @@ sub redirect_mod_subscription { ModSubscription( $auser, $branchcode, $aqbooksellerid, $cost, $aqbudgetid, $startdate, $periodicity, $firstacquidate, join(";",@irregularity), - $numberpattern, $locale, $numberlength, $weeklength, $monthlength, $lastvalue1, + join(';', @permanent_irregularity), $numberpattern, $locale, + $numberlength, $weeklength, $monthlength, $lastvalue1, $innerloop1, $lastvalue2, $innerloop2, $lastvalue3, $innerloop3, $status, $biblionumber, $callnumber, $notes, $letter, $manualhistory, $internalnotes, $serialsadditems, $staffdisplaycount, --- a/t/db_dependent/Serials/SubscriptionIrregularity.pm +++ a/t/db_dependent/Serials/SubscriptionIrregularity.pm @@ -0,0 +1,35 @@ +#!/usr/bin/perl + +use Modern::Perl; + +use t::lib::TestBuilder; +use Test::More tests => 6; + +use Koha::Database; + +use_ok('Koha::Subscription'); + +my $schema = Koha::Database->new->schema; +$schema->storage->txn_begin; + +my $builder = t::lib::TestBuilder->new(); + +my $subscription = $builder->build({ + source => 'Subscription', + value => { + irregularity => '2;4;7', + permanent_irregularity => '1;2' + }, +}); + +my $subscription_o = Koha::Subscriptions->find($subscription->{subscriptionid}); +my @irreg = $subscription_o->irregularities; +is($irreg[0], 2, 'First element of irregularities is 2'); +is($irreg[1], 4, 'Second element of irregularities is 4'); +is($irreg[2], 7, 'Third element of irregularities is 7'); + +my @permanent_irreg = $subscription_o->permanent_irregularities; +is($permanent_irreg[0], 1, 'First element of permanent_irregularities is 1'); +is($permanent_irreg[1], 2, 'Second element of permanent_irregularities is 2'); + +$schema->storage->txn_rollback; --