Commit | Line | Data |
---|---|---|
760ac839 LW |
1 | package OS2::ExtAttr; |
2 | ||
3 | use strict; | |
5c728af0 | 4 | use XSLoader; |
760ac839 | 5 | |
f185f654 | 6 | our $VERSION = '0.04'; |
5c728af0 | 7 | XSLoader::load 'OS2::ExtAttr', $VERSION; |
760ac839 LW |
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'; | |
f703fc96 | 125 | |
760ac839 LW |
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 | |
f185f654 | 165 | library are supported, with leading C<_ea> and C<_ead> stripped. |
760ac839 LW |
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 |