]> git.gag.com Git - debian/amanda/blob - perl/Amanda/Tapelist.pm
Imported Upstream version 3.3.3
[debian/amanda] / perl / Amanda / Tapelist.pm
1 # This file was automatically generated by SWIG (http://www.swig.org).
2 # Version 2.0.4
3 #
4 # Do not make changes to this file unless you know what you are doing--modify
5 # the SWIG interface file instead.
6
7 package Amanda::Tapelist;
8 use base qw(Exporter);
9 use base qw(DynaLoader);
10 package Amanda::Tapelistc;
11 bootstrap Amanda::Tapelist;
12 package Amanda::Tapelist;
13 @EXPORT = qw();
14
15 # ---------- BASE METHODS -------------
16
17 package Amanda::Tapelist;
18
19 sub TIEHASH {
20     my ($classname,$obj) = @_;
21     return bless $obj, $classname;
22 }
23
24 sub CLEAR { }
25
26 sub FIRSTKEY { }
27
28 sub NEXTKEY { }
29
30 sub FETCH {
31     my ($self,$field) = @_;
32     my $member_func = "swig_${field}_get";
33     $self->$member_func();
34 }
35
36 sub STORE {
37     my ($self,$field,$newval) = @_;
38     my $member_func = "swig_${field}_set";
39     $self->$member_func($newval);
40 }
41
42 sub this {
43     my $ptr = shift;
44     return tied(%$ptr);
45 }
46
47
48 # ------- FUNCTION WRAPPERS --------
49
50 package Amanda::Tapelist;
51
52 *get_last_reusable_tape_label = *Amanda::Tapelistc::get_last_reusable_tape_label;
53 *list_new_tapes = *Amanda::Tapelistc::list_new_tapes;
54 *C_read_tapelist = *Amanda::Tapelistc::C_read_tapelist;
55 *C_clear_tapelist = *Amanda::Tapelistc::C_clear_tapelist;
56
57 # ------- VARIABLE STUBS --------
58
59 package Amanda::Tapelist;
60
61
62 @EXPORT_OK = ();
63 %EXPORT_TAGS = ();
64
65
66 =head1 NAME
67
68 Amanda::Tapelist - manipulate the Amanda tapelist
69
70 =head1 SYNOPSIS
71
72     use Amanda::Tapelist;
73
74     # to get a read only copy of the tapelist file:
75     my $tl = Amanda::Tapelist->new("/path/to/tapefile");
76
77     # to read/update/write the tapelist file
78     # read and take lock
79     my $tl = Amanda::Tapelist->new("/path/to/tapefile", 1);
80     # modify the memory copy
81     $tl->add_tapelabel($datestamp, $label);
82     $tl->add_tapelabel($datestamp2, $label2, $comment, 1);
83     # write it and unlock
84     $tl->write();
85
86     # If you already have a read only copy and want to modify it
87     # take a read only copy
88     my $tl = Amanda::Tapelist->new("/path/to/tapefile");
89     # reload and take lock
90     $tl->reload(1);
91     # modify the memory copy
92     tl->add_tapelabel($datestamp, $label);
93     $tl->add_tapelabel($datestamp2, $label2, $comment, 1);
94     # write it and unlock
95     $tl->write();
96
97 =head1 OBJECT-ORIENTED INTERFACE
98
99 C<new> returns a hash with no C<tles> set if the tapelist does
100 not exist. C<tles> is an empty array if the tapelist is empty.
101 Invalid entries are silently ignored.
102
103 =head2 tapelist object
104
105 A tapelist object is a hash with the following keys:
106
107 =over
108
109 =item C<filename>
110
111   The filename of the tapelist file.
112
113 =item C<filename_lock>
114
115   The filename of the lock file.
116
117 =item C<fl>
118
119   A Amanda::Util::file_lock is the file is locked.
120
121 =item C<tles>
122
123 A sequence of tapelist elements (referred to as TLEs in this document),
124 sorted by datestamp from newest to oldest.
125
126 =back
127
128 =head2 tapelist element
129
130 A tapelist elementas a hash with the following keys:
131
132 =over
133
134 =item C<position>
135
136 the one-based position of the TLE in the tapelist
137
138 =item C<datestamp>
139
140 the datestamp on which this was written, or "0" for an unused tape
141
142 =item C<reuse>
143
144 true if this tape can be reused when it is no longer active
145
146 =item C<label>
147
148 tape label
149
150 =item C<comment>
151
152 the comment for this tape, or undef if no comment was given
153
154 =back
155
156 =head1 Method
157
158 The following methods are available on a tapelist object C<$tl>:
159
160 =over
161
162 =item C<relod($lock)>
163
164 reload the tapelist file, lock it if $lock is set
165
166 =item C<lookup_tapelabel($lbl)>
167
168 look up and return a reference to the TLE with the given label
169
170 =item C<lookup_tapepos($pos)>
171
172 look up and return a reference to the TLE in the given position
173
174 =item C<lookup_tapedate($date)>
175
176 look up and return a reference to the TLE with the given datestamp
177
178 =item C<remove_tapelabel($lbl)>
179
180 remove the tape with the given label
181
182 =item C<add_tapelabel($date, $lbl, $comment, $reuse)>
183
184 add a tape with the given date, label, comment and reuse to the end of the
185 tapelist. reuse can be 1 or undef for a reusable volume, it must be 0 for
186 a no-reusable volume.
187
188 =item C<write()> or C<write($filename)>
189
190 write the tapelist out to the same file as when read or to C<$filename> if it
191 is set, remove the lock if a lock was taken
192
193 =item C<unlock()>
194
195 remove the lock if a lock was taken
196
197 =item C<clear_tapelist()>
198
199 remove all tle from the tles.
200
201 =back
202
203 =head1 INTERACTION WITH C CODE
204
205 The C portions of Amanda treat the tapelist as a global variable,
206 while this package treats it as an object (and can thus handle more
207 than one tapelist simultaneously).  Every call to C<reload>
208 fills this global variable with a copy of the tapelist, and likewise
209 C<clear_tapelist> clears the global.  However, any changes made from
210 Perl are not reflected in the C copy, nor are changes made by C
211 modules reflected in the Perl copy.
212
213 =cut
214
215
216
217 use Amanda::Debug qw(:logging);
218 use Amanda::Config qw( config_dir_relative );
219 use File::Copy;
220 use Fcntl qw(:flock); # import LOCK_* constants
221
222 ## package functions
223
224 sub new {
225     my ($class)  = shift;
226     my ($filename, $lock ) = @_;
227     my $self = {
228         filename => $filename,
229         lockname => $filename . '.lock',
230     };
231     bless $self, $class;
232
233     $self->reload($lock);
234     return $self;
235 }
236
237 sub clear_tapelist {
238     my $self = shift;
239
240     # clear the C version
241     C_clear_tapelist();
242
243     $self->{'tles'} = [];
244
245     return $self;
246 }
247
248 ## methods
249
250 sub reload {
251     my $self = shift;
252     my ($lock) = @_;
253
254     if ($lock) {
255         $self->_take_lock();
256     }
257
258     # clear the C copy
259     C_clear_tapelist();
260
261     # let C read the file
262     C_read_tapelist($self->{'filename'});
263
264     $self->_read_tapelist();
265 }
266
267 sub lookup_tapelabel {
268     my $self = shift;
269     my ($label) = @_;
270
271     for my $tle (@{$self->{'tles'}}) {
272         return $tle if ($tle->{'label'} eq $label);
273     }
274
275     return undef;
276 }
277
278 sub lookup_tapepos {
279     my $self = shift;
280     my ($position) = @_;
281
282     $self->_update_positions();
283     return $self->{'tles'}->[$position-1];
284 }
285
286 sub lookup_tapedate {
287     my $self = shift;
288     my ($datestamp) = @_;
289
290     for my $tle (@{$self->{'tles'}}) {
291         return $tle if ($tle->{'datestamp'} eq $datestamp);
292     }
293
294     return undef;
295 }
296
297 sub remove_tapelabel {
298     my $self = shift;
299     my ($label) = @_;
300
301     for (my $i = 0; $i < @{$self->{tles}}; $i++) {
302         if ($self->{tles}->[$i]->{'label'} eq $label) {
303             splice @{$self->{tles}}, $i, 1;
304             $self->_update_positions();
305             return;
306         }
307     }
308 }
309
310 sub add_tapelabel {
311     my $self = shift;
312     my ($datestamp, $label, $comment, $reuse, $meta, $barcode, $blocksize) = @_;
313     $reuse = 1 if !defined $reuse;
314
315     # prepend this (presumably new) volume to the beginning of the list
316     my $tle = {
317         'datestamp' => $datestamp,
318         'label'     => $label,
319         'reuse'     => $reuse,
320         'barcode'   => $barcode,
321         'meta'      => $meta,
322         'blocksize' => $blocksize,
323         'comment'   => $comment,
324     };
325     my $tles = $self->{'tles'};
326     if (!defined $tles->[0] ||
327         $tles->[0]->{'datestamp'} le $datestamp) {
328         unshift @{$tles}, $tle;
329     } elsif (defined $tles->[0] &&
330         $tles->[@$tles-1]->{'datestamp'} gt $datestamp) {
331         push @{$tles}, $tle;
332     } else {
333         my $added = 0;
334         for my $i (0..(@$tles-1)) {
335             if ($tles->[$i]->{'datestamp'} le $datestamp) {
336                 splice @{$tles}, $i, 0, $tle;
337                 $added = 1;
338                 last;
339             }
340         }
341         push @{$tles}, $tle if !$added;
342     }
343     $self->_update_positions();
344 }
345
346 sub write {
347     my $self = shift;
348     my ($filename) = @_;
349     my $result = TRUE;
350     $filename = $self->{'filename'} if !defined $filename;
351
352     my $new_tapelist_file = $filename . "-new-" . time();
353
354     open(my $fhn, ">", $new_tapelist_file) or die("Could not open '$new_tapelist_file' for writing: $!");
355     for my $tle (@{$self->{tles}}) {
356         my $datestamp = $tle->{'datestamp'};
357         my $label = $tle->{'label'};
358         my $reuse = $tle->{'reuse'} ? 'reuse' : 'no-reuse';
359         my $barcode = (defined $tle->{'barcode'})? (" BARCODE:" . $tle->{'barcode'}) : '';
360         my $meta = (defined $tle->{'meta'})? (" META:" . $tle->{'meta'}) : '';
361         my $blocksize = (defined $tle->{'blocksize'})? (" BLOCKSIZE:" . $tle->{'blocksize'}) : '';
362         my $comment = (defined $tle->{'comment'})? (" #" . $tle->{'comment'}) : '';
363         $result &&= print $fhn "$datestamp $label $reuse$barcode$meta$blocksize$comment\n";
364     }
365     my $result_close = close($fhn);
366     $result &&= $result_close;
367
368     return if (!$result);
369
370     unless (move($new_tapelist_file, $filename)) {
371         die ("failed to rename '$new_tapelist_file' to '$filename': $!");
372     }
373
374     # re-read from the C side to synchronize
375     C_read_tapelist($filename);
376
377     $self->unlock();
378
379     return undef;
380 }
381
382 sub unlock {
383     my $self = shift;
384
385     return if !exists $self->{'fl'};
386
387     $self->{'fl'}->unlock();
388     delete $self->{'fl'}
389 }
390
391 ## private methods
392
393 sub _take_lock {
394     my $self = shift;
395
396     if (!-e $self->{'lockname'}) {
397         open(my $fhl, ">>", $self->{'lockname'});
398         close($fhl);
399     }
400     my $fl = Amanda::Util::file_lock->new($self->{'lockname'});
401     while(($r = $fl->lock()) == 1) {
402         sleep(1);
403     }
404     if ($r == 0) {
405         $self->{'fl'} = $fl;
406     }
407 }
408
409 sub _read_tapelist {
410     my $self = shift;
411
412     my @tles;
413     open(my $fh, "<", $self->{'filename'}) or return $self;
414     while (my $line = <$fh>) {
415         my ($datestamp, $label, $reuse, $barcode, $meta, $blocksize, $comment)
416             = $line =~ m/^([0-9]+)\s*([^\s]*)\s*(?:(reuse|no-reuse))?\s*(?:BARCODE:([^\s]*))?\s*(?:META:([^\s]*))?\s*(?:BLOCKSIZE:([^\s]*))?\s*(?:\#(.*))?$/mx;
417         if (!defined $datestamp) {
418             Amanda::Debug::critical("Bogus line in the tapelist ($self->{'filename'}) file: $line");
419         }
420         push @tles, {
421             'datestamp' => $datestamp,
422             'label' => $label,
423             'reuse' => (!defined $reuse || $reuse eq 'reuse'),
424             'barcode' => $barcode,
425             'meta' => $meta,
426             'blocksize' => $blocksize,
427             'comment' => $comment,
428         };
429     }
430     close($fh);
431
432     # sort in descending order by datestamp, sorting on position, too, to ensure
433     # that entries with the same datestamp stay in the right order
434     $self->{'tles'} = \@tles;
435     $self->_update_positions();
436     @tles = sort {
437            $b->{'datestamp'} cmp $a->{'datestamp'}
438         || $a->{'position'} <=> $b->{'position'}
439         } @tles;
440
441     $self->{'tles'} = \@tles;
442
443     # and re-calculate the positions
444     $self->_update_positions(\@tles);
445 }
446
447 # update the 'position' key for each TLE
448 sub _update_positions {
449     my $self = shift;
450     my $tles = $self->{'tles'};
451     for (my $i = 0; $i < scalar @$tles; $i++) {
452         $tles->[$i]->{'position'} = $i+1;
453     }
454 }
455
456 1;