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

   1 /*
   2  * Copyright (c) Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This library is free software; you can redistribute it and/or modify it
   5  * under the terms of the GNU Lesser General Public License version 2.1
   6  * as published by the Free Software Foundation.
   7  *
   8  * This library 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 Lesser General Public
  11  * License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public License
  14  * along with this library; if not, write to the Free Software Foundation,
  15  * Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA.
  16  *
  17  * Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
  18  * Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19  */
  20
  21 %module "Amanda::Archive"
  22 %include "amglue/amglue.swg"
  23 %include "exception.i"
  24 %include "cstring.i"
  25
  26 %{
  27 #include "amar.h"
  28 %}
  29
  30 %perlcode %{
  31 =head1 NAME
  32
  33 Amanda::Archive - Perl access to the  amanda archive library
  34
  35 =head1 SYNOPSIS
  36
  37   use Amanda::Archive
  38
  39   # Write to the file descriptor $fd, and add /etc/hosts to it
  40   my $archive = Amanda::Archive->new($fd, ">");
  41   my $file = $archive->new_file("/etc/hosts");
  42   my $attr = $file->new_attr(16);
  43   open(my $fh, "<", "/etc/hosts");
  44   $attr->add_data_fd(fileno($fh), 1);
  45   $file->close();
  46   $archive->close();
  47
  48   # Read from an archive
  49   my $archive = Amanda::Archive->new($fd, "<");
  50   $ar->read(
  51       file_start => sub {
  52           my ($user_data, $filenum, $filename) = @_;
  53           # ...
  54           return "foo"; # this becomes $file_data
  55       },
  56       file_finish => sub {
  57           my ($user_data, $file_data, $filenum, $truncated) = @_;
  58           # ...
  59       },
  60       21 => [ 32768,    # buffer into 32k chunks
  61               sub {
  62                   my ($user_data, $filenum, $file_data, $attrid,
  63                       $attr_data, $data, $eoa, $truncated) = @_;
  64                   return "pants"; # becomes the new $attr_data for
  65                                   # any subsequent fragments
  66               } ],
  67       0 => sub {        # note no buffering here; attrid 0 is "default"
  68           my ($user_data, $filenum, $file_data, $attrid,
  69               $attr_data, $data, $eoa, $truncated) = @_;
  70           return "shorts"; # becomes the new $attr_data for
  71                            # any subsequent fragments
  72       },
  73       user_data => [ "mydata" ], # sent to all callbacks
  74   );
  75
  76 =head1 WRITING
  77
  78 =head2 Amanda::Archive::Archive Objects
  79
  80 Note that C<Amanda::Archive->new> and C<Amanda::Archive::Archive->new> are
  81 equivalent.
  82
  83 =over
  84
  85 =item C<new($fd, $mode)>
  86
  87 Create a new archive for reading ("<") or writing (">") from or to file
  88 descriptor C<$fd>.
  89
  90 =item C<new_file($filename, $want_posn)>
  91
  92 Create a new C<Amanda::Archive::File> object with the given filename (writing
  93 only).  Equivalent to
  94
  95   Amanda::Archive::File->new($archive, $filename, $want_posn);
  96
  97 if C<$want_posn> is false, then this method returns a new
  98 C<Amanda::Archive::File> object.  If C<$want_posn> is true, then it returns
  99 C<($file, $posn)> where C<$file> is the object and C<$posn> is the offset into
 100 the datastream at which this file begins.  This offset can be stored in an
 101 index and used later to seek into the file.
 102
 103 =item C<read(..)>
 104
 105 See I<READING>, below.
 106
 107 =item C<close()>
 108
 109 Flush all buffers and close this archive. This does not close the file descriptor.
 110
 111 =back
 112
 113 =head2 Amanda::Archive::File Objects
 114
 115 =over
 116
 117 =item C<new($archive, $filename, $want_posn)>
 118
 119 Create a new file in the given archive.  See C<Amanda::Archive::Archive::new_file>, above.
 120
 121 =item C<new_attr($attrid)>
 122
 123 Create a new C<Amanda::Archive::Attribute> object.  Equivalent to
 124
 125   Amanda::Archive::Attr->new($file, $attrid);
 126
 127 =item C<close()>
 128
 129 Close this file, writing an EOF record.
 130
 131 =back
 132
 133 =head2 Amanda::Archive::Attribute Objects
 134
 135 =over
 136
 137 =item C<add_data($data, $eoa)>
 138
 139 Add C<$data> to this attribute, adding an EOA (end-of-attribute) bit if C<$eoa> is true.
 140
 141 =item C<add_data_fd($fd, $eoa)>
 142
 143 Copy data from C<$fd> to this attribute, adding an EOA (end-of-attribute) bit if C<$eoa> is true.
 144
 145 =item C<close()>
 146
 147 Close this attribute, adding an EOA bit if none has been written already.
 148
 149 =back
 150
 151 =head1 READING
 152
 153 The C<Amanda::Archive::Archive> method C<read()> handles reading archives via a callback mechanism.  It takes its arguments in hash form, with the following keys:
 154
 155     file_start => sub {
 156         my ($user_data, $filenum, $filename) = @_;
 157         # ..
 158     },
 159
 160 C<file_start> gives a sub which is called for every file in the archive.  It
 161 can return an arbitrary value which will become the C<$file_data> for
 162 subsequent callbacks in this file, or the string "IGNORE" which will cause the
 163 reader to ignore all data for this file.  In this case, no other callbacks will
 164 be made for the file (not even C<file_finish>).
 165
 166     file_finish => sub {
 167         my ($user_data, $file_data, $filenum, $truncated) = @_;
 168         # ..
 169     },
 170
 171 C<file_finish> gives a sub which is called when an EOF record appears.
 172 C<$file_data> comes from the return value of the C<file_start> callback.
 173 C<$truncated> is true if the file may be missing data (e.g., when an early EOF
 174 is detected).
 175
 176     user_data => $my_object,
 177
 178 C<user_data> gives an arbitrary value which is passed to each callback as C<$user_data>.
 179
 180     13 => sub {
 181         my ($user_data, $filenum, $file_data, $attrid,
 182             $attr_data, $data, $eoa, $truncated) = @_;
 183         # ...
 184     },
 185     19 => [ 10240, sub { ... } ],
 186
 187 Any numeric key is treated as an attribute ID, and specifies the handling for
 188 that attribute.  Attribute ID zero is treated as a wildcard, and will match any
 189 attribute without an explicit handler.  The handler can be specified as a sub
 190 (as for attribute ID 13 in the example above) or as an arrayref C<[$minsize,
 191 $sub]>.  In the latter case, the sub is only called when at least C<$minsize>
 192 bytes of data are available for the attribute, or at the end of the attribute
 193 data.
 194
 195 The parameters to the callback include C<$file_data>, the value returned from
 196 C<file_start>, and C<$attr_data>, which is the return value of the last
 197 invocation of this sub for this attribute.  If this is the last fragment of
 198 data for this attribute, then C<$eoa> is true.  The meaning of C<$truncated>
 199 is similar to that in C<file_finish>.
 200
 201 =head2 EXAMPLE
 202
 203     sub read_to_files {
 204         my ($arch_fh, $basedir) = @_;
 205
 206         my $arch = Amanda::Archive->new(fileno($arch_fh), "<");
 207         $arch->read(
 208             file_start => sub {
 209                 my ($user_data, $filenum, $filename) = @_;
 210                 return "$basedir/$filenum"; # becomes $file_data
 211             },
 212             0 => [ 32768, sub {
 213                 my ($user_data, $filenum, $file_data, $attrid,
 214                     $attr_data, $data, $eoa, $truncated) = @_;
 215                 warn("file $filename attribute $attrid is truncated")
 216                     if ($truncated);
 217                 # store the open filehandle in $attr_data
 218                 if (!$attr_data) {
 219                     open($attr_data, "$file_data.$attrid", ">")
 220                         or die("open: $!");
 221                 }
 222                 print $attr_data $data;
 223                 if ($eoa) {
 224                     close($attr_data);
 225                 }
 226                 return $attr_data;
 227             },
 228         );
 229     }
 230
 231 =cut
 232 %}
 233
 234 %{
 235 /* Support code (not directly available from perl) */
 236
 237 /* A C object to contain all of the relevant callbacks and other state during a
 238  * read operation; this becomes the user_data during the read */
 239 typedef struct perl_read_data_s {
 240     SV *user_data;
 241     SV *file_start_sub;
 242     SV *file_finish_sub;
 243
 244     amar_attr_handling_t *handling_array;
 245 } perl_read_data_t;
 246
 247 static gboolean
 248 read_start_file_cb(
 249         gpointer user_data,
 250         uint16_t filenum,
 251         gpointer filename,
 252         gsize filename_len,
 253         gboolean *ignore,
 254         gpointer *file_data)
 255 {
 256     dSP;
 257     perl_read_data_t *dat = user_data;
 258     SV *rv = NULL;
 259     STRLEN len;
 260     int count;
 261
 262     *file_data = NULL;
 263
 264     g_assert(dat->file_start_sub != NULL);
 265
 266     ENTER;
 267     SAVETMPS;
 268
 269     PUSHMARK(SP);
 270     XPUSHs(dat->user_data);
 271     XPUSHs(sv_2mortal(newSViv(filenum)));
 272     XPUSHs(sv_2mortal(newSVpvn(filename, filename_len)));
 273     PUTBACK;
 274
 275     count = call_sv(dat->file_start_sub, G_EVAL|G_SCALAR);
 276
 277     SPAGAIN;
 278
 279     if (count != 1)
 280         croak("file_start_sub returned nothing");
 281
 282     rv = POPs;
 283
 284     /* if it's the string "IGNORE", then ignore it */
 285     if (SvPOK(rv)) {
 286         static const char *ign = "IGNORE";
 287         char *rvstr = SvPV(rv, len);
 288         if (strlen(ign) == len && 0 == strncmp(ign, rvstr, len))
 289             *ignore = TRUE;
 290     }
 291
 292     /* otherwise, keep the value */
 293     if (!*ignore)
 294         *(SV **)(file_data) = SvREFCNT_inc(rv);
 295
 296     PUTBACK;
 297     FREETMPS;
 298     LEAVE;
 299
 300     if (SvTRUE(ERRSV))
 301         return FALSE;
 302     return TRUE;
 303 }
 304
 305 static gboolean
 306 read_finish_file_cb(
 307         gpointer user_data,
 308         uint16_t filenum,
 309         gpointer *file_data,
 310         gboolean truncated)
 311 {
 312     dSP;
 313     perl_read_data_t *dat = user_data;
 314
 315     g_assert(dat->file_finish_sub != NULL);
 316
 317     ENTER;
 318     SAVETMPS;
 319
 320     PUSHMARK(SP); XPUSHs(dat->user_data); XPUSHs(*(SV **)file_data);
 321     XPUSHs(sv_2mortal(newSViv(filenum)));
 322     XPUSHs(sv_2mortal(newSViv(truncated))); PUTBACK;
 323
 324     call_sv(dat->file_finish_sub, G_EVAL|G_DISCARD);
 325
 326     /* we're done with this file's file_data */
 327     SvREFCNT_dec(*(SV **)file_data);
 328
 329     FREETMPS;
 330     LEAVE;
 331
 332     if (SvTRUE(ERRSV))
 333         return FALSE;
 334     return TRUE;
 335 }
 336
 337 static gboolean
 338 read_frag_cb(
 339         gpointer user_data,
 340         uint16_t filenum,
 341         gpointer file_data,
 342         uint16_t attrid,
 343         gpointer attrid_data,
 344         gpointer *attr_data,
 345         gpointer data,
 346         gsize size,
 347         gboolean eoa,
 348         gboolean truncated)
 349 {
 350     dSP;
 351     perl_read_data_t *dat = user_data;
 352     SV *rv;
 353     int count;
 354
 355     if (!attrid_data)
 356         return TRUE;
 357
 358     ENTER;
 359     SAVETMPS;
 360
 361     PUSHMARK(SP);
 362     XPUSHs(dat->user_data);
 363     XPUSHs(sv_2mortal(newSViv(filenum)));
 364     XPUSHs((SV *)file_data);
 365     XPUSHs(sv_2mortal(newSViv(attrid)));
 366     if (*attr_data)
 367         XPUSHs((SV *)(*attr_data));
 368     else
 369         XPUSHs(&PL_sv_undef);
 370     XPUSHs(sv_2mortal(newSVpvn(data, size)));
 371     XPUSHs(sv_2mortal(newSViv(eoa)));
 372     XPUSHs(sv_2mortal(newSViv(truncated)));
 373     PUTBACK;
 374
 375     count = call_sv(attrid_data, G_EVAL|G_SCALAR);
 376
 377     SPAGAIN;
 378
 379     if (count != 1)
 380         croak("fragment callback returned nothing");
 381
 382     rv = POPs;
 383
 384     if (eoa) {
 385         SvREFCNT_dec(*attr_data);
 386     } else {
 387         /* increment before decrement here, in case they're the same object */
 388         SvREFCNT_inc(rv);
 389         SvREFCNT_dec(*attr_data);
 390         *attr_data = rv;
 391     }
 392
 393     FREETMPS;
 394     LEAVE;
 395
 396     if (SvTRUE(ERRSV))
 397         return FALSE;
 398     return TRUE;
 399 }
 400
 401 static void
 402 croak_gerror(GError **error)
 403 {
 404     static char *errstr = NULL;
 405     if (errstr) g_free(errstr);
 406     errstr = g_strdup((*error)->message);
 407     g_clear_error(error);
 408     croak("Amanda archive: %s", errstr);
 409 }
 410
 411 /* generic function to recognize when a string+len represents a number and
 412  * incidentally return the resulting value.  Note that this does not handle
 413  * negative numbers. */
 414 static gboolean
 415 is_number(char *str, int len, int *result)
 416 {
 417     char *end = str+len;
 418     int r = 0;
 419
 420     while (str < end) {
 421         if (!g_ascii_isdigit(*str)) return FALSE;
 422         r = r * 10 + (int)(*str - '0');
 423         if (r < 0) {
 424             /* overflow */
 425             return FALSE;
 426         }
 427         str++;
 428     }
 429
 430     *result = r;
 431     return TRUE;
 432 }
 433
 434 %}
 435
 436 /* Rename all of the below wrapper functions (suffixed with '_') for
 437  * consumption by perl */
 438 %rename(amar_new) amar_new_;
 439 %rename(amar_close) amar_close_;
 440 %rename(amar_new_file) amar_new_file_;
 441 %rename(amar_file_close) amar_file_close_;
 442 %rename(amar_new_attr) amar_new_attr_;
 443 %rename(amar_attr_close) amar_attr_close_;
 444 %rename(amar_attr_add_data_buffer) amar_attr_add_data_buffer_;
 445 %rename(amar_attr_add_data_fd) amar_attr_add_data_fd_;
 446 %rename(amar_read) amar_read_;
 447
 448 /* typemaps for the below */
 449 %apply (char *STRING, int LENGTH) { (char *filename, gsize filename_len) };
 450 %apply (char *STRING, int LENGTH) { (char *buffer, gsize size) };
 451 %typemap(in) SV * "$1 = $input;"
 452
 453 %typemap(in) off_t *want_position (off_t position) {
 454     if (SvTRUE($input)) {
 455         position = 0;
 456         $1 = &position;
 457     } else {
 458         $1 = NULL;
 459     }
 460 }
 461 %typemap(argout) off_t *want_position {
 462     if ($1) {
 463         $result = amglue_newSVi64(*$1);
 464         argvi++;
 465     }
 466 }
 467
 468 %inline %{
 469
 470 /* Wrapper functions, mostly dealing with error handling */
 471
 472 amar_t *amar_new_(int fd, char *modestr) {
 473     GError *error = NULL;
 474     amar_t *rv;
 475     int mode;
 476
 477     if (strcmp(modestr, ">") == 0)
 478         mode = O_WRONLY;
 479     else if (strcmp(modestr, "<") == 0)
 480         mode = O_RDONLY;
 481     else
 482         croak("mode must be '<' or '>'");
 483
 484     if ((rv = amar_new(fd, mode, &error))) {
 485         return rv;
 486     }
 487
 488     croak_gerror(&error);
 489     return NULL;
 490 }
 491
 492 void amar_close_(amar_t *arch) {
 493     GError *error = NULL;
 494     if (!amar_close(arch, &error))
 495         croak_gerror(&error);
 496 }
 497
 498 amar_file_t *
 499 amar_new_file_(amar_t *arch, char *filename, gsize filename_len, off_t *want_position) {
 500     GError *error = NULL;
 501     amar_file_t *file;
 502     g_assert(arch != NULL);
 503
 504     file = amar_new_file(arch, filename, filename_len, want_position, &error);
 505     if (file)
 506         return file;
 507
 508     croak_gerror(&error);
 509     return NULL;
 510 }
 511
 512 void amar_file_close_(amar_file_t *file) {
 513     GError *error = NULL;
 514     if (!amar_file_close(file, &error))
 515         croak_gerror(&error);
 516 }
 517
 518 amar_attr_t *
 519 amar_new_attr_(amar_file_t *file, guint16 attrid) {
 520     GError *error = NULL;
 521     amar_attr_t *attr;
 522
 523     g_assert(file != NULL);
 524
 525     attr = amar_new_attr(file, attrid, &error);
 526     if (attr)
 527         return attr;
 528
 529     croak_gerror(&error);
 530     return NULL;
 531 }
 532
 533 void amar_attr_close_(amar_attr_t *attr) {
 534     GError *error = NULL;
 535     if (!amar_attr_close(attr, &error))
 536         croak_gerror(&error);
 537 }
 538
 539 void amar_attr_add_data_buffer_(amar_attr_t *attr, char *buffer, gsize size, gboolean eoa) {
 540     GError *error = NULL;
 541     if (!amar_attr_add_data_buffer(attr, buffer, size, eoa, &error))
 542         croak_gerror(&error);
 543 }
 544
 545 size_t
 546 amar_attr_add_data_fd_(amar_attr_t *attr, int fd, gboolean eoa) {
 547     GError *error = NULL;
 548     size_t rv = amar_attr_add_data_fd(attr, fd, eoa, &error);
 549     if (rv < 0)
 550         croak_gerror(&error);
 551     return rv;
 552 }
 553
 554 /* reading */
 555
 556 void amar_read_(amar_t *archive, SV *params_hashref) {
 557     perl_read_data_t *dat = g_new0(perl_read_data_t, 1);
 558     GError *error = NULL;
 559     gboolean success;
 560     HV *params;
 561     HE *param;
 562     I32 len;
 563     int maxhandlers;
 564     int hdl_idx;
 565
 566     /* make sure we got a hashref */
 567     if (!SvROK(params_hashref) || SvTYPE(SvRV(params_hashref)) != SVt_PVHV)
 568         croak("read() expects a single hashref");
 569     params = (HV *)SvRV(params_hashref);
 570     len = hv_iterinit(params);
 571
 572     maxhandlers = hdl_idx = len;
 573     dat->handling_array = g_new0(amar_attr_handling_t, len+1);
 574
 575     /* loop through the parameters */
 576     while ((param = hv_iternext(params))) {
 577         I32 keylen;
 578         char *key = hv_iterkey(param, &keylen);
 579         int attrid;
 580
 581         /* if it's a number, it's handling information for an attrid */
 582         if (is_number(key, keylen, &attrid)) {
 583             SV *val = hv_iterval(params, param);
 584             SV *coderef;
 585             UV bufsize = 0;
 586             int i;
 587
 588             if (!SvROK(val)) goto croak_hdl;
 589
 590             switch (SvTYPE(SvRV(val))) {
 591                 case SVt_PVCV:
 592                     coderef = val;
 593                     break;
 594
 595                 case SVt_PVAV: {
 596                     AV *arr = (AV *)SvRV(val);
 597                     SV **svp;
 598
 599                     if (av_len(arr) != 1) /* av_len == largest index, not length */
 600                         goto croak_hdl;
 601
 602                     /* get the bufsize */
 603                     svp = av_fetch(arr, 0, 0);
 604                     if (!SvIOK(*svp))
 605                         goto croak_hdl;
 606                     bufsize = SvUV(*svp);
 607
 608                     /* and the coderef */
 609                     svp = av_fetch(arr, 1, 0);
 610                     if (!SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVCV)
 611                         goto croak_hdl;
 612                     coderef = *svp;
 613                     break;
 614                 }
 615
 616                 default:
 617                     goto croak_hdl;
 618             }
 619
 620             /* fill in the handling array, putting attrid 0 at the end, and
 621              * filling in entries backward from there */
 622             i = (attrid == 0)? maxhandlers : --hdl_idx;
 623             dat->handling_array[i].attrid = attrid;
 624             dat->handling_array[i].min_size = bufsize;
 625             dat->handling_array[i].callback = read_frag_cb;
 626             dat->handling_array[i].attrid_data = coderef;
 627             SvREFCNT_inc(coderef);
 628             continue;
 629
 630         croak_hdl:
 631             croak("Expected CODEREF or [ MIN_SIZE, CODEREF ] for attrid %d", attrid);
 632         }
 633
 634 #define key_compare(key, val, keylen) \
 635     (keylen == sizeof(val)-1) && (0 == strncmp(key, val, keylen))
 636
 637         if (key_compare(key, "file_start", keylen)) {
 638             SV *val = hv_iterval(params, param);
 639             if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVCV)
 640                 croak("Expected a CODEREF for file_start");
 641             dat->file_start_sub = val;
 642             SvREFCNT_inc(val);
 643             continue;
 644         }
 645
 646         if (key_compare(key, "file_finish", keylen)) {
 647             SV *val = hv_iterval(params, param);
 648             if (!SvROK(val) || SvTYPE(SvRV(val)) != SVt_PVCV)
 649                 croak("Expected a CODEREF for file_finish");
 650             dat->file_finish_sub = val;
 651             SvREFCNT_inc(val);
 652             continue;
 653         }
 654
 655         if (key_compare(key, "user_data", keylen)) {
 656             SV *val = hv_iterval(params, param);
 657             dat->user_data = val;
 658             SvREFCNT_inc(val);
 659             continue;
 660         }
 661 #undef key_compare
 662         croak("Invalid parameter named '%*s'", (int)keylen, key);
 663     }
 664
 665     if (!dat->user_data)
 666         dat->user_data = &PL_sv_undef;
 667
 668     success = amar_read(archive, dat, dat->handling_array + hdl_idx,
 669         dat->file_start_sub? read_start_file_cb : NULL,
 670         dat->file_finish_sub? read_finish_file_cb : NULL,
 671         &error);
 672
 673     /* now unreference and free everything we referenced earlier */
 674     if (dat->file_start_sub)
 675         SvREFCNT_dec(dat->file_start_sub);
 676     if (dat->file_finish_sub)
 677         SvREFCNT_dec(dat->file_finish_sub);
 678     if (dat->user_data && dat->user_data != &PL_sv_undef)
 679         SvREFCNT_dec(dat->user_data);
 680
 681     for (hdl_idx = 0; hdl_idx <= maxhandlers; hdl_idx++) {
 682         if (dat->handling_array[hdl_idx].attrid_data)
 683             SvREFCNT_dec(dat->handling_array[hdl_idx].attrid_data);
 684     }
 685
 686     g_free(dat->handling_array);
 687     g_free(dat);
 688
 689     /* if amar_read returned FALSE, then either we hit an internal
 690      * error, or one of the perl callbacks raised an exception, and $@
 691      * is still set */
 692     if (!success) {
 693         if (error)
 694             croak_gerror(&error);
 695         else
 696             croak(NULL);
 697     }
 698 }
 699
 700 %}
 701
 702 /* now wrap those flat functions in Perl classes, depending on the perl
 703  * refcounting to close objects in the right order */
 704
 705 %perlcode %{
 706 package Amanda::Archive;
 707
 708 # Expose the Archive constructor at Amanda::Archive->new
 709 sub new {
 710     my $pkg = shift;
 711     Amanda::Archive::Archive->new(@_);
 712 }
 713
 714 package Amanda::Archive::Archive;
 715
 716 sub new {
 717     my ($class, $fd, $mode) = @_;
 718     my $arch = Amanda::Archive::amar_new($fd, $mode);
 719     return bless (\$arch, $class);
 720 }
 721
 722 sub close {
 723     my $self = shift;
 724     if ($$self) {
 725         Amanda::Archive::amar_close($$self);
 726         $$self = undef;
 727     }
 728 }
 729
 730 sub DESTROY {
 731     my $self = shift;
 732     $self->close();
 733 }
 734
 735 sub new_file {
 736     my ($self, $filename, $want_offset) = @_;
 737     return Amanda::Archive::File->new($self, $filename, $want_offset);
 738 }
 739
 740 sub Amanda::Archive::Archive::read {
 741     my $self = shift;
 742     die "Archive is not open" unless ($$self);
 743     # pass a hashref to the C code
 744     my %h = @_;
 745     Amanda::Archive::amar_read($$self, \%h);
 746 }
 747
 748 package Amanda::Archive::File;
 749
 750 sub new {
 751     my ($class, $arch, $filename, $want_offset) = @_;
 752     die "Archive is not open" unless ($$arch);
 753     if ($want_offset) {
 754         # note that posn is returned first by the SWIG wrapper
 755         my ($file, $posn) = Amanda::Archive::amar_new_file($$arch, $filename, $want_offset);
 756         return (bless([ $file, $arch ], $class), $posn);
 757     } else {
 758         my $file = Amanda::Archive::amar_new_file($$arch, $filename, $want_offset);
 759         return bless([ $file, $arch ], $class);
 760     }
 761 }
 762
 763 sub close {
 764     my $self = shift;
 765     if ($self->[0]) {
 766         Amanda::Archive::amar_file_close($self->[0]);
 767         $self->[0] = undef;
 768     }
 769 }
 770
 771 sub DESTROY {
 772     my $self = shift;
 773     $self->close();
 774 }
 775
 776 sub new_attr {
 777     my ($self, $attrid) = @_;
 778     return Amanda::Archive::Attr->new($self, $attrid);
 779 }
 780
 781 package Amanda::Archive::Attr;
 782
 783 sub new {
 784     my ($class, $file, $attrid) = @_;
 785     die "File is not open" unless ($file->[0]);
 786     my $attr = Amanda::Archive::amar_new_attr($file->[0], $attrid);
 787     return bless ([$attr, $file], $class);
 788 }
 789
 790 sub close {
 791     my $self = shift;
 792     if ($self->[0]) {
 793         Amanda::Archive::amar_attr_close($self->[0]);
 794         $self->[0] = undef;
 795     }
 796 }
 797
 798 sub DESTROY {
 799     my $self = shift;
 800     $self->close();
 801 }
 802
 803 sub add_data {
 804     my ($self, $data, $eoa) = @_;
 805     die "Attr is not open" unless ($self->[0]);
 806     Amanda::Archive::amar_attr_add_data_buffer($self->[0], $data, $eoa);
 807 }
 808
 809 sub add_data_fd {
 810     my ($self, $fd, $eoa) = @_;
 811     die "Attr is not open" unless ($self->[0]);
 812     return Amanda::Archive::amar_attr_add_data_fd($self->[0], $fd, $eoa);
 813 }
 814 %}