#!/perl/bin/perl.exe
$|=1;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# Information Software SA
# Date In: 2004-12-26
# Updates: 2005-08-21,2006-01-10,2006-05-01,2012-04-10,2014-03-01,2016-02-09
# Author:Rodolfo Machon
# File Name: gmp.pl
#------------------------------------------------------------------------- 
#-------------------------------------------------------------------------
#PERL MODULES
use CGI;
use XML::Simple;
use Data::Dumper;
use DBI;
use Encode;
use Encode qw/is_utf8 decode/;
use CGI::Carp qw(fatalsToBrowser);
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
# HTML PRINTING ACTIVATION
print "Content-type: text/html; charset=utf-8\n\n";
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
# GET PARAMETERS
$cgiparms 				= new CGI;
$clase					= $cgiparms->param("clase");
$master_select_values	= $cgiparms->param("msu");
$master_insert_values	= $cgiparms->param("miv");
$master_update_values	= $cgiparms->param("muv");
$master_delete_values	= $cgiparms->param("mdv");
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# GET CLASE SCHEMA AND VARIABLES
get_app_data();
get_component_schema($clase);
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
# OPEN DATABASE CONNECTIONS - ODBCs
$dbh 	  = DBI->connect("dbi:ODBC:$appid",'','',{PrintError => 1, RaiseError => 1});
if (!$dbh) {print "error: connection: $DBI::err\n$DBI::errstr\n$DBI::state\n";}
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
# MAIN PROGRAM
if ($master_insert_values ne ""){insert_records($data->{clase}->{table},$data->{clase}->{insert_fields},$master_insert_values,$data->{clase}->{autoincrement});}
if ($master_update_values ne ""){update_records($data->{clase}->{table},$data->{clase}->{update_fields},$master_update_values,$data->{clase}->{id_field},$master_select_values);}
if ($master_delete_values ne ""){delete_records($data->{clase}->{table},$data->{clase}->{delete_fields},$master_delete_values);}
construct_page();

$dbh->disconnect if $dbh;
exit;
#-------------------------------------------------------------------------
# SUB-ROUTINES
sub insert_records{
    my ($table,$insert_fields,$insert_values,$autoincrement) = @_;
    $insert_fields =~ s/{lan}/$lan/g;
    if (uc($autoincrement) eq "YES"){	
		my @records	= split(/~~/,$insert_values);
		for (my $i=0;$i<=$#records;$i++){
			my $values		= "";
			my @records_values	= split(/\|/,$records[$i]);	
			my $query_temp 	= "INSERT INTO $table (ts_in) VALUES (now())";
			$dbh->do($query_temp);

			my $sql = "SELECT LAST_INSERT_ID()";
			my $sth = $dbh->prepare($sql);
			$sth->execute or die SQL_fail($sql,$dbh,'sub insert_records');
			while (my @row = $sth->fetchrow_array) {$records_values[0]=$row[0]}

			$insert_record = join("|",@records_values);
			$id_trick="|".$records_values[0]."|~~";
			update_records($table,$insert_fields,$insert_record,$data->{clase}->{id_field},$id_trick);
		}
    }elsif (uc($autoincrement) eq "NO"){	
		my $columns		= "";
		my $tmp_insert_fields	= $insert_fields;	
		my @fields 		= split(',',$tmp_insert_fields);	
		for($i=0;$i<=$#fields;$i++){
			$columns = $columns.$fields[$i].",";
		}
		$columns = substr($columns,0,length($columns)-1);
		my @records	= split(/~~/,$insert_values);
		for (my $i=0;$i<=$#records;$i++){
			my $values		= "";
			my @records_values	= split(/\|/,$records[$i]);	
			for ($j=0;$j<=$#fields;$j++){
				$record_values[$j] = decode_utf8($record_values[$j]);
				$record_values[$j] = encode("iso-8859-1",$record_values[$j]);
				if (substr($fields[$j],0,1) eq "i" || substr($fields[$j],0,1) eq "f" || substr($fields[$j],0,2) eq "d8"){
					if($records_values[$j] eq ""){
						$records_values[$j]="NULL";
					}
					$values=$values.$records_values[$j].","
				}else {
					if ($fields[$j] eq "ts_in"){
						$values=$values."now(),"
					}else{
						$values=$values."\"".$records_values[$j]."\","
					}
				}
			}
			$values = substr($values,0,length($values)-1);
			$values =~ s/(\d{2})-(\d{2})-(\d{4})/$3$1$2$more_time/g;
            
			my $query = "INSERT INTO $table ($columns) VALUES ($values)";
            #print $query;
			$dbh->do($query);
		}
    }
}
sub update_records{
    my ($table,$update_fields,$update_values,$where_fields,$where_values) = @_;
    $update_fields 		=~ s/{lan}/$lan/g;
    my $tmp_update_fields	= $update_fields;					
    my @where_records		= split(/~~/,"$where_values");
    my @records			= split(/~~/,"$update_values");
    for (my $i=0;$i<=$#records;$i++){
		my $set			= "";
		my $where		= "";
		my @record_values 	= split(/\|/,"$records[$i]");
		my @fields 		= split(',',$tmp_update_fields);	
		for (my $j=0;$j<=$#fields;$j++){
			if ($record_values[$j] ne ""){
				$record_values[$j] = decode_utf8($record_values[$j]);
				$record_values[$j] = encode("iso-8859-1",$record_values[$j]);
				my $val = $record_values[$j];				
				if (substr($fields[$j],0,1) eq "i" || substr($fields[$j],0,1) eq "f" || substr($fields[$j],0,2) eq "d8"){
					$set = $set.$fields[$j]."=".$val.",";					
				}else {
					$set = $set.$fields[$j]."='".$val."'".",";
				}
			}
		}
		my $len=length($set);
		$set=substr($set,0,$len-1);		
		$set=~ s/(\d{2})-(\d{2})-(\d{4})/$3$1$2$more_time/g;
		$where = get_wheres($where_fields,$where_records[$i]);
		my $query = "UPDATE $table SET $set WHERE $where";
        #print $query;
		$dbh->do($query);
    }
}
sub delete_records{
    my ($table,$delete_fields,$delete_values) = @_;
    $delete_fields =~ s/{lan}/$lan/g;
    my @del	   = split(/\~~/,"$delete_values");
    for (my $i=0;$i<=$#del;$i++){
		my $where = get_wheres($delete_fields,$del[$i]);
		my $query = "DELETE FROM $table WHERE $where";
		#print "$query <br>";
		$dbh->do($query);
		if($data->{clase}->{detail}){
			my $detail_database = $data->{clase}->{detail}->{database};
			my $detail_table    = $data->{clase}->{detail}->{table};
			my $detail_id_field = $data->{clase}->{detail}->{id_field};
			if($data->{clase}->{detail}->{delete} eq "YES"){
				my $detail_where = get_wheres($detail_id_field,$del[$i]);
				my $query1 	 = "DELETE FROM $detail_table WHERE $detail_where";
				$dbh->do($query1);
			}
		}
		if($data->{clase}->{associations} eq "YES"){
			my $detail_database = $data->{clase}->{detail}->{database};
			my $detail_table    = $data->{clase}->{detail}->{table};
			my $detail_id_field = $data->{clase}->{detail}->{id_field};
			if($data->{clase}->{detail}->{delete} eq "YES"){
				my $detail_where = get_wheres($detail_id_field,$del[$i]);
				my $query1 	 = "DELETE FROM $detail_table WHERE $detail_where";
				$dbh->do($query1);				
			}
		}
    }
}
sub construct_page {
    $data= "gml.pl?lan=$lan&appid=$appid&clase=$clase";
    open (DATA, "$path$file");
    while ($line = <DATA>) {
	    $line =~ s/{CGI}/$data/g;
	    $line =~ s/{message}/$message/g;
	    print $line;
    }    
}
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
#AUXILIAR-SUBROUTINES
sub get_app_data {
    my $schema  = "app.data.xml";
    my $xml     = new XML::Simple;
    my $data    = $xml->XMLin("../xml/".$schema);
    $appid      = $data->{portal}->{app};
    $lan        = $data->{portal}->{lang};
}
sub get_component_schema {
    my ($cmp)=@_;
    my $schema     = $cmp."_gmfl.xml";
    my $xml        = new XML::Simple;
    $data 	= $xml->XMLin("../xml/".$schema);
    $path	= $data->{base_path}."/libraries/html/";
    $file 	= "msg_processing.html";
    $message	= $data->{clase}->{msg_processing};
    $more_time	= "000000";
}
sub SQL_fail {
    my ($query,$dbh,$section)= @_;
    print "SQL failed in Section $section<br>";
    print "Query: ".$query."<br>";
    exit;
}
sub get_wheres{
    my ($where_fields,$where_values) = @_;
    my $whr		= "";			
    my $where		= "";
    my @where_fields	= split(',',"$where_fields");
    my @where_values	= split(/\|/,"$where_values");	
    for ($k=0;$k<=$#where_fields;$k++){
	    if (substr($where_fields[$k],0,1) eq "i" || substr($where_fields[$k],0,1) eq "f"){$whr=$whr.$where_fields[$k]."=".$where_values[$k+1]." and ";}
	    elsif(substr($where_fields[$k],0,2) eq "ts" ){$whr=$whr."substring(".$where_fields[$k]."+0,1,8)='".$where_values[$k+1]."' and ";}
	    else {$whr=$whr.$where_fields[$k]."='".$where_values[$k+1]."' and ";}
    }
    my $len	= length($whr);
    $where 	= substr($whr,0,$len-4);	
    $where	=~ s/(\d{2})-(\d{2})-(\d{4})/$3$1$2/g;
    return $where;
}
#-------------------------------------------------------------------------