File Coverage

blib/lib/File/Attributes.pm

Criterion	Covered	Total	%
statement	69	72	95.8
branch	9	12	75.0
condition	2	3	66.6
subroutine	18	18	100.0
pod	7	7	100.0
total	105	112	93.7

package File::Attributes;

# please see POD after __END__

use warnings;
use strict;
use Carp;
our $VERSION = '0.04';

# modules that we require
use Module::Pluggable ( search_path => 'File::Attributes',
		        instantiate => 'new' );

# exporting business
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = ();
our @EXPORT_OK   = qw(set_attribute   set_attributes
		      get_attribute   get_attributes
		      unset_attribute unset_attributes
		      list_attributes);
our %EXPORT_TAGS = (all => [@EXPORT_OK]);

# internal variables
my @modules; # the modules to call, in order

sub _foreach_plugin(@&){
    my @args = @_;
    my $file = $args[0];
    my $code = pop @args;

    croak "$file does not exist" if !-e $file;

    foreach my $plugin (@modules){
	next if !$plugin->applicable($file);
	my @result = $code->($plugin, @args);
	if(@result){
	    return @result if wantarray;
	    return $result[0];
	}
    }
}

sub set_attribute {
    _foreach_plugin @_, sub { my $p = shift; $p->set(@_) };
    return;
}

sub set_attributes {
    my $file  = shift;
    my $first = shift;

    # if someone passes a hashref instead, handle that nicely
    my %attributes;
    if(ref $first){
	%attributes = %{$first};
    }
    else {
	%attributes = ($first, @_);
    }

    foreach my $key (keys %attributes){
	set_attribute($file, $key, $attributes{$key});
    }
}

sub get_attribute {
    return _foreach_plugin @_, sub { my $p = shift; $p->get(@_) };
}

sub get_attributes {
    my $file = shift;
    my @attributes = list_attributes($file);
    my %result;
    foreach my $attribute (@attributes){
	$result{$attribute} = get_attribute($file, $attribute);
    }
    return %result;
}

sub unset_attribute {
    _foreach_plugin @_,
      sub { my $p = shift;
	    $p->unset(@_);
	    return; # force unset on all plugins
	};
    return;
}

sub unset_attributes {
    my $file = shift;
    my @attributes = @_;
    foreach my $attribute (@attributes){
	unset_attribute($file, $attribute);
    }
    return;
}

sub list_attributes {
    my @result;
    _foreach_plugin @_,
      sub {
	  my $p = shift;
	  push @result, $p->list(@_);
	  return; # force examination of all plugins
      };
    my %result = map { $_ => 1 } @result; # filter out dupes
    return keys %result;
}

sub _init {
    my $simple;
    foreach my $plugin (plugins()){
	eval {
	    push @modules, $plugin
	      if $plugin->isa('File::Attributes::Base') &&
		$plugin->priority > 0;
	};
    }

    # sort from highest priority to lowest
    @modules = reverse sort {$a->priority <=> $b->priority} @modules;

    return scalar @modules;
}

sub _modules {
    return map {/(.+)=[A-Z]+/; $1;} @modules;
}

return _init(); # returns true if the module can be used
__END__