git.gag.com Git - debian/amanda/blob - perl/Amanda/Tapelist.swg

   1 /*
   2  * Copyright (c) 2008-2012 Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  12  * for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  17  *
  18  * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  19  * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
  20  */
  21
  22 %module "Amanda::Tapelist"
  23 %include "amglue/amglue.swg"
  24 %include "exception.i"
  25
  26 %include "Amanda/Tapelist.pod"
  27
  28 %{
  29 #include "tapefile.h"
  30 %}
  31
  32 %perlcode %{
  33 use Amanda::Debug qw(:logging);
  34 use Amanda::Config qw( config_dir_relative );
  35 use File::Copy;
  36 use Fcntl qw(:flock); # import LOCK_* constants
  37
  38 ## package functions
  39
  40 sub new {
  41     my ($class)  = shift;
  42     my ($filename, $lock ) = @_;
  43     my $self = {
  44         filename => $filename,
  45         lockname => $filename . '.lock',
  46     };
  47     bless $self, $class;
  48
  49     $self->reload($lock);
  50     return $self;
  51 }
  52
  53 sub clear_tapelist {
  54     my $self = shift;
  55
  56     # clear the C version
  57     C_clear_tapelist();
  58
  59     $self->{'tles'} = [];
  60
  61     return $self;
  62 }
  63
  64 ## methods
  65
  66 sub reload {
  67     my $self = shift;
  68     my ($lock) = @_;
  69
  70     if ($lock) {
  71         $self->_take_lock();
  72     }
  73
  74     # clear the C copy
  75     C_clear_tapelist();
  76
  77     # let C read the file
  78     C_read_tapelist($self->{'filename'});
  79
  80     $self->_read_tapelist();
  81 }
  82
  83 sub lookup_tapelabel {
  84     my $self = shift;
  85     my ($label) = @_;
  86
  87     for my $tle (@{$self->{'tles'}}) {
  88         return $tle if ($tle->{'label'} eq $label);
  89     }
  90
  91     return undef;
  92 }
  93
  94 sub lookup_tapepos {
  95     my $self = shift;
  96     my ($position) = @_;
  97
  98     $self->_update_positions();
  99     return $self->{'tles'}->[$position-1];
 100 }
 101
 102 sub lookup_tapedate {
 103     my $self = shift;
 104     my ($datestamp) = @_;
 105
 106     for my $tle (@{$self->{'tles'}}) {
 107         return $tle if ($tle->{'datestamp'} eq $datestamp);
 108     }
 109
 110     return undef;
 111 }
 112
 113 sub remove_tapelabel {
 114     my $self = shift;
 115     my ($label) = @_;
 116
 117     for (my $i = 0; $i < @{$self->{tles}}; $i++) {
 118         if ($self->{tles}->[$i]->{'label'} eq $label) {
 119             splice @{$self->{tles}}, $i, 1;
 120             $self->_update_positions();
 121             return;
 122         }
 123     }
 124 }
 125
 126 sub add_tapelabel {
 127     my $self = shift;
 128     my ($datestamp, $label, $comment, $reuse, $meta, $barcode, $blocksize) = @_;
 129     $reuse = 1 if !defined $reuse;
 130
 131     # prepend this (presumably new) volume to the beginning of the list
 132     my $tle = {
 133         'datestamp' => $datestamp,
 134         'label'     => $label,
 135         'reuse'     => $reuse,
 136         'barcode'   => $barcode,
 137         'meta'      => $meta,
 138         'blocksize' => $blocksize,
 139         'comment'   => $comment,
 140     };
 141     my $tles = $self->{'tles'};
 142     if (!defined $tles->[0] ||
 143         $tles->[0]->{'datestamp'} le $datestamp) {
 144         unshift @{$tles}, $tle;
 145     } elsif (defined $tles->[0] &&
 146         $tles->[@$tles-1]->{'datestamp'} gt $datestamp) {
 147         push @{$tles}, $tle;
 148     } else {
 149         my $added = 0;
 150         for my $i (0..(@$tles-1)) {
 151             if ($tles->[$i]->{'datestamp'} le $datestamp) {
 152                 splice @{$tles}, $i, 0, $tle;
 153                 $added = 1;
 154                 last;
 155             }
 156         }
 157         push @{$tles}, $tle if !$added;
 158     }
 159     $self->_update_positions();
 160 }
 161
 162 sub write {
 163     my $self = shift;
 164     my ($filename) = @_;
 165     my $result = TRUE;
 166     $filename = $self->{'filename'} if !defined $filename;
 167
 168     my $new_tapelist_file = $filename . "-new-" . time();
 169
 170     open(my $fhn, ">", $new_tapelist_file) or die("Could not open '$new_tapelist_file' for writing: $!");
 171     for my $tle (@{$self->{tles}}) {
 172         my $datestamp = $tle->{'datestamp'};
 173         my $label = $tle->{'label'};
 174         my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
 175         my $barcode = (defined $tle->{'barcode'})? (" BARCODE:" . $tle->{'barcode'}) : '';
 176         my $meta = (defined $tle->{'meta'})? (" META:" . $tle->{'meta'}) : '';
 177         my $blocksize = (defined $tle->{'blocksize'})? (" BLOCKSIZE:" . $tle->{'blocksize'}) : '';
 178         my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
 179         $result &&= print $fhn "$datestamp $label $reuse$barcode$meta$blocksize$comment\n";
 180     }
 181     my $result_close = close($fhn);
 182     $result &&= $result_close;
 183
 184     return if (!$result);
 185
 186     unless (move($new_tapelist_file, $filename)) {
 187         die ("failed to rename '$new_tapelist_file' to '$filename': $!");
 188     }
 189
 190     # re-read from the C side to synchronize
 191     C_read_tapelist($filename);
 192
 193     $self->unlock();
 194
 195     return undef;
 196 }
 197
 198 sub unlock {
 199     my $self = shift;
 200
 201     return if !exists $self->{'fl'};
 202
 203     $self->{'fl'}->unlock();
 204     delete $self->{'fl'}
 205 }
 206
 207 ## private methods
 208
 209 sub _take_lock {
 210     my $self = shift;
 211
 212     if (!-e $self->{'lockname'}) {
 213         open(my $fhl, ">>", $self->{'lockname'});
 214         close($fhl);
 215     }
 216     my $fl = Amanda::Util::file_lock->new($self->{'lockname'});
 217     while(($r = $fl->lock()) == 1) {
 218         sleep(1);
 219     }
 220     if ($r == 0) {
 221         $self->{'fl'} = $fl;
 222     }
 223 }
 224
 225 sub _read_tapelist {
 226     my $self = shift;
 227
 228     my @tles;
 229     open(my $fh, "<", $self->{'filename'}) or return $self;
 230     while (my $line = <$fh>) {
 231         my ($datestamp, $label, $reuse, $barcode, $meta, $blocksize, $comment)
 232             = $line =~ m/^([0-9]+)\s*([^\s]*)\s*(?:(reuse|no-reuse))?\s*(?:BARCODE:([^\s]*))?\s*(?:META:([^\s]*))?\s*(?:BLOCKSIZE:([^\s]*))?\s*(?:\#(.*))?$/mx;
 233         if (!defined $datestamp) {
 234             Amanda::Debug::critical("Bogus line in the tapelist ($self->{'filename'}) file: $line");
 235         }
 236         push @tles, {
 237             'datestamp' => $datestamp,
 238             'label' => $label,
 239             'reuse' => (!defined $reuse || $reuse eq 'reuse'),
 240             'barcode' => $barcode,
 241             'meta' => $meta,
 242             'blocksize' => $blocksize,
 243             'comment' => $comment,
 244         };
 245     }
 246     close($fh);
 247
 248     # sort in descending order by datestamp, sorting on position, too, to ensure
 249     # that entries with the same datestamp stay in the right order
 250     $self->{'tles'} = \@tles;
 251     $self->_update_positions();
 252     @tles = sort {
 253            $b->{'datestamp'} cmp $a->{'datestamp'}
 254         || $a->{'position'} <=> $b->{'position'}
 255         } @tles;
 256
 257     $self->{'tles'} = \@tles;
 258
 259     # and re-calculate the positions
 260     $self->_update_positions(\@tles);
 261 }
 262
 263 # update the 'position' key for each TLE
 264 sub _update_positions {
 265     my $self = shift;
 266     my $tles = $self->{'tles'};
 267     for (my $i = 0; $i < scalar @$tles; $i++) {
 268         $tles->[$i]->{'position'} = $i+1;
 269     }
 270 }
 271
 272 %}
 273
 274 char *get_last_reusable_tape_label(int skip);
 275 %newobject list_new_tapes;
 276 char *list_new_tapes(int nb);
 277
 278 /* C functions -- should be called *only* from within this module */
 279
 280 %rename(C_read_tapelist) read_tapelist;
 281 int read_tapelist(char *tapefile);
 282
 283 %rename(C_clear_tapelist) clear_tapelist;
 284 void clear_tapelist(void);