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 => 5;
  21 use Test::MockModule;
  22 use Test::Warn;
  23
  24 use t::lib::Mocks;
  25 use t::lib::TestBuilder;
  26
  27 use C4::Members;
  28 use C4::Circulation;
  29 use C4::Items;
  30 use C4::Biblio;
  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         issuelength  => 1,
  58     }
  59 );
  60 $rule->store();
  61
  62 subtest "InProcessingToShelvingCart tests" => sub {
  63
  64     plan tests => 2;
  65
  66     $branch = $builder->build({ source => 'Branch' })->{ branchcode };
  67     my $permanent_location = 'TEST';
  68     my $location           = 'PROC';
  69
  70     # Create a biblio record with biblio-level itemtype
  71     my $record = MARC::Record->new();
  72     my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '' );
  73     my $built_item = $builder->build({
  74         source => 'Item',
  75         value  => {
  76             biblionumber  => $biblionumber,
  77             homebranch    => $branch,
  78             holdingbranch => $branch,
  79             location      => $location,
  80             permanent_location => $permanent_location
  81         }
  82     });
  83     my $barcode = $built_item->{ barcode };
  84     my $itemnumber = $built_item->{ itemnumber };
  85     my $item;
  86
  87     t::lib::Mocks::mock_preference( "InProcessingToShelvingCart", 1 );
  88     AddReturn( $barcode, $branch );
  89     $item = Koha::Items->find( $itemnumber );
  90     is( $item->location, 'CART',
  91         "InProcessingToShelvingCart functions as intended" );
  92
  93     ModItem( {location => $location}, undef, $itemnumber );
  94
  95     t::lib::Mocks::mock_preference( "InProcessingToShelvingCart", 0 );
  96     AddReturn( $barcode, $branch );
  97     $item = Koha::Items->find( $itemnumber );
  98     is( $item->location, $permanent_location,
  99         "InProcessingToShelvingCart functions as intended" );
 100 };
 101
 102
 103 subtest "AddReturn logging on statistics table (item-level_itypes=1)" => sub {
 104
 105     plan tests => 4;
 106
 107     # Set item-level item types
 108     t::lib::Mocks::mock_preference( "item-level_itypes", 1 );
 109
 110     # Make sure logging is enabled
 111     t::lib::Mocks::mock_preference( "IssueLog", 1 );
 112     t::lib::Mocks::mock_preference( "ReturnLog", 1 );
 113
 114     # Create an itemtype for biblio-level item type
 115     my $blevel_itemtype = $builder->build({ source => 'Itemtype' })->{ itemtype };
 116     # Create an itemtype for item-level item type
 117     my $ilevel_itemtype = $builder->build({ source => 'Itemtype' })->{ itemtype };
 118     # Create a branch
 119     $branch = $builder->build({ source => 'Branch' })->{ branchcode };
 120     # Create a borrower
 121     my $borrowernumber = $builder->build({
 122         source => 'Borrower',
 123         value => { branchcode => $branch }
 124     })->{ borrowernumber };
 125     # Look for the defined MARC field for biblio-level itemtype
 126     my $rs = $schema->resultset('MarcSubfieldStructure')->search({
 127         frameworkcode => '',
 128         kohafield     => 'biblioitems.itemtype'
 129     });
 130     my $tagfield    = $rs->first->tagfield;
 131     my $tagsubfield = $rs->first->tagsubfield;
 132
 133     # Create a biblio record with biblio-level itemtype
 134     my $record = MARC::Record->new();
 135     $record->append_fields(
 136         MARC::Field->new($tagfield,'','', $tagsubfield => $blevel_itemtype )
 137     );
 138     my ( $biblionumber, $biblioitemnumber ) = AddBiblio( $record, '' );
 139     my $item_with_itemtype = $builder->build(
 140         {
 141             source => 'Item',
 142             value  => {
 143                 biblionumber     => $biblionumber,
 144                 biblioitemnumber => $biblioitemnumber,
 145                 homebranch       => $branch,
 146                 holdingbranch    => $branch,
 147                 itype            => $ilevel_itemtype
 148             }
 149         }
 150     );
 151     my $item_without_itemtype = $builder->build(
 152         {
 153             source => 'Item',
 154             value  => {
 155                 biblionumber     => $biblionumber,
 156                 biblioitemnumber => $biblioitemnumber,
 157                 homebranch       => $branch,
 158                 holdingbranch    => $branch,
 159                 itype            => undef
 160             }
 161         }
 162     );
 163
 164     my $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 165     AddIssue( $borrower, $item_with_itemtype->{ barcode } );
 166     AddReturn( $item_with_itemtype->{ barcode }, $branch );
 167     # Test item-level itemtype was recorded on the 'statistics' table
 168     my $stat = $schema->resultset('Statistic')->search({
 169         branch     => $branch,
 170         type       => 'return',
 171         itemnumber => $item_with_itemtype->{ itemnumber }
 172     }, { order_by => { -asc => 'datetime' } })->next();
 173
 174     is( $stat->itemtype, $ilevel_itemtype,
 175         "item-level itype recorded on statistics for return");
 176     warning_like { AddIssue( $borrower, $item_without_itemtype->{ barcode } ) }
 177                  [qr/^item-level_itypes set but no itemtype set for item/,
 178                  qr/^item-level_itypes set but no itemtype set for item/,
 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 biblio 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             biblioitemnumber => $biblioitemnumber,
 238             homebranch    => $branch,
 239             holdingbranch => $branch,
 240             itype         => $ilevel_itemtype
 241         }
 242     });
 243     my $item_without_itemtype = $builder->build({
 244         source => 'Item',
 245         value  => {
 246             biblionumber  => $biblionumber,
 247             biblioitemnumber => $biblioitemnumber,
 248             homebranch    => $branch,
 249             holdingbranch => $branch,
 250             itype         => undef
 251         }
 252     });
 253
 254     my $borrower = Koha::Patrons->find( $borrowernumber )->unblessed;
 255
 256     AddIssue( $borrower, $item_with_itemtype->{ barcode } );
 257     AddReturn( $item_with_itemtype->{ barcode }, $branch );
 258     # Test item-level itemtype was recorded on the 'statistics' table
 259     my $stat = $schema->resultset('Statistic')->search({
 260         branch     => $branch,
 261         type       => 'return',
 262         itemnumber => $item_with_itemtype->{ itemnumber }
 263     }, { order_by => { -asc => 'datetime' } })->next();
 264
 265     is( $stat->itemtype, $blevel_itemtype,
 266         "biblio-level itype recorded on statistics for return");
 267
 268     AddIssue( $borrower, $item_without_itemtype->{ barcode } );
 269     AddReturn( $item_without_itemtype->{ barcode }, $branch );
 270     # Test biblio-level itemtype was recorded on the 'statistics' table
 271     $stat = $schema->resultset('Statistic')->search({
 272         branch     => $branch,
 273         type       => 'return',
 274         itemnumber => $item_without_itemtype->{ itemnumber }
 275     }, { order_by => { -asc => 'datetime' } })->next();
 276
 277     is( $stat->itemtype, $blevel_itemtype,
 278         "biblio-level itype recorded on statistics for return");
 279 };
 280
 281 subtest 'Handle ids duplication' => sub {
 282     plan tests => 8;
 283
 284     t::lib::Mocks::mock_preference( 'item-level_itypes', 1 );
 285     t::lib::Mocks::mock_preference( 'CalculateFinesOnReturn', 1 );
 286     t::lib::Mocks::mock_preference( 'finesMode', 'production' );
 287     Koha::IssuingRules->search->update({ chargeperiod => 1, fine => 1, firstremind => 1, });
 288
 289     my $biblio = $builder->build( { source => 'Biblio' } );
 290     my $itemtype = $builder->build( { source => 'Itemtype', value => { rentalcharge => 5 } } );
 291     my $item = $builder->build(
 292         {
 293             source => 'Item',
 294             value  => {
 295                 biblionumber => $biblio->{biblionumber},
 296                 notforloan => 0,
 297                 itemlost   => 0,
 298                 withdrawn  => 0,
 299                 itype      => $itemtype->{itemtype},
 300             }
 301         }
 302     );
 303     my $patron = $builder->build({source => 'Borrower'});
 304     $patron = Koha::Patrons->find( $patron->{borrowernumber} );
 305
 306     my $original_checkout = AddIssue( $patron->unblessed, $item->{barcode}, dt_from_string->subtract( days => 50 ) );
 307     my $issue_id = $original_checkout->issue_id;
 308     my $account_lines = Koha::Account::Lines->search({ borrowernumber => $patron->borrowernumber, issue_id => $issue_id });
 309     is( $account_lines->count, 1, '1 account line should exist for this issue_id' );
 310     is( $account_lines->next->description, 'Rental', 'patron has been charged the rentalcharge' );
 311     $account_lines->delete;
 312
 313     # Create an existing entry in old_issue
 314     $builder->build({ source => 'OldIssue', value => { issue_id => $issue_id } });
 315
 316     my $old_checkout = Koha::Old::Checkouts->find( $issue_id );
 317
 318     my ($doreturn, $messages, $new_checkout, $borrower);
 319     warning_like {
 320         ( $doreturn, $messages, $new_checkout, $borrower ) =
 321           AddReturn( $item->{barcode}, undef, undef, undef, dt_from_string );
 322     }
 323     [
 324         qr{.*DBD::mysql::st execute failed: Duplicate entry.*},
 325         { carped => qr{The checkin for the following issue failed.*Duplicate ID.*} }
 326     ],
 327     'DBD should have raised an error about dup primary key';
 328
 329     is( $doreturn, 0, 'Return should not have been done' );
 330     is( $messages->{WasReturned}, 0, 'messages should have the WasReturned flag set to 0' );
 331     is( $messages->{DataCorrupted}, 1, 'messages should have the DataCorrupted flag set to 1' );
 332
 333     $account_lines = Koha::Account::Lines->search({ borrowernumber => $patron->borrowernumber, issue_id => $issue_id });
 334     is( $account_lines->count, 0, 'No account lines should exist for this issue_id, patron should not have been charged' );
 335
 336     is( Koha::Checkouts->find( $issue_id )->issue_id, $issue_id, 'The issues entry should not have been removed' );
 337 };
 338
 339 subtest 'BlockReturnOfLostItems' => sub {
 340     plan tests => 4;
 341     my $biblio = $builder->build_object( { class => 'Koha::Biblios' } );
 342     my $item = $builder->build_object(
 343         {
 344             class  => 'Koha::Items',
 345             value  => {
 346                 biblionumber => $biblio->biblionumber,
 347                 notforloan => 0,
 348                 itemlost   => 0,
 349                 withdrawn  => 0,
 350         }
 351     }
 352     );
 353     my $patron = $builder->build_object({class => 'Koha::Patrons'});
 354     my $checkout = AddIssue( $patron->unblessed, $item->barcode );
 355
 356     # Mark the item as lost
 357     ModItem({itemlost => 1}, $biblio->biblionumber, $item->itemnumber);
 358
 359     t::lib::Mocks::mock_preference('BlockReturnOfLostItems', 1);
 360     my ( $doreturn, $messages, $issue ) = AddReturn($item->barcode);
 361     is( $doreturn, 0, "With BlockReturnOfLostItems, a checkin of a lost item should be blocked");
 362     is( $messages->{WasLost}, 1, "... and the WasLost flag should be set");
 363
 364     $item->discard_changes;
 365     is( $item->itemlost, 1, "Item remains lost" );
 366
 367     t::lib::Mocks::mock_preference('BlockReturnOfLostItems', 0);
 368     ( $doreturn, $messages, $issue ) = AddReturn($item->barcode);
 369     is( $doreturn, 1, "Without BlockReturnOfLostItems, a checkin of a lost item should not be blocked");
 370 };