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