Open-ILS/src/perlmods/live_t/26-lp1411422-transferring-items-volumes-with-parts.t

   1 #!perl
   2
   3 use Test::More tests => 8;
   4
   5 diag("Test transferring holds with parts.");
   6
   7 use constant WORKSTATION_NAME => 'BR1-test-26-lp1411422-transferring-items-volumes-with-parts.t';
   8 use constant WORKSTATION_LIB => 4;
   9
  10 use strict; use warnings;
  11
  12 use OpenILS::Utils::TestUtils;
  13 use OpenILS::Utils::CStoreEditor qw/:funcs/;
  14 use OpenILS::Utils::Fieldmapper;
  15
  16 our $script = OpenILS::Utils::TestUtils->new();
  17 $script->bootstrap;
  18
  19 our $e = new_editor(xact => 1);
  20 $e->init;
  21
  22
  23 # setup workstation and login
  24 # -------------
  25 setupLogin();
  26
  27 # Find a copy with at least one part
  28 # -------------
  29
  30 my $copy = $e->search_asset_copy([
  31 { deleted => 'f' },
  32 {
  33     join => {
  34         acpm => {
  35             type => 'inner',
  36             join => {
  37                 bmp => { type => 'left' },
  38             }
  39         }
  40     },
  41     flesh => 1,
  42     flesh_fields => { acp => ['parts']},
  43     limit => 1
  44 }
  45 ])->[0];
  46
  47 diag("Using copy ". $copy->id);
  48 my $parts = $copy->parts;
  49 my $oldcallnumber = $copy->call_number;
  50 my $part_objs = [];
  51 my $part;
  52
  53 foreach my $spart (@$parts) {
  54     $part = $spart;
  55 }
  56 diag("Copy part label -> ". $part->label);
  57
  58 diag("Copy call number ". $oldcallnumber);
  59
  60 $oldcallnumber = $e->search_asset_call_number({id => $oldcallnumber, deleted => 'f'})->[0];
  61
  62 diag("Copy attached to bib ". $oldcallnumber->record);
  63
  64 # Find a bib without parts
  65 # -------------
  66 my $sdestbib = $e->search_biblio_record_entry([
  67 {
  68 id =>
  69     {
  70         'not in' =>
  71             { "from" => 'bmp',
  72                 'select' =>  { "bmp" => [ 'record' ] }
  73             }
  74     },
  75 deleted => 'f' },
  76 { limit => 3 }
  77
  78 ]);
  79
  80 my $destbib;
  81 foreach(@{$sdestbib}) {
  82     if ($_->id > -1) {
  83         $destbib = $_;
  84         last;
  85     }
  86 }
  87
  88
  89 diag("Using this non parted bib ". $destbib->id);
  90
  91 # Create a new volume for the copy to transfer to
  92 # -------------
  93 my $newcall = Fieldmapper::asset::call_number->new;
  94
  95 $newcall->owning_lib($oldcallnumber->owning_lib);
  96 $newcall->record($destbib->id);
  97 $newcall->creator($oldcallnumber->creator);
  98 $newcall->editor($oldcallnumber->editor);
  99 $newcall->label('Test copy transfer with parts');
 100
 101
 102 my $stat = $e->create_asset_call_number($newcall);
 103 ok($stat, 'Created temporary volume on bib '.$destbib->id);
 104
 105 diag( "New call number id: " . $newcall->id );
 106
 107 # freshen up the variable
 108 # get all the rest of the values from the DB
 109 $newcall = $e->search_asset_call_number({id => $newcall->id})->[0];
 110
 111 # save changes so that the storage request has access
 112 $e->commit;
 113
 114 # make the transfer
 115 # -------------
 116 my @copy_id_array = ($copy->id);
 117 my $storage = $script->session('open-ils.cat');
 118 my $req = $storage->request(
 119     'open-ils.cat.transfer_copies_to_volume',  $script->authtoken, $newcall->id, \@copy_id_array )->gather(1);
 120
 121 # Did the code create a new part on the destination bib?
 122 # -------------
 123 $e->xact_begin;
 124
 125 my $destparts = $e->search_biblio_monograph_part({record => $newcall->record, label => $part->label, deleted => 'f'})->[0];
 126 ok($destparts, 'Copy transfer with parts success on bib '.$destbib->id);
 127
 128 is($destparts->label, $part->label, 'Part labels match and everything!');
 129
 130 # Now test transferring volumes,
 131 # might as well transfer it back to the old bib
 132 # -------------
 133
 134 my @vols = ($newcall->id);
 135 my $docid = $oldcallnumber->record;
 136 my $args = {lib => $oldcallnumber->owning_lib, docid => $docid, volumes => \@vols };
 137 $storage = $script->session('open-ils.cat');
 138 $req = $storage->request(
 139     'open-ils.cat.asset.volume.batch.transfer',
 140     $script->authtoken,
 141     $args
 142     )->gather(1);
 143 # Make sure that the old bib received the part
 144 my $destparts2 = $e->search_biblio_monograph_part({record => $oldcallnumber->record, label => $part->label, deleted => 'f'})->[0];
 145 ok($destparts2, 'Volume transfer with parts success on bib '.$oldcallnumber->record);
 146 is($destparts->label, $part->label, 'Part labels match and everything!');
 147
 148
 149 # Reverse the data
 150 # -------------
 151 $storage = $script->session('open-ils.cat');
 152 $req = $storage->request(
 153     'open-ils.cat.transfer_copies_to_volume',  $script->authtoken, $oldcallnumber->id, \@copy_id_array )->gather(1);
 154
 155 $stat = $e->delete_asset_call_number($newcall);
 156
 157 $e->xact_commit;
 158
 159
 160 sub setupLogin {
 161
 162     my $workstation = $e->search_actor_workstation([ {name => WORKSTATION_NAME, owning_lib => WORKSTATION_LIB } ])->[0];
 163
 164     if(!$workstation )
 165     {
 166         $script->authenticate({
 167             username => 'admin',
 168             password => 'demo123',
 169             type => 'staff'});
 170         ok( $script->authtoken, 'Have an authtoken');
 171         my $ws = $script->register_workstation(WORKSTATION_NAME,WORKSTATION_LIB);
 172         ok( ! ref $ws, 'Registered a new workstation');
 173         $script->logout();
 174     }
 175
 176     $script->authenticate({
 177         username => 'admin',
 178         password => 'demo123',
 179         type => 'staff',
 180         workstation => WORKSTATION_NAME});
 181     ok( $script->authtoken, 'Have an authtoken associated with the workstation');
 182 }
 183