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

   1 /*
   2  * Copyright (c) Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This library is free software; you can redistribute it and/or modify it
   5  * under the terms of the GNU Lesser General Public License version 2.1
   6  * as published by the Free Software Foundation.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
  11  * License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public License
  14  * along with this library; if not, write to the Free Software Foundation,
  15  * Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA.
  16  *
  17  * Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
  18  * Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19  */
  20
  21 %module "Amanda::Tapelist"
  22 %include "amglue/amglue.swg"
  23 %include "exception.i"
  24
  25 %{
  26 #include "tapefile.h"
  27 %}
  28
  29 %perlcode %{
  30 use Amanda::Debug qw(:logging);
  31
  32 =head1 NAME
  33
  34 Amanda::Tapelist - manipulate the Amanda tapelist
  35
  36 =head1 SYNOPSIS
  37
  38     use Amanda::Tapelist;
  39
  40     my $tl = Amanda::Tapelist::read_tapelist("/path/to/tapefile");
  41     $tl->add_tapelabel($datestamp, $label);
  42     $tl->add_tapelabel($datestamp2, $label2, $comment);
  43     $tl->write("/path/to/tapefile");
  44
  45 =head1 API STATUS
  46
  47 Stable
  48
  49 =head1 OBJECT-ORIENTED INTERFACE
  50
  51 The package-level functions C<read_tapelist($filename)> and C<clear_tapelist()>
  52 both return a new tapelist object.  C<read_tapelist> returns C<undef> if the
  53 tapelist does not exist.  Invalid entries are silently ignored.
  54
  55 A tapelist object is a sequence of tapelist
  56 elements (referred to as TLEs in this document).  Each TLE is a hash with the
  57 following keys:
  58
  59 =over
  60
  61 =item C<position> -- the one-based position of the TLE in the tapelist
  62
  63 =item C<datestamp> -- the datestamp on which this was written, or "0" for an
  64 unused tape
  65
  66 =item C<reuse> -- true if this tape can be reused when it is no longer active
  67
  68 =item C<label> -- tape label
  69
  70 =item C<comment> -- the comment for this tape, or undef if no comment was given
  71
  72 =back
  73
  74 The following methods are available on a tapelist object C<$tl>:
  75
  76 =over
  77
  78 =item C<lookup_tapelabel($lbl)> -- look up and return a reference to the TLE
  79 with the given label
  80
  81 =item C<lookup_tapepos($pos)> -- look up and return a reference to the TLE in
  82 the given position
  83
  84 =item C<lookup_tapedate($date)> -- look up and return a reference to the TLE
  85 with the given datestamp
  86
  87 =item C<remove_tapelabel($lbl)> -- remove the tape with the given label
  88
  89 =item C<add_tapelabel($date, $lbl, $comment)> -- add a tape with the given date,
  90 label, and comment to the end of the tapelist, marking it reusable.
  91
  92 =item C<write($filename)> -- write the tapelist out to C<$filename>.
  93
  94 =back
  95
  96 =head1 INTERACTION WITH C CODE
  97
  98 The C portions of Amanda treat the tapelist as a global variable, while this
  99 package treats it as an object (and can thus handle more than one tapelist
 100 simultaneously).  Every call to C<read_tapelist> fills this global variable
 101 with a copy of the tapelist, and likewise C<clear_tapelist> clears the global.
 102 However, any changes made from Perl are not reflected in the C copy, nor are
 103 changes made by C modules reflected in the Perl copy.
 104
 105 =cut
 106
 107 ## package functions
 108
 109 sub read_tapelist {
 110     my ($filename) = @_;
 111
 112     # let C read the file
 113     C_read_tapelist($filename);
 114
 115     # and then read it ourselves
 116     open(my $fh, "<", $filename) or return undef;
 117     my @tles;
 118     while (my $line = <$fh>) {
 119         my ($datestamp, $label, $reuse, $comment)
 120             = $line =~ m/^([0-9]*)\s([^\s]*)\s(reuse|no-reuse)\s*(?:\#(.*))?$/mx;
 121         next if !defined $datestamp; # silently filter out bogus lines
 122         push @tles, {
 123             'datestamp' => $datestamp,
 124             'label' => $label,
 125             'reuse' => ($reuse eq 'reuse'),
 126             'comment' => $comment,
 127         };
 128     }
 129     close($fh);
 130
 131     my $self = bless \@tles, "Amanda::Tapelist";
 132     $self->update_positions();
 133
 134     return $self;
 135 }
 136
 137 sub clear_tapelist {
 138     # clear the C version
 139     C_clear_tapelist();
 140
 141     # and produce an empty object
 142     my $self = bless [], "Amanda::Tapelist";
 143     $self->update_positions();
 144
 145     return $self;
 146 }
 147
 148 ## methods
 149
 150 sub lookup_tapelabel {
 151     my $self = shift;
 152     my ($label) = @_;
 153
 154     for my $tle (@$self) {
 155         return $tle if ($tle->{'label'} eq $label);
 156     }
 157
 158     return undef;
 159 }
 160
 161 sub lookup_tapepos {
 162     my $self = shift;
 163     my ($position) = @_;
 164
 165     $self->update_positions();
 166     return $self->[$position-1];
 167 }
 168
 169 sub lookup_tapedate {
 170     my $self = shift;
 171     my ($datestamp) = @_;
 172
 173     for my $tle (@$self) {
 174         return $tle if ($tle->{'datestamp'} eq $datestamp);
 175     }
 176
 177     return undef;
 178 }
 179
 180 sub remove_tapelabel {
 181     my $self = shift;
 182     my ($label) = @_;
 183
 184     for (my $i = 0; $i < @$self; $i++) {
 185         if ($self->[$i]->{'label'} eq $label) {
 186             splice @$self, $i, 1;
 187             $self->update_positions();
 188             return;
 189         }
 190     }
 191 }
 192
 193 sub add_tapelabel {
 194     my $self = shift;
 195     my ($datestamp, $label, $comment) = @_;
 196
 197     push @$self, {
 198         'datestamp' => $datestamp,
 199         'label' => $label,
 200         'reuse' => 1,
 201         'comment' => $comment,
 202     };
 203     $self->update_positions();
 204 }
 205
 206 sub write {
 207     my $self = shift;
 208     my ($filename) = @_;
 209
 210     open(my $fh, ">", $filename) or die("Could not open '$filename' for writing: $!");
 211     for my $tle (@$self) {
 212         my $datestamp = $tle->{'datestamp'};
 213         my $label = $tle->{'label'};
 214         my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
 215         my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
 216         print $fh "$datestamp $label $reuse$comment\n";
 217     }
 218     close($fh);
 219
 220     # re-read from the C side to synchronize
 221     C_read_tapelist($filename);
 222 }
 223
 224 ## TODO -- implement this when it's needed
 225 # =item C<lookup_last_reusable_tape($skip)> -- find the (C<$skip>+1)-th least recent
 226 # reusable tape.  For example, C<last_reusable_tape(1)> would return the
 227 # second-oldest reusable tape.
 228
 229 ## private methods
 230
 231 # update the 'position' key for each TLE
 232 sub update_positions {
 233     my $self = shift;
 234     for (my $i = 0; $i < @$self; $i++) {
 235         $self->[$i]->{'position'} = $i+1;
 236     }
 237 }
 238
 239 %}
 240
 241 /* C functions -- should be called *only* from within this module */
 242
 243 %rename(C_read_tapelist) read_tapelist;
 244 int read_tapelist(char *tapefile);
 245
 246 %rename(C_clear_tapelist) clear_tapelist;
 247 void clear_tapelist(void);