282 lines
7.3 KiB
Perl
282 lines
7.3 KiB
Perl
######################################### 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
|