#!/usr/local/bin/perl -T

use lib './module/';
use strict;
use Tie;
use CGI; my $q=new CGI;
use CGI::Carp qw(fatalsToBrowser);

########################################

my $Quest= $q->param('-quest'); defined $Quest or $Quest='';
my $Row= $q->param('-row'); defined $Row or $Row=0;
my $local= defined $q->param('-local') ? 'checked' : '';
my $sel= $q->param('-sel'); defined $sel or $sel=0;
my $del= $q->param('-del'); defined $del or $del=0;
my $Go= $q->param('-go'); defined $Go or $Go=0;	#0-SELECT ALL; 1-SELECT ONE; 2-UPDATE

0=~/(.)/; $Quest=~ /\s*SELECT\s+([^\s]+)\s+FROM\s+([^\s]+)/i;
my( $fields,$table )=( $1,$2 );

0=~/(.)/; $Quest=~ /WHERE\s+(.+)\s*$/i;
my $where= defined $1 ? $1 : '';

########################################

print $q->header( -type=>'text/html', -charset=>'WINDOWS-1251' );
print $q->start_html( -title=>'Просмотр, изменение и удаление данных', -style=>$STYLE, "leftmargin=0 topmargin=0 marginwidth=0 marginheight=0" );

print "<div align=center><div style='border:1px solid #BBB;width:95%;color:#006;background-color:#FFF;font-size:15;padding:2;margin:1'>";

print $q->start_form( -method=>'GET', -action=>'select.cgi' );
print "<a href=select.cgi><u>Запрос в БД</u></a><br>";

my $value= $Quest ? $Quest : sel($sel);

print $q->textfield( -name=>'-quest', -class=>'boxLagre', -size=>100, -value=>$value ).' ';
print $q->submit( -name=>'>>', -class=>'boxLagre' );
print $q->end_form;

print $q->start_form( -method=>'POST', -action=>'select.cgi' );
print $q->hidden( -name=>'-quest', -value=>$Quest );

################### DELETE

if( $del eq'Delete' && $table ){

	die'В запросе нет WHERE!<br>' unless $where;
	$where=~ s/LIMIT\s+([\d\,]+)//i;
	$where=~ s/ORDER\s+BY.+$//i;
	$where=~ s/GROUP\s+BY.+$//i;

	my( @old )=();
	for( $q->param ){
		my( $key,$val )= ( $_,$dbSQL->quote($q->param($_)) );
		if( $key!~/^-/ ){ push(@old, "BINARY $key=$val") }
	}
	my $old= join' AND ',@old;

	$Q->param(Q=>"DELETE FROM $table WHERE $where AND $old LIMIT 1");
	Tie();

	print '<code>Удалено строк на удалённом хосте: ',$A->param('A'),'</code><br>';
	print '<code>Удалено строк на локальном хосте: ',$dbSQL->do("DELETE FROM $table WHERE $where AND $old LIMIT 1"),'</code>' unless $local;
}

################### UPDATE

elsif( $Go==2 && $table ){

	die'В запросе нет WHERE!\n' unless $where;
	$where=~ s/LIMIT\s+([\d\,]+)//i;
	$where=~ s/ORDER\s+BY.+$//i;
	$where=~ s/GROUP\s+BY.+$//i;

	my @field= $fields eq'*' ? @{ $dbSQL->selectcol_arrayref("DESC $table") } : split/,/,$fields;

	my( $i,@sql,@old,%old )=( 0 );
	for( $q->param ){
		my( $key,$val )= ( $_,$dbSQL->quote($q->param($_)) );
		if( $key=~/^-OLD_(.*)$/ ){ push(@old, "BINARY $1=$val"); $old{$1}=$val }
		else{ $old{$key}='' }
	}
	for( $q->param ){
		my( $key,$val )= ( $_,$dbSQL->quote($q->param($_)) );
		if( $key!~/^-/ && $old{$key} ne $val ){ push(@sql, "$key=$val") };
	}

	die"Нет изменений данных в Вашем запросе!\n" unless @sql;
	my $sql= join',', @sql;
	my $old= join' AND ',@old;

	$Q->param(Q=>"UPDATE $table SET $sql WHERE $where AND $old LIMIT 1");
	Tie();

	print '<code>Обновлено строк на удалённом хосте: ',$A->param('A'),'</code><br>';
	print '<code>Обновлено строк на локальном хосте: ',
		$dbSQL->do("UPDATE $table SET $sql WHERE $where AND $old LIMIT 1"),'</code>' unless $local;
}

################### SELECT

if( $Go==0 && $Quest ){

	print "<p><table border=0 width=100% cellspacing=1 cellpadding=1><tr align=center bgcolor=#BBBBBB>";
	print "<input type=hidden name='-go' value=1>";
	print "<td>UP" if $where;
	for( $fields eq'*' ? @{ $dbSQL->selectcol_arrayref("DESC $table") } : split/,/,$fields ){ print "<td class=w8>$_" }

	$Q->param(Q=>"$Quest LIMIT 0,20");
	Tie();

	my( $i,$ib,$bg )=( 1,0 );
	for( $A->param('A') ){

		$bg= $ib?'#FFFFF0':'#EEEEEE'; $ib= $ib?0:1;
		print "<tr bgcolor=$bg>";
		print "<td><input type=submit name='-row' value=$i class=box>" if $where;
		for( @{fields($_)} ){ print "<td>$_->[1]" }
		$i++;
	}
	print "<tr class=tg><td colspan=40>";
}

elsif( ($Go==1||$Go==2) && $table ){

	$Quest=~ s/LIMIT\s+([\d\,]+)//i;
	my $r=$Row-1;

	my $qS= $Row ? "$Quest LIMIT $r,1" : "$Quest LIMIT 0,1";
	$Q->param(Q=>$qS);
	Tie();

	print "<p><small>Не производить изменения на локальном хосте <input type=checkbox $local name='-local' value=1 class=box></small>";
	print "<table border=0 width=500 cellspacing=1 cellpadding=1>";
	print "<tr bgcolor=#BBBBBB><td colspan=2>Таблица $table</td>";

	my( $ib,$bg )=( 0 );
	for( @{
		fields($A->param('A'))
	} ){
		$bg= $ib?'#FFFFF0':'#EEEEEE'; $ib= $ib?0:1;
		$_->[1]= html( $_->[1] );

		print "<tr bgcolor=$bg><td>$_->[0]</td><td><input size=75 class=box name=$_->[0] value=\"$_->[1]\">";
		print "<input type=hidden name='-OLD_$_->[0]' value='$_->[1]'>" if $_->[1] && $_->[1]!~/[^\w\-\.]/;
		print "</td></tr>";
	}

	print "<input type=hidden name='-go' value=2>";
	print "<input type=hidden name='-row' value=$Row>";
	print "<tr><td colspan=2 align=center><input type=submit value=Update class=boxG>";
	print " &nbsp; <input type=submit name='-del' value=Delete class=boxR onClick=\"return confirm('Удалить строку в таблице?')\">";
}

print "</table></form></div></div></body></html>";
exit(0);

########################################

sub csv{

	my $text= shift;
	my @new=();
	push(@new, $+) while $text=~ m{'([^\'\\]*(?:\\.[^\'\\]*)*)',? | ([^,]+),? | ,}gx;
	push(@new, undef) if substr($text,-1,1) eq'';
	foreach( @new ){ s/(\\([^\\]))/$2/g }

	return @new;
}


sub fields{

	my $value= shift;
	my @field= $fields eq'*' ? @{ $dbSQL->selectcol_arrayref("DESC $table") } : split/,/,$fields;

	my $i=0;
	for( csv($value) ){
		my $val= defined $_ ? $_ : '';
		$field[$i]= [$field[$i],$val];
		$i++;
	}

	return \@field;
}


sub html{

	my $val= shift;
	$val=~ s/&/&amp;/g;
	$val=~ s/</&lt;/g;
	$val=~ s/>/&gt;/g;
	$val=~ s/"/&quot;/g;

	return $val;
}


sub sel{

	my $sel= shift;
	my( $n,%sel )=( 0 );

	open OP, './dbm/select' or die 'no file /dbm/select\n';
	while( <OP> ){
		s/\s*\#+.*$//;
		next if !$_ || /^\r?\n$/;

		if( /^\>(.*)/ ){ $sel{$n}[2].=" $1"; next }

		0=~/(.)/; /^\=+\s?([\d]+)\s*(.*)$/;
		if( $1 ){ $n=lc $1; $sel{$n}[1]=$2; next }
		$sel{$n}[0]=$_ if $n;
	}
	close OP;

	if( $sel==0 ){

		print "<ul>";
		for( sort{ $a<=>$b } keys %sel ){

			print "<li><a href=select.cgi?-sel=$_>$sel{$_}[1]</a> » ";
			print "<small>$sel{$_}[2]</small>";
		}
		print "</ul>";
		return '';
	}

	elsif( $sel>0 ){
		print "<ul>";
		print "<li><a href=select.cgi?-sel=$_>$sel{$sel}[1]</a> » ";
		print "<small>$sel{$sel}[2]</small>";
		print "</ul>";
		return $sel{$sel}[0];
	}
}