1 # This file was automatically generated by SWIG (http://www.swig.org).
4 # Do not make changes to this file unless you know what you are doing--modify
5 # the SWIG interface file instead.
7 package Amanda::Tapelist;
9 use base qw(DynaLoader);
10 package Amanda::Tapelistc;
11 bootstrap Amanda::Tapelist;
12 package Amanda::Tapelist;
15 # ---------- BASE METHODS -------------
17 package Amanda::Tapelist;
20 my ($classname,$obj) = @_;
21 return bless $obj, $classname;
31 my ($self,$field) = @_;
32 my $member_func = "swig_${field}_get";
33 $self->$member_func();
37 my ($self,$field,$newval) = @_;
38 my $member_func = "swig_${field}_set";
39 $self->$member_func($newval);
48 # ------- FUNCTION WRAPPERS --------
50 package Amanda::Tapelist;
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;
57 # ------- VARIABLE STUBS --------
59 package Amanda::Tapelist;
68 Amanda::Tapelist - manipulate the Amanda tapelist
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");
79 =head1 OBJECT-ORIENTED INTERFACE
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.
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:
94 the one-based position of the TLE in the tapelist
98 the datestamp on which this was written, or "0" for an unused tape
102 true if this tape can be reused when it is no longer active
110 the comment for this tape, or undef if no comment was given
114 The following methods are available on a tapelist object C<$tl>:
118 =item C<lookup_tapelabel($lbl)>
120 look up and return a reference to the TLE with the given label
122 =item C<lookup_tapepos($pos)>
124 look up and return a reference to the TLE in the given position
126 =item C<lookup_tapedate($date)>
128 look up and return a reference to the TLE with the given datestamp
130 =item C<remove_tapelabel($lbl)>
132 remove the tape with the given label
134 =item C<add_tapelabel($date, $lbl, $comment)>
136 add a tape with the given date, label, and comment to the end of the
137 tapelist, marking it reusable.
139 =item C<write($filename)>
141 write the tapelist out to C<$filename>.
145 =head1 INTERACTION WITH C CODE
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.
159 use Amanda::Debug qw(:logging);
166 # let C read the file
167 C_read_tapelist($filename);
169 # and then read it ourselves
170 open(my $fh, "<", $filename) or return undef;
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
177 'datestamp' => $datestamp,
179 'reuse' => ($reuse eq 'reuse'),
180 'comment' => $comment,
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
189 $b->{'datestamp'} cmp $a->{'datestamp'}
190 || $a->{'position'} <=> $b->{'position'}
193 # and re-calculate the positions
194 update_positions(\@tles);
196 my $self = bless \@tles, "Amanda::Tapelist";
202 # clear the C version
205 # and produce an empty object
206 my $self = bless [], "Amanda::Tapelist";
207 $self->update_positions();
214 sub lookup_tapelabel {
218 for my $tle (@$self) {
219 return $tle if ($tle->{'label'} eq $label);
229 $self->update_positions();
230 return $self->[$position-1];
233 sub lookup_tapedate {
235 my ($datestamp) = @_;
237 for my $tle (@$self) {
238 return $tle if ($tle->{'datestamp'} eq $datestamp);
244 sub remove_tapelabel {
248 for (my $i = 0; $i < @$self; $i++) {
249 if ($self->[$i]->{'label'} eq $label) {
250 splice @$self, $i, 1;
251 $self->update_positions();
259 my ($datestamp, $label, $comment) = @_;
261 # prepend this (presumably new) volume to the beginning of the list
263 'datestamp' => $datestamp,
266 'comment' => $comment,
268 $self->update_positions();
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";
285 # re-read from the C side to synchronize
286 C_read_tapelist($filename);
291 # update the 'position' key for each TLE
292 sub update_positions {
294 for (my $i = 0; $i < @$self; $i++) {
295 $self->[$i]->{'position'} = $i+1;