#!/perl/bin/perl.exe
$|=1;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# Information Software SA
# Date In: 2006-05-04
# Updates: 2006-05-04,2016-03-29
# Author: Rodolfo Machon
# File Name: ltmd.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');
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# CHECK PARAMETERS
if ($clase eq ""){print "Your are not passing CLASE parameter<br>";}
if ($passback eq ""){$passback =$data->{grid_columns}}
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
# 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 * 1024;
$dbh1 	  = DBI->connect("dbi:ODBC:$appid",'','',{PrintError => 1, RaiseError => 1});
if (!$dbh1) {print "error: connection: $DBI::err\n$DBI::errstr\n$DBI::state\n";}
$dbh1->{LongReadLen} = 512 * 1024;
$dbh2 	  = DBI->connect("dbi:ODBC:$appid",'','',{PrintError => 1, RaiseError => 1});
if (!$dbh2) {print "error: connection: $DBI::err\n$DBI::errstr\n$DBI::state\n";}
$dbh2->{LongReadLen} = 512 * 1024;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
#MAIN PROGRAM
($grid_header,$elements)= get_grid_properties();
if($id ne ""){
      $select_order	= get_select_order();
      $where_statement	= get_where_statement($id);
      %recordset	= get_record($select_order,$where_statement);
      #%associations	= get_associations(%recordset);
      get_associations(%recordset);
      ($grid_values,$select_values) = get_stream();
}
construct_page($grid_values,$select_values,$grid_header,$elements);

exit;
#-------------------------------------------------------------------------
#-------------------------------------------------------------------------
#SUB-ROUTINES LEVEL 2
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->{detail}->{grid}->{columns});
      for(my $i=0;$i<=$#columns;$i++){
	    my $events	   = "";
            my $htemplate  = $template;
	    my %properties = %{$data->{detail}->{grid}->{column}->{$columns[$i]}->{properties}};
	    my %events	   = %{$data->{detail}->{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->{detail}->{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->{detail}->{grid}->{column}->{$columns[$i]}->{elements}/g;
	    if ($data->{detail}->{grid}->{column}->{$columns[$i]}->{elements} ne "NO"){
		  my @elements= split(/\,/,$data->{detail}->{grid}->{column}->{$columns[$i]}->{elements});
		  for(my $j=0;$j<=$#elements;$j++){
			my $eventos	= "";
			my $emask	= $mask;
			#my %properties	= %{$data->{detail}->{grid}->{column}->{$fields[$i]}->{element}->{$elements[$j]}->{properties}};
			my %eventos	= %{$data->{detail}->{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->{detail}->{grid}->{column}->{$columns[$i]}->{method}->{$eventos{$key}}){
					  my $prms	= "";
					  my @params	= split(/\,/,$data->{detail}->{grid}->{column}->{$columns[$i]}->{method}->{$eventos{$key}}->{params});
					  for(my $k=0;$k<=$#params;$k++){
						$prms .= $data->{detail}->{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->{detail}->{grid}->{column}->{$columns[$i]}->{element}->{$elements[$j]}->{properties}->{type}/g;
			$emask	  =~ s/{data}/$data->{detail}->{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 get_select_order {
      my @fields = ();
      my $select_order="";
      my @displayed_fields = split(/\,/,$data->{detail}->{select_fields});
      for (my $w=0;$w<=$#displayed_fields;$w++){
            $fields[$w]= $displayed_fields[$w];
            my $timestamp= substr($fields[$w],0,2);			
            if ($timestamp eq "ts"){
                  $fields[$w] = "unix_timestamp(".$fields[$w].")";
            }
            if ( $#displayed_fields > $w ){
                  $select_order = $select_order.$fields[$w].",";
            }else{
                  $select_order = $select_order.$fields[$w];
            }
      }
      return $select_order;
}
sub get_where_statement {
    my ($where_value)=@_;
    my $where_field = $data->{detail}->{id_field};
    my $ws = "WHERE $where_field='$where_value'";
    return $ws;
}
sub get_record {
      my ($select_order,$where_statement)=@_;
      my $j	   = 0;
      my %rs	   = ();
      my @fields   = split(/\,/,$data->{detail}->{select_fields});
      my $table    = $data->{detail}->{table};
      my $sql      = "SELECT $select_order FROM $table $where_statement ORDER BY 1";
      $sth 	= $dbh->prepare($sql);
      $sth->execute or die SQL_fail($sql,$dbh,'sub get_clase_values');
      while (my @row = $sth->fetchrow_array) {
            my %record = ();
            for($i=0;$i<=$#fields;$i++){
                  if(substr($fields[$i],0,2) eq "ts"){
                        $record{$fields[$i]}= standard_timestamp($row[$i]);
                  }else{
                    $record{$fields[$i]}=$row[$i];
                  }
            }
            $rs{$j}= {%record};
            $j++;
      }
      return %rs;
}
sub get_associations {
      my (%rs)=@_;
      my $grid_stream	= "";
      my $select_stream	= "";
      %all_grid		= ();
      %all_select	= ();
      foreach $key(sort keys %rs){
            foreach $key1(sort keys %{$rs{$key}}){
                  my @ass = split(/\,/,$data->{detail}->{associations});
                  for (my $i=0;$i<=$#ass;$i++){
                        #print "get_associations ($key,$key1,$ass[$i])=>$rs{$key}{$key1}<br>";
                        if ($data->{detail}->{association}->{$ass[$i]}){
                              my @splt1 = ();
                              my $ws    = "WHERE ".$data->{detail}->{association}->{$ass[$i]}->{keys}."='".$rs{$key}{$key1}."'";
                              if ($data->{detail}->{association}->{$ass[$i]}->{result} eq "table"){
                                  ($grid_stream,$select_stream) = get_association_table($ass[$i],$data->{detail}->{association}->{$ass[$i]}->{database},$data->{detail}->{association}->{$ass[$i]}->{fields},$data->{detail}->{association}->{$ass[$i]}->{table},$ws,$data->{detail}->{association}->{$ass[$i]}->{document_fields});
                              }elsif ($data->{detail}->{association}->{$ass[$i]}->{result} eq "recordset"){
                                  ($grid_stream,$select_stream) = get_association_recordset($ass[$i],$data->{detail}->{association}->{$ass[$i]}->{database},$data->{detail}->{association}->{$ass[$i]}->{fields},$data->{detail}->{association}->{$ass[$i]}->{table},$ws,$data->{detail}->{association}->{$ass[$i]}->{document_fields});
                              }else{
                                  #my %rl = get_association($data->{detail}->{association}->{$ass[$i]}->{database},$data->{detail}->{association}->{$ass[$i]}->{fields},$data->{detail}->{association}->{$ass[$i]}->{table},$ws,$data->{detail}->{association}->{$ass[$i]}->{document_fields});
                                  #$associations{$ass[$i]} = {%rl};
                              }
                        }
                        #$all_grid{$rs{$key}{$key1}}{$ass[$i]}	= $ass[$i]."^^".$grid_stream;                        
                        $all_grid{$rs{$key}{$key1}}{$ass[$i]}	= $grid_stream;
                        $all_select{$rs{$key}{$key1}}{$ass[$i]} = $select_stream;
                  }
            }
      }
      #return %all_grid;
}
sub get_stream {
      my $grid_stream	= "";
      my $select_stream	= "";
      foreach $key(sort keys %all_grid){
	    $grid_stream .= $key;
            foreach $key1(sort keys %{$all_grid{$key}}){      
		  $grid_stream .= "|".$all_grid{$key}{$key1};
	    }
	    $grid_stream .= "~~";
      }
      foreach $key(sort keys %all_select){
	    $select_stream .= $key;
            foreach $key1(sort keys %{$all_select{$key}}){      
		  $select_stream .= "|".$all_select{$key}{$key1};
	    }
	    $select_stream .= "~~";
      }      
      $grid_stream =~ s/\"//g;
      return ($grid_stream,$select_stream);
}
sub construct_page {
      my ($grid_values,$select_values,$grid_header,$elements)=@_;

      #my $select_fields = $data->{detail}->{select_fields};
      my $select_fields = $data->{detail}->{grid}->{columns};
      my $passback_fields = $data->{detail}->{passback_fields};
      $select_fields    =~ s/{lan}/$lan/g;
      $passback_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_field}/$id_field/g;
	    $line =~ s/{id}/$id/g;
	    
	    $line =~ s/{title}/$data->{title}/g;
	    $line =~ s/{height}/$data->{height}/g;
	    $line =~ s/{width}/$data->{width}/g;
	    
	    $line =~ s/{id_field}/$data->{detail}->{id_field}/g;
	    $line =~ s/{select_fields}/$select_fields/g;
	    $line =~ s/{passback_fields}/$passback_fields/g;
	    
	    $line =~ s/{grid_values}/$grid_values/g;
	    $line =~ s/{select_values}/$select_values/g;
	    
	    $line =~ s/{grid_header}/$grid_header/g;
	    $line =~ s/{elements}/$elements/g;

	    $line =~ s/{tdheader_style}/$data->{detail}->{grid}->{tdheader_style}/g;
	    $line =~ s/{tdbody_style}/$data->{detail}->{grid}->{tdbody_style}/g;
	    $line =~ s/{counter}/$data->{detail}->{grid}->{counter}/g;	    
	    $line =~ s/{delete}/$data->{detail}->{grid}->{delete}/g;

	    print $line;
      }
}
#-------------------------------------------------------------------------
#SUB-ROUTINES LEVEL 2
sub get_association {
      my ($db,$so,$fo,$WHERE,$do)=@_;    
      $do 	=~ s/{lan}/$lan/g;
      $so 	=~ s/{lan}/$lan/g;
      my %la= ();
      my $i 	= 0;
      my @fields= split(/\,/,$do);
      my $sql	="SELECT $so FROM $fo $WHERE ORDER BY 1";
      #print "$query<br>";
      $sth 	= $dbh->prepare($sql);
      $sth->execute or die SQL_fail($sql,$dbh,'sub get_clase_values');
      if (my @row_a = $sth->fetchrow_array) {
	    for($i=0;$i<=$#fields;$i++){
		  if(substr($fields[$i],0,2) eq "ts"){
		      $la{$fields[$i]}= standard_timestamp($row_a[$i]);
		  }else{
		      $la{$fields[$i]}=$row_a[$i];
		  }
	    }
      }else{
	    for($i=0;$i<=$#fields;$i++){
                $la{$fields[$i]} = "";
	    }
      }
      return %la;
}
sub get_association_recordset {
      my ($assoc,$db,$so,$fo,$WHERE,$do)=@_;    
      $do 	       =~ s/{lan}/$lan/g;
      $so 	       =~ s/{lan}/$lan/g;
      my $recordset = "";
      my $rowset    = "";
      my @fields    = split(/\,/,$do);
      my @sfields   = split(/\,/,$so);
      my $table_schema = $data->{detail}->{association}->{$assoc}->{table_schema};
      my $sql = "SELECT $so FROM $fo $WHERE ORDER BY 1";
      $sth 	  = $dbh->prepare($sql);
      $sth->execute or die SQL_fail($sql,$dbh,'sub get_clase_values');
      while (my @row_a = $sth->fetchrow_array) {
            my $row = $data->{detail}->{association}->{$assoc}->{recordset_schema};          
            for(my $i=0;$i<=$#fields;$i++){
                  if($data->{detail}->{association}->{$assoc}->{select_labels}->{$sfields[$i]}){
                        my $tabla     = $data->{detail}->{association}->{$assoc}->{select_labels}->{$sfields[$i]}->{table};
                        my $fields    = $data->{detail}->{association}->{$assoc}->{select_labels}->{$sfields[$i]}->{fields};                        
			my $new_value = get_association_label($db,$fields,$tabla,$sfields[$i],$row_a[$i],$assoc,$sfields[$i],$WHERE);                        
                        $row =~ s/{$fields}/$new_value/g;
			if($i==0){$rowset .= $new_value.",";}
                  }else{
			$row =~ s/{$fields[$i]}/$row_a[$i]/g;
		  }
            }
            $recordset .= $row;
      }
      $rowset = substr($rowset,0,length($rowset)-1);
      $table_schema =~ s/{recordset}/$recordset/g;
      return ($table_schema,$rowset);
}
sub get_association_table {
      my ($assoc,$db,$so,$fo,$WHERE,$do)=@_;    
      $do 	  =~ s/{lan}/$lan/g;
      $so 	  =~ s/{lan}/$lan/g;
      my $record  = "";
      my @fields  = split(/\,/,$do);
      my @sfields = split(/\,/,$so);
      my $table_schema = $data->{detail}->{association}->{$assoc}->{table_schema};
      my $sql = "SELECT $so FROM $fo $WHERE ORDER BY 1";
      $sth 	  = $dbh->prepare($sql);
      $sth->execute or die SQL_fail($sql,$dbh,'sub get_clase_values');
      if (my @row_a = $sth->fetchrow_array) {
	    for(my $i=0;$i<=$#fields;$i++){
		  if($data->{detail}->{association}->{$assoc}->{select_labels}->{$sfields[$i]}){
			my $tabla     = $data->{detail}->{association}->{$assoc}->{select_labels}->{$sfields[$i]}->{table};
			my $fields    = $data->{detail}->{association}->{$assoc}->{select_labels}->{$sfields[$i]}->{fields};
			my $new_value = get_association_label($db,$fields,$tabla,$sfields[$i],$row_a[$i],$assoc,$sfields[$i],$WHERE);
			$table_schema =~ s/{$fields}/$new_value/g;
			if($new_value ne ""){$record .= $new_value.",";}			
		  }else{
			$table_schema =~ s/{$fields[$i]}/$row_a[$i]/g;
			if($row_a[$i] ne ""){$record .= $row_a[$i].",";}
		  }
  	    }
      }
      $record = substr($record,0,length($record)-1);
      return ($table_schema,$record);
}
#SUB-ROUTINES LEVEL 3
sub get_association_label {
      my ($db,$so,$fo,$field_id,$label_id,$ass,$ass_field,$WHERE)=@_;
      $so 	       =~ s/{lan}/$lan/g;
      my $label        = "";
      my $filter_value = "";
      my $filter_field = "";      
      if($data->{detail}->{association}->{$ass}->{select_labels}->{$ass_field}->{filter}){
            my $database  = $data->{detail}->{association}->{$ass}->{select_labels}->{$ass_field}->{filter}->{database};            
            my $table     = $data->{detail}->{association}->{$ass}->{select_labels}->{$ass_field}->{filter}->{table};
            my $field     = $data->{detail}->{association}->{$ass}->{select_labels}->{$ass_field}->{filter}->{field};
            my $id_field  = $data->{detail}->{association}->{$ass}->{select_labels}->{$ass_field}->{filter}->{keys};

            my $sql1 = "SELECT $field FROM $table $WHERE LIMIT 1";            
            $sth1 	 = $dbh1->prepare($sql1);
            $sth1->execute or die SQL_fail($sql1,$dbh1,'sub get_association_label');
            if (my @row_a = $sth1->fetchrow_array) {
                  $filter_value = $row_a[0];
                  $filter_field = $field;
            }
      }
      if($filter_value eq ""){$where_a = "$field_id='$label_id'"}else{$where_a = "$field_id='$label_id' and $filter_field ='$filter_value'"}
      my $sql2	="SELECT $so FROM $fo WHERE $where_a ORDER BY 1";
      $sth2 	= $dbh->prepare($sql2);
      $sth2->execute or die SQL_fail($sql2,$dbh2,'sub get_association_label');
      if (my @row_b = $sth2->fetchrow_array) {
            $label    = $row_b[0];
      }
      return $label;
}
#-------------------------------------------------------------------------
#AUXILIARY 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."_ltmd.xml";
	my $xml        = new XML::Simple;
	$data 	  = $xml->XMLin("../xml/".$schema);
	$path	  = $data->{base_path}."/libraries/html/";
	$file	  = "ltmdl.html";
}
sub SQL_fail {
    my ($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 = "$mo\-$d\-$y";
	return $standard_timestamp;
}
#-------------------------------------------------------------------------