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