File: Tie.pm

package info (click to toggle)
libfile-extattr-perl 1.09-7
  • links: PTS
  • area: main
  • in suites: forky, sid
  • size: 364 kB
  • sloc: ansic: 1,864; perl: 1,221; makefile: 42
file content (125 lines) | stat: -rw-r--r-- 2,763 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
package File::ExtAttr::Tie;

=head1 NAME

File::ExtAttr::Tie - Tie interface to extended attributes of files

=head1 SYNOPSIS

  use File::ExtAttr::Tie;
  use Data::Dumper;

  tie %a,
    "File::ExtAttr::Tie", "/Applications (Mac  OS 9)/Sherlock 2",
    { namespace => 'user' };
  print Dumper \%a;

produces:

  $VAR1 = {
           'com.apple.FinderInfo' => 'APPLfndf!?',
           'com.apple.ResourceFork' => '?p?p5I'
          };

=head1 DESCRIPTION

File::ExtAttr::Tie provides access to extended attributes of a file
through a tied hash. Creating a new key creates a new extended attribute
associated with the file. Modifying the value or removing a key likewise
modifies/removes the extended attribute.

Internally this module uses the File::ExtAttr module. So it has
the same restrictions as that module in terms of OS support.

=head1 METHODS

=over 4

=item tie "File::ExtAttr::Tie", $filename, [\%flags]

The flags are the same optional flags as in File::ExtAttr.  Any flags
given here will be passed to all operations on the tied hash.
Only the C<namespace> flag makes sense. The hash will be tied
to the default namespace, if no flags are given.

=back

=cut

use strict;
use base qw(Tie::Hash);
use File::ExtAttr qw(:all);

our $VERSION = '0.01';

sub TIEHASH {
  my($class, $file, $flags) = @_;
  my $self = bless { file => $file }, ref $class || $class;
  $self->{flags} = defined($flags) ? $flags : {};
  return $self;
}

sub STORE {
  my($self, $name, $value) = @_;
  return undef unless setfattr($self->{file}, $name, $value, $self->{flags});
  $value;
}

sub FETCH {
  my($self, $name) = @_;
  return getfattr($self->{file}, $name, $self->{flags});
}

sub FIRSTKEY {
  my($self) = @_;
  $self->{each_list} = [listfattr($self->{file}, $self->{flags})];
  shift @{$self->{each_list}};
}

sub NEXTKEY {
  my($self) = @_;
  shift @{$self->{each_list}};
}

sub EXISTS {
  my($self, $name) = @_;
  return getfattr($self->{file}, $name, $self->{flags}) ne undef;
}

sub DELETE {
  my($self, $name) = @_;
  # XXX: Race condition
  my $value = getfattr($self->{file}, $name, $self->{flags});
  return $value if delfattr($self->{file}, $name, $self->{flags});
  undef;
}

sub CLEAR {
  my($self) = @_;
  for(listfattr($self->{file})) {
    delfattr($self->{file}, $_, $self->{flags});
  }
}

#sub SCALAR { }

=head1 SEE ALSO

L<File::ExtAttr>

=head1 AUTHOR

David Leadbeater, L<http://dgl.cx/contact>

Documentation by Richard Dawe, E<lt>richdawe@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by David Leadbeater

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.

1;
__END__