Commit | Line | Data |
760ac839 |
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'; |
88c28ceb |
136 | |
760ac839 |
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 |