CTKlib
view release on metacpan or search on metacpan
lib/CTK/Util.pm view on Meta::CPAN
use CTK::Util;
use CTK::Util qw( :BASE ); # Export only BASE subroutines. See TAGS section
my @ls = ls(".");
=head1 DESCRIPTION
Public utility functions. No function is not exported by default!
=head2 FUNCTIONS
All subroutines are listed in alphabetical order
=head3 basetime
$secs = basetime();
The time at which the program began running, in seconds.
This function returns result of expression:
time() - $^T
Tags: BASE, DATE
=head3 bload, file_load
$bindata = bload( $file_or_fh, $onutf8 );
Reading file in binary mode as ':raw:utf8' layer (if $onutf8 is true) or regular binary layer.
Tags: BASE, FILE, ATOM
=head3 bsave, file_save
$status = bsave( $file_or_fh, $bindata, $onutf8 );
Saving file in binary mode as ':raw:utf8' layer (if $onutf8 is true) or regular binary layer.
Tags: BASE, FILE, ATOM
=head3 cachedir
my $value = cachedir();
For example value can be set as: /var/cache
/var/cache is intended for cached data from applications. Such data is locally generated as a result of
time-consuming I/O or calculation. The application must be able to regenerate or restore the data. Unlike
/var/spool, the cached files can be deleted without data loss. The data must remain valid between invocations
of the application and rebooting the system.
Files located under /var/cache may be expired in an application specific manner, by the system administrator,
or both. The application must always be able to recover from manual deletion of these files (generally because of
a disk space shortage). No other requirements are made on the data format of the cache directories.
See L<Sys::Path/"cachedir">
Tags: CORE, BASE, FILE
=head3 cdata
$cdatatext = cdata( $text );
Returns a string "<![CDATA[$text]]>" for plain XML documents.
Tags: BASE, FORMAT
=head3 correct_date
$mydate = correct_date( $date );
Returns date in format dd.mm.yyyy or null ('') if $date is wrongly.
Tags: BASE, DATE
=head3 correct_dig
$mydig = correct_dig( $string );
Returns digits only from string or 0 if string is not correctly.
Tags: BASE, FORMAT
=head3 correct_number
$mynumber = correct_number( $string, $sep );
Placement of separators discharges among digits. For example 1`234`567 if $sep is char "`" (default)
Tags: BASE, FORMAT
=head3 current_date
$date = current_date();
Returns current date in format dd.mm.yyyy
Tags: BASE, DATE
=head3 current_date_time
$datetime = current_date_time();
Returns current date in format dd.mm.yyyy hh.mm.ss
Tags: BASE, DATE
=head3 date2dig
$dd = date2dig( $date );
Returns $date (or current) in format yyyymmdd
Tags: BASE, DATE
=head3 date2localtime
$time = date2localtime( $date );
Returns time from date format dd.mm.yyyy in time() value in seconds since the system epoch
(Midnight, January 1, 1970 GMT on Unix, for example).
lib/CTK/Util.pm view on Meta::CPAN
Exports functions:
L</"basetime">,
L</"correct_date">,
L</"current_date">,
L</"current_date_time">,
L</"date_time2dig">,
L</"date2dig">,
L</"date2localtime">,
L</"datef">,
L</"datetime2localtime">,
L</"datetimef">,
L</"dig2date">,
L</"dig2date_time">,
L</"dtf">,
L</"localtime2date">,
L</"localtime2date_time">,
L</"tz_diff">,
L</"visokos">
=item B<:EXT>
Exports functions:
L</"exe">,
L</"execute">,
L</"ftp">,
L</"ftpgetlist">,
L</"ftptest">,
L</"send_mail">,
L</"sendmail">,
L</"where">,
L</"which">
=item B<:FILE>
Exports all function CORE and:
L</"bload">,
L</"bsave">,
L</"eqtime">,
L</"file_load">,
L</"file_save">,
L</"fload">,
L</"fsave">,
L</"getdirlist">,
L</"getfilelist">,
L</"getlist">,
L</"load_file">,
L</"ls">,
L</"preparedir">,
L</"save_file">,
L</"scandirs">,
L</"scanfiles">,
L</"touch">
=item B<:FORMAT>
Exports functions:
L</"cdata">,
L</"correct_dig">,
L</"correct_number">,
L</"dformat">,
L</"escape">,
L</"fformat">,
L</"file_lf_normalize">,
L</"file_nl_normalize">,
L</"from_utf8">,
L</"lf_normalize">,
L</"nl_normalize">,
L</"slash">,
L</"tag">,
L</"tag_create">,
L</"to_base64">,
L</"to_cp1251">,
L</"to_utf8">,
L</"to_windows1251">,
L</"trim">,
L</"unescape">,
L</"variant_stf">,
=item B<:UTIL>
Exports all function EXT and:
L</"isFalseFlag">,
L</"isTrueFlag">,
L</"randchars">,
L</"randomize">,
L</"shuffle">
=back
=head1 HISTORY
See C<Changes> file
=head1 DEPENDENCIES
L<Config>, L<Cwd>, L<Encode>, L<File::Path>, L<File::Spec>, L<IPC::Open3>,
L<MIME::Base64>, L<MIME::Lite>, L<Net::FTP>, L<Perl::OSType>, L<Symbol>,
L<Time::Local>, L<List::Util>
=head1 TO DO
See C<TODO> file
=head1 BUGS
* none noted
=head1 SEE ALSO
L<CGI::Util>, L<IPC::Open3>, L<List::Util>, L<MIME::Lite>, L<Net::FTP>
=head1 AUTHOR
Serż Minus (Sergey Lepenkov) L<https://www.serzik.com> E<lt>abalama@cpan.orgE<gt>
=head1 COPYRIGHT
lib/CTK/Util.pm view on Meta::CPAN
See C<LICENSE> file and L<https://dev.perl.org/licenses/>
=cut
use constant {
DEBUG => 1, # 0 - off, 1 - on, 2 - all (+ http headers and other)
WIN => $^O =~ /mswin/i ? 1 : 0,
NULL => $^O =~ /mswin/i ? 'NUL' : '/dev/null',
TONULL => $^O =~ /mswin/i ? '>NUL 2>&1' : '>/dev/null 2>&1',
ERR2OUT => '2>&1',
VOIDFILE => 'void.txt',
DTF => {
DOW => [qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/],
DOWS => [qw/Sun Mon Tue Wed Thu Fri Sat/],
MOY => [qw/January February March April May June
July August September October November December/],
MOYS => [qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/],
},
};
use vars qw/$VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS/;
$VERSION = '2.83';
use Encode;
use Time::Local;
use File::Spec::Functions qw/
catdir catfile rootdir tmpdir updir curdir
path splitpath splitdir abs2rel rel2abs
/;
use MIME::Base64;
use MIME::Lite;
use Net::FTP;
use File::Path; # mkpath / rmtree
use IPC::Open3;
use Symbol;
use Cwd;
use Carp qw/carp croak cluck confess/;
# carp -- as warn
# croak -- as die
# cluck -- as extended warn
# confess -- as extended die
use base qw /Exporter/;
my @est_api = qw(
read_attributes
syscfg getsyscfg isos isostype
);
my @est_core = qw(
prefixdir localstatedir sysconfdir srvdir
sharedir docdir localedir cachedir syslogdir spooldir rundir lockdir sharedstatedir webdir
);
my @est_util = qw(
randomize randchars shuffle isTrueFlag isFalseFlag
);
my @est_encoding = qw(
to_utf8 to_windows1251 to_cp1251 to_base64 from_utf8
);
my @est_format = qw(
escape unescape slash tag tag_create cdata dformat fformat
lf_normalize nl_normalize file_lf_normalize file_nl_normalize
correct_number correct_dig
variant_stf trim
);
my @est_datetime = qw(
current_date current_date_time localtime2date localtime2date_time correct_date date2localtime
datetime2localtime visokos date2dig dig2date date_time2dig dig2date_time basetime
dtf datetimef datef tz_diff
);
my @est_file = qw(
load_file save_file file_load file_save fsave fload bsave bload touch eqtime
);
my @est_dir = qw(
ls scandirs scanfiles getlist getfilelist getdirlist
preparedir
);
my @est_ext = qw(
sendmail send_mail
ftp ftptest ftpgetlist
exe execute where which
);
@EXPORT = (); # Defaults none
@EXPORT_OK = ( # All
@est_api, @est_core, @est_encoding, @est_format, @est_datetime,
@est_file, @est_dir, @est_ext, @est_util
);
%EXPORT_TAGS = (
DEFAULT => [@EXPORT],
ALL => [@EXPORT_OK],
API => [
@est_api
],
CORE => [
@est_core,
],
FORMAT => [
@est_encoding,
@est_format,
],
DATE => [
@est_datetime,
],
FILE => [
@est_core,
@est_file,
@est_dir,
],
EXT => [
@est_ext,
],
UTIL => [
@est_ext,
@est_util,
],
ATOM => [
@est_file, @est_dir,
@est_ext,
lib/CTK/Util.pm view on Meta::CPAN
#
# Format functions
#
sub to_utf8 { # Default: Windows-1251
my $ss = shift;
my $ch = shift || 'Windows-1251';
my $ret = "";
Encode::_utf8_on($ret);
return $ret unless defined($ss);
return Encode::decode($ch,$ss)
}
sub from_utf8 { # Default: Windows-1251
my $ss = shift;
my $ch = shift || 'Windows-1251';
my $ret = "";
Encode::_utf8_off($ret);
return $ret unless defined($ss);
return Encode::encode($ch,$ss)
}
sub to_windows1251 {
return from_utf8(shift, 'Windows-1251');
}
sub to_cp1251 { goto &to_windows1251 };
sub to_base64 {
# Converts UTF-8 string to base64 (RFC 2047)
my $ss = shift; # Сообщение
return '=?UTF-8?B??=' unless defined($ss);
return sprintf('=?UTF-8?B?%s?=', MIME::Base64::encode(Encode::encode('UTF-8', $ss), ''));
}
sub slash {
# \ -> \\
# ' -> \'
my $data_staring = shift;
return '' unless defined($data_staring);
$data_staring =~ s/\\/\\\\/g;
$data_staring =~ s/'/\\'/g;
return $data_staring;
}
sub tag {
# <, >, " and ' chars convert to <, >, " and ' strings
my $data_staring = shift;
return '' unless defined($data_staring);
$data_staring =~ s/</</g;
$data_staring =~ s/>/>/g;
$data_staring =~ s/\"/"/g;
$data_staring =~ s/\'/'/g;
return $data_staring;
}
sub tag_create {
# < -> < and etc. See tag
my $data_staring = shift;
return '' unless defined($data_staring);
$data_staring =~ s/\'\;/\'/g;
$data_staring =~ s/\<\;/\</g;
$data_staring =~ s/\>\;/\>/g;
$data_staring =~ s/\"\;/\"/g;
return $data_staring;
}
sub cdata {
my $s = shift;
my $ss = to_utf8('<![CDATA[');
my $sf = to_utf8(']]>');
if (defined $s) {
return $ss.$s.$sf;
}
return to_utf8('');
}
sub escape { # Percent-encoding, also known as URL encoding
my $toencode = shift;
return '' unless defined($toencode);
$toencode =~ s/([^a-zA-Z0-9_.~-])/uc(sprintf("%%%02x",ord($1)))/eg;
return $toencode;
}
sub unescape { # Percent-decoding, also known as URL decoding
my $todecode = shift;
return '' unless defined($todecode);
$todecode =~ tr/+/ /; # pluses become spaces
$todecode =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
return $todecode;
}
sub lf_normalize {
# line feed normalize in string
my $s = shift // return '';
$s =~ s/(\x0D*\x0A)|(\x0D)/_proxy_crlf($CRLF)/ges;
return $s;
}
sub nl_normalize { goto &lf_normalize }
sub file_lf_normalize {
# line feed normalize in file. Original: dos2unix
my $f = shift // return 0;
return 0 unless -e $f;
return 0 if -d $f;
return 0 unless -w $f;
return 0 unless -r $f;
return 0 if -B $f;
local $\;
my $temp = sprintf('%s.%d.tmp',$f,$$);
open ORIG, $f or do { carp "Can't open $f: $!"; return 0 };
open TEMP, ">$temp" or do { carp "Can't create $temp: $!"; return 0 };
binmode(TEMP);
while (my $line = <ORIG>) {
print TEMP lf_normalize($line);
}
close ORIG;
close TEMP;
rename $temp, $f;
return 1;
}
sub file_nl_normalize { goto &file_lf_normalize }
sub dformat {
my $fmt = shift // '';
my $fd = shift || {};
$fmt =~ s/\[([a-z0-9_\-.]+?)\]/(defined($fd->{uc($1)}) ? $fd->{uc($1)} : "[$1]")/ieg;
return $fmt;
}
sub fformat {
# [FILENAME] -- Filename only
( run in 0.925 second using v1.01-cache-2.11-cpan-6aa56a78535 )