2 * Copyright (c) Zmanda, Inc. All Rights Reserved.
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.
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.
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.
17 * Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
18 * Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
21 %module "Amanda::Tapelist"
22 %include "amglue/amglue.swg"
23 %include "exception.i"
30 use Amanda::Debug qw(:logging);
34 Amanda::Tapelist - manipulate the Amanda tapelist
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");
49 =head1 OBJECT-ORIENTED INTERFACE
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.
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
61 =item C<position> -- the one-based position of the TLE in the tapelist
63 =item C<datestamp> -- the datestamp on which this was written, or "0" for an
66 =item C<reuse> -- true if this tape can be reused when it is no longer active
68 =item C<label> -- tape label
70 =item C<comment> -- the comment for this tape, or undef if no comment was given
74 The following methods are available on a tapelist object C<$tl>:
78 =item C<lookup_tapelabel($lbl)> -- look up and return a reference to the TLE
81 =item C<lookup_tapepos($pos)> -- look up and return a reference to the TLE in
84 =item C<lookup_tapedate($date)> -- look up and return a reference to the TLE
85 with the given datestamp
87 =item C<remove_tapelabel($lbl)> -- remove the tape with the given label
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.
92 =item C<write($filename)> -- write the tapelist out to C<$filename>.
96 =head1 INTERACTION WITH C CODE
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.
112 # let C read the file
113 C_read_tapelist($filename);
115 # and then read it ourselves
116 open(my $fh, "<", $filename) or return undef;
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
123 'datestamp' => $datestamp,
125 'reuse' => ($reuse eq 'reuse'),
126 'comment' => $comment,
131 my $self = bless \@tles, "Amanda::Tapelist";
132 $self->update_positions();
138 # clear the C version
141 # and produce an empty object
142 my $self = bless [], "Amanda::Tapelist";
143 $self->update_positions();
150 sub lookup_tapelabel {
154 for my $tle (@$self) {
155 return $tle if ($tle->{'label'} eq $label);
165 $self->update_positions();
166 return $self->[$position-1];
169 sub lookup_tapedate {
171 my ($datestamp) = @_;
173 for my $tle (@$self) {
174 return $tle if ($tle->{'datestamp'} eq $datestamp);
180 sub remove_tapelabel {
184 for (my $i = 0; $i < @$self; $i++) {
185 if ($self->[$i]->{'label'} eq $label) {
186 splice @$self, $i, 1;
187 $self->update_positions();
195 my ($datestamp, $label, $comment) = @_;
198 'datestamp' => $datestamp,
201 'comment' => $comment,
203 $self->update_positions();
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";
220 # re-read from the C side to synchronize
221 C_read_tapelist($filename);
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.
231 # update the 'position' key for each TLE
232 sub update_positions {
234 for (my $i = 0; $i < @$self; $i++) {
235 $self->[$i]->{'position'} = $i+1;
241 /* C functions -- should be called *only* from within this module */
243 %rename(C_read_tapelist) read_tapelist;
244 int read_tapelist(char *tapefile);
246 %rename(C_clear_tapelist) clear_tapelist;
247 void clear_tapelist(void);