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.
134 lines
2.8 KiB
134 lines
2.8 KiB
package App::WRT::Util;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Carp;
|
|
use Encode;
|
|
|
|
use base qw(Exporter);
|
|
our @EXPORT_OK = qw(dir_list get_date file_put_contents file_get_contents);
|
|
|
|
=over
|
|
|
|
=item dir_list($dir, $sort_order, $pattern)
|
|
|
|
Return a $sort_order sorted list of files matching regex $pattern in a
|
|
directory.
|
|
|
|
Calls $sort_order, which can be one of:
|
|
|
|
alpha - alphabetical
|
|
reverse_alpha - alphabetical, reversed
|
|
high_to_low - numeric, high to low
|
|
low_to_high - numeric, low to high
|
|
|
|
=cut
|
|
|
|
sub dir_list {
|
|
my ($dir, $sort_order, $pattern) = @_;
|
|
|
|
$pattern ||= qr/^[0-9]{1,2}$/;
|
|
$sort_order ||= 'high_to_low';
|
|
|
|
opendir my $list_dir, $dir
|
|
or die "Couldn't open $dir: $!";
|
|
|
|
my @files = sort $sort_order
|
|
grep { m/$pattern/ }
|
|
readdir $list_dir;
|
|
|
|
closedir $list_dir;
|
|
|
|
return @files;
|
|
}
|
|
|
|
# Various named sorts for dir_list:
|
|
sub alpha { $a cmp $b; } # alphabetical
|
|
sub high_to_low { $b <=> $a; } # numeric, high to low
|
|
sub low_to_high { $a <=> $b; } # numberic, low to high
|
|
sub reverse_alpha { $b cmp $a; } # alphabetical, reversed
|
|
|
|
=item file_put_contents($file, $contents)
|
|
|
|
Write $contents string to $file path. Because:
|
|
|
|
L<https://secure.php.net/manual/en/function.file-put-contents.php>
|
|
|
|
=cut
|
|
|
|
sub file_put_contents {
|
|
my ($file, $contents) = @_;
|
|
open(my $fh, '>', $file)
|
|
or die "Unable to open $file for writing: $!";
|
|
print $fh $contents;
|
|
close $fh;
|
|
}
|
|
|
|
=item file_get_contents($file)
|
|
|
|
Get contents string of $file path. Because:
|
|
|
|
L<https://secure.php.net/manual/en/function.file-get-contents.php>
|
|
|
|
=cut
|
|
|
|
sub file_get_contents {
|
|
my ($file) = @_;
|
|
|
|
open my $fh, '<', $file
|
|
or croak "Couldn't open $file: $!\n";
|
|
|
|
my $contents;
|
|
{
|
|
# line separator:
|
|
local $/ = undef;
|
|
$contents = <$fh>;
|
|
}
|
|
|
|
close $fh or croak "Couldn't close $file: $!";
|
|
|
|
# TODO: _May_ want to assume here that any file is UTF-8 text.
|
|
# http://perldoc.perl.org/perlunitut.html
|
|
# return decode('UTF-8', $contents);
|
|
return $contents;
|
|
}
|
|
|
|
=item get_date('key', 'other_key', ...)
|
|
|
|
Return current date values for the given key. Valid keys are sec, min, hour,
|
|
mday (day of month), mon, year, wday (day of week), yday (day of year), and
|
|
isdst (is daylight savings).
|
|
|
|
Remember that year is given in years after 1900.
|
|
|
|
=cut
|
|
|
|
# Below replaces:
|
|
# my ($sec, $min, $hour, $mday, $mon,
|
|
# $year, $wday, $yday, $isdst) = localtime(time);
|
|
{
|
|
my %name_map = (
|
|
sec => 0, min => 1, hour => 2, mday => 3,
|
|
mon => 4, year => 5, wday => 6, yday => 5,
|
|
isdst => 6,
|
|
);
|
|
|
|
sub get_date {
|
|
my (@names) = @_;
|
|
my (@indices) = @name_map{@names};
|
|
my (@values) = (localtime time)[@indices];
|
|
|
|
if (wantarray()) {
|
|
# my ($foo, $bar) = get_date('foo', 'bar');
|
|
return @values;
|
|
} else {
|
|
# this is probably useless unless you're getting just one value
|
|
return join '', @values;
|
|
}
|
|
}
|
|
}
|
|
|
|
=back
|
|
|
|
1;
|