os2/OS2/OS2-ExtAttr/ExtAttr.pm

   1 package OS2::ExtAttr;
   2
   3 use strict;
   4 use XSLoader;
   5
   6 our $VERSION = '0.02';
   7 XSLoader::load 'OS2::ExtAttr', $VERSION;
   8
   9 # Preloaded methods go here.
  10
  11 # Format of the array:
  12 # 0 ead, 1 file name, 2 file handle. 3 length, 4 position, 5 need to write.
  13
  14 sub TIEHASH {
  15   my $class = shift;
  16   my $ea = _create() || die "Cannot create EA: $!";
  17   my $file = shift;
  18   my ($name, $handle);
  19   if (ref $file eq 'GLOB' or ref \$file eq 'GLOB') {
  20     die "File handle is not opened" unless $handle = fileno $file;
  21     _read($ea, undef, $handle, 0);
  22   } else {
  23     $name = $file;
  24     _read($ea, $name, 0, 0);
  25   }
  26   bless [$ea, $name, $handle, 0, 0, 0], $class;
  27 }
  28
  29 sub DESTROY {
  30   my $eas = shift;
  31   # 0 means: discard eas which are not in $eas->[0].
  32   _write( $eas->[0], $eas->[1], $eas->[2], 0) and die "Cannot write EA: $!"
  33     if $eas->[5];
  34   _destroy( $eas->[0] );
  35 }
  36
  37 sub FIRSTKEY {
  38   my $eas = shift;
  39   $eas->[3] = _count($eas->[0]);
  40   $eas->[4] = 1;
  41   return undef if $eas->[4] > $eas->[3];
  42   return _get_name($eas->[0], $eas->[4]);
  43 }
  44
  45 sub NEXTKEY {
  46   my $eas = shift;
  47   $eas->[4]++;
  48   return undef if $eas->[4] > $eas->[3];
  49   return _get_name($eas->[0], $eas->[4]);
  50 }
  51
  52 sub FETCH {
  53   my $eas = shift;
  54   my $index = _find($eas->[0], shift);
  55   return undef if $index <= 0;
  56   return value($eas->[0], $index);
  57 }
  58
  59 sub EXISTS {
  60   my $eas = shift;
  61   return _find($eas->[0], shift) > 0;
  62 }
  63
  64 sub STORE {
  65   my $eas = shift;
  66   $eas->[5] = 1;
  67   add($eas->[0], shift, shift) > 0 or die "Error setting EA: $!";
  68 }
  69
  70 sub DELETE {
  71   my $eas = shift;
  72   my $index = _find($eas->[0], shift);
  73   return undef if $index <= 0;
  74   my $value = value($eas->[0], $index);
  75   _delete($eas->[0], $index) and die "Error deleting EA: $!";
  76   $eas->[5] = 1;
  77   return $value;
  78 }
  79
  80 sub CLEAR {
  81   my $eas = shift;
  82   _clear($eas->[0]);
  83   $eas->[5] = 1;
  84 }
  85
  86 # Here are additional methods:
  87
  88 *new = \&TIEHASH;
  89
  90 sub copy {
  91   my $eas = shift;
  92   my $file = shift;
  93   my ($name, $handle);
  94   if (ref $file eq 'GLOB' or ref \$file eq 'GLOB') {
  95     die "File handle is not opened" unless $handle = fileno $file;
  96     _write($eas->[0], undef, $handle, 0) or die "Cannot write EA: $!";
  97   } else {
  98     $name = $file;
  99     _write($eas->[0], $name, 0, 0) or die "Cannot write EA: $!";
 100   }
 101 }
 102
 103 sub update {
 104   my $eas = shift;
 105   # 0 means: discard eas which are not in $eas->[0].
 106   _write( $eas->[0], $eas->[1], $eas->[2], 0) and die "Cannot write EA: $!";
 107 }
 108
 109 # Autoload methods go after =cut, and are processed by the autosplit program.
 110
 111 1;
 112 __END__
 113 # Below is the stub of documentation for your module. You better edit it!
 114
 115 =head1 NAME
 116
 117 OS2::ExtAttr - Perl access to extended attributes.
 118
 119 =head1 SYNOPSIS
 120
 121   use OS2::ExtAttr;
 122   tie %ea, 'OS2::ExtAttr', 'my.file';
 123   print $ea{eaname};
 124   $ea{myfield} = 'value';
 125
 126   untie %ea;
 127
 128 =head1 DESCRIPTION
 129
 130 The package provides low-level and high-level interface to Extended
 131 Attributes under OS/2.
 132
 133 =head2 High-level interface: C<tie>
 134
 135 The only argument of tie() is a file name, or an open file handle.
 136
 137 Note that all the changes of the tied hash happen in core, to
 138 propagate it to disk the tied hash should be untie()ed or should go
 139 out of scope. Alternatively, one may use the low-level C<update>
 140 method on the corresponding object. Example:
 141
 142   tied(%hash)->update;
 143
 144 Note also that setting/getting EA flag is not supported by the
 145 high-level interface, one should use the low-level interface
 146 instead. To use it on a tied hash one needs undocumented way to find
 147 C<eas> give the tied hash.
 148
 149 =head2 Low-level interface
 150
 151 Two low-level methods are supported by the objects: copy() and
 152 update(). The copy() takes one argument: the name of a file to copy
 153 the attributes to, or an opened file handle. update() takes no
 154 arguments, and is discussed above.
 155
 156 Three convenience functions are provided:
 157
 158   value($eas, $key)
 159   add($eas, $key, $value [, $flag])
 160   replace($eas, $key, $value [, $flag])
 161
 162 The default value for C<flag> is 0.
 163
 164 In addition, all the C<_ea_*> and C<_ead_*> functions defined in EMX
 165 library are supported, with leading C<_ea/_ead> stripped.
 166
 167 =head1 AUTHOR
 168
 169 Ilya Zakharevich, ilya@math.ohio-state.edu
 170
 171 =head1 SEE ALSO
 172
 173 perl(1).
 174
 175 =cut