#!/perl/bin/perl.exe
$|=1;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# Web 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: rcrdp.pl
#------------------------------------------------------------------------- 
#-------------------------------------------------------------------------
# PERL MODULES
use CGI;
use XML::Simple;
use Data::Dumper;
use DBI;
use CGI::Carp qw(fatalsToBrowser);
binmode STDOUT, ":encoding(utf8)";
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
# HTML PRINTING ACTIVATION
print "Content-type: text/html; charset=utf-8\n\n";
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
# GET PARAMETERS
$cgiparms 			= new CGI;

$clase      		= $cgiparms->param('clase');
$id 				= $cgiparms->param('id');
$master_insert_values= $cgiparms->param('iuv');
$associations_values= $cgiparms->param('aiv');
$associations_fields= $cgiparms->param('aif');
$exist 				= $cgiparms->param('exist');
$campos         	= $cgiparms->param('fields');
$valores        	= $cgiparms->param('values');
$passback			= $cgiparms->param('passback');
$opener_form    	= $cgiparms->param('opener_form');
$field_focus    	= $cgiparms->param('field_focus');
$checked_field    	= $cgiparms->param('checked_field');
$checked_value    	= $cgiparms->param('checked_value');
#-------------------------------------------------------------------------
#print "$master_insert_values <br>";
#-------------------------------------------------------------------------
# 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";}
$dbh->{LongReadLen} = 512 * 2048;
$dbh->{LongTruncOk} = 1;
#--------------------------------------------------------------------------
#--------------------------------------------------------------------------
# MAIN PROGRAM
if ($exist eq "false" ){
	if($checked_value ne ""){
		$iden = checked_value_exist($checked_field,$checked_value); 
		if($iden ne ""){construct_checked_page($iden);exit;}
	}
	insert_records('master',$master_insert_values);
	insert_associations($associations_values,$id);
}else{
	update_records('master',$master_insert_values,$campos,$valores);
	update_associations($associations_values,$id);
}
construct_page();
$dbh->disconnect if $dbh;
exit;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# SUB-ROUTINES
sub checked_value_exist {
	my ($cf,$cv)	= @_;
	my $iden	= "";
	my $keys	= $data->{clase}->{keys};	
	my $table	= $data->{clase}->{table};
	my $database	= $data->{clase}->{database};      
	my $query	= "SELECT $keys FROM $table WHERE $cf='$cv'";
	my $sth = $dbh->prepare($query);
	$sth->execute or die SQL_fail($query,$dbh,'sub checked_value_exist');
	while (my @row = $sth->fetchrow_array) {$iden=$row[0]}
	return $iden;
}
sub insert_records {
	my ($section,$insert_values) = @_;
	my $table	  = $data->{clase}->{table};
	my $id_field	  = $data->{clase}->{keys};	
	my $update_fields = $data->{clase}->{update_fields};
	my $insert_fields = $data->{clase}->{insert_fields};
	my $autoincrement = $data->{clase}->{autoincrement};
	if ($section eq "master" && $autoincrement eq "YES"){	
		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) {$id=$row[0]}
			
		my @uv	= split(/\|/,"$insert_values");
		for(my $a=1;$a<=$#uv;$a++){$update_values .= $uv[$a]."|";}		
		update_records('master',$update_values,'','');
	}
	if ($section eq "master" && $autoincrement eq "NO"){
		my $columns		= "";
		my $values	  	= "";
		my @records		= split(/~~/,"$insert_values");
		my @records_values	= split(/\|/,"$records[0]");
		if($data->{clase}->{construct_key}){
			my $key			= "";
			my @fields 		= split(/\,/,$insert_fields);
			my @construct_fields	= split(/\,/,$data->{clase}->{construct_key}->{construct_fields});
			for(my $a=0;$a<=$#fields;$a++){
				for(my $b=0;$b<=$#construct_fields;$b++){
					if($fields[$a] eq $construct_fields[$b]){
						$key .= $records_values[$a];
					}
				}
			}
			if ($data->{clase}->{construct_key}->{construct_counter} eq "YES"){
				my $new_count		= "";
				my $len			= length($key);
				my $counter_digits	= $data->{clase}->{construct_key}->{counter_digits};
				my $counter_start	= $data->{clase}->{construct_key}->{counter_start};
				my $query		= "SELECT $id_field FROM $table WHERE substring($id_field,1,$len)='$key' ORDER BY $id_field DESC LIMIT 1";
				my $sth = $dbh->prepare($query);
				$sth->execute or die SQL_fail($query,$dbh,'sub insert_records');
				if ($sth->rows > 0){
					my @row2 = $sth->fetchrow_array;
					my $lf	   = "true";
					my $str	   = "";
					$len 	   = length($row2[0]);
					$old_count = substr($row2[0],$len-$counter_digits,$counter_digits);
					for(my $b=0;$b<$counter_digits;$b++){
						if(substr($old_count,$b,1) ne "0" || $lf eq "false"){
							$str.= substr($old_count,$b,1);
							$lf  = "false";
						}
					}
					$str++;
					$len	   = length($str);
					for(my $c=$len;$c<$counter_digits;$c++){
						$new_count.="0"
					}
					$key .= $new_count.$str;
				}else{
					$key .= $counter_start;						
				}
			}
			for(my $j=1;$j<=$#fields;$j++){			
				if ($fields[$j] eq "ts_in"){$records_values[$j]="now()"}
				if ($records_values[$j] ne ""){				
					$columns .= $fields[$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(),"
					    }elsif (substr($fields[$j],0,2) eq "tm"){
							if($records_values[$j] eq ""){
								$records_values[$j]="NULL";
							}else{
								$values=$values."'".$records_values[$j]."',"
							}
					    }elsif (substr($fields[$j],0,2) eq "dt"){
							if($records_values[$j] eq ""){
								$records_values[$j]="NULL";
							}else{
								$values=$values."'".$records_values[$j]."',"
							}					
					    }else{
							$values=$values."'".$records_values[$j]."',"
						}
					}
				}
			}
			$columns .= $id_field;
			$id = $key;
			if (substr($id_field,0,1) eq "f" || substr($id_field,0,1) eq "i"){$values=$values.$id;}
			else {$values=$values."'".$id."'"}
		}else{
			my @fields = split(/\,/,$insert_fields);
			for(my $j=0;$j<=$#fields;$j++){
				if ($fields[$j] eq "ts_in"){$records_values[$j]="now()"}
				if ($records_values[$j] ne ""){
					$columns .= $fields[$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(),"
					    }elsif (substr($fields[$j],0,2) eq "tm"){
							if($records_values[$j] eq ""){
								$records_values[$j]="NULL";
							}else{
								$values=$values."'".$records_values[$j]."',"
							}					
					    }elsif (substr($fields[$j],0,2) eq "dt"){
							if($records_values[$j] eq ""){
								$records_values[$j]="NULL";
							}else{
								$values=$values."'".$records_values[$j]."',"
							}
					    }else{
							$values=$values."'".$records_values[$j]."',"
						}
					}
				}
			}
			$columns = substr($columns,0,length($columns)-1);
			$values  = substr($values,0,length($values)-1);
		}
		$query = "INSERT INTO $table ($columns) VALUES ($values)";
		#print "$query<br>";
		$dbh->do($query);
	}
}
sub update_records {
	my ($section,$update_values,$camps,$valors) = @_;
	my $table			= $data->{clase}->{table};
	my $id_field  		= $data->{clase}->{keys};
	my $update_fields	= $data->{clase}->{update_fields};
	my @fields 			= split(',',$update_fields);
	my $fields_amount	= scalar(@fields);
	my @records			= split(/~~/,"$update_values");
	my $records_amount	= scalar(@records);
	for ($i=0;$i<$records_amount;$i++){
		@record_values 	= split(/\|/,"$records[$i]");	
		for ($j=0;$j<$fields_amount;$j++){
			my $val = $record_values[$j];
			if($val ne ""){			
				if (substr($fields[$j],0,1) eq "i" || substr($fields[$j],0,1) eq "f" || substr($fields[$j],0,2) eq "d8"){
					$set.=$fields[$j]."=".$val.",";
				}else{
					if(substr($fields[$j],0,2) eq "ts"){
						$val=~ s/(\d{4})-(\d{2})-(\d{2})/$1$2$3$more_time/g;
					}
					$set.=$fields[$j]."=\"".$val."\"".",";
				}
			}
		}
		$len=length($set);
		$set=substr($set,0,$len-1);		
		if($camps eq ""){$query = "UPDATE $table SET $set WHERE $id_field=\"$id\""}else{$query = "UPDATE $table SET $set WHERE $id_field=\"$id\" and $camps=\"$valors\""}
		#print "$query<br>";
		$dbh->do($query);
	}
}
sub insert_associations {
	my ($insert_values,$id) = @_;
	my @ass	    = split(/\,/,$data->{clase}->{associations});
	my @records = split(/~~/,$insert_values);
	my @aifs	= split(/\~~/,"$associations_fields");

	for (my $i=0;$i<=$#ass;$i++){
		for (my $j=0;$j<=$#aifs;$j++){
			my @aiv = split(/\|/,$records[$j]);
			my @aif	= split(/\|/,$aifs[$j]);
			#print "$records[$j] <> $aifs[$j] <br>";
			if ($data->{clase}->{association}->{$ass[$i]}->{insert_fields}){
				if ($data->{clase}->{association}->{$ass[$i]}->{table} eq $aif[0]){
					my $id_field= $data->{clase}->{association}->{$ass[$i]}->{keys};
					my $table	= $data->{clase}->{association}->{$ass[$i]}->{table};
					my @fields  = split(/\,/,$data->{clase}->{association}->{$ass[$i]}->{insert_fields});
					my @mif = split(/\,/,$aif[1]);
					my @miv	= split(/\,/,$aiv[1]);
					my $columns  = "";
					my $values   = "";
					#print "$aif[1] <> $aiv[1] <br>";
					for (my $k=0;$k<=$#mif;$k++){
						for (my $n=0;$n<=$#fields;$n++){
							if ($mif[$k] eq $fields[$n]) {
								my $val = $miv[$k];
								$columns .= $fields[$k].",";
								if (substr($fields[$k],0,1) eq "f" || substr($fields[$k],0,1) eq "i" || substr($fields[$j],0,2) eq "d8"){
									if($val eq ""){
										$val="NULL"
									}
									$values=$values.$val.","
								}else {
									if(substr($fields[$k],0,2) eq "ts"){
										$val=~ s/(\d{4})-(\d{2})-(\d{2})/$1$2$3$more_time/g;
									}
									if ($fields[$k] eq "ts_in"){
										$val="NOW()";
										$values	= $values.$val.",";
									}else{
										$values	= $values."'".$val."',"
									}
								}
							}
						}
					}
					$columns .= $id_field;	 
					if (substr($id_field,0,1) eq "f" || substr($id_field,0,1) eq "i"){$values=$values.$id;}
					else {$values=$values."'".$id."'"}
				
					my $query = "INSERT INTO $table ($columns) VALUES ($values)";
					#print "$query<br>";
					$dbh->do($query);
				}
			}
		}
	}
}
sub update_associations {
	my ($update_values,$id) = @_;
	my @ass	    = split(/\,/,$data->{clase}->{associations});
	my @records = split(/~~/,$update_values);
	my @aifs	= split(/\~~/,"$associations_fields");

	for (my $i=0;$i<=$#ass;$i++){
		for (my $j=0;$j<=$#aifs;$j++){
			my @aiv = split(/\|/,$records[$j]);
			my @aif	= split(/\|/,$aifs[$j]);
			#print "$records[$j] <> $aifs[$j] <br>";
			if ($data->{clase}->{association}->{$ass[$i]}->{delete_fields}){
				if ($data->{clase}->{association}->{$ass[$i]}->{table} eq $aif[0]){
					my $id_field= $data->{clase}->{association}->{$ass[$i]}->{keys};
					my $table	= $data->{clase}->{association}->{$ass[$i]}->{table};
					my @fields	= split(/\,/,$data->{clase}->{association}->{$ass[$i]}->{delete_fields});
					my @mif = split(/\,/,$aif[1]);
					my @miv	= split(/\,/,$aiv[1]);
					my $set = "";
					#print "$aif[1] <> $aiv[1] <br>";
					for (my $k=0;$k<=$#mif;$k++){
						for (my $n=0;$n<=$#fields;$n++){
							if ($mif[$k] eq $fields[$n]) {
								my $val = $miv[$k];
								if (substr($fields[$n],0,1) eq "f"){
									$set.=$fields[$n]."=".$val." and ";
								}else{
									if(substr($fields[$n],0,2) eq "ts"){
										$val=~ s/(\d{4})-(\d{2})-(\d{2})/$1$2$3$more_time/g;
									}
									$set.=$fields[$n]."=\"".$val."\""." and ";
								}
							}
						}
					}
					$set .= " $id_field='$id'";
					my $query = "DELETE FROM $table WHERE $set";
					#print "$query <BR>";
					$dbh->do($query);
				}
			}
		}
	}
	insert_associations($update_values,$id);	
}
sub construct_page {
	my $data= "rcrd.pl?lan=$lan&appid=$appid&clase=$clase&id=$id&fields=$campos&values=$valores&getback=$passback&opener_form=$opener_form&field_focus=$field_focus";
	open (DATA, "$path$file");
	while ($line = <DATA>) {
		$line =~ s/{CGI}/$data/g;
		$line =~ s/{message}/$message/g;
		print $line;
	}
}
sub construct_checked_page {
	my ($id) = @_;
	my $data= "rcrd.pllan=$lan&appid=$appid&clase=$clase&id=$id&fields=$campos&values=$valores&getback=$passback&opener_form=$opener_form&field_focus=$field_focus";
	open (DATA, "$path$file_exist");
	while ($line = <DATA>) {
		$line =~ s/{CGI}/$data/g;
		$line =~ s/{message}/$message/g;		
		$line =~ s/{id}/$id/g;
		print $line;
	}
}
#-------------------------------------------------------------------------
#Auxiliar Sub-Routines
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."_rcrd.xml";
    my $xml        = new XML::Simple;
    $data 		= $xml->XMLin("../xml/".$schema);
    $path		= "../libraries/html/";
    $file 		= "msg_processing.html";
    $file_exist	= "msg_exist.html";    
    $more_time	= "000000";
    $message	= $data->{detail}->{msg_processing};
}
sub SQL_fail {
    my ($query,$dbh,$section)= @_;
    print "SQL failed in Section $section<br>";
    print "Query: ".$query."<br>";    
    exit;
}
#-------------------------------------------------------------------------