package File::Attributes::Recursive;
use warnings;
use strict;
our $VERSION = '0.02';
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(get_attribute_recursively get_attributes_recursively
list_attributes_recursively);
our %EXPORT_TAGS = (all => \@EXPORT_OK);
use File::Attributes qw(get_attribute list_attributes);
use Path::Class;
use Cwd qw(abs_path);
use Carp;
sub get_attribute_recursively {
my $file = shift;
my $top = shift;
my $attribute = shift;
if(!defined $attribute){
$attribute = $top;
$top = '/';
}
$file = file($file)->absolute;
$top = dir($top)->absolute;
if(!$top->subsumes($file)){
croak "get_attribute_recursively: filename ($file) must ".
"contain top ($top)";
}
my $result;
while($top->subsumes($file)){
eval {
$result = get_attribute($file, $attribute);
};
last if defined $result;
$file = $file->parent;
}
return $result;
}
sub get_attributes_recursively {
my $file = shift;
my $top = shift;
$top = '/' if !defined $top;
$file = file($file)->absolute;
$top = dir($top)->absolute;
if(!$top->subsumes($file)){
croak "get_attributes_recursively: filename ($file) must ".
"contain top ($top)";
}
my %result;
while($top->subsumes($file)){
my @attributes = list_attributes($file);
foreach my $attribute (@attributes){
next if exists $result{$attribute};
eval {
$result{$attribute} = get_attribute($file, $attribute);
};
}
$file = $file->parent;
}
return %result;
}
sub list_attributes_recursively {
my $file = shift;
my $top = shift;
$top = '/' if !defined $top;
$file = file($file)->absolute;
$top = dir($top)->absolute;
if(!$top->subsumes($file)){
croak "get_attributes_recursively: filename ($file) must ".
"contain top ($top)";
}
my %results;
while($top->subsumes($file)){
eval {
my @subresults = list_attributes($file);
@results{@subresults} = @subresults;
};
$file = $file->parent;
}
return keys %results;
}
__END__
=head1 NAME
File::Attributes::Recursive - Inherit file attributes from parent
directories.
=head1 VERSION
Version 0.02
=head1 SYNOPSIS
Works like C<File::Attributes>, but will recurse up the directory tree
until a matching attribute is found.
=head1 EXPORT
None, by default. Specify the functions you'd like to use as
arguments to the module. C<:all> means export everything.
=head1 FUNCTIONS
=head2 get_attribute_recursively($file, [$top], $attribute)
Returns the value of attribute C<$attribute>. If C<$top> is
specified, then the search will terminate when the path no longer
contains C<$top>. (i.e. if C<$file> is C</foo/bar/baz/quux> and C<$top> is
=head2 get_attributes_recursively($file, [$top])
Returns a hash of key value pairs for all attributes that apply to
C<$file>. Only the closest attributes are returned. Given:
/a (a = yes, foo = bar)
/a/b (b = yes, foo = baz)
/a/b/c (c = yes)
C<get_attributes_recursively('/a/b/c', '/a')> will return:
(a => yes, b => yes, c => yes, foo => baz).
The C<< foo => bar >> is masked by the "closer" C<< foo => baz >>.
=head2 list_attributes_recursively($file, [$top])
Returns a list of attributes that are defined and apply to C<$file>.
Like C<keys get_attributes_recursively($file, [$top])>, but faster.
=head1 NOTABLY ABSENT FUNCTIONS
=head2 unset_attribute_recursively
There are two possible ways for this function to behave -- either
recurse until the attribute is removed, or recurse to C<top>, removing
the attribute at each level. The first doesn't make sense, and the
second is dangerous. If you need this function, write it for the
specific needs of your application; I think that's the safest thing to
do.
(Note that C<rm> refuses to C<rm ..>, so I think there's some
precedent here.)
=head1 AUTHOR
Jonathan Rockway, C<< <jrockway at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to
C<bug-file-attributes-recursive at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-Attributes-Recursive>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc File::Attributes::Recursive
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/File-Attributes-Recursive>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/File-Attributes-Recursive>
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Attributes-Recursive>
=item * Search CPAN
L<http://search.cpan.org/dist/File-Attributes-Recursive>
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2006 Jonathan Rockway, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of File::Attributes::Recursive