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.
1023 lines
32 KiB
1023 lines
32 KiB
7 years ago
|
package Anvil::Tools::Storage;
|
||
8 years ago
|
#
|
||
|
# This module contains methods used to handle storage related tasks
|
||
|
#
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
use Data::Dumper;
|
||
7 years ago
|
use Scalar::Util qw(weaken isweak);
|
||
8 years ago
|
|
||
|
our $VERSION = "3.0.0";
|
||
|
my $THIS_FILE = "Storage.pm";
|
||
|
|
||
|
### Methods;
|
||
8 years ago
|
# change_mode
|
||
|
# change_owner
|
||
8 years ago
|
# copy_file
|
||
8 years ago
|
# find
|
||
8 years ago
|
# make_directory
|
||
8 years ago
|
# read_config
|
||
8 years ago
|
# read_file
|
||
8 years ago
|
# read_mode
|
||
8 years ago
|
# search_directories
|
||
8 years ago
|
# write_file
|
||
8 years ago
|
|
||
|
=pod
|
||
|
|
||
|
=encoding utf8
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
7 years ago
|
Anvil::Tools::Storage
|
||
8 years ago
|
|
||
|
Provides all methods related to storage on a system.
|
||
|
|
||
|
=head1 SYNOPSIS
|
||
|
|
||
7 years ago
|
use Anvil::Tools;
|
||
8 years ago
|
|
||
7 years ago
|
# Get a common object handle on all Anvil::Tools modules.
|
||
|
my $anvil = Anvil::Tools->new();
|
||
8 years ago
|
|
||
7 years ago
|
# Access to methods using '$anvil->Storage->X'.
|
||
8 years ago
|
#
|
||
|
# Example using 'find()';
|
||
7 years ago
|
my $foo_path = $anvil->Storage->find({file => "foo"});
|
||
8 years ago
|
|
||
|
=head1 METHODS
|
||
|
|
||
8 years ago
|
Methods in this module;
|
||
8 years ago
|
|
||
|
=cut
|
||
|
sub new
|
||
|
{
|
||
|
my $class = shift;
|
||
|
my $self = {
|
||
|
SEARCH_DIRECTORIES => \@INC,
|
||
|
};
|
||
|
|
||
|
bless $self, $class;
|
||
|
|
||
|
return ($self);
|
||
|
}
|
||
|
|
||
7 years ago
|
# Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
|
||
8 years ago
|
# 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;
|
||
|
|
||
7 years ago
|
# Defend against memory leads. See Scalar::Util'.
|
||
|
if (not isweak($self->{HANDLE}{TOOLS}))
|
||
|
{
|
||
|
weaken($self->{HANDLE}{TOOLS});;
|
||
|
}
|
||
|
|
||
8 years ago
|
return ($self->{HANDLE}{TOOLS});
|
||
|
}
|
||
|
|
||
|
|
||
|
#############################################################################################################
|
||
|
# Public methods #
|
||
|
#############################################################################################################
|
||
|
|
||
8 years ago
|
=head2 change_mode
|
||
|
|
||
|
This changes the mode of a file or directory.
|
||
|
|
||
7 years ago
|
$anvil->Storage->change_mode({target => "/tmp/foo", mode => "0644"});
|
||
8 years ago
|
|
||
|
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;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
my $target = defined $parameter->{target} ? $parameter->{target} : "";
|
||
|
my $mode = defined $parameter->{mode} ? $parameter->{mode} : "";
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
8 years ago
|
target => $target,
|
||
|
mode => $mode,
|
||
|
}});
|
||
8 years ago
|
|
||
|
my $error = 0;
|
||
|
if (not $target)
|
||
|
{
|
||
|
# No target...
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_mode()", parameter => "target" }});
|
||
8 years ago
|
$error = 1;
|
||
|
}
|
||
|
if (not $mode)
|
||
|
{
|
||
|
# No mode...
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_mode()", parameter => "mode" }});
|
||
8 years ago
|
$error = 1;
|
||
|
}
|
||
|
elsif (($mode !~ /^\d\d\d$/) && ($mode !~ /^\d\d\d\d$/))
|
||
|
{
|
||
|
# Invalid mode
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0038", variables => { mode => $mode }});
|
||
8 years ago
|
$error = 1;
|
||
|
}
|
||
|
|
||
|
if (not $error)
|
||
|
{
|
||
7 years ago
|
my $shell_call = $anvil->data->{path}{exe}{'chmod'}." $mode $target";
|
||
|
$anvil->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 $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }});
|
||
8 years ago
|
while(<$file_handle>)
|
||
|
{
|
||
|
chomp;
|
||
|
my $line = $_;
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }});
|
||
8 years ago
|
}
|
||
|
close $file_handle;
|
||
|
}
|
||
|
|
||
|
return(0);
|
||
|
}
|
||
|
|
||
|
=head2 change_owner
|
||
|
|
||
|
This changes the owner and/or group of a file or directory.
|
||
|
|
||
7 years ago
|
$anvil->Storage->change_owner({target => "/tmp/foo", mode => "0644"});
|
||
8 years ago
|
|
||
8 years ago
|
If it fails to write the file, an alert will be logged and 'C<< 1 >>' will be returned. Otherwise, 'C<< 0 >>' will be returned.
|
||
8 years ago
|
|
||
|
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;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
my $target = defined $parameter->{target} ? $parameter->{target} : "";
|
||
|
my $group = defined $parameter->{group} ? $parameter->{group} : "";
|
||
|
my $user = defined $parameter->{user} ? $parameter->{user} : "";
|
||
8 years ago
|
my $debug = 3;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
|
||
8 years ago
|
target => $target,
|
||
|
group => $group,
|
||
|
user => $user,
|
||
|
}});
|
||
|
|
||
8 years ago
|
# Make sure the user and group and just one digit or word.
|
||
|
$user =~ s/^(\S+)\s.*$/$1/;
|
||
|
$group =~ s/^(\S+)\s.*$/$1/;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
|
||
8 years ago
|
group => $group,
|
||
|
user => $user,
|
||
8 years ago
|
}});
|
||
|
|
||
8 years ago
|
my $string = "";
|
||
|
my $error = 0;
|
||
|
if (not $target)
|
||
|
{
|
||
|
# No target...
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_owner()", parameter => "target" }});
|
||
8 years ago
|
$error = 1;
|
||
|
}
|
||
8 years ago
|
if (not -e $target)
|
||
|
{
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0051", variables => {target => $target }});
|
||
8 years ago
|
$error = 1;
|
||
|
}
|
||
8 years ago
|
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user => $user }});
|
||
8 years ago
|
if ($user ne "")
|
||
8 years ago
|
{
|
||
|
$string = $user;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }});
|
||
8 years ago
|
}
|
||
8 years ago
|
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { group => $group }});
|
||
8 years ago
|
if ($group ne "")
|
||
8 years ago
|
{
|
||
|
$string .= ":".$group;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }});
|
||
8 years ago
|
}
|
||
|
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { error => $error, string => $string }});
|
||
8 years ago
|
if ((not $error) && ($string ne ""))
|
||
8 years ago
|
{
|
||
7 years ago
|
my $shell_call = $anvil->data->{path}{exe}{'chown'}." $string $target";
|
||
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0011", variables => { shell_call => $shell_call }});
|
||
|
open (my $file_handle, $shell_call." 2>&1 |") or $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }});
|
||
8 years ago
|
while(<$file_handle>)
|
||
|
{
|
||
|
chomp;
|
||
|
my $line = $_;
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0017", variables => { line => $line }});
|
||
8 years ago
|
}
|
||
|
close $file_handle;
|
||
|
}
|
||
|
|
||
8 years ago
|
return($error);
|
||
8 years ago
|
}
|
||
|
|
||
8 years ago
|
=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
|
||
7 years ago
|
$anvil->Storage->copy_file({source => "/some/file", target => "/another/directory/file"});
|
||
8 years ago
|
|
||
|
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)
|
||
|
|
||
8 years ago
|
This is the source file. If it isn't specified, 'C<< 1 >>' will be returned. If it doesn't exist, this method will return 'C<< 4 >>'.
|
||
8 years ago
|
|
||
|
=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;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
my $overwrite = defined $parameter->{overwrite} ? $parameter->{overwrite} : 0;
|
||
|
my $source = defined $parameter->{source} ? $parameter->{source} : "";
|
||
|
my $target = defined $parameter->{target} ? $parameter->{target} : "";
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
8 years ago
|
overwrite => $overwrite,
|
||
|
source => $source,
|
||
|
target => $target,
|
||
|
}});
|
||
|
|
||
|
if (not $source)
|
||
|
{
|
||
|
# No source passed.
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->copy_file()", parameter => "source" }});
|
||
8 years ago
|
return(1);
|
||
|
}
|
||
8 years ago
|
elsif (not -e $source)
|
||
|
{
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0052", variables => { source => $source }});
|
||
8 years ago
|
return(4);
|
||
|
}
|
||
8 years ago
|
if (not $target)
|
||
|
{
|
||
|
# No target passed.
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->copy_file()", parameter => "target" }});
|
||
8 years ago
|
return(2);
|
||
|
}
|
||
|
|
||
|
# If the target exists, abort
|
||
|
if ((-e $target) && (not $overwrite))
|
||
|
{
|
||
|
# This isn't an error.
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0046", variables => {
|
||
8 years ago
|
source => $source,
|
||
|
target => $target,
|
||
|
}});
|
||
|
return(3);
|
||
|
}
|
||
|
|
||
|
# Make sure the target directory exists and create it, if not.
|
||
|
my ($directory, $file) = ($target =~ /^(.*)\/(.*)$/);
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
8 years ago
|
directory => $directory,
|
||
|
file => $file,
|
||
|
}});
|
||
|
if (not -e $directory)
|
||
|
{
|
||
7 years ago
|
$anvil->Storage->make_directory({
|
||
8 years ago
|
directory => $directory,
|
||
|
group => $(, # Real UID
|
||
|
user => $<, # Real GID
|
||
|
mode => "0750",
|
||
|
});
|
||
|
}
|
||
|
|
||
|
# Now backup the file.
|
||
7 years ago
|
my $output = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{'cp'}." -af $source $target"});
|
||
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }});
|
||
8 years ago
|
|
||
|
return(0);
|
||
|
}
|
||
|
|
||
8 years ago
|
=head2 find
|
||
|
|
||
7 years ago
|
This searches for the given file on the system. It will search in the directories returned by C<< $anvil->Storage->search_directories() >>.
|
||
8 years ago
|
|
||
8 years ago
|
Example to search for 'C<< foo >>';
|
||
8 years ago
|
|
||
7 years ago
|
$anvil->Storage->find({file => "foo"});
|
||
8 years ago
|
|
||
|
Same, but error out if the file isn't found.
|
||
|
|
||
7 years ago
|
$anvil->Storage->find({
|
||
8 years ago
|
file => "foo",
|
||
|
fatal => 1,
|
||
|
});
|
||
|
|
||
8 years ago
|
If it fails to find the file and C<< fatal >> isn't set to 'C<< 1 >>', 'C<< 0 >>' is returned.
|
||
8 years ago
|
|
||
|
Parameters;
|
||
|
|
||
8 years ago
|
=head3 file (required)
|
||
8 years ago
|
|
||
|
This is the name of the file to search for.
|
||
|
|
||
|
=cut
|
||
|
sub find
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $parameter = shift;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
8 years ago
|
# WARNING: Don't call Log from here! It causes it to abort
|
||
|
my $debug = 0;
|
||
8 years ago
|
my $file = defined $parameter->{file} ? $parameter->{file} : "";
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - file: [$file]\n" if $debug;
|
||
8 years ago
|
|
||
|
# Each full path and file name will be stored here before the test.
|
||
8 years ago
|
my $full_path = "#!not_found!#";
|
||
8 years ago
|
if ($file)
|
||
8 years ago
|
{
|
||
7 years ago
|
foreach my $directory (@{$anvil->Storage->search_directories()})
|
||
8 years ago
|
{
|
||
8 years ago
|
# If "directory" is ".", expand it.
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - >> directory: [$directory]\n" if $debug;
|
||
8 years ago
|
if (($directory eq ".") && ($ENV{PWD}))
|
||
|
{
|
||
|
$directory = $ENV{PWD};
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - << directory: [$directory]\n" if $debug;
|
||
8 years ago
|
}
|
||
|
|
||
|
# Put together the initial path
|
||
|
my $test_path = $directory."/".$file;
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - >> test_path: [$test_path]\n" if $debug;
|
||
8 years ago
|
|
||
8 years ago
|
# Clear double-delimiters.
|
||
|
$test_path =~ s/\/+/\//g;
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - << test_path: [$test_path]\n" if $debug;
|
||
8 years ago
|
if (-f $test_path)
|
||
|
{
|
||
|
# Found it!
|
||
|
$full_path = $test_path;
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - >> full_path: [$full_path]\n" if $debug;
|
||
8 years ago
|
last;
|
||
|
}
|
||
8 years ago
|
}
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - << full_path: [$full_path]\n" if $debug;
|
||
8 years ago
|
}
|
||
8 years ago
|
|
||
8 years ago
|
# Return
|
||
8 years ago
|
print $THIS_FILE." ".__LINE__."; [ Debug] - full_path: [$full_path]\n" if $debug;
|
||
8 years ago
|
return ($full_path);
|
||
|
}
|
||
|
|
||
|
=head2 make_directory
|
||
|
|
||
|
This creates a directory (and any parent directories).
|
||
|
|
||
7 years ago
|
$anvil->Storage->make_directory({directory => "/foo/bar/baz", owner => "me", grou[ => "me", group => 755});
|
||
8 years ago
|
|
||
|
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;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
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} : "";
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
8 years ago
|
directory => $directory,
|
||
|
group => $group,
|
||
|
mode => $mode,
|
||
|
user => $user,
|
||
|
}});
|
||
|
|
||
8 years ago
|
# Make sure the user and group and just one digit or word.
|
||
|
$user =~ s/^(\S+)\s.*$/$1/;
|
||
|
$group =~ s/^(\S+)\s.*$/$1/;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
8 years ago
|
group => $group,
|
||
|
user => $user,
|
||
|
}});
|
||
|
|
||
8 years ago
|
# Break the directories apart.
|
||
|
my $working_directory = "";
|
||
8 years ago
|
foreach my $this_directory (split/\//, $directory)
|
||
8 years ago
|
{
|
||
8 years ago
|
next if not $this_directory;
|
||
|
$working_directory .= "/$this_directory";
|
||
8 years ago
|
$working_directory =~ s/\/\//\//g;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { working_directory => $working_directory }});
|
||
8 years ago
|
if (not -e $working_directory)
|
||
8 years ago
|
{
|
||
8 years ago
|
# Directory doesn't exist, so create it.
|
||
7 years ago
|
my $shell_call = $anvil->data->{path}{exe}{'mkdir'}." ".$working_directory;
|
||
|
$anvil->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 $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }});
|
||
8 years ago
|
while(<$file_handle>)
|
||
|
{
|
||
|
chomp;
|
||
|
my $line = $_;
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }});
|
||
8 years ago
|
}
|
||
|
close $file_handle;
|
||
|
|
||
|
if ($mode)
|
||
|
{
|
||
7 years ago
|
$anvil->Storage->change_mode({target => $working_directory, mode => $mode});
|
||
8 years ago
|
}
|
||
|
if (($user) or ($group))
|
||
|
{
|
||
7 years ago
|
$anvil->Storage->change_owner({target => $working_directory, user => $user, group => $group});
|
||
8 years ago
|
}
|
||
8 years ago
|
}
|
||
|
}
|
||
|
|
||
8 years ago
|
return(0);
|
||
8 years ago
|
}
|
||
|
|
||
|
=head2 read_config
|
||
|
|
||
7 years ago
|
This method is used to read 'Anvil::Tools' style configuration files. These configuration files are in the format:
|
||
8 years ago
|
|
||
|
# This is a comment for the 'a::b::c' variable
|
||
|
a::b::c = x
|
||
|
|
||
|
A configuration file can be read in like this;
|
||
|
|
||
7 years ago
|
$anvil->Storage->read_config({file => "test.conf"});
|
||
8 years ago
|
|
||
7 years ago
|
In this example, the file 'C<< test.conf >>' will be searched for in the directories returned by 'C<< $anvil->Storage->search_directories >>'.
|
||
8 years ago
|
|
||
|
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.
|
||
|
|
||
7 years ago
|
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<< $anvil->Storage->search_directories >>'. The first match is read in.
|
||
8 years ago
|
|
||
7 years ago
|
All variables are stored in the root of 'C<< $anvil->data >>', allowing for configuration files to override internally set variables.
|
||
8 years ago
|
|
||
|
For example, if you set:
|
||
|
|
||
7 years ago
|
$anvil->data->{a}{b}{c} = "1";
|
||
8 years ago
|
|
||
|
Then you read in a config file with:
|
||
|
|
||
|
a::b::c = x
|
||
|
|
||
7 years ago
|
Then 'C<< $anvil->data->{a}{b}{c} >>' will now contain 'C<< x >>'.
|
||
8 years ago
|
|
||
|
=cut
|
||
|
sub read_config
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $parameter = shift;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
# Setup default values
|
||
|
my $file = defined $parameter->{file} ? $parameter->{file} : 0;
|
||
|
my $return_code = 0;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }});
|
||
8 years ago
|
|
||
|
if (not $file)
|
||
8 years ago
|
{
|
||
8 years ago
|
# No file to read
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0032"});
|
||
8 years ago
|
$return_code = 1;
|
||
8 years ago
|
}
|
||
8 years ago
|
|
||
|
# If I have a file name that isn't a full path, find it.
|
||
|
if (($file) && ($file !~ /^\//))
|
||
8 years ago
|
{
|
||
8 years ago
|
# 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.
|
||
7 years ago
|
my $path = $anvil->Storage->find({ file => $file });
|
||
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { path => $path }});
|
||
8 years ago
|
if ($path ne "#!not_found!#")
|
||
|
{
|
||
|
# Update the file
|
||
|
$file = $path;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }});
|
||
8 years ago
|
}
|
||
8 years ago
|
}
|
||
8 years ago
|
|
||
|
if ($file)
|
||
8 years ago
|
{
|
||
8 years ago
|
if (not -e $file)
|
||
|
{
|
||
8 years ago
|
# The file doesn't exist
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0033", variables => { file => $file }});
|
||
8 years ago
|
$return_code = 2;
|
||
|
}
|
||
|
elsif (not -r $file)
|
||
|
{
|
||
8 years ago
|
# The file can't be read
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0034", variables => {
|
||
8 years ago
|
file => $file,
|
||
|
user => getpwuid($<),
|
||
|
uid => $<,
|
||
|
}});
|
||
8 years ago
|
$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)
|
||
|
{
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0035", variables => {
|
||
8 years ago
|
file => $file,
|
||
|
count => $count,
|
||
|
line => $line,
|
||
|
}});
|
||
8 years ago
|
}
|
||
|
|
||
7 years ago
|
$anvil->_make_hash_reference($anvil->data, $variable, $value);
|
||
8 years ago
|
}
|
||
|
close $file_handle;
|
||
|
}
|
||
8 years ago
|
}
|
||
|
|
||
8 years ago
|
return($return_code);
|
||
8 years ago
|
}
|
||
|
|
||
8 years ago
|
=head2 read_file
|
||
|
|
||
|
This reads in a file and returns the contents of the file as a single string variable.
|
||
|
|
||
7 years ago
|
my $body = $anvil->Storage->read_file({file => "/tmp/foo"});
|
||
8 years ago
|
|
||
8 years ago
|
If it fails to find the file, or the file is not readable, 'C<< !!error!! >>' is returned.
|
||
8 years ago
|
|
||
|
Parameters;
|
||
|
|
||
7 years ago
|
=head3 cache (optional)
|
||
|
|
||
|
This is an optional parameter that controls whether the file is cached in case something else tries to read the same file later. By default, all read files are cached. Set this to C<< 0 >> to disable caching. This should only be needed when reading large files.
|
||
|
|
||
8 years ago
|
=head3 file (required)
|
||
|
|
||
|
This is the name of the file to read.
|
||
|
|
||
7 years ago
|
=head3 force_read (optional)
|
||
|
|
||
|
This is an otpional parameter that, if set, forces the file to be read, bypassing cache if it exists. Set this to C<< 1 >> to bypass the cache.
|
||
|
|
||
8 years ago
|
=cut
|
||
|
sub read_file
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $parameter = shift;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
7 years ago
|
my $body = "";
|
||
|
my $cache = defined $parameter->{cache} ? $parameter->{cache} : 1;
|
||
|
my $file = defined $parameter->{file} ? $parameter->{file} : "";
|
||
|
my $force_read = defined $parameter->{force_read} ? $parameter->{force_read} : 0;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
7 years ago
|
cache => $cache,
|
||
|
file => $file,
|
||
|
force_read => $force_read,
|
||
|
}});
|
||
8 years ago
|
|
||
|
if (not $file)
|
||
|
{
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->read_file()", parameter => "file" }});
|
||
8 years ago
|
return("!!error!!");
|
||
8 years ago
|
}
|
||
|
elsif (not -e $file)
|
||
|
{
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0021", variables => { file => $file }});
|
||
8 years ago
|
return("!!error!!");
|
||
8 years ago
|
}
|
||
|
elsif (not -r $file)
|
||
|
{
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0022", variables => { file => $file }});
|
||
8 years ago
|
return("!!error!!");
|
||
8 years ago
|
}
|
||
|
|
||
7 years ago
|
# If I've read this before, don't read it again.
|
||
7 years ago
|
if ((exists $anvil->data->{cache}{file}{$file}) && (not $force_read))
|
||
7 years ago
|
{
|
||
|
# Use the cache
|
||
7 years ago
|
$body = $anvil->data->{cache}{file}{$file};
|
||
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { body => $body }});
|
||
7 years ago
|
}
|
||
|
else
|
||
8 years ago
|
{
|
||
7 years ago
|
# Read from disk.
|
||
|
my $shell_call = $file;
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0012", variables => { shell_call => $shell_call }});
|
||
|
open (my $file_handle, "<", $shell_call) or $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0015", variables => { shell_call => $shell_call, error => $! }});
|
||
7 years ago
|
while(<$file_handle>)
|
||
|
{
|
||
|
chomp;
|
||
|
my $line = $_;
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0023", variables => { line => $line }});
|
||
7 years ago
|
$body .= $line."\n";
|
||
|
}
|
||
|
close $file_handle;
|
||
|
$body =~ s/\n$//s;
|
||
|
|
||
|
if ($cache)
|
||
|
{
|
||
7 years ago
|
$anvil->data->{cache}{file}{$file} = $body;
|
||
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "cache::file::$file" => $anvil->data->{cache}{file}{$file} }});
|
||
7 years ago
|
}
|
||
8 years ago
|
}
|
||
|
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { body => $body }});
|
||
8 years ago
|
return($body);
|
||
|
}
|
||
|
|
||
8 years ago
|
=head2 read_mode
|
||
|
|
||
|
This reads a file or directory's mode (sticky-bit and ownership) and returns the mode as a four-digit string (ie: 'c<< 0644 >>', 'C<< 4755 >>', etc.
|
||
|
|
||
7 years ago
|
my $mode = $anvil->Storage->read_mode({file => "/tmp/foo"});
|
||
8 years ago
|
|
||
|
If it fails to find the file, or the file is not readable, 'C<< 0 >>' is returned.
|
||
|
|
||
|
Parameters;
|
||
|
|
||
|
=head3 file (required)
|
||
|
|
||
|
This is the name of the file or directory to check the mode of.
|
||
|
|
||
|
=cut
|
||
|
sub read_mode
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $parameter = shift;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
my $debug = 1;
|
||
|
my $target = defined $parameter->{target} ? $parameter->{target} : "";
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { target => $target }});
|
||
8 years ago
|
|
||
|
if (not $target)
|
||
|
{
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->read_mode()", parameter => "target" }});
|
||
8 years ago
|
return(1);
|
||
|
}
|
||
|
|
||
|
# Read the mode and convert it to digits.
|
||
|
my $mode = (stat($target))[2];
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mode => $mode }});
|
||
8 years ago
|
|
||
|
# Return the full mode, unless it is a directory or file. In those cases, return the last four digits.
|
||
|
my $say_mode = $mode;
|
||
|
if (-d $target)
|
||
|
{
|
||
|
# Directory - five digits
|
||
|
$say_mode = sprintf("%04o", $mode);
|
||
|
$say_mode =~ s/^\d(\d\d\d\d)$/$1/;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { say_mode => $say_mode }});
|
||
8 years ago
|
}
|
||
|
elsif (-f $target)
|
||
|
{
|
||
|
# File - six digits
|
||
|
$say_mode = sprintf("%04o", $mode);
|
||
|
$say_mode =~ s/^\d\d(\d\d\d\d)$/$1/;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { say_mode => $say_mode }});
|
||
8 years ago
|
}
|
||
|
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mode => $mode, say_mode => $say_mode }});
|
||
8 years ago
|
return($say_mode);
|
||
|
}
|
||
|
|
||
8 years ago
|
=head2 search_directories
|
||
|
|
||
|
This method returns an array reference of directories to search within for files and directories.
|
||
|
|
||
|
Parameters;
|
||
|
|
||
8 years ago
|
=head3 directories (optional)
|
||
8 years ago
|
|
||
8 years ago
|
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.
|
||
|
|
||
8 years ago
|
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.
|
||
8 years ago
|
|
||
8 years ago
|
=head3 initialize (optional)
|
||
|
|
||
8 years ago
|
If this is set, the list of directories to search will be set to 'C<< @INC >>' + 'C<< $ENV{'PATH'} >>' + 'C<< path::directories::tools >>'.
|
||
8 years ago
|
|
||
7 years ago
|
NOTE: You don't need to call this manually unless you want to reset the list. Invoking Anvil::Tools->new() causes this to be called automatically.
|
||
8 years ago
|
|
||
8 years ago
|
=cut
|
||
|
sub search_directories
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $parameter = shift;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
# Set a default if nothing was passed.
|
||
8 years ago
|
my $array = defined $parameter->{directories} ? $parameter->{directories} : "";
|
||
|
my $initialize = defined $parameter->{initialize} ? $parameter->{initialize} : "";
|
||
8 years ago
|
|
||
|
# 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;
|
||
|
}
|
||
8 years ago
|
elsif (($initialize) or (($array) && (ref($array) ne "ARRAY")))
|
||
8 years ago
|
{
|
||
8 years ago
|
if (not $initialize)
|
||
|
{
|
||
8 years ago
|
# Not initializing and an array was passed that isn't.
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0031", variables => { array => $array }});
|
||
8 years ago
|
}
|
||
8 years ago
|
|
||
|
# 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;
|
||
|
}
|
||
8 years ago
|
|
||
|
# Add the tools directory
|
||
7 years ago
|
push @new_array, $anvil->data->{path}{directories}{tools};
|
||
8 years ago
|
$array = \@new_array;
|
||
8 years ago
|
}
|
||
|
|
||
|
# Store the new array, if set.
|
||
|
if (ref($array) eq "ARRAY")
|
||
|
{
|
||
8 years ago
|
# Dedupe and sort.
|
||
|
my $sorted_array = [];
|
||
|
my $seen_directories = {};
|
||
|
foreach my $directory (sort {$a cmp $b} @{$array})
|
||
|
{
|
||
8 years ago
|
next if not defined $directory;
|
||
|
|
||
8 years ago
|
# 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;
|
||
|
|
||
8 years ago
|
$self->{SEARCH_DIRECTORIES} = $array;
|
||
|
}
|
||
|
|
||
8 years ago
|
# Debug
|
||
|
foreach my $directory (@{$self->{SEARCH_DIRECTORIES}})
|
||
|
{
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { directory => $directory }});
|
||
8 years ago
|
}
|
||
|
|
||
8 years ago
|
return ($self->{SEARCH_DIRECTORIES});
|
||
|
}
|
||
|
|
||
8 years ago
|
=head2 write_file
|
||
|
|
||
|
This writes out a file on the local system. It can optionally set the mode as well.
|
||
|
|
||
7 years ago
|
$anvil->Storage->write_file({file => "/tmp/foo", body => "some data", mode => 0644});
|
||
8 years ago
|
|
||
|
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.
|
||
|
|
||
8 years ago
|
=head3 secure (optional)
|
||
|
|
||
|
If set to 'C<< 1 >>', the body is treated as containing secure data for logging purposes.
|
||
|
|
||
8 years ago
|
=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;
|
||
7 years ago
|
my $anvil = $self->parent;
|
||
8 years ago
|
|
||
|
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;
|
||
8 years ago
|
my $secure = defined $parameter->{secure} ? $parameter->{secure} : "";
|
||
8 years ago
|
my $user = defined $parameter->{user} ? $parameter->{user} : "";
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, secure => $secure, list => {
|
||
8 years ago
|
body => $body,
|
||
|
file => $file,
|
||
|
group => $group,
|
||
|
mode => $mode,
|
||
|
overwrite => $overwrite,
|
||
8 years ago
|
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/;
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
8 years ago
|
group => $group,
|
||
8 years ago
|
user => $user,
|
||
|
}});
|
||
|
|
||
|
my $error = 0;
|
||
|
if ((-e $file) && (not $overwrite))
|
||
|
{
|
||
|
# Nope.
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0040", variables => { file => $file }});
|
||
8 years ago
|
$error = 1;
|
||
|
}
|
||
|
|
||
|
if ($file !~ /^\/\w/)
|
||
|
{
|
||
|
# Not a fully defined path, abort.
|
||
7 years ago
|
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0041", variables => { file => $file }});
|
||
8 years ago
|
$error = 1;
|
||
|
}
|
||
|
|
||
|
if (not $error)
|
||
|
{
|
||
|
# Break the directory off the file.
|
||
|
my ($directory, $file_name) = ($file =~ /^(\/.*)\/(.*)$/);
|
||
7 years ago
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
|
||
8 years ago
|
directory => $directory,
|
||
|
file_name => $file_name,
|
||
|
}});
|
||
|
|
||
8 years ago
|
if (not -e $directory)
|
||
8 years ago
|
{
|
||
8 years ago
|
# Don't pass the mode as the file's mode is likely not executable.
|
||
7 years ago
|
$anvil->Storage->make_directory({
|
||
8 years ago
|
directory => $directory,
|
||
|
group => $group,
|
||
|
user => $user,
|
||
|
});
|
||
|
}
|
||
|
|
||
8 years ago
|
# If 'secure' is set, the file will probably contain sensitive data so touch the file and set
|
||
|
# the mode before writing it.
|
||
|
if ($secure)
|
||
|
{
|
||
7 years ago
|
my $shell_call = $anvil->data->{path}{exe}{touch}." ".$file;
|
||
|
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { shell_call => $shell_call }});
|
||
8 years ago
|
|
||
7 years ago
|
$anvil->System->call({shell_call => $shell_call});
|
||
|
$anvil->Storage->change_mode({target => $file, mode => $mode});
|
||
8 years ago
|
}
|
||
|
|
||
8 years ago
|
# Now write the file.
|
||
|
my $shell_call = $file;
|
||
7 years ago
|
$anvil->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 $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, secure => $secure, priority => "err", key => "log_0016", variables => { shell_call => $shell_call, error => $! }});
|
||
8 years ago
|
print $file_handle $body;
|
||
|
close $file_handle;
|
||
|
|
||
|
if ($mode)
|
||
|
{
|
||
7 years ago
|
$anvil->Storage->change_mode({target => $file, mode => $mode});
|
||
8 years ago
|
}
|
||
|
if (($user) or ($group))
|
||
|
{
|
||
7 years ago
|
$anvil->Storage->change_owner({target => $file, user => $user, group => $group});
|
||
8 years ago
|
}
|
||
|
}
|
||
|
|
||
|
return(0);
|
||
|
}
|
||
|
|
||
8 years ago
|
|
||
|
# =head3
|
||
|
#
|
||
|
# Private Functions;
|
||
|
#
|
||
|
# =cut
|
||
|
|
||
|
#############################################################################################################
|
||
|
# Private functions #
|
||
|
#############################################################################################################
|
||
|
|
||
|
1;
|