view release on metacpan or  search on metacpan

lib/App/Framework/Base/SearchPath.pm  view on Meta::CPAN

package App::Framework::Base::SearchPath ;

=head1 NAME

App::Framework::Base::SearchPath - Searchable path

=head1 SYNOPSIS

use App::Framework::Base::SearchPath ;


=head1 DESCRIPTION

Provides a simple searchable path under which to locate files or directories. 

When trying the read a file/dir, looks in each location in the path stopping at the first found.

When writing a file/dir, attempts to write into each location in the path until can either (a) write, or (b) runs out of search path
 

=cut

use strict ;

our $VERSION = "1.000" ;

#============================================================================================
# USES
#============================================================================================
use File::Path ;

use App::Framework::Base::Object::ErrorHandle ;


#============================================================================================
# OBJECT HIERARCHY
#============================================================================================
our @ISA = qw(App::Framework::Base::Object::ErrorHandle) ; 

#============================================================================================
# GLOBALS
#============================================================================================

=head2 FIELDS

The following fields should be defined either in the call to 'new()', as part of a 'set()' call, or called by their accessor method
(which is the same name as the field):


=over 4

=item B<dir_mask> - directory creation mask

When the write_path is searched, any directories created are created using this mask [default = 0755]

=item B<env> - environment HASH ref

Any paths that contain variables have the variables expanded using the standard environment variables. Specifying
this HASH ref causes the variables to be replaced from this HASH before looking in the envrionment.

=item B<path> - search path

A comma seperated list (in scalar context), or an ARRAY ref list of paths to be searched (for a file)

=item B<write_path> - search path for writing

A comma seperated list (in scalar context), or an ARRAY ref list of paths to be searched (for a file) when writing. If not set, then
B<path> is used.


=back

=cut


my %FIELDS = (
	# user settings
	'dir_mask'		=> 0755,
	'env'			=> {},
	
	# Object Data
	'path'			=> undef,	# dummy field - causes _path to be set
	'write_path'	=> undef,	# dummy field - casues _write_path to be set
	
	'_path'			=> [],
	'_write_path'	=> undef,
) ;



#============================================================================================

=head2 CONSTRUCTOR

=over 4

=cut

#============================================================================================

=item B< new([%args]) >

Create a new SearchPath object.

The %args are specified as they would be in the B<set> method, for example:

	'mmap_handler' => $mmap_handler

The full list of possible arguments are :

	'fields'	=> Either ARRAY list of valid field names, or HASH of field names with default values 

=cut

sub new
{
	my ($obj, %args) = @_ ;
	

lib/App/Framework/Base/SearchPath.pm  view on Meta::CPAN

				$this->_dbg_prt([" + + Write to $d/$file succeded\n"]) ;
			}
			else
			{
				$this->_dbg_prt([" + + Unable to write to $d/$file - aborting this dir\n"]) ;

				$found = 0;
			}
		}		
		
		if ($found)
		{
			$path = File::Spec->catfile($d, $file) ;
			last ;
		}
	}

	$this->_dbg_prt(["Searched $file : write path=".($path?$path:"")."\n"]) ;
	
	return $path ;
}




#============================================================================================
# PRIVATE METHODS 
#============================================================================================

#----------------------------------------------------------------------------
# get/set paths
sub _access_path
{
	my $this = shift ;
	my ($name, $path_ref) = @_ ;

	$path_ref ||= '' ;
$this->_dbg_prt(["_access_path($name, $path_ref)\n"]) ;

	if ($path_ref)
	{
		# Set new value
		my @dirs ;
		if (ref($path_ref) eq 'ARRAY')
		{
			# list
			@dirs = @$path_ref ;
		}
		else
		{
			# comma/semicolon seperated list
			@dirs = split /[,;]/, $path_ref ;
		}

$this->_dbg_prt([" + dirs=", \@dirs]) ;
$this->_dbg_prt(["this=", $this], 10) ;
		
		my $vars_href = $this->env ;
$this->_dbg_prt([" + env=", $vars_href]) ;
		
		## expand directories
		foreach my $d (@dirs)
		{
			# Replace any '~' with $HOME
			$d =~ s/~/\$HOME/g ;
			
			# Now replace any vars with values from the environment
			$d =~ s/\$(\w+)/$vars_href->{$1} || $ENV{$1} || $1/ge ;
			
			# Ensure path is clean
			$d = File::Spec->rel2abs($d) ;

$this->_dbg_prt([" + + dir=$d\n"]) ;

		}
			
		# save value
		$this->$name(\@dirs) ;		
	}

$this->_dbg_prt([" + now this=", $this], 2);

	## return latest settings
	return $this->$name() ;
}


# ============================================================================================
# END OF PACKAGE

=back

=head1 DIAGNOSTICS

Setting the debug flag to level 1 prints out (to STDOUT) some debug messages, setting it to level 2 prints out more verbose messages.

=head1 AUTHOR

Steve Price C<< <sdprice at cpan.org> >>

=head1 BUGS

None that I know of!

=cut

1;

__END__