NetSDS-Util-1.044/0000755000076400007640000000000011254222717012534 5ustar mishamishaNetSDS-Util-1.044/t/0000755000076400007640000000000011254222717012777 5ustar mishamishaNetSDS-Util-1.044/t/01_load.t0000444000076400007640000000150311253717636014410 0ustar mishamisha#!/usr/bin/env perl #=============================================================================== # # FILE: 01_load.t # # DESCRIPTION: Check if all modules are loading without errors # # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.0 #=============================================================================== use strict; use warnings; use Test::More tests => 10; # last test to print BEGIN { use_ok('NetSDS::Util'); use_ok('NetSDS::Util::Convert'); use_ok('NetSDS::Util::DateTime'); use_ok('NetSDS::Util::File'); use_ok('NetSDS::Util::FileImport'); use_ok('NetSDS::Util::Misc'); use_ok('NetSDS::Util::String'); use_ok('NetSDS::Util::Struct'); use_ok('NetSDS::Util::Translit'); use_ok('NetSDS::Util::Types'); } NetSDS-Util-1.044/t/02_pod.t0000444000076400007640000000130311227135004014232 0ustar mishamisha#!/usr/bin/env perl #=============================================================================== # # FILE: 02_pod.t # # DESCRIPTION: # # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.0 # CREATED: 13.07.2008 23:51:01 EEST # REVISION: $Id: 02_pod.t 8 2008-07-13 21:11:35Z misha $ #=============================================================================== use strict; use warnings; use Test::More; # last test to print # We need at least 1.14 version to check POD data eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); NetSDS-Util-1.044/t/03_pod_coverage.t0000444000076400007640000000125211227135004016111 0ustar mishamisha#!/usr/bin/env perl #=============================================================================== # # FILE: 03_pod_coverage.t # # DESCRIPTION: Check POD coverage # # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.0 # CREATED: 13.07.2008 23:54:48 EEST # REVISION: $Id: 03_pod_coverage.t 8 2008-07-13 21:11:35Z misha $ #=============================================================================== use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok(); NetSDS-Util-1.044/lib/0000755000076400007640000000000011254222717013302 5ustar mishamishaNetSDS-Util-1.044/lib/NetSDS/0000755000076400007640000000000011254222717014402 5ustar mishamishaNetSDS-Util-1.044/lib/NetSDS/Util/0000755000076400007640000000000011254222717015317 5ustar mishamishaNetSDS-Util-1.044/lib/NetSDS/Util/Struct.pm0000444000076400007640000000763311254220504017140 0ustar mishamishapackage NetSDS::Util::Struct; ######################################################################## # Misc Struct routines # ######################################################################## =head1 NAME NetSDS::Util::Struct - data structure convertors =head1 SYNOPSIS use NetSDS::Util::Struct; ... my $str = dump_to_row($some_structure); =head1 DESCRIPTION NetSDS::Util::Struct module contains different utilities for data structures processing. =cut use 5.8.0; use warnings 'all'; use strict; use base 'Exporter'; use version; our $VERSION = "1.044"; our @EXPORT = qw( dump_to_string dump_to_row arrays_to_hash to_array merge_hash ); use Scalar::Util qw( blessed reftype ); #*********************************************************************** =head1 EXPORTED METHODS =over =item B Returns cleaned dump to scalar. =cut #----------------------------------------------------------------------- sub dump_to_string { my $dmp = Data::Dumper->new( ( scalar(@_) > 1 ) ? [ \@_ ] : \@_, ['DUMP'] ); $dmp->Terse(0); $dmp->Deepcopy(0); $dmp->Sortkeys(1); $dmp->Quotekeys(0); $dmp->Indent(1); $dmp->Pair(': '); $dmp->Bless('obj'); return $dmp->Dump(); } #*********************************************************************** =item B Returns cleaned dump to scalar. =cut #----------------------------------------------------------------------- sub dump_to_row { my $str = dump_to_string(@_); if ( $str =~ s/^\s*\$DUMP\s+=\s+[{\[]\s+//s ) { $str =~ s/\s+[}\]];\s+$//s; } else { $str =~ s/^\s*\$DUMP\s+=\s+//s; $str =~ s/\s;\s+$//s; } $str =~ s/\$DUMP/\$/g; $str =~ s/\s+/ /g; $str =~ s/\\'/'/g; $str =~ s/\\undef/undef/g; $str =~ s/\\(\d)/$1/g; return $str; } #*********************************************************************** =item B =cut #----------------------------------------------------------------------- sub to_array { my ($data) = @_; if ( is_ref_array($data) ) { return $data; } elsif ( is_ref_hash($data) ) { return [ keys %{$data} ]; } elsif ( defined($data) ) { return [$data]; } else { return $data; } } #*********************************************************************** =item B - translate arrays to hash Parameters: references to keys array and values array Return: hash If @$keys_ref is longer than @$values_ref - rest of keys filled with C values. If @$keys_ref is shorter than @$values_ref - rest of values are discarded. If any of parameters isn't array reference then C will return. Example: my %h = array2hash(['fruit','animal'], ['apple','horse']); Result should be a hash: ( fruit => 'apple', animal => 'horse' ) =cut #----------------------------------------------------------------------- sub arrays_to_hash { my ( $keys_ref, $values_ref ) = @_; return undef unless ( is_ref_array($keys_ref) and is_ref_array($values_ref) ); my %h = (); for ( my $i = 0 ; $i < scalar(@$keys_ref) ; $i++ ) { $h{ $keys_ref->[$i] } = defined( $values_ref->[$i] ) ? $values_ref->[$i] : undef; } return %h; } #*********************************************************************** =item B - merge two hashes Parameters: references to target and source hashes. This method adds source hash to target one and return value as a result. =cut #----------------------------------------------------------------------- sub merge_hash { my ( $trg, $src ) = @_; while ( my ( $key, $val ) = each( %{$src} ) ) { if ( is_ref_hash($val) and is_ref_hash( $trg->{$key} ) ) { merge_hash( $trg->{$key}, $val ); } else { $trg->{$key} = $val; } } return $trg; } #************************************************************************** 1; __END__ =back =head1 EXAMPLES None =head1 BUGS Unknown yet =head1 TODO None =head1 SEE ALSO None =head1 AUTHORS Valentyn Solomko =cut NetSDS-Util-1.044/lib/NetSDS/Util/DateTime.pm0000444000076400007640000001213211253730062017342 0ustar mishamisha#=============================================================================== # # FILE: DateTime.pm # # DESCRIPTION: Common date/time processing utilities for NetSDS # # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # CREATED: 25.04.2008 15:55:01 EEST #=============================================================================== =head1 NAME NetSDS::Util::DateTime - common date/time processing routines =head1 SYNOPSIS use NetSDS::Util::DateTime; print "Current date: " . date_now(); =head1 DESCRIPTION This package provides set of routines for date and time processing. =cut package NetSDS::Util::DateTime; use 5.8.0; use strict; use warnings; use base 'Exporter'; use version; our $VERSION = '1.044'; our @EXPORT = qw( date_now_array date_now date_now_iso8601 date_strip date_date date_time time_from_string date_from_string date_inc date_inc_string ); use POSIX; use Time::Local; use Time::HiRes qw(gettimeofday clock_gettime); # Include parsing/formatting modules use HTTP::Date qw(parse_date); use Date::Parse qw(str2time); use Date::Format qw(time2str); #=============================================================================== =head1 EXPORTED FUNCTIONS =over =item B Returns array of date items for given date. If source date is not set current date used. =cut #----------------------------------------------------------------------- sub date_now_array { my ( $sec, $min, $hor, $mdy, $mon, $yer ) = localtime( (@_) ? $_[0] : time ); return ( $yer + 1900, $mon + 1, $mdy, $hor, $min, $sec ); } #*********************************************************************** =item B Return [given] date as string. 2001-12-23 14:39:53 =cut #----------------------------------------------------------------------- sub date_now { my ( $tm, $zn ) = @_; return ($zn) ? time2str( "%Y-%m-%d %T %z", $tm || time ) : time2str( "%Y-%m-%d %T", $tm || time ); } #*********************************************************************** =item B Return date as ISO 8601 string. 20011223T14:39:53Z L L =cut #----------------------------------------------------------------------- sub date_now_iso8601 { my ($tm) = @_; return time2str( "%Y%m%dT%H%M%S%z", $tm || time ); } #*********************************************************************** =item B Trim miliseconds from date. =cut #----------------------------------------------------------------------- sub date_strip { my ($date) = @_; $date =~ s/\.\d+// if ($date); return $date; } #*********************************************************************** =item B Trim time part from date. =cut #----------------------------------------------------------------------- sub date_date { my ($date) = @_; $date =~ s/[\sT]+.+$// if ($date); return $date; } #*********************************************************************** =item B Trim date part from date. =cut #----------------------------------------------------------------------- sub date_time { my ($date) = @_; unless ( defined ($date) ) { return undef; } my ($dateonly, $time) = split (/ /, $date); return $time; } #*********************************************************************** =item B Return parsed date/time structure. =cut #----------------------------------------------------------------------- sub time_from_string { my ($str) = @_; unless ($str) { return undef; } my $tm = Date::Parse::str2time($str); if ($tm) { return $tm; } $tm = parse_date($str); if ($tm) { return Date::Parse::str2time($tm); } return undef; } #*********************************************************************** =item B Return date from string representation. =cut #----------------------------------------------------------------------- sub date_from_string { my ($str) = @_; return date_now( time_from_string($str) ); } #*********************************************************************** =item B Return date incremented with given number of seconds. =cut #----------------------------------------------------------------------- sub date_inc { my ( $inc, $tm ) = @_; $tm ||= time; return date_now( $tm + $inc ); } #*********************************************************************** =item B Return string representation of date incremented with given number of seconds. =cut #----------------------------------------------------------------------- sub date_inc_string { my ( $inc, $tm ) = @_; return ($tm) ? date_inc( $inc, time_from_string($tm) ) : date_inc($inc); } 1; __END__ =back =head1 EXAMPLES None yet =head1 BUGS Unknown yet =head1 SEE ALSO L, L =head1 TODO Import stuff from Wono project =head1 AUTHOR Valentyn Solomko Michael Bochkaryov =cut NetSDS-Util-1.044/lib/NetSDS/Util/Misc.pm0000444000076400007640000001006111253730014016535 0ustar mishamisha#=============================================================================== # # FILE: Misc.pm # # DESCRIPTION: # # NOTES: --- # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.044 # CREATED: 17.08.2008 17:01:48 EEST #=============================================================================== =head1 NAME NetSDS::Util::Misc - miscelaneous utilities =head1 SYNOPSIS use NetSDS::Util::Misc; =head1 DESCRIPTION C module contains miscelaneous functions. =cut package NetSDS::Util::Misc; use 5.8.0; use warnings 'all'; use strict; use base 'Exporter'; use version; our $VERSION = '1.044'; our @EXPORT = qw( cmp_version usage get_cli make_uuid csv_num format_msisdn ); use Getopt::Long; use Pod::Usage; use Data::UUID; #*********************************************************************** =head1 EXPORTED FUNCTIONS =over =item B - compare versions Funcion comapres two version strings. =cut #----------------------------------------------------------------------- sub cmp_version { my ( $ver1, $ver2 ) = @_; return sprintf( "%03d.%03d", split( m/\./, $ver1 ) ) cmp sprintf( "%03d.%03d", split( m/\./, $ver2 ) ); } #*********************************************************************** =item B - print C text This function is wapper to L module printing POD to STDERR. =cut #----------------------------------------------------------------------- sub usage { pod2usage( -message => sprintf( shift(@_), @_ ), -verbose => 0, -exitval => 2, -output => \*STDERR ); } #*********************************************************************** =item B - get CLI parameters Return command line arguments =cut #----------------------------------------------------------------------- sub get_cli { my ( $res, @opa ) = @_; my $ret = undef; my @argv = @ARGV; # save @ARGV { # Switch off warnings because of other CLI parameters # still not known my $warn = $SIG{__WARN__}; $SIG{__WARN__} = sub { }; $ret = GetOptions( $res, @opa, 'help|h|?', 'man|m' ); $SIG{__WARN__} = $warn; } @ARGV = @argv; # restore @ARGV # GetOptions bug workaround # if ( !$ret ) { # pod2usage( -verbose => 0, -exitval => 2, -output => \*STDERR ); # } elsif ( exists( $res->{help} ) and $res->{help} ) { if ( exists( $res->{help} ) and $res->{help} ) { pod2usage( -verbose => 1, -exitval => 2, -output => \*STDERR ); } elsif ( exists( $res->{man} ) and $res->{man} ) { pod2usage( -verbose => 2, -exitval => 2, -output => \*STDERR ); } return $res; } ## end sub get_cli #*********************************************************************** =item B - make UUD string Create upper case UUID string. =cut #----------------------------------------------------------------------- sub make_uuid { return Data::UUID->new()->create_str(); } #*********************************************************************** =item B - format number for CSV Paramters: numeric value Returns: CSV formatted =cut sub csv_num { my ($num) = @_; $num =~ s/\./,/g; $num = "\"$num\""; return $num; } #*********************************************************************** =item B - format MSISDN Paramters: phone number Returns: well formed MSISDN without leading +. =cut #----------------------------------------------------------------------- sub format_msisdn { my ($msisdn) = @_; $msisdn =~ s/[\-\(\)\.\s]//g; if ( $msisdn =~ /^\+?(\d{12})$/ ) { return $1; } elsif ( $msisdn =~ /^\s*(\d{9,12})\s*$/ ) { return "380" . substr( $msisdn, length($1) - 9, 9 ); } else { return undef; } } #************************************************************************** 1; __END__ =back =head1 EXAMPLES None =head1 BUGS None =head1 TODO 1. Add other encodings support =head1 SEE ALSO L, L =head1 AUTHORS Valentyn Solomko Michael Bochkaryov =cut NetSDS-Util-1.044/lib/NetSDS/Util/Convert.pm0000444000076400007640000001122211253730050017262 0ustar mishamisha#=============================================================================== # # FILE: Convert.pm # # DESCRIPTION: Conversion between different data formats # # NOTES: --- # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # CREATED: 17.08.2008 17:01:48 EEST #=============================================================================== =head1 NAME NetSDS::Util::Convert - data formats conversion functions =head1 SYNOPSIS use NetSDS::Util::Convert qw(...); =head1 DESCRIPTION C module contains miscelaneous functions. =over =item * CLI parameters processing =item * types validation =item * HEX, Base64, URI, BCD encondig =item * UUID processing =back =cut package NetSDS::Util::Convert; use 5.8.0; use warnings 'all'; use strict; use base 'Exporter'; use version; our $VERSION = '1.044'; our @EXPORT = qw( conv_str_bcd conv_chr_hex conv_hex_chr conv_str_hex conv_hex_str conv_str_base64 conv_base64_str conv_str_uri conv_uri_str ); use MIME::Base64; use URI::Escape; #*********************************************************************** =head1 EXPORTED FUNCTIONS =over =item B - convert string to little-endian BCD This function converts string to little-endian BCD encoding filled with F16 value. =cut #----------------------------------------------------------------------- sub conv_conv_str_bcd { my ($str) = @_; $str = "$str" . 'F' x ( length("$str") % 2 ); $str =~ s/([\dF])([\dF])/$2$1/g; return conv_hex_str($str); } #*********************************************************************** =item B - encode char to hexadecimal string $hex = conv_chr_hex('a'); # return 61 =cut #----------------------------------------------------------------------- sub conv_chr_hex { my ($chr) = @_; return defined($chr) ? uc( unpack( "H2", "$chr" ) ) : "$chr"; } #*********************************************************************** =item B - convert hexadecimal string to character $chr = conv_hex_chr('4A'); # return 'J' =cut #----------------------------------------------------------------------- sub conv_hex_chr { my ($hex) = @_; return defined($hex) ? pack( "H2", "$hex" ) : "$hex"; } #*********************************************************************** =item B - convert byte string to hexadecimal $str = 'Want hex dump!'; $hex = conv_hex_str($str); print "Hex string: " . $hex; =cut #----------------------------------------------------------------------- sub conv_str_hex { my ($str) = @_; return defined($str) ? uc( unpack( "H*", "$str" ) ) : ""; } #*********************************************************************** =item B - convert hex to byte string $hex = '7A686F7061'; $string = conv_hex_str($hex); print "String from hex: " . $string; =cut #----------------------------------------------------------------------- sub conv_hex_str { my ($hex) = @_; return defined($hex) ? pack( "H*", "$hex" ) : ""; #"$hex"; } #*********************************************************************** =item B - convert string to Base64 my $b64 = str_base64("Hallo, people!"); =cut #----------------------------------------------------------------------- sub conv_str_base64 { my ($str) = @_; return encode_base64($str, ""); } #*********************************************************************** =item B - convert Base64 to string my $str = base64_str($base64_string); =cut #----------------------------------------------------------------------- sub conv_base64_str { my ($str) = @_; return decode_base64($str); } #*********************************************************************** =item B - convert string to URI encoded Example: my $uri = str_uri("http://www.google.com/?q=what"); =cut #----------------------------------------------------------------------- sub conv_str_uri { my ($str) = @_; return uri_escape( $str, "\x00-\xff" ); } #*********************************************************************** =item B - decode URI encoded string Example: my $str = uri_str($uri_string); =cut #----------------------------------------------------------------------- sub conv_uri_str { my ($str) = @_; return uri_unescape($str); } 1; __END__ =back =head1 EXAMPLES None =head1 BUGS None =head1 TODO 1. Add other encodings support =head1 SEE ALSO L, L =head1 AUTHORS Valentyn Solomko Michael Bochkaryov =cut NetSDS-Util-1.044/lib/NetSDS/Util/File.pm0000444000076400007640000002270111253730014016525 0ustar mishamisha#=============================================================================== # # FILE: File.pm # # DESCRIPTION: NetSDS utilities for file operations # # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.044 # CREATED: 16.07.2008 18:25:48 EEST #=============================================================================== =head1 NAME NetSDS::Util::File - file related utilities =head1 SYNOPSIS use NetSDS::Util::File qw(file_read); my $passwd = file_read('/etc/passwd'); file_move('/etc/passwd', '/tmp/find_this'); =head1 DESCRIPTION C module contains some routines for files and directories processing tasks like creating, reading, writing, copying and moving files and catalogs. This module of cource uses such well known things like L, L, L and others. =cut package NetSDS::Util::File; use 5.8.0; use strict; use warnings; use POSIX; use File::Spec; use File::Copy; use File::Path; use File::Temp (); use base 'Exporter'; use version; our $VERSION = "1.044"; our @EXPORT = qw( is_handle reset_handle file_open file_read file_write file_copy file_move file_temp dir_create dir_delete dir_read dir_read_recursive exec_external ); #*********************************************************************** =head1 EXPORTED FUNCTIONS =over =item B - check if argument is a file handle Paramters: some variable Returns: 1 if it's file handle or undef otherwise if (is_handle($var)) { reset_handle($fh); } =cut #----------------------------------------------------------------------- sub is_handle { my ( $fh, @list ) = @_; push( @list, qw(IO::Scalar IO::Handle GLOB) ); foreach my $class (@list) { if ( UNIVERSAL::isa( $fh, $class ) ) { return 1; } } return 0; } #*********************************************************************** =item B - reset file handle Paramters: file handle Returns: nothing This function tries to set filehandle to begin of file and set binmode on it. my $fh = file_open('/etc/passwd'); ... do something with file ... reset_handle($fh); # We can read it from the beginning =cut #----------------------------------------------------------------------- sub reset_handle { my ($fh) = @_; if ( $fh->can('binmode') ) { $fh->binmode; } else { binmode($fh); } if ( $fh->can('seek') ) { $fh->seek( 0, 0 ); } } #*********************************************************************** =item B - open file Paramters: file name or file handle Returns: file handle This function provides unified API for opening files. my $f = file_open('/etc/passwd'); =cut #----------------------------------------------------------------------- sub file_open { my $fil = shift; my $fh; my $st = 1; if ( ref($fil) ) { if ( is_handle($fil) ) { $fh = $fil; } else { require IO::File; $fh = IO::File->new; $st = $fh->fdopen( $fil, @_ ); } } else { require IO::File; $fh = IO::File->new; $st = $fh->open( $fil, @_ ); } if ($st) { reset_handle($fh); } else { return undef; } return $fh; } ## end sub file_open #*********************************************************************** =item B - read file to scalar Paramters: file name or file handle Returns: scalar content of file This function provides ability to read file content to scalar variable. my $data = file_read('/etc/passwd'); print "Passwords file: $data\n"; =cut #----------------------------------------------------------------------- sub file_read { my $fil = shift; my $bin = undef; my $fh = file_open( $fil, ( scalar(@_) > 0 ) ? @_ : 'r' ); if ( defined($fh) ) { local $/ = undef; $bin = <$fh>; $fh->close; $/ = "\n"; } return $bin; } #*********************************************************************** =item B - write scalar data to file Paramters: file name or open file handle Returns: length of written data or undef in case of error my $data = 'This should be file'; file_write('/tmp/file.dat', $data); =cut #----------------------------------------------------------------------- sub file_write { my $fil = shift; my $bin = shift; my $fh = file_open( $fil, ( scalar(@_) > 0 ) ? @_ : 'w+' ); if ( defined($fh) ) { $fh->print($bin); $fh->close; return bytes::length($bin); } else { return undef; } } #*********************************************************************** =item B - copy file Paramters: input file name, output file name Returns: This function copy file to new location. =cut #----------------------------------------------------------------------- sub file_copy { my ( $ifl, $ofl ) = @_; if ( is_handle($ifl) ) { reset_handle($ifl); } if ( copy( $ifl, $ofl ) ) { return 1; } else { return undef; } } #*********************************************************************** =item B - move file Paramters: input file name, output file name Returns: 1 or undef This function moves old file to new location. =cut #----------------------------------------------------------------------- sub file_move { my ( $ifl, $ofl ) = @_; if ( is_handle($ifl) ) { reset_handle($ifl); } if ( move( $ifl, $ofl ) ) { return 1; } else { return undef; } } #*********************************************************************** =item B - create temporary file Creates new temp file and return its handle =cut #----------------------------------------------------------------------- sub file_temp { my ($dir) = @_; my %params = (); if ($dir) { $params{DIR} = $dir; } my $fh = File::Temp->new(%params); return $fh; } #*********************************************************************** =item B - create directory with parents Paramters: directory name Returns: directory name or undef # Will create all parent catalogs if necessary dir_create('/var/log/NetSDS/xxx'); =cut #----------------------------------------------------------------------- sub dir_create { my ( $dir, $mode ) = @_; $mode ||= 0777 & ~umask(); my $ret = ''; eval { $ret = mkpath( $dir, 0, $mode ); }; if ($@) { return undef; } return $dir; } #*********************************************************************** =item B - remove directory recursive Paramters: directory name Returns: dir name or undef if error print "We need no libs!"; dir_delete('/usr/lib'); =cut #----------------------------------------------------------------------- sub dir_delete { my ($dir) = @_; my $ret = ''; eval { $ret = rmtree( $dir, 0, 1 ); }; if ($@) { return undef; } return $dir; } #*********************************************************************** =item B - read files list from catalog Paramters: directory name, extension of files to read Returns: list of files in catalog my @logs = @{ dir_read('/var/log/httpd', 'log') }; print "Logs are: " . join (', ', @logs); =cut #----------------------------------------------------------------------- sub dir_read { my ( $dir, $end ) = @_; if ( opendir( DIR, $dir ) ) { my @con = ( defined($end) ) ? sort grep { $_ !~ m/^[.]{1,2}$/ and $_ =~ m/^.+\.$end$/i } readdir(DIR) : sort grep { $_ !~ m/^[.]{1,2}$/ } readdir(DIR); closedir(DIR); return \@con; } else { return undef; } } #*********************************************************************** =item B - read all files list recursive Paramters: $start catalog, $extension Returns: list of files with extension from parameters my $tpls = dir_read_recursive('/etc/NetSDS', 'tmpl'); foreach my $tpl (@$tpls) { pritn "Template: $tpl\n"; } =cut #----------------------------------------------------------------------- sub dir_read_recursive { my ( $dir, $ext, $res ) = @_; $res ||= []; my $con = dir_read($dir); if ( defined($con) ) { foreach my $nam ( @{$con} ) { my $fil = "$dir/$nam"; if ( -d $fil ) { dir_read_recursive( $fil, $ext, $res ); } elsif ( $nam =~ m/^.+\.$ext$/i ) { push( @{$res}, $fil ); } } return $res; } else { return undef; } } ## end sub dir_read_recursive #*********************************************************************** =item B - execute external program Paramters: pragram name, arguments list (see perldoc -f system) Returns: 1 if ok, undef otherwise This function calls system() with given parameters and returns 1 if everything happened correctly (program executed and returned correct result). if (exec_external('/bin/rm', '-rf', '/')) { print "Hey! We removed the world!"; } =cut #----------------------------------------------------------------------- sub exec_external { my $rc = system(@_); if ( $rc == -1 ) { return undef; } elsif ( $rc & 127 ) { return undef; } else { my $cd = $rc >> 8; if ( $cd == 0 ) { return 1; } else { return undef; } } } #----------------------------------------------------------------------- 1; __END__ =back =head1 EXAMPLES None yet =head1 BUGS Unknown yet =head1 SEE ALSO L, L, L, L, L, L, L =head1 TODO 1. Implement more detailed error handling =head1 AUTHOR Valentyn Solomko Michael Bochkaryov =cut NetSDS-Util-1.044/lib/NetSDS/Util/Translit.pm0000444000076400007640000001474411254222413017456 0ustar mishamisha#=============================================================================== # # FILE: Translit.pm # # DESCRIPTION: Cyrillic transliteration routines # # NOTE: This module ported from Wono framework "as is" # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.044 # CREATED: 03.08.2008 15:04:22 EEST #=============================================================================== =head1 NAME NetSDS::Util::Translit - transliteration routines =head1 SYNOPSIS use NetSDS::Const; use NetSDS::Util::Translit; # Transliterate cyrillic string $trans_string = trans_cyr_lat($cyr_string); # Reverse transliteration to russian language $rus_string = trans_lat_cyr("Vsem privet", LANG_RU); =head1 DESCRIPTION C module contains routines for bidirectional cyrillic text transliteration. Now it supports russian and ukrainian languages processing. =cut package NetSDS::Util::Translit; use 5.8.0; use warnings 'all'; use strict; use base 'Exporter'; use version; our $VERSION = '1.044'; use NetSDS::Util::String; our @EXPORT = qw( trans_cyr_lat trans_lat_cyr ); use constant LANG_BE => 'be'; use constant LANG_EN => 'en'; use constant LANG_RU => 'ru'; use constant LANG_UK => 'uk'; use constant DEFAULT_LANG => LANG_RU; my %PREP = ( LANG_RU() => { 'а' => 'a', 'б' => 'b', 'в' => 'v', 'г' => 'g', 'д' => 'd', 'е' => 'e', 'ё' => 'yo', 'ж' => 'zh', 'з' => 'z', 'и' => 'i', 'й' => 'j', 'к' => 'k', 'л' => 'l', 'м' => 'm', 'н' => 'n', 'о' => 'o', 'п' => 'p', 'р' => 'r', 'с' => 's', 'т' => 't', 'у' => 'u', 'ф' => 'f', 'х' => 'kh', 'ц' => 'tc', 'ч' => 'ch', 'ш' => 'sh', 'щ' => 'sch', 'ъ' => '"', 'ы' => 'y', 'ые' => 'yje', 'ыё' => 'yjo', 'ыу' => 'yiu', 'ыю' => 'yju', 'ыя' => 'yja', 'ь' => "'", 'ье' => 'jie', 'ьё' => 'jio', 'ью' => 'jiu', 'ья' => 'jia', 'э' => 'ye', 'ю' => 'yu', 'я' => 'ya', }, LANG_UK() => { "'" => '"', 'а' => 'a', 'б' => 'b', 'в' => 'v', 'ґ' => 'g', 'г' => 'h', 'д' => 'd', 'е' => 'e', 'є' => 'ye', 'ж' => 'zh', 'з' => 'z', 'і' => 'i', 'и' => 'y', 'ї' => 'yi', 'й' => 'j', 'к' => 'k', 'л' => 'l', 'м' => 'm', 'н' => 'n', 'о' => 'o', 'п' => 'p', 'р' => 'r', 'с' => 's', 'т' => 't', 'у' => 'u', 'ф' => 'f', 'х' => 'kh', 'ц' => 'tc', 'ч' => 'ch', 'ш' => 'sh', 'щ' => 'sch', 'ь' => "'", 'ю' => 'yu', 'я' => 'ya', }, LANG_BE() => { "'" => '"', 'а' => 'a', 'б' => 'b', 'в' => 'v', 'ґ' => 'g', 'г' => 'h', 'д' => 'd', 'е' => 'ye', 'ё' => 'yo', 'ж' => 'zh', 'з' => 'z', 'і' => 'i', 'и' => 'i', 'ї' => 'yi', 'й' => 'j', 'к' => 'k', 'л' => 'l', 'м' => 'm', 'н' => 'n', 'о' => 'o', 'п' => 'p', 'р' => 'r', 'с' => 's', 'т' => 't', 'у' => 'u', 'ў' => 'w', 'ф' => 'f', 'х' => 'kh', 'ц' => 'tc', 'ч' => 'ch', 'ш' => 'sh', 'щ' => 'sch', 'ы' => 'y', 'ые' => 'yje', 'ыё' => 'yjo', 'ыу' => 'yiu', 'ыю' => 'yju', 'ыя' => 'yja', 'ь' => "'", 'ье' => 'jie', 'ьё' => 'jio', 'ью' => 'jiu', 'ья' => 'jia', 'э' => 'e', 'ю' => 'yu', 'я' => 'ya', }, ); my %TO_LAT = (); my %TO_CYR = (); #********************************************************************************************* sub _prep_translit { my ($lang) = @_; return if ( $PREP{prepared}->{$lang} ); my $rfw = {}; my $rbw = {}; while ( my ( $fw, $bw ) = each %{ $PREP{$lang} } ) { $fw = str_encode($fw); $bw = str_encode($bw); my $lf = length($fw); my $lb = length($bw); if ( ( $lf == 1 ) and ( $lb == 1 ) ) { $rfw->{0}->{ uc($fw) } = uc($bw); $rfw->{0}->{ ucfirst($fw) } = ucfirst($bw); $rfw->{0}->{$fw} = $bw; $rbw->{0}->{ uc($bw) } = uc($fw); $rbw->{0}->{ ucfirst($bw) } = ucfirst($fw); $rbw->{0}->{$bw} = $fw; } else { $rfw->{$lf}->{ uc($fw) } = uc($bw); $rfw->{$lf}->{ ucfirst($fw) } = ucfirst($bw); $rfw->{$lf}->{$fw} = $bw; $rbw->{$lb}->{ uc($bw) } = uc($fw); $rbw->{$lb}->{ ucfirst($bw) } = ucfirst($fw); $rbw->{$lb}->{$bw} = $fw; } } ## end while ( my ( $fw, $bw ) =... $TO_LAT{$lang} = []; foreach my $ord ( reverse sort { $a <=> $b } keys %{$rfw} ) { my $tra = $rfw->{$ord}; my $fnd = join( '|', keys %{$tra} ); push( @{ $TO_LAT{$lang} }, [ $fnd, $tra ] ); } $TO_CYR{$lang} = []; foreach my $ord ( reverse sort { $a <=> $b } keys %{$rbw} ) { my $tra = $rbw->{$ord}; my $fnd = join( '|', keys %{$tra} ); push( @{ $TO_CYR{$lang} }, [ $fnd, $tra ] ); } $PREP{prepared}->{$lang} = 1; } ## end sub _prep_translit #********************************************************************************************* =head1 EXPORTS =over =item B - transliterate string Convert text from cyrillic to latin encoding. Language may be set if not default one. $lat = trans_cyr_lat($string); =cut #----------------------------------------------------------------------- sub trans_cyr_lat { my ( $text, $lang ) = @_; $lang ||= DEFAULT_LANG(); _prep_translit($lang); $text = str_encode($text); foreach my $row ( @{ $TO_LAT{$lang} } ) { my ( $fnd, $has ) = @{$row}; $text =~ s/($row->[0])/$row->[1]->{$1}/ge; } $text =~ s/[^\x{0}-\x{7f}]+/\?/g; return str_decode($text); } #********************************************************************************************* =item B - reverse transliteration This function transliterate string from latin encoding to cyrillic one. Target language may be set if not default one. $cyr = trans_lat_cyr("Sam baran", "ru"); =cut #----------------------------------------------------------------------- sub trans_lat_cyr { my ( $text, $lang ) = @_; $lang ||= DEFAULT_LANG(); _prep_translit($lang); $text = str_encode($text); $text =~ s/[^\x{0}-\x{7f}]+/\?/g; foreach my $row ( @{ $TO_CYR{$lang} } ) { my ( $fnd, $has ) = @{$row}; $text =~ s/($row->[0])/$row->[1]->{$1}/sg; } return str_decode($text); } 1; __END__ =back =head1 EXAMPLES None yet =head1 BUGS Unknown yet =head1 TODO Implement examples and tests. =head1 SEE ALSO L, L =head1 AUTHORS Valentyn Solomko =cut NetSDS-Util-1.044/lib/NetSDS/Util/String.pm0000444000076400007640000001616511254220614017124 0ustar mishamisha#=============================================================================== # # FILE: String.pm # # DESCRIPTION: Utilities for easy string processing # # NOTE: This module ported from Wono framework # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.044 # CREATED: 03.08.2008 15:04:22 EEST #=============================================================================== =head1 NAME NetSDS::Util::String - string prcessing routines =head1 SYNOPSIS use NetSDS::Util::String qw(); # Read from standard input my $string = ; # Encode string to internal structure $string = string_encode($tring); =head1 DESCRIPTION C module contains functions may be used to quickly solve string processing tasks like parsing, recoding, formatting. As in other NetSDS modules standard encoding is UTF-8. =cut package NetSDS::Util::String; use 5.8.0; use warnings 'all'; use strict; use base 'Exporter'; use version; our $VERSION = '1.044'; our @EXPORT = qw( str_encode str_decode str_recode str_trim str_trim_left str_trim_right str_clean str_camelize str_decamelize ); use POSIX; use Encode qw( encode decode encode_utf8 decode_utf8 from_to is_utf8 ); my $BLANK = "[:blank:][:space:][:cntrl:]"; use constant DEFAULT_ENCODING => 'UTF-8'; #*********************************************************************** # # ENCODING/DECODING/RECODING FUNCTIONS # #*********************************************************************** =head1 EXPORTED FUNCTIONS =over =item B - encode string to internal UTF-8 By default this function treat first argument as byte string in UTF-8 and return it's internal Unicode representation. In case of external character set isn't UTF-8 it should be added as second argument of function. # Convert UTF-8 byte string to internal Unicode representation $uni_string = str_encode($byte_string); # Convert KOI8-U byte string to internal $uni_string = str_encode($koi8_string, 'KOI8-U'); After C it's possible to process this string correctly including regular expressions. All characters will be understood as UTF-8 symbols instead of byte sequences. =cut #----------------------------------------------------------------------- sub str_encode { my ( $txt, $enc ) = @_; if ( defined($txt) and ( $txt ne '' ) ) { unless ( is_utf8($txt) ) { $txt = decode( $enc || DEFAULT_ENCODING, $txt ); } } return $txt; } #*********************************************************************** =item B - decode internal UTF-8 to byte string By default this function treat first argument as string in internal UTF-8 and return it in byte string (external) representation. In case of external character set isn't UTF-8 it should be added as second argument of function. # Get UTF-8 byte string from internal Unicode representation $byte_string = str_decode($uni_string); # Convert to KOI8-U byte string from internal Unicode $koi8_string = str_encode($uni_string, 'KOI8-U'); It's recommended to use C when preparing data for communication with external systems (especially networking). =cut #----------------------------------------------------------------------- sub str_decode { my ( $txt, $enc ) = @_; if ( defined($txt) and ( $txt ne '' ) ) { if ( is_utf8($txt) ) { $txt = encode( $enc || DEFAULT_ENCODING, $txt ); } } return $txt; } #*********************************************************************** =item B - recode string Translate string between different encodings. If target encoding is not set UTF-8 used as default one. =cut #----------------------------------------------------------------------- sub str_recode { my ( $txt, $enc, $trg ) = @_; if ( defined($txt) and ( $txt ne '' ) ) { if ($enc) { my $len = from_to( $txt, $enc, $trg || DEFAULT_ENCODING ); unless ( defined($len) ) { $txt = undef; } } } return $txt; } #*********************************************************************** # # CLEANING STRINGS # #*********************************************************************** =item B - remove leading/trailing space characters $orig_str = " string with spaces "; $new_str = str_trim($orig_str); # Output: "string with spaces" print $new_str; =cut #----------------------------------------------------------------------- sub str_trim { my ($s) = @_; if ( defined($s) and ( $s ne '' ) ) { $s =~ s/^[$BLANK]+//s; $s =~ s/[$BLANK]+$//s; } return $s; } #*********************************************************************** =item B - removes leading whitespaces This function is similar to C except of it removes only leading space characters and leave trailing ones. =cut #----------------------------------------------------------------------- sub str_trim_left { my ($s) = @_ ? @_ : $_; if ( defined($s) and ( $s ne '' ) ) { $s =~ s/^[$BLANK]+//s; } return $s; } #*********************************************************************** =item B - removes trailing whitespaces This function is similar to C except of it removes only trailing space characters and leave leading ones. =cut #----------------------------------------------------------------------- sub str_trim_right { my ($s) = @_ ? @_ : $_; if ( defined($s) and ( $s ne '' ) ) { $s =~ s/[$BLANK]+$//s; } return $s; } #*********************************************************************** =item B - clean string from extra spaces Function is similar to C but also changes all spacing chains inside string to single spaces. =cut #----------------------------------------------------------------------- sub str_clean { my ($txt) = @_; if ( defined($txt) and ( $txt ne '' ) ) { $txt =~ s/^[$BLANK]+//s; $txt =~ s/[$BLANK]+$//s; $txt =~ s/[$BLANK]+/ /gs; } return $txt; } #************************************************************************** =item B If pass undef - return undef. If pass '' - return ''. Examples: # returns 'getValue' str_camelize( 'get_value' ) # returns 'addUserAction' str_camelize( 'ADD_User_actION' ) =cut #----------------------------------------------------------------------- sub str_camelize { my $s = shift; if ( defined($s) and ( $s ne '' ) ) { $s = lc($s); $s =~ s/_([0-9a-z])/\U$1/g; } return $s; } #************************************************************************** =item B If pass undef - return undef. If pass '' - return ''. Examples: # returns 'get_value' str_decamelize( 'getValue' ) =cut #----------------------------------------------------------------------- sub str_decamelize { my $s = shift; $s =~ s/([A-Z])/_\L$1/g; return lc($s); } 1; __END__ =back =head1 EXAMPLES None yet =head1 BUGS Unknown yet =head1 TODO Implement examples and tests. =head1 SEE ALSO L, L =head1 AUTHORS Valentyn Solomko Michael Bochkaryov =cut NetSDS-Util-1.044/lib/NetSDS/Util/Types.pm0000444000076400007640000001170111253730014016750 0ustar mishamisha#=============================================================================== # # FILE: Types.pm # # DESCRIPTION: # # NOTES: --- # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # VERSION: 1.044 # CREATED: 17.08.2008 17:01:48 EEST #=============================================================================== =head1 NAME NetSDS::Util::Types - type checking routines =head1 SYNOPSIS use NetSDS::Util::Types; # Check if variable contains integer value if (is_int($var)) { $var++; } else { print "Value is not integer!"; } =head1 DESCRIPTION C module contains functions for checking data for being of exact data types. =cut package NetSDS::Util::Types; use 5.8.0; use warnings 'all'; use strict; use base 'Exporter'; use version; our $VERSION = '1.044'; use POSIX; use Scalar::Util qw( blessed reftype ); our @EXPORT = qw( is_int is_float is_date is_binary is_ref_scalar is_ref_array is_ref_hash is_ref_code is_ref_obj ); #*********************************************************************** =head1 EXPORTED FUNCTIONS =over =item B - check if parameter is integer Check if given parameter is integer =cut #----------------------------------------------------------------------- sub is_int { my ($value) = @_; return 0 unless defined $value; return ( ( $value =~ /^[-+]?\d+$/ ) and ( $value >= INT_MIN ) and ( $value <= INT_MAX ) ) ? 1 : 0; } #*********************************************************************** =item B - check if parameter is float number Check if given parameter is float number =cut #----------------------------------------------------------------------- sub is_float { my ($value) = @_; return 0 unless defined $value; # return ( ( $value =~ m/^[-+]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([-+]?\d+))?$/ ) and ( ( $value >= 0 ) and ( $value >= DBL_MIN() ) and ( $value <= DBL_MAX() ) ) or ( ( $value < 0 ) and ( $value >= -DBL_MAX() ) and ( $value <= -DBL_MIN() ) ) ) ? 1 : 0; return ( $value =~ m/^[-+]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([-+]?\d+))?$/ ) ? 1 : 0; } #*********************************************************************** =item B - check if parameter is date string Return 1 if parameter is date string =cut #----------------------------------------------------------------------- sub is_date { my ($value) = @_; return 0 unless defined $value; return ( $value =~ m/^\d{8}T\d{2}:\d{2}:\d{2}(Z|[-+]\d{1,2}(?::\d{2})*)$/ ) ? 1 : 0; } #*********************************************************************** =item B - check for binary content Return 1 if parameter is non text. =cut #----------------------------------------------------------------------- sub is_binary { my ($value) = @_; if ( has_utf8($value) ) { return 0; } else { return ( $value =~ m/[^\x09\x0a\x0d\x20-\x7f[:print:]]/ ) ? 1 : 0; } } #************************************************************************** =item B - check if reference to scalar value Return true if parameter is a scalar reference. my $var = 'Scalar string'; if (is_ref_scalar(\$var)) { print "It's scalar value"; } =cut #----------------------------------------------------------------------- sub is_ref_scalar { my $ref = reftype( $_[0] ); return ( $ref and ( $ref eq 'SCALAR' ) ) ? 1 : 0; } #*********************************************************************** =item B - check if reference to array Return true if parameter is an array reference. =cut #----------------------------------------------------------------------- sub is_ref_array { my $ref = reftype( $_[0] ); return ( $ref and ( $ref eq 'ARRAY' ) ) ? 1 : 0; } #*********************************************************************** =item B - check if hashref Return true if parameter is a hash reference. =cut #----------------------------------------------------------------------- sub is_ref_hash { my $ref = reftype( $_[0] ); return ( $ref and ( $ref eq 'HASH' ) ) ? 1 : 0; } #*********************************************************************** =item B - check if code reference Return true if parameter is a code reference. =cut #----------------------------------------------------------------------- sub is_ref_code { my $ref = reftype( $_[0] ); return ( $ref and ( $ref eq 'CODE' ) ) ? 1 : 0; } #*********************************************************************** =item B - check if blessed object Return true if parameter is an object. =cut #----------------------------------------------------------------------- sub is_ref_obj { return blessed( $_[0] ) ? 1 : 0; } 1; __END__ =back =head1 EXAMPLES None =head1 BUGS None =head1 TODO Add more functions. =head1 SEE ALSO None. =head1 AUTHORS Valentyn Solomko Michael Bochkaryov =cut NetSDS-Util-1.044/lib/NetSDS/Util/FileImport.pm0000444000076400007640000001046011253730014017717 0ustar mishamisha =head1 NAME NetSDS::Util::FileImport - import table structure from file =head1 SYNOPSIS =head1 DESCRIPTION =cut package NetSDS::Util::FileImport; use 5.8.0; use strict; use warnings; use File::MMagic; # Determine MIME type of file use Spreadsheet::Read; # Parse spreadsheet files use base 'Exporter'; use version; our $VERSION = "1.044"; our @EXPORT = qw( import_table ); # TODO use constant PREVIEW_LIMIT => 5; # Number of records to process for previews =head1 CLASS API =over =item B - import table data from file takes $content of a file, $pre_parse (true or false it means: return all table or only 5 first rows params it could be patterns => { qr#name#i => { qr#last#i => 'last_name', qr#first#i => 'first_name' } } separator => could be ,;\t: fields => [ email last_name ] substitute => { E-mail => email, Last Name => last_name, .. } Depends of a params parse would be different Returns a structure like this [ { last_name => undef, first_name => yana, ... }, { last_name => kornienko, first_name => test, ... } .. ] =cut sub import_table($;$$) { my ( $file_name, $params, $pre_parse ) = @_; my ( $separator, $data, $rows ) = ( $params->{'separator'}, [], [] ); return "Can't find file [$file_name]." unless -e $file_name; # [ { 'last_name' => 'my name', 'First Name' => 'my first name' ... }, {'last_name' => undef, 'First Name' => 'test_name' ... } ... ] my @title = (); if ( File::MMagic->new->checktype_filename($file_name) eq 'text/plain' ) { open my $FILE, '<', $file_name or return $!; my @lines = <$FILE>; chomp for @lines; close $FILE; $lines[0] =~ s/^["']|["']$//; $separator ||= ( $lines[0] =~ m![\w\s"]+?([,;:\t])! )[0]; return "Parse error while parsing csv file" unless $separator; $lines[0] =~ s/["']$//; @title = split /["']{0,1}$separator["']{0,1}/, $lines[0]; my @rows = ( ( $pre_parse and @lines > PREVIEW_LIMIT ) ? @lines[ 1 .. PREVIEW_LIMIT + 1 ] : @lines ); $rows = [ map { [ split /["']*$separator["']*/, $_ ] } grep { ( $_ and $_ =~ s/^['"]// ) or $_ } @rows ]; } else { my $struct = ReadData($file_name); return "Parse error while parsing data xls file" unless $struct; my @content = @{ $struct->[1]{'cell'} }; @title = map { $content[$_]->[1] } 1 .. $#content; my $count = ( ( $pre_parse and @{ $content[1] } > ( PREVIEW_LIMIT + 2 ) ) ? PREVIEW_LIMIT : scalar @{ $content[1] } - 1 ); for my $i ( 2 .. $count ) { push @$rows, [ map { $content[$_]->[$i] } 1 .. @title ]; } } my @original_fields = @title; if ( $params->{'patterns'} ) { _order_data_by_patterns( \@title, $params->{'patterns'} ); } elsif ( $params->{'fields'} ) { #return only specific fields that has the same name _order_data_by_fields( $data, \@title, $params->{'fields'}, $rows ); return $data; } elsif ( $params->{'substitute'} ) { #return only specific fields the names of which has been changed _order_data_with_substitute( $data, \@title, $params->{'substitute'}, $rows ); return $data; } for my $row (@$rows) { push @$data, { map { ( $title[$_] => $row->[$_] ) } 0 .. $#title }; } return wantarray ? ( $data, \@original_fields ) : $data; } ## end sub import_table($;$$) sub _order_data_by_patterns($$) { my ( $title, $patterns ) = @_; for ( my $i = 0 ; $title->[$i] ; $i++ ) { #TODO multi for my $pattern ( keys %$patterns ) { if ( $title->[$i] =~ $pattern ) { if ( ref $patterns->{$pattern} ) { for my $subpattern ( keys %{ $patterns->{$pattern} } ) { if ( $title->[$i] =~ $subpattern ) { $title->[$i] = $patterns->{$pattern}{$subpattern}; last; } } } else { $title->[$i] = $patterns->{$pattern}; } } } } } ## end sub _order_data_by_patterns($$) sub _order_data_by_fields($$$$) { my ( $data, $title, $fields, $rows ) = @_; my @res = (); for my $field (@$fields) { for ( my $i = 0 ; $title->[$i] ; $i++ ) { if ( $title->[$i] eq $field ) { push @res, $i; last; } } } for my $row (@$rows) { push @$data, { map { ( $title->[$_] => $row->[$_] ) } @res }; } } sub _order_data_with_substitute($$$$) { my ( $data, $title, $substitute, $rows ) = @_; my $pattern = join '|', map { quotemeta $_ } keys %$substitute; $_ =~ s/^($pattern)$/$substitute->{$1}/ for @$title; _order_data_by_fields( $data, $title, [ values %$substitute ], $rows ); } 1; NetSDS-Util-1.044/lib/NetSDS/Util.pm0000444000076400007640000000473011254221724015654 0ustar mishamisha#=============================================================================== # # FILE: Util.pm # # DESCRIPTION: NetSDS utilities # # AUTHOR: Michael Bochkaryov (Rattler), # COMPANY: Net.Style # CREATED: 24.07.2009 09:38:14 UTC #=============================================================================== =head1 NAME NetSDS::Util - supplementary NetSDS packages =head1 SYNOPSIS use NetSDS::Util::Convert; use NetSDS::Util::String; my $trim_str = str_trim(" Some string with leading and trailing "); =head1 DESCRIPTION C modules contains functions useful for everyday tasks. =over =item B - data format conversions =item B - processing date and time =item B - work with files and catalogs =item B - processing spreadsheet files =item B - miscelaneous routines =item B - text and binary strings processing =item B - data structures conversion =item B - transliteration =item B - work with data types =back =cut package NetSDS::Util; use 5.8.0; use strict; use warnings; use version; our $VERSION = "1.044"; 1; __END__ =head1 BUGS Unknown yet =head1 SEE ALSO L L L L L L L, L L =head1 TODO Implement functional tests. =head1 AUTHOR Valentyn Solomko Michael Bochkaryov Yana Kornienko =head1 LICENSE Copyright (C) 2008-2009 Michael Bochkaryov This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =cut NetSDS-Util-1.044/META.yml0000444000076400007640000000321311254222717014002 0ustar mishamisha--- name: NetSDS-Util version: 1.044 author: - 'Net.Style Development Team ' abstract: Utility Perl5 modules for NetSDS VAS development framework license: gpl resources: license: http://www.opensource.org/licenses/gpl-license.php requires: Data::UUID: 1.000 Date::Format: 0 Date::Parse: 0 Encode: 2.000 File::Copy: 0 File::MMagic: 1.000 File::Path: 0 File::Spec: 0 File::Temp: 0 Getopt::Long: 0 HTTP::Date: 0 IO::File: 0 MIME::Base64: 0 POSIX: 0 Pod::Usage: 0 Scalar::Util: 0 Spreadsheet::Read: 0.30 Time::HiRes: 0 Time::Local: 0 URI: 1.00 URI::Escape: 1.00 perl: 5.008 version: 0 build_requires: Module::Build: 0 Test::More: 0 Test::Pod: 1.20 Test::Pod::Coverage: 1.08 provides: NetSDS::Util: file: lib/NetSDS/Util.pm version: 1.044 NetSDS::Util::Convert: file: lib/NetSDS/Util/Convert.pm version: 1.044 NetSDS::Util::DateTime: file: lib/NetSDS/Util/DateTime.pm version: 1.044 NetSDS::Util::File: file: lib/NetSDS/Util/File.pm version: 1.044 NetSDS::Util::FileImport: file: lib/NetSDS/Util/FileImport.pm version: 1.044 NetSDS::Util::Misc: file: lib/NetSDS/Util/Misc.pm version: 1.044 NetSDS::Util::String: file: lib/NetSDS/Util/String.pm version: 1.044 NetSDS::Util::Struct: file: lib/NetSDS/Util/Struct.pm version: 1.044 NetSDS::Util::Translit: file: lib/NetSDS/Util/Translit.pm version: 1.044 NetSDS::Util::Types: file: lib/NetSDS/Util/Types.pm version: 1.044 generated_by: Module::Build version 0.2808 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.2.html version: 1.2 NetSDS-Util-1.044/Changes0000444000076400007640000000164011254222140014014 0ustar mishamishaTODO: - import XML processing routines * Wed Sep 16 2009 Michael Bochkaryov 1.044 - fix annoying requirements to main NetSDS packages * Tue Sep 15 2009 Michael Bochkaryov 1.043 - fix tmpnam() function redefine in file utilities - add ImportFile.pm module for spreadsheets parsing * Fri Jul 24 2009 Michael Bochkaryov 1.040 - changed version to be compatible with ALT Linux autoprovides - drop Base64 strings separation into lines - added NetSDS::Util module (stubber yet) * Mon Jul 20 2009 Michael Bochkaryov 1.04 - imported all routines from older versions * Fri Jul 17 2009 Michael Bochkaryov 1.03 - file processing utilities added * Tue Jul 14 2009 Michael Bochkaryov 1.02 - initial import from perl-NetSDS-common - string processing routines - data formats conversions (HEX, Base64, URI encoding) NetSDS-Util-1.044/MANIFEST0000444000076400007640000000056011254222715013662 0ustar mishamishaBuild.PL Changes lib/NetSDS/Util.pm lib/NetSDS/Util/Convert.pm lib/NetSDS/Util/DateTime.pm lib/NetSDS/Util/File.pm lib/NetSDS/Util/FileImport.pm lib/NetSDS/Util/Misc.pm lib/NetSDS/Util/String.pm lib/NetSDS/Util/Struct.pm lib/NetSDS/Util/Translit.pm lib/NetSDS/Util/Types.pm Makefile.PL MANIFEST This list of files META.yml t/01_load.t t/02_pod.t t/03_pod_coverage.t NetSDS-Util-1.044/Makefile.PL0000444000076400007640000000315511254222717014510 0ustar mishamisha# Note: this file was auto-generated by Module::Build::Compat version 0.03 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'NetSDS::Util', 'VERSION_FROM' => 'lib/NetSDS/Util.pm', 'PREREQ_PM' => { 'Data::UUID' => '1.000', 'Date::Format' => '0', 'Date::Parse' => '0', 'Encode' => '2.000', 'File::Copy' => '0', 'File::MMagic' => '1.000', 'File::Path' => '0', 'File::Spec' => '0', 'File::Temp' => '0', 'Getopt::Long' => '0', 'HTTP::Date' => '0', 'IO::File' => '0', 'MIME::Base64' => '0', 'Module::Build' => '0', 'POSIX' => '0', 'Pod::Usage' => '0', 'Scalar::Util' => '0', 'Spreadsheet::Read' => '0.30', 'Test::More' => '0', 'Test::Pod' => '1.20', 'Test::Pod::Coverage' => '1.08', 'Time::HiRes' => '0', 'Time::Local' => '0', 'URI' => '1.00', 'URI::Escape' => '1.00', 'version' => '0' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; NetSDS-Util-1.044/Build.PL0000444000076400007640000000337311254221274014031 0ustar mishamisha#!/usr/bin/env perl ######################################################################## # $Id: Build.PL 27 2008-07-21 23:23:15Z anvil $ ######################################################################## =head1 NAME Build.PL - Build script generator for NetSDS common =head1 SYNOPSIS perl Build.PL ./Build ./Build test ./Build install =cut use strict; use warnings 'all'; use Module::Build; my $build = Module::Build->new( module_name => 'NetSDS::Util', dist_abstract => 'Utility Perl5 modules for NetSDS VAS development framework', create_makefile_pl => 'traditional', dist_author => 'Net.Style Development Team ', create_readme => '0', license => 'gpl', build_requires => { 'Test::More' => '0', 'Test::Pod' => '1.20', 'Test::Pod::Coverage' => '1.08', 'Module::Build' => '0', }, requires => { 'perl' => '5.008', 'version' => '0', 'Data::UUID' => '1.000', 'Date::Format' => '0', 'Date::Parse' => '0', 'Encode' => '2.000', 'File::Copy' => '0', 'File::MMagic' => '1.000', 'File::Path' => '0', 'File::Spec' => '0', 'File::Temp' => '0', 'Getopt::Long' => '0', 'HTTP::Date' => '0', 'IO::File' => '0', 'MIME::Base64' => '0', 'Pod::Usage' => '0', 'POSIX' => '0', 'Scalar::Util' => '0', 'Spreadsheet::Read' => '0.30', 'Time::HiRes' => '0', 'Time::Local' => '0', 'URI' => '1.00', 'URI::Escape' => '1.00', }, recommends => {}, script_files => {}, ); $build->create_build_script; __END__ =head1 AUTHOR Michael Bochkaryov =cut