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