# This file was automatically generated by SWIG (http://www.swig.org).
-# Version 1.3.35
+# Version 1.3.39
#
-# Don't modify this file, modify the SWIG interface instead.
+# Do not make changes to this file unless you know what you are doing--modify
+# the SWIG interface file instead.
package Amanda::Tapelist;
-require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
+use base qw(Exporter);
+use base qw(DynaLoader);
package Amanda::Tapelistc;
bootstrap Amanda::Tapelist;
package Amanda::Tapelist;
-@EXPORT = qw( );
+@EXPORT = qw();
# ---------- BASE METHODS -------------
package Amanda::Tapelist;
+*get_last_reusable_tape_label = *Amanda::Tapelistc::get_last_reusable_tape_label;
+*list_new_tapes = *Amanda::Tapelistc::list_new_tapes;
*C_read_tapelist = *Amanda::Tapelistc::C_read_tapelist;
*C_clear_tapelist = *Amanda::Tapelistc::C_clear_tapelist;
@EXPORT_OK = ();
%EXPORT_TAGS = ();
-use Amanda::Debug qw(:logging);
=head1 NAME
use Amanda::Tapelist;
- my $tl = Amanda::Tapelist::read_tapelist("/path/to/tapefile");
+ # to get a read only copy of the tapelist file:
+ my $tl = Amanda::Tapelist->new("/path/to/tapefile");
+
+ # to read/update/write the tapelist file
+ # read and take lock
+ my $tl = Amanda::Tapelist->new("/path/to/tapefile", 1);
+ # modify the memory copy
$tl->add_tapelabel($datestamp, $label);
- $tl->add_tapelabel($datestamp2, $label2, $comment);
- $tl->write("/path/to/tapefile");
+ $tl->add_tapelabel($datestamp2, $label2, $comment, 1);
+ # write it and unlock
+ $tl->write();
+
+ # If you already have a read only copy and want to modify it
+ # take a read only copy
+ my $tl = Amanda::Tapelist->new("/path/to/tapefile");
+ # reload and take lock
+ $tl->reload(1);
+ # modify the memory copy
+ tl->add_tapelabel($datestamp, $label);
+ $tl->add_tapelabel($datestamp2, $label2, $comment, 1);
+ # write it and unlock
+ $tl->write();
-=head1 API STATUS
+=head1 OBJECT-ORIENTED INTERFACE
-Stable
+C<new> returns a hash with no C<tles> set if the tapelist does
+not exist. C<tles> is an empty array if the tapelist is empty.
+Invalid entries are silently ignored.
-=head1 OBJECT-ORIENTED INTERFACE
+=head2 tapelist object
+
+A tapelist object is a hash with the following keys:
+
+=over
-The package-level functions C<read_tapelist($filename)> and C<clear_tapelist()>
-both return a new tapelist object. C<read_tapelist> returns C<undef> if the
-tapelist does not exist. Invalid entries are silently ignored.
+=item C<filename>
-A tapelist object is a sequence of tapelist
-elements (referred to as TLEs in this document). Each TLE is a hash with the
-following keys:
+ The filename of the tapelist file.
+
+=item C<filename_lock>
+
+ The filename of the lock file.
+
+=item C<fl>
+
+ A Amanda::Util::file_lock is the file is locked.
+
+=item C<tles>
+
+A sequence of tapelist elements (referred to as TLEs in this document),
+sorted by datestamp from newest to oldest.
+
+=back
+
+=head2 tapelist element
+
+A tapelist elementas a hash with the following keys:
=over
-=item C<position> -- the one-based position of the TLE in the tapelist
+=item C<position>
+
+the one-based position of the TLE in the tapelist
+
+=item C<datestamp>
+
+the datestamp on which this was written, or "0" for an unused tape
+
+=item C<reuse>
-=item C<datestamp> -- the datestamp on which this was written, or "0" for an
-unused tape
+true if this tape can be reused when it is no longer active
-=item C<reuse> -- true if this tape can be reused when it is no longer active
+=item C<label>
-=item C<label> -- tape label
+tape label
-=item C<comment> -- the comment for this tape, or undef if no comment was given
+=item C<comment>
+
+the comment for this tape, or undef if no comment was given
=back
+=head1 Method
+
The following methods are available on a tapelist object C<$tl>:
=over
-=item C<lookup_tapelabel($lbl)> -- look up and return a reference to the TLE
-with the given label
+=item C<relod($lock)>
+
+reload the tapelist file, lock it if $lock is set
+
+=item C<lookup_tapelabel($lbl)>
+
+look up and return a reference to the TLE with the given label
+
+=item C<lookup_tapepos($pos)>
-=item C<lookup_tapepos($pos)> -- look up and return a reference to the TLE in
-the given position
+look up and return a reference to the TLE in the given position
-=item C<lookup_tapedate($date)> -- look up and return a reference to the TLE
-with the given datestamp
+=item C<lookup_tapedate($date)>
-=item C<remove_tapelabel($lbl)> -- remove the tape with the given label
+look up and return a reference to the TLE with the given datestamp
-=item C<add_tapelabel($date, $lbl, $comment)> -- add a tape with the given date,
-label, and comment to the end of the tapelist, marking it reusable.
+=item C<remove_tapelabel($lbl)>
-=item C<write($filename)> -- write the tapelist out to C<$filename>.
+remove the tape with the given label
+
+=item C<add_tapelabel($date, $lbl, $comment, $reuse)>
+
+add a tape with the given date, label, comment and reuse to the end of the
+tapelist. reuse can be 1 or undef for a reusable volume, it must be 0 for
+a no-reusable volume.
+
+=item C<write()> or C<write($filename)>
+
+write the tapelist out to the same file as when read or to C<$filename> if it
+is set, remove the lock if a lock was taken
+
+=item C<unlock()>
+
+remove the lock if a lock was taken
+
+=item C<clear_tapelist()>
+
+remove all tle from the tles.
=back
=head1 INTERACTION WITH C CODE
-The C portions of Amanda treat the tapelist as a global variable, while this
-package treats it as an object (and can thus handle more than one tapelist
-simultaneously). Every call to C<read_tapelist> fills this global variable
-with a copy of the tapelist, and likewise C<clear_tapelist> clears the global.
-However, any changes made from Perl are not reflected in the C copy, nor are
-changes made by C modules reflected in the Perl copy.
+The C portions of Amanda treat the tapelist as a global variable,
+while this package treats it as an object (and can thus handle more
+than one tapelist simultaneously). Every call to C<reload>
+fills this global variable with a copy of the tapelist, and likewise
+C<clear_tapelist> clears the global. However, any changes made from
+Perl are not reflected in the C copy, nor are changes made by C
+modules reflected in the Perl copy.
=cut
-## package functions
-sub read_tapelist {
- my ($filename) = @_;
- # let C read the file
- C_read_tapelist($filename);
+use Amanda::Debug qw(:logging);
+use Amanda::Config qw( config_dir_relative );
+use File::Copy;
+use Fcntl qw(:flock); # import LOCK_* constants
- # and then read it ourselves
- open(my $fh, "<", $filename) or return undef;
- my @tles;
- while (my $line = <$fh>) {
- my ($datestamp, $label, $reuse, $comment)
- = $line =~ m/^([0-9]*)\s([^\s]*)\s(reuse|no-reuse)\s*(?:\#(.*))?$/mx;
- next if !defined $datestamp; # silently filter out bogus lines
- push @tles, {
- 'datestamp' => $datestamp,
- 'label' => $label,
- 'reuse' => ($reuse eq 'reuse'),
- 'comment' => $comment,
- };
- }
- close($fh);
+## package functions
- my $self = bless \@tles, "Amanda::Tapelist";
- $self->update_positions();
+sub new {
+ my ($class) = shift;
+ my ($filename, $lock ) = @_;
+ my $self = {
+ filename => $filename,
+ lockname => $filename . '.lock',
+ };
+ bless $self, $class;
+ $self->reload($lock);
return $self;
}
sub clear_tapelist {
+ my $self = shift;
+
# clear the C version
C_clear_tapelist();
- # and produce an empty object
- my $self = bless [], "Amanda::Tapelist";
- $self->update_positions();
+ $self->{'tles'} = [];
return $self;
}
## methods
+sub reload {
+ my $self = shift;
+ my ($lock) = @_;
+
+ if ($lock) {
+ $self->_take_lock();
+ }
+
+ # clear the C copy
+ C_clear_tapelist();
+
+ # let C read the file
+ C_read_tapelist($self->{'filename'});
+
+ $self->_read_tapelist();
+}
+
sub lookup_tapelabel {
my $self = shift;
my ($label) = @_;
- for my $tle (@$self) {
+ for my $tle (@{$self->{'tles'}}) {
return $tle if ($tle->{'label'} eq $label);
}
my $self = shift;
my ($position) = @_;
- $self->update_positions();
- return $self->[$position-1];
+ $self->_update_positions();
+ return $self->{'tles'}->[$position-1];
}
sub lookup_tapedate {
my $self = shift;
my ($datestamp) = @_;
- for my $tle (@$self) {
+ for my $tle (@{$self->{'tles'}}) {
return $tle if ($tle->{'datestamp'} eq $datestamp);
}
my $self = shift;
my ($label) = @_;
- for (my $i = 0; $i < @$self; $i++) {
- if ($self->[$i]->{'label'} eq $label) {
- splice @$self, $i, 1;
- $self->update_positions();
+ for (my $i = 0; $i < @{$self->{tles}}; $i++) {
+ if ($self->{tles}->[$i]->{'label'} eq $label) {
+ splice @{$self->{tles}}, $i, 1;
+ $self->_update_positions();
return;
}
}
sub add_tapelabel {
my $self = shift;
- my ($datestamp, $label, $comment) = @_;
-
- push @$self, {
- 'datestamp' => $datestamp,
- 'label' => $label,
- 'reuse' => 1,
- 'comment' => $comment,
+ my ($datestamp, $label, $comment, $reuse, $meta, $barcode) = @_;
+ $reuse = 1 if !defined $reuse;
+
+ # prepend this (presumably new) volume to the beginning of the list
+ my $tle = {
+ 'datestamp' => $datestamp,
+ 'label' => $label,
+ 'reuse' => $reuse,
+ 'barcode' => $barcode,
+ 'meta' => $meta,
+ 'comment' => $comment,
};
- $self->update_positions();
+ my $tles = $self->{'tles'};
+ if (!defined $tles->[0] ||
+ $tles->[0]->{'datestamp'} le $datestamp) {
+ unshift @{$tles}, $tle;
+ } elsif (defined $tles->[0] &&
+ $tles->[@$tles-1]->{'datestamp'} gt $datestamp) {
+ push @{$tles}, $tle;
+ } else {
+ my $added = 0;
+ for my $i (0..(@$tles-1)) {
+ if ($tles->[$i]->{'datestamp'} le $datestamp) {
+ splice @{$tles}, $i, 0, $tle;
+ $added = 1;
+ last;
+ }
+ }
+ push @{$tles}, $tle if !$added;
+ }
+ $self->_update_positions();
}
sub write {
my $self = shift;
my ($filename) = @_;
+ my $result = TRUE;
+ $filename = $self->{'filename'} if !defined $filename;
- open(my $fh, ">", $filename) or die("Could not open '$filename' for writing: $!");
- for my $tle (@$self) {
+ my $new_tapelist_file = $filename . "-new-" . time();
+
+ open(my $fhn, ">", $new_tapelist_file) or die("Could not open '$new_tapelist_file' for writing: $!");
+ for my $tle (@{$self->{tles}}) {
my $datestamp = $tle->{'datestamp'};
my $label = $tle->{'label'};
my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
+ my $barcode = (defined $tle->{'barcode'})? (" BARCODE:" . $tle->{'barcode'}) : '';
+ my $meta = (defined $tle->{'meta'})? (" META:" . $tle->{'meta'}) : '';
my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
- print $fh "$datestamp $label $reuse$comment\n";
+ $result &&= print $fhn "$datestamp $label $reuse$barcode$meta$comment\n";
+ }
+ my $result_close = close($fhn);
+ $result &&= $result_close;
+
+ return if (!$result);
+
+ unless (move($new_tapelist_file, $filename)) {
+ die ("failed to rename '$new_tapelist_file' to '$filename': $!");
}
- close($fh);
# re-read from the C side to synchronize
C_read_tapelist($filename);
+
+ $self->unlock();
+
+ return undef;
}
-## TODO -- implement this when it's needed
-# =item C<lookup_last_reusable_tape($skip)> -- find the (C<$skip>+1)-th least recent
-# reusable tape. For example, C<last_reusable_tape(1)> would return the
-# second-oldest reusable tape.
+sub unlock {
+ my $self = shift;
+
+ return if !exists $self->{'fl'};
+
+ $self->{'fl'}->unlock();
+ delete $self->{'fl'}
+}
## private methods
+sub _take_lock {
+ my $self = shift;
+
+ if (!-e $self->{'lockname'}) {
+ open(my $fhl, ">>", $self->{'lockname'});
+ close($fhl);
+ }
+ my $fl = Amanda::Util::file_lock->new($self->{'lockname'});
+ while(($r = $fl->lock()) == 1) {
+ sleep(1);
+ }
+ if ($r == 0) {
+ $self->{'fl'} = $fl;
+ }
+}
+
+sub _read_tapelist {
+ my $self = shift;
+
+ my @tles;
+ open(my $fh, "<", $self->{'filename'}) or return $self;
+ while (my $line = <$fh>) {
+ my ($datestamp, $label, $reuse, $barcode, $meta, $comment)
+ = $line =~ m/^([0-9]*)\s([^\s]*)\s(reuse|no-reuse)\s*(?:BARCODE:([^\s]*))?\s*(?:META:([^\s]*))?\s*(?:\#(.*))?$/mx;
+ next if !defined $datestamp; # silently filter out bogus lines
+ push @tles, {
+ 'datestamp' => $datestamp,
+ 'label' => $label,
+ 'reuse' => ($reuse eq 'reuse'),
+ 'barcode' => $barcode,
+ 'meta' => $meta,
+ 'comment' => $comment,
+ };
+ }
+ close($fh);
+
+ # sort in descending order by datestamp, sorting on position, too, to ensure
+ # that entries with the same datestamp stay in the right order
+ $self->{'tles'} = \@tles;
+ $self->_update_positions();
+ @tles = sort {
+ $b->{'datestamp'} cmp $a->{'datestamp'}
+ || $a->{'position'} <=> $b->{'position'}
+ } @tles;
+
+ $self->{'tles'} = \@tles;
+
+ # and re-calculate the positions
+ $self->_update_positions(\@tles);
+}
+
# update the 'position' key for each TLE
-sub update_positions {
+sub _update_positions {
my $self = shift;
- for (my $i = 0; $i < @$self; $i++) {
- $self->[$i]->{'position'} = $i+1;
+ my $tles = $self->{'tles'};
+ for (my $i = 0; $i < scalar @$tles; $i++) {
+ $tles->[$i]->{'position'} = $i+1;
}
}