X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=perl%2FAmanda%2FTapelist.pm;h=6a746ba623e6df860027e927dcf3f6f0f716cda0;hb=b116e9366c7b2ea2c2eb53b0a13df4090e176235;hp=40991d0f43dc647e427b5520269aa93382aa184e;hpb=96f35b20267e8b1a1c846d476f27fcd330e0b018;p=debian%2Famanda

diff --git a/perl/Amanda/Tapelist.pm b/perl/Amanda/Tapelist.pm
index 40991d0..6a746ba 100644
--- a/perl/Amanda/Tapelist.pm
+++ b/perl/Amanda/Tapelist.pm
@@ -49,6 +49,8 @@ sub this {
 
 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;
 
@@ -60,7 +62,6 @@ package Amanda::Tapelist;
 @EXPORT_OK = ();
 %EXPORT_TAGS = ();
 
-use Amanda::Debug qw(:logging);
 
 =head1 NAME
 
@@ -70,121 +71,204 @@ Amanda::Tapelist - manipulate the Amanda tapelist
 
     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);
     }
 
@@ -195,15 +279,15 @@ sub lookup_tapepos {
     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);
     }
 
@@ -214,10 +298,10 @@ sub remove_tapelabel {
     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;
 	}
     }
@@ -225,47 +309,118 @@ sub remove_tapelabel {
 
 sub add_tapelabel {
     my $self = shift;
-    my ($datestamp, $label, $comment) = @_;
+    my ($datestamp, $label, $comment, $reuse) = @_;
+    $reuse = 1 if !defined $reuse;
 
-    push @$self, { 
+    # prepend this (presumably new) volume to the beginning of the list
+    unshift @{$self->{'tles'}}, {
 	'datestamp' => $datestamp,
 	'label' => $label,
-	'reuse' => 1,
+	'reuse' => $reuse,
 	'comment' => $comment,
     };
-    $self->update_positions();
+    $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 $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
-	print $fh "$datestamp $label $reuse$comment\n";
+	$result &&= print $fhn "$datestamp $label $reuse$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, $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);
+
+    # 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;
     }
 }