Imported Upstream version 3.2.0
[debian/amanda] / perl / Amanda / Tapelist.swg
index 5999ea80ab0da7fc2eaa6305cc2a696514d8ca92..510fd29bdd1910480d13233e0fd8104a39176863 100644 (file)
@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 2008,2009 Zmanda, Inc.  All Rights Reserved.
+ * Copyright (c) 2008, 2009, 2010 Zmanda, Inc.  All Rights Reserved.
  *
  * This program is free software; you can redistribute it and/or modify it
  * under the terms of the GNU General Public License version 2 as published
 
 %perlcode %{
 use Amanda::Debug qw(:logging);
+use Amanda::Config qw( config_dir_relative );
+use File::Copy;
+use Fcntl qw(:flock); # import LOCK_* constants
 
 ## package functions
 
-sub read_tapelist {
-    my ($filename) = @_;
-
-    # let C read the file
-    C_read_tapelist($filename);
-
-    # 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);
-
-    # sort in descending order by datestamp, sorting on position, too, to ensure
-    # that entries with the same datestamp stay in the right order
-    update_positions(\@tles); # call a method with an explicit $self
-    @tles = sort {
-          $b->{'datestamp'} cmp $a->{'datestamp'}
-       || $a->{'position'} <=> $b->{'position'}
-       } @tles;
-
-    # and re-calculate the positions
-    update_positions(\@tles);
-
-    my $self = bless \@tles, "Amanda::Tapelist";
+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);
     }
 
@@ -99,15 +94,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);
     }
 
@@ -118,10 +113,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;
        }
     }
@@ -129,43 +124,118 @@ sub remove_tapelabel {
 
 sub add_tapelabel {
     my $self = shift;
-    my ($datestamp, $label, $comment) = @_;
+    my ($datestamp, $label, $comment, $reuse) = @_;
+    $reuse = 1 if !defined $reuse;
 
     # prepend this (presumably new) volume to the beginning of the list
-    unshift @$self, {
+    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;
+
+    my $new_tapelist_file = $filename . "-new-" . time();
 
-    open(my $fh, ">", $filename) or die("Could not open '$filename' for writing: $!");
-    for my $tle (@$self) {
+    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;
+}
+
+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;
     }
 }