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

   1 # Copyright (c) 2007-2012 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 my @new_tape_label = $chg->make_new_tape_label();
 260 is_deeply(\@new_tape_label, [undef, "template is not set, you must set autolabel"], "no make_new_tape_label");
 261 is($chg->make_new_meta_label(), undef, "no make_new_meta_label");
 262
 263 $chg = Amanda::Changer->new("mychanger", tapelist => $tl,
 264                             labelstr => "TESTCONF-[0-9][0-9][0-9]-[a-z][a-z][a-z]-[0-9][0-9][0-9]",
 265                             autolabel => { template => '$c-$m-$b-%%%',
 266                                            other_config => 1,
 267                                            non_amanda => 1,
 268                                            volume_error => 0,
 269                                            empty => 1 },
 270                             meta_autolabel => "%%%");
 271 my $meta = $chg->make_new_meta_label();
 272 is($meta, "001", "meta 001");
 273 my $label = $chg->make_new_tape_label(meta => $meta, barcode => 'aaa');
 274 is($label, 'TESTCONF-001-aaa-001', "label TESTCONF-001-aaa-001");
 275
 276 is($chg->volume_is_labelable($DEVICE_STATUS_VOLUME_UNLABELED, $Amanda::Header::F_EMPTY),
 277    1, "empty volume is labelable");
 278 is($chg->volume_is_labelable($DEVICE_STATUS_VOLUME_ERROR, undef),
 279    0, "empty volume is labelable");
 280
 281 # test loading by label
 282 {
 283     my @labels;
 284     my @reservations;
 285     my ($getres, $rq_reserved, $relres);
 286
 287     $getres = make_cb('getres' => sub {
 288         if (!@labels) {
 289             return $rq_reserved->();
 290         }
 291
 292         my $label = pop @labels;
 293
 294         $chg->load(label => $label,
 295                    set_current => ($label eq "TAPE-02"),
 296                    res_cb => sub {
 297             my ($err, $res) = @_;
 298             ok(!$err, "no error loading $label")
 299                 or diag($err);
 300
 301             # keep this reservation
 302             push @reservations, $res if $res;
 303
 304             # and start on the next
 305             $getres->();
 306         });
 307     });
 308
 309     $rq_reserved = make_cb(rq_reserved => sub {
 310         # try to load an already-reserved volume
 311         $chg->load(label => 'TAPE-00',
 312                    res_cb => sub {
 313             my ($err, $res) = @_;
 314             ok($err, "error when requesting already-reserved volume");
 315             push @reservations, $res if $res;
 316
 317             $relres->();
 318         });
 319     });
 320
 321     $relres = make_cb('relres' => sub {
 322         if (!@reservations) {
 323             return Amanda::MainLoop::quit();
 324         }
 325
 326         my $res = pop @reservations;
 327         $res->release(finished_cb => sub {
 328             my ($err) = @_;
 329             die $err if $err;
 330
 331             $relres->();
 332         });
 333     });
 334
 335     # start the loop
 336     @labels = ( 'TAPE-02', 'TAPE-00', 'TAPE-03' );
 337     $getres->();
 338     Amanda::MainLoop::run();
 339
 340     $relres->();
 341     Amanda::MainLoop::run();
 342
 343     @labels = ( 'TAPE-00', 'TAPE-01' );
 344     $getres->();
 345     Amanda::MainLoop::run();
 346
 347     # explicitly release the reservations (without using the callback)
 348     for my $res (@reservations) {
 349         $res->release();
 350     }
 351 }
 352
 353 # test loading by slot
 354 {
 355     my ($start, $first_cb, $released, $second_cb, $quit);
 356     my $slot;
 357
 358     # reserves the current slot
 359     $start = make_cb('start' => sub {
 360         $chg->load(res_cb => $first_cb, relative_slot => "current");
 361     });
 362
 363     # gets a reservation for the "current" slot
 364     $first_cb = make_cb('first_cb' => sub {
 365         my ($err, $res) = @_;
 366         die $err if $err;
 367
 368         is($res->{'this_slot'}, 2,
 369             "'current' slot loads slot 2");
 370         is($res->{'device'}->device_name, "null:slot-2",
 371             "..device is correct");
 372
 373         $slot = $res->{'this_slot'};
 374         $res->release(finished_cb => $released);
 375     });
 376
 377     $released = make_cb(released => sub {
 378         my ($err) = @_;
 379
 380         $chg->load(res_cb => $second_cb, relative_slot => 'next',
 381                    slot => $slot, set_current => 1);
 382     });
 383
 384     # gets a reservation for the "next" slot
 385     $second_cb = make_cb('second_cb' => sub {
 386         my ($err, $res) = @_;
 387         die $err if $err;
 388
 389         is($res->{'this_slot'}, 3,
 390             "next slot loads slot 3");
 391         is($chg->{'curslot'}, 3,
 392             "..which is also now the current slot");
 393
 394         $res->release(finished_cb => $quit);
 395     });
 396
 397     $quit = make_cb(quit => sub {
 398         my ($err) = @_;
 399         die $err if $err;
 400
 401         Amanda::MainLoop::quit();
 402     });
 403
 404     $start->();
 405     Amanda::MainLoop::run();
 406 }
 407
 408 # test set_label
 409 {
 410     my ($start, $load1_cb, $set_cb, $released, $load2_cb, $released2, $load3_cb);
 411     my $res;
 412
 413     # load TAPE-00
 414     $start = make_cb('start' => sub {
 415         $chg->load(res_cb => $load1_cb, label => "TAPE-00");
 416     });
 417
 418     # rename it to TAPE-99
 419     $load1_cb = make_cb('load1_cb' => sub {
 420         (my $err, $res) = @_;
 421         die $err if $err;
 422
 423         pass("loaded TAPE-00");
 424         $res->set_label(label => "TAPE-99", finished_cb => $set_cb);
 425     });
 426
 427     $set_cb = make_cb('set_cb' => sub {
 428         my ($err) = @_;
 429
 430         $res->release(finished_cb => $released);
 431     });
 432
 433     # try to load TAPE-00
 434     $released = make_cb('released' => sub {
 435         my ($err) = @_;
 436         die $err if $err;
 437
 438         pass("relabeled TAPE-00 to TAPE-99");
 439         $chg->load(res_cb => $load2_cb, label => "TAPE-00");
 440     });
 441
 442     # try to load TAPE-99
 443     $load2_cb = make_cb('load2_cb' => sub {
 444         (my $err, $res) = @_;
 445         ok($err, "loading TAPE-00 is now an error");
 446
 447         $chg->load(res_cb => $load3_cb, label => "TAPE-99");
 448     });
 449
 450     # check result
 451     $load3_cb = make_cb('load3_cb' => sub {
 452         (my $err, $res) = @_;
 453         die $err if $err;
 454
 455         pass("but loading TAPE-99 is ok");
 456
 457         $res->release(finished_cb => $released2);
 458     });
 459
 460     $released2 = make_cb(released2 => sub {
 461         my ($err) = @_;
 462         die $err if $err;
 463
 464         Amanda::MainLoop::quit();
 465     });
 466
 467     $start->();
 468     Amanda::MainLoop::run();
 469 }
 470
 471 # test reset and clean and inventory
 472 sub test_simple {
 473     my ($finished_cb) = @_;
 474
 475     my $steps = define_steps
 476         cb_ref => \$finished_cb;
 477
 478     step do_reset => sub {
 479         $chg->reset(finished_cb => sub {
 480             is($chg->{'curslot'}, 0,
 481                 "reset() resets to slot 0");
 482             $steps->{'do_clean'}->();
 483         });
 484     };
 485
 486     step do_clean => sub {
 487         $chg->clean(finished_cb => sub {
 488             ok($chg->{'clean'}, "clean 'cleaned' the changer");
 489             $steps->{'do_inventory'}->();
 490         });
 491     };
 492
 493     step do_inventory => sub {
 494         $chg->inventory(inventory_cb => sub {
 495             is_deeply($_[1], [ {
 496                     slot => 1,
 497                     empty => 0,
 498                     label => 'TAPE-99',
 499                     barcode => '09385A',
 500                     reserved => 0,
 501                     import_export => 0,
 502                     loaded_in => undef,
 503                 }], "inventory returns an inventory");
 504             $finished_cb->();
 505         });
 506     };
 507 }
 508 test_simple(\&Amanda::MainLoop::quit);
 509 Amanda::MainLoop::run();
 510
 511 # test info
 512 {
 513     my ($do_info, $check_info, $do_info_err, $check_info_err);
 514
 515     $do_info = make_cb('do_info' => sub {
 516         $chg->info(info_cb => $check_info,
 517             info => [ 'num_slots' ]);
 518     });
 519
 520     $check_info = make_cb('check_info' => sub {
 521         my ($err, %results) = @_;
 522         die($err) if $err;
 523         is_deeply(\%results, { 'num_slots' => 13 },
 524             "info() works");
 525         $do_info_err->();
 526     });
 527
 528     $do_info_err = make_cb('do_info_err' => sub {
 529         $chg->info(info_cb => $check_info_err,
 530             info => [ 'mkerror1', 'mkerror2' ]);
 531     });
 532
 533     $check_info_err = make_cb('check_info_err' => sub {
 534         my ($err, %results) = @_;
 535         is($err,
 536           "While getting info key 'mkerror1': err1; While getting info key 'mkerror2': err2",
 537           "info errors are handled correctly");
 538         is($err->{'type'}, 'failed', "error has type 'failed'");
 539         ok($err->failed, "\$err->failed is true");
 540         ok(!$err->fatal, "\$err->fatal is false");
 541         is($err->{'reason'}, 'unknown', "\$err->{'reason'} is 'unknown'");
 542         ok($err->unknown, "\$err->unknown is true");
 543         ok(!$err->notimpl, "\$err->notimpl is false");
 544         Amanda::MainLoop::quit();
 545     });
 546
 547     $do_info->();
 548     Amanda::MainLoop::run();
 549 }
 550 $chg->quit();
 551
 552 # Test the various permutations of configuration setup, with a patched
 553 # _new_from_uri so we can monitor the result
 554 sub my_new_from_uri {
 555     my ($uri, $cc, $name) = @_;
 556     return $uri if (ref $uri and $uri->isa("Amanda::Changer::Error"));
 557     return [ $uri, $cc? "cc" : undef ];
 558 }
 559 *saved_new_from_uri = *Amanda::Changer::_new_from_uri;
 560 *Amanda::Changer::_new_from_uri = *my_new_from_uri;
 561
 562 sub loadconfig {
 563     my ($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn) = @_;
 564
 565     $testconf = Installcheck::Config->new();
 566
 567     if (defined($global_tapedev)) {
 568         $testconf->add_param('tapedev', "\"$global_tapedev\"")
 569     }
 570
 571     if (defined($global_tpchanger)) {
 572         $testconf->add_param('tpchanger', "\"$global_tpchanger\"")
 573     }
 574
 575     if (defined($defn_tpchanger)) {
 576         $testconf->add_changer("mychanger", [
 577             'tpchanger' => "\"$defn_tpchanger\"",
 578         ]);
 579     }
 580
 581     if (defined($custom_defn)) {
 582         $testconf->add_changer("customchanger", $custom_defn);
 583         $testconf->add_param('tpchanger', '"customchanger"');
 584     }
 585
 586     $testconf->write();
 587
 588     my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
 589     if ($cfg_result != $CFGERR_OK) {
 590         my ($level, @errors) = Amanda::Config::config_errors();
 591         die(join "\n", @errors);
 592     }
 593 }
 594
 595 sub assert_invalid {
 596     my ($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn,
 597         $name, $regexp, $msg) = @_;
 598     loadconfig($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn);
 599     my $err = Amanda::Changer->new($name);
 600     if ($err->isa("Amanda::Changer::Error")) {
 601         like($err->{'message'}, $regexp, $msg);
 602     } else {
 603         diag("Amanda::Changer->new did not return an Error object:");
 604         diag("".Dumper($err));
 605         fail($msg);
 606     }
 607 }
 608
 609 assert_invalid(undef, undef, undef, undef, undef,
 610     qr/You must specify one of 'tapedev' or 'tpchanger'/,
 611     "supplying a nothing is invalid");
 612
 613 loadconfig(undef, "file:/foo", undef, undef);
 614 is_deeply( Amanda::Changer->new(), [ "chg-single:file:/foo", undef ],
 615     "default changer with global tpchanger naming a device");
 616
 617 loadconfig(undef, "chg-disk:/foo", undef, undef);
 618 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", undef ],
 619     "default changer with global tpchanger naming a changer");
 620
 621 loadconfig(undef, "mychanger", "chg-disk:/bar", undef);
 622 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
 623     "default changer with global tpchanger naming a defined changer with a uri");
 624
 625 loadconfig(undef, "mychanger", "chg-zd-mtx", undef);
 626 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", "cc" ],
 627     "default changer with global tpchanger naming a defined changer with a compat script");
 628
 629 loadconfig(undef, "chg-zd-mtx", undef, undef);
 630 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", undef ],
 631     "default changer with global tpchanger naming a compat script");
 632
 633 loadconfig("tape:/dev/foo", undef, undef, undef);
 634 is_deeply( Amanda::Changer->new(), [ "chg-single:tape:/dev/foo", undef ],
 635     "default changer with global tapedev naming a device and no tpchanger");
 636
 637 assert_invalid("tape:/dev/foo", "tape:/dev/foo", undef, undef, undef,
 638     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 639     "supplying a device for both tpchanger and tapedev is invalid");
 640
 641 assert_invalid("tape:/dev/foo", "chg-disk:/foo", undef, undef, undef,
 642     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 643     "supplying a device for tapedev and a changer for tpchanger is invalid");
 644
 645 loadconfig("tape:/dev/foo", 'chg-zd-mtx', undef, undef);
 646 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", undef ],
 647     "default changer with global tapedev naming a device and a global tpchanger naming a compat script");
 648
 649 assert_invalid("chg-disk:/foo", "tape:/dev/foo", undef, undef, undef,
 650     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 651     "supplying a changer for tapedev and a device for tpchanger is invalid");
 652
 653 loadconfig("chg-disk:/foo", undef, undef, undef);
 654 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", undef ],
 655     "default changer with global tapedev naming a device");
 656
 657 loadconfig("mychanger", undef, "chg-disk:/bar", undef);
 658 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
 659     "default changer with global tapedev naming a defined changer with a uri");
 660
 661 loadconfig("mychanger", undef, "chg-zd-mtx", undef);
 662 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", "cc" ],
 663     "default changer with global tapedev naming a defined changer with a compat script");
 664
 665 loadconfig(undef, undef, "chg-disk:/foo", undef);
 666 is_deeply( Amanda::Changer->new("mychanger"), [ "chg-disk:/foo", "cc" ],
 667     "named changer loads the proper definition");
 668
 669 loadconfig(undef, undef, undef, [
 670     tapedev => '"chg-disk:/foo"',
 671 ]);
 672 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", "cc" ],
 673     "defined changer with tapedev loads the proper definition");
 674
 675 loadconfig(undef, undef, undef, [
 676     tpchanger => '"chg-disk:/bar"',
 677 ]);
 678 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
 679     "defined changer with tpchanger loads the proper definition");
 680
 681 assert_invalid(undef, undef, undef, [
 682         tpchanger => '"chg-disk:/bar"',
 683         tapedev => '"file:/bar"',
 684     ], undef,
 685     qr/Cannot specify both 'tapedev' and 'tpchanger'/,
 686     "supplying both a new tpchanger and tapedev in a definition is invalid");
 687
 688 assert_invalid(undef, undef, undef, [
 689         property => '"this" "will not work"',
 690     ], undef,
 691     qr/You must specify one of 'tapedev' or 'tpchanger'/,
 692     "supplying neither a tpchanger nor tapedev in a definition is invalid");
 693
 694 *Amanda::Changer::_new_from_uri = *saved_new_from_uri;
 695
 696 # test with_locked_state *within* a process
 697
 698 sub test_locked_state {
 699     my ($finished_cb) = @_;
 700     my $chg;
 701     my $stfile = "$Installcheck::TMP/test-statefile";
 702     my $num_outstanding = 0;
 703
 704     my $steps = define_steps
 705         cb_ref => \$finished_cb,
 706         finalize => sub { $chg->quit() if defined $chg };
 707
 708     step start => sub {
 709         $chg = Amanda::Changer->new("chg-null:");
 710
 711         for my $num (qw( one two three )) {
 712             ++$num_outstanding;
 713             $chg->with_locked_state($stfile, $steps->{'maybe_done'}, sub {
 714                 my ($state, $maybe_done) = @_;
 715
 716                 $state->{$num} = $num;
 717                 $state->{'count'}++;
 718
 719                 Amanda::MainLoop::call_after(50, $maybe_done, undef, $state);
 720             });
 721         }
 722     };
 723
 724     step maybe_done => sub {
 725         my ($err, $state) = @_;
 726         die $err if $err;
 727
 728         return if (--$num_outstanding);
 729
 730         is_deeply($state, {
 731             one => "one",
 732             two => "two",
 733             three => "three",
 734             count => 3,
 735         }, "state is maintained correctly (within a process)");
 736
 737         unlink($stfile) if -f $stfile;
 738
 739         $finished_cb->();
 740     };
 741 }
 742 test_locked_state(\&Amanda::MainLoop::quit);
 743 Amanda::MainLoop::run();