#!/usr/bin/perl
# Simple.pm
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>
# 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__
=head1 NAME
File::Attributes::Simple - the simplest implementation of File::Attributes
=head1 SYNOPSIS
This is the fallback for File::Attributes if it can't find anything
better. It stores attributes as YAML files (named
.filename.attributes) containing key/value pairs.
You probably shouldn't use this class directly, see
L<File::Attributes> instead.
=head1 METHODS
All the standard ones, namely:
=head2 get
=head2 set
=head2 unset
=head2 list
=head2 applicable
Applicable for every file.
=head2 priority
Priority 1 (low).
=head1 EXTENDING
If you want to implement a file attribute scheme, and can do so doing
hashrefs, this class might make your life easier. Simply subclass
C<File::Attributes::Simple> (this class), and override the following
(private) methods:
=over 4
=item _attribute_file($filename)
If you just want the attributes to be stored somewhere else, override
this method. It takes a filename and returns the filename that stores
the attributes. If you override _load and _save, you don't need to
worry about this method; it isn't called from anywhere else.
=item _load($filename)
This method takes a filename and returns the hash(ref) of attributes.
=item _save($filename, \%attributes)
This method takes a filename and the attributes hashref and stores it
to disk (or wherever, the method doesn't care if it's a disk or not).
=back
I think OS X uses a format for storing filesystem attributes that
could be implemented by overriding this class, but I don't have a Mac
and couldn't find any documentation.
=cut
=head1 BUGS
See bug reporting instructions in L<File::Attributes/BUGS>.
=head1 AUTHOR
Jonathan Rockway C<< <jrockway at cpan.org> >>
syntax highlighted by Code2HTML, v. 0.9.1