From 83e8f70a0cca1c0d64d93136ec0927760734e11e Mon Sep 17 00:00:00 2001
From: Will Budic <vilijanc@gmail.com>
Date: Sun, 5 Jan 2020 18:43:44 +1100
Subject: [PATCH] Added DEBUG setting.

---
 htdocs/cgi-bin/main.cgi                   |   8 +-
 htdocs/cgi-bin/remove.cgi                 | 226 +++++++++++++---------
 htdocs/cgi-bin/system/modules/Settings.pm |   1 +
 3 files changed, 137 insertions(+), 98 deletions(-)

diff --git a/htdocs/cgi-bin/main.cgi b/htdocs/cgi-bin/main.cgi
index 3d25d17..e673a36 100755
--- a/htdocs/cgi-bin/main.cgi
+++ b/htdocs/cgi-bin/main.cgi
@@ -27,7 +27,7 @@ use lib "system/modules";
 require Settings;
 
 my $cgi = CGI->new;
-my $sss = new CGI::Session( "driver:File", $cgi, { Directory => Settings::logPath()} );
+my $sss = new CGI::Session( "driver:File", $cgi, { Directory => Settings::logPath() } );
 my $sid      = $sss->id();
 my $dbname   = $sss->param('database');
 my $userid   = $sss->param('alias');
@@ -38,7 +38,7 @@ if ( !$userid || !$dbname ) {
     exit;
 }
 
-my $database = '../../dbLifeLog/' . $dbname;
+my $database = Settings::logPath() . $dbname;
 my $dsn      = "DBI:SQLite:dbname=$database";
 my $db       = DBI->connect( $dsn, $userid, $password, { PrintError => 0, RaiseError => 1 } )
   or die "<p>Error->" & $DBI::errstri & "</p>";
@@ -1157,12 +1157,12 @@ sub authenticate {
                     if ( length($word) > 2 ) {
                         $word = lc $word;
 
-                      #parse for already placed words, instead of using an hash.
+                        #parse for already placed words, instead of using an hash.
                         my $idx = index( $autowords, $word, 0 );
                         if ( $idx > 0 ) {
                             my $end = index( $autowords, '"', $idx );
                             my $existing =
-                              substr( $autowords, $idx, $end - $idx );
+                                substr( $autowords, $idx, $end - $idx );
                             next if $word eq $existing;
                         }
 
diff --git a/htdocs/cgi-bin/remove.cgi b/htdocs/cgi-bin/remove.cgi
index a65593b..db7792b 100755
--- a/htdocs/cgi-bin/remove.cgi
+++ b/htdocs/cgi-bin/remove.cgi
@@ -17,23 +17,13 @@ use DBI;
 use DateTime qw();
 use DateTime::Format::SQLite;
 use DateTime::Format::Human::Duration;
+use Regexp::Common qw /URI/;
 
-
-#DEFAULT SETTINGS HERE!
-our $REC_LIMIT   = 25;
-our $TIME_ZONE   = 'Australia/Sydney';
-our $PRC_WIDTH   = '60';
-our $LOG_PATH    = '../../dbLifeLog/';
-our $SESSN_EXPR  = '+2m';
-our $RELEASE_VER = '1.5';
-my  $THEME        = 'Standard';
-my  $TH_CSS       = 'main.css';
-my $BGCOL = '#c8fff8';
-#END OF SETTINGS
-
+use lib "system/modules";
+require Settings;
 
 my $cgi = CGI->new;
-my $session = new CGI::Session("driver:File",$cgi, {Directory=>$LOG_PATH});
+my $session = new CGI::Session("driver:File",$cgi, {Directory => Settings::logPath()});
 my $sid=$session->id();
 my $dbname  =$session->param('database');
 my $userid  =$session->param('alias');
@@ -44,36 +34,43 @@ if(!$userid||!$dbname){
     exit;
 }
 
-my $database = '../../dbLifeLog/'.$dbname;
+
+my $database = Settings::logPath().$dbname;
 my $dsn= "DBI:SQLite:dbname=$database";
 my $db = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die "<p>Error->"& $DBI::errstri &"</p>";
 
-my $today = DateTime->now;
-   $today->set_time_zone( $TIME_ZONE );
+#Fetch settings
+my $imgw = 210;
+my $imgh = 120;
+Settings::getConfiguration($db);
+Settings::getTheme();
 
 
 
-#####################
-&getConfigurationForRemove;
-#####################
-&getTheme;
+### Page specific settings Here
+my $PRC_WIDTH = &Settings::pagePrcWidth;
+my $TH_CSS = &Settings::css;
+my $BGCOL  = &Settings::bgcol;
+#Set to 1 to get debug help. Switch off with 0.
+my $DEBUG        = &Settings::debug;
+#END OF SETTINGS
 
+my $today = DateTime->now;
+$today->set_time_zone(&Settings::timezone);
 
 my %hshCats ={};
 my $tbl_rc =0;
 my $stm;
 my $stmtCat = "SELECT ID, NAME FROM CAT;";
 my $st = $db->prepare( $stmtCat );
-my $rv = $st->execute() or die or die "<p>Error->"& $DBI::errstri &"</p>";
-
+my $rv = $st->execute();
 
 
 while(my @row = $st->fetchrow_array()) {
     $hshCats{$row[0]} = $row[1];
 }
 
-my $stmS = "SELECT rowid, ID_CAT, DATE, LOG from LOG WHERE";
-my $stmE = " ORDER BY DATE DESC, rowid DESC;";
+
 my $tbl = '<form name="frm_log_del" action="remove.cgi" onSubmit="return formDelValidation();">
            <table class="tbl_rem" width="'.$PRC_WIDTH.'%">
            <tr class="hdr" style="text-align:left;"><th>Date</th> <th>Time</th><th>Log</th><th>Category</th></tr>';
@@ -83,7 +80,7 @@ my $datediff = $cgi->param("datediff");
 my $confirmed = $cgi->param('confirmed');
 if ($datediff){
          print $cgi->header(-expires=>"+6os");    
-         print $cgi->start_html(-title => "Date Difference Report", -BGCOLOR => $BGCOL, theme=> "$THEME",
+         print $cgi->start_html(-title => "Date Difference Report", -BGCOLOR => $BGCOL,
                  -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'},
                  -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"}
 
@@ -91,7 +88,7 @@ if ($datediff){
         &DisplayDateDiffs;
 }elsif (!$confirmed){
          print $cgi->header(-expires=>"+6os");    
-         print $cgi->start_html(-title => "Personal Log Record Removal", -BGCOLOR => $BGCOL,theme=> "$THEME",
+         print $cgi->start_html(-title => "Personal Log Record Removal", -BGCOLOR => $BGCOL,
                  -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'},
                  -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"}
 
@@ -181,43 +178,47 @@ sub ConfirmedDelition{
 
 sub NotConfirmed{
 
-#Get ids and build confirm table and check
-my $stm = $stmS ." ";
-    foreach my $id ($cgi->param('chk')){
-        $stm = $stm . "rowid = '" . $id . "' OR ";
+    my $stmS = "SELECT rowid, ID_CAT, DATE, LOG from LOG WHERE";
+    my $stmE = " ORDER BY DATE DESC, rowid DESC;";
+
+    #Get ids and build confirm table and check
+    my $stm = $stmS ." ";
+        foreach my $id ($cgi->param('chk')){
+            $stm = $stm . "rowid = '" . $id . "' OR ";
+        }
+    #OR end to rid=0 hack! ;)
+        $stm = $stm . "rowid = '0' " . $stmE;
+    #
+    $st = $db->prepare( $stm );
+    $rv = $st->execute() or die "<p>Error->"& $DBI::errstri &"</p>";
+    if($rv < 0) {
+            print "<p>Error->"& $DBI::errstri &"</p>";
     }
-#OR end to rid=0 hack! ;)
-    $stm = $stm . "rowid = '0' " . $stmE;
-#
-$st = $db->prepare( $stm );
-$rv = $st->execute() or die "<p>Error->"& $DBI::errstri &"</p>";
-if($rv < 0) {
-         print "<p>Error->"& $DBI::errstri &"</p>";
-}
 
-my $r_cnt = 0;
-my $rs = "r1";
-while(my @row = $st->fetchrow_array()) {
+    my $r_cnt = 0;
+    my $rs = "r1";
+    while(my @row = $st->fetchrow_array()) {
 
-     my $ct = $hshCats{$row[1]};
-     my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] );
-     
-     $tbl = $tbl . '<tr class="r1"><td class="'.$rs.'">'. $dt->ymd . "</td>" . 
-          '<td class="'.$rs.'">' . $dt->hms . "</td>" .
-          '<td class="'.$rs.'" style="font-weight:bold; color:maroon;">' . $row[3] . "</td>\n".
-          '<td class="'.$rs.'">' . $ct. '<input type="hidden" name="chk" value="'.$row[0].'"></td></tr>';
-    if($rs eq "r1"){
-       $rs = "r0";
+        my $ct = $hshCats{$row[1]};
+        my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] );
+        my $log = log2html($row[3]);
+        
+        $tbl = $tbl . '<tr class="r1"><td class="'.$rs.'">'. $dt->ymd . "</td>" . 
+            '<td class="'.$rs.'">' . $dt->hms . "</td>" .
+            '<td class="'.$rs.'" style="font-weight:bold; color:maroon;">'."$log</td>\n".
+            '<td class="'.$rs.'">' . $ct. '<input type="hidden" name="chk" value="'.$row[0].'"></td></tr>';
+        if($rs eq "r1"){
+        $rs = "r0";
+        }
+        else{
+            $rs = "r1";
+        }
+        $r_cnt++;
     }
-    else{
-        $rs = "r1";
+    my $plural = "";
+    if($r_cnt>1){
+        $plural = "s";
     }
-    $r_cnt++;
-}
-my $plural = "";
-if($r_cnt>1){
-    $plural = "s";
-}
 
  $tbl = $tbl .  '<tr class="r0"><td colspan="4">
  <center>
@@ -236,47 +237,84 @@ print '<center><div>' . $tbl .'</div></center>';
  $st->finish;
 }
 
-sub getConfigurationForRemove{
-
-    try{
-        $st = $db->prepare("SELECT ID, NAME, VALUE FROM CONFIG;");
-        $st->execute();
-
-        while ( my @r = $st->fetchrow_array() ) {
-            
-            switch ($r[1]) {
-
-                case "REC_LIMIT"  {$REC_LIMIT=$r[2]}
-                case "TIME_ZONE"  {$TIME_ZONE=$r[2]}
-                case "PRC_WIDTH"  {$PRC_WIDTH=$r[2]}
-                case "SESSN_EXPR" {$SESSN_EXPR=$r[2]}
-                case "THEME"      {$THEME = $r[2]}
+sub log2html{
+    my $log = shift;
+    my ($re_a_tag, $sub)  = qr/<a\s+.*?>.*<\/a>/si;
+    $log =~ s/''/'/g;    
+    $log =~ s/\r\n/<br>/gs;
+    $log =~ s/\\n/<br>/gs;
+
+    if ( $log =~ /<<LNK</ ) {
+        my $idx = $-[0] + 5;
+        my $len = index( $log, '>', $idx );
+        $sub = substr( $log, $idx + 1, $len - $idx - 1 );
+        my $url = qq(<a href="$sub" target=_blank>$sub</a>);
+        $log =~ s/<<LNK<(.*?)>/$url/osi;
+    }
 
+    if ( $log =~ /<<IMG</ ) {
+            my $idx = $-[0] + 5;
+            my $len = index( $log, '>', $idx );
+            $sub = substr( $log, $idx + 1, $len - $idx - 1 );
+            my $url = qq(<img src="$sub"/>);
+            $log =~ s/<<IMG<(.*?)>/$url/osi;
+    }
+    elsif ( $log =~ /<<FRM</ ) {
+            my $idx = $-[0] + 5;
+            my $len = index( $log, '>', $idx );
+            $sub = substr( $log, $idx + 1, $len - $idx - 1 );
+            my $lnk = $sub;
+            if ( $lnk =~ /_frm.png/ ) {
+                my $ext = substr( $lnk, index( $lnk, '.' ) );
+                $lnk =~ s/_frm.png/$ext/;
+                if ( not -e "./images/$lnk" ) {
+                    $lnk =~ s/$ext/.jpg/;
+                    if ( not -e "./images/$lnk" ) {
+                        $lnk =~ s/.jpg/.gif/;
+                    }
+                }
+                $lnk =
+                  qq(\n<a href="./images/$lnk" style="border=0;" target="_IMG">
+			      <img src="./images/$sub" width="$imgw" height="$imgh" class="tag_FRM"/></a>);
             }
+            else {
+                #TODO fetch from web locally the original image.
+                $lnk =  qq(\n<img src="$lnk" width="$imgw" height="$imgh" class="tag_FRM"/>);
+            }
+            $log =~ s/<<FRM<(.*?)>/$lnk/o;
+        }
 
+    #Replace with a full link an HTTP URI
+    if ( $log =~ /<iframe / ) {
+        my $a = q(<iframe width="560" height="315");
+        my $b;
+        switch (&Settings::frameSize) {
+            case "0" { $b = q(width="390" height="215") }
+            case "1" { $b = q(width="280" height="180") }
+            case "2" { $b = q(width="160" height="120") }
+            else {
+                $b = &Settings::frameSize;
+            }
         }
+        $b = qq(<div><iframe align="center" $b);
+        $log =~ s/$a/$b/o;
+        $a = q(</iframe>);
+        $b = q(</iframe></div>);
+        $log =~ s/$a/$b/o;        
     }
-    catch{
-        print "<font color=red><b>SERVER ERROR</b></font>:".$_;
+    else {
+        my @chnks = split( /($re_a_tag)/si, $log );
+        foreach my $ch_i (@chnks) {
+            next if $ch_i =~ /$re_a_tag/;
+            next if index( $ch_i, "<img" ) > -1;
+            $ch_i =~ s/https/http/gsi;
+            $ch_i =~ s/($RE{URI}{HTTP})/<a href="$1" target=_blank>$1<\/a>/gsi;
+        }
+        $log = join( '', @chnks );
     }
-}
 
-sub getTheme{
+    #$log =~ s/\<\</&#60;&#60/gs;
+    #$log =~ s/\>\>/&#62&#62;/gs;
 
-
-if ( $THEME eq 'Sun' ) {
-    $BGCOL  = '#D4AF37';
-    $TH_CSS = "main_sun.css";
-}
-elsif ( $THEME eq 'Moon' ) {
-    $TH_CSS = "main_moon.css";
-    $BGCOL  = '#000000';
+return $log;
 }
-elsif ( $THEME eq 'Earth' ) {
-    $TH_CSS = "main_earth.css";
-    $BGCOL  = 'green';
-}
-
-
-
-}
\ No newline at end of file
diff --git a/htdocs/cgi-bin/system/modules/Settings.pm b/htdocs/cgi-bin/system/modules/Settings.pm
index 250f20c..52600ea 100644
--- a/htdocs/cgi-bin/system/modules/Settings.pm
+++ b/htdocs/cgi-bin/system/modules/Settings.pm
@@ -77,6 +77,7 @@ sub getConfiguration {
                 case "FRAME_SIZE"   { $FRAME_SIZE   = $r[2] }
                 case "RTF_SIZE"     { $RTF_SIZE     = $r[2] }
                 case "THEME"        { $THEME        = $r[2] }
+                case "DEBUG"        { $DEBUG        = $r[2] }
             }
 
         }
-- 
2.34.1