git.gag.com Git - debian/amanda/blob - perl/Amanda/Changer/aggregate.pm

   1 # Copyright (c) 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 94085, USA, or: http://www.zmanda.com
  18
  19 package Amanda::Changer::aggregate;
  20
  21 use strict;
  22 use warnings;
  23 use vars qw( @ISA );
  24 @ISA = qw( Amanda::Changer );
  25
  26 use File::Glob qw( :glob );
  27 use File::Path;
  28 use Amanda::Config qw( :getconf );
  29 use Amanda::Paths;
  30 use Amanda::Debug qw( debug warning );
  31 use Amanda::Util qw( :alternates );
  32 use Amanda::Changer;
  33 use Amanda::MainLoop;
  34 use Amanda::Device qw( :constants );
  35
  36 =head1 NAME
  37
  38 Amanda::Changer::aggregate
  39
  40 =head1 DESCRIPTION
  41
  42 This changer operates several child changers.
  43 Slot are numbered:
  44   0:0  changer 0 slot 0
  45   0:1  changer 0 slot 1
  46   1:0  changer 1 slot 0
  47   3:4  changer 3 slot 4
  48
  49 See the amanda-changers(7) manpage for usage information.
  50
  51 =cut
  52
  53 sub new {
  54     my $class = shift;
  55     my ($config, $tpchanger) = @_;
  56     my ($kidspecs) = ( $tpchanger =~ /chg-aggregate:(.*)/ );
  57
  58     my @kidspecs = Amanda::Util::expand_braced_alternates($kidspecs);
  59     if (@kidspecs < 2) {
  60         return Amanda::Changer->make_error("fatal", undef,
  61             message => "chg-aggregate needs at least two child changers");
  62     }
  63
  64     my @children = map {
  65         ($_ eq "ERROR")? "ERROR" : Amanda::Changer->new($_)
  66     } @kidspecs;
  67
  68     my $fail_on_error;
  69     if (defined $config->{'properties'}->{'fail-on-error'}) {
  70         $fail_on_error = string_to_boolean($config->{'properties'}->{'fail-on-error'}->{'values'}[0]);
  71     } else {
  72         $fail_on_error = 1;
  73     }
  74
  75     if (grep { $_->isa("Amanda::Changer::Error") } @children) {
  76         my @annotated_errs;
  77         my $valid = 0;
  78         for my $i (0 .. @children-1) {
  79             if ($children[$i]->isa("Amanda::Changer::Error")) {
  80                 push @annotated_errs,
  81                     [ $kidspecs[$i], $children[$i] ];
  82             } else {
  83                 $valid++;
  84             }
  85         }
  86         if ($valid == 0 || $fail_on_error) {
  87             return Amanda::Changer->make_combined_error(
  88                 "fatal", [ @annotated_errs ]);
  89         }
  90     }
  91
  92     my $state_filename;
  93     my $state_filename_prop = $config->{'properties'}->{'state_filename'};
  94
  95     if (defined $state_filename_prop) {
  96         $state_filename = $state_filename_prop->{'values'}[0];
  97     }
  98     if (!defined $state_filename) {
  99         $state_filename = $Amanda::Paths::CONFIG_DIR . '/' . $config->{'name'} . ".state";
 100     }
 101
 102     my $self = {
 103         config => $config,
 104         child_names => \@kidspecs,
 105         children => \@children,
 106         num_children => scalar @children,
 107         current_slot => undef,
 108         state_filename => $state_filename,
 109     };
 110     bless ($self, $class);
 111     return $self;
 112 }
 113
 114 sub quit {
 115     my $self = shift;
 116
 117     # quit each child
 118     foreach my $child (@{$self->{'children'}}) {
 119         $child->quit();
 120     }
 121
 122     $self->SUPER::quit();
 123 }
 124
 125 sub _get_current_slot
 126 {
 127     my $self = shift;
 128     my $cb = shift;
 129
 130     $self->with_locked_state($self->{'state_filename'}, $cb, sub {
 131         my ($state, $cb) = @_;
 132         $self->{'current_slot'} = $state->{'current_slot'};
 133         $self->{'current_slot'} = "0:first" if !defined $self->{'current_slot'};
 134         $cb->();
 135     });
 136 }
 137
 138 sub _set_current_slot
 139 {
 140     my $self = shift;
 141     my $cb = shift;
 142
 143     $self->with_locked_state($self->{'state_filename'}, $cb, sub {
 144         my ($state, $cb) = @_;
 145         $state->{'current_slot'} = $self->{'current_slot'};
 146         $cb->();
 147     });
 148 }
 149
 150 sub load {
 151     my $self = shift;
 152     my %params = @_;
 153     my $aggregate_res;
 154
 155     return if $self->check_error($params{'res_cb'});
 156
 157     my $res_cb = $params{'res_cb'};
 158     my $orig_slot = $params{'slot'};
 159     $self->validate_params('load', \%params);
 160
 161     my $steps = define_steps
 162         cb_ref => \$res_cb;
 163
 164     step which_slot => sub {
 165         if (exists $params{'relative_slot'} &&
 166             $params{'relative_slot'} eq "current") {
 167             if (defined $self->{'current_slot'}) {
 168                 return $steps->{'set_from_current'}->();
 169             } else {
 170                 return $self->_get_current_slot($steps->{'set_from_current'});
 171             }
 172         } elsif (exists $params{'relative_slot'} &&
 173                  $params{'relative_slot'} eq "next") {
 174             if (defined $self->{'current_slot'}) {
 175                 return $steps->{'get_inventory_next'}->();
 176             } else {
 177                 return $self->_get_current_slot($steps->{'get_inventory_next'});
 178             }
 179         } elsif (exists $params{'label'}) {
 180             return $self->inventory(inventory_cb => $steps->{'got_inventory_label'});
 181         }
 182         return $steps->{'slot_set'}->();
 183     };
 184
 185     step get_inventory_next => sub {
 186         return $self->inventory(inventory_cb => $steps->{'got_inventory_next'})
 187     };
 188
 189     step got_inventory_next => sub {
 190         my ($err, $inv) = @_;
 191         my $slot;
 192         if ($err) {
 193             $res_cb->($err);
 194         }
 195         my $found = -1;
 196         for my $i (0.. scalar(@$inv)-1) {
 197             $slot = @$inv[$i]->{'slot'};
 198             if ($slot eq $self->{'current_slot'}) {
 199                 $found = $i;
 200             } elsif ($found >= 0 && (!exists $params{'except_slots'} ||
 201                                 !exists $params{'except_slots'}->{$slot})) {
 202                 $orig_slot = $slot;
 203                 return $steps->{'slot_set'}->();
 204             }
 205         }
 206         if ($found >= 0) {
 207             for my $i (0..($found-1)) {
 208                 $slot = @$inv[$i]->{'slot'};
 209                 if (!exists($params{'except_slots'}) ||
 210                     !exists($params{'except_slots'}->{$slot})) {
 211                     $orig_slot = $slot;
 212                     return $steps->{'slot_set'}->();
 213                 }
 214             }
 215         }
 216         return $self->make_error("failed", $res_cb,
 217                 reason => "notfound",
 218                 message => "all slots have been loaded");
 219     };
 220
 221     step got_inventory_label => sub {
 222         my ($err, $inv) = @_;
 223         my $slot;
 224         if ($err) {
 225             $res_cb->($err);
 226         }
 227         for my $i (0.. scalar(@$inv)-1) {
 228             my $slot = @$inv[$i]->{'slot'};
 229             my $label = @$inv[$i]->{'label'};
 230             if ($label eq $params{'label'}) {
 231                 $orig_slot = $slot;
 232                 return $steps->{'slot_set'}->();
 233             }
 234         }
 235         return $self->make_error("failed", $res_cb,
 236                 reason => "notfound",
 237                 message => "label $params{'label'} not found");
 238     };
 239
 240     step set_from_current => sub {
 241         $orig_slot = $self->{'current_slot'};
 242         return $steps->{'slot_set'}->();
 243     };
 244
 245     step slot_set => sub {
 246         my ($kid, $slot) = split(':', $orig_slot, 2);
 247         my $child = $self->{'children'}[$kid];
 248         if (!defined $child) {
 249             return $self->make_error("failed", $res_cb,
 250                 reason => "invalid",
 251                 message => "no changer $kid");
 252         }
 253         delete $params{'relative_slot'};
 254         $params{'slot'} = $slot;
 255         $params{'res_cb'} = sub {
 256             my ($err, $res) = @_;
 257             if ($res) {
 258                 if ($slot ne "first" && $res->{'this_slot'} != $slot) {
 259                     return $self->make_error("failed", $res_cb,
 260                         reason => "invalid",
 261                         message => "slot doesn't match: $res->{'this_slot'} != $slot");
 262                 } else {
 263                     $self->{'current_slot'} = "$kid:$res->{'this_slot'}";
 264                     $aggregate_res = Amanda::Changer::aggregate::Reservation->new($self, $res, $self->{'current_slot'});
 265                     return $self->_set_current_slot($steps->{'done'});
 266                 }
 267             }
 268             return $res_cb->($err, undef);
 269         };
 270         return $child->load(%params);
 271     };
 272
 273     step done => sub {
 274         $res_cb->(undef, $aggregate_res);
 275     };
 276 }
 277
 278 sub info_key {
 279     my $self = shift;
 280     my ($key, %params) = @_;
 281
 282     return if $self->check_error($params{'info_cb'});
 283
 284     my $check_and_report_errors = sub {
 285         my ($kid_results) = @_;
 286
 287         if (grep { defined($_->[0]) } @$kid_results) {
 288             # we have errors, so collect them and make a "combined" error.
 289             my @annotated_errs;
 290             my @err_slots;
 291             for my $i (0 .. $self->{'num_children'}-1) {
 292                 my $kr = $kid_results->[$i];
 293                 next unless defined($kr->[0]);
 294                 push @annotated_errs,
 295                     [ $self->{'child_names'}[$i], $kr->[0] ];
 296                 push @err_slots, $kr->[0]->{'slot'}
 297                     if (defined $kr->[0] and defined $kr->[0]->{'slot'});
 298             }
 299
 300             my @slotarg;
 301             if (@err_slots == $self->{'num_children'}) {
 302                 @slotarg = (slot => collapse_braced_alternates([@err_slots]));
 303             }
 304
 305             $self->make_combined_error(
 306                 $params{'info_cb'}, [ @annotated_errs ],
 307                 @slotarg);
 308             return 1;
 309         }
 310     };
 311
 312     if ($key eq 'num_slots') {
 313         my $all_kids_done_cb = sub {
 314             my ($kid_results) = @_;
 315             return if ($check_and_report_errors->($kid_results));
 316
 317             # Sum the result
 318             my $num_slots;
 319             for (@$kid_results) {
 320                 my ($err, %kid_info) = @$_;
 321                 next unless exists($kid_info{'num_slots'});
 322                 my $kid_num_slots = $kid_info{'num_slots'};
 323                 $num_slots += $kid_num_slots;
 324             }
 325             $params{'info_cb'}->(undef, num_slots => $num_slots) if $params{'info_cb'};
 326         };
 327
 328         $self->_for_each_child(
 329             oksub => sub {
 330                 my ($kid_chg, $kid_cb) = @_;
 331                 $kid_chg->info(info => [ 'num_slots' ], info_cb => $kid_cb);
 332             },
 333             errsub => undef,
 334             parent_cb => $all_kids_done_cb,
 335         );
 336     } elsif ($key eq "vendor_string") {
 337         my $all_kids_done_cb = sub {
 338             my ($kid_results) = @_;
 339             return if ($check_and_report_errors->($kid_results));
 340
 341             my @kid_vendors =
 342                 grep { defined($_) }
 343                 map { my ($e, %r) = @$_; $r{'vendor_string'} }
 344                 @$kid_results;
 345             my $vendor_string;
 346             if (@kid_vendors) {
 347                 $vendor_string = collapse_braced_alternates([@kid_vendors]);
 348                 $params{'info_cb'}->(undef, vendor_string => $vendor_string) if $params{'info_cb'};
 349             } else {
 350                 $params{'info_cb'}->(undef) if $params{'info_cb'};
 351             }
 352         };
 353
 354         $self->_for_each_child(
 355             oksub => sub {
 356                 my ($kid_chg, $kid_cb) = @_;
 357                 $kid_chg->info(info => [ 'vendor_string' ], info_cb => $kid_cb);
 358             },
 359             errsub => undef,
 360             parent_cb => $all_kids_done_cb,
 361         );
 362     } elsif ($key eq 'fast_search') {
 363         my $all_kids_done_cb = sub {
 364             my ($kid_results) = @_;
 365             return if ($check_and_report_errors->($kid_results));
 366
 367             my @kid_fastness =
 368                 grep { defined($_) }
 369                 map { my ($e, %r) = @$_; $r{'fast_search'} }
 370                 @$kid_results;
 371             if (@kid_fastness) {
 372                 my $fast_search = 1;
 373                 # conduct a logical AND of all child fastnesses
 374                 for my $f (@kid_fastness) {
 375                     $fast_search = $fast_search && $f;
 376                 }
 377                 $params{'info_cb'}->(undef, fast_search => $fast_search) if $params{'info_cb'};
 378             } else {
 379                 $params{'info_cb'}->(undef, fast_search => 0) if $params{'info_cb'};
 380             }
 381         };
 382
 383         $self->_for_each_child(
 384             oksub => sub {
 385                 my ($kid_chg, $kid_cb) = @_;
 386                 $kid_chg->info(info => [ 'fast_search' ], info_cb => $kid_cb);
 387             },
 388             errsub => undef,
 389             parent_cb => $all_kids_done_cb,
 390         );
 391     }
 392 }
 393
 394 # reset, clean, etc. are all *very* similar to one another, so we create them
 395 # generically
 396 sub _mk_simple_op {
 397     my ($op, $has_drive) = @_;
 398     sub {
 399         my $self = shift;
 400         my %params = @_;
 401
 402         return if $self->check_error($params{'finished_cb'});
 403
 404         if (exists $params{'drive'}) {
 405             return $self->make_error("failed", $params{'finished_cb'},
 406                     reason => "notimpl",
 407                     message => "Can't specify drive fo $op command");
 408         }
 409
 410         my $all_kids_done_cb = sub {
 411             my ($kid_results) = @_;
 412             if (grep { defined($_->[0]) } @$kid_results) {
 413                 # we have errors, so collect them and make a "combined" error.
 414                 my @annotated_errs;
 415                 for my $i (0 .. $self->{'num_children'}-1) {
 416                     my $kr = $kid_results->[$i];
 417                     next unless defined($kr->[0]);
 418                     push @annotated_errs,
 419                         [ $self->{'child_names'}[$i], $kr->[0] ];
 420                 }
 421                 $self->make_combined_error(
 422                     $params{'finished_cb'}, [ @annotated_errs ]);
 423                 return 1;
 424             }
 425             $params{'finished_cb'}->() if $params{'finished_cb'};
 426         };
 427
 428         $self->_for_each_child(
 429             oksub => sub {
 430                 my ($kid_chg, $kid_cb) = @_;
 431                 $kid_chg->$op(%params, finished_cb => $kid_cb);
 432             },
 433             errsub => undef,
 434             parent_cb => $all_kids_done_cb,
 435         );
 436     };
 437 }
 438
 439 {
 440     # perl doesn't like that these symbols are only mentioned once
 441     no warnings;
 442
 443     *reset = _mk_simple_op("reset");
 444     *clean = _mk_simple_op("clean");
 445     *eject = _mk_simple_op("eject");
 446 }
 447
 448 sub update {
 449     my $self = shift;
 450     my %params = @_;
 451     my %changed;
 452     my @kid_args;
 453
 454     my $user_msg_fn = $params{'user_msg_fn'};
 455     $user_msg_fn ||= sub { Amanda::Debug::info("chg-aggregate: " . $_[0]); };
 456
 457     if (exists $params{'changed'}) {
 458         for my $range (split ',', $params{'changed'}) {
 459             my ($first, $last) = ($range =~ /([:\d]+)(?:-([:\d]+))?/);
 460             $last = $first unless defined($last);
 461             if ($first =~ /:/) {
 462                 my ($f_kid, $f_slot) = split(':', $first, 2);
 463                 my ($l_kid, $l_slot) = split(':', $last, 2);
 464                 if ($f_kid != $l_kid) {
 465                     return;
 466                 }
 467                 if ($changed{$f_kid} != 1) {
 468                     for my $slot ($f_slot..$l_slot) {
 469                         $changed{$f_kid}{$slot} = 1;
 470                     }
 471                 }
 472             } else {
 473                 for my $kid ($first..$last) {
 474                     $changed{$kid} = 1;
 475                 }
 476             }
 477         }
 478         for my $kid (0..$self->{'num_children'}-1) {
 479             if ($changed{$kid} == 1) {
 480                 $kid_args[$kid] = "ALL";
 481             } elsif (keys %{$changed{$kid}} > 0) {
 482                 $kid_args[$kid] = { changed => join(',',sort(keys %{$changed{$kid}})) };
 483             } else {
 484                 $kid_args[$kid] = "NONE";
 485             }
 486         }
 487     } else {
 488         for my $kid (0..$self->{'num_children'}-1) {
 489             $kid_args[$kid] = "ALL";
 490         }
 491     }
 492
 493     my $all_kids_done_cb = sub {
 494         my ($kid_results) = @_;
 495         if (grep { defined($_->[0]) } @$kid_results) {
 496             # we have errors, so collect them and make a "combined" error.
 497             my @annotated_errs;
 498             for my $i (0 .. $self->{'num_children'}-1) {
 499                 my $kr = $kid_results->[$i];
 500                 next unless defined($kr->[0]);
 501                 push @annotated_errs,
 502                     [ $self->{'child_names'}[$i], $kr->[0] ];
 503             }
 504             $self->make_combined_error(
 505                 $params{'finished_cb'}, [ @annotated_errs ]);
 506             return 1;
 507         }
 508         $params{'finished_cb'}->() if $params{'finished_cb'};
 509     };
 510
 511     $self->_for_each_child(
 512         oksub => sub {
 513             my ($kid_chg, $kid_cb, $args) = @_;
 514             if (ref($args) eq "HASH") {
 515                 $kid_chg->update(%params, finished_cb => $kid_cb, %$args);
 516             } elsif ($args eq "ALL") {
 517                 $kid_chg->update(%params, finished_cb => $kid_cb);
 518             } else {
 519                 $kid_cb->();
 520             }
 521         },
 522         errsub => undef,
 523         parent_cb => $all_kids_done_cb,
 524         args => \@kid_args,
 525     );
 526 }
 527
 528 sub inventory {
 529     my $self = shift;
 530     my %params = @_;
 531
 532     return if $self->check_error($params{'inventory_cb'});
 533
 534     my $steps = define_steps
 535         cb_ref => \$params{'inventory_cb'};
 536
 537     step get_current => sub {
 538         return $self->_get_current_slot($steps->{'got_current_slot'});
 539     };
 540
 541     step got_current_slot => sub {
 542         $self->_for_each_child(
 543             oksub => sub {
 544                 my ($kid_chg, $kid_cb) = @_;
 545                 $kid_chg->inventory(inventory_cb => $kid_cb);
 546             },
 547             errsub => undef,
 548             parent_cb => $steps->{'all_kids_done_cb'},
 549         );
 550     };
 551
 552     step all_kids_done_cb => sub {
 553         my ($kid_results) = @_;
 554         if (grep { defined($_->[0]) } @$kid_results) {
 555             # we have errors, so collect them and make a "combined" error.
 556             my @annotated_errs;
 557             for my $i (0 .. $self->{'num_children'}-1) {
 558                 my $kr = $kid_results->[$i];
 559                 next unless defined($kr->[0]);
 560                 push @annotated_errs,
 561                     [ $self->{'child_names'}[$i], $kr->[0] ];
 562             }
 563             return $self->make_combined_error(
 564                 $params{'inventory_cb'}, [ @annotated_errs ]);
 565         }
 566
 567         my $inv = $self->_merge_inventories($kid_results);
 568         if (!defined $inv) {
 569             return $self->make_error("failed", $params{'inventory_cb'},
 570                     reason => "notimpl",
 571                     message => "could not generate consistent inventory from aggregate child changers");
 572         }
 573
 574         $params{'inventory_cb'}->(undef, $inv);
 575     };
 576
 577 }
 578
 579 sub set_meta_label {
 580     my $self = shift;
 581     my %params = @_;
 582     my $state;
 583
 584     return if $self->check_error($params{'finished_cb'});
 585
 586     my $finished_cb = $params{'finished_cb'};
 587     my $orig_slot = $params{'slot'};
 588
 589     if (!defined $params{'slot'}) {
 590         return $self->make_error("failed", $finished_cb,
 591             reason => "invalid",
 592             message => "no 'slot' params set.");
 593     }
 594
 595     if (!defined $params{'meta'}) {
 596         return $self->make_error("failed", $finished_cb,
 597             reason => "invalid",
 598             message => "no 'meta' params set.");
 599     }
 600
 601     my ($kid, $slot) = split(':', $orig_slot, 2);
 602     my $child = $self->{'children'}[$kid];
 603     if (!defined $child) {
 604         return $self->make_error("failed", $finished_cb,
 605             reason => "invalid",
 606             message => "no changer $kid");
 607     }
 608
 609     $params{'slot'} = $slot;
 610     return $child->set_meta_label(%params);
 611 }
 612
 613 sub get_meta_label {
 614     my $self = shift;
 615     my %params = @_;
 616     my $state;
 617
 618     return if $self->check_error($params{'finished_cb'});
 619
 620     my $finished_cb = $params{'finished_cb'};
 621     my $orig_slot = $params{'slot'};
 622
 623     if (!defined $params{'slot'}) {
 624         return $self->make_error("failed", $finished_cb,
 625             reason => "invalid",
 626             message => "no 'slot' params set.");
 627     }
 628
 629     my ($kid, $slot) = split(':', $orig_slot, 2);
 630     my $child = $self->{'children'}[$kid];
 631     if (!defined $child) {
 632         return $self->make_error("failed", $finished_cb,
 633             reason => "invalid",
 634             message => "no changer $kid");
 635     }
 636
 637     $params{'slot'} = $slot;
 638     return $child->get_meta_label(%params);
 639 }
 640
 641 # Takes keyword parameters 'oksub', 'errsub', 'parent_cb', and 'args'.  For
 642 # each child, runs $oksub (or, if the child is "ERROR", $errsub), passing it
 643 # the changer, an aggregating callback, and the corresponding element from
 644 # @$args (if specified).  The callback combines its results with the results
 645 # from other changers, and when all results are available, calls $parent_cb.
 646 #
 647 # This forms a kind of "AND" combinator for a parallel operation on multiple
 648 # changers, providing the caller with a simple collection of the results of
 649 # the operation. The parent_cb is called as
 650 #   $parent_cb->([ [ <chg_1_results> ], [ <chg_2_results> ], .. ]).
 651 sub _for_each_child {
 652     my $self = shift;
 653     my %params = @_;
 654     my ($oksub, $errsub, $parent_cb, $args) =
 655         ($params{'oksub'}, $params{'errsub'}, $params{'parent_cb'}, $params{'args'});
 656
 657     if (defined($args)) {
 658         die "number of args did not match number of children"
 659             unless (@$args == $self->{'num_children'});
 660     } else {
 661         $args = [ ( undef ) x $self->{'num_children'} ];
 662     }
 663
 664     my $remaining = $self->{'num_children'};
 665     my @results = ( undef ) x $self->{'num_children'};
 666     my $maybe_done = sub {
 667         return if (--$remaining);
 668         $parent_cb->([ @results ]);
 669     };
 670
 671     for my $i (0 .. $self->{'num_children'}-1) {
 672         my $child = $self->{'children'}[$i];
 673         my $arg = @$args? $args->[$i] : undef;
 674
 675         my $child_cb = sub {
 676             $results[$i] = [ @_ ];
 677             $maybe_done->();
 678         };
 679
 680         if ($child eq "ERROR") {
 681             if (defined $errsub) {
 682                 $errsub->("ERROR", $child_cb, $arg);
 683             } else {
 684                 # no errsub; just call $child_cb directly
 685                 $child_cb->(undef) if $child_cb;
 686             }
 687         } else {
 688             $oksub->($child, $child_cb, $arg) if $oksub;
 689         }
 690     }
 691 }
 692
 693 sub _merge_inventories {
 694     my $self = shift;
 695     my ($kid_results) = @_;
 696
 697     my @combined;
 698     my $nb = 0;
 699     for my $kid_result (@$kid_results) {
 700         my $kid_inv = $kid_result->[1];
 701
 702         for my $x (@$kid_inv) {
 703             my $slotname = "$nb:" . $x->{'slot'};
 704             my $current = $slotname eq $self->{'current_slot'};
 705             push @combined, {
 706                     state => $x->{'state'},
 707                     device_status => $x->{'device_status'},
 708                     f_type => $x->{'f_type'},
 709                     label => $x->{'label'},
 710                     barcode => $x->{'barcode'},
 711                     reserved => $x->{'reserved'},
 712                     slot => $slotname,
 713                     import_export => $x->{'import_export'},
 714                     loaded_in => $x->{'loaded_in'},
 715                     current => $current,
 716                 };
 717         }
 718         $nb++;
 719     }
 720
 721     return [ @combined ];
 722 }
 723
 724 package Amanda::Changer::aggregate::Reservation;
 725 use vars qw( @ISA );
 726 @ISA = qw( Amanda::Changer::Reservation );
 727
 728 sub new {
 729     my $class = shift;
 730     my ($chg, $kid_res, $slot) = @_;
 731     my $self = Amanda::Changer::Reservation::new($class);
 732
 733     $self->{'chg'} = $chg;
 734     $self->{'kid_res'} = $kid_res;
 735     $self->{'device'} = $kid_res->{'device'};
 736     $self->{'barcode'} = $kid_res->{'barcode'};
 737     $self->{'this_slot'} = $slot;
 738
 739     return $self;
 740 }
 741
 742 sub do_release {
 743     my $self = shift;
 744     my %params = @_;
 745
 746     # unref the device, for good measure
 747     $self->{'device'} = undef;
 748
 749     $self->{'kid_res'}->release(%params);
 750     $self->{'kid_res'} = undef;
 751 }
 752
 753 sub get_meta_label {
 754     my $self = shift;
 755     my %params = @_;
 756
 757     $self->{'kid_res'}->get_meta_label(%params);
 758 }
 759
 760 sub set_meta_label {
 761     my $self = shift;
 762     my %params = @_;
 763
 764     $self->{'kid_res'}->set_meta_label(%params);
 765 }