package DFA::Set::File;

use strict;
use vars qw($VERSION @ISA);


use Carp;
use DFA::Set;
use File::Path;
use File::Spec;
use IO::File;

$VERSION = '0.01';
@ISA=qw(DFA::Set);


#####################################################################
sub new
{
    my($package, %params)=@_;
    my $self=$package->SUPER::new(%params);
    croak "Please to be including Directory parameter to $package->new"
            unless $self->{Directory};

    my @todo;
    push @todo, $self->{Directory};

    foreach my $s (keys %{$self->{States}}) {
        push @todo, File::Spec->catfile($self->{Directory}, $s);
    }

    my $perm=$self->{Perm}||0700;
    foreach my $path (@todo) {
        croak "$path exists but is not a directory!"
            if -e $path and not -d _;
        next if -d _;
        mkpath [$path], 0, $perm;
    }
    return $self;
}

#####################################################################
sub add
{
    my($self, $name, $obj, $state)=@_;
    $self->SUPER::add($name, $obj, $state);

    my $fd=$self->open_fd(">", $name, $state);
    $fd->print($obj);

    return;
}

sub open_fd
{
    my($self, $mode, $name, $state)=@_;

    $state||=$self->find_state($name);
    return unless $state;
    my $file=File::Spec->catfile($self->{Directory}, $state, $name);

    my $fd=IO::File->new($mode.$file);
    return $fd;
}

#####################################################################
sub remove
{
    my($self, $name, $state)=@_;
    $state||=$self->find_state($name);
    croak "Can't remove unknown object $name" unless $state;
    my $file=File::Spec->catfile($self->{Directory}, $state, $name);
    croak "Can't remove unknown object $name" unless -f $file;
    unlink $file 
            or die "Unable to remove $file: $!\n";
    return;
}

#####################################################################
sub find_state
{
    my($self, $name)=@_;
    my $file;
    foreach my $state (keys %{$self->{States}}) {   # look in all states
        $file=File::Spec->catfile($self->{Directory}, $state, $name);
        return $state if -f $file;                  # for a file named $name
    }
    return;
}

#####################################################################
sub find_payload
{
    my($self, $name, $state)=@_;
    $state||=$self->find_state($name);
    return unless $state;
    my $fd=$self->open_fd("<", $name, $state);      # read entire object
    local $/;                                       # at once
    return <$fd>;
}

#####################################################################
sub list
{
    my($self, $state)=@_;

    my $dir=File::Spec->catfile($self->{Directory}, $state);
    opendir DIR, $dir or die "Unable to open $dir: $!\n";

    # only real files are objects
    my @names=grep {-f File::Spec->catfile($dir, $_)} readdir DIR;
    closedir DIR;
    return @names;
}

#####################################################################
sub transition
{
    my($self, $name, $newstate)=@_;

    # find_state is expensive... only do it once by not calling SUPER::transition
    my $state=$self->find_state($name);
    croak "Transitioning object to unknown state $state" 
                    unless exists $self->{States}{$newstate};
    croak "Illegal state transition $state -> $newstate"
        unless $self->{States}{$state}{transition}{$newstate};

    my $old=File::Spec->catfile($self->{Directory}, $state, $name);
    my $new=File::Spec->catfile($self->{Directory}, $newstate, $name);
    # rename is atomic on unix systems... right?  right?
    rename $old, $new or die "Unable to transition $name to $newstate: $!\n";
    return ($self->{Terminal} and $self->{Terminal} eq $newstate);
}

1;

__END__

# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

DFA::Set::File - DFA implemented on the filesystem

=head1 SYNOPSIS

    use DFA::Set::File;
    $dfa=DFA::Set::File->new(
        Directory=>"$ENV{HOME}/Maildir",
        States=>{
            cur=>[],
            tmp=>[qw(new)],
            new=>[qw(cur)],
        }, 
        Terminal=>'cur');

    my $unique="12341234123.foo.com"
    $fd=$dfa->open_fd(">", $unique, "tmp");
    eval {
        # read $data from somewhere
        $fd->print($data);
    };
    $fd->close;
    if($@) {
        $dfa->remove($unique);
        die $@;
    }

    $dfa->transition($unique, 'new');


=head1 DESCRIPTION


DFA::Set::File is an implementation of DFA::Set that uses files and
directories to make sure that transitions are atomic.  This has the
advantage of never being able to loose information if the program crashes
unexpectedly (unless the filesystem crashes, in which case there's not much
you can do).

An example of an application that uses this approche is qmail with Maildirs.
New mail is crated in a 'tmp' state.  Then moved to a 'new' state.  After it
has been looked at once, it is moved to a 'cur' state.

DFA::Set::File uses File::Spec to create pathnames.  This allows it to be as
portable as possible.


=head1 METHODS

All methods work as documented in C<DFA::Set>, with a few extenstions and
caveats detailed here.


=head2 new

    my $dfa=DFA::Set::File->new(..., Directory=>$dir, ...);

Each state is it's own directory.  All directories are created under the one 
specified via the C<Directory> parameter.  All directories are created at
instansiation time.  If they can't be created, C<new> will croak.


=head2 add

    $dfa->add($name, $payload, $state);

Creates a file and writes $payload to it.  This means that $payload MUST be
a scalar and not a reference.  Serialisation is left as an excercise to the
caller.


=head2 open_fd

    my $fd=$dfa->open_fd($mode, $name[, $state]);

Opens the file of the token $name and returns a C<IO::File> object.  While
this breaks strict OO, it allows you to receive and save data as robustly as
possible.  Otherwise, you would have to save all data into memory, then use
add() to write to the file.  That wouldn't be as safe.

See C<IO::File> for details.

=head2 remove

    $dfa->remove($name[, $state]);

Uses C<unlink> to remove the token from the filesystem.  Because
C<find_state> is relatively expensive, you can specify C<$state>.  However,
if the token moved and you didn't know it, this method will croak.

=head2 list

    @names=$dfa->list($state);

This function returns all the tokens in a given state.  This could be useful
for cronjobs to get a list of tokens to process as a batch.

Uses C<opendir/readdir/closedir> so it's relatively expensive.

=head2 transition

    $dfa->transition($name, $newstate);

Uses C<rename> to move token C<$name> from it's current state to
C<$newstate>.  Because C<rename> is an atomic operation on most useful
systems, the token should never be lost.  Barring catastrphic filesystem
corruption, that is.



=head2 find_state

    my $state=$dfa->find_state($name);

Returns the state that the token C<$name> is in.  

Relatively expensive operation, however.


=head2 find_payload

    my $payload=$dfa->find_payload($name[, $state]);

Returns the payload of token C<$name>.  Because C<find_state> is relatively
expensive, you can specify C<$state>.  However, if the token moved and you
didn't know it, this method will croak.


=head1 AUTHOR

Philip Gwyn <cpan at pied.nu>

=head1 SEE ALSO

DFA::Set, DFA::Set::Memory, perl(1).

=cut