Commit | Line | Data |
760ac839 |
1 | package OS2::ExtAttr; |
2 | |
3 | use strict; |
5c728af0 |
4 | use XSLoader; |
760ac839 |
5 | |
5c728af0 |
6 | our $VERSION = '0.02'; |
7 | XSLoader::load 'OS2::ExtAttr', $VERSION; |
760ac839 |
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'; |
88c28ceb |
125 | |
760ac839 |
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 |