File Coverage

blib/lib/File/Attributes/Simple.pm

Criterion	Covered	Total	%
statement	67	67	100.0
branch	2	2	100.0
condition	2	3	66.6
subroutine	14	14	100.0
pod	6	6	100.0
total	91	92	98.9

#!/usr/bin/perl
# Simple.pm
# Copyright (c) 2006 Jonathan Rockway

# see POD after __END__

package File::Attributes::Simple;
use strict;
use warnings;
use base qw(File::Attributes::Base);
use Best [ [ qw/YAML::Syck YAML/ ], qw/DumpFile LoadFile/ ];
use File::Spec;

our $VERSION = '0.04';

sub priority {
    return 1; # try something else first, eh?
}

sub applicable {
    return 1; # this module Works Everywhere, hopefully.
}

sub _load {
    my $self = shift;
    my $file = shift;
    my $attrfile = $self->_attribute_file($file);

    # throws an exception if attrfile ain't YAML (or doesn't exist, etc.)
    my $data = LoadFile($attrfile);
    return $data;
}

sub _save {
    my $self = shift;
    my $file = shift;
    my $data = shift;
    my $attrfile = $self->_attribute_file($file);

    if(!scalar keys %$data){
	unlink $attrfile;
    }
    else {
	DumpFile($attrfile, $data);
    }
}

sub list {
    my $self = shift;
    my $file = shift;
    my $data = {};

    eval {
	$data = $self->_load($file);
    };

    return keys %{$data};
}

sub get {
    my $self = shift;
    my $file = shift;
    my $attr = shift;
    my $data = $self->_load($file);

    return $data->{$attr};
}

sub set {
    my $self  = shift;
    my $file  = shift;
    my $key   = shift;
    my $value = shift;

    my $data = {};

    eval {
	$data = $self->_load($file);
    };

    $data->{$key} = $value;
    $self->_save($file, $data);
    return 1;
}

sub unset {
    my $self = shift;
    my $file = shift;
    my $key  = shift;

    my $data = {};
    eval {
	$data = $self->_load($file);
    };

    delete $data->{$key};
    $self->_save($file, $data);
    return 1;
}

sub _attribute_file {
    my $self = shift;
    my $file = shift;

    my $max = 10;
    while($max-- && -l $file){
	$file = readlink $file;
    }

    my ($volume,$dirs,$filename) = File::Spec->splitpath($file);
    return File::Spec->catpath($volume, $dirs, ".$filename.attributes");
}

__END__