package Tools;

@ISA = qw(Exporter);

use FindBin qw($RealBin);
use lib sprintf("%s", $RealBin);
use lib sprintf("%s/../lib", $RealBin);

use Data::Dumper;
$Data::Dumper::Indent = 1;
#$Data::Dumper::Maxdepth = 2;

use IO::File;
use Socket;
use Time::HiRes qw( gettimeofday );

our $DUMPSTACK  = 0;
our $VERBOSE    = 3;
our $LOG        = sub{ warn @_ };
our $BENCH      = {};
our $LOGCALLB   = sub{ };
our $DBH        = {};

@EXPORT = qw(&datum &stackTrace &lg &event &debug &error &panic &rep2str &dumper &getFromSocket &fields
 &load_file &save_file &tableExists &buildsearch &deleteDir &getip &convert &int &entities &bench
 &fmttime &getDataByTable &getDataById &getDataBySearch &getDataByFields &umlaute);


# ------------------
sub fmttime {
# ------------------
    my $tim = shift  || 0;
    return $tim if(index($tim, ':') > -1);

    my $value = sprintf('%04d',$tim);
    my $ret = sprintf('%02d:%02d', substr($value, 0, 2), substr($value, 2, 2));
    return $ret;
}

# ------------------
sub datum {
# ------------------
    my $zeit = shift  || time;
    my $typ  = shift  || 'voll';
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
            localtime($zeit);

    if(lc($typ) eq 'voll') {
        return sprintf('%02d:%02d:%02d %02d.%02d.%04d',
            $hour, $min, $sec, $mday, $mon+1, $year+1900);
    } elsif(lc($typ) eq 'tag') {
        return sprintf('%02d.%02d.%04d',
            $mday, $mon+1, $year+1900);
    } elsif (lc($typ) eq 'int') {
        # 1901-01-01T00:00+00:00
        return sprintf('%04d-%02d-%02dT%02d:%02d+01:00',
            $year+1900, $mon+1, $mday, $hour, $min );
    } elsif (lc($typ) eq 'rss') {
        # 23 Aug 1999 07:00:00 GMT
        my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
        return sprintf('%02d %s %04d %02d:%02d:%02d GMT',
            $mday, $abbr[$mon], $year+1900, $hour, $min, $sec );
    } else {
        return sprintf('%02d:%02d:%02d',
            $hour, $min, $sec);
    }
}

#returns a string containg the stacktrace
# ------------------
sub stackTrace {
# ------------------
    my $result;
    my $s;
    my $n = 0;
    my @res;
    do {
        my ($package, $filename, $line, $subroutine) = caller($n++);
        if($filename) {
            $s = sprintf("%s:%s (%s)", $filename||"", $line||"", $subroutine||"");
            push(@res, $s);
        } else {
            $s = 0;
        }
    } while ($s);

    my $evalon = 1
        if(scalar @res > 4
            and $res[4] =~ /\(eval\)/si
            and $res[4] !~ /XXV/si);

    $result .= "\n=========== top of stack =========\n";
    $result .= join("\n   ", @res);
    $result .= "\n=========== end of stack =========\n\n";
    return ($result, $evalon);
}

# ------------------
sub lg {
# ------------------
    my $msg = shift;
    my $lev = shift || 5;

    $msg = 'ERR:202 ' . $msg
        unless($msg =~ /^ERR:\d{3}/);

    my ($stack, $evalon) = &stackTrace;
    # Only report if not an eval call from an other Modul
    if($evalon) {
        return 1;
    } elsif($VERBOSE > 5 or $DUMPSTACK) {
        $msg .= $stack;
    }

    my ($package, $filename, $line, $subroutine) = caller(3);

    my  $module = '';
        $module = (split('::', $package))[-1]
            if($package);

    return 1 if($VERBOSE < $lev);

    &{$LOG}($module . ': ' . $msg);

    return 1;
}

# ------------------
sub event {
# ------------------
    my $msg = sprintf(shift, @_);

    my ($package, $filename, $line, $subroutine) = caller(3);
    &{$LOGCALLB}($module, $subroutine, $msg);

    &lg('EVT:270 ' . $msg, 3);

    return 1;
}

# ------------------
sub debug {
# ------------------
    my $msg = sprintf(shift, @_);

    &lg('ERR:250 ' . $msg, 2);

    return 1;
}

# ------------------
sub error {
# ------------------
    my $msg = sprintf(shift, @_);

    &lg('ERR:501 ' . $msg, 1);

    return undef;
}

# ------------------
sub panic {
# ------------------
    my $msg = sprintf(shift, @_);

    &lg('ERR:550 ' . $msg, 1);

    return undef;
}

# ------------------
sub getFromSocket {
# ------------------
    my $sock = shift or return undef;

    my (@Data, $Line);
    my $len = 0;
	do {
		$Line = <$sock> || 0;
        $len += length($Line);
		$Line =~ s/\r\n//g;
		push(@Data, $Line);
	} while($Line);

    lg sprintf('Get Data from socket: %s',
            convert($len),
        );

    return (\@Data, $len);
}


# ------------------
sub rep2str {
# ------------------
    my %args = @_;
    my $text = $args{-text};
    $text =~ s/\<(.+?)\>/$args{"-$1"}/sig;
    return $text;
}

# ------------------
sub dumper {
# ------------------
    my $var = shift || '<undef>';
    my $args = @_;

    $Data::Dumper::Maxdepth = $args->{d}
        if($args->{d});
    $Data::Dumper::Indent = $args->{i}
        if($args->{d});

    debug Dumper( $var );
}

# ------------------
sub fields {
# ------------------
    my $dbh = shift || return error ('No DBH!' );
    my $str = shift || return error ('No SQL!');

    $str =~ s/order\s+by.+//sig;
    my $sql = sprintf('%s %s 0 = 1', $str, ($str =~ /where/i ? 'AND' : 'WHERE'));
	my $sth = $dbh->prepare($sql) or return error("$DBI::errstr - $sql");
	$sth->execute or return error("$DBI::errstr - $sql");
	my $fields = $sth->{'NAME'};
    return $fields;
}

# ------------------
sub tableExists {
# ------------------
    my $dbh = shift || return error ('No DBH!' );
    my $name = shift || return error ('No Table!');

    my $erg = $dbh->selectall_arrayref('show tables');
    for(@$erg) {
        return 1 if($name eq $_->[0]);
    }
    return 0;
}

#--------------------------------------------------------
sub load_file {
#--------------------------------------------------------
	my $file = shift || die "Kein File bei Loader $!";

    lg sprintf('Load file "%s" from system',
            $file,
        );

	my $fh = IO::File->new("< $file")
	    or return error(sprintf("Can't open %s : %s!",$file,$!));
	my $data;
	while ( defined (my $l = <$fh>) ) {
	        $data .= $l;
	}
	$fh->close;
	return $data;
}

#--------------------------------------------------------
sub save_file {
#--------------------------------------------------------
    my ($file, $data) = @_;
	return unless($file);

    $data =~ s/\r\n/\n/sig;

    lg sprintf('Save %s in file "%s"',
            $file,
            convert(length($data))
        );

	my $fhi = new IO::File("> $file")
	    or return error(sprintf("Can't write %s : %s!",$file,$!));
	print $fhi $data;
	$fhi->close;

    return $file
}


#--------------------------------------------------------
sub buildsearch {
#--------------------------------------------------------
    my ($InFields, $Search) = @_;
    my $ss = {};
    foreach my $su (split(/\s*,\s*/, $Search)) {
        $su =~ s/\'/\./sg;
        $su =~ s/\+/\\\\\+/sg;

        # Split inFields and make a sql where clausel
        # if field with minus at top, then not rlike
        # if field with & at top, then with rlike
        foreach my $f (split(/\s*,\s*/, $InFields)) {
            my $searchtext = $su;
            if($searchtext =~ s/^\-//) {
                push(@{$ss->{$su}}, "$f NOT RLIKE '$searchtext'");
            } elsif($searchtext =~ s/^\&//) {
                push(@{$ss->{$su}}, "$f RLIKE '$searchtext'");
            } else {
                push(@{$ss->{$su}}, "$f RLIKE '$searchtext'");
            }
        }
    }

    my @fieldsearch;
    foreach my $su (keys %$ss) {
        my $type = ($su =~ /^\[-|&]+/) ? 'AND' : 'OR';
        push(@fieldsearch, "(" . join(" $type ", @{$ss->{$su}}) . ")");
    }
    my $out = join(' AND ', @fieldsearch);
	return $out;
}

# ------------------
sub deleteDir {
# ------------------
    my $dir = shift || return;

    lg sprintf('Delete directory "%s" in the system',
            $dir,
        );

    foreach my $file (glob(sprintf('%s/*', $dir))) {
        deleteDir($file)
            if(-d $file);
        unlink $file;
    }
    rmdir $dir;
    return 1;
}

# ------------------
sub getip {
# ------------------
    my $handle = shift  || return error ('No Handle!' );
    my $p = getpeername($handle)
        or return;
    my($port, $iaddr) = unpack_sockaddr_in($p);
    my $ip = inet_ntoa($iaddr);
    lg sprintf('Read IP from handle: %s',
            $ip,
        );
    return $ip;
}

# ------------------
# Name:  getDataByTable
# Descr: universal routine to get data by table
# Usage: my $hash = $obj->getDataByTable('TABLE', ['ID']);
# ------------------
sub getDataByTable {
    my $table = shift || return error ('No Table!' );
    my $key = shift  || &fields($DBH, 'select * from '.$table)->[0];
    my $dbh = $DBH;

    my $sql = sprintf('select * from %s',
                $table);
#    debug($sql);
    my $erg = $dbh->selectall_hashref($sql, $key);
    return $erg;
}


# ------------------
# Name:  getDataById
# Descr: universal routine to get data by id from table
# Usage: my $hashrow = $obj->getDataById(123, 'TABLE', ['ID']);
# ------------------
sub getDataById {
    my $id = shift  || return error ('No Object!' );
    my $table = shift || return error ('No Table!' );
    my $key = shift  || &fields($DBH, 'select * from '.$table)->[0];
    my $dbh = $DBH;

    my $sql = sprintf('select * from %s where %s = "%s"',
                $table, $key, $id);
#    debug($sql);
    my $erg = $dbh->selectrow_hashref($sql);
    return $erg;
}

# ------------------
# Name:  getDataBySearch
# Descr: universal routine to get data by search from table
# Usage: my $arref = $obj->getDataBySearch('TABLE', 'ID = 123');
# ------------------
sub getDataBySearch {
    my $table = shift || return error ('No Table!' );
    my $search = shift || return error ('No Searchtxt!' );

    my $dbh = $DBH;

    my $sql = sprintf('select * from %s where %s',
                $table, $search);

    my $erg = $dbh->selectall_arrayref($sql);
    return $erg;
}

# ------------------
# Name:  getDataByFields
# Descr: universal routine to get data by fields from table
# Usage: my $arref = $obj->getDataBySearch('TABLE', 'ID', ['WHERE']);
# ------------------
sub getDataByFields {
    my $table = shift || return error ('No Table!' );
    my $field = shift || '*';
    my $where = shift || '';

    my $dbh = $DBH;

    my $sql = sprintf('select %s from %s %s',
                $field, $table, ($where ? 'where '.$where : '')
                );
    my $erg = $dbh->selectcol_arrayref($sql);
    return $erg;
}


# Takes kilobytes and formats for MB and GB if necessary
sub convert {
    my $kbytes = $_[0] / 1024;
    my $result = 0;

    if ( $kbytes > 1048576 ) {
        $result = sprintf("%.2f", $kbytes / 1048576);
        $result .= " GB";
    } elsif ( $kbytes > 1024 ) {
        $result = sprintf("%.2f", $kbytes / 1024);
        $result .= " MB";
    } else {
        $result = sprintf("%.2f", $kbytes);
        $result .= " KB";
    }

    return $result;
}

# ------------------
sub int {
# ------------------
    my $var = shift  || return 0;
    $var =~ s/[^0-9\.\,\-\+]//sig;
    return CORE::int($var);
}

# ------------------
sub entities {
# ------------------
    my $s = shift || return '';

    $s =~ s/&/&amp;/g;
    $s =~ s/>/&gt;/g;
    $s =~ s/</&lt;/g;
    $s =~ s/\"/&quot;/g;
    $s =~ s/([^a-zA-Z0-9&%;:,\.\!\?\(\)\' ])/sprintf("&#x%02x;",ord($1))/eg;

    return $s;
}

# ------------------
sub bench {
# ------------------
    my $tag = shift || return $BENCH;

    return $BENCH = {}
        if($tag eq 'CLEAR');

    if(! $BENCH->{$tag} or $BENCH->{$tag} < 1000) {
        $BENCH->{$tag} = scalar gettimeofday;
    } else {
        $BENCH->{$tag} = scalar gettimeofday - $BENCH->{$tag};
    }
}

# ------------------
sub umlaute {
# ------------------
    my $s = shift || return "";

    my %uml = (
        'Ä' => 'Ae',
        'Ö' => 'Oe',
        'Ü' => 'Ue',
        'ä' => 'ae',
        'ö' => 'oe',
        'ü' => 'ue',
        'ß' => 'sz'
    );

    my @uml = join("|", keys(%uml));

    $s =~ s/(@uml)/$uml{$1}/eg;

    return $s;
}

1;
