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.
904 lines
26 KiB
904 lines
26 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; |
|
# change_mode |
|
# change_owner |
|
# copy_file |
|
# find |
|
# make_directory |
|
# read_config |
|
# read_file |
|
# search_directories |
|
# write_file |
|
|
|
=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 change_mode |
|
|
|
This changes the mode of a file or directory. |
|
|
|
$an->Storage->change_mode({target => "/tmp/foo", mode => "0644"}); |
|
|
|
If it fails to write the file, an alert will be logged. |
|
|
|
Parameters; |
|
|
|
=head3 target (required) |
|
|
|
This is the file or directory to change the mode on. |
|
|
|
=head3 mode (required) |
|
|
|
This is the numeric mode to set on the file. It expects four digits to cover the sticky bit, but will work with three digits. |
|
|
|
=cut |
|
sub change_mode |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
my $target = defined $parameter->{target} ? $parameter->{target} : ""; |
|
my $mode = defined $parameter->{mode} ? $parameter->{mode} : ""; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
target => $target, |
|
mode => $mode, |
|
}}); |
|
|
|
my $error = 0; |
|
if (not $target) |
|
{ |
|
# No target... |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0036"}); |
|
$error = 1; |
|
} |
|
if (not $mode) |
|
{ |
|
# No mode... |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0037"}); |
|
$error = 1; |
|
} |
|
elsif (($mode !~ /^\d\d\d$/) && ($mode !~ /^\d\d\d\d$/)) |
|
{ |
|
# Invalid mode |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0038", variables => { mode => $mode }}); |
|
$error = 1; |
|
} |
|
|
|
if (not $error) |
|
{ |
|
my $shell_call = $an->data->{path}{exe}{'chmod'}." $mode $target"; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0011", variables => { shell_call => $shell_call }}); |
|
open (my $file_handle, $shell_call." 2>&1 |") or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }}); |
|
while(<$file_handle>) |
|
{ |
|
chomp; |
|
my $line = $_; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }}); |
|
} |
|
close $file_handle; |
|
} |
|
|
|
return(0); |
|
} |
|
|
|
=head2 change_owner |
|
|
|
This changes the owner and/or group of a file or directory. |
|
|
|
$an->Storage->change_owner({target => "/tmp/foo", mode => "0644"}); |
|
|
|
If it fails to write the file, an alert will be logged. |
|
|
|
Parameters; |
|
|
|
=head3 target (required) |
|
|
|
This is the file or directory to change the mode on. |
|
|
|
=head3 group (optional) |
|
|
|
This is the group name or UID to set the target to. |
|
|
|
=head3 user (optional) |
|
|
|
This is the user name or UID to set the target to. |
|
|
|
=cut |
|
sub change_owner |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
my $target = defined $parameter->{target} ? $parameter->{target} : ""; |
|
my $group = defined $parameter->{group} ? $parameter->{group} : ""; |
|
my $user = defined $parameter->{user} ? $parameter->{user} : ""; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
target => $target, |
|
group => $group, |
|
user => $user, |
|
}}); |
|
|
|
# Make sure the user and group and just one digit or word. |
|
$user =~ s/^(\S+)\s.*$/$1/; |
|
$group =~ s/^(\S+)\s.*$/$1/; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
group => $group, |
|
user => $user, |
|
}}); |
|
|
|
# If the group is a series of digits, remove all but the first. |
|
if (defined $group) |
|
{ |
|
} |
|
|
|
my $string = ""; |
|
my $error = 0; |
|
if (not $target) |
|
{ |
|
# No target... |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0039"}); |
|
$error = 1; |
|
} |
|
|
|
if (defined $user) |
|
{ |
|
$string = $user; |
|
} |
|
if (defined $group) |
|
{ |
|
$string .= ":".$group; |
|
} |
|
|
|
if ((not $error) && ($string)) |
|
{ |
|
my $shell_call = $an->data->{path}{exe}{'chown'}." $string $target"; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0011", variables => { shell_call => $shell_call }}); |
|
open (my $file_handle, $shell_call." 2>&1 |") or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }}); |
|
while(<$file_handle>) |
|
{ |
|
chomp; |
|
my $line = $_; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }}); |
|
} |
|
close $file_handle; |
|
} |
|
|
|
return(0); |
|
} |
|
|
|
=head2 copy_file |
|
|
|
This copies a file, with a few additional checks like creating the target directory if it doesn't exist, aborting if the file has already been backed up before, etc. |
|
|
|
# Example |
|
$an->Storage->copy_file({source => "/some/file", target => "/another/directory/file"}); |
|
|
|
Parameters; |
|
|
|
=head3 overwrite (optional) |
|
|
|
If this is set to 'C<< 1 >>', and if the target file exists, it will be replaced. |
|
|
|
If this is not passed and the target exists, this module will return 'C<< 3 >>'. |
|
|
|
=head3 source (required) |
|
|
|
This is the source file. if it doesn't exist, this method will return 'C<< 1 >>'. |
|
|
|
=head3 target (required) |
|
|
|
This is the target *B<file>*, not the directory to put it in. The target file name can be different from the source file name. |
|
|
|
if this is not specified, 'C<< 2 >>' will be returned. |
|
|
|
=cut |
|
sub copy_file |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
my $overwrite = defined $parameter->{overwrite} ? $parameter->{overwrite} : 0; |
|
my $source = defined $parameter->{source} ? $parameter->{source} : ""; |
|
my $target = defined $parameter->{target} ? $parameter->{target} : ""; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
overwrite => $overwrite, |
|
source => $source, |
|
target => $target, |
|
}}); |
|
|
|
if (not $source) |
|
{ |
|
# No source passed. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0044"}); |
|
return(1); |
|
} |
|
if (not $target) |
|
{ |
|
# No target passed. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0045"}); |
|
return(2); |
|
} |
|
|
|
# If the target exists, abort |
|
if ((-e $target) && (not $overwrite)) |
|
{ |
|
# This isn't an error. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0046", variables => { |
|
source => $source, |
|
target => $target, |
|
}}); |
|
return(3); |
|
} |
|
|
|
# Make sure the target directory exists and create it, if not. |
|
my ($directory, $file) = ($target =~ /^(.*)\/(.*)$/); |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
directory => $directory, |
|
file => $file, |
|
}}); |
|
if (not -e $directory) |
|
{ |
|
$an->Storage->make_directory({ |
|
directory => $directory, |
|
group => $(, # Real UID |
|
user => $<, # Real GID |
|
mode => "0750", |
|
}); |
|
} |
|
|
|
# Now backup the file. |
|
my $output = $an->System->call({shell_call => $an->data->{path}{exe}{'cp'}." -af $source $target"}); |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }}); |
|
|
|
return(0); |
|
} |
|
|
|
=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 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; |
|
|
|
# WARNING: Don't call Log from here! It causes it to abort |
|
my $debug = 0; |
|
my $file = defined $parameter->{file} ? $parameter->{file} : ""; |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - file: [$file]\n" if $debug; |
|
|
|
# Each full path and file name will be stored here before the test. |
|
my $full_path = "#!not_found!#"; |
|
if ($file) |
|
{ |
|
foreach my $directory (@{$an->Storage->search_directories()}) |
|
{ |
|
# If "directory" is ".", expand it. |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - >> directory: [$directory]\n" if $debug; |
|
if (($directory eq ".") && ($ENV{PWD})) |
|
{ |
|
$directory = $ENV{PWD}; |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - << directory: [$directory]\n" if $debug; |
|
} |
|
|
|
# Put together the initial path |
|
my $test_path = $directory."/".$file; |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - >> test_path: [$test_path]\n" if $debug; |
|
|
|
# Clear double-delimiters. |
|
$test_path =~ s/\/+/\//g; |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - << test_path: [$test_path]\n" if $debug; |
|
if (-f $test_path) |
|
{ |
|
# Found it! |
|
$full_path = $test_path; |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - >> full_path: [$full_path]\n" if $debug; |
|
last; |
|
} |
|
} |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - << full_path: [$full_path]\n" if $debug; |
|
} |
|
|
|
# Return |
|
print $THIS_FILE." ".__LINE__."; [ Debug] - full_path: [$full_path]\n" if $debug; |
|
return ($full_path); |
|
} |
|
|
|
=head2 make_directory |
|
|
|
This creates a directory (and any parent directories). |
|
|
|
$an->Storage->make_directory({directory => "/foo/bar/baz", owner => "me", grou[ => "me", group => 755}); |
|
|
|
If it fails to create the directory, an alert will be logged. |
|
|
|
Parameters; |
|
|
|
=head3 directory (required) |
|
|
|
This is the name of the directory to create. |
|
|
|
=head3 group (optional) |
|
|
|
This is the group name or group ID to set the ownership of the directory to. |
|
|
|
=head3 mode (optional) |
|
|
|
This is the numeric mode to set on the file. It expects four digits to cover the sticky bit, but will work with three digits. |
|
|
|
=head3 user (optional) |
|
|
|
This is the user name or user ID to set the ownership of the directory to. |
|
|
|
=cut |
|
sub make_directory |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
my $directory = defined $parameter->{directory} ? $parameter->{directory} : ""; |
|
my $group = defined $parameter->{group} ? $parameter->{group} : ""; |
|
my $mode = defined $parameter->{mode} ? $parameter->{mode} : ""; |
|
my $user = defined $parameter->{user} ? $parameter->{user} : ""; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
directory => $directory, |
|
group => $group, |
|
mode => $mode, |
|
user => $user, |
|
}}); |
|
|
|
# Make sure the user and group and just one digit or word. |
|
$user =~ s/^(\S+)\s.*$/$1/; |
|
$group =~ s/^(\S+)\s.*$/$1/; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
group => $group, |
|
user => $user, |
|
}}); |
|
|
|
# Break the directories apart. |
|
my $working_directory = ""; |
|
foreach my $this_directory (split/\//, $directory) |
|
{ |
|
next if not $this_directory; |
|
$working_directory .= "/$this_directory"; |
|
$working_directory =~ s/\/\//\//g; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { working_directory => $working_directory }}); |
|
if (not -e $working_directory) |
|
{ |
|
# Directory doesn't exist, so create it. |
|
my $shell_call = $an->data->{path}{exe}{'mkdir'}." ".$working_directory; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0011", variables => { shell_call => $shell_call }}); |
|
open (my $file_handle, $shell_call." 2>&1 |") or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }}); |
|
while(<$file_handle>) |
|
{ |
|
chomp; |
|
my $line = $_; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }}); |
|
} |
|
close $file_handle; |
|
|
|
if ($mode) |
|
{ |
|
$an->Storage->change_mode({target => $working_directory, mode => $mode}); |
|
} |
|
if (($user) or ($group)) |
|
{ |
|
$an->Storage->change_owner({target => $working_directory, user => $user, group => $group}); |
|
} |
|
} |
|
} |
|
|
|
return(0); |
|
} |
|
|
|
=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; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }}); |
|
|
|
if (not $file) |
|
{ |
|
# No file to read |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0032"}); |
|
$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 }); |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { path => $path }}); |
|
if ($path ne "#!not_found!#") |
|
{ |
|
# Update the file |
|
$file = $path; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }}); |
|
} |
|
} |
|
|
|
if ($file) |
|
{ |
|
if (not -e $file) |
|
{ |
|
# The file doesn't exist |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0033", variables => { file => $file }}); |
|
$return_code = 2; |
|
} |
|
elsif (not -r $file) |
|
{ |
|
# The file can't be read |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0034", variables => { |
|
file => $file, |
|
user => getpwuid($<), |
|
uid => $<, |
|
}}); |
|
$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) |
|
{ |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0035", variables => { |
|
file => $file, |
|
count => $count, |
|
line => $line, |
|
}}); |
|
} |
|
|
|
$an->_make_hash_reference($an->data, $variable, $value); |
|
} |
|
close $file_handle; |
|
} |
|
} |
|
|
|
return($return_code); |
|
} |
|
|
|
=head2 read_file |
|
|
|
This reads in a file and returns the contents of the file as a single string variable. |
|
|
|
$an->Storage->read_file({file => "/tmp/foo"}); |
|
|
|
If it fails to find the file, or the file is not readable, 'C<< undef >>' is returned. |
|
|
|
Parameters; |
|
|
|
=head3 file (required) |
|
|
|
This is the name of the file to read. |
|
|
|
=cut |
|
sub read_file |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
my $body = ""; |
|
my $file = defined $parameter->{file} ? $parameter->{file} : ""; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }}); |
|
|
|
if (not $file) |
|
{ |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020"}); |
|
return(undef); |
|
} |
|
elsif (not -e $file) |
|
{ |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0021", variables => { file => $file }}); |
|
return(undef); |
|
} |
|
elsif (not -r $file) |
|
{ |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0022", variables => { file => $file }}); |
|
return(undef); |
|
} |
|
|
|
my $shell_call = $file; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0012", variables => { shell_call => $shell_call }}); |
|
open (my $file_handle, "<", $shell_call) or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0015", variables => { shell_call => $shell_call, error => $! }}); |
|
while(<$file_handle>) |
|
{ |
|
chomp; |
|
my $line = $_; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0023", variables => { line => $line }}); |
|
$body .= $line."\n"; |
|
} |
|
close $file_handle; |
|
$body =~ s/\n$//s; |
|
|
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { body => $body }}); |
|
return($body); |
|
} |
|
|
|
=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) |
|
{ |
|
# Not initializing and an array was passed that isn't. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0031", variables => { array => $array }}); |
|
} |
|
|
|
# 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; |
|
} |
|
|
|
# Debug |
|
foreach my $directory (@{$self->{SEARCH_DIRECTORIES}}) |
|
{ |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { directory => $directory }}); |
|
} |
|
|
|
return ($self->{SEARCH_DIRECTORIES}); |
|
} |
|
|
|
=head2 write_file |
|
|
|
This writes out a file on the local system. It can optionally set the mode as well. |
|
|
|
$an->Storage->write_file({file => "/tmp/foo", body => "some data", mode => 0644}); |
|
|
|
If it fails to write the file, an alert will be logged. |
|
|
|
Parameters; |
|
|
|
=head3 body (optional) |
|
|
|
This is the contents of the file. If it is blank, an empty file will be created (similar to using 'C<< touch >>' on the command line). |
|
|
|
=head3 file (required) |
|
|
|
This is the name of the file to write. |
|
|
|
NOTE: The file must include the full directory it will be written into. |
|
|
|
=head3 group (optional) |
|
|
|
This is the group name or group ID to set the ownership of the file to. |
|
|
|
=head3 mode (optional) |
|
|
|
This is the numeric mode to set on the file. It expects four digits to cover the sticky bit, but will work with three digits. |
|
|
|
=head3 overwrite (optional) |
|
|
|
Normally, if the file already exists, it won't be overwritten. Setting this to 'C<< 1 >>' will cause the file to be overwritten. |
|
|
|
=head3 secure (optional) |
|
|
|
If set to 'C<< 1 >>', the body is treated as containing secure data for logging purposes. |
|
|
|
=head3 user (optional) |
|
|
|
This is the user name or user ID to set the ownership of the file to. |
|
|
|
=cut |
|
sub write_file |
|
{ |
|
my $self = shift; |
|
my $parameter = shift; |
|
my $an = $self->parent; |
|
|
|
my $body = defined $parameter->{body} ? $parameter->{body} : ""; |
|
my $file = defined $parameter->{file} ? $parameter->{file} : ""; |
|
my $group = defined $parameter->{group} ? $parameter->{group} : ""; |
|
my $mode = defined $parameter->{mode} ? $parameter->{mode} : ""; |
|
my $overwrite = defined $parameter->{overwrite} ? $parameter->{overwrite} : 0; |
|
my $secure = defined $parameter->{secure} ? $parameter->{secure} : ""; |
|
my $user = defined $parameter->{user} ? $parameter->{user} : ""; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, secure => $secure, list => { |
|
body => $body, |
|
file => $file, |
|
group => $group, |
|
mode => $mode, |
|
overwrite => $overwrite, |
|
secure => $secure, |
|
user => $user, |
|
}}); |
|
|
|
# Make sure the user and group and just one digit or word. |
|
$user =~ s/^(\S+)\s.*$/$1/; |
|
$group =~ s/^(\S+)\s.*$/$1/; |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
group => $group, |
|
user => $user, |
|
}}); |
|
|
|
my $error = 0; |
|
if ((-e $file) && (not $overwrite)) |
|
{ |
|
# Nope. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0040", variables => { file => $file }}); |
|
$error = 1; |
|
} |
|
|
|
if ($file !~ /^\/\w/) |
|
{ |
|
# Not a fully defined path, abort. |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0041", variables => { file => $file }}); |
|
$error = 1; |
|
} |
|
|
|
if (not $error) |
|
{ |
|
# Break the directory off the file. |
|
my ($directory, $file_name) = ($file =~ /^(\/.*)\/(.*)$/); |
|
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { |
|
directory => $directory, |
|
file_name => $file_name, |
|
}}); |
|
|
|
if (not -e $directory) |
|
{ |
|
# Don't pass the mode as the file's mode is likely not executable. |
|
$an->Storage->make_directory({ |
|
directory => $directory, |
|
group => $group, |
|
user => $user, |
|
}); |
|
} |
|
|
|
# Now write the file. |
|
my $shell_call = $file; |
|
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, secure => $secure, key => "log_0013", variables => { shell_call => $shell_call }}); |
|
open (my $file_handle, ">", $shell_call) or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, secure => $secure, priority => "err", key => "log_0016", variables => { shell_call => $shell_call, error => $! }}); |
|
print $file_handle $body; |
|
close $file_handle; |
|
|
|
if ($mode) |
|
{ |
|
$an->Storage->change_mode({target => $file, mode => $mode}); |
|
} |
|
if (($user) or ($group)) |
|
{ |
|
$an->Storage->change_owner({target => $file, user => $user, group => $group}); |
|
} |
|
} |
|
|
|
return(0); |
|
} |
|
|
|
|
|
# =head3 |
|
# |
|
# Private Functions; |
|
# |
|
# =cut |
|
|
|
############################################################################################################# |
|
# Private functions # |
|
############################################################################################################# |
|
|
|
1;
|
|
|