os2/OS2/ExtAttr/ExtAttr.pm

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