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 # to get a read only copy of the tapelist file:
75 my $tl = Amanda::Tapelist->new("/path/to/tapefile");
77 # to read/update/write the tapelist file
79 my $tl = Amanda::Tapelist->new("/path/to/tapefile", 1);
80 # modify the memory copy
81 $tl->add_tapelabel($datestamp, $label);
82 $tl->add_tapelabel($datestamp2, $label2, $comment, 1);
86 # If you already have a read only copy and want to modify it
87 # take a read only copy
88 my $tl = Amanda::Tapelist->new("/path/to/tapefile");
89 # reload and take lock
91 # modify the memory copy
92 tl->add_tapelabel($datestamp, $label);
93 $tl->add_tapelabel($datestamp2, $label2, $comment, 1);
97 =head1 OBJECT-ORIENTED INTERFACE
99 C<new> returns a hash with no C<tles> set if the tapelist does
100 not exist. C<tles> is an empty array if the tapelist is empty.
101 Invalid entries are silently ignored.
103 =head2 tapelist object
105 A tapelist object is a hash with the following keys:
111 The filename of the tapelist file.
113 =item C<filename_lock>
115 The filename of the lock file.
119 A Amanda::Util::file_lock is the file is locked.
123 A sequence of tapelist elements (referred to as TLEs in this document),
124 sorted by datestamp from newest to oldest.
128 =head2 tapelist element
130 A tapelist elementas a hash with the following keys:
136 the one-based position of the TLE in the tapelist
140 the datestamp on which this was written, or "0" for an unused tape
144 true if this tape can be reused when it is no longer active
152 the comment for this tape, or undef if no comment was given
158 The following methods are available on a tapelist object C<$tl>:
162 =item C<relod($lock)>
164 reload the tapelist file, lock it if $lock is set
166 =item C<lookup_tapelabel($lbl)>
168 look up and return a reference to the TLE with the given label
170 =item C<lookup_tapepos($pos)>
172 look up and return a reference to the TLE in the given position
174 =item C<lookup_tapedate($date)>
176 look up and return a reference to the TLE with the given datestamp
178 =item C<remove_tapelabel($lbl)>
180 remove the tape with the given label
182 =item C<add_tapelabel($date, $lbl, $comment, $reuse)>
184 add a tape with the given date, label, comment and reuse to the end of the
185 tapelist. reuse can be 1 or undef for a reusable volume, it must be 0 for
186 a no-reusable volume.
188 =item C<write()> or C<write($filename)>
190 write the tapelist out to the same file as when read or to C<$filename> if it
191 is set, remove the lock if a lock was taken
195 remove the lock if a lock was taken
197 =item C<clear_tapelist()>
199 remove all tle from the tles.
203 =head1 INTERACTION WITH C CODE
205 The C portions of Amanda treat the tapelist as a global variable,
206 while this package treats it as an object (and can thus handle more
207 than one tapelist simultaneously). Every call to C<reload>
208 fills this global variable with a copy of the tapelist, and likewise
209 C<clear_tapelist> clears the global. However, any changes made from
210 Perl are not reflected in the C copy, nor are changes made by C
211 modules reflected in the Perl copy.
217 use Amanda::Debug qw(:logging);
218 use Amanda::Config qw( config_dir_relative );
220 use Fcntl qw(:flock); # import LOCK_* constants
226 my ($filename, $lock ) = @_;
228 filename => $filename,
229 lockname => $filename . '.lock',
233 $self->reload($lock);
240 # clear the C version
243 $self->{'tles'} = [];
261 # let C read the file
262 C_read_tapelist($self->{'filename'});
264 $self->_read_tapelist();
267 sub lookup_tapelabel {
271 for my $tle (@{$self->{'tles'}}) {
272 return $tle if ($tle->{'label'} eq $label);
282 $self->_update_positions();
283 return $self->{'tles'}->[$position-1];
286 sub lookup_tapedate {
288 my ($datestamp) = @_;
290 for my $tle (@{$self->{'tles'}}) {
291 return $tle if ($tle->{'datestamp'} eq $datestamp);
297 sub remove_tapelabel {
301 for (my $i = 0; $i < @{$self->{tles}}; $i++) {
302 if ($self->{tles}->[$i]->{'label'} eq $label) {
303 splice @{$self->{tles}}, $i, 1;
304 $self->_update_positions();
312 my ($datestamp, $label, $comment, $reuse, $meta, $barcode) = @_;
314 $reuse = 1 if !defined $reuse;
316 # prepend this (presumably new) volume to the beginning of the list
317 unshift @{$self->{'tles'}}, {
318 'datestamp' => $datestamp,
321 'barcode' => $barcode,
322 'comment' => $comment,
324 $self->_update_positions();
331 $filename = $self->{'filename'} if !defined $filename;
333 my $new_tapelist_file = $filename . "-new-" . time();
335 open(my $fhn, ">", $new_tapelist_file) or die("Could not open '$new_tapelist_file' for writing: $!");
336 for my $tle (@{$self->{tles}}) {
337 my $datestamp = $tle->{'datestamp'};
338 my $label = $tle->{'label'};
339 my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
340 my $barcode = (defined $tle->{'barcode'})? (" BARCODE:" . $tle->{'barcode'}) : '';
341 my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
342 $result &&= print $fhn "$datestamp $label $reuse$barcode$comment\n";
344 my $result_close = close($fhn);
345 $result &&= $result_close;
347 return if (!$result);
349 unless (move($new_tapelist_file, $filename)) {
350 die ("failed to rename '$new_tapelist_file' to '$filename': $!");
353 # re-read from the C side to synchronize
354 C_read_tapelist($filename);
364 return if !exists $self->{'fl'};
366 $self->{'fl'}->unlock();
375 if (!-e $self->{'lockname'}) {
376 open(my $fhl, ">>", $self->{'lockname'});
379 my $fl = Amanda::Util::file_lock->new($self->{'lockname'});
380 while(($r = $fl->lock()) == 1) {
392 open(my $fh, "<", $self->{'filename'}) or return $self;
393 while (my $line = <$fh>) {
394 my ($datestamp, $label, $reuse, $barcode, $comment)
395 = $line =~ m/^([0-9]*)\s([^\s]*)\s(reuse|no-reuse)\s*(?:BARCODE:([^\s]*))?\s*(?:\#(.*))?$/mx;
396 next if !defined $datestamp; # silently filter out bogus lines
398 'datestamp' => $datestamp,
400 'reuse' => ($reuse eq 'reuse'),
401 'barcode' => $barcode,
402 'comment' => $comment,
407 # sort in descending order by datestamp, sorting on position, too, to ensure
408 # that entries with the same datestamp stay in the right order
409 $self->{'tles'} = \@tles;
410 $self->_update_positions();
412 $b->{'datestamp'} cmp $a->{'datestamp'}
413 || $a->{'position'} <=> $b->{'position'}
416 $self->{'tles'} = \@tles;
418 # and re-calculate the positions
419 $self->_update_positions(\@tles);
422 # update the 'position' key for each TLE
423 sub _update_positions {
425 my $tles = $self->{'tles'};
426 for (my $i = 0; $i < scalar @$tles; $i++) {
427 $tles->[$i]->{'position'} = $i+1;