File::Attributes::Recursive - Inherit file attributes from parent

File-Attributes-Recursive documentation Contained in the File-Attributes-Recursive distribution.

Index

Code Index:

NAME

Top

File::Attributes::Recursive - Inherit file attributes from parent directories.

VERSION

Top

Version 0.02

SYNOPSIS

Top

Works like File::Attributes, but will recurse up the directory tree until a matching attribute is found.

EXPORT

Top

None, by default. Specify the functions you'd like to use as arguments to the module. :all means export everything.

FUNCTIONS

Top

get_attribute_recursively($file, [$top], $attribute)

Returns the value of attribute $attribute. If $top is specified, then the search will terminate when the path no longer contains $top. (i.e. if $file is /foo/bar/baz/quux and $top is

get_attributes_recursively($file, [$top])

Returns a hash of key value pairs for all attributes that apply to $file. Only the closest attributes are returned. Given:

      /a            (a = yes, foo = bar)
      /a/b          (b = yes, foo = baz)
      /a/b/c        (c = yes)

get_attributes_recursively('/a/b/c', '/a') will return:

     (a => yes, b => yes, c => yes, foo => baz).

The foo => bar is masked by the "closer" foo => baz.

list_attributes_recursively($file, [$top])

Returns a list of attributes that are defined and apply to $file. Like keys get_attributes_recursively($file, [$top]), but faster.

NOTABLY ABSENT FUNCTIONS

Top

unset_attribute_recursively

There are two possible ways for this function to behave -- either recurse until the attribute is removed, or recurse to 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 rm refuses to rm .., so I think there's some precedent here.)

AUTHOR

Top

Jonathan Rockway, <jrockway at cpan.org>

BUGS

Top

Please report any bugs or feature requests to bug-file-attributes-recursive at rt.cpan.org, or through the web interface at 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.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc File::Attributes::Recursive

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/File-Attributes-Recursive

* CPAN Ratings

http://cpanratings.perl.org/d/File-Attributes-Recursive

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=File-Attributes-Recursive

* Search CPAN

http://search.cpan.org/dist/File-Attributes-Recursive

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top

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.

File-Attributes-Recursive documentation Contained in the File-Attributes-Recursive distribution. 
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__


1; # End of File::Attributes::Recursive