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

   1 # This file was automatically generated by SWIG (http://www.swig.org).
   2 # Version 1.3.39
   3 #
   4 # Do not make changes to this file unless you know what you are doing--modify
   5 # the SWIG interface file instead.
   6
   7 package Amanda::Tapelist;
   8 use base qw(Exporter);
   9 use base qw(DynaLoader);
  10 package Amanda::Tapelistc;
  11 bootstrap Amanda::Tapelist;
  12 package Amanda::Tapelist;
  13 @EXPORT = qw();
  14
  15 # ---------- BASE METHODS -------------
  16
  17 package Amanda::Tapelist;
  18
  19 sub TIEHASH {
  20     my ($classname,$obj) = @_;
  21     return bless $obj, $classname;
  22 }
  23
  24 sub CLEAR { }
  25
  26 sub FIRSTKEY { }
  27
  28 sub NEXTKEY { }
  29
  30 sub FETCH {
  31     my ($self,$field) = @_;
  32     my $member_func = "swig_${field}_get";
  33     $self->$member_func();
  34 }
  35
  36 sub STORE {
  37     my ($self,$field,$newval) = @_;
  38     my $member_func = "swig_${field}_set";
  39     $self->$member_func($newval);
  40 }
  41
  42 sub this {
  43     my $ptr = shift;
  44     return tied(%$ptr);
  45 }
  46
  47
  48 # ------- FUNCTION WRAPPERS --------
  49
  50 package Amanda::Tapelist;
  51
  52 *get_last_reusable_tape_label = *Amanda::Tapelistc::get_last_reusable_tape_label;
  53 *list_new_tapes = *Amanda::Tapelistc::list_new_tapes;
  54 *C_read_tapelist = *Amanda::Tapelistc::C_read_tapelist;
  55 *C_clear_tapelist = *Amanda::Tapelistc::C_clear_tapelist;
  56
  57 # ------- VARIABLE STUBS --------
  58
  59 package Amanda::Tapelist;
  60
  61
  62 @EXPORT_OK = ();
  63 %EXPORT_TAGS = ();
  64
  65
  66 =head1 NAME
  67
  68 Amanda::Tapelist - manipulate the Amanda tapelist
  69
  70 =head1 SYNOPSIS
  71
  72     use Amanda::Tapelist;
  73
  74     my $tl = Amanda::Tapelist::read_tapelist("/path/to/tapefile");
  75     $tl->add_tapelabel($datestamp, $label);
  76     $tl->add_tapelabel($datestamp2, $label2, $comment);
  77     $tl->write("/path/to/tapefile");
  78
  79 =head1 OBJECT-ORIENTED INTERFACE
  80
  81 The package-level functions C<read_tapelist($filename)> and
  82 C<clear_tapelist()> both return a new tapelist object.
  83 C<read_tapelist> returns C<undef> if the tapelist does not exist.
  84 Invalid entries are silently ignored.
  85
  86 A tapelist object is a sequence of tapelist elements (referred to as TLEs in
  87 this document), sorted by datestamp from newest to oldest.  Each TLE is a hash
  88 with the following keys:
  89
  90 =over
  91
  92 =item C<position>
  93
  94 the one-based position of the TLE in the tapelist
  95
  96 =item C<datestamp>
  97
  98 the datestamp on which this was written, or "0" for an unused tape
  99
 100 =item C<reuse>
 101
 102 true if this tape can be reused when it is no longer active
 103
 104 =item C<label>
 105
 106 tape label
 107
 108 =item C<comment>
 109
 110 the comment for this tape, or undef if no comment was given
 111
 112 =back
 113
 114 The following methods are available on a tapelist object C<$tl>:
 115
 116 =over
 117
 118 =item C<lookup_tapelabel($lbl)>
 119
 120 look up and return a reference to the TLE with the given label
 121
 122 =item C<lookup_tapepos($pos)>
 123
 124 look up and return a reference to the TLE in the given position
 125
 126 =item C<lookup_tapedate($date)>
 127
 128 look up and return a reference to the TLE with the given datestamp
 129
 130 =item C<remove_tapelabel($lbl)>
 131
 132 remove the tape with the given label
 133
 134 =item C<add_tapelabel($date, $lbl, $comment)>
 135
 136 add a tape with the given date, label, and comment to the end of the
 137 tapelist, marking it reusable.
 138
 139 =item C<write($filename)>
 140
 141 write the tapelist out to C<$filename>.
 142
 143 =back
 144
 145 =head1 INTERACTION WITH C CODE
 146
 147 The C portions of Amanda treat the tapelist as a global variable,
 148 while this package treats it as an object (and can thus handle more
 149 than one tapelist simultaneously).  Every call to C<read_tapelist>
 150 fills this global variable with a copy of the tapelist, and likewise
 151 C<clear_tapelist> clears the global.  However, any changes made from
 152 Perl are not reflected in the C copy, nor are changes made by C
 153 modules reflected in the Perl copy.
 154
 155 =cut
 156
 157
 158
 159 use Amanda::Debug qw(:logging);
 160
 161 ## package functions
 162
 163 sub read_tapelist {
 164     my ($filename) = @_;
 165
 166     # let C read the file
 167     C_read_tapelist($filename);
 168
 169     # and then read it ourselves
 170     open(my $fh, "<", $filename) or return undef;
 171     my @tles;
 172     while (my $line = <$fh>) {
 173         my ($datestamp, $label, $reuse, $comment)
 174             = $line =~ m/^([0-9]*)\s([^\s]*)\s(reuse|no-reuse)\s*(?:\#(.*))?$/mx;
 175         next if !defined $datestamp; # silently filter out bogus lines
 176         push @tles, {
 177             'datestamp' => $datestamp,
 178             'label' => $label,
 179             'reuse' => ($reuse eq 'reuse'),
 180             'comment' => $comment,
 181         };
 182     }
 183     close($fh);
 184
 185     # sort in descending order by datestamp, sorting on position, too, to ensure
 186     # that entries with the same datestamp stay in the right order
 187     update_positions(\@tles); # call a method with an explicit $self
 188     @tles = sort {
 189            $b->{'datestamp'} cmp $a->{'datestamp'}
 190         || $a->{'position'} <=> $b->{'position'}
 191         } @tles;
 192
 193     # and re-calculate the positions
 194     update_positions(\@tles);
 195
 196     my $self = bless \@tles, "Amanda::Tapelist";
 197
 198     return $self;
 199 }
 200
 201 sub clear_tapelist {
 202     # clear the C version
 203     C_clear_tapelist();
 204
 205     # and produce an empty object
 206     my $self = bless [], "Amanda::Tapelist";
 207     $self->update_positions();
 208
 209     return $self;
 210 }
 211
 212 ## methods
 213
 214 sub lookup_tapelabel {
 215     my $self = shift;
 216     my ($label) = @_;
 217
 218     for my $tle (@$self) {
 219         return $tle if ($tle->{'label'} eq $label);
 220     }
 221
 222     return undef;
 223 }
 224
 225 sub lookup_tapepos {
 226     my $self = shift;
 227     my ($position) = @_;
 228
 229     $self->update_positions();
 230     return $self->[$position-1];
 231 }
 232
 233 sub lookup_tapedate {
 234     my $self = shift;
 235     my ($datestamp) = @_;
 236
 237     for my $tle (@$self) {
 238         return $tle if ($tle->{'datestamp'} eq $datestamp);
 239     }
 240
 241     return undef;
 242 }
 243
 244 sub remove_tapelabel {
 245     my $self = shift;
 246     my ($label) = @_;
 247
 248     for (my $i = 0; $i < @$self; $i++) {
 249         if ($self->[$i]->{'label'} eq $label) {
 250             splice @$self, $i, 1;
 251             $self->update_positions();
 252             return;
 253         }
 254     }
 255 }
 256
 257 sub add_tapelabel {
 258     my $self = shift;
 259     my ($datestamp, $label, $comment) = @_;
 260
 261     # prepend this (presumably new) volume to the beginning of the list
 262     unshift @$self, {
 263         'datestamp' => $datestamp,
 264         'label' => $label,
 265         'reuse' => 1,
 266         'comment' => $comment,
 267     };
 268     $self->update_positions();
 269 }
 270
 271 sub write {
 272     my $self = shift;
 273     my ($filename) = @_;
 274
 275     open(my $fh, ">", $filename) or die("Could not open '$filename' for writing: $!");
 276     for my $tle (@$self) {
 277         my $datestamp = $tle->{'datestamp'};
 278         my $label = $tle->{'label'};
 279         my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
 280         my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
 281         print $fh "$datestamp $label $reuse$comment\n";
 282     }
 283     close($fh);
 284
 285     # re-read from the C side to synchronize
 286     C_read_tapelist($filename);
 287 }
 288
 289 ## private methods
 290
 291 # update the 'position' key for each TLE
 292 sub update_positions {
 293     my $self = shift;
 294     for (my $i = 0; $i < @$self; $i++) {
 295         $self->[$i]->{'position'} = $i+1;
 296     }
 297 }
 298
 299 1;