File Coverage

blib/lib/File/Attributes/Recursive.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

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__