git.gag.com Git - debian/amanda/blob - installcheck/Amanda_Changer.pl

   1 # Copyright (c) 2007, 2008, 2009, 2010 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or modify it
   4 # under the terms of the GNU General Public License version 2 as published
   5 # by the Free Software Foundation.
   6 #
   7 # This program is distributed in the hope that it will be useful, but
   8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   9 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  10 # for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along
  13 # with this program; if not, write to the Free Software Foundation, Inc.,
  14 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  15 #
  16 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 use Test::More tests => 54;
  20 use File::Path;
  21 use Data::Dumper;
  22 use strict;
  23 use warnings;
  24
  25 use lib "@amperldir@";
  26 use Installcheck::Config;
  27 use Amanda::Paths;
  28 use Amanda::Device qw( :constants );;
  29 use Amanda::Debug;
  30 use Amanda::MainLoop;
  31 use Amanda::Config qw( :init :getconf config_dir_relative );
  32 use Amanda::Changer;
  33 use Amanda::Tapelist;
  34
  35 # set up debugging so debug output doesn't interfere with test results
  36 Amanda::Debug::dbopen("installcheck");
  37 Installcheck::log_test_output();
  38
  39 # and disable Debug's die() and warn() overrides
  40 Amanda::Debug::disable_die_override();
  41
  42 # --------
  43 # define a "test" changer for purposes of this installcheck
  44
  45 package Amanda::Changer::test;
  46 use vars qw( @ISA );
  47 @ISA = qw( Amanda::Changer );
  48
  49 # monkey-patch our test changer into Amanda::Changer, and indicate that
  50 # the module has already been required by adding a key to %INC
  51 $INC{'Amanda/Changer/test.pm'} = "Amanda_Changer";
  52
  53 sub new {
  54     my $class = shift;
  55     my ($config, $tpchanger) = @_;
  56
  57     my $self = {
  58         config => $config,
  59         curslot => 0,
  60         slots => [ 'TAPE-00', 'TAPE-01', 'TAPE-02', 'TAPE-03' ],
  61         reserved_slots => [],
  62         clean => 0,
  63     };
  64     bless ($self, $class);
  65     return $self;
  66 }
  67
  68 sub load {
  69     my $self = shift;
  70     my %params = @_;
  71
  72     my $cb = $params{'res_cb'};
  73
  74     if (exists $params{'label'}) {
  75         # search by label
  76         my $slot = -1;
  77         my $label = $params{'label'};
  78
  79         for my $i (0 .. $#{$self->{'slots'}}) {
  80             if ($self->{'slots'}->[$i] eq $label) {
  81                 $slot = $i;
  82                 last;
  83             }
  84         }
  85         if ($slot == -1) {
  86             $cb->("No such label '$label'", undef);
  87             return;
  88         }
  89
  90         # check that it's not in use
  91         for my $used_slot (@{$self->{'reserved_slots'}}) {
  92             if ($used_slot == $slot) {
  93                 $cb->("Volume with label '$label' is already in use", undef);
  94                 return;
  95             }
  96         }
  97
  98         # ok, let's use it.
  99         push @{$self->{'reserved_slots'}}, $slot;
 100
 101         if (exists $params{'set_current'} && $params{'set_current'}) {
 102             $self->{'curslot'} = $slot;
 103         }
 104
 105         $cb->(undef, Amanda::Changer::test::Reservation->new($self, $slot, $label));
 106     } elsif (exists $params{'slot'} or exists $params{'relative_slot'}) {
 107         my $slot = $params{'slot'};
 108         if (exists $params{'relative_slot'}) {
 109             if ($params{'relative_slot'} eq "current") {
 110                 $slot = $self->{'curslot'};
 111             } elsif ($params{'relative_slot'} eq "next") {
 112                 $slot = ($self->{'curslot'} + 1) % (scalar @{$self->{'slots'}});
 113             } else {
 114                 die "invalid relative_slot";
 115             }
 116         }
 117
 118         if (grep { $_ == $slot } @{$self->{'reserved_slots'}}) {
 119             $cb->("Slot $slot is already in use", undef);
 120             return;
 121         }
 122         my $label = $self->{'slots'}->[$slot];
 123         push @{$self->{'reserved_slots'}}, $slot;
 124
 125         if (exists $params{'set_current'} && $params{'set_current'}) {
 126             $self->{'curslot'} = $slot;
 127         }
 128
 129         $cb->(undef, Amanda::Changer::test::Reservation->new($self, $slot, $label));
 130     } else {
 131         die "No label or slot parameter given";
 132     }
 133 }
 134
 135 sub info_key {
 136     my $self = shift;
 137     my ($key, %params) = @_;
 138     my %results;
 139
 140     if ($key eq 'num_slots') {
 141         $results{$key} = 13;
 142     } elsif ($key eq 'mkerror1') {
 143         return $self->make_error("failed", $params{'info_cb'},
 144             reason => "unknown",
 145             message => "err1");
 146     } elsif ($key eq 'mkerror2') {
 147         return $self->make_error("failed", $params{'info_cb'},
 148             reason => "unknown",
 149             message => "err2");
 150     }
 151
 152     $params{'info_cb'}->(undef, %results) if $params{'info_cb'};
 153 }
 154
 155 sub reset {
 156     my $self = shift;
 157     my %params = @_;
 158
 159     $self->{'curslot'} = 0;
 160
 161     $params{'finished_cb'}->(undef) if $params{'finished_cb'};
 162 }
 163
 164 sub clean {
 165     my $self = shift;
 166     my %params = @_;
 167
 168     $self->{'clean'} = 1;
 169
 170     $params{'finished_cb'}->(undef) if $params{'finished_cb'};
 171 }
 172
 173 sub inventory {
 174     my $self = shift;
 175     my %params = @_;
 176
 177     Amanda::MainLoop::call_later($params{'inventory_cb'},
 178         undef, [ {
 179             slot => 1,
 180             empty => 0,
 181             label => 'TAPE-99',
 182             barcode => '09385A',
 183             reserved => 0,
 184             import_export => 0,
 185             loaded_in => undef,
 186         }]);
 187 }
 188
 189 package Amanda::Changer::test::Reservation;
 190 use vars qw( @ISA );
 191 @ISA = qw( Amanda::Changer::Reservation );
 192
 193 sub new {
 194     my $class = shift;
 195     my ($chg, $slot, $label) = @_;
 196     my $self = Amanda::Changer::Reservation::new($class);
 197
 198     $self->{'chg'} = $chg;
 199     $self->{'slot'} = $slot;
 200     $self->{'label'} = $label;
 201
 202     $self->{'device'} = Amanda::Device->new("null:slot-$slot");
 203     $self->{'this_slot'} = $slot;
 204
 205     return $self;
 206 }
 207
 208 sub do_release {
 209     my $self = shift;
 210     my %params = @_;
 211     my $slot = $self->{'slot'};
 212     my $chg = $self->{'chg'};
 213
 214     $chg->{'reserved_slots'} = [ grep { $_ != $slot } @{$chg->{'reserved_slots'}} ];
 215
 216     $params{'finished_cb'}->(undef) if $params{'finished_cb'};
 217 }
 218
 219 sub set_label {
 220     my $self = shift;
 221     my %params = @_;
 222     my $slot = $self->{'slot'};
 223     my $chg = $self->{'chg'};
 224
 225     $self->{'chg'}->{'slots'}->[$self->{'slot'}] = $params{'label'};
 226     $self->{'label'} = $params{'label'};
 227
 228     $params{'finished_cb'}->(undef) if $params{'finished_cb'};
 229 }
 230
 231 # --------
 232 # back to the perl tests..
 233
 234 package main;
 235
 236 # work against a config specifying our test changer, to work out the kinks
 237 # when it opens devices to check their labels
 238 my $testconf;
 239 $testconf = Installcheck::Config->new();
 240 $testconf->add_changer("mychanger", [
 241     'tpchanger' => '"chg-test:/foo"',
 242     'property' => '"testprop" "testval"',
 243 ]);
 244 $testconf->write();
 245
 246 my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
 247 if ($cfg_result != $CFGERR_OK) {
 248     my ($level, @errors) = Amanda::Config::config_errors();
 249     die(join "\n", @errors);
 250 }
 251
 252 # check out the relevant changer properties
 253 my $tlf = Amanda::Config::config_dir_relative(getconf($CNF_TAPELIST));
 254 my $tl = Amanda::Tapelist->new($tlf);
 255 my $chg = Amanda::Changer->new("mychanger", tapelist => $tl);
 256 is($chg->{'config'}->get_property("testprop"), "testval",
 257     "changer properties are correctly represented");
 258 is($chg->have_inventory(), 1, "changer have inventory");
 259 is($chg->make_new_tape_label(), undef, "no make_new_tape_label");
 260 is($chg->make_new_meta_label(), undef, "no make_new_meta_label");
 261
 262 $chg = Amanda::Changer->new("mychanger", tapelist => $tl,
 263                             labelstr => "TESTCONF-[0-9][0-9][0-9]-[a-z][a-z][a-z]-[0-9][0-9][0-9]",
 264                             autolabel => { template => '$c-$m-$b-%%%',
 265                                            other_config => 1,
 266                                            non_amanda => 1,
 267                                            volume_error => 0,
 268                                            empty => 1 },
 269                             meta_autolabel => "%%%");
 270 my $meta = $chg->make_new_meta_label();
 271 is($meta, "001", "meta 001");
 272 my $label = $chg->make_new_tape_label(meta => $meta, barcode => 'aaa');
 273 is($label, 'TESTCONF-001-aaa-001', "label TESTCONF-001-aaa-001");
 274
 275 is($chg->volume_is_labelable($DEVICE_STATUS_VOLUME_UNLABELED, $Amanda::Header::F_EMPTY),
 276    1, "empty volume is labelable");
 277 is($chg->volume_is_labelable($DEVICE_STATUS_VOLUME_ERROR, undef),
 278    0, "empty volume is labelable");
 279
 280 # test loading by label
 281 {
 282     my @labels;
 283     my @reservations;
 284     my ($getres, $rq_reserved, $relres);
 285
 286     $getres = make_cb('getres' => sub {
 287         if (!@labels) {
 288             return $rq_reserved->();
 289         }
 290
 291         my $label = pop @labels;
 292
 293         $chg->load(label => $label,
 294                    set_current => ($label eq "TAPE-02"),
 295                    res_cb => sub {
 296             my ($err, $res) = @_;
 297             ok(!$err, "no error loading $label")
 298                 or diag($err);
 299
 300             # keep this reservation
 301             push @reservations, $res if $res;
 302
 303             # and start on the next
 304             $getres->();
 305         });
 306     });
 307
 308     $rq_reserved = make_cb(rq_reserved => sub {
 309         # try to load an already-reserved volume
 310         $chg->load(label => 'TAPE-00',
 311                    res_cb => sub {
 312             my ($err, $res) = @_;
 313             ok($err, "error when requesting already-reserved volume");
 314             push @reservations, $res if $res;
 315
 316             $relres->();
 317         });
 318     });
 319
 320     $relres = make_cb('relres' => sub {
 321         if (!@reservations) {
 322             return Amanda::MainLoop::quit();
 323         }
 324
 325         my $res = pop @reservations;
 326         $res->release(finished_cb => sub {
 327             my ($err) = @_;
 328             die $err if $err;
 329
 330             $relres->();
 331         });
 332     });
 333
 334     # start the loop
 335     @labels = ( 'TAPE-02', 'TAPE-00', 'TAPE-03' );
 336     $getres->();
 337     Amanda::MainLoop::run();
 338
 339     $relres->();
 340     Amanda::MainLoop::run();
 341
 342     @labels = ( 'TAPE-00', 'TAPE-01' );
 343     $getres->();
 344     Amanda::MainLoop::run();
 345
 346     # explicitly release the reservations (without using the callback)
 347     for my $res (@reservations) {
 348         $res->release();
 349     }
 350 }
 351
 352 # test loading by slot
 353 {
 354     my ($start, $first_cb, $released, $second_cb, $quit);
 355     my $slot;
 356
 357     # reserves the current slot
 358     $start = make_cb('start' => sub {
 359         $chg->load(res_cb => $first_cb, relative_slot => "current");
 360     });
 361
 362     # gets a reservation for the "current" slot
 363     $first_cb = make_cb('first_cb' => sub {
 364         my ($err, $res) = @_;
 365         die $err if $err;
 366
 367         is($res->{'this_slot'}, 2,
 368             "'current' slot loads slot 2");
 369         is($res->{'device'}->device_name, "null:slot-2",
 370             "..device is correct");
 371
 372         $slot = $res->{'this_slot'};
 373         $res->release(finished_cb => $released);
 374     });
 375
 376     $released = make_cb(released => sub {
 377         my ($err) = @_;
 378
 379         $chg->load(res_cb => $second_cb, relative_slot => 'next',
 380                    slot => $slot, set_current => 1);
 381     });
 382
 383     # gets a reservation for the "next" slot
 384     $second_cb = make_cb('second_cb' => sub {
 385         my ($err, $res) = @_;
 386         die $err if $err;
 387
 388         is($res->{'this_slot'}, 3,
 389             "next slot loads slot 3");
 390         is($chg->{'curslot'}, 3,
 391             "..which is also now the current slot");
 392
 393         $res->release(finished_cb => $quit);
 394     });
 395
 396     $quit = make_cb(quit => sub {
 397         my ($err) = @_;
 398         die $err if $err;
 399
 400         Amanda::MainLoop::quit();
 401     });
 402
 403     $start->();
 404     Amanda::MainLoop::run();
 405 }
 406
 407 # test set_label
 408 {
 409     my ($start, $load1_cb, $set_cb, $released, $load2_cb, $released2, $load3_cb);
 410     my $res;
 411
 412     # load TAPE-00
 413     $start = make_cb('start' => sub {
 414         $chg->load(res_cb => $load1_cb, label => "TAPE-00");
 415     });
 416
 417     # rename it to TAPE-99
 418     $load1_cb = make_cb('load1_cb' => sub {
 419         (my $err, $res) = @_;
 420         die $err if $err;
 421
 422         pass("loaded TAPE-00");
 423         $res->set_label(label => "TAPE-99", finished_cb => $set_cb);
 424     });
 425
 426     $set_cb = make_cb('set_cb' => sub {
 427         my ($err) = @_;
 428
 429         $res->release(finished_cb => $released);
 430     });
 431
 432     # try to load TAPE-00
 433     $released = make_cb('released' => sub {
 434         my ($err) = @_;
 435         die $err if $err;
 436
 437         pass("relabeled TAPE-00 to TAPE-99");
 438         $chg->load(res_cb => $load2_cb, label => "TAPE-00");
 439     });
 440
 441     # try to load TAPE-99
 442     $load2_cb = make_cb('load2_cb' => sub {
 443         (my $err, $res) = @_;
 444         ok($err, "loading TAPE-00 is now an error");
 445
 446         $chg->load(res_cb => $load3_cb, label => "TAPE-99");
 447     });
 448
 449     # check result
 450     $load3_cb = make_cb('load3_cb' => sub {
 451         (my $err, $res) = @_;
 452         die $err if $err;
 453
 454         pass("but loading TAPE-99 is ok");
 455
 456         $res->release(finished_cb => $released2);
 457     });
 458
 459     $released2 = make_cb(released2 => sub {
 460         my ($err) = @_;
 461         die $err if $err;
 462
 463         Amanda::MainLoop::quit();
 464     });
 465
 466     $start->();
 467     Amanda::MainLoop::run();
 468 }
 469
 470 # test reset and clean and inventory
 471 sub test_simple {
 472     my ($finished_cb) = @_;
 473
 474     my $steps = define_steps
 475         cb_ref => \$finished_cb;
 476
 477     step do_reset => sub {
 478         $chg->reset(finished_cb => sub {
 479             is($chg->{'curslot'}, 0,
 480                 "reset() resets to slot 0");
 481             $steps->{'do_clean'}->();
 482         });
 483     };
 484
 485     step do_clean => sub {
 486         $chg->clean(finished_cb => sub {
 487             ok($chg->{'clean'}, "clean 'cleaned' the changer");
 488             $steps->{'do_inventory'}->();
 489         });
 490     };
 491
 492     step do_inventory => sub {
 493         $chg->inventory(inventory_cb => sub {
 494             is_deeply($_[1], [ {
 495                     slot => 1,
 496                     empty => 0,
 497                     label => 'TAPE-99',
 498                     barcode => '09385A',
 499                     reserved => 0,
 500                     import_export => 0,
 501                     loaded_in => undef,
 502                 }], "inventory returns an inventory");
 503             $finished_cb->();
 504         });
 505     };
 506 }
 507 test_simple(\&Amanda::MainLoop::quit);
 508 Amanda::MainLoop::run();
 509
 510 # test info
 511 {
 512     my ($do_info, $check_info, $do_info_err, $check_info_err);
 513
 514     $do_info = make_cb('do_info' => sub {
 515         $chg->info(info_cb => $check_info,
 516             info => [ 'num_slots' ]);
 517     });
 518
 519     $check_info = make_cb('check_info' => sub {
 520         my ($err, %results) = @_;
 521         die($err) if $err;
 522         is_deeply(\%results, { 'num_slots' => 13 },
 523             "info() works");
 524         $do_info_err->();
 525     });
 526
 527     $do_info_err = make_cb('do_info_err' => sub {
 528         $chg->info(info_cb => $check_info_err,
 529             info => [ 'mkerror1', 'mkerror2' ]);
 530     });
 531
 532     $check_info_err = make_cb('check_info_err' => sub {
 533         my ($err, %results) = @_;
 534         is($err,
 535           "While getting info key 'mkerror1': err1; While getting info key 'mkerror2': err2",
 536           "info errors are handled correctly");
 537         is($err->{'type'}, 'failed', "error has type 'failed'");
 538         ok($err->failed, "\$err->failed is true");
 539         ok(!$err->fatal, "\$err->fatal is false");
 540         is($err->{'reason'}, 'unknown', "\$err->{'reason'} is 'unknown'");
 541         ok($err->unknown, "\$err->unknown is true");
 542         ok(!$err->notimpl, "\$err->notimpl is false");
 543         Amanda::MainLoop::quit();
 544     });
 545
 546     $do_info->();
 547     Amanda::MainLoop::run();
 548 }
 549 $chg->quit();
 550
 551 # Test the various permutations of configuration setup, with a patched
 552 # _new_from_uri so we can monitor the result
 553 sub my_new_from_uri {
 554     my ($uri, $cc, $name) = @_;
 555     return $uri if (ref $uri and $uri->isa("Amanda::Changer::Error"));
 556     return [ $uri, $cc? "cc" : undef ];
 557 }
 558 *saved_new_from_uri = *Amanda::Changer::_new_from_uri;
 559 *Amanda::Changer::_new_from_uri = *my_new_from_uri;
 560
 561 sub loadconfig {
 562     my ($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn) = @_;
 563
 564     $testconf = Installcheck::Config->new();
 565
 566     if (defined($global_tapedev)) {
 567         $testconf->add_param('tapedev', "\"$global_tapedev\"")
 568     }
 569
 570     if (defined($global_tpchanger)) {
 571         $testconf->add_param('tpchanger', "\"$global_tpchanger\"")
 572     }
 573
 574     if (defined($defn_tpchanger)) {
 575         $testconf->add_changer("mychanger", [
 576             'tpchanger' => "\"$defn_tpchanger\"",
 577         ]);
 578     }
 579
 580     if (defined($custom_defn)) {
 581         $testconf->add_changer("customchanger", $custom_defn);
 582         $testconf->add_param('tpchanger', '"customchanger"');
 583     }
 584
 585     $testconf->write();
 586
 587     my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
 588     if ($cfg_result != $CFGERR_OK) {
 589         my ($level, @errors) = Amanda::Config::config_errors();
 590         die(join "\n", @errors);
 591     }
 592 }
 593
 594 sub assert_invalid {
 595     my ($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn,
 596         $name, $regexp, $msg) = @_;
 597     loadconfig($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn);
 598     my $err = Amanda::Changer->new($name);
 599     if ($err->isa("Amanda::Changer::Error")) {
 600         like($err->{'message'}, $regexp, $msg);
 601     } else {
 602         diag("Amanda::Changer->new did not return an Error object:");
 603         diag("".Dumper($err));
 604         fail($msg);
 605     }
 606 }
 607
 608 assert_invalid(undef, undef, undef, undef, undef,
 609     qr/You must specify one of 'tapedev' or 'tpchanger'/,
 610     "supplying a nothing is invalid");
 611
 612 loadconfig(undef, "file:/foo", undef, undef);
 613 is_deeply( Amanda::Changer->new(), [ "chg-single:file:/foo", undef ],
 614     "default changer with global tpchanger naming a device");
 615
 616 loadconfig(undef, "chg-disk:/foo", undef, undef);
 617 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", undef ],
 618     "default changer with global tpchanger naming a changer");
 619
 620 loadconfig(undef, "mychanger", "chg-disk:/bar", undef);
 621 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
 622     "default changer with global tpchanger naming a defined changer with a uri");
 623
 624 loadconfig(undef, "mychanger", "chg-zd-mtx", undef);
 625 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", "cc" ],
 626     "default changer with global tpchanger naming a defined changer with a compat script");
 627
 628 loadconfig(undef, "chg-zd-mtx", undef, undef);
 629 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", undef ],
 630     "default changer with global tpchanger naming a compat script");
 631
 632 loadconfig("tape:/dev/foo", undef, undef, undef);
 633 is_deeply( Amanda::Changer->new(), [ "chg-single:tape:/dev/foo", undef ],
 634     "default changer with global tapedev naming a device and no tpchanger");
 635
 636 assert_invalid("tape:/dev/foo", "tape:/dev/foo", undef, undef, undef,
 637     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 638     "supplying a device for both tpchanger and tapedev is invalid");
 639
 640 assert_invalid("tape:/dev/foo", "chg-disk:/foo", undef, undef, undef,
 641     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 642     "supplying a device for tapedev and a changer for tpchanger is invalid");
 643
 644 loadconfig("tape:/dev/foo", 'chg-zd-mtx', undef, undef);
 645 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", undef ],
 646     "default changer with global tapedev naming a device and a global tpchanger naming a compat script");
 647
 648 assert_invalid("chg-disk:/foo", "tape:/dev/foo", undef, undef, undef,
 649     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 650     "supplying a changer for tapedev and a device for tpchanger is invalid");
 651
 652 loadconfig("chg-disk:/foo", undef, undef, undef);
 653 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", undef ],
 654     "default changer with global tapedev naming a device");
 655
 656 loadconfig("mychanger", undef, "chg-disk:/bar", undef);
 657 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
 658     "default changer with global tapedev naming a defined changer with a uri");
 659
 660 loadconfig("mychanger", undef, "chg-zd-mtx", undef);
 661 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", "cc" ],
 662     "default changer with global tapedev naming a defined changer with a compat script");
 663
 664 loadconfig(undef, undef, "chg-disk:/foo", undef);
 665 is_deeply( Amanda::Changer->new("mychanger"), [ "chg-disk:/foo", "cc" ],
 666     "named changer loads the proper definition");
 667
 668 loadconfig(undef, undef, undef, [
 669     tapedev => '"chg-disk:/foo"',
 670 ]);
 671 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", "cc" ],
 672     "defined changer with tapedev loads the proper definition");
 673
 674 loadconfig(undef, undef, undef, [
 675     tpchanger => '"chg-disk:/bar"',
 676 ]);
 677 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
 678     "defined changer with tpchanger loads the proper definition");
 679
 680 assert_invalid(undef, undef, undef, [
 681         tpchanger => '"chg-disk:/bar"',
 682         tapedev => '"file:/bar"',
 683     ], undef,
 684     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 685     "supplying both a new tpchanger and tapedev in a definition is invalid");
 686
 687 assert_invalid(undef, undef, undef, [
 688         property => '"this" "will not work"',
 689     ], undef,
 690     qr/You must specify one of 'tapedev' or 'tpchanger'/,
 691     "supplying neither a tpchanger nor tapedev in a definition is invalid");
 692
 693 *Amanda::Changer::_new_from_uri = *saved_new_from_uri;
 694
 695 # test with_locked_state *within* a process
 696
 697 sub test_locked_state {
 698     my ($finished_cb) = @_;
 699     my $chg;
 700     my $stfile = "$Installcheck::TMP/test-statefile";
 701     my $num_outstanding = 0;
 702
 703     my $steps = define_steps
 704         cb_ref => \$finished_cb,
 705         finalize => sub { $chg->quit() if defined $chg };
 706
 707     step start => sub {
 708         $chg = Amanda::Changer->new("chg-null:");
 709
 710         for my $num (qw( one two three )) {
 711             ++$num_outstanding;
 712             $chg->with_locked_state($stfile, $steps->{'maybe_done'}, sub {
 713                 my ($state, $maybe_done) = @_;
 714
 715                 $state->{$num} = $num;
 716                 $state->{'count'}++;
 717
 718                 Amanda::MainLoop::call_after(50, $maybe_done, undef, $state);
 719             });
 720         }
 721     };
 722
 723     step maybe_done => sub {
 724         my ($err, $state) = @_;
 725         die $err if $err;
 726
 727         return if (--$num_outstanding);
 728
 729         is_deeply($state, {
 730             one => "one",
 731             two => "two",
 732             three => "three",
 733             count => 3,
 734         }, "state is maintained correctly (within a process)");
 735
 736         unlink($stfile) if -f $stfile;
 737
 738         $finished_cb->();
 739     };
 740 }
 741 test_locked_state(\&Amanda::MainLoop::quit);
 742 Amanda::MainLoop::run();