t/db_dependent/Circulation/Returns.t

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 use Test::More tests => 4;
  21 use Test::MockModule;
  22 use Test::Warn;
  23
  24 use t::lib::Mocks;
  25 use t::lib::TestBuilder;
  26
  27 use C4::Biblio;
  28 use C4::Circulation;
  29 use C4::Items;
  30 use C4::Members;
  31 use Koha::Database;
  32 use Koha::Account::Lines;
  33 use Koha::DateUtils;
  34 use Koha::Items;
  35 use Koha::Patrons;
  36
  37 use MARC::Record;
  38 use MARC::Field;
  39
  40 # Mock userenv, used by AddIssue
  41 my $branch;
  42 my $context = Test::MockModule->new('C4::Context');
  43 $context->mock( 'userenv', sub {
  44     return { branch => $branch }
  45 });
  46
  47 my $schema = Koha::Database->schema;
  48 $schema->storage->txn_begin;
  49
  50 my $builder = t::lib::TestBuilder->new();
  51 Koha::IssuingRules->search->delete;
  52 my $rule = Koha::IssuingRule->new(
  53     {
  54         categorycode => '*',
  55         itemtype     => '*',
  56         branchcode   => '*',
  57         maxissueqty  => 99,
  58         issuelength  => 1,
  59     }
  60 );
  61 $rule->store();
  62
  63 subtest "InProcessingToShelvingCart tests" => sub {
  64
  65     plan tests => 2;
  66
  67     $branch = $builder->build({ source => 'Branch' })->{ branchcode };
  68     my $permanent_location = 'TEST';
  69     my $location           = 'PROC';
  70
  71     # Create a biblio record with biblio-level itemtype
  72     my $record = MARC::Record->new();
  73     my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '' );
  74     my $built_item = $builder->build({
  75         source => 'Item',
  76         value  => {
  77             biblionumber  => $biblionumber,
  78             homebranch    => $branch,
  79             holdingbranch => $branch,
  80             location      => $location,
  81             permanent_location => $permanent_location
  82         }
  83     });
  84     my $barcode = $built_item->{ barcode };
  85     my $itemnumber = $built_item->{ itemnumber };
  86     my $item;
  87
  88     t::lib::Mocks::mock_preference( "InProcessingToShelvingCart", 1 );
  89     AddReturn( $barcode, $branch );
  90     $item = GetItem( $itemnumber );
  91     is( $item->{location}, 'CART',
  92         "InProcessingToShelvingCart functions as intended" );
  93
  94     $item->{location} = $location;
  95     ModItem( $item, undef, $itemnumber );
  96
  97     t::lib::Mocks::mock_preference( "InProcessingToShelvingCart", 0 );
  98     AddReturn( $barcode, $branch );
  99     $item = GetItem( $itemnumber );
 100     is( $item->{location}, $permanent_location,
 101         "InProcessingToShelvingCart functions as intended" );
 102 };
 103
 104
 105 subtest "AddReturn logging on statistics table (item-level_itypes=1)" => sub {
 106
 107     plan tests => 4;
 108
 109     # Set item-level item types
 110     t::lib::Mocks::mock_preference( "item-level_itypes", 1 );
 111
 112     # Make sure logging is enabled
 113     t::lib::Mocks::mock_preference( "IssueLog", 1 );
 114     t::lib::Mocks::mock_preference( "ReturnLog", 1 );
 115
 116     # Create an itemtype for biblio-level item type
 117     my $blevel_itemtype = $builder->build({ source => 'Itemtype' })->{ itemtype };
 118     # Create an itemtype for item-level item type
 119     my $ilevel_itemtype = $builder->build({ source => 'Itemtype' })->{ itemtype };
 120     # Create a branch
 121     $branch = $builder->build({ source => 'Branch' })->{ branchcode };
 122     # Create a borrower
 123     my $borrowernumber = $builder->build({
 124         source => 'Borrower',
 125         value => { branchcode => $branch }
 126     })->{ borrowernumber };
 127     # Look for the defined MARC field for biblio-level itemtype
 128     my $rs = $schema->resultset('MarcSubfieldStructure')->search({
 129         frameworkcode => '',
 130         kohafield     => 'biblioitems.itemtype'
 131     });
 132     my $tagfield    = $rs->first->tagfield;
 133     my $tagsubfield = $rs->first->tagsubfield;
 134
 135     # Create a biblio record with biblio-level itemtype
 136     my $record = MARC::Record->new();
 137     $record->append_fields(
 138         MARC::Field->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
 139     );
 140     my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '' );
 141     my $item_with_itemtype = $builder->build(
 142         {
 143             source => 'Item',
 144             value  => {
 145                 biblionumber     => $biblionumber,
 146                 biblioitemnumber => $biblioitemnumber,
 147                 homebranch       => $branch,
 148                 holdingbranch    => $branch,
 149                 itype            => $ilevel_itemtype
 150             }
 151         }
 152     );
 153     my $item_without_itemtype = $builder->build(
 154         {
 155             source => 'Item',
 156             value  => {
 157                 biblionumber     => $biblionumber,
 158                 biblioitemnumber => $biblioitemnumber,
 159                 homebranch       => $branch,
 160                 holdingbranch    => $branch,
 161                 itype            => undef
 162             }
 163         }
 164     );
 165
 166     my $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 167     AddIssue( $borrower, $item_with_itemtype->{ barcode } );
 168     AddReturn( $item_with_itemtype->{ barcode }, $branch );
 169     # Test item-level itemtype was recorded on the 'statistics' table
 170     my $stat = $schema->resultset('Statistic')->search({
 171         branch     => $branch,
 172         type       => 'return',
 173         itemnumber => $item_with_itemtype->{ itemnumber }
 174     }, { order_by => { -asc => 'datetime' } })->next();
 175
 176     is( $stat->itemtype, $ilevel_itemtype,
 177         "item-level itype recorded on statistics for return");
 178     warning_like { AddIssue( $borrower, $item_without_itemtype->{ barcode } ) }
 179                  [qr/^item-level_itypes set but no itemtype set for item/,
 180                  qr/^item-level_itypes set but no itemtype set for item/],
 181                  'Item without itemtype set raises warning on AddIssue';
 182     warning_like { AddReturn( $item_without_itemtype->{ barcode }, $branch ) }
 183                  qr/^item-level_itypes set but no itemtype set for item/,
 184                  'Item without itemtype set raises warning on AddReturn';
 185     # Test biblio-level itemtype was recorded on the 'statistics' table
 186     $stat = $schema->resultset('Statistic')->search({
 187         branch     => $branch,
 188         type       => 'return',
 189         itemnumber => $item_without_itemtype->{ itemnumber }
 190     }, { order_by => { -asc => 'datetime' } })->next();
 191
 192     is( $stat->itemtype, $blevel_itemtype,
 193         "biblio-level itype recorded on statistics for return as a fallback for null item-level itype");
 194
 195 };
 196
 197 subtest "AddReturn logging on statistics table (item-level_itypes=0)" => sub {
 198
 199     plan tests => 2;
 200
 201     # Make sure logging is enabled
 202     t::lib::Mocks::mock_preference( "IssueLog", 1 );
 203     t::lib::Mocks::mock_preference( "ReturnLog", 1 );
 204
 205     # Set item-level item types
 206     t::lib::Mocks::mock_preference( "item-level_itypes", 0 );
 207
 208     # Create an itemtype for biblio-level item type
 209     my $blevel_itemtype = $builder->build({ source => 'Itemtype' })->{ itemtype };
 210     # Create an itemtype for item-level item type
 211     my $ilevel_itemtype = $builder->build({ source => 'Itemtype' })->{ itemtype };
 212     # Create a branch
 213     $branch = $builder->build({ source => 'Branch' })->{ branchcode };
 214     # Create a borrower
 215     my $borrowernumber = $builder->build({
 216         source => 'Borrower',
 217         value => { branchcode => $branch }
 218     })->{ borrowernumber };
 219     # Look for the defined MARC field for biblio-level itemtype
 220     my $rs = $schema->resultset('MarcSubfieldStructure')->search({
 221         frameworkcode => '',
 222         kohafield     => 'biblioitems.itemtype'
 223     });
 224     my $tagfield    = $rs->first->tagfield;
 225     my $tagsubfield = $rs->first->tagsubfield;
 226
 227     # Create a biblio record with biblio-level itemtype
 228     my $record = MARC::Record->new();
 229     $record->append_fields(
 230         MARC::Field->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
 231     );
 232     my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '' );
 233     my $item_with_itemtype = $builder->build({
 234         source => 'Item',
 235         value  => {
 236             biblionumber  => $biblionumber,
 237             homebranch    => $branch,
 238             holdingbranch => $branch,
 239             itype         => $ilevel_itemtype
 240         }
 241     });
 242     my $item_without_itemtype = $builder->build({
 243         source => 'Item',
 244         value  => {
 245             biblionumber  => $biblionumber,
 246             homebranch    => $branch,
 247             holdingbranch => $branch,
 248             itype         => undef
 249         }
 250     });
 251
 252     my $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 253
 254     AddIssue( $borrower, $item_with_itemtype->{ barcode } );
 255     AddReturn( $item_with_itemtype->{ barcode }, $branch );
 256     # Test item-level itemtype was recorded on the 'statistics' table
 257     my $stat = $schema->resultset('Statistic')->search({
 258         branch     => $branch,
 259         type       => 'return',
 260         itemnumber => $item_with_itemtype->{ itemnumber }
 261     }, { order_by => { -asc => 'datetime' } })->next();
 262
 263     is( $stat->itemtype, $blevel_itemtype,
 264         "biblio-level itype recorded on statistics for return");
 265
 266     AddIssue( $borrower, $item_without_itemtype->{ barcode } );
 267     AddReturn( $item_without_itemtype->{ barcode }, $branch );
 268     # Test biblio-level itemtype was recorded on the 'statistics' table
 269     $stat = $schema->resultset('Statistic')->search({
 270         branch     => $branch,
 271         type       => 'return',
 272         itemnumber => $item_without_itemtype->{ itemnumber }
 273     }, { order_by => { -asc => 'datetime' } })->next();
 274
 275     is( $stat->itemtype, $blevel_itemtype,
 276         "biblio-level itype recorded on statistics for return");
 277 };
 278
 279 subtest 'Handle ids duplication' => sub {
 280     plan tests => 6;
 281
 282     t::lib::Mocks::mock_preference( 'item-level_itypes', 1 );
 283     t::lib::Mocks::mock_preference( 'CalculateFinesOnReturn', 1 );
 284     t::lib::Mocks::mock_preference( 'finesMode', 'production' );
 285     Koha::IssuingRules->search->update({ chargeperiod => 1, fine => 1, firstremind => 1, });
 286
 287     my $biblio = $builder->build( { source => 'Biblio' } );
 288     my $itemtype = $builder->build( { source => 'Itemtype', value => { rentalcharge => 5 } } );
 289     my $item = $builder->build(
 290         {
 291             source => 'Item',
 292             value  => {
 293                 biblionumber => $biblio->{biblionumber},
 294                 notforloan => 0,
 295                 itemlost   => 0,
 296                 withdrawn  => 0,
 297                 itype      => $itemtype->{itemtype},
 298             }
 299         }
 300     );
 301     my $patron = $builder->build({source => 'Borrower'});
 302     $patron = Koha::Patrons->find( $patron->{borrowernumber} );
 303
 304     my $original_checkout = AddIssue( $patron->unblessed, $item->{barcode}, dt_from_string->subtract( days => 50 ) );
 305
 306     my $issue_id = $original_checkout->issue_id;
 307     # Create an existing entry in old_issue
 308     $builder->build({ source => 'OldIssue', value => { issue_id => $issue_id } });
 309
 310     my $old_checkout = Koha::Old::Checkouts->find( $issue_id );
 311
 312     my ($doreturn, $messages, $new_checkout, $borrower);
 313     warning_like {
 314         ( $doreturn, $messages, $new_checkout, $borrower ) =
 315           AddReturn( $item->{barcode}, undef, undef, undef, dt_from_string );
 316     }
 317     [
 318         qr{.*DBD::mysql::st execute failed: Duplicate entry.*},
 319         { carped => qr{The checkin for the following issue failed.*DBIx::Class::Storage::DBI::_dbh_execute.*} }
 320     ],
 321     'DBD should have raised an error about dup primary key';
 322
 323     is( $doreturn, 0, 'Return should not have been done' );
 324     is( $messages->{WasReturned}, 0, 'messages should have the WasReturned flag set to 0' );
 325     is( $messages->{DataCorrupted}, 1, 'messages should have the DataCorrupted flag set to 1' );
 326
 327     my $account_lines = Koha::Account::Lines->search({ borrowernumber => $patron->borrowernumber, issue_id => $issue_id });
 328     is( $account_lines->count, 0, 'No account lines should exist for this issue_id, patron should not have been charged' );
 329
 330     is( Koha::Checkouts->find( $issue_id )->issue_id, $issue_id, 'The issues entry should not have been removed' );
 331 };
 332
 333 1;