initial commit [141.14.140.180,mike]
This commit is contained in:
@@ -0,0 +1,281 @@
|
||||
######################################### mikes perl tools (mwx,11.09.03) #####
|
||||
package mwx;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
use AutoLoader qw(AUTOLOAD);
|
||||
|
||||
our $VERSION = '1.21';
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw(
|
||||
sendmail
|
||||
md5
|
||||
gnfip
|
||||
tosql
|
||||
tsd
|
||||
fsd
|
||||
mkdatequery
|
||||
mknumquery
|
||||
mkquery
|
||||
uniqid
|
||||
shortstr
|
||||
);
|
||||
|
||||
################################################################### TOOLS #####
|
||||
|
||||
sub sendmail { ##### send mail #####
|
||||
my($from,$to,$subject,$message,$server)=@_;
|
||||
use Net::SMTP;
|
||||
my($smtp)=Net::SMTP->new("mail",Debug=>0);
|
||||
$smtp->mail("<$from>");
|
||||
$smtp->recipient($to);$smtp->data();
|
||||
$smtp->datasend("To: $to\n");
|
||||
$smtp->datasend("From: $from\n");
|
||||
$smtp->datasend("Subject: $subject\n");
|
||||
$smtp->datasend("$message\n");
|
||||
$smtp->dataend();
|
||||
$smtp->quit();
|
||||
}
|
||||
|
||||
sub md5() { ##### calculate md5 checksum #####
|
||||
my($file)=@_;
|
||||
use Digest::MD5;
|
||||
open(FILE,$file);binmode(FILE);
|
||||
my($md5)=Digest::MD5->new->addfile(*FILE)->hexdigest;
|
||||
close(FILE);
|
||||
return($md5);
|
||||
}
|
||||
|
||||
sub gnfip { ##### find hostname for given IP (bug fixed version) #####
|
||||
my($ip)=@_;
|
||||
use Net::DNS;
|
||||
if ($ip!~/\d+\.\d+\.\d+\.\d+/) {;return $ip;}
|
||||
my($res) = new Net::DNS::Resolver;
|
||||
my($query)=$res->query($ip);
|
||||
if ($query) {
|
||||
for ($query->answer) {
|
||||
if ($_->type eq 'PTR') {
|
||||
my($ip)=$_->ptrdname;
|
||||
return("$ip");
|
||||
}
|
||||
}
|
||||
}
|
||||
else {;return("$ip");}
|
||||
}
|
||||
|
||||
sub tosql { ##### convert string for SQL #####
|
||||
my($str)=@_;my($a)="'";my($b)="`";if(!defined($str)) {;$str="";}
|
||||
$str=~s/$b/$a$a/g;$str=~s/$a/$a$a/g;$str=~s/\s*$//g;$str=~s/^\s*//g;
|
||||
return $str;
|
||||
}
|
||||
|
||||
sub tsd { ##### format date/time to MySQL date/time #####
|
||||
my($tmp)=@_;my($y);
|
||||
$tmp=~s/^\s*//;$tmp=~s/\s*$//;$tmp=~s/\s+/ / ;
|
||||
if ($tmp=~/^(\d+)\.(\d+)\.(\d+)\s+(\d+)\:(\d+)$/) {
|
||||
$y=$3;if ($3>=0 && $3<100) {;$y=$3+2000;}
|
||||
return sprintf("%04d-%02d-%02d %02d:%02d",$y,$2,$1,$4,$5);
|
||||
}
|
||||
if ($tmp=~/^(\d+)\.(\d+)\.(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
|
||||
$y=$3;if ($3>=0 && $3<100) {;$y=$3+2000;}
|
||||
return sprintf("%04d-%02d-%02d %02d:%02d:%02d",$y,$2,$1,$4,$5,$6);
|
||||
}
|
||||
elsif ($tmp=~/^(\d+)\.(\d+)\.(\d+)$/) {
|
||||
$y=$3;if ($3>=0 && $3<100) {;$y=$3+2000;}
|
||||
return sprintf("%04d-%02d-%02d",$y,$2,$1);
|
||||
}
|
||||
elsif ($tmp=~/^(\d+)\:(\d+)$/) {
|
||||
return sprintf("%02d:%02d",$1,$2);
|
||||
}
|
||||
else {;return("");}
|
||||
}
|
||||
|
||||
sub fsd { ########################### format MySQL date/time to date/time #####
|
||||
my($tmp,$mode)=@_;if (!defined($mode)) {;$mode="";}
|
||||
$tmp=~s/^\s*//;$tmp=~s/\s*$//;$tmp=~s/\s+/ / ;
|
||||
if ($tmp=~/(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)/) {
|
||||
if ($tmp eq '0000-00-00 00:00:00') {;return("");}
|
||||
if ($mode eq 'date') {
|
||||
return sprintf("%d\.%d\.%04d",$3,$2,$1);
|
||||
}
|
||||
elsif ($mode eq 'time') {
|
||||
return sprintf("%d\:%02d",$4,$5);
|
||||
}
|
||||
else {
|
||||
return sprintf("%d\.%d\.%04d %d\:%02d",$3,$2,$1,$4,$5);
|
||||
}
|
||||
}
|
||||
elsif ($tmp=~/(\d+)\-(\d+)\-(\d+)/) {
|
||||
if ($tmp eq '0000-00-00' || $mode eq 'time') {;return("");}
|
||||
return sprintf("%d\.%d\.%04d",$3,$2,$1);
|
||||
}
|
||||
if ($tmp=~/(\d+)\:(\d+)\:(\d+)/) {
|
||||
if ($mode eq 'date') {;return("");}
|
||||
return sprintf("%d\:%02d",$1,$2);
|
||||
}
|
||||
else {;return("");}
|
||||
}
|
||||
|
||||
sub mkdatequery { ###################### make query string for date range #####
|
||||
my($datestr,$field)=@_;
|
||||
my(@list)=split(",",$datestr);
|
||||
my($tmp)="";my($da,$db);
|
||||
for (@list) {
|
||||
if (/^\s*([^\s]+)\s*\-\s*([^\s]+)\s*$/) {
|
||||
$da=$1;$db=$2;
|
||||
$da=~s/(\d+)\.(\d+)\.(\d+)/$3\-$2\-$1/;
|
||||
$db=~s/(\d+)\.(\d+)\.(\d+)/$3\-$2\-$1/;
|
||||
$tmp.=" $field BETWEEN '$da' AND '$db' OR ";
|
||||
}
|
||||
elsif (/^\s*([\>\<])\s*(.*)/) {
|
||||
$da=$1;$db=$2;$db=~s/(\d+)\.(\d+)\.(\d+)/$3\-$2\-$1/;
|
||||
$tmp.=" $field $da '$db' OR ";
|
||||
}
|
||||
elsif (/^\s*\-(\d+)$/) {
|
||||
$tmp.=" UNIX_TIMESTAMP($field)>UNIX_TIMESTAMP(now())-(86400*$1) OR ";
|
||||
}
|
||||
elsif (/^\s*([^\s]+)\s*$/) {
|
||||
$da=$1;$da=~s/(\d+)\.(\d+)\.(\d+)/$3\-$2\-$1/;
|
||||
$tmp.=" $field='$da' OR ";
|
||||
}
|
||||
}
|
||||
$tmp=~s/\s*or\s*$//i;$tmp=~s/^\s//i;$tmp=~s/\s+/ /g;
|
||||
if ($tmp=~/^\s*$/) {;return "";}
|
||||
return "($tmp)";
|
||||
}
|
||||
|
||||
sub mknumquery { ##################### make query string for number range #####
|
||||
my($numstr,$field)=@_;
|
||||
my($tmp)="";
|
||||
my(@list)=split(",",$numstr);
|
||||
for (@list) {
|
||||
if (/^\s*(\d+)\s*\-\s*(\d+)\s*$/) {
|
||||
$tmp.=" $field BETWEEN $1 AND $2 OR ";
|
||||
}
|
||||
elsif (/^\s*([\>\<])\s*(\d+)/) {
|
||||
$tmp.=" $field $1 $2 OR ";
|
||||
}
|
||||
elsif (/^\s*(\d+)\s*$/) {
|
||||
$tmp.=" $field=$1 OR ";
|
||||
}
|
||||
}
|
||||
$tmp=~s/\s*or\s*$//i;$tmp=~s/^\s//i;$tmp=~s/\s+/ /g;
|
||||
return "($tmp)";
|
||||
}
|
||||
|
||||
sub mkquery { ############################### make query string for field #####
|
||||
my($query,$mode,@fields)=@_;if (!defined($query)) {;$query="";}
|
||||
my(@list,$tmp,$field,@field);
|
||||
use Text::ParseWords;
|
||||
|
||||
$query=~s/\s*\(\s*/ \( /g;$query=~s/\s*\)\s*/ \) /g;
|
||||
@list="ewords(' ',0,$query);
|
||||
$query="";
|
||||
my($notflag)=0;
|
||||
for (@list) {
|
||||
if (!/^\s*and\s*$/i && !/^\s*or\s*$/i &&
|
||||
!/^\s*andnot\s*$/i && !/^\s*ornot\s*$/i &&
|
||||
!/^\s*\(\s*$/ && !/^\s*\)\s*$/ && !/^\s*$/) {
|
||||
s/^\s*\'//;s/\'\s*$//;
|
||||
|
||||
if ($query=~/\)\s*$/) {;$query.=" AND (";}
|
||||
else {;$query.="(";}
|
||||
for $field (@fields) {
|
||||
$tmp=$_;if($mode==1) {;$tmp=" $_ ";}
|
||||
if ($notflag) {;$query.=" NOT($field LIKE '%$tmp%') ";$notflag=0;}
|
||||
else {;$query.=" $field LIKE '%$tmp%' ";}
|
||||
$query.="OR ";
|
||||
}
|
||||
$query=~s/\s*or\s*$/\)/i;
|
||||
}
|
||||
else {
|
||||
if ($_=~/^\s*andnot\s*$/i) {;$query.=" AND ";$notflag=1;}
|
||||
elsif ($_=~/^\s*andnot\s*$/i) {;$query.=" OR ";$notflag=1;}
|
||||
else {;$query.=" $_ ";}
|
||||
}
|
||||
|
||||
}
|
||||
return $query;
|
||||
}
|
||||
|
||||
|
||||
sub base62() { ################################################### Base62 #####
|
||||
my($s)=@_;
|
||||
my(@c)=('0'..'9','a'..'z','A'..'Z');
|
||||
my(@p,$u,$v,$i,$n);
|
||||
my($m)=20;
|
||||
$p[0]=1;
|
||||
for $i (1..$m) {
|
||||
$p[$i]=Math::BigInt->new($p[$i-1]);
|
||||
$p[$i]=$p[$i]->bmul(62);
|
||||
}
|
||||
|
||||
$v=Math::BigInt->new($s);
|
||||
for ($i=$m;$i>=0;$i--) {
|
||||
$v=Math::BigInt->new($v);
|
||||
($n,$v)=$v->bdiv($p[$i]);
|
||||
$u.=$c[$n];
|
||||
}
|
||||
$u=~s/^0+//;
|
||||
|
||||
return($u);
|
||||
}
|
||||
|
||||
sub uniqid { ############################################## get unique id #####
|
||||
use Math::BigInt;
|
||||
use Sys::Hostname;
|
||||
use Time::HiRes qw( gettimeofday usleep );
|
||||
my($s,$us)=gettimeofday();
|
||||
my($ia,$ib,$ic,$id)=unpack("C4", (gethostbyname(hostname()))[4]);
|
||||
my($v)=sprintf("%06d%10d%06d%03d%03d%03d%03d",$us,$s,$$,$ia,$ib,$ic,$id);
|
||||
return(&base62($v));
|
||||
}
|
||||
|
||||
sub shortstr() { ########################### make short string with '...' #####
|
||||
my($str,$len)=@_;
|
||||
if (length($str)>$len) {
|
||||
my($tmp)=substr($str,0,$len-3) . "...";
|
||||
return $tmp;
|
||||
} else {;return ($str);}
|
||||
}
|
||||
|
||||
##################################################################### END #####
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
mwx - mikes perl tools
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use mwx;
|
||||
|
||||
sendmail($from,$to,$subject,$message,$server);
|
||||
|
||||
$md5 = md5($file);
|
||||
|
||||
$name = gnfip($ip);
|
||||
|
||||
$str = tosql($str);
|
||||
$sqldate = tsd($date);
|
||||
$date = fsd($date);
|
||||
|
||||
$subsql = mkdatequery($datestr,$columnname);
|
||||
$subsql = mknumquery($numstr,$columnname);
|
||||
$subsql = mkquery($querystr,$mode,@columnnames);
|
||||
|
||||
$id = uniqid();
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Mike Wesemann, E<lt>mwx@gmx.deE<gt>
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user