]> git.gag.com Git - debian/amanda/blob - perl/Amanda/Tapelist.pm
Imported Upstream version 2.6.1
[debian/amanda] / perl / Amanda / Tapelist.pm
1 # This file was automatically generated by SWIG (http://www.swig.org).
2 # Version 1.3.35
3 #
4 # Don't modify this file, modify the SWIG interface instead.
5
6 package Amanda::Tapelist;
7 require Exporter;
8 require DynaLoader;
9 @ISA = qw(Exporter 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 *C_read_tapelist = *Amanda::Tapelistc::C_read_tapelist;
53 *C_clear_tapelist = *Amanda::Tapelistc::C_clear_tapelist;
54
55 # ------- VARIABLE STUBS --------
56
57 package Amanda::Tapelist;
58
59
60 @EXPORT_OK = ();
61 %EXPORT_TAGS = ();
62
63 use Amanda::Debug qw(:logging);
64
65 =head1 NAME
66
67 Amanda::Tapelist - manipulate the Amanda tapelist
68
69 =head1 SYNOPSIS
70
71     use Amanda::Tapelist;
72
73     my $tl = Amanda::Tapelist::read_tapelist("/path/to/tapefile");
74     $tl->add_tapelabel($datestamp, $label);
75     $tl->add_tapelabel($datestamp2, $label2, $comment);
76     $tl->write("/path/to/tapefile");
77
78 =head1 API STATUS
79
80 Stable
81
82 =head1 OBJECT-ORIENTED INTERFACE
83
84 The package-level functions C<read_tapelist($filename)> and C<clear_tapelist()>
85 both return a new tapelist object.  C<read_tapelist> returns C<undef> if the
86 tapelist does not exist.  Invalid entries are silently ignored.
87
88 A tapelist object is a sequence of tapelist
89 elements (referred to as TLEs in this document).  Each TLE is a hash with the
90 following keys:
91
92 =over
93
94 =item C<position> -- the one-based position of the TLE in the tapelist
95
96 =item C<datestamp> -- the datestamp on which this was written, or "0" for an
97 unused tape
98
99 =item C<reuse> -- true if this tape can be reused when it is no longer active
100
101 =item C<label> -- tape label
102
103 =item C<comment> -- the comment for this tape, or undef if no comment was given
104
105 =back
106
107 The following methods are available on a tapelist object C<$tl>:
108
109 =over
110
111 =item C<lookup_tapelabel($lbl)> -- look up and return a reference to the TLE
112 with the given label
113
114 =item C<lookup_tapepos($pos)> -- look up and return a reference to the TLE in
115 the given position
116
117 =item C<lookup_tapedate($date)> -- look up and return a reference to the TLE
118 with the given datestamp
119
120 =item C<remove_tapelabel($lbl)> -- remove the tape with the given label
121
122 =item C<add_tapelabel($date, $lbl, $comment)> -- add a tape with the given date,
123 label, and comment to the end of the tapelist, marking it reusable.
124
125 =item C<write($filename)> -- write the tapelist out to C<$filename>.
126
127 =back
128
129 =head1 INTERACTION WITH C CODE
130
131 The C portions of Amanda treat the tapelist as a global variable, while this
132 package treats it as an object (and can thus handle more than one tapelist
133 simultaneously).  Every call to C<read_tapelist> fills this global variable
134 with a copy of the tapelist, and likewise C<clear_tapelist> clears the global.
135 However, any changes made from Perl are not reflected in the C copy, nor are
136 changes made by C modules reflected in the Perl copy.
137
138 =cut
139
140 ## package functions
141
142 sub read_tapelist {
143     my ($filename) = @_;
144
145     # let C read the file
146     C_read_tapelist($filename);
147
148     # and then read it ourselves
149     open(my $fh, "<", $filename) or return undef;
150     my @tles;
151     while (my $line = <$fh>) {
152         my ($datestamp, $label, $reuse, $comment)
153             = $line =~ m/^([0-9]*)\s([^\s]*)\s(reuse|no-reuse)\s*(?:\#(.*))?$/mx;
154         next if !defined $datestamp; # silently filter out bogus lines
155         push @tles, {
156             'datestamp' => $datestamp,
157             'label' => $label,
158             'reuse' => ($reuse eq 'reuse'),
159             'comment' => $comment,
160         };
161     }
162     close($fh);
163
164     my $self = bless \@tles, "Amanda::Tapelist";
165     $self->update_positions();
166
167     return $self;
168 }
169
170 sub clear_tapelist {
171     # clear the C version
172     C_clear_tapelist();
173
174     # and produce an empty object
175     my $self = bless [], "Amanda::Tapelist";
176     $self->update_positions();
177
178     return $self;
179 }
180
181 ## methods
182
183 sub lookup_tapelabel {
184     my $self = shift;
185     my ($label) = @_;
186
187     for my $tle (@$self) {
188         return $tle if ($tle->{'label'} eq $label);
189     }
190
191     return undef;
192 }
193
194 sub lookup_tapepos {
195     my $self = shift;
196     my ($position) = @_;
197
198     $self->update_positions();
199     return $self->[$position-1];
200 }
201
202 sub lookup_tapedate {
203     my $self = shift;
204     my ($datestamp) = @_;
205
206     for my $tle (@$self) {
207         return $tle if ($tle->{'datestamp'} eq $datestamp);
208     }
209
210     return undef;
211 }
212
213 sub remove_tapelabel {
214     my $self = shift;
215     my ($label) = @_;
216
217     for (my $i = 0; $i < @$self; $i++) {
218         if ($self->[$i]->{'label'} eq $label) {
219             splice @$self, $i, 1;
220             $self->update_positions();
221             return;
222         }
223     }
224 }
225
226 sub add_tapelabel {
227     my $self = shift;
228     my ($datestamp, $label, $comment) = @_;
229
230     push @$self, { 
231         'datestamp' => $datestamp,
232         'label' => $label,
233         'reuse' => 1,
234         'comment' => $comment,
235     };
236     $self->update_positions();
237 }
238
239 sub write {
240     my $self = shift;
241     my ($filename) = @_;
242
243     open(my $fh, ">", $filename) or die("Could not open '$filename' for writing: $!");
244     for my $tle (@$self) {
245         my $datestamp = $tle->{'datestamp'};
246         my $label = $tle->{'label'};
247         my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
248         my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
249         print $fh "$datestamp $label $reuse$comment\n";
250     }
251     close($fh);
252
253     # re-read from the C side to synchronize
254     C_read_tapelist($filename);
255 }
256
257 ## TODO -- implement this when it's needed
258 # =item C<lookup_last_reusable_tape($skip)> -- find the (C<$skip>+1)-th least recent
259 # reusable tape.  For example, C<last_reusable_tape(1)> would return the
260 # second-oldest reusable tape.
261
262 ## private methods
263
264 # update the 'position' key for each TLE
265 sub update_positions {
266     my $self = shift;
267     for (my $i = 0; $i < @$self; $i++) {
268         $self->[$i]->{'position'} = $i+1;
269     }
270 }
271
272 1;