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