package DBI::Library::Database;
use strict;
use warnings;
use utf8;
use HTML::Entities;
use vars qw(
  $m_dbh
  $m_dsn
  $m_sDefaultClass
  @EXPORT_OK
  @ISA
  %m_hFunctions
  $m_sServerName
  $m_nSecs
);
$m_sDefaultClass = 'DBI::Library::Database' unless defined $DBI::Library::Database::m_sDefaultClass;
require Exporter;
use DBI::Library qw(:all $m_dbh $m_dsn);
@DBI::Library::Database::ISA    = qw(DBI::Library Exporter);
@DBI::Library::Database::EXPORT = qw(useexecute);
@DBI::Library::Database::EXPORT_OK =
  qw(getActionRight catright topicright getAction fulltext searchDB rss readMenu deleteMessage reply editMessage addMessage getIndex CurrentPass CurrentUser CurrentHost CurrentDb Driver execute useexecute quote void fetch_hashref fetch_AoH fetch_array updateModules deleteexecute editexecute addexecute tableLength tableExists addUser hasAcount isMember right checkPass checkSession setSid getName initDB checkFlood GetColumns GetAttrs GetCollation GetColumnCollation GetExtra GetNull GetEngineForRow GetEngines GetCharacterSet GetDataBases GetAutoIncrement GetPrimaryKey GetAutoIncrementValue fetch_string);
%DBI::Library::Database::EXPORT_TAGS = (
    'all' => [
        qw(getActionRight catright topicright getAction
          fulltext searchDB rss readMenu deleteMessage reply editMessage addMessage
          getIndex CurrentPass CurrentUser CurrentHost CurrentDb Driver addUser hasAcount isMember right checkPass checkSession setSid getName initDB tableLength tableExists useexecute void fetch_hashref fetch_AoH fetch_array updateModules deleteexecute editexecute addexecute  checkFlood GetColumns GetAttrs GetCollation GetColumnCollation GetExtra GetNull GetEngineForRow GetEngines GetCharacterSet GetDataBases GetAutoIncrement GetPrimaryKey GetAutoIncrementValue fetch_string)
    ],
    'dynamic' => [
        qw(CurrentPass CurrentUser CurrentHost CurrentDb Driver useexecute void fetch_hashref fetch_AoH fetch_array updateModules deleteexecute editexecute addexecute)
    ],
    'independent' => [
        qw(CurrentPass CurrentUser CurrentHost CurrentDb Driver tableLength tableExists initDB useexecute void fetch_hashref fetch_AoH fetch_array updateModules deleteexecute editexecute addexecute fetch_string)
    ],
    'mysql' => [
        qw(getIndex CurrentPass CurrentUser CurrentHost CurrentDb Driver addUser hasAcount isMember right checkPass checkSession setSid getName checkFlood GetColumns GetAttrs GetCollation GetColumnCollation GetExtra GetNull GetEngineForRow GetEngines GetCharacterSet GetDataBases GetAutoIncrement GetPrimaryKey GetAutoIncrementValue)
    ],
);
$DBI::Library::Database::VERSION = '1.18';
$m_nSecs                         = 10;

=head1 NAME

DBI::Library::Database - Database interface for MySQL::Admin::GUI

=head1 SYNOPSIS

use DBI::Library::Database;

=head2 new()

constructor

=cut

sub new {
    my ( $class, @initializer ) = @_;
    my $self = {};
    bless $self, ref $class || $class || $m_sDefaultClass;
    $m_dbh = $self->SUPER::initDB(@initializer) if (@initializer);
    return $self;
} ## end sub new

=head2 getName

      $name = $m_oDatabase->getName($m_sSid);

=cut

sub getName {
    my ( $self, @p ) = getSelf(@_);
    my $m_sSid = $p[0];
    if ( defined $m_sSid ) {
        my $sql = 'SELECT user FROM `users` where sid = ?;';
        my $sth = $m_dbh->prepare($sql) or warn $m_dbh->errstr;
        $sth->execute($m_sSid) or warn $m_dbh->errstr;
        my $name = $sth->fetchrow_array();
        $sth->finish();
        return $name;
    } else {
        return 'guest';
    } ## end else [ if ( defined $m_sSid )]
} ## end sub getName

=head2 setSid

      $sid = $m_oDatabase->setSid( name, pass );

=cut

sub setSid {
    my ( $self, @p ) = getSelf(@_);
    my $name = $p[0];
    my $pass = $p[1];
    my $ip   = $p[2];
    use POSIX qw(strftime);
    my $time = strftime "%d.%m.%Y %H:%M:%S", localtime;
    use MD5;
    my $md5 = new MD5;
    $md5->add($name);
    $md5->add($pass);
    $md5->add($time);
    $md5->add($ip);
    my $fingerprint = $md5->hexdigest();
    my $sql         = 'UPDATE users  SET sid = ? ,ip = ? WHERE user = ?';
    my $sth         = $m_dbh->prepare($sql);
    $sth->execute( $fingerprint, $ip, $name );
    $sth->finish();
    return $fingerprint;
} ## end sub setSid

=head2 checkSession

    $bool = $m_oDatabase->checkSession($sUser,$m_sSid);

=cut

sub checkSession {
    my ( $self, @p ) = getSelf(@_);
    my $sUser  = shift @p;
    my $ssid   = shift @p;
    my $ip     = shift @p;
    my $return = 0;
    if ( length($sUser) > 3 && length($ssid) > 3 ) {
        my $sql = 'select sid from  users where  user = ?';
        my $sth = $m_dbh->prepare($sql);
        $sth->execute($sUser) or warn $m_dbh->errstr;
        my $session = $sth->fetchrow_array();
        $sth->finish();
        $return = 1 if ( defined $session && defined $ssid && $ssid eq $session );
    } ## end if ( length($sUser) > ...)
    return $return;
} ## end sub checkSession

=head2 checkPass

  bool checkPass( user, crypt_pass);

=cut

sub checkPass {
    my ( $self, @p ) = getSelf(@_);
    my $u  = $p[0];
    my $cp = $p[1];
    if ( defined $u ) {
        my $sql = q(SELECT pass  FROM users where user = ?);
        my $sth = $m_dbh->prepare($sql) or warn $m_dbh->errstr;
        $sth->execute($u);
        my $cpass = $sth->fetchrow_array();
        $sth->finish();
        $cpass = defined $cpass ? $cpass : 0;
        return ( $cp eq $cpass ) ? 1 : 0;
    } ## end if ( defined $u )
    return 0;
} ## end sub checkPass

=head2 right()

  $nRight = right($m_sAction,$sUsername);

=cut

sub right {
    my ( $self, @p ) = getSelf(@_);
    my $sUser = $p[0];
    return userright($sUser);
} ## end sub right

=head2 userright()

      userright( user );

=cut

sub userright {
    my ( $self, @p ) = getSelf(@_);
    my $sUser = $p[0];
    my $sql   = 'SELECT `right`  FROM users where `user` = ? ';
    my $sth   = $m_dbh->prepare($sql);
    $sth->execute($sUser);
    my @q = $sth->fetchrow_array;
    $sth->finish();
    return $q[0];
} ## end sub userright

=head2 catright()

    catright( 'name|name2' );

=cut

sub catright {
    my ( $self, @p ) = getSelf(@_);
    my $cat = $p[0];
    my @select = split /\|/, $cat;
    my %sel;
    $sel{$_} = 1 foreach @select;
    my @cats   = $self->fetch_AoH('SELECT * FROM cats');
    my $nRight = 0;
    for ( my $i = 0 ; $i <= $#cats ; $i++ ) {
        $nRight = $cats[$i]->{right} if ( $sel{ $cats[$i]->{name} } && $cats[$i]->{right} > $nRight );
    } ## end for ( my $i = 0 ; $i <=...)
    return $nRight;
} ## end sub catright

=head2 isMember

      isMember($sUser);

=cut

sub isMember {
    my ( $self, @p ) = getSelf(@_);
    my $sUser = lc $p[0];
    if ( defined $sUser ) {
        my $sth = $m_dbh->prepare('SELECT user  FROM users where user = ?') or warn $m_dbh->errstr;
        $sth->execute($sUser);
        my ($member) = $sth->fetchrow_array();
        $sth->finish();
        return defined $member ? ( $sUser eq $member ) ? 1 : 0 : 0;
    } else {
        return 1;
    } ## end else [ if ( defined $sUser ) ]
} ## end sub isMember

=head2 hasAcount

      bool hasAcount( $email )

=cut

sub hasAcount {
    my ( $self, @p ) = getSelf(@_);
    my $mail = lc $p[0];
    if ( defined $mail ) {
        my $sth = $m_dbh->prepare('SELECT email  FROM users where email = ?')
          or warn $m_dbh->errstr;
        $sth->execute($mail);
        my ($email) = $sth->fetchrow_array();
        $sth->finish();
        return ( $mail eq $email ) ? 1 : 0;
    } else {
        return 1;
    } ## end else [ if ( defined $mail ) ]
} ## end sub hasAcount

=head2 addUser

      $m_oDatabase->addUser(user, pass,mail);

=cut

sub addUser {
    my ( $self, @p ) = getSelf(@_);
    my $newuser = $p[0];
    my $newpass = $p[1];
    my $mail    = $p[2];
    use MD5;
    my $md5 = new MD5;
    $md5->add($newuser);
    $md5->add($newpass);
    my $fingerprint = $md5->hexdigest();
    my $sql_addUser = q/insert into users (user,pass,email,`right`,cats) values(?,?,?,1,'news|member')/;
    my $sth         = $m_dbh->prepare($sql_addUser);
    my $anzahl      = $sth->execute( $newuser, $fingerprint, $mail ) or warn $m_dbh->errstr;
    $sth->finish();
    return 1 if ( $anzahl + 0 == 1 );
} ## end sub addUser

=head2 serverName()

set serverName.

=cut

sub serverName {
    my ( $self, @p ) = getSelf(@_);
    if ( defined $p[0] ) {
        $m_sServerName = $p[0];
    } else {
        return $m_sServerName;
    } ## end else [ if ( defined $p[0] ) ]
} ## end sub serverName

=head2 floodtime()

set floodtime.

=cut

sub floodtime {
    my ( $self, @p ) = getSelf(@_);
    if ( defined $p[0] ) {
        $m_nSecs = $p[0];
    } else {
        return $m_nSecs;
    } ## end else [ if ( defined $p[0] ) ]
} ## end sub floodtime

=head2 checkFlood

checkFlood(ip,optional time in seconds )

checkFlood( remote_addr() );

=cut

sub checkFlood {
    my ( $self, @p ) = getSelf(@_);
    my $ip = $p[0];
    $m_nSecs = defined $p[1] ? $p[1] : $m_nSecs;
    my $return = 0;
    if ( defined $ip ) {
        my $sql = q(SELECT ti FROM flood where remote_addr = ? );
        my $sth = $m_dbh->prepare($sql) or warn $m_dbh->errstr;
        $sth->execute($ip);
        my $ltime = $sth->fetchrow_array();
        unless ( defined $ltime ) {
            $self->void( 'insert into flood (remote_addr, ti) VALUES(?,?)', $ip, time() );
            $return = 1;
        } else {
            $return = ( time() - $ltime > $m_nSecs ) ? 1 : 0;
            $self->void( 'update flood set ti =?  where remote_addr = ?', time(), $ip );
        } ## end else
        $sth->finish();
    } ## end if ( defined $ip )
    return $return;
} ## end sub checkFlood

=head2 GetAutoIncrementValue()

    GetAutoIncrementValue(table)

=cut

sub GetAutoIncrementValue {
    my ( $self, @p ) = getSelf(@_);
    my $name = $p[0];
    my @a    = $self->fetch_AoH('SHOW TABLE STATUS');
    for ( my $i = 0 ; $i <= $#a ; $i++ ) {
        return $a[$i]->{Auto_increment} if ( $a[$i]->{Name} eq $name );
    } ## end for ( my $i = 0 ; $i <=...)
} ## end sub GetAutoIncrementValue

=head2 GetPrimaryKey()

       liefert die primary_key(s) der tabelle zurueck

       @array = GetPrimaryKey(table)

=cut

sub GetPrimaryKey {
    my ( $self, @p ) = getSelf(@_);
    my $tbl = $p[0];
    if ( defined $tbl ) {
        $tbl = $m_dbh->quote_identifier($tbl);
        my @caption = $self->fetch_AoH("show columns from $tbl");
        my @return;
        for ( my $j = 0 ; $j <= $#caption ; $j++ ) {
            push @return, $caption[$j]->{'Field'} if ( $caption[$j]->{'Key'} eq 'PRI' );
        } ## end for ( my $j = 0 ; $j <=...)
        push @return, $caption[0]->{'Field'} if $#caption eq 0;
        return @return;
    } else {
        return 0;
    } ## end else [ if ( defined $tbl ) ]
} ## end sub GetPrimaryKey

=head2 getIndex()

=cut

sub getIndex {
    my ( $self, @p ) = getSelf(@_);
    my $tbl = $p[0];
    if ( defined $tbl ) {
        $tbl = $m_dbh->quote_identifier($tbl);
        my $hr = $self->fetch_hashref("SHOW CREATE TABLE $tbl");
        my @return;
        foreach my $line ( split /\n/, $hr->{'Create Table'} ) {
            if ( $line =~ /(PRIMARY KEY|FOREIGN KEY|FULLTEXT KEY|UNIQUE KEY|KEY) (`([^`]+)`)? ?(\(([^)]+)\))?/ ) {
                my $type = $1;
                my $name = $type eq 'FOREIGN KEY' ? $return[$#return]->{field} : $2;
                delete $return[$#return];
                my $sfields = $5;
                my @fields;
                push @fields, /`([^`]+)`/ for split ',', $5;
                if ( $line =~ /REFERENCES `([^`]+)` \(([^)]+)\)/ ) {
                    my $table = $1;
                    my @references;
                    push @references, /`([^`]+)`/ for split ',', $2;
                    push @return,
                      {
                        field             => /`([^`]+)`/,
                        foreignTable      => $table,
                        foreignFields     => [@fields],
                        foreignReferences => [@references],
                        name              => $name,
                        type              => $type,
                        ondelete          => $line =~ /ON DELETE CASCADE/ ? 'CASCADE'
                        : $line =~ /ON DELETE SET DEFAULT/ ? 'SET DEFAULT'
                        : '',
                        onupdate => $line =~ /ON UPDATE CASCADE/ ? 'CASCADE'
                        : $line =~ /ON UPDATE SET DEFAULT/ ? 'SET DEFAULT'
                        :                                    '',
                      }
                      for split ',', $sfields;
                } else {
                    push @return,
                      {
                        field => /`([^`]+)`/,
                        name  => $name,
                        type  => $type,
                      } for split ',', $5;
                } ## end else [ if ( $line =~ /REFERENCES `([^`]+)` \(([^)]+)\)/(([(])))]
            } ## end if ( $line =~ /(PRIMARY KEY|FOREIGN KEY|FULLTEXT KEY|UNIQUE KEY|KEY) (`([^`]+)`)? ?(\(([^)]+)\))?/((([(]))))
        } ## end foreach my $line ( split /\n/...)
        return @return;
    } ## end if ( defined $tbl )
} ## end sub getIndex

=head2 getConstraintKeys()

=cut

sub getConstraintKeys {
    my ( $self, @p ) = getSelf(@_);
    my $tbl = $p[0];
    my $key = $p[1];
    my @return;
    if ( defined $tbl ) {
        $tbl = $m_dbh->quote_identifier($tbl);
        my $hr = $self->fetch_hashref("SHOW CREATE TABLE $tbl");
        foreach my $line ( split /\n/, $hr->{'Create Table'} ) {
            my %keys;
            if ( $line =~ /CONSTRAINT `([^`]+)` FOREIGN KEY \(([^)]+)\)/ ) {
                my $i = 0;
                for ( split ',', $2 ) {
                    /`([^`]+)`/;
                    $keys{$1} = 1;
                } ## end for ( split ',', $2 )
                push @return, $1 if ( $keys{$key} and $return[ $#return - 1 ] ne $1 );
            } ## end if ( $line =~ /CONSTRAINT `([^`]+)` FOREIGN KEY \(([^)]+)\)/(([(])))
        } ## end foreach my $line ( split /\n/...)
        return @return;
    } ## end if ( defined $tbl )
} ## end sub getConstraintKeys

=head2 GetAutoIncrement()

    returns the auto_increment Column.

    GetAutoIncrement(table)

=cut

sub GetAutoIncrement {
    my ( $self, @p ) = getSelf(@_);
    my $tbl = $p[0];
    if ( defined $tbl ) {
        $tbl = $m_dbh->quote_identifier($tbl);
        my @caption = $self->fetch_AoH("show columns from $tbl");
        my $r;
        for ( my $j = 0 ; $j <= $#caption ; $j++ ) {
            $r = $caption[$j]->{'Field'} if ( $caption[$j]->{'Extra'} eq 'auto_increment' );
        } ## end for ( my $j = 0 ; $j <=...)
        return $r;
    } else {
        return 0;
    } ## end else [ if ( defined $tbl ) ]
} ## end sub GetAutoIncrement

=head2 fetch_string()


=cut

sub fetch_string {
    my ( $self, @p ) = getSelf(@_);
    my @a = $self->fetch_array(@p);
    return $a[0];
} ## end sub fetch_string

#html erzeugende funktionen

=head2 GetDataBases()

     returns a <select> list with the Databases.

=cut
sub GetDataBases {
    my ( $self, @p ) = getSelf(@_);
    my $name = $p[0] ? shift(@p) : 'm_ChangeCurrentDb';
    my $change = $p[0] ? 'onchange="submitForm(this.form)"' : '';
    my $m_sCurrentDb = $self->CurrentDb();
    my @dbs          = $self->fetch_array('show Databases');
    my $return       = qq|<select align="center" $change name="$name" style="width:75%" >|;
    $return .=
      $_ eq $m_sCurrentDb
      ? qq|<option  value="$_"  selected="selected" >$_(| . $self->TableCount4Db($_) . q|)</option>|
      : qq|<option  value="$_">$_(| . $self->TableCount4Db($_) . q|)</option>|
      foreach @dbs;
    $return .= '</select>';
    return $return;
} ## end sub GetDataBases

=head2 TableCount4Db()

     Gibt die anzahl der tabellen fuer die angegebene Datenbank zurueck.

=cut

sub TableCount4Db {
    my ( $self, @p ) = getSelf(@_);
    $p[0] = $m_dbh->quote_identifier( $p[0] );
    my @count = $self->fetch_array("show tables from $p[0]");
    warn $@ if $@;
    return $#count > 0 ? $#count : 0;
} ## end sub TableCount4Db

=head2 GetCharacterSet()

    gibt das Charset zu coalation zurueck.

    GetCharacterSet(coalation);

=cut

sub GetCharacterSet {
    my ( $self, @p ) = getSelf(@_);
    my $c = shift @p;
    if ( defined $c ) {
        my $coalation = $self->fetch_hashref( "SHOW COLLATION like ?", $c );
        return $coalation->{Charset};
    } else {
        return 0;
    } ## end else [ if ( defined $c ) ]
} ## end sub GetCharacterSet

=head2 GetEngines()

    gibt die verfuegbaren Engines zurueck.

    GetEngines(tabelle);

=cut

sub GetEngines {
    my ( $self, @p ) = getSelf(@_);
    my $tbl  = shift @p;
    my $name = shift @p;
    if ( defined $tbl ) {
        my @co     = $self->fetch_AoH('SHOW ENGINES');
        my $status = $self->fetch_hashref( 'SHOW TABLE STATUS where `Name` = ? ', $tbl );
        my $return = qq|<select class="editTable" name="$name">|;
        $return .=
          $_->{Engine} eq $status->{Engine}
          ? qq|<option  value="$_->{Engine}"  selected="selected" >$_->{Engine}</option>|
          : qq|<option  value="$_->{Engine}">$_->{Engine}</option>|
          foreach @co;
        $return .= '</select>';
        return $return;
    } else {
        return 0;
    } ## end else [ if ( defined $tbl ) ]
} ## end sub GetEngines

=head2 GetEngineForRow()

    GetEngineForRow(tabelle, zeile);

=cut

sub GetEngineForRow {
    my ( $self, @p ) = getSelf(@_);
    my $tbl  = shift @p;
    my $name = shift @p;
    if ( defined $tbl && defined $name ) {
        my @co       = $self->fetch_array('SHOW ENGINES');
        my @EINGINES = $self->fetch_AoH( 'SHOW TABLE STATUS where `Name` = ?  ', $tbl );
        my $return   = qq|<select class="editTable" name="$name">|;
        $return .=
          $_->{Engine} eq "@co"
          ? qq|<option  value="$_->{Engine}"  selected="selected" >$_->{Engine}</option>|
          : qq|<option  value="$_->{Engine}">$_->{Engine}</option>|
          foreach @EINGINES;
        $return .= '</select>';
        return $return;
    } else {
        return 0;
    } ## end else [ if ( defined $tbl && defined...)]
} ## end sub GetEngineForRow

=head2 GetNull()

    gibt die NULL( NULL | not NULL ) auswahlliste zurueck

    GetNull( selected extra, slect_name );

=cut

sub GetNull {
    my ( $self, @p ) = getSelf(@_);
    my $null = shift @p;
    my $name = shift @p;
    if ( defined $null && defined $name ) {
        my $return = qq|<select class="editTable" name="$name">|;
        $return .= qq|<option value="not NULL">not NULL</option>|;
        $return .=
          $null eq 'YES'
          ? qq|<option value="NULL" selected="selected">NULL</option>|
          : qq|<option value="NULL">NULL</option>|;
        $return .= q|</select>|;
        return $return;
    } else {
        return 0;
    } ## end else [ if ( defined $null && ...)]
} ## end sub GetNull

=head2 GetExtra()

        gibt die extra(auto_increment) auswahlliste zurueck

        GetExtra(selected extra, slect_name);

=cut

sub GetExtra {
    my ( $self, @p ) = getSelf(@_);
    my $selected = shift @p;
    my $name     = shift @p;
    if ( defined $selected && defined $name ) {
        my $return = qq|<select class="editTable" name="$name">|;
        $return .= '<option value=""></option>';
        $return .=
          $selected eq "auto_increment"
          ? q|<option value="auto_increment" selected="selected">auto_increment</option>|
          : q|<option value="auto_increment">auto_increment</option>|;
        $return .= q|</select>|;
        return $return;
    } else {
        return 0;
    } ## end else [ if ( defined $selected...)]
} ## end sub GetExtra

=head2 GetColumnCollation()

       gibt eine auswahlliste (select) zurueck.

       GetColumnCollation( tabelle ,columne, name_select);

=cut

sub GetColumnCollation {
    my ( $self, @p ) = getSelf(@_);
    my $tbl    = shift @p;
    my $column = shift @p;
    my $name   = shift @p;
    if ( defined $tbl && defined $column && defined $name ) {
        $tbl = $m_dbh->quote_identifier($tbl);
        my $col       = $self->fetch_hashref( "show full columns from $tbl where field = ?", $column );
        my @collation = $self->fetch_AoH("SHOW COLLATION");
        my $return    = qq|<select class="editTable" name="$name" style="width:100px;"><option></option>|;
        unless ( $col->{Collation} ) {
            $return .= qq|<option  value="NULL"  selected="selected" >NULL</option>|;
        } else {
            $return .=
              $_->{Collation} eq $col->{Collation}
              ? qq|<option  value="$_->{Collation}"  selected="selected" >$_->{Collation}</option>|
              : qq|<option  value="$_->{Collation}">$_->{Collation}</option>|
              foreach @collation;
        } ## end else
        $return .= '</select>';
        return $return;
    } else {
        return 0;
    } ## end else [ if ( defined $tbl && defined...)]
} ## end sub GetColumnCollation

=head2 GetCollation()

    $sel = GetCollation( name, selected );

=cut

sub GetCollation {
    my ( $self, @p ) = getSelf(@_);
    my $name     = shift @p;
    my $selected = shift @p;
    no warnings;    #$selected maybe empty
    my @collation = $self->fetch_AoH("SHOW COLLATION");
    if ($name) {
        my @a = $self->fetch_AoH("SHOW TABLE STATUS");
        for ( my $i = 0 ; $i <= $#a ; $i++ ) {
            $selected = $a[$i]->{Collation} if ( $a[$i]->{Name} eq $selected );
        } ## end for ( my $i = 0 ; $i <=...)
    } ## end if ($name)
    my $return = qq|<select class="editTable" name="$name" style="width:100px;"><option></option>|;
    $return .= qq|<option  value="$_->{Collation}"| . ( $selected eq $_->{Collation} ? 'selected="selected"' : '' ) . qq|>$_->{Collation}</option>|
      foreach @collation;
    $return .= '</select>';
    return $return;
} ## end sub GetCollation

=head2 GetCharset()

    $sel = GetCharset(name,selected table);

=cut

sub GetCharset {
    my ( $self, @p ) = getSelf(@_);
    my $name     = shift @p;
    my $selected = shift @p;
    my @Charset  = $self->fetch_AoH("SHOW Charset");
    if ($name) {
        my @a = $self->fetch_AoH("SHOW TABLE STATUS");
        for ( my $i = 0 ; $i <= $#a ; $i++ ) {
            $selected = $a[$i]->{Collation} if ( $a[$i]->{Name} eq $selected );
        } ## end for ( my $i = 0 ; $i <=...)
    } ## end if ($name)
    $selected = GetCharacterSet($selected);
    my $return = qq|<select class="editTable" name="$name" style="width:100px;"><option></option>|;
    $return .= qq|<option  value="$_->{Charset}"| . ( $selected eq $_->{Charset} ? 'selected="selected"' : '' ) . qq|>$_->{Charset}</option>|
      foreach @Charset;
    $return .= '</select>';
    return $return;
} ## end sub GetCharset

=head2 GetAttrs

       $sel = GetAttrs($tbl, $field, $name );

=cut

sub GetAttrs {
    my ( $self, @p ) = getSelf(@_);
    my $tbl    = shift @p;
    my $select = shift @p;
    my $name   = shift @p;
    if ($tbl) {
        $tbl = $m_dbh->quote_identifier($tbl);
        my $hr = $self->fetch_hashref("SHOW CREATE TABLE $tbl");
        $select = $self->quote_identifier($select);
        return qq|<select class="editTable" name="$name" style="width:100px;"><option></option><option value="UNSIGNED" |
          . (
            $hr->{'Create Table'} =~ /$select[^,]+UNSIGNED/ ? 'selected="selected"'
            : ''
          )
          . q|>UNSIGNED</option><option  value="UNSIGNED ZEROFILL" |
          . (
            $hr->{'Create Table'} =~ /$select[^,]+UNSIGNED ZEROFILL/ ? 'selected="selected"'
            : ''
          )
          . q|>UNSIGNED ZEROFILL</option><option  value="ON UPDATE CURRENT_TIMESTAMP"  |
          . (
            $hr->{'Create Table'} =~ /$select[^,]+ON UPDATE CURRENT_TIMESTAMP/ ? 'selected="selected"'
            : ''
          ) . q|>ON UPDATE CURRENT_TIMESTAMP</option></select>|;
    } else {
        return
            qq(<select class="editTable" name="$name" style="width:100px;"><option></option><option  value="UNSIGNED" )
          . ( $select eq 'UNSIGNED' ? 'selected="selected"' : '' )
          . q(>UNSIGNED</option><option  value="UNSIGNED ZEROFILL" )
          . ( $select eq 'UNSIGNED ZEROFILL' ? 'selected="selected"' : '' )
          . q(>UNSIGNED ZEROFILL</option><option  value="ON UPDATE CURRENT_TIMESTAMP" )
          . ( $select eq 'ON UPDATE CURRENT_TIMESTAMP' ? 'selected="selected"' : '' )
          . q(>ON UPDATE CURRENT_TIMESTAMP</option></select>);
    } ## end else [ if ($tbl) ]
} ## end sub GetAttrs

=head2 GetColumns

    $sel = GetColumns($tbl , $name, $selected);

=cut

sub GetColumns {
    my ( $self, @p ) = getSelf(@_);
    my $tbl      = shift @p;
    my $name     = shift @p;
    my $selected = $p[0] ? shift @p : '';
    $tbl = $m_dbh->quote_identifier($tbl);
    my @col    = $self->fetch_AoH("show columns from $tbl");
    my $return = qq|<select class="editTable" name="$name" style="width:100px;">|;
    $return .= qq|<option  value="$_->{Field}" | . ( $selected eq $_->{Field} ? 'selected="selected"' : '' ) . qq|>$_->{Field}</option>| foreach @col;
    $return .= '</select>';
    return $return;
} ## end sub GetColumns

=head2 addMessage

     my %message = (

          thread => $thread,

          title => $headline,

          body  => $body,

          thread => $thread,

          cat    => $cat,

          attach => $sra,

          format => $format,

          id => $id,

          user => $sUser,

          attach => $m_sFilename,

          ip => remote_addr(),


     );

     my $id = addMessage(\%message);

=cut

sub addMessage {
    my ( $self, @p ) = getSelf(@_);
    if ( $self->checkFlood( $p[0]->{ip} ) ) {
        my $thread = defined $p[0]->{thread} ? $p[0]->{thread} : 'trash';
        $thread = ( $thread =~ /^(\w{3,50})$/ ) ? $1 : 'trash';
        $thread = $m_dbh->quote_identifier($thread);
        my $headline = defined $p[0]->{title} ? $p[0]->{title} : 'headline';
        $headline = ( $headline =~ /^(.{3,100})$/ ) ? $1 : 'Invalid headline';
        my $sUser     = defined $p[0]->{user}   ? $p[0]->{user}   : 'guest';
        my $body      = defined $p[0]->{body}   ? $p[0]->{body}   : 'Body';
        my $cat       = defined $p[0]->{cat}    ? $p[0]->{cat}    : 'news';
        my $rght      = $self->catright($cat);
        my $attach    = defined $p[0]->{attach} ? $p[0]->{attach} : 0;
        my $format    = defined $p[0]->{format} ? $p[0]->{format} : 'markdown';
        my $m_sAction = defined $p[0]->{action} ? $p[0]->{action} : 'news';
        my $sql       = "insert into $thread (`title`,`body`,`attach`,`cat`,`right`,`user`,`action`,`format`) values(?,?,?,?,?,?,?,?)";
        my $sth       = $m_dbh->prepare($sql);
        $sth->execute( $headline, $body, $attach, $cat, $rght, $sUser, $m_sAction, $format )
          or warn $m_dbh->errstr;
        my $id = $m_dbh->last_insert_id( undef, undef, qw(news news_id) );
        $sth->finish();
        return $id;
    } else {
        return 0;
    } ## end else [ if ( $self->checkFlood...)]
} ## end sub addMessage

=head2 editMessage()

     my %message = (

          thread => $thread,

          title => $headline,

          body  => $body,

          thread => $thread,

          cat    => $cat,

          attach => $sra,

          format => $format,

          id => $id,

          user => $sUser,

          attach => $m_sFilename,

          ip => remote_addr(),

     );

     editMessage(\%message);

=cut

sub editMessage {
    my ( $self, @p ) = getSelf(@_);
    if ( $self->checkFlood( $p[0]->{ip} ) ) {
        my $thread = defined $p[0]->{thread} ? $p[0]->{thread} : 'trash';
        $thread = ( $thread =~ /^(\w{3,50})$/ ) ? $1 : 'trash';
        $thread = $m_dbh->quote_identifier($thread);
        my $refid    = defined $p[0]->{id}    ? $p[0]->{id}    : 1;
        my $headline = defined $p[0]->{title} ? $p[0]->{title} : 'headline';
        $headline = ( $headline =~ /^(.{3,100})$/ ) ? $1 : 'Invalid headline';
        my $sUser  = defined $p[0]->{user}   ? $p[0]->{user}   : 'guest';
        my $body   = defined $p[0]->{body}   ? $p[0]->{body}   : 'Body';
        my $attach = defined $p[0]->{attach} ? $p[0]->{attach} : 0;
        my $format = defined $p[0]->{format} ? $p[0]->{format} : 'markdown';
        my $cat    = defined $p[0]->{cat}    ? $p[0]->{cat}    : 'news';
        my $up =
          defined $p[0]->{uploadpath}
          ? $p[0]->{uploadpath}
          : '/srv/www/htdocs/downloads';

        if ( $attach ne '0.0' ) {
            my $sql_insert = qq/update $thread set title =?, body =? , attach= ?,format =?,user =?,cat =?,`right` =? where id = ?;/;
            my $sth        = $m_dbh->prepare($sql_insert);
            $sth->execute( $headline, $body, $attach, $format, $sUser, $cat, $self->catright($cat), $refid )
              or warn $m_dbh->errstr;
            $sth->finish();
        } else {
            my $sql_insert = qq/update $thread set title =?, body = ? ,format = ?,user = ?,cat = ?,`right` =?  where id = ?;/;
            my $sth        = $m_dbh->prepare($sql_insert);
            $sth->execute( $headline, $body, $format, $sUser, $cat, $self->catright($cat), $refid )
              or warn $m_dbh->errstr;
            $sth->finish();
        } ## end else [ if ( $attach ne '0.0' )]
    } ## end if ( $self->checkFlood...)
} ## end sub editMessage

=head2 reply

     my %reply =(

          title => $headline,

          body => $body,

          id => $reply,

          user => $sUser,

          attach =>  $sra,

          format => $html,

          ip => remote_addr(),

     );

     reply(\%reply);

=cut

sub reply {
    my ( $self, @p ) = getSelf(@_);
    if ( $self->checkFlood( $p[0]->{ip} ) ) {
        my $headline = defined $p[0]->{title} ? $p[0]->{title} : 'headline';
        $headline = ( $headline =~ /^(.{3,100})$/ ) ? $1 : 'Invalid headline';
        my $sUser  = defined $p[0]->{user}   ? $p[0]->{user}   : 'guest';
        my $body   = defined $p[0]->{body}   ? $p[0]->{body}   : 'Body';
        my $attach = defined $p[0]->{attach} ? $p[0]->{attach} : 0;
        my $format = defined $p[0]->{format} ? $p[0]->{format} : 'markdown';
        my $refid  = defined $p[0]->{id}     ? $p[0]->{id}     : 1;
        my $sql    = "insert into replies (`title`,`body`,`attach`,`right`,`user`,`refererId`,`format`) values(?,?,?,?,?,?,?)";
        my $sth    = $m_dbh->prepare($sql);
        $sth->execute( $headline, $body, $attach, $self->topicright($refid), $sUser, $refid, $format )
          or warn $m_dbh->errstr;
        $sth->finish();
    } ## end if ( $self->checkFlood...)
} ## end sub reply

=head2 deleteMessage

      $bool = $self->deleteMessage($table,$id);

=cut

sub deleteMessage {
    my ( $self, @p ) = getSelf(@_);
    my $p_sTable   = $p[0];
    my $id         = $p[1];
    my $sql_backup = "select * from $p_sTable  Where id  = '$id'";
    my $sth_backup = $m_dbh->prepare($sql_backup);
    $sth_backup->execute();
    my $backup    = $sth_backup->fetchrow_hashref();
    my $c         = ( $p_sTable eq 'replies' ) ? 'replies' : $backup->{cat};
    my $refererId = ( $p_sTable eq 'replies' ) ? $backup->{refererId} : 0;
    my $sql_trash =
"insert into `trash`  (`table`,`oldId`,`title`,`body`,`date`,`user`,`right`,`attach`,`cat`,`sticky`,`refererId`,`format`) values(?,?,?,?,?,?,?,?,?,?,?)";
    my $sth_trash = $m_dbh->prepare($sql_trash);
    $sth_trash->execute(
        $p_sTable,        $id,               $backup->{title}, $backup->{body},   $backup->{date}, $backup->{user},
        $backup->{right}, $backup->{attach}, $c,               $backup->{sticky}, $refererId,      $backup->{format}
    );
    my $sql_delete = "DELETE FROM $p_sTable Where id  = '$id'";
    my $sth        = $m_dbh->prepare($sql_delete);
    $sth->execute() or warn $m_dbh->errstr;
    $sth->finish();
    return 1;
} ## end sub deleteMessage

=head2 readMenu()

      @menu = $m_oDatabase->readMenu($sThread,$nRight,$nStart,$nEnd);

=cut

sub readMenu {
    my ( $self, @p ) = getSelf(@_);
    my $thread   = $p[0];
    my $p_nRight = $p[1];
    my $p_nStart = $p[2];
    my $p_nEnd   = $p[3];
    $p_nStart = 0  unless ( defined $p_nStart );
    $p_nEnd   = 10 unless ( defined $p_nEnd );
    my $limit    = $p_nEnd - $p_nStart;
    my $sql_read = qq/select title,id from  $thread where `right` <= $p_nRight order by date desc  LIMIT $p_nStart , $limit/;
    my $sth      = $m_dbh->prepare($sql_read);
    $sth->execute();
    my @output;

    while ( my @data = $sth->fetchrow_array() ) {
        my $headline = $data[0];
        my $id       = $data[1];
        $headline =~ s/(.{15}).+/$1.../;
        my $nl = "javascript:requestURI('$m_sServerName$ENV{SCRIPT_NAME}?action=$thread&von=$p_nStart&bis=$p_nEnd');";
        push @output,
          {
            text => $headline,
            href => $nl,
          };
    } ## end while ( my @data = $sth->...)
    $sth->finish();
    return @output;
} ## end sub readMenu

=head2 rss()

      $rss = $m_oDatabase->rss($thread,int start);

=cut

sub rss {
    my ( $self, @p ) = getSelf(@_);
    my $thread = $p[0];
    $thread = 'news' unless ( defined $thread );
    my $p_nStart = $p[1];
    $p_nStart = 0 unless ( defined $p_nStart );
    my $description = $p[2];
    $description = 'Feed' unless ( defined $description );
    my $time     = localtime;
    my $sql_read = qq/select *from  $thread  where `right` = '0' order by id desc LIMIT $p_nStart , 10/;
    my $sth      = $m_dbh->prepare($sql_read);
    $sth->execute();
    my @output;
    push @output,
qq(<?xml version="1.0" encoding="UTF-8"?>\n<rss xmlns:atom="http://www.w3.org/2005/Atom" version="2.0"><channel><title><![CDATA[$thread]]></title>\n<description><![CDATA[$description]]></description>\n<link><![CDATA[$m_sServerName]]></link>\n<language>de</language>\n<pubDate><![CDATA[$time]]></pubDate>\n);

    while ( my @data = $sth->fetchrow_array() ) {
        my $headline = $data[0];
        my $body     = $data[1];
        my $href     = $data[9];
        my $link     = "$m_sServerName?$m_sServerName/cgi-bin/mysql.pl?action=reply&reply=$href&thread=news#$href";
        push @output,
          "\n<item>\n<title><![CDATA[$headline]]></title>\n<link><![CDATA[$link]]></link>\n<description><![CDATA[$body]]></description></item>";
    } ## end while ( my @data = $sth->...)
    push @output, "\n</channel>\n</rss>";
    $sth->finish();
    return "@output";
} ## end sub rss

=head2 searchDB()

       searchDB($query,$column,$table,$rigt,$start,$end);

regexp search in tabelle ...

=cut

sub searchDB {
    my ( $self, @p ) = getSelf(@_);
    my $p_sQuery = $p[0];
    eval { return 0 if /($p_sQuery)/; };
    return "Invalid regexp : $@" if $@;
    $p_sQuery = $self->quote($p_sQuery);
    my $p_sCol = $p[1];
    $p_sCol = $m_dbh->quote_identifier($p_sCol);
    my $p_sTable = $p[2];
    $p_sTable = $m_dbh->quote_identifier($p_sTable);
    my $p_nRight = $p[3];
    my $p_nStart = $p[4] ? $p[4] : 0;
    my $p_nEnd   = $p[5] ? $p[5] : 100;
    my $limit    = $p_nEnd - $p_nStart;
    $p_nRight = $p_nRight =~ /(\d+)/ ? $1 : 0;
    $p_nStart = $p_nStart =~ /(\d+)/ ? $1 : 0;
    $limit    = $limit =~ /(\d+)/    ? $1 : 10;
    my $sql_select =
"SELECT * FROM $p_sTable WHERE  `right` <= $p_nRight  && ( $p_sCol REGEXP $p_sQuery || title REGEXP $p_sQuery )  order by date desc LIMIT $p_nStart , $limit ";
    my $b =
'<table align="center" summary="layoutSearch" border="0" cellpadding="0" cellspacing="0" width="100%"><tr><td class="caption">Title</td><td class="caption">User</td><td class="caption">Datum</td></tr>';
    my @messages = $self->fetch_AoH($sql_select);

    for ( my $i = 0 ; $i <= $#messages ; $i++ ) {
        my $body = $messages[$i]->{body};
        if ( !utf8::is_utf8($body) ) {
            utf8::decode($body);
        } ## end if ( !utf8::is_utf8($body...))
        $body =~ s/\[([^\]])+\]//gs;
        $body =~ s?<[^>]+>??gs;
        my $j = index $body, /$p[0]/;
        $j = $j > 50 ? $j - 50 : 0;
        $body = substr( $body, $j, 150 );
        $body = encode_entities($body);
        $body =~ s?($p[0])?<span style="color:red;">$1</span>?ig;

        if ( !utf8::is_utf8( $messages[$i]->{title} ) ) {
            utf8::decode( $messages[$i]->{title} );
        } ## end if ( !utf8::is_utf8( $messages...))
        $messages[$i]->{title} = encode_entities( $messages[$i]->{title} );
        $messages[$i]->{title} =~ s?($p[0])?<span style="color:red;">$1</span>?ig;
        my $link = "javascript:requestURI('$m_sServerName$ENV{SCRIPT_NAME}?action=showthread&reply=$messages[$i]->{id}','showthread','showthread');";
        $b .=
qq(<tr><td class="values"><a href="$link" class="menuLink">$messages[$i]->{title}</a></td><td class="values">$messages[$i]->{user}</td><td align="right" class="values"><font size="-1">$messages[$i]->{date}</font></td></tr><tr><td colspan="3"><font size="-2">$body</font></td></tr>);
    } ## end for ( my $i = 0 ; $i <=...)
    $b .= '</table>';
    return $b;
} ## end sub searchDB

=head2 fulltext()

      @messages = fulltext(query,table);

fulltextsuche in tabelle ...

=cut

sub fulltext {
    my ( $self, @p ) = getSelf(@_);
    my $p_sQuery = $p[0];
    eval { return 0 if /($p_sQuery)/; };
    return "Invalid Query : <br/>" if $@;
    $p_sQuery = $self->quote($p_sQuery);
    my $p_sTable = $p[1];
    $p_sTable = $m_dbh->quote_identifier($p_sTable);
    my $p_nRight = $p[2];
    my $p_nStart = $p[3] ? $p[3] : 0;
    my $p_nEnd   = $p[4] ? $p[4] : 100;
    my $limit    = $p_nEnd - $p_nStart;
    $p_nRight = $p_nRight =~ /(\d+)/ ? $1 : 0;
    $p_nStart = $p_nStart =~ /(\d+)/ ? $1 : 0;
    $limit    = $limit =~ /(\d+)/    ? $1 : 10;
    my $b        = '<table class="ShowTables"><tr><td class="caption">Title</td><td class="caption">User</td><td class="caption">Datum</td></tr>';
    my @messages = $self->fetch_AoH(
        "SELECT * FROM $p_sTable  where `right` <= $p_nRight and MATCH (title,body) AGAINST($p_sQuery) order by date desc LIMIT $p_nStart , $limit");

    for ( my $i = 0 ; $i <= $#messages ; $i++ ) {
        my $body = $messages[$i]->{body};
        if ( !utf8::is_utf8($body) ) {
            utf8::decode($body);
        } ## end if ( !utf8::is_utf8($body...))
        $body =~ s/\[([^\]])+\]//gs;
        $body =~ s?<[^>]+>??gs;
        my $j = index $body, $p_sQuery;
        $j = $j > 50 ? $j - 50 : 0;
        $body = substr( $body, $j, 150 );
        $body = encode_entities($body);
        $body =~ s/($p[0])/<span style="color:red;">$1<\/span>/ig;

        if ( !utf8::is_utf8( $messages[$i]->{title} ) ) {
            utf8::decode( $messages[$i]->{title} );
        } ## end if ( !utf8::is_utf8( $messages...))
        $messages[$i]->{title} = encode_entities( $messages[$i]->{title} );
        $messages[$i]->{title} =~ s/($p[0])/<span style="color:red;">$1<\/span>/ig;
        my $link = "javascript:requestURI('$m_sServerName$ENV{SCRIPT_NAME}?action=showthread&reply=$messages[$i]->{id}','showthread','showthread')";
        $b .=
qq(<tr><td class="values"><a href="$link" class="menuLink">$messages[$i]->{title}</a></td><td class="values">$messages[$i]->{user}</td><td align="right" class="values"><font size="-1">$messages[$i]->{date}</font></td></tr><tr><td colspan="3"><font size="-2">$body</font></td></tr>);
    } ## end for ( my $i = 0 ; $i <=...)
    $b .= '</table>';
    return $b;
} ## end sub fulltext

=head2 getAction

      $hashref = $m_oDatabase->getAction($m_sAction);

=cut

sub getAction {
    my ( $self, @p ) = getSelf(@_);
    my $m_sAction = $p[0];
    my $sql       = q/select * from actions where action = ?/;
    my $sth       = $m_dbh->prepare($sql) or warn $m_dbh->errstr;
    $sth->execute($m_sAction);
    my $hr = $sth->fetchrow_hashref;
    $sth->finish();
    return $hr;
} ## end sub getAction

=head2 getActionRight

      $right = $m_oDatabase->getActionRight($m_sAction);

=cut

sub getActionRight {
    my ( $self, @p ) = getSelf(@_);
    my $m_sAction = $p[0];
    my $sql       = q/select `right` from actions where action = ?/;
    my $sth       = $m_dbh->prepare($sql) or warn $m_dbh->errstr;
    $sth->execute($m_sAction);
    my $hr = $sth->fetchrow_array;
    $sth->finish();
    return $hr;
} ## end sub getActionRight

=head2 topicright()

      topicright(id);

=cut

sub topicright {
    my ( $self, @p ) = getSelf(@_);
    my $id  = $p[0];
    my $sql = 'SELECT `right` FROM news where id = ?';
    my $sth = $m_dbh->prepare($sql);
    $sth->execute($id);
    my @q = $sth->fetchrow_array;
    $sth->finish();
    return $q[0];
} ## end sub topicright

=head2 getSelf()

    getSelf or CGI

=cut

sub getSelf {
    return @_ if defined( $_[0] ) && ( !ref( $_[0] ) ) && ( $_[0] eq 'DBI::Library::Database' );
    return (
        defined( $_[0] ) && ( ref( $_[0] ) eq 'DBI::Library::Database'
            || UNIVERSAL::isa( $_[0], 'DBI::Library::Database' ) )
      )
      ? @_
      : ( $DBI::Library::Database::m_sDefaultClass->new, @_ );
} ## end sub getSelf

package DBI::Library::Database::db;
use vars qw(@ISA);
@ISA = qw(DBI::Library:::db);

=head2 prepare()

=cut

sub prepare {
    my ( $m_dbh, @args ) = @_;
    my $sth = $m_dbh->SUPER::prepare(@args) or return;
    return $sth;
} ## end sub prepare

package DBI::Library::Database::st;
use vars qw(@ISA);
@ISA = qw(DBI::Library::st);

=head2 execute()

=cut

sub execute {
    my ( $sth, @args ) = @_;
    my $rv = $sth->SUPER::execute(@args) or return;
    return $rv;
} ## end sub execute

=head2 fetch()

=cut

sub fetch {
    my ( $sth, @args ) = @_;
    my $row = $sth->SUPER::fetch(@args) or return;
    return $row;
} ## end sub fetch

=head1 SEE ALSO

L<MySQL::Admin::GUI> L<DBI> L<DBI::Library>

=head1 AUTHOR

Dirk Lindner <lze@cpan.org>

=head1 LICENSE

Copyright (C) 2005-2016 by Hr. Dirk Lindner

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation;
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 Lesser General Public License for more details.

=cut
1;