You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
390 lines
11 KiB
390 lines
11 KiB
package AN::Tools::Storage; |
|
# |
|
# This module contains methods used to handle storage related tasks |
|
# |
|
|
|
use strict; |
|
use warnings; |
|
use Data::Dumper; |
|
|
|
our $VERSION = "3.0.0"; |
|
my $THIS_FILE = "Storage.pm"; |
|
|
|
### Methods; |
|
# find |
|
# read_config |
|
# search_directories |
|
|
|
=pod |
|
|
|
=encoding utf8 |
|
|
|
=head1 NAME |
|
|
|
AN::Tools::Storage |
|
|
|
Provides all methods related to storage on a system. |
|
|
|
=head1 SYNOPSIS |
|
|
|
use AN::Tools; |
|
|
|
# Get a common object handle on all AN::Tools modules. |
|
my $an = AN::Tools->new(); |
|
|
|
# Access to methods using '$an->Storage->X'. |
|
# |
|
# Example using 'find()'; |
|
my $foo_path = $an->Storage->find({file => "foo"}); |
|
|
|
=head1 METHODS |
|
|
|
Methods in this module; |
|
|
|
=cut |
|
sub new |
|
{ |
|
my $class = shift; |
|
my $self = { |
|
SEARCH_DIRECTORIES => \@INC, |
|
}; |
|
|
|
bless $self, $class; |
|
|
|
return ($self); |
|
} |
|
|
|
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more |
|
# sense in this case to think of it as a parent. |
|
sub parent |
|
{ |
|
my $self = shift; |
|
my $parent = shift; |
|
|
|
$self->{HANDLE}{TOOLS} = $parent if $parent; |
|
|
|
return ($self->{HANDLE}{TOOLS}); |
|
} |
|
|
|
|
|
############################################################################################################# |
|
# Public methods # |
|
############################################################################################################# |
|
|
|
|
|
=head2 find |
|
|
|
This searches for the given file on the system. It will search in the directories returned by C<< $an->Storage->search_directories() >>. |
|
|
|
Example to search for 'C<< foo >>'; |
|
|
|
$an->Storage->find({file => "foo"}); |
|
|
|
Same, but error out if the file isn't found. |
|
|
|
$an->Storage->find({ |
|
file => "foo", |
|
fatal => 1, |
|
}); |
|
|
|
If it fails to find the file and C<< fatal >> isn't set to 'C<< 1 >>', 'C<< 0 >>' is returned. |
|
|
|
Parameters; |
|
|
|
=head3 fatal (optional) |
|
|
|
This can be set to 'C<< 1 >>' to tell the method to throw an error and exit if the file is not found. Default is 'C<< 0 >>' which only triggers a warning of the file isn't found. |
|
|
|
=head3 file (required) |
|
|
|
This is the name of the file to search for. |
|
|
|
=cut |
|
sub find |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
# Setup default values |
|
my $fatal = defined $parameter->{fatal} ? $parameter->{fatal} : 0; |
|
my $file = defined $parameter->{file} ? $parameter->{file} : ""; |
|
|
|
# Each full path and file name will be stored here before the test. |
|
my $full_path = "#!not_found!#"; |
|
foreach my $directory (@{$an->Storage->search_directories()}) |
|
{ |
|
# If "directory" is ".", expand it. |
|
if (($directory eq ".") && ($ENV{PWD})) |
|
{ |
|
$directory = $ENV{PWD}; |
|
} |
|
|
|
# Put together the initial path |
|
my $test_path = $directory."/".$file; |
|
|
|
# Clear double-delimiters. |
|
$test_path =~ s/\/+/\//g; |
|
|
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - Test path: [$test_path] - "; |
|
if (-f $test_path) |
|
{ |
|
# Found it! |
|
#print "Found!\n"; |
|
$full_path = $test_path; |
|
last; |
|
} |
|
else |
|
{ |
|
#print "Not found...\n"; |
|
} |
|
} |
|
|
|
# Die if we didn't find the file and fatal is set. |
|
if ($full_path !~ /^\//) |
|
{ |
|
if ($fatal) |
|
{ |
|
### TODO: Make this $an->Alert->error() later |
|
print $THIS_FILE." ".__LINE__."; [ Error ] - Failed to find: [$file].\n"; |
|
} |
|
else |
|
{ |
|
### TODO: Make this $an->Alert->warning() later |
|
print $THIS_FILE." ".__LINE__."; [ Warning ] - Failed to find: [$file].\n"; |
|
} |
|
if ($fatal) |
|
{ |
|
print "Exiting on errors.\n"; |
|
exit(2); |
|
} |
|
} |
|
|
|
# Return |
|
return ($full_path); |
|
} |
|
|
|
=head2 read_config |
|
|
|
This method is used to read 'AN::Tools' style configuration files. These configuration files are in the format: |
|
|
|
# This is a comment for the 'a::b::c' variable |
|
a::b::c = x |
|
|
|
A configuration file can be read in like this; |
|
|
|
$an->Storage->read_config({file => "test.conf"}); |
|
|
|
In this example, the file 'C<< test.conf >>' will be searched for in the directories returned by 'C<< $an->Storage->search_directories >>'. |
|
|
|
Any line starting with '#' is a comment and is ignored. Preceding white spaces are allowed and also ignored. |
|
|
|
Any line in the format 'x = y' is treated as a variable / value pair, split on the first 'C<< = >>'. Whitespaces on either side of the 'C<< = >>' are removed and ignored. However, anything after the first non-whitespace character is treated as data an unmolested. This includes addition 'C<< = >>' characters, white spaces and so on. The exception is that trailing white spaces are cropped and ignored. If nothing comes after the 'C<< = >>', the variable is set to a blank string. |
|
|
|
Successful read will return 'C<< 0 >>'. Non-0 is an error; |
|
C<< 0 >> = OK |
|
C<< 1 >> = Invalid or missing file name |
|
C<< 2 >> = File not found |
|
C<< 3 >> = File not readable |
|
|
|
Parameters; |
|
|
|
=head3 file (required) |
|
|
|
This is the configuration file to read. |
|
|
|
If the 'C<< file >>' parameter starts with 'C<< / >>', the exact path to the file is used. Otherwise, this method will search for the file in the list of directories returned by 'C<< $an->Storage->search_directories >>'. The first match is read in. |
|
|
|
All variables are stored in the root of 'C<< $an->data >>', allowing for configuration files to override internally set variables. |
|
|
|
For example, if you set: |
|
|
|
$an->data->{a}{b}{c} = "1"; |
|
|
|
Then you read in a config file with: |
|
|
|
a::b::c = x |
|
|
|
Then 'C<< $an->data->{a}{b}{c} >>' will now contain 'C<< x >>'. |
|
|
|
=cut |
|
sub read_config |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
# Setup default values |
|
my $file = defined $parameter->{file} ? $parameter->{file} : 0; |
|
my $return_code = 0; |
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - file: [$file].\n"; |
|
|
|
if (not $file) |
|
{ |
|
# TODO: Log the problem, do not translate. |
|
print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' called without a file name to read.\n"; |
|
$return_code = 1; |
|
} |
|
|
|
# If I have a file name that isn't a full path, find it. |
|
if (($file) && ($file !~ /^\//)) |
|
{ |
|
# Find the file, if possible. If not found, we'll not alter what the user passed in and hope |
|
# it is relative to where we are. |
|
my $path = $an->Storage->find({ file => $file }); |
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - path: [$path].\n"; |
|
if ($path ne "#!not_found!#") |
|
{ |
|
# Update the file |
|
$file = $path; |
|
#print $THIS_FILE." ".__LINE__."; [ Debug ] - file: [$file].\n"; |
|
} |
|
} |
|
|
|
if ($file) |
|
{ |
|
if (not -e $file) |
|
{ |
|
# TODO: Log the problem, do not translate. |
|
print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' asked to read: [$file] which was not found.\n"; |
|
$return_code = 2; |
|
} |
|
elsif (not -r $file) |
|
{ |
|
# TODO: Log the problem, do not translate. |
|
print $THIS_FILE." ".__LINE__."; [ Warning ] - AN::Tools::Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."/".getpwuid($>)."] (uid/euid: [".$<."/".$>."]).\n"; |
|
$return_code = 3; |
|
} |
|
else |
|
{ |
|
# Read it in! |
|
my $count = 0; |
|
open (my $file_handle, "<$file") or die "Can't read: [$file], error was: $!\n"; |
|
while (<$file_handle>) |
|
{ |
|
chomp; |
|
my $line = $_; |
|
$line =~ s/^\s+//; |
|
$line =~ s/\s+$//; |
|
$count++; |
|
next if ((not $line) or ($line =~ /^#/)); |
|
next if $line !~ /=/; |
|
my ($variable, $value) = split/=/, $line, 2; |
|
$variable =~ s/\s+$//; |
|
$value =~ s/^\s+//; |
|
if (not $variable) |
|
{ |
|
print $THIS_FILE." ".__LINE__."; [ Warning ] - The config file: [$file] appears to have a malformed line: [$count:$line].\n"; |
|
} |
|
|
|
$an->_make_hash_reference($an->data, $variable, $value); |
|
} |
|
close $file_handle; |
|
} |
|
} |
|
|
|
return($return_code); |
|
} |
|
|
|
=head2 search_directories |
|
|
|
This method returns an array reference of directories to search within for files and directories. |
|
|
|
Parameters; |
|
|
|
=head3 directories (optional) |
|
|
|
This accepts either an array reference of directories to search, or a comma-separated string of directories to search (which will be converted to an array). When passed, this sets the internal list of directories to search. |
|
|
|
By default, it is set to all directories in C<< @INC >>, 'C<< path::directories::tools >> (our tools) and the C<< $ENV{'PATH'} >> variables, minus directories that don't actually exist. The returned array is sorted alphabetically. |
|
|
|
=head3 initialize (optional) |
|
|
|
If this is set, the list of directories to search will be set to 'C<< @INC >>' + 'C<< $ENV{'PATH'} >>' + 'C<< path::directories::tools >>'. |
|
|
|
NOTE: You don't need to call this manually unless you want to reset the list. Invoking AN::Tools->new() causes this to be called automatically. |
|
|
|
=cut |
|
sub search_directories |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
# Set a default if nothing was passed. |
|
my $array = defined $parameter->{directories} ? $parameter->{directories} : ""; |
|
my $initialize = defined $parameter->{initialize} ? $parameter->{initialize} : ""; |
|
|
|
# If the array is a CSV of directories, convert it now. |
|
if ($array =~ /,/) |
|
{ |
|
# CSV, convert to an array. |
|
my @new_array = split/,/, $array; |
|
$array = \@new_array; |
|
} |
|
elsif (($initialize) or (($array) && (ref($array) ne "ARRAY"))) |
|
{ |
|
if (not $initialize) |
|
{ |
|
# TODO: Make this a $an->Alert->warning(). |
|
print $THIS_FILE." ".__LINE__."; [ Warning ] - The passed in array: [$array] wasn't actually an array. Using \@INC + \$ENV{'PATH'} for the list of directories to search instead.\n"; |
|
} |
|
|
|
# Create a new array containing the '$ENV{'PATH'}' directories and the @INC directories. |
|
my @new_array = split/:/, $ENV{'PATH'} if $ENV{'PATH'} =~ /:/; |
|
foreach my $directory (@INC) |
|
{ |
|
push @new_array, $directory; |
|
} |
|
|
|
# Add the tools directory |
|
push @new_array, $an->data->{path}{directories}{tools}; |
|
$array = \@new_array; |
|
} |
|
|
|
# Store the new array, if set. |
|
if (ref($array) eq "ARRAY") |
|
{ |
|
# Dedupe and sort. |
|
my $sorted_array = []; |
|
my $seen_directories = {}; |
|
foreach my $directory (sort {$a cmp $b} @{$array}) |
|
{ |
|
next if not defined $directory; |
|
|
|
# Convert '.' to $ENV{PWD} |
|
if ($directory eq ".") |
|
{ |
|
$directory = $ENV{PWD}; |
|
} |
|
|
|
# Skip duplicates |
|
next if exists $seen_directories->{$directory}; |
|
|
|
# Skip non-existent directories |
|
next if not -d $directory; |
|
|
|
# Record this directory. |
|
$seen_directories->{$directory} = 1; |
|
push @{$sorted_array}, $directory; |
|
} |
|
$array = $sorted_array; |
|
|
|
$self->{SEARCH_DIRECTORIES} = $array; |
|
} |
|
|
|
return ($self->{SEARCH_DIRECTORIES}); |
|
} |
|
|
|
|
|
# =head3 |
|
# |
|
# Private Functions; |
|
# |
|
# =cut |
|
|
|
############################################################################################################# |
|
# Private functions # |
|
############################################################################################################# |
|
|
|
1;
|
|
|