1 # This file was automatically generated by SWIG (http://www.swig.org).
4 # Don't modify this file, modify the SWIG interface instead.
6 package Amanda::Tapelist;
9 @ISA = qw(Exporter 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 *C_read_tapelist = *Amanda::Tapelistc::C_read_tapelist;
53 *C_clear_tapelist = *Amanda::Tapelistc::C_clear_tapelist;
55 # ------- VARIABLE STUBS --------
57 package Amanda::Tapelist;
63 use Amanda::Debug qw(:logging);
67 Amanda::Tapelist - manipulate the Amanda tapelist
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");
82 =head1 OBJECT-ORIENTED INTERFACE
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.
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
94 =item C<position> -- the one-based position of the TLE in the tapelist
96 =item C<datestamp> -- the datestamp on which this was written, or "0" for an
99 =item C<reuse> -- true if this tape can be reused when it is no longer active
101 =item C<label> -- tape label
103 =item C<comment> -- the comment for this tape, or undef if no comment was given
107 The following methods are available on a tapelist object C<$tl>:
111 =item C<lookup_tapelabel($lbl)> -- look up and return a reference to the TLE
114 =item C<lookup_tapepos($pos)> -- look up and return a reference to the TLE in
117 =item C<lookup_tapedate($date)> -- look up and return a reference to the TLE
118 with the given datestamp
120 =item C<remove_tapelabel($lbl)> -- remove the tape with the given label
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.
125 =item C<write($filename)> -- write the tapelist out to C<$filename>.
129 =head1 INTERACTION WITH C CODE
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.
145 # let C read the file
146 C_read_tapelist($filename);
148 # and then read it ourselves
149 open(my $fh, "<", $filename) or return undef;
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
156 'datestamp' => $datestamp,
158 'reuse' => ($reuse eq 'reuse'),
159 'comment' => $comment,
164 my $self = bless \@tles, "Amanda::Tapelist";
165 $self->update_positions();
171 # clear the C version
174 # and produce an empty object
175 my $self = bless [], "Amanda::Tapelist";
176 $self->update_positions();
183 sub lookup_tapelabel {
187 for my $tle (@$self) {
188 return $tle if ($tle->{'label'} eq $label);
198 $self->update_positions();
199 return $self->[$position-1];
202 sub lookup_tapedate {
204 my ($datestamp) = @_;
206 for my $tle (@$self) {
207 return $tle if ($tle->{'datestamp'} eq $datestamp);
213 sub remove_tapelabel {
217 for (my $i = 0; $i < @$self; $i++) {
218 if ($self->[$i]->{'label'} eq $label) {
219 splice @$self, $i, 1;
220 $self->update_positions();
228 my ($datestamp, $label, $comment) = @_;
231 'datestamp' => $datestamp,
234 'comment' => $comment,
236 $self->update_positions();
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";
253 # re-read from the C side to synchronize
254 C_read_tapelist($filename);
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.
264 # update the 'position' key for each TLE
265 sub update_positions {
267 for (my $i = 0; $i < @$self; $i++) {
268 $self->[$i]->{'position'} = $i+1;