git.gag.com Git - debian/amanda/blob - installcheck/Amanda_Tapelist.pl

   1 # Copyright (c) 2008 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 => 20;
  20 use strict;
  21
  22 use lib "@amperldir@";
  23 use Installcheck::Config;
  24 use Amanda::Tapelist;
  25 use Amanda::Config qw( :init :getconf config_dir_relative );
  26
  27 my $tl;
  28 my $tl_ok;
  29 my $line;
  30 my @lines;
  31
  32 # First try reading a tapelist
  33
  34 my $testconf = Installcheck::Config->new();
  35 $testconf->write();
  36
  37 config_init($CONFIG_INIT_EXPLICIT_NAME, "TESTCONF") == $CFGERR_OK
  38     or die("config_init failed");
  39 my $tapelist = config_dir_relative("tapelist");
  40
  41 sub mktapelist {
  42     my ($filename, @lines) = @_;
  43     open(my $fh, ">", $filename) or die("Could not make tapelist '$filename'");
  44     for my $line (@lines) {
  45         print $fh $line;
  46     }
  47     close($fh);
  48 }
  49
  50 sub readtapelist {
  51     my ($filename) = @_;
  52     open(my $fh, "<", $filename) or die("Could not read tapelist '$filename'");
  53     my @reread_lines = <$fh>;
  54     close($fh);
  55     return @reread_lines;
  56 }
  57
  58 @lines = (
  59     "20071111010002 TESTCONF004 reuse\n",
  60     "20071110010002 TESTCONF003 reuse\n",
  61     "20071109010002 TESTCONF002 reuse #comment 2\n",
  62     "20071108010001 TESTCONF001 no-reuse #comment 1\n",
  63 );
  64 mktapelist($tapelist, @lines);
  65
  66 $tl = Amanda::Tapelist::read_tapelist($tapelist);
  67 $tl_ok = is_deeply($tl, [
  68   { 'datestamp' => '20071111010002', 'label' => 'TESTCONF004',
  69     'reuse' => 1, 'position' => 1, 'comment' => undef },
  70   { 'datestamp' => '20071110010002', 'label' => 'TESTCONF003',
  71     'reuse' => 1, 'position' => 2, 'comment' => undef },
  72   { 'datestamp' => '20071109010002', 'label' => 'TESTCONF002',
  73     'reuse' => 1, 'position' => 3, 'comment' => 'comment 2' },
  74   { 'datestamp' => '20071108010001', 'label' => 'TESTCONF001',
  75     'reuse' => '', 'position' => 4, 'comment' => 'comment 1' },
  76 ], "A simple tapelist is parsed correctly");
  77
  78 SKIP: {
  79     skip "Tapelist is parsed incorrectly, so these tests are unlikely to work", 15,
  80         unless $tl_ok;
  81
  82     # now try writing it out and check that the results are the same
  83     $tl->write("$tapelist-new");
  84     my @reread_lines = readtapelist("$tapelist-new");
  85     is_deeply(\@reread_lines, \@lines, "Lines of freshly written tapelist match the original");
  86
  87     is_deeply($tl->lookup_tapelabel('TESTCONF002'),
  88         { 'datestamp' => '20071109010002', 'label' => 'TESTCONF002',
  89           'reuse' => 1, 'position' => 3, 'comment' => 'comment 2' },
  90         "lookup_tapelabel works");
  91
  92     is_deeply($tl->lookup_tapelabel('TESTCONF009'), undef,
  93         "lookup_tapelabel returns undef on an unknown label");
  94
  95     is_deeply($tl->lookup_tapepos(4),
  96         { 'datestamp' => '20071108010001', 'label' => 'TESTCONF001',
  97           'reuse' => '', 'position' => 4, 'comment' => 'comment 1' },
  98         "lookup_tapepos works");
  99
 100     is_deeply($tl->lookup_tapepos(9), undef,
 101         "lookup_tapepos returns undef on an unknown position");
 102
 103     is_deeply($tl->lookup_tapedate('20071110010002'),
 104         { 'datestamp' => '20071110010002', 'label' => 'TESTCONF003',
 105           'reuse' => 1, 'position' => 2, 'comment' => undef },
 106         "lookup_tapedate works");
 107
 108     is_deeply($tl->lookup_tapedate('12345678'), undef,
 109         "lookup_tapedate returns undef on an unknown datestamp");
 110
 111     # try some edits
 112     $tl->add_tapelabel("20080112010203", "TESTCONF007", "seven");
 113     is(scalar @$tl, 5, "add_tapelabel adds a new element to the tapelist");
 114
 115     is_deeply($tl->lookup_tapepos(1),
 116         { 'datestamp' => '20080112010203', 'label' => 'TESTCONF007',
 117           'reuse' => 1, 'position' => 1, 'comment' => 'seven' },
 118         ".. lookup_tapepos finds it at the beginning");
 119
 120     is_deeply($tl->lookup_tapelabel("TESTCONF007"),
 121         { 'datestamp' => '20080112010203', 'label' => 'TESTCONF007',
 122           'reuse' => 1, 'position' => 1, 'comment' => 'seven' },
 123         ".. lookup_tapelabel finds it");
 124
 125     is_deeply($tl->lookup_tapedate("20080112010203"),
 126         { 'datestamp' => '20080112010203', 'label' => 'TESTCONF007',
 127           'reuse' => 1, 'position' => 1, 'comment' => 'seven' },
 128         ".. lookup_tapedate finds it");
 129
 130     $tl->remove_tapelabel("TESTCONF002");
 131     is(scalar @$tl, 4, "remove_tapelabel removes an element from the tapelist");
 132
 133     is_deeply($tl->lookup_tapepos(4), # used to be in position 5
 134         { 'datestamp' => '20071108010001', 'label' => 'TESTCONF001',
 135           'reuse' => '', 'position' => 4, 'comment' => 'comment 1' },
 136         ".. tape positions are adjusted correctly");
 137
 138     is_deeply($tl->lookup_tapelabel("TESTCONF002"), undef,
 139         ".. lookup_tapelabel no longer finds it");
 140
 141     is_deeply($tl->lookup_tapedate("20071109010002"), undef,
 142         ".. lookup_tapedate no longer finds it");
 143
 144     ## set tapecycle to 0 to perform the next couple tests
 145     config_uninit();
 146     my $cor = new_config_overrides(1);
 147     add_config_override_opt($cor, "tapecycle=1");
 148     set_config_overrides($cor);
 149     config_init($CONFIG_INIT_EXPLICIT_NAME, "TESTCONF") == $CFGERR_OK
 150         or die("config_init failed");
 151
 152     is( Amanda::Tapelist::get_last_reusable_tape_label(0),
 153         'TESTCONF002', ".. get_last_reusable_tape_labe for skip=0" );
 154
 155     is( Amanda::Tapelist::get_last_reusable_tape_label(2),
 156         'TESTCONF004', ".. get_last_reusable_tape_labe for skip=2" );
 157 }
 158
 159 # try parsing various invalid lines
 160 @lines = (
 161     "2006123456 FOO reuse\n", # valid
 162     "TESTCONF003 290385098 reuse\n", # invalid
 163     "20071109010002 TESTCONF002 re-use\n", # invalid
 164     "20071108010001 TESTCONF001\n", # invalid
 165     "20071108010001 TESTCONF001 #comment\n", # invalid
 166     "#comment\n", # invalid
 167 );
 168 mktapelist($tapelist, @lines);
 169
 170 $tl = Amanda::Tapelist::read_tapelist($tapelist);
 171 is_deeply($tl,  [
 172   { 'datestamp' => '2006123456', 'label' => 'FOO',
 173     'reuse' => 1, 'position' => 1, 'comment' => undef },
 174 ], "Invalid lines are ignored");
 175
 176 # make sure clear_tapelist is empty
 177 $tl = Amanda::Tapelist::clear_tapelist();
 178 is_deeply($tl,  [ ], "clear_tapelist returns an empty tapelist");