From 76818070bded89c22c968442a40c0a8049162d12 Mon Sep 17 00:00:00 2001 From: Metabox Date: Tue, 13 Aug 2019 19:57:09 +1000 Subject: [PATCH] Themeing, experimenting with session. --- htdocs/cgi-bin/config.cgi | 40 +- htdocs/cgi-bin/login_ctr.cgi | 690 +++++++++++----------- htdocs/cgi-bin/main.cgi | 59 +- htdocs/cgi-bin/remove.cgi | 231 ++++---- htdocs/cgi-bin/time_zones.cgi | 11 +- htdocs/cgi-bin/wsrc/main.cgi | 1035 --------------------------------- 6 files changed, 556 insertions(+), 1510 deletions(-) delete mode 100755 htdocs/cgi-bin/wsrc/main.cgi diff --git a/htdocs/cgi-bin/config.cgi b/htdocs/cgi-bin/config.cgi index a905d8e..ac40062 100755 --- a/htdocs/cgi-bin/config.cgi +++ b/htdocs/cgi-bin/config.cgi @@ -33,8 +33,9 @@ our $AUTO_WRD_LMT = 200; our $AUTO_LOGIN = 0; our $FRAME_SIZE = 0; our $RTF_SIZE = 0; -our $THEME = 0; -our $TH_CSS = 'main.css'; +my $THEME = 0; +my $TH_CSS = 'main.css'; +my $BGCOL = '#c8fff8'; #END OF SETTINGS #This is the OS developer release key, replace on istallation. As it is not secure. @@ -94,18 +95,11 @@ my $status = "Ready for change!"; &processSubmit; ############### -my $BGCOL = '#c8fff8'; - if ( $THEME eq 'Sun' ) { - $BGCOL = '#D4AF37'; - $TH_CSS = "main_sun.css"; - }elsif ($THEME eq 'Moon'){ - $TH_CSS = "main_moon.css"; - $BGCOL = '#000000'; - }elsif ($THEME eq 'Earth'){ - $TH_CSS = "main_earth.css"; - $BGCOL = 'green'; - } +&getTheme; + + $session->param("theme",$TH_CSS); + $session->param("bgcolor",$BGCOL); print $cgi->header(-expires=>"+6s", -charset=>"UTF-8"); print $cgi->start_html(-title => "Personal Log", -BGCOLOR=>"$BGCOL", @@ -164,8 +158,7 @@ my $tbl = ' $dbs = dbExecute($stmtCat); while(my @row = $dbs->fetchrow_array()) { if($row[0]>0){ - $tbl = $tbl. - ' + $tbl .= ''; @@ -1055,4 +1048,21 @@ sub error{ print $cgi->end_html; $db->disconnect(); exit; +} + +sub getTheme{ + + + if ( $THEME eq 'Sun' ) { + $BGCOL = '#D4AF37'; + $TH_CSS = "main_sun.css"; + }elsif ($THEME eq 'Moon'){ + $TH_CSS = "main_moon.css"; + $BGCOL = '#000000'; + + }elsif ($THEME eq 'Earth'){ + $TH_CSS = "main_earth.css"; + $BGCOL = 'green'; + } + } \ No newline at end of file diff --git a/htdocs/cgi-bin/login_ctr.cgi b/htdocs/cgi-bin/login_ctr.cgi index ad39013..e5ba7b5 100755 --- a/htdocs/cgi-bin/login_ctr.cgi +++ b/htdocs/cgi-bin/login_ctr.cgi @@ -31,6 +31,9 @@ our $IMG_W_H = '210x120'; our $AUTO_WRD_LMT= 200; our $AUTO_LOGIN = 0; our $FRAME_SIZE = 0; +my $THEME = 'Standard'; +my $TH_CSS = 'main.css'; +my $BGCOL = '#c8fff8'; #END OF SETTINGS @@ -53,43 +56,44 @@ if($cgi->param('logout')){&logout} &checkAutologinSet; if(&processSubmit==0){ + &getTheme; print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie); - print $cgi->start_html(-title => "Personal Log Login", -BGCOLOR=>"#c8fff8", - -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, - -style =>{-type => 'text/css', -src => 'wsrc/main.css'}, - ); + print $cgi->start_html(-title => "Personal Log Login", -BGCOLOR=>"$BGCOL", + -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, + -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"}, + ); $frm = qq( -
'.$row[0].'
'.$row[0].'
- - - - - - - - - - - - +
LOGIN
Alias:
Password:
NOTICE!   - Alias will create a new database if it doesn't exist. Note down your password. - -
+ + + + + + + + + + + +
LOGIN
Alias:
Password:
NOTICE!   + Alias will create a new database if it doesn't exist. Note down your password. + +
); - print qq(

-
-

Welcome to Life Log

$frm

- Get latest version of this application here!
-
); - print $cgi->end_html; + print qq(

+
+

Welcome to Life Log

$frm

+ Get latest version of this application here!
+
); + print $cgi->end_html; } else{ - print $cgi->start_html; - print $cgi->end_html; + print $cgi->start_html; + print $cgi->end_html; } exit; @@ -97,362 +101,384 @@ exit; sub processSubmit{ try{ - if($alias&&$passw){ - - $passw = uc crypt $passw, hex $cipher_key; - &checkCreateTables; - #ssion = CGI::Session->load(); - $session->param('alias', $alias); - $session->param('passw', $passw); - $session->param('database', 'data_'.$alias.'_log.db'); - $session->flush(); - print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie, -location=>"main.cgi"); - return 1; - } - else{ - &removeOldSessions; - } + if($alias&&$passw){ + + $passw = uc crypt $passw, hex $cipher_key; + &checkCreateTables; + $session->param('alias', $alias); + $session->param('passw', $passw); + $session->param('database', 'data_'.$alias.'_log.db'); + $session->flush(); + print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie, -location=>"main.cgi"); + return 1; + } + else{ + &removeOldSessions; + } return 0; } catch{ - print $cgi->header; - print "SERVER ERROR dump ->". $session->dump(); + print $cgi->header; + print "SERVER ERROR dump ->". $session->dump(); print $cgi->end_html; } } sub checkAutologinSet { try{ - #We don't need to slurp as it is expected setting in header. - my @cre; - open(my $fh, '<', $LOG_PATH.'main.cnf' ) or die "Can't open main.cnf: $!"; - while (my $line = <$fh>) { - chomp $line; - if(rindex ($line, "<", 14; - my $crest = substr $line, 13, $end - 13; - @cre = split '/', $crest; - last; - } - } + #We don't need to slurp as it is expected setting in header. + my @cre; + open(my $fh, '<', $LOG_PATH.'main.cnf' ) or die "Can't open main.cnf: $!"; + while (my $line = <$fh>) { + chomp $line; + if(rindex ($line, "<", 14; + my $crest = substr $line, 13, $end - 13; + @cre = split '/', $crest; + last; + } + } close $fh; - if(@cre &&scalar(@cre)>1){ - my $database = $LOG_PATH.'data_'.$cre[0].'_log.db'; - my $dsn= "DBI:SQLite:dbname=$database"; - my $db = DBI->connect($dsn, $cre[0], $cre[1], { RaiseError => 1 }) - or die "

Error->"& $DBI::errstri &"

"; - #check if enabled. - my $st = $db->prepare("SELECT VALUE FROM CONFIG WHERE NAME='AUTO_LOGIN';"); - $st->execute(); - my @set = $st->fetchrow_array(); - if(@set && $set[0]=="1"){ - $alias = $cre[0]; - $passw = $cre[1]; - } - $db->disconnect(); - } + if(@cre &&scalar(@cre)>1){ + my $database = $LOG_PATH.'data_'.$cre[0].'_log.db'; + my $dsn= "DBI:SQLite:dbname=$database"; + my $db = DBI->connect($dsn, $cre[0], $cre[1], { RaiseError => 1 }) + or die "

Error->"& $DBI::errstri &"

"; + #check if enabled. + my $st = $db->prepare("SELECT VALUE FROM CONFIG WHERE NAME='AUTO_LOGIN';"); + $st->execute(); + my @set = $st->fetchrow_array(); + if(@set && $set[0]=="1"){ + $alias = $cre[0]; + $passw = $cre[1]; + } + $db->disconnect(); + } } catch{ - print $cgi->header; - print "SERVER ERROR:".$_; - print $cgi->end_html; - exit; + print $cgi->header; + print "SERVER ERROR:".$_; + print $cgi->end_html; + exit; } } -sub checkCreateTables { +sub checkCreateTables{ try{ - my $today = DateTime->now; - $today->set_time_zone( $TIME_ZONE ); - my $database = $LOG_PATH.'data_'.$alias.'_log.db'; - my $dsn= "DBI:SQLite:dbname=$database"; - my $db = DBI->connect($dsn, $alias, $passw, { RaiseError => 1 }) - or die "

Error->"& $DBI::errstri &"

"; - my $rv; - my $st = $db->prepare(selSQLTbl('LOG')); - $st->execute(); - - my $changed = 0; - - if(!$st->fetchrow_array()) { - my $stmt = qq( - CREATE TABLE LOG ( - ID_CAT TINY NOT NULL, - DATE DATETIME NOT NULL, - LOG VCHAR(128) NOT NULL, - AMOUNT INTEGER DEFAULT 0, - AFLAG TINY DEFAULT 0, - RTF BOOL DEFAULT 0 - ); - CREATE INDEX idx_log_dates ON LOG (DATE); - ); - $rv = $db->do($stmt); - if($rv < 0){print "

Error->"& $DBI::errstri &"

";} - - $st = $db->prepare('INSERT INTO LOG VALUES (?,?,?,?,?,?)'); - $st->execute( 3, $today, "DB Created!",0,0,0); - } - $st = $db->prepare(selSQLTbl('CAT')); - $st->execute(); - if(!$st->fetchrow_array()) { - my $stmt = qq( - CREATE TABLE CAT( - ID TINY PRIMARY KEY NOT NULL, - NAME VCHAR(16), - DESCRIPTION VCHAR(64) - ); - CREATE INDEX idx_cat_name ON CAT (NAME); - ); - $rv = $db->do($stmt); - $changed = 1; - } - #Have cats been wiped out? - $st = $db->prepare('SELECT count(ID) FROM CAT;'); - $st->execute(); - if($st->fetchrow_array()==0) { - $changed = 1; - } + my $today = DateTime->now; + $today->set_time_zone( $TIME_ZONE ); + my $database = $LOG_PATH.'data_'.$alias.'_log.db'; + my $dsn= "DBI:SQLite:dbname=$database"; + my $db = DBI->connect($dsn, $alias, $passw, { RaiseError => 1 }) + or die "

Error->"& $DBI::errstri &"

"; + my $rv; + my $st = $db->prepare(selSQLTbl('LOG')); + $st->execute(); + + my $changed = 0; + + if(!$st->fetchrow_array()) { + my $stmt = qq( + CREATE TABLE LOG ( + ID_CAT TINY NOT NULL, + DATE DATETIME NOT NULL, + LOG VCHAR(128) NOT NULL, + AMOUNT INTEGER DEFAULT 0, + AFLAG TINY DEFAULT 0, + RTF BOOL DEFAULT 0 + ); + CREATE INDEX idx_log_dates ON LOG (DATE); + ); + $rv = $db->do($stmt); + if($rv < 0){print "

Error->"& $DBI::errstri &"

";} + + $st = $db->prepare('INSERT INTO LOG VALUES (?,?,?,?,?,?)'); + $st->execute( 3, $today, "DB Created!",0,0,0); + } + $st = $db->prepare(selSQLTbl('CAT')); + $st->execute(); + if(!$st->fetchrow_array()) { + my $stmt = qq( + CREATE TABLE CAT( + ID TINY PRIMARY KEY NOT NULL, + NAME VCHAR(16), + DESCRIPTION VCHAR(64) + ); + CREATE INDEX idx_cat_name ON CAT (NAME); + ); + $rv = $db->do($stmt); + $changed = 1; + } + #Have cats been wiped out? + $st = $db->prepare('SELECT count(ID) FROM CAT;'); + $st->execute(); + if($st->fetchrow_array()==0) { + $changed = 1; + } $st = $db->prepare(selSQLTbl('AUTH')); - $st->execute(); - if(!$st->fetchrow_array()) { - # - # @TODO - # AUTH Action Flags - # 00|DEFAULT`No action idle use.| - # 02|CONF_UPD`Configuration file update with db. - # 03|EMAIL`Issue email.| + $st->execute(); + if(!$st->fetchrow_array()) { + # + # @TODO + # AUTH Action Flags + # 00|DEFAULT`No action idle use.| + # 02|CONF_UPD`Configuration file update with db. + # 03|EMAIL`Issue email.| # 06|DESTRUCT`Self destruct, remove alias and all data. # 08|CHNG_PASS`Change password. - # 10|CHNG_ALIAS`Change alias. - + # 10|CHNG_ALIAS`Change alias. + my $stmt = qq( - CREATE TABLE AUTH( - alias varchar(20) PRIMARY KEY, - passw TEXT, - email varchar(44), - action TINY - ) WITHOUT ROWID; - CREATE INDEX idx_auth_name_passw ON AUTH (ALIAS, PASSW); - ); - - - $rv = $db->do($stmt); - if($rv < 0){print "

Error->"& $DBI::errstri &"

"}; - - } - # - # Scratch FTS4 implementation if present. - # - $st = $db->prepare(selSQLTbl('NOTES_content')); - $st->execute(); - if($st->fetchrow_array()) { - $rv = $db->do('DROP TABLE NOTES;'); - if($rv < 0){print "

Error->"& $DBI::errstri &"

"}; - } - # - # New Implementation as of 1.5, cross SQLite Database compatible. - # - $st = $db->prepare(selSQLTbl('NOTES')); - $st->execute(); - if(!$st->fetchrow_array()) { - my $stmt = qq( - CREATE TABLE NOTES (LID PRIMARY KEY NOT NULL, DOC TEXT); - ); - $rv = $db->do($stmt); - if($rv < 0){print "

Error->"& $DBI::errstri &"

"}; - } - - $st = $db->prepare("SELECT ALIAS, PASSW, EMAIL, ACTION FROM AUTH WHERE alias='$alias' AND passw='$passw';"); - $st->execute(); - my @res = $st->fetchrow_array(); - if(scalar @res == 0) { - $st = $db->prepare('INSERT INTO AUTH VALUES (?,?,?,?);'); - $st->execute($alias, $passw,"",0); - } + CREATE TABLE AUTH( + alias varchar(20) PRIMARY KEY, + passw TEXT, + email varchar(44), + action TINY + ) WITHOUT ROWID; + CREATE INDEX idx_auth_name_passw ON AUTH (ALIAS, PASSW); + ); + + + $rv = $db->do($stmt); + if($rv < 0){print "

Error->"& $DBI::errstri &"

"}; + + } + # + # Scratch FTS4 implementation if present. + # + $st = $db->prepare(selSQLTbl('NOTES_content')); + $st->execute(); + if($st->fetchrow_array()) { + $rv = $db->do('DROP TABLE NOTES;'); + if($rv < 0){print "

Error->"& $DBI::errstri &"

"}; + } + # + # New Implementation as of 1.5, cross SQLite Database compatible. + # + $st = $db->prepare(selSQLTbl('NOTES')); + $st->execute(); + if(!$st->fetchrow_array()) { + my $stmt = qq( + CREATE TABLE NOTES (LID PRIMARY KEY NOT NULL, DOC TEXT); + ); + $rv = $db->do($stmt); + if($rv < 0){print "

Error->"& $DBI::errstri &"

"}; + } + + $st = $db->prepare("SELECT ALIAS, PASSW, EMAIL, ACTION FROM AUTH WHERE alias='$alias' AND passw='$passw';"); + $st->execute(); + my @res = $st->fetchrow_array(); + if(scalar @res == 0) { + $st = $db->prepare('INSERT INTO AUTH VALUES (?,?,?,?);'); + $st->execute($alias, $passw,"",0); + } - $st = $db->prepare(selSQLTbl('CONFIG')); - $st->execute(); + $st = $db->prepare(selSQLTbl('CONFIG')); + $st->execute(); if(!$st->fetchrow_array()) { - #v.1.3 -> v.1.4 - #alter table CONFIG add DESCRIPTION VCHAR(128); + #v.1.3 -> v.1.4 + #alter table CONFIG add DESCRIPTION VCHAR(128); my $stmt = qq( - CREATE TABLE CONFIG( - ID TINY PRIMARY KEY NOT NULL, - NAME VCHAR(16), - VALUE VCHAR(28), - DESCRIPTION VCHAR(128) - ); - CREATE INDEX idx_config_name ON CONFIG (NAME); - ); - $rv = $db->do($stmt); - $st->finish(); - $changed = 1; - - } - else{ - #PRAGMA table_info(CONFIG); <-To check current structure - #populateConfig($db); - - #Has configuration been wiped out? - $st = $db->prepare('SELECT count(ID) FROM CONFIG;'); - $st->execute(); - $changed = 1 if($st->fetchrow_array()==0); - - } - # - &populate($db) if $changed; - # - $db->disconnect(); + CREATE TABLE CONFIG( + ID TINY PRIMARY KEY NOT NULL, + NAME VCHAR(16), + VALUE VCHAR(28), + DESCRIPTION VCHAR(128) + ); + CREATE INDEX idx_config_name ON CONFIG (NAME); + ); + $rv = $db->do($stmt); + $st->finish(); + $changed = 1; + + } + else{ + #PRAGMA table_info(CONFIG); <-To check current structure + #populateConfig($db); + $st = $db->prepare("SELECT VALUE FROM CONFIG WHERE NAME == 'THEME';"); + $st->execute(); + my $val = $st->fetchrow_array(); + if($val){ + $THEME = $val; + } + + #Has configuration been wiped out? + $st = $db->prepare('SELECT count(ID) FROM CONFIG;'); + $st->execute(); + $changed = 1 if($st->fetchrow_array()==0); + + } + # + &populate($db) if $changed; + # + $db->disconnect(); } catch{ - print $cgi->header; - print "SERVER ERROR:".$_; + print $cgi->header; + print "SERVER ERROR:".$_; print $cgi->end_html; - exit; + exit; } } sub populate { - - my $db = shift; - my ($did,$name, $value, $desc); - my $inData = 0; - my $err = ""; - my %vars = (); - my @lines; - my $table_type = 0; - - open(my $fh, "<:perlio", $LOG_PATH.'main.cnf' ) or die "Can't open main.cnf: $!"; - read $fh, my $content, -s $fh; - @lines = split '\n', $content; - close $fh; + + my $db = shift; + my ($did,$name, $value, $desc); + my $inData = 0; + my $err = ""; + my %vars = (); + my @lines; + my $table_type = 0; + + open(my $fh, "<:perlio", $LOG_PATH.'main.cnf' ) or die "Can't open main.cnf: $!"; + read $fh, my $content, -s $fh; + @lines = split '\n', $content; + close $fh; #TODO Check if script id is unique to database? If not script prevails to database entry. #So, if user settings from a previous release, must be migrated later. try{ - - my $insConfig = $db->prepare('INSERT INTO CONFIG VALUES (?,?,?,?)'); - my $insCat = $db->prepare('INSERT INTO CAT VALUES (?,?,?)'); - $db->begin_work(); + + my $insConfig = $db->prepare('INSERT INTO CONFIG VALUES (?,?,?,?)'); + my $insCat = $db->prepare('INSERT INTO CAT VALUES (?,?,?)'); + $db->begin_work(); foreach my $line (@lines) { - - last if ($line =~ //); - my @tick = split("`",$line); - - if( index( $line, '<' ) == 0 ) {next;} #Migration is complex main.cnf contains though SQL alter statements. - - if( scalar @tick == 2 ) { - - my %hsh = $tick[0] =~ m[(\S+)\s*=\s*(\S+)]g; - if ( scalar %hsh ) { - for my $key ( keys %hsh ) { - my %nash = $key =~ m[(\S+)\s*\|\$\s*(\S+)]g; - if ( scalar(%nash) ) { - for my $id ( keys %nash ) { - my $name = $nash{$id}; - my $value = $hsh{$key}; - if($vars{$id}){ + + last if ($line =~ //); + my @tick = split("`",$line); + + if( index( $line, '<' ) == 0 ) {next;} #Migration is complex main.cnf contains though SQL alter statements. + + if( scalar @tick == 2 ) { + + my %hsh = $tick[0] =~ m[(\S+)\s*=\s*(\S+)]g; + if ( scalar %hsh ) { + for my $key ( keys %hsh ) { + my %nash = $key =~ m[(\S+)\s*\|\$\s*(\S+)]g; + if ( scalar(%nash) ) { + for my $id ( keys %nash ) { + my $name = $nash{$id}; + my $value = $hsh{$key}; + if($vars{$id}){ $err .= "UID{$id} taken by $vars{$id}-> $line\n"; - } - else{ - my $st = $db->prepare("SELECT rowid FROM CONFIG WHERE NAME LIKE '$name';"); - $st->execute(); - $inData = 1; - if(!$st->fetchrow_array()) { - $insConfig->execute($id,$name,$value,$tick[1]) if(!$st->fetchrow_array()); - } - } - } - }else{ + } + else{ + my $st = $db->prepare("SELECT rowid FROM CONFIG WHERE NAME LIKE '$name';"); + $st->execute(); + $inData = 1; + if(!$st->fetchrow_array()) { + $insConfig->execute($id,$name,$value,$tick[1]) if(!$st->fetchrow_array()); + } + } + } + }else{ $err .= "Invalid, spec'ed {uid}|{variable}`{description}-> $line\n"; - } - - }#rof - } - elsif($table_type==0){ - $err .= "Invalid, spec'd entry -> $line\n"; - }elsif($table_type==1){ - my @pair = $tick[0] =~ m[(\S+)\s*\|\s*(\S+)]g; - if ( scalar(@pair)==2 ) { - my $st = $db->prepare("SELECT rowid FROM CONFIG WHERE NAME LIKE '$pair[1]';"); - $st->execute(); - $inData = 1; - if(!$st->fetchrow_array()) { - $insCat->execute($pair[0],$pair[1],$tick[1]) if(!$st->fetchrow_array()); - } - } - else { + } + + }#rof + } + elsif($table_type==0){ + $err .= "Invalid, spec'd entry -> $line\n"; + }elsif($table_type==1){ + my @pair = $tick[0] =~ m[(\S+)\s*\|\s*(\S+)]g; + if ( scalar(@pair)==2 ) { + my $st = $db->prepare("SELECT rowid FROM CONFIG WHERE NAME LIKE '$pair[1]';"); + $st->execute(); + $inData = 1; + if(!$st->fetchrow_array()) { + $insCat->execute($pair[0],$pair[1],$tick[1]) if(!$st->fetchrow_array()); + } + } + else { $err .= "Invalid, spec'ed {uid}|{category}`{description}-> $line\n"; - } - }elsif($table_type==2){ - #TODO Do we really want this? - } - }elsif($inData && length($line)>0){ - - if(scalar(@tick)==1){ - $err .= "Corrupt Entry, no description supplied -> $line\n"; - } - else{ - $err .= "Corrupt Entry -> $line\n"; - } - - } - } - die "Configuration script $LOG_PATH/main.cnf [$fh] contains errors." if $err; - $db->commit(); - } catch{ - print $cgi->header; - print "SERVER ERROR!
".$_."
$err
"; - print $cgi->end_html; - exit; + } + }elsif($table_type==2){ + #TODO Do we really want this? + } + }elsif($inData && length($line)>0){ + + if(scalar(@tick)==1){ + $err .= "Corrupt Entry, no description supplied -> $line\n"; + } + else{ + $err .= "Corrupt Entry -> $line\n"; + } + + } + } + die "Configuration script $LOG_PATH/main.cnf [$fh] contains errors." if $err; + $db->commit(); + } catch{ + print $cgi->header; + print "SERVER ERROR!
".$_."
$err
"; + print $cgi->end_html; + exit; } } sub selSQLTbl{ - my $name = $_[0]; + my $name = $_[0]; return "SELECT name FROM sqlite_master WHERE type='table' AND name='$name';" } sub removeOldSessions { - opendir(DIR, $LOG_PATH); - my @files = grep(/cgisess_*/,readdir(DIR)); - closedir(DIR); - my $now = time - (24 * 60 * 60); - foreach my $file (@files) { - my $mod = (stat("$LOG_PATH/$file"))[9]; - if($mod<$now){ - unlink "$LOG_PATH/$file"; - } - } + opendir(DIR, $LOG_PATH); + my @files = grep(/cgisess_*/,readdir(DIR)); + closedir(DIR); + my $now = time - (24 * 60 * 60); + foreach my $file (@files) { + my $mod = (stat("$LOG_PATH/$file"))[9]; + if($mod<$now){ + unlink "$LOG_PATH/$file"; + } + } } sub logout{ - $session->delete(); - $session->flush(); - print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie); - print $cgi->start_html(-title => "Personal Log Login", -BGCOLOR=>"black", - -style =>{-type => 'text/css', -src => 'wsrc/main.css'}, - ); - - print qq(

You have properly loged out of the Life Log Application!

-
-

-
- -
- ); - - print $cgi->end_html; - exit; + $session->delete(); + $session->flush(); + print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie); + print $cgi->start_html(-title => "Personal Log Login", -BGCOLOR=>"black", + -style =>{-type => 'text/css', -src => 'wsrc/main.css'}, + ); + + print qq(

You have properly loged out of the Life Log Application!

+
+

+
+ +
+ ); + + print $cgi->end_html; + exit; +} + +sub getTheme{ + + + if ( $THEME eq 'Sun' ) { + $BGCOL = '#D4AF37'; + $TH_CSS = "main_sun.css"; + }elsif ($THEME eq 'Moon'){ + $TH_CSS = "main_moon.css"; + $BGCOL = '#000000'; + + }elsif ($THEME eq 'Earth'){ + $TH_CSS = "main_earth.css"; + $BGCOL = 'green'; + } + } ### CGI END diff --git a/htdocs/cgi-bin/main.cgi b/htdocs/cgi-bin/main.cgi index 23c483f..4695334 100755 --- a/htdocs/cgi-bin/main.cgi +++ b/htdocs/cgi-bin/main.cgi @@ -36,9 +36,9 @@ our $IMG_W_H = '210x120'; our $AUTO_WRD_LMT = 1000; our $FRAME_SIZE = 0; our $RTF_SIZE = 0; -our $THEME = 'Standard'; -our $TH_CSS = 'main.css'; - +my $THEME = 'Standard'; +my $TH_CSS = 'main.css'; +my $BGCOL = '#c8fff8'; #END OF SETTINGS my $cgi = CGI->new; @@ -89,6 +89,7 @@ my $lang = Date::Language->new($LANGUAGE); my $today = DateTime->now; $today->set_time_zone($TIME_ZONE); + if ( !$rs_dat_to && $rs_dat_from ) { my $dur = $today; $dur->add( months => 1 ); @@ -104,6 +105,9 @@ my $toggle = ""; if ( $rs_keys || $rs_cat_idx || $stmD || $prm_vc > 0 ) { $toggle = 1; } $session->expire($SESSN_EXPR); +$session->param('theme', $TH_CSS); +$session->param('bgcolor', $BGCOL); +$session->flush(); #tag related framed sizing. my @arrwh = split /x/, $IMG_W_H; @@ -116,18 +120,8 @@ else { #defaults $imgh = 120; } -my $BGCOL = '#c8fff8'; - if ( $THEME eq 'Sun' ) { - $BGCOL = '#D4AF37'; - $TH_CSS = "main_sun.css"; - }elsif ($THEME eq 'Moon'){ - $TH_CSS = "main_moon.css"; - $BGCOL = '#000000'; - - }elsif ($THEME eq 'Earth'){ - $TH_CSS = "main_earth.css"; - $BGCOL = 'green'; - } + +&getTheme; print $cgi->header(-expires => "0s", -charset => "UTF-8"); print $cgi->start_html( @@ -443,6 +437,7 @@ qq(\n); while ( $log =~ /<', $idx ) - 4; + last if $len<6; my $sub = "" . substr( $log, $idx + 4, $len - $idx ) . ""; $log =~ s/</$sub/o; $tagged = 1; @@ -450,6 +445,7 @@ qq(\n); while ( $log =~ /<', $idx ) - 8; + last if $len<9; my $sub = "

" . substr( $log, $idx + 8, $len - $idx ) . "

"; $log =~ s/</$sub/o; $tagged = 1; @@ -458,6 +454,7 @@ qq(\n); while ( $log =~ /<', $idx ) - 7; + last if $len<9; my $lst = substr( $log, $idx + 7, $len - $idx ); my $sub = ""; my @arr = split( /\n|\\n/, $lst ); @@ -1106,13 +1103,13 @@ sub authenticate { sub getConfiguration{ my $db = shift; try { - $st = $db->prepare("SELECT * FROM CONFIG;"); + $st = $db->prepare("SELECT ID, NAME, VALUE FROM CONFIG;"); $st->execute(); while ( my @r = $st->fetchrow_array() ) { switch ( $r[1] ) { - case "$RELEASE_VER" { $RELEASE_VER = $r[2] } + case "RELEASE_VER" { $RELEASE_VER = $r[2] } case "REC_LIMIT" { $REC_LIMIT = $r[2] } case "TIME_ZONE" { $TIME_ZONE = $r[2] } case "PRC_WIDTH" { $PRC_WIDTH = $r[2] } @@ -1124,9 +1121,9 @@ sub authenticate { case "FRAME_SIZE" { $FRAME_SIZE = $r[2] } case "RTF_SIZE" { $RTF_SIZE = $r[2] } case "THEME" { $THEME = $r[2] } - else { - print "Unknow variable setting: " . $r[1] . " == " . $r[2]; - } + # else { + # print "Unknow variable setting: " . $r[1] . " == " . $r[2]; + #} } } @@ -1135,13 +1132,29 @@ sub authenticate { print "SERVER ERROR:" . $_; } } - sub cam { my $am = sprintf( "%.2f", shift @_ ); # Add one comma each time through the do-nothing loop 1 while $am =~ s/^(-?\d+)(\d\d\d)/$1,$2/; return $am; } + sub getTheme{ + + + if ( $THEME eq 'Sun' ) { + $BGCOL = '#D4AF37'; + $TH_CSS = "main_sun.css"; + }elsif ($THEME eq 'Moon'){ + $TH_CSS = "main_moon.css"; + $BGCOL = '#000000'; + + }elsif ($THEME eq 'Earth'){ + $TH_CSS = "main_earth.css"; + $BGCOL = 'green'; + } + + } + sub quill{ @@ -1228,9 +1241,9 @@ return <<___STR; $sp2 -
+

L-Tags Specs

-

+

Life Log Tags are simple markup allowing fancy formatting and functionality for your logs HTML layout.

diff --git a/htdocs/cgi-bin/remove.cgi b/htdocs/cgi-bin/remove.cgi index 8dd02bf..a2c3fe1 100755 --- a/htdocs/cgi-bin/remove.cgi +++ b/htdocs/cgi-bin/remove.cgi @@ -25,14 +25,13 @@ our $TIME_ZONE = 'Australia/Sydney'; our $PRC_WIDTH = '60'; our $LOG_PATH = '../../dbLifeLog/'; our $SESSN_EXPR = '+2m'; -our $RELEASE_VER = '1.3'; +our $RELEASE_VER = '1.5'; +my $THEME = 'Standard'; +my $TH_CSS = 'main.css'; +my $BGCOL = '#c8fff8'; #END OF SETTINGS -##################### - &getConfiguration; -##################### - my $cgi = CGI->new; my $session = new CGI::Session("driver:File",$cgi, {Directory=>$LOG_PATH}); my $sid=$session->id(); @@ -41,8 +40,8 @@ my $userid =$session->param('alias'); my $password=$session->param('passw'); if(!$userid||!$dbname){ - print $cgi->redirect("login_ctr.cgi?CGISESSID=$sid"); - exit; + print $cgi->redirect("login_ctr.cgi?CGISESSID=$sid"); + exit; } my $database = '../../dbLifeLog/'.$dbname; @@ -52,6 +51,14 @@ my $db = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die "

my $today = DateTime->now; $today->set_time_zone( $TIME_ZONE ); + + +##################### +&getConfigurationForRemove; +##################### +&getTheme; + + my %hshCats ={}; my $tbl_rc =0; my $stm; @@ -62,38 +69,38 @@ my $rv = $st->execute() or die or die "

Error->"& $DBI::errstri &"

"; while(my @row = $st->fetchrow_array()) { - $hshCats{$row[0]} = $row[1]; + $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 = '
- - '; +
Date TimeLogCategory
+ '; 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", - -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, - -style =>{-type => 'text/css', -src => 'wsrc/main.css'} + print $cgi->header(-expires=>"+6os"); + print $cgi->start_html(-title => "Date Difference Report", -BGCOLOR => $BGCOL, theme=> "$THEME", + -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, + -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"} - ); - &DisplayDateDiffs; + ); + &DisplayDateDiffs; }elsif (!$confirmed){ - print $cgi->header(-expires=>"+6os"); - print $cgi->start_html(-title => "Personal Log Record Removal", - -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, - -style =>{-type => 'text/css', -src => 'wsrc/main.css'} + print $cgi->header(-expires=>"+6os"); + print $cgi->start_html(-title => "Personal Log Record Removal", -BGCOLOR => $BGCOL,theme=> "$THEME", + -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, + -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"} + + ); - ); - &NotConfirmed; + &NotConfirmed; }else{ - &ConfirmedDelition; + &ConfirmedDelition; } @@ -103,31 +110,31 @@ exit; sub DisplayDateDiffs{ $tbl = '
Date TimeLogCategory
- '; + '; $stm = 'SELECT DATE, LOG FROM LOG WHERE '; my @ids = $cgi->param('chk'); - foreach (@ids){ - $stm .= "rowid = '" . $_ ."'"; - if( \$_ != \$ids[-1] ) { - $stm = $stm." OR "; - } - } - $stm .= ';'; - $st = $db->prepare( $stm ); - $st->execute() or die or die "

Error->"& $DBI::errstri &"

"; - - my $dt_prev = $today; - while(my @row = $st->fetchrow_array()) { - - my $dt = DateTime::Format::SQLite->parse_datetime( $row[0] ); - my $dif = dateDiff($dt_prev, $dt); - $tbl .= ' - ". - ''; - $dt_prev = $dt; - } + foreach (@ids){ + $stm .= "rowid = '" . $_ ."'"; + if( \$_ != \$ids[-1] ) { + $stm = $stm." OR "; + } + } + $stm .= ';'; + $st = $db->prepare( $stm ); + $st->execute() or die or die "

Error->"& $DBI::errstri &"

"; + + my $dt_prev = $today; + while(my @row = $st->fetchrow_array()) { + + my $dt = DateTime::Format::SQLite->parse_datetime( $row[0] ); + my $dif = dateDiff($dt_prev, $dt); + $tbl .= ' + ". + ''; + $dt_prev = $dt; + } $tbl .= '
* DATE DIFFERENCES *
* DATE DIFFERENCES *
'. $dt->ymd . ''.$row[1]."
'.$dif. '
'. $dt->ymd . ''.$row[1]."
'.$dif. '
'; print '
'.$tbl.'

'; @@ -135,15 +142,15 @@ print '
'.$tbl.'

Back to Main Lognew(); - my $dur = $span->format_duration($d2 - $d1); + my($d1,$d2)=@_; + my $span = DateTime::Format::Human::Duration->new(); + my $dur = $span->format_duration($d2 - $d1); return sprintf( "%s
between %s and %s", $dur, boldDate($d1), boldDate($d2)); } sub boldDate{ - my($d)=@_; + my($d)=@_; return "".$d->ymd." ".$d->hms; } @@ -151,24 +158,24 @@ return "".$d->ymd." ".$d->hms; sub ConfirmedDelition{ - foreach my $id ($cgi->param('chk')){ - - $st = $db->prepare("DELETE FROM LOG WHERE rowid = '$id';"); - $rv = $st->execute() or die or die "

Error->"& $DBI::errstri &"

"; - $st = $st = $db->prepare("DELETE FROM NOTES WHERE LID = '$id';"); - $rv = $st->execute(); + foreach my $id ($cgi->param('chk')){ + + $st = $db->prepare("DELETE FROM LOG WHERE rowid = '$id';"); + $rv = $st->execute() or die or die "

Error->"& $DBI::errstri &"

"; + $st = $st = $db->prepare("DELETE FROM NOTES WHERE LID = '$id';"); + $rv = $st->execute(); - if($rv < 0) { - print "

Error->"& $DBI::errstri &"

"; - exit; - } - - } - - - $st->finish; + if($rv < 0) { + print "

Error->"& $DBI::errstri &"

"; + exit; + } + + } + + + $st->finish; - print $cgi->redirect('main.cgi'); + print $cgi->redirect('main.cgi'); } @@ -176,40 +183,40 @@ sub NotConfirmed{ #Get ids and build confirm table and check my $stm = $stmS ." "; - foreach my $id ($cgi->param('chk')){ - $stm = $stm . "rowid = '" . $id . "' OR "; - } + foreach my $id ($cgi->param('chk')){ + $stm = $stm . "rowid = '" . $id . "' OR "; + } #OR end to rid=0 hack! ;) - $stm = $stm . "rowid = '0' " . $stmE; + $stm = $stm . "rowid = '0' " . $stmE; # $st = $db->prepare( $stm ); $rv = $st->execute() or die "

Error->"& $DBI::errstri &"

"; if($rv < 0) { - print "

Error->"& $DBI::errstri &"

"; + print "

Error->"& $DBI::errstri &"

"; } 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 . ''. $dt->ymd . "" . - '' . $dt->hms . "" . - '' . $row[3] . "\n". - '' . $ct. ''; - if($rs eq "r1"){ - $rs = "r0"; - } - else{ - $rs = "r1"; - } - $r_cnt++; + my $ct = $hshCats{$row[1]}; + my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] ); + + $tbl = $tbl . ''. $dt->ymd . "" . + '' . $dt->hms . "" . + '' . $row[3] . "\n". + '' . $ct. ''; + if($rs eq "r1"){ + $rs = "r0"; + } + else{ + $rs = "r1"; + } + $r_cnt++; } my $plural = ""; if($r_cnt>1){ - $plural = "s"; + $plural = "s"; } $tbl = $tbl . ' @@ -229,26 +236,44 @@ print '
' . $tbl .'
'; $st->finish; } -sub getConfiguration{ - try{ - my $dbs = $db->prepare("SELECT * FROM CONFIG;"); - $dbs->execute(); +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]} + + } + + } + } + catch{ + print "SERVER ERROR:".$_; + } +} + +sub getTheme{ - while (my @r=$dbs->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]} - else {print "Unknow variable setting: ".$r[1]. " == ". $r[2]} + if ( $THEME eq 'Sun' ) { + $BGCOL = '#D4AF37'; + $TH_CSS = "main_sun.css"; + }elsif ($THEME eq 'Moon'){ + $TH_CSS = "main_moon.css"; + $BGCOL = '#000000'; - } + }elsif ($THEME eq 'Earth'){ + $TH_CSS = "main_earth.css"; + $BGCOL = 'green'; + } - } - } - catch{ - print "SERVER ERROR:".$_; - } } \ No newline at end of file diff --git a/htdocs/cgi-bin/time_zones.cgi b/htdocs/cgi-bin/time_zones.cgi index 207a41c..434fbb8 100755 --- a/htdocs/cgi-bin/time_zones.cgi +++ b/htdocs/cgi-bin/time_zones.cgi @@ -11,6 +11,7 @@ use CGI; use CGI::Session '-ip_match'; use Text::CSV; +our $LOG_PATH = '../../dbLifeLog/'; my @zones; my $zone; open my $fh, '<', '../../dbLifeLog/zone.csv' or die "Cannot open: $!"; @@ -24,10 +25,16 @@ close $fh; my $cgi = CGI->new; +my $session = new CGI::Session( "driver:File", $cgi, { Directory => $LOG_PATH } ); +my $TH_CSS = $session->param("theme"); +my $BGCOL = $session->param("bgcolor"); + + + print $cgi->header(-expires=>"+6s", -charset=>"UTF-8"); -print $cgi->start_html(-title => "Personal Log", -BGCOLOR=>"#c8fff8", +print $cgi->start_html(-title => "Personal Log", -BGCOLOR=>"$BGCOL", -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, - -style =>{-type => 'text/css', -src => 'wsrc/main.css'}, + -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"}, ); diff --git a/htdocs/cgi-bin/wsrc/main.cgi b/htdocs/cgi-bin/wsrc/main.cgi deleted file mode 100755 index 4bb4ded..0000000 --- a/htdocs/cgi-bin/wsrc/main.cgi +++ /dev/null @@ -1,1035 +0,0 @@ -#!/usr/bin/perl -# -# Programed in vim by: Will Budic -# Open Source License -> https://choosealicense.com/licenses/isc/ -# -use strict; -use warnings; -use Try::Tiny; -use Switch; - -use CGI; -use CGI::Session '-ip_match'; -use CGI::Carp qw ( fatalsToBrowser ); -use DBI; - -use DateTime; -use DateTime::Format::SQLite; -use DateTime::Duration; -use Date::Language; -use Date::Parse; -use Time::localtime; -use Regexp::Common qw /URI/; - -#DEFAULT SETTINGS HERE! -our $REC_LIMIT = 25; -our $TIME_ZONE = 'Australia/Sydney'; -our $LANGUAGE = 'English'; -our $PRC_WIDTH = '60'; -our $LOG_PATH = '../../dbLifeLog/'; -our $SESSN_EXPR = '+30m'; -our $DATE_UNI = '0'; -our $RELEASE_VER = '1.4'; -our $AUTHORITY = ''; -our $IMG_W_H = '210x120'; -our $AUTO_WRD_LMT = 200; - -#END OF SETTINGS - -my $cgi = CGI->new; -my $session = - new CGI::Session( "driver:File", $cgi, { Directory => $LOG_PATH } ); -my $sid = $session->id(); -my $dbname = $session->param('database'); -my $userid = $session->param('alias'); -my $password = $session->param('passw'); - -if ($AUTHORITY) { - $userid = $password = $AUTHORITY; - $dbname = 'data_' . $userid . '_log.db'; -} -elsif ( !$userid || !$dbname ) { - print $cgi->redirect("login_ctr.cgi?CGISESSID=$sid"); - exit; -} - -my $database = '../../dbLifeLog/' . $dbname; -my $dsn = "DBI:SQLite:dbname=$database"; -my $db = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } ) - or die "

Error->" & $DBI::errstri & "

"; - -my ( $imgw, $imgh ); - -### Authenticate session to alias password -&authenticate; -&getConfiguration($db ); - -my $tbl_rc = 0; -my $tbl_rc_prev = 0; -my $tbl_cur_id; -my $rs_keys = $cgi->param('keywords'); -my $rs_cat_idx = $cgi->param('category'); -my $prm_vc = $cgi->param("vc"); -my $rs_dat_from = $cgi->param('v_from'); -my $rs_dat_to = $cgi->param('v_to'); -my $rs_prev = $cgi->param('rs_prev'); -my $rs_cur = $cgi->param('rs_cur'); -my $rs_page = $cgi->param('rs_page'); -my $stmS = "SELECT rowid, ID_CAT, DATE, LOG, AMMOUNT from LOG WHERE"; -my $stmE = " ORDER BY DATE DESC;"; -my $stmD = ""; -if ( !$rs_dat_to ) { - $rs_dat_to = 'now'; -} - -if ( $rs_dat_from && $rs_dat_to ) { - $stmD =qq( DATE BETWEEN date('$rs_dat_from') AND date('$rs_dat_to') ); -} - -my $toggle = ""; -if ( $rs_keys || $rs_cat_idx || $stmD ) { $toggle = 1; } - -$session->expire($SESSN_EXPR); - -#tag related framed sizing. -my @arrwh = split /x/, $IMG_W_H; -if ( @arrwh == 2 ) { - $imgw = $arrwh[0]; - $imgh = $arrwh[1]; -} -else { #defaults - $imgw = 210; - $imgh = 120; -} - -print $cgi->header( - -expires => "0s", - -charset => "UTF-8" - ); -print $cgi->start_html( - -title => "Personal Log", - -BGCOLOR => "#c8fff8", - -onload => "loadedBody('" . $toggle . "');", - -style => [ - { -type => 'text/css', -src => 'wsrc/main.css' }, - { -type => 'text/css', -src => 'wsrc/jquery-ui.css' }, - { -type => 'text/css', -src => 'wsrc/jquery-ui.theme.css' }, - { - -type => 'text/css', - -src => 'wsrc/jquery-ui-timepicker-addon.css' - }, - { -type => 'text/css', -src => 'wsrc/tip-skyblue/tip-skyblue.css' }, - { - -type => 'text/css', - -src => 'wsrc/tip-yellowsimple/tip-yellowsimple.css' - }, - - {-type => 'application/atom+xml', - -src=>'https://quilljs.com/feed.xml', -title=>"Quill - Your powerful rich text editor"}, - {-type => 'text/css', -src=>'wsrc/quill/katex.min.css'}, - {-type => 'text/css', -src=>'wsrc/quill/monokai-sublime.min.css'}, - {-type => 'text/css', -src=>'wsrc/quill/quill.snow.css'}, - - - ], - -script => [ - { -type => 'text/javascript', -src => 'wsrc/main.js' }, - { -type => 'text/javascript', -src => 'wsrc/jquery.js' }, - { -type => 'text/javascript', -src => 'wsrc/jquery-ui.js' }, - { - -type => 'text/javascript', - -src => 'wsrc/jquery-ui-timepicker-addon.js' - }, - { - -type => 'text/javascript', - -src => 'wsrc/jquery-ui-sliderAccess.js' - }, - { -type => 'text/javascript', -src => 'wsrc/jquery.poshytip.js' }, - - { -type => 'text/javascript', -src => 'wsrc/quill/katex.min.js'}, - { -type => 'text/javascript', -src => 'wsrc/quill/highlight.min.js'}, - { -type => 'text/javascript', -src => 'wsrc/quill/quill.min.js'}, - - ], - ); - -my $rv; -my $st; -my $lang = Date::Language->new($LANGUAGE); -my $today = DateTime->now; -$today->set_time_zone($TIME_ZONE); - -my $stmtCat = "SELECT * FROM CAT;"; -my $stmt = -"SELECT rowid, ID_CAT, DATE, LOG, AMMOUNT FROM LOG ORDER BY DATE DESC, rowid DESC;"; - -$st = $db->prepare($stmtCat); -$rv = $st->execute() or die or die "

Error->" & $DBI::errstri & "

"; - -my $cats = qq('; - -my $cat_descriptions = ""; -for my $key ( keys %desc ) { - my $kv = $desc{$key}; - if ( $kv ne ".." ) { - $cat_descriptions .= qq(
  • $kv
    • \n); - } -} - -my $tbl = -qq( - - - - - - -); - -if (defined $prm_vc) { #view category form selection - $rs_cat_idx = $prm_vc; -} - -if ($rs_keys) { - - my @keywords = split / /, $rs_keys; - if ($rs_cat_idx) { - $stmS = $stmS . " ID_CAT='" . $rs_cat_idx . "' AND"; - } - else { - $stmS = $stmS . " ID_CAT='0' OR"; - } - if ($stmD) { - $stmS = $stmS . $stmD . " AND"; - } - - if (@keywords) { - foreach (@keywords) { - $stmS = $stmS . " LOWER(LOG) REGEXP '\\b" . lc $_ . "\\b'"; - if ( \$_ != \$keywords[-1] ) { - $stmS = $stmS . " OR "; - } - } - $stmt = $stmS . $stmE; - } -} -elsif ($rs_cat_idx) { - - if ($stmD) { - $stmt = $stmS . $stmD . " AND ID_CAT='" . $rs_cat_idx . "'" . $stmE; - } - else { - $stmt = $stmS . " ID_CAT='" . $rs_cat_idx . "'" . $stmE; - } -} -else { - if ($stmD) { - $stmt = $stmS . $stmD . $stmE; - } -} - -############### -&processSubmit; -############### -# -# Uncomment bellow to see main query statement issued! -#print $cgi->pre("### -> ".$stmt); -# -my $tfId = 0; -my $id = 0; -my $tbl_start = index $stmt, "<="; -my $re_a_tag = qr/.*<\/a>/si; - -if ( $tbl_start > 0 ) { - - #check if we are at the beggining of the LOG table? - my $stc = - $db->prepare('select rowid from LOG order by rowid DESC LIMIT 1;'); - $stc->execute(); - my @row = $stc->fetchrow_array(); - if ( $row[0] == $rs_prev && $rs_cur == $rs_prev ) { - $tbl_start = -1; - } - $stc->finish(); -} -# -#Fetch entries! -# -my $CID_EVENT = 9; -my $tags = ""; -$st = $db->prepare($stmt); -$rv = $st->execute() or die or die "

    Error->" & $DBI::errstri & "

    "; -if ( $rv < 0 ) { - print "

    Error->" & $DBI::errstri & "

    "; -} -while ( my @row = $st->fetchrow_array() ) { - - $id = $row[0]; - - my $ct = $hshCats{ $row[1] }; - my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] ); - my $log = $row[3]; - my $amm = camm(sprintf "%.2f", $row[4]); - - #Apostrophe in the log value is doubled to avoid SQL errors. - $log =~ s/''/'/g; - # - if ( !$ct ) { - $ct = $hshCats{1}; - } - if ( !$dt ) { - $dt = $today; - } - if ( !$amm ) { - $amm = "0.00"; - } - if ( $tbl_rc_prev == 0 ) { - $tbl_rc_prev = $id; - } - if ( $tfId == 1 ) { - $tfId = 0; - } - else { - $tfId = 1; - } - - my $sub = ""; - my $tagged = 0; - -#Check for LNK takes precedence here as we also parse plain placed URL's for http protocol later. - if ( $log =~ /<', $idx ); - $sub = substr( $log, $idx + 1, $len - $idx - 1 ); - my $url = qq($sub); - $tags .= qq(\n); - $tagged = 1; - $log =~ s/</$url/osi; - } - - if ( $log =~ /<', $idx ); - $sub = substr( $log, $idx + 1, $len - $idx - 1 ); - my $url = qq(); - if ( !$tagged ) { - $tags .= qq(\n); - } - $log =~ s/</$url/osi; - } - elsif ( $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 - ); - } - else { - #TODO fetch from web locally the original image. - $lnk=qq(\n); - } - if ( !$tagged ) { - $tags .= qq(\n); - } - $log =~ s/</$lnk/o; - } - elsif ( $log =~ /<', $idx ) - 7; - my $lst = substr( $log, $idx + 7, $len - $idx ); - my $sub = ""; - my @arr = split(/\n/, $lst); - foreach my $ln (@arr) { - $ln =~ s/^\s*//g; - $sub .= "
  • $ln
    • " if length($ln)>0; - } - - $log = "
      $sub
    "; - #$log =~ s/</$lst/o; - # print $lst; - - } - - - #Replace with a full link an HTTP URI - 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, " -1; - $ch_i =~ s/https/http/gsi; - $ch_i =~ s/($RE{URI}{HTTP})/$1<\/a>/gsi; - } - $log = join( '', @chnks ); - - while ( $log =~ /<', $idx ) - 4; - my $sub = "" . substr( $log, $idx + 4, $len - $idx ) . ""; - $log =~ s/</$sub/o; - } - while ( $log =~ /<', $idx ) - 4; - my $sub = "" . substr( $log, $idx + 4, $len - $idx ) . ""; - $log =~ s/</$sub/o; - } - while ( $log =~ /<', $idx ) - 8; - my $sub = "

    " . substr( $log, $idx + 8, $len - $idx ) . "

    "; - $log =~ s/</$sub/o; - } - - #Decode escaped \\n - $log =~ s/\r\n/
    /gs; - $log =~ s/\n/
    /gs; - - if ( $CID_EVENT == $row[1] ) { - $log = "$log"; - } - elsif ( 1 == $row[1] ) { - $log = -"$log"; - } - - my ( $dty, $dtf ) = $dt->ymd; - my $dth = $dt->hms; - if ( $DATE_UNI == 1 ) { - $dtf = $dty; - } - else { - $dtf = $lang->time2str( "%d %b %Y", $dt->epoch, $TIME_ZONE); - } - $tbl .= qq(     - - - - - - - ); - $tbl_rc += 1; - - if ( $REC_LIMIT > 0 && $tbl_rc == $REC_LIMIT ) { - &buildNavigationButtons; - last; - } - -} #while end - -## -#Fetch Keywords autocomplete we go by words larger then three. -# -$st = $db->prepare('select LOG from LOG;'); -my $aw_cnt = 0; -my $autowords = qq("gas","money","today"); -$rv = $st->execute() or die or die "

    Error->" & $DBI::errstri & "

    "; -if ( $rv < 0 ) { - print "

    Error->" & $DBI::errstri & "

    "; -} -&fetchAutocomplete; - -#End of table? -if ( $rs_prev && $tbl_rc < $REC_LIMIT ) { - $st = $db->prepare("SELECT count(*) FROM LOG;"); - $st->execute(); - my @row = $st->fetchrow_array(); - if ( $row[0] > $REC_LIMIT ) { - &buildNavigationButtons(1); - } -} - -if ( $tbl_rc == 0 ) { - - if ($stmD) { - $tbl = $tbl . '    '; - } - elsif ($rs_keys) { - my $criter = ""; - if ( $rs_cat_idx > 0 ) { - $criter = "->Criteria[" . $hshCats{$rs_cat_idx} . "]"; - } - $tbl = $tbl . qq( - ); - } - else { - $tbl = $tbl - . '\n'; - } -} - -$tbl .= -' - - -
    DateTimeLog#CategoryEdit
    $dtf$dth$log$amm$ct - - -
    - Search Failed to Retrive any records on select: [' . $stmD - . '] !
    - Search Failed to Retrive any records on keywords: [$rs_keys]$criter!
    Database is New or Empty!
    -↟ - -  - - - -
    Keywords: -
    '; -my $COLLAPSED_LOG = 's'; -my ($sp1,$sp2); -$sp1 = ''; -$sp2 = qq(); - - -my $frm = qq( -
    - - - - - - - - - - - - - - - -
    * LOG ENTRY FORM * - $sp1 - $sp2 -
    Date:hms . qq("> - -   -  Category: -$cats -

    -
    Log: - -
    ↡ Ammount: -   RTF Document - -
      -
    -
    - - - - - - - - $tags
    - ); - -my $srh = qq( -
    - - - ); - -$srh .= -qq( - - - - - - - - ); - -if ( $rs_keys || $rs_cat_idx || $stmD ) { - $srh .= ' - '; -} - -$srh .= '
    Search/View By - $sp1 - $sp2 - -
    View by Category:$cats_v -
    View by Date: - From:  - To:  -
    Keywords: -
    '; -my $quill = &quill(); -# -#Page printout from here! -# -print qq(
    \n - - -
    \n$frm\n
    \n -
    $srh
    - $quill -
    \n$tbl\n

    -
    -
    - - ); -print qq(
    -
      - $cat_descriptions -
    - - - ); - -print $cgi->end_html; -$st->finish; -$db->disconnect(); -undef($session); -exit; - -=comm -sub parseDate{ - my $date = $_[0]; -try{ -return DateTime::Format::SQLite->parse_datetime( $date ); -} -catch{ - print "SERVER ERRORdate:$date]->".$_; -} -return $today; -} -=cut - -sub processSubmit { - - my $date = $cgi->param('date'); - my $log = $cgi->param('log'); - my $cat = $cgi->param('ec') - ; #Used to be cat v.1.3, tag id and name should be kept same. - my $amm = $cgi->param('am'); - - my $edit_mode = $cgi->param('submit_is_edit'); - my $view_mode = $cgi->param('submit_is_view'); - my $view_all = $cgi->param('rs_all'); - - try { -#Apostroph's need to be replaced with doubles and white space fixed for the SQL. - $log =~ s/'/''/g; - - if ( $edit_mode && $edit_mode != "0" ) { - - #Update - - my $stm = - "UPDATE LOG SET ID_CAT='" - . $cat - . "', DATE='" - . $date . "', - LOG='" - . $log - . "', AMMOUNT='" - . $amm - . "' WHERE rowid=" - . $edit_mode . ";"; - my $st = $db->prepare($stm); - $st->execute(); - return; - } - - if ( $view_all && $view_all == "1" ) { - $REC_LIMIT = 0; - } - - if ( $view_mode == "1" ) { - - if ($rs_cur) { - - if ( $rs_cur == $rs_prev ) - { #Mid page back button if id ordinal. - $rs_cur += $REC_LIMIT; - $rs_prev = $rs_cur; - $rs_page--; - } - else { - $rs_page++; - } - - $stmt = -'SELECT rowid, ID_CAT, DATE, LOG, AMMOUNT from LOG where rowid <= "' - . $rs_cur - . '" ORDER BY DATE DESC;' - . $rs_page; - return; - } - } - - if ( $log && $date && $cat ) { - - #check for double entry - # - my $st = $db->prepare( qq(SELECT DATE,LOG FROM LOG where DATE='$date' AND LOG='$log';) ); - - $st->execute(); - if ( my @row = $st->fetchrow_array() ) { - return; - } - - $st = $db->prepare('INSERT INTO LOG VALUES (?,?,?,?)'); - $st->execute( $cat, $date, $log, $amm ); - # - # After Insert renumeration check - # - my $dt = DateTime::Format::SQLite->parse_datetime($date); - my $dtCur = DateTime->now(); - $dtCur->set_time_zone($TIME_ZONE); - $dtCur = $dtCur - DateTime::Duration->new( days => 1 ); - - if ( $dtCur > $dt ) { - print $cgi->p('Insert is in the past!'); - - #Renumerate directly (not proper SQL but faster); - $st = $db->prepare('select rowid from LOG ORDER BY DATE;'); - $st->execute(); - my $cnt = 1; - while ( my @row = $st->fetchrow_array() ) { - my $st_upd = - $db->prepare( "UPDATE LOG SET rowid=" - . $cnt - . " WHERE rowid='" - . $row[0] - . "';" ); - $st_upd->execute(); - $cnt = $cnt + 1; - } - } - } - } - catch { - print "ERROR:" . $_; - } -} - -sub buildNavigationButtons { - - my $is_end_of_rs = shift; - - if ( !$tbl_cur_id ) { - - #Following is a quick hack as previous id as current minus one might not - #coincide in the database table! - $tbl_cur_id = $id - 1; - } - if ( $tfId == 1 ) { - $tfId = 0; - } - else { - $tfId = 1; - } - - $tbl .= qq!!; - - if ( $rs_prev && $rs_prev > 0 && $tbl_start > 0 && $rs_page > 0 ) { - - $tbl = $tbl . qq! - !; - - } - else { - $tbl .= 'Top'; - } - - $tbl .= -''; - - if ( $is_end_of_rs == 1 ) { - $tbl = $tbl . 'End'; - } - else { - - $tbl .= -qq!!; - - } - - $tbl = $tbl . ''; -} - -sub authenticate { - try { - - if ($AUTHORITY) { - return; - } - - my $st = $db->prepare( - "SELECT * FROM AUTH WHERE alias='$userid' and passw='$password';" - ); - $st->execute(); - if ( $st->fetchrow_array() ) { return; } - - #Check if passw has been wiped for reset? - $st = $db->prepare("SELECT * FROM AUTH WHERE alias='$userid';"); - $st->execute(); - my @w = $st->fetchrow_array(); - if ( @w && $w[1] == "" ) { - - #Wiped with -> UPDATE AUTH SET passw='' WHERE alias='$userid'; - $st = $db->prepare( - "UPDATE AUTH SET passw='$password' WHERE alias='$userid';"); - $st->execute(); - return; - } - - print $cgi->header( -expires => "+0s", -charset => "UTF-8" ); - print $cgi->start_html( - -title => "Personal Log Login", - -script => { -type => 'text/javascript', -src => 'wsrc/main.js' }, - -style => { -type => 'text/css', -src => 'wsrc/main.css' }, - ); - - print $cgi->center( - $cgi->div("Access Denied! alias:$userid pass:$password") ); - print $cgi->end_html; - - $db->disconnect(); - $session->flush(); - exit; - - } - catch { - print $cgi->header( -expires => "+0s", -charset => "UTF-8" ); - print $cgi->p( "ERROR:" . $_ ); - print $cgi->end_html; - exit; - } -} - -sub fetchAutocomplete { - try { - - while ( my @row = $st->fetchrow_array() ) { - my $log = $row[0]; - - #Decode escaped \\n - $log =~ s/\\n/\n/gs; - $log =~ s/''/'/g; - - #Replace link to empty string - my @words = split( /($re_a_tag)/si, $log ); - foreach my $ch_i (@words) { - next if $ch_i =~ /$re_a_tag/; - next if index( $ch_i, " -1; - $ch_i =~ s/https//gsi; - $ch_i =~ s/($RE{URI}{HTTP})//gsi; - } - $log = join( ' ', @words ); - @words = split( ' ', $log ); - foreach my $word (@words) { - - #remove all non alphanumerics - $word =~ s/[^a-zA-Z]//gs; - if ( length($word) > 2 ) { - $word = lc $word; - - #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 ); - next if $word eq $existing; - } - - $autowords .= qq(,"$word"); - if ( $aw_cnt++ > $AUTO_WRD_LMT ) { - last; - } - } - } - - if ( $aw_cnt > $AUTO_WRD_LMT ) { - last; - } - } - - } - catch { - print "SERVER ERROR:" . $_; - } -} - -sub getConfiguration { - my $db = shift; - try { - $st = $db->prepare("SELECT * 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 "DATE_UNI" { $DATE_UNI = $r[2] } - case "LANGUAGE" { $LANGUAGE = $r[2] } - case "IMG_W_H" { $IMG_W_H = $r[2] } - case "AUTO_WRD_LMT" { $AUTO_WRD_LMT = $r[2] } - else { - print "Unknow variable setting: " . $r[1] . " == " . $r[2]; - } - } - - } - } - catch { - print "SERVER ERROR:" . $_; - } -} - -sub camm { - my $amm = sprintf("%.2f", shift @_); - # Add one comma each time through the do-nothing loop - 1 while $amm =~ s/^(-?\d+)(\d\d\d)/$1,$2/; -return $amm; -} - -sub quill { -return qq{ - - -
    -
    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    -
    -
    - -} -} \ No newline at end of file -- 2.34.1