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

   1 /*
   2  * Copyright (c) 2008,2009 Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This program is free software; you can redistribute it and/or modify it
   5  * under the terms of the GNU General Public License version 2 as published
   6  * by the Free Software Foundation.
   7  *
   8  * This program is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11  * for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License along
  14  * with this program; if not, write to the Free Software Foundation, Inc.,
  15  * 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16  *
  17  * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  18  * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
  19  */
  20
  21 %module "Amanda::Tapelist"
  22 %include "amglue/amglue.swg"
  23 %include "exception.i"
  24
  25 %include "Amanda/Tapelist.pod"
  26
  27 %{
  28 #include "tapefile.h"
  29 %}
  30
  31 %perlcode %{
  32 use Amanda::Debug qw(:logging);
  33
  34 ## package functions
  35
  36 sub read_tapelist {
  37     my ($filename) = @_;
  38
  39     # let C read the file
  40     C_read_tapelist($filename);
  41
  42     # and then read it ourselves
  43     open(my $fh, "<", $filename) or return undef;
  44     my @tles;
  45     while (my $line = <$fh>) {
  46         my ($datestamp, $label, $reuse, $comment)
  47             = $line =~ m/^([0-9]*)\s([^\s]*)\s(reuse|no-reuse)\s*(?:\#(.*))?$/mx;
  48         next if !defined $datestamp; # silently filter out bogus lines
  49         push @tles, {
  50             'datestamp' => $datestamp,
  51             'label' => $label,
  52             'reuse' => ($reuse eq 'reuse'),
  53             'comment' => $comment,
  54         };
  55     }
  56     close($fh);
  57
  58     # sort in descending order by datestamp, sorting on position, too, to ensure
  59     # that entries with the same datestamp stay in the right order
  60     update_positions(\@tles); # call a method with an explicit $self
  61     @tles = sort {
  62            $b->{'datestamp'} cmp $a->{'datestamp'}
  63         || $a->{'position'} <=> $b->{'position'}
  64         } @tles;
  65
  66     # and re-calculate the positions
  67     update_positions(\@tles);
  68
  69     my $self = bless \@tles, "Amanda::Tapelist";
  70
  71     return $self;
  72 }
  73
  74 sub clear_tapelist {
  75     # clear the C version
  76     C_clear_tapelist();
  77
  78     # and produce an empty object
  79     my $self = bless [], "Amanda::Tapelist";
  80     $self->update_positions();
  81
  82     return $self;
  83 }
  84
  85 ## methods
  86
  87 sub lookup_tapelabel {
  88     my $self = shift;
  89     my ($label) = @_;
  90
  91     for my $tle (@$self) {
  92         return $tle if ($tle->{'label'} eq $label);
  93     }
  94
  95     return undef;
  96 }
  97
  98 sub lookup_tapepos {
  99     my $self = shift;
 100     my ($position) = @_;
 101
 102     $self->update_positions();
 103     return $self->[$position-1];
 104 }
 105
 106 sub lookup_tapedate {
 107     my $self = shift;
 108     my ($datestamp) = @_;
 109
 110     for my $tle (@$self) {
 111         return $tle if ($tle->{'datestamp'} eq $datestamp);
 112     }
 113
 114     return undef;
 115 }
 116
 117 sub remove_tapelabel {
 118     my $self = shift;
 119     my ($label) = @_;
 120
 121     for (my $i = 0; $i < @$self; $i++) {
 122         if ($self->[$i]->{'label'} eq $label) {
 123             splice @$self, $i, 1;
 124             $self->update_positions();
 125             return;
 126         }
 127     }
 128 }
 129
 130 sub add_tapelabel {
 131     my $self = shift;
 132     my ($datestamp, $label, $comment) = @_;
 133
 134     # prepend this (presumably new) volume to the beginning of the list
 135     unshift @$self, {
 136         'datestamp' => $datestamp,
 137         'label' => $label,
 138         'reuse' => 1,
 139         'comment' => $comment,
 140     };
 141     $self->update_positions();
 142 }
 143
 144 sub write {
 145     my $self = shift;
 146     my ($filename) = @_;
 147
 148     open(my $fh, ">", $filename) or die("Could not open '$filename' for writing: $!");
 149     for my $tle (@$self) {
 150         my $datestamp = $tle->{'datestamp'};
 151         my $label = $tle->{'label'};
 152         my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
 153         my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
 154         print $fh "$datestamp $label $reuse$comment\n";
 155     }
 156     close($fh);
 157
 158     # re-read from the C side to synchronize
 159     C_read_tapelist($filename);
 160 }
 161
 162 ## private methods
 163
 164 # update the 'position' key for each TLE
 165 sub update_positions {
 166     my $self = shift;
 167     for (my $i = 0; $i < @$self; $i++) {
 168         $self->[$i]->{'position'} = $i+1;
 169     }
 170 }
 171
 172 %}
 173
 174 char *get_last_reusable_tape_label(int skip);
 175 char *list_new_tapes(int nb);
 176
 177 /* C functions -- should be called *only* from within this module */
 178
 179 %rename(C_read_tapelist) read_tapelist;
 180 int read_tapelist(char *tapefile);
 181
 182 %rename(C_clear_tapelist) clear_tapelist;
 183 void clear_tapelist(void);