#!/perl/bin/perl.exe
$|=1;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# Information Software SA
# Date In: 03-16-2005
# Updates: 12-11-2005,2012-04-10,2014-03-01,2016-03-31,2022-08-11
# Author:Rodolfo Machon
# File Name: gdl.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_field       = $cgiparms->param('id_field');
$id		        = $cgiparms->param('id');
$passback     	= $cgiparms->param('passback');
$opener      	= $cgiparms->param('opener_form');
$field_focus   	= $cgiparms->param('field_focus');
$search_fields	= $cgiparms->param('search_fields');
$search_values	= $cgiparms->param('search_values');
$page		    = $cgiparms->param('page');
$limit		    = $cgiparms->param('limit');
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# CHECK PARAMETERS
if ($clase eq ""){print "Your are not passing CLASE parameter<br>";}
if ($id eq ""){print "Your are not passing ID parameter<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;
$dbh1->{'LongTruncOk'} = 1;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
#MAIN PROGRAM
($database,$select_order,$from_order,$where_order,$order_by,$direction,$limite,$offset) = get_clase_order($search_fields,$search_values,$id);
if ($limit eq ""){$limit=$limite}
if ($page ne ""){$offset=($page-1)*$limit}
($total_rows,$select_values,%rows)  = get_clase_values($database,$select_order,$from_order,$where_order,$order_by,$direction,$limit,$offset);
($labels_fields,$labels_values)	    = get_clase_labels($select_values);
($grid_header,$elements)	        = get_grid_properties();
construct_page($select_values,$labels_fields,$labels_values,$grid_header,$elements,$total_rows);
exit;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
#SUB-ROUTINES
sub get_clase_order {
    my ($search_fields,$search_values,$id) = @_;
    my $so		    = "";
    my $wo		    = "";
    my $wfv		    = "";
    my $talias	    = "";
    my $sc_keys	    = "";
    my $select_order= "";
    my $where_order	= "";
    my $from_order	= "";
    my $sc_campos	= "";
    my $sc_table	= "";
    my $c_keys	    = $data->{clase}->{id_field};
    my $c_campos	= $data->{clase}->{select_fields};
    my $c_table	    = $data->{clase}->{table};
    my $database	= $data->{clase}->{database};
    my $order_by	= $data->{clase}->{order_by};
    my $direction	= $data->{clase}->{direction};	
    my $limit		= $data->{clase}->{limit};
    my $offset	    = $data->{clase}->{offset};
    my $to		    = get_from_order($c_table,'');
    #if ($data->{clase}->{search_fields}) {$c_campos=$data->{clase}->{search_fields}}
    my @fields	    = split(/\,/,$c_campos);
    for (my $i=0;$i<=$#fields;$i++){
        if($data->{clase}->{field}->{$fields[$i]}){
            $sc_keys	 = $data->{clase}->{field}->{$fields[$i]}->{keys};
            $sc_campos	 = $data->{clase}->{field}->{$fields[$i]}->{fields};
            $sc_table	 = $data->{clase}->{field}->{$fields[$i]}->{table};
            $so		     = get_select_order($sc_campos,$sc_table);
            $sc_to	    .= get_from_order($sc_table,'').",";
            $sc_wo	    .= get_where_order($fields[$i],$c_table,$sc_keys,$sc_table)." and ";
        }else{
            $so		    = get_where_table_field($fields[$i],$c_table);
        }
        $select_order		.= $so.",";
    }
    $talias		= substr($c_table,4,length($c_table)-4);
    $wfv		= get_where_field_value($talias,$search_fields,$search_values,'like');
    if($id ne ""){
      if($wfv ne ""){
        $wo   = get_where_field_value($talias,$c_keys,$id,'=');
        $wo  .= " and ".$wfv; 
      }else{
        $wo   = get_where_field_value($talias,$c_keys,$id,'=');		  
      }
    }else{
      if($wfv ne ""){$sc_wo = $wfv;}else{$sc_wo = substr($sc_wo,0,length($sc_wo)-4);}
    }
    $select_order	= substr($select_order,0,length($select_order)-1);	
    $from_order	= $sc_to.$to;
    $where_order	= $sc_wo.$wo;
    if($data->{clase}->{associations} ne "NO"){
      my $campos  = "";
      my $juntas	= "";
      my @associations = split(/\,/,$data->{clase}->{associations});
      for (my $j=0;$j<=$#associations;$j++){
      if($data->{association}->{$associations[$j]}){
          my $as_keys		= $data->{association}->{$associations[$j]}->{keys};
          my $as_campos		= $data->{association}->{$associations[$j]}->{fields};
          my $as_table		= $data->{association}->{$associations[$j]}->{table};
          my $as_select_order	= get_select_order($as_campos,$as_table);		    
          my $as_table_order	= get_from_order($as_table,'');
          my $as_where_order	= get_where_order($c_keys,$c_table,$as_keys,$as_table);
          $campos	       	       .= ",".$as_select_order;
          $juntas 	       .= " LEFT JOIN ".$as_table_order." on ".$as_where_order;
      }
      }
      $select_order	.= $campos;
      $from_order		.= $juntas;
    }
    $select_order =~ s/{lan}/$lan/g;
    return ($database,$select_order,$from_order,$where_order,$order_by,$direction,$limit,$offset);
}
sub get_clase_values {
    my ($db,$so,$fo,$wo,$ob,$dn,$lt,$of)=@_;
    my $j		= 0;
    my $count	= 0;
    my $sql		= "";
    my %rows	= ();
    my %record	= ();      
    my @cols	= ();
    my $rows_stream	= "";
    my $counter	= $data->{counter};
    my @fields	= split(/\,/,$data->{clase}->{select_fields});

    if($wo ne ""){$sql = "SELECT count(*) FROM $fo WHERE $wo";}else{$query = "SELECT count(*) FROM $fo"}
	my $sth 	= $dbh->prepare($sql);
	$sth->execute or die SQL_fail($sql,$dbh,'sub get_clase_values');
	if (my @row = $sth->fetchrow_array) {$trodb=$row[0]}      
    
    if($wo ne ""){$sql = "SELECT $so FROM $fo WHERE $wo ORDER BY $ob $dn LIMIT $of,$lt"}else{$query = "SELECT $so FROM $fo ORDER BY $ob $dn LIMIT $of,$lt"}
	$sth 	= $dbh->prepare($sql);
	$sth->execute or die SQL_fail($sql,$dbh,'sub get_clase_values');
	while (my @row = $sth->fetchrow_array) {
        if($counter eq "YES"){$count++;$rows_stream .= $count."|";}
        for(my $i=0;$i<=$#fields;$i++){
            $fields[$i] =~ s/{lan}/$lan/g;
            if(substr($fields[$i],0,2) eq "ts"){
                $row[$i]  = standard_timestamp($row[$i]);
                $record{$fields[$i]}= standard_timestamp($row[$i]);
            }else{
                $row[$i] =~ s/'//g;            
                $record{$fields[$i]}=$row[$i];
            }
            $row[$i] =~ s/'/-/g;
            $row[$i] =~ s/"/-/g;			
            $rows_stream .= $row[$i]."|"; 
        }
        $rows_stream .= "~~";
        $rows{$j} 	  = {%record};
        $j++;	
    }
    return ($count,$rows_stream,%rows);
}
sub get_clase_labels {
      my ($sv)=@_;
      my $count	  = 0;
      my $values  = "";
      my $fields  = "";
      my @recs    = split(/\~~/,$sv);
      my @fds  = split(/\,/,$data->{clase}->{select_fields});
      for(my $k=0;$k<=$#recs;$k++){
	    my $hv	= "";
            my @campos  = split(/\|/,$recs[$k]);
            for(my $l=0;$l<=$#fds;$l++){
                  if ($data->{clase}->{select_labels}->{$fds[$l]}){
                        my %rl = ();
                        if ($data->{clase}->{select_labels}->{$fds[$l]}->{type} eq "pivot"){
                              %rl = get_labels($data->{clase}->{select_labels}->{$fds[$l]}->{database},$data->{clase}->{select_labels}->{$fds[$l]}->{fields},$data->{clase}->{select_labels}->{$fds[$l]}->{table},$data->{clase}->{select_labels}->{$fds[$l]}->{id_field},$campos[$l],$data->{clase}->{select_labels}->{$fds[$l]}->{document_fields});
                        }else{
                              %rl = get_labels($data->{clase}->{select_labels}->{$fds[$l]}->{database},$data->{clase}->{select_labels}->{$fds[$l]}->{fields},$data->{clase}->{select_labels}->{$fds[$l]}->{table},$fds[$l],$campos[$l],$data->{clase}->{select_labels}->{$fds[$l]}->{document_fields});                              
                        }
                        my ($lf,$lv) = split_hashes(1,%rl);
                        if($count==0){$fields .= $lf}
                        $hv .= $lv;
                  }
            }		
	    $values .= $hv."~~";	    
	    $count++;
      }
      return ($fields,$values);
}
sub get_grid_properties {
      my $grid_header	= "";
      my $elements	= "";
      my $template	= "{field}|{header}|{width}|{type}|{events}|{elements}";
      my $mask		= "{element}|{type}|{data}|{events}|";
      my @columns	= split(/\,/,$data->{grid}->{columns});
      for(my $i=0;$i<=$#columns;$i++){
	    my $events	   = "";
            my $htemplate  = $template;
	    my %properties = %{$data->{grid}->{column}->{$columns[$i]}->{properties}};
	    my %events	   = %{$data->{grid}->{column}->{$columns[$i]}->{events}};	    
	    foreach $key(keys %properties){if($key ne "content"){$htemplate =~ s/{$key}/$properties{$key}/g}}
	    foreach $key(keys %events){
		  if($data->{grid}->{column}->{method}->{$events{$key}}){
			
		  }else{if($key ne "content"){$events .= $key."=".$events{$key}." "}}
	    }
	    $htemplate	=~ s/{field}/$columns[$i]/g;	    
	    $htemplate	=~ s/{events}/$events/g;
	    $htemplate	=~ s/{elements}/$data->{grid}->{column}->{$columns[$i]}->{elements}/g;
	    if ($data->{grid}->{column}->{$columns[$i]}->{elements} ne "NO"){
		  my @elements= split(/\,/,$data->{grid}->{column}->{$columns[$i]}->{elements});
		  for(my $j=0;$j<=$#elements;$j++){
			my $eventos	= "";
			my $emask	= $mask;
			#my %properties	= %{$data->{grid}->{column}->{$fields[$i]}->{element}->{$elements[$j]}->{properties}};
			my %eventos	= %{$data->{grid}->{column}->{$columns[$i]}->{element}->{$elements[$j]}->{events}};	    
			#foreach $key(keys %properties){$htemplate =~ s/{$key}/$properties{$key}/g;}
			foreach $key(keys %eventos){
			      if($key ne "content"){			      
				    if($data->{grid}->{column}->{$columns[$i]}->{method}->{$eventos{$key}}){
					  my $prms	= "";
					  my @params	= split(/\,/,$data->{grid}->{column}->{$columns[$i]}->{method}->{$eventos{$key}}->{params});
					  for(my $k=0;$k<=$#params;$k++){
						$prms .= $data->{grid}->{column}->{$columns[$i]}->{method}->{$eventos{$key}}->{$params[$k]}.",";
					  }
					  $prms	= substr($prms,0,length($prms)-1);
					  $eventos .= $key."=".$eventos{$key}."^".$prms;
				    }else{if($key ne "content"){$eventos .= $key."=".$eventos{$key}."^"}}
				    $eventos  .= "^^";
			      }
			}
			$emask	  =~ s/{element}/$elements[$j]/g;
			$emask	  =~ s/{type}/$data->{grid}->{column}->{$columns[$i]}->{element}->{$elements[$j]}->{properties}->{type}/g;
			$emask	  =~ s/{data}/$data->{grid}->{column}->{$columns[$i]}->{element}->{$elements[$j]}->{properties}->{data}/g;
			$emask	  =~ s/{events}/$eventos/g;			
			$elements .= $emask."~~";
		  }
	    }
	    $grid_header .= $htemplate."~~";
      }
      $grid_header =~ s/{lan}/$lan/g;
      return ($grid_header,$elements);
}
sub construct_page {
      my ($select_values,$labels_fields,$labels_values,$grid_header,$elements,$total_rows)=@_;

      my $select_fields = $data->{clase}->{select_fields};
      my $insert_fields = $data->{clase}->{insert_fields};
      my $update_fields = $data->{clase}->{update_fields};
      my $delete_fields = $data->{clase}->{delete_fields};
      my $needed_fields = $data->{clase}->{needed_fields};
      $select_fields    =~ s/{lan}/$lan/g;
      $insert_fields    =~ s/{lan}/$lan/g;
      $update_fields    =~ s/{lan}/$lan/g;
      $delete_fields    =~ s/{lan}/$lan/g;
      $needed_fields    =~ s/{lan}/$lan/g;

      open (DATA,"$path$file");
      while ($line = <DATA>){
	    $line =~ s/{lan}/$lan/g;
	    $line =~ s/{appid}/$appid/g;
	    $line =~ s/{path}/$path/g;
	    $line =~ s/{clase}/$clase/g;
	    $line =~ s/{passback}/$passback/g; 	    
	    $line =~ s/{opener_form}/$opener/g; 
	    $line =~ s/{field_focus}/$field_focus/g;
	    $line =~ s/{id}/$id/g;
	    
	    $line =~ s/{height}/$data->{height}/g;
	    $line =~ s/{width}/$data->{width}/g;
	    
	    $line =~ s/{id_field}/$data->{clase}->{id_field}/g;
	    $line =~ s/{select_fields}/$select_fields/g;
	    $line =~ s/{insert_fields}/$insert_fields/g;
	    $line =~ s/{update_fields}/$update_fields/g;
	    $line =~ s/{delete_fields}/$delete_fields/g;	    
	    $line =~ s/{needed_fields}/$needed_fields/g;
	    $line =~ s/{labels_fields}/$labels_fields/g;
	    
	    $line =~ s/{select_values}/$select_values/g;
	    $line =~ s/{labels_values}/$labels_values/g;
	    
	    $line =~ s/{grid_header}/$grid_header/g;
	    $line =~ s/{elements}/$elements/g;
	    $line =~ s/{count}/$total_rows/g;
	    $line =~ s/{trodb}/$trodb/g;
	    $line =~ s/{limit}/$limit/g;
	    $pfin = round($trodb/$limit)+1;
	    $line =~ s/{pfin}/$pfin/g;
	    $page = round($offset/$limit)+1;
	    $line =~ s/{page}/$page/g;
	    $line =~ s/{tdheader_style}/$data->{grid}->{tdheader_style}/g;
	    $line =~ s/{tdbody_style}/$data->{grid}->{tdbody_style}/g;
	    $line =~ s/{counter}/$data->{grid}->{counter}/g;	    
	    $line =~ s/{delete}/$data->{grid}->{delete}/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 {
      ($cmp)=@_;
      $schema     = $cmp."_gdfl.xml";
      $xml        = new XML::Simple;
      $data 	  = $xml->XMLin("../xml/".$schema);
      $path	  = "../libraries/html/";
      $file	  = "gdl.html";
}
sub SQL_fail {
    ($query,$dbh,$section)= @_;
    print "SQL failed in Section $section<br>";
    print "Query: ".$query."<br>";    
    exit;
}
sub standard_timestamp {
	my ($unix_timestamp)=@_;
	($s,$m,$h,$d,$mo,$y,$w,$yd,$is)	= localtime($unix_timestamp);
	$mo=$mo+1;
	$y=$y+1900;
	$mo1=length($mo);
	if ($mo1 == 1){$mo="0".$mo;}
	$d1=length($d);	if ($d1 == 1){$d="0".$d;}
	$standard_timestamp = "$y\-$mo\-$d";
	return $standard_timestamp;
}
sub get_select_order {
    my ($fields,$table)=@_;
    my $so = "";
    my $talias = substr($table,4,length($table)-4);
    my @displayed_fields = split(/\,/,$fields);
    for (my $i=0;$i<=$#displayed_fields;$i++){
	$fields[$i]= $displayed_fields[$i];
	$timestamp= substr($fields[$i],0,2);			
	if ($timestamp eq "ts"){
	    $fields[$i] = "unix_timestamp(".$talias.".".$fields[$i].")";
	}else{
	    $fields[$i] = $talias.".".$fields[$i];	
	}
	if ( $#displayed_fields > $i ){
	    $so .= $fields[$i].",";
	}else{
	    $so .= $fields[$i];
	}
    }
    return $so;
}
sub get_from_order {
    my ($c_table,$sc_table) = @_;
    my $table = "";
    my $c_talias = substr($c_table,4,length($c_table)-4);
    if($sc_table ne ""){
	my $sc_talias = substr($sc_table,4,length($sc_table)-4);
	$table = $c_table." ".$c_talias.",".$sc_table." ".$sc_talias;
    }else{
	$table = $c_table." ".$c_talias;
    }
    return $table;
}
sub get_where_order {
      my ($c_field,$c_table,$sc_field,$sc_table)=@_;
      my $c_talias	= substr($c_table,4,length($c_table)-4);
      my $sc_talias	= substr($sc_table,4,length($sc_table)-4); 
      my $whr		= $c_talias.".".$c_field."=".$sc_talias.".".$sc_field;
      return $whr;
}
sub get_where_field_value {
      my ($talias,$search_fields,$search_values,$operator) = @_;
      my $timestamp	= "";
      my $ts_min	= "";
      my $ts_max	= "";      
      my $where		= "";
      my @splt 		= split(/\,/,$search_fields);
      my @splt1		= split(/\|/,$search_values);
      my $ws		= "";
      if($search_fields ne "" && $search_values ne ""){
	    for (my $i=0;$i<=$#splt;$i++){
		  $timestamp = substr($splt[$i],0,2);		
		  if ($timestamp eq "ts"){
			@ts = split(/-/,$splt1[$i]);
			$ts_min = $ts[2].$ts[0].$ts[1]."000000";
			$ts_max = $ts[2].$ts[0].$ts[1]."235959";
			$ws    .= $talias.".".$splt[$i]." >= $ts_min and ".$talias.".".$splt[$i]." <= $ts_max and ";		
		  }else{
			if($operator eq "like"){
			      $ws    .= $talias.".".$splt[$i]." ".$operator." '".$splt1[$i]."%' and ";
			}else{
			      $ws    .= $talias.".".$splt[$i]." ".$operator." '".$splt1[$i]."' and ";			      
			}
		  }
	    }
	    $where = substr($ws,0,length($ws)-4);
      } 
      return $where;	
}
sub get_where_table_field {
    my ($field,$table)=@_;
    my $talias = substr($table,4,length($table)-4);
    $timestamp= substr($field,0,2);			
    if ($timestamp eq "ts"){
	$field = "unix_timestamp(".$talias.".".$field.")";
    }else{
	$field = $talias.".".$field;	
    }
    return $field;
}
sub get_labels {
    my ($db,$so,$fo,$field_id,$label_id,$do)=@_;
    $do 	    =~ s/{lan}/$lan/g;
    $so 	    =~ s/{lan}/$lan/g;
    my %labels  = ();
    my $i 	    = 0;
    my @fields  = split(/\,/,$do);
    my $sql	    = "SELECT $so FROM $fo WHERE $field_id='$label_id' ORDER BY 1";
	my $sth 	= $dbh->prepare($sql);
	$sth->execute or die SQL_fail($sql,$dbh,'sub get_labels');
	if (my @row_a = $sth->fetchrow_array) {
        for($i=0;$i<=$#fields;$i++){
            $row_a[$i] =~ s/'//g;
            if(substr($fields[$i],0,2) eq "ts"){
                $labels{$fields[$i]}= standard_timestamp($row_a[$i]);
            }else{
                $labels{$fields[$i]}=$row_a[$i];
            }
        }
    }else{
        for($i=0;$i<=$#fields;$i++){
            if(substr($fields[$i],0,2) eq "ts"){
                $labels{$fields[$i]} = "";
            }else{
                $labels{$fields[$i]} = "";
            }
        }
    }
    return %labels;
}
sub split_hashes {
    my ($level,%hashes)=@_;
    my $fields_stream ="";
    my $values_stream ="";
    if($level==1){
	foreach $key(keys %hashes){
	    $fields_stream .= $key.",";
	    $values_stream .= $hashes{$key}."|";
	}
	return ($fields_stream,$values_stream);
    }elsif($level==2){
	foreach $key(keys %hashes){
	    my $fs = "";
	    my $vs = "";
	    foreach $key1(keys %{$hashes{$key}}){
		$fs .= $key1.",";
		$vs .= $hashes{$key}{$key1}."|";
	    }
	    $fields_stream .= $fs."~~";	    
	    $values_stream .= $vs."~~";
	}
	return ($fields_stream,$values_stream);	
    }
}
#-------------------------------------------------------------------------
sub round {
      my ($number)=@_;
      $number = shift;
      return int($number + .5 * ($number <=> 0));
}