#-----------------------------------------------------------------
# SADI::FileStore
# Author: Edward Kawas <edward.kawas@gmail.com>,
#
# For copyright and disclaimer see below.
#
# $Id: FileStore.pm,v 1.7 2009-09-11 15:56:41 ubuntu Exp $
#-----------------------------------------------------------------
package SADI::FileStore;
use SADI::Base;
use base ("SADI::Base");
use FindBin qw( $Bin );
use lib $Bin;
use SADI::Utils;
use Carp;
use File::Spec;
use File::Path;
use Fcntl qw( :DEFAULT :flock :mode );
use strict;

# add versioning to this module
use vars qw /$VERSION/;
$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /: (\d+)\.(\d+)/;

=head1 NAME

SADI::FileStore - A module for (add|get|delet)ing persistent data

=cut

=head1 SYNOPSIS

 use SADI::FileStore;

 # create a new blank SADI FileStore object
 my $data = SADI::FileStore->new ();
 
 # create a new primed SADI File store object
 $data = SADI::FileStore->new (
     ServiceName => "HelloWorldService",
 );
 
 # get the service name
 my $name = $data->ServiceName;
 # set the service name
 $data->ServiceName($name);

 # create a unique id
 my $uid = $data->generate_uid();
 
 # store a persistent file
 $data->add($uid,"my value");

 # get the persistent file
 $data->get($uid);

 # remove the persistent file
 $data->remove($uid);

=cut

=head1 DESCRIPTION
    
A module for creating persistent files (for use with asynchronous services)

=cut

#-----------------------------------------------------------------
# A list of allowed attribute names. See SADI::Base for details.
#-----------------------------------------------------------------

=head1 ACCESSIBLE ATTRIBUTES

Details are in L<SADI::Base>. Here just a list of them (additionally
to the attributes from the parent classes)

=over

=item B<ServiceName>

The name of the service that this FileStore will operate on

=back

=cut

=head1 SUBROUTINES

=head2 add

 # use this method to add persistent data to the store. 
 #   Given a unique identifier, $uid, and the data, $data,  
 #   this sub will store the information for you.
 # Throws an exception if there are problems writing to disk.
 #
 # You can provide any identifier (but make it unique or else 
 # existing data will be over-written). If you want to generate
 # one automatically, use C<generate_uid>.

=cut

=head2 get

 # use this method to get persistent data from the store. 
 #   Given a unique identifier, $uid, this sub will retrieve
 #   the information for you.
 # Throws an exception if there are problems retrieving the data
 # from the disk.

=cut

=head2 remove

 # use this method to remove persistent data from the store. 
 #   Given a unique identifier, $uid, this sub will remove 
 #   the persistent data from the store.
 # Throws an exception if there are problems removing the data
 # from the store.
 #
 # Also, if the service that created this store no longer has
 # data in the store, then the service directory is removed so
 # that no files are left over.

=cut

=head2 generate_uid

 # use this method to generate a unique identifier for use with C<add>. 
 #   Given an optional length for our unique identifier (defaults to 24),  
 #   a unique identifier is generated.
 # using the default length, you have a 1 in 24^6760 chance of generating
 # a duplicate uid. All uids generated are a combo of letters and numbers.

=cut

=head2 clean_store

 # use this method to clean the file store. 
 #   Given an optional age in days of files to clean (defaults to 2.00),  
 #   the file store is checked for files that meet this critia and removed.

=cut

=cut

=head1 AUTHORS, COPYRIGHT, DISCLAIMER

 Edward Kawas  (edward.kawas [at] gmail [dot] com)

Copyright (c) 2009 Edward Kawas. All Rights Reserved.

This module is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

This software is provided "as is" without warranty of any kind.

=cut
{
	my %_allowed = (

		# this is the sub dir that we store our files
		ServiceName => {
			type => SADI::Base->STRING,
			post => sub {
				my ($self) = shift;

				# escape the name
				$self->{_escaped_name} =
				  $self->_clean_servicename( $self->ServiceName );
			},
		},

		# here we clean the service name ... just in case
		_escaped_name => { type => SADI::Base->STRING, },
	);

	sub _accessible {
		my ( $self, $attr ) = @_;
		exists $_allowed{$attr} or $self->SUPER::_accessible($attr);
	}

	sub _attr_prop {
		my ( $self, $attr_name, $prop_name ) = @_;
		my $attr = $_allowed{$attr_name};
		return ref($attr) ? $attr->{$prop_name} : $attr if $attr;
		return $self->SUPER::_attr_prop( $attr_name, $prop_name );
	}
}

#-----------------------------------------------------------------
# init
#-----------------------------------------------------------------
sub init {
	my ($self) = shift;
	$self->SUPER::init();
}

# add a file to our persistent store
sub add {
	my ( $self, $id, $value ) = @_;
	$self->throw(
			   'Before you can add a data to the store, you need to set ServiceName!\n')
	  unless $self->ServiceName;
	my $async_dir = $SADICFG::ASYNC_TMP || SADI::Utils->find_file( $Bin, 'async' );
	unless ( -e File::Spec->catfile( $async_dir, $self->_escaped_name ) ) {
		unless (
				 File::Path::mkpath(
								 File::Spec->catfile( $async_dir, $self->_escaped_name )
				 )
		  )
		{
			$self->throw("add(): couldn't create directory path: $!");
		}
	}
	my $path = File::Spec->catfile( $async_dir, $self->_escaped_name, $id );

	# make certain our filehandle goes away when we fall out of scope
	local *FH;
	my $no_follow = eval { O_NOFOLLOW } || 0;
	my $mode = O_WRONLY | $no_follow;

	# kill symlinks when we spot them
	if ( -l $path ) {
		unlink($path)
		  or $self->throw(
				 "add(): '$path' appears to be a symlink and I couldn't remove it: $!");
	}
	$mode = O_RDWR | O_CREAT | O_EXCL unless -e $path;
	sysopen( FH, $path, $mode, 0660 )
	  or $self->throw("add(): couldn't open '$path': $!");

	# sanity check to make certain we're still ok
	if ( -l $path ) {
		$self->throw("add(): '$path' is a symlink, check for malicious processes");
	}

	# prevent race condition
	flock( FH, LOCK_EX )
	  or $self->throw("add(): couldn't lock '$path': $!");
	truncate( FH, 0 ) or $self->throw("add(): couldn't truncate '$path': $!");
	print FH $value;
	close(FH) or $self->throw("add(): couldn't close '$path': $!");
	return 1;
}

# remove a file from our persistent store
sub remove {
	my ( $self, $id ) = @_;

	# make sure that we have a primed FileStore first
	$self->throw(
			'Before you can remove data from the store, you need to set ServiceName!\n')
	  unless $self->ServiceName;
	my $async_dir = $SADICFG::ASYNC_TMP || SADI::Utils->find_file( $Bin, 'async' );
	my $path = File::Spec->catfile( $async_dir, $self->_escaped_name, $id );

	# remove the file if the path exists ...
	if ( -e $path ) {

		# path exists
		unlink($path) or $self->throw("Couldn't remove the file '$path'!\n");
	}

	# check if the directory is empty now ...
	if ( $self->_is_dir_empty( File::Spec->catfile( $async_dir, $self->_escaped_name ) )
	  )
	{
		File::Path::rmtree( File::Spec->catfile( $async_dir, $self->_escaped_name ) );
	}
	return 1;
}

# get a file from our persistent store
sub get {
	my ( $self, $id ) = @_;

	# make sure that we have a primed store first
	$self->throw(
		  'Before you can retrieve data from the store, you need to set ServiceName!\n')
	  unless $self->ServiceName;
	my $async_dir = $SADICFG::ASYNC_TMP || SADI::Utils->find_file( $Bin, 'async' );
	my $path = File::Spec->catfile( $async_dir, $self->_escaped_name, $id );
	return undef unless -e $path;

	# make certain our filehandle goes away when we fall out of scope
	local *FH;
	if ( -l $path ) {
		unlink($path)
		  or $self->throw(
			   "get(): '$path' appears to be a symlink and I couldn't remove it: $!\n");
	}
	my $no_follow = eval { O_NOFOLLOW } || 0;
	sysopen( FH, $path, O_RDONLY | $no_follow )
	  || return $self->set_error("retrieve(): couldn't open '$path': $!");
	flock( FH, LOCK_SH ) or $self->throw("get(): couldn't lock '$path': $!");
	my $rv = "";
	while (<FH>) {
		$rv .= $_;
	}
	close(FH);
	return $rv;
}

# TODO when should we do this? should we just allow the service provider to call this method? Should we automatically do it?
sub clean_store {
	my ( $self, $age ) = @_;
	return unless $self->ServiceName;
	$age = 2.00 unless defined $age;
	$age = 2.00 unless $age =~ m/^\s*(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?\s*$/;
	my $async_dir = $SADICFG::ASYNC_TMP || SADI::Utils->find_file( $Bin, 'async' );
	for my $eachFile (
				glob( File::Spec->catfile( $async_dir, $self->_escaped_name ) . '/*' ) )
	{
		if ( -d $eachFile ) {
			$LOG->warn(
"Encountered a directory in the file store where a file was expected! Offender: '$eachFile'\n"
			);
		} else {

			# remove the following file if the age is greater than wanted ...
			$LOG->debug("Removing '$eachFile' from store\n") if $LOG->is_debug() and -A $eachFile >= $age;
			unlink $eachFile if -A $eachFile >= $age;
		}
	}
}

sub _clean_servicename {
	my ( $self, $name ) = @_;
	$name =~ s/\W/_/g;
	return ( $name =~ /^\d/ ? "_$name" : $name );
}

sub _is_dir_empty {
	my ( $self, $path ) = @_;
	opendir DIR, $path;
	while ( my $entry = readdir DIR ) {
		next if ( $entry =~ /^\.\.?$/ );
		closedir DIR;
		return 0;
	}
	closedir DIR;
	return 1;
}

sub generate_uid {
	my ( $self, $length ) = @_;
	my $uid = "";

	# if no length, then we give a default of 24
	$length = 24 unless defined $length;

	# if length isnt numeric, then we give a default of 24
	$length = 24 unless $length =~ m/^\s*\d+\s*$/;
	while ( length($uid) != $length ) {
		my $j = chr( int( rand(127) ) );
		if ( $j =~ /[a-zA-Z0-9]/ ) {
			$uid .= $j;
		}
	}
	return $uid;
}
1;
__END__
