1package File::ExtAttr::Tie;
2
3=head1 NAME
4
5File::ExtAttr::Tie - Tie interface to extended attributes of files
6
7=head1 SYNOPSIS
8
9  use File::ExtAttr::Tie;
10  use Data::Dumper;
11
12  tie %a,
13    "File::ExtAttr::Tie", "/Applications (Mac  OS 9)/Sherlock 2",
14    { namespace => 'user' };
15  print Dumper \%a;
16
17produces:
18
19  $VAR1 = {
20           'com.apple.FinderInfo' => 'APPLfndf!?',
21           'com.apple.ResourceFork' => '?p?p5I'
22          };
23
24=head1 DESCRIPTION
25
26File::ExtAttr::Tie provides access to extended attributes of a file
27through a tied hash. Creating a new key creates a new extended attribute
28associated with the file. Modifying the value or removing a key likewise
29modifies/removes the extended attribute.
30
31Internally this module uses the File::ExtAttr module. So it has
32the same restrictions as that module in terms of OS support.
33
34=head1 METHODS
35
36=over 4
37
38=item tie "File::ExtAttr::Tie", $filename, [\%flags]
39
40The flags are the same optional flags as in File::ExtAttr.  Any flags
41given here will be passed to all operations on the tied hash.
42Only the C<namespace> flag makes sense. The hash will be tied
43to the default namespace, if no flags are given.
44
45=back
46
47=cut
48
49use strict;
50use base qw(Tie::Hash);
51use File::ExtAttr qw(:all);
52
53our $VERSION = '0.01';
54
55sub TIEHASH {
56  my($class, $file, $flags) = @_;
57  my $self = bless { file => $file }, ref $class || $class;
58  $self->{flags} = defined($flags) ? $flags : {};
59  return $self;
60}
61
62sub STORE {
63  my($self, $name, $value) = @_;
64  return undef unless setfattr($self->{file}, $name, $value, $self->{flags});
65  $value;
66}
67
68sub FETCH {
69  my($self, $name) = @_;
70  return getfattr($self->{file}, $name, $self->{flags});
71}
72
73sub FIRSTKEY {
74  my($self) = @_;
75  $self->{each_list} = [listfattr($self->{file}, $self->{flags})];
76  shift @{$self->{each_list}};
77}
78
79sub NEXTKEY {
80  my($self) = @_;
81  shift @{$self->{each_list}};
82}
83
84sub EXISTS {
85  my($self, $name) = @_;
86  return getfattr($self->{file}, $name, $self->{flags}) ne undef;
87}
88
89sub DELETE {
90  my($self, $name) = @_;
91  # XXX: Race condition
92  my $value = getfattr($self->{file}, $name, $self->{flags});
93  return $value if delfattr($self->{file}, $name, $self->{flags});
94  undef;
95}
96
97sub CLEAR {
98  my($self) = @_;
99  for(listfattr($self->{file})) {
100    delfattr($self->{file}, $_, $self->{flags});
101  }
102}
103
104#sub SCALAR { }
105
106=head1 SEE ALSO
107
108L<File::ExtAttr>
109
110=head1 AUTHOR
111
112David Leadbeater, L<http://dgl.cx/contact>
113
114Documentation by Richard Dawe, E<lt>richdawe@cpan.orgE<gt>
115
116=head1 COPYRIGHT AND LICENSE
117
118Copyright (C) 2006 by David Leadbeater
119
120This library is free software; you can redistribute it and/or modify
121it under the same terms as Perl itself, either Perl version 5.8.5 or,
122at your option, any later version of Perl 5 you may have available.
123
1241;
125__END__
126