Imported Upstream version 3.2.0
[debian/amanda] / installcheck / Amanda_Changer_null.pl
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 94086, USA, or: http://www.zmanda.com
18
19 use Test::More tests => 4;
20 use File::Path;
21 use strict;
22 use warnings;
23
24 use lib "@amperldir@";
25 use Installcheck::Config;
26 use Installcheck::Changer;
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 my $testconf = Installcheck::Config->new();
42 $testconf->write();
43
44 my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
45 if ($cfg_result != $CFGERR_OK) {
46     my ($level, @errors) = Amanda::Config::config_errors();
47     die(join "\n", @errors);
48 }
49
50 my $chg = Amanda::Changer->new("chg-null:");
51 {
52     my ($get_info, $check_info, $do_load, $got_res);
53
54     $get_info = make_cb('get_info' => sub {
55         $chg->info(info_cb => $check_info, info => [ 'num_slots', 'fast_search' ]);
56     });
57
58     $check_info = make_cb('check_info' => sub {
59         my $err = shift;
60         my %results = @_;
61         die($err) if defined($err);
62
63         is_deeply({ %results },
64             { num_slots => 1, fast_search => 1 },
65             "info() returns the correct num_slots and fast_search");
66
67         $do_load->();
68     });
69
70     $do_load = make_cb('do_load' => sub {
71         $chg->load(relative_slot => "current",
72                    res_cb => $got_res);
73     });
74
75     $got_res = make_cb('got_res' => sub {
76         my ($err, $res) = @_;
77         ok(!$err, "no error loading relative slot 'current'")
78             or diag($err);
79         is($res->{'device'}->device_name, 'null:',
80             "returns correct device name");
81
82         $res->release(finished_cb => sub {
83             Amanda::MainLoop::quit();
84         });
85     });
86
87     # start the loop
88     $get_info->();
89     Amanda::MainLoop::run();
90 }
91
92 # eject is not implemented
93 {
94     my $try_eject = make_cb('try_eject' => sub {
95         $chg->eject(finished_cb => sub {
96             my ($err, $res) = @_;
97             chg_err_like($err,
98                 { type => 'failed', reason => 'notimpl' },
99                 "eject returns a failed/notimpl error");
100
101             Amanda::MainLoop::quit();
102         });
103     });
104
105     $try_eject->();
106     Amanda::MainLoop::run();
107 }