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.
&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",
$dbs = dbExecute($stmtCat);
while(my @row = $dbs->fetchrow_array()) {
if($row[0]>0){
- $tbl = $tbl.
- '<tr class="r0"><td>'.$row[0].'</td>
+ $tbl .= '<tr class="r0"><td>'.$row[0].'</td>
<td><input name="nm'.$row[0].'" type="text" value="'.$row[1].'" size="12"></td>
<td align="left"><input name="ds'.$row[0].'" type="text" value="'.$row[2].'" size="64"></td>
</tr>';
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
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
&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(
-
<form id="frm_login" action="login_ctr.cgi" method="post"><table border="0" width="$PRC_WIDTH%">
- <tr class="r0">
- <td colspan="3"><center>LOGIN</center></td>
- </tr>
- <tr class="r1" style="border-left:1px solid black; border-right:1px solid black;">
- <td align="right">Alias:</td><td><input type="text" name="alias" value="$alias"/></td><td></td>
- </tr>
- <tr class="r1" style="border-left:1px solid black; border-right:1px solid black;">
- <td align="right">Password:</td><td><input type="password" name="passw" value="$passw"/></td><td></td>
- </tr>
- <tr class="r1">
- <td colspan="3" style="border-left:1px solid black; border-right:1px solid black;"><font color="red">NOTICE!</font>
- Alias will create a new database if it doesn't exist. Note down your password.
- <input type="hidden" name="CGISESSID" value="$sid"/>
- <input type="hidden" name="login" value="1"/></td></tr>
- <tr class="r0"><td colspan="2"></td><td><input type="submit" value="Login"/></td></tr>
+ <form id="frm_login" action="login_ctr.cgi" method="post"><table border="0" width="$PRC_WIDTH%">
+ <tr class="r0">
+ <td colspan="3"><center>LOGIN</center></td>
+ </tr>
+ <tr class="r1" style="border-left:1px solid black; border-right:1px solid black;">
+ <td align="right">Alias:</td><td><input type="text" name="alias" value="$alias"/></td><td></td>
+ </tr>
+ <tr class="r1" style="border-left:1px solid black; border-right:1px solid black;">
+ <td align="right">Password:</td><td><input type="password" name="passw" value="$passw"/></td><td></td>
+ </tr>
+ <tr class="r1">
+ <td colspan="3" style="border-left:1px solid black; border-right:1px solid black;"><font color="red">NOTICE!</font>
+ Alias will create a new database if it doesn't exist. Note down your password.
+ <input type="hidden" name="CGISESSID" value="$sid"/>
+ <input type="hidden" name="login" value="1"/></td></tr>
+ <tr class="r0"><td colspan="2"></td><td><input type="submit" value="Login"/></td></tr>
</table></form>);
-
print qq(<br><br><div id=rz>
- <center>
-
<h2>Welcome to Life Log</h2><div>$frm</div><br/>
-
<a href="https://github.com/wbudic/LifeLog" target="_blank">Get latest version of this application here!</a><br>
- print $cgi->end_html;
+ print qq(<br><br><div id=rz>
+ <center>
+ <h2>Welcome to Life Log</h2><div>$frm</div><br/>
+ <a href="https://github.com/wbudic/LifeLog" target="_blank">Get latest version of this application here!</a><br>
+ </center><div>);
+ print $cgi->end_html;
}
else{
- print $cgi->start_html;
- print $cgi->end_html;
+ print $cgi->start_html;
+ print $cgi->end_html;
}
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 "<font color=red><b>SERVER ERROR</b></font> dump ->". $session->dump();
+ print $cgi->header;
+ print "<font color=red><b>SERVER ERROR</b></font> 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, "<<AUTO_LOGIN<", 0)==0){
- my $end = index $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, "<<AUTO_LOGIN<", 0)==0){
+ my $end = index $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 "<p>Error->"& $DBI::errstri &"</p>";
- #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 "<p>Error->"& $DBI::errstri &"</p>";
+ #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 "<font color=red><b>SERVER ERROR</b></font>:".$_;
- print $cgi->end_html;
- exit;
+ print $cgi->header;
+ print "<font color=red><b>SERVER ERROR</b></font>:".$_;
+ 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 "<p>Error->"& $DBI::errstri &"</p>";
- 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 "<p>Error->"& $DBI::errstri &"</p>";}
-
- $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 "<p>Error->"& $DBI::errstri &"</p>";
+ 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 "<p>Error->"& $DBI::errstri &"</p>";}
+
+ $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 "<p>Error->"& $DBI::errstri &"</p>"};
-
- }
- #
- # 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 "<p>Error->"& $DBI::errstri &"</p>"};
- }
- #
- # 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 "<p>Error->"& $DBI::errstri &"</p>"};
- }
-
- $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 "<p>Error->"& $DBI::errstri &"</p>"};
+
+ }
+ #
+ # 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 "<p>Error->"& $DBI::errstri &"</p>"};
+ }
+ #
+ # 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 "<p>Error->"& $DBI::errstri &"</p>"};
+ }
+
+ $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 "<font color=red><b>SERVER ERROR</b></font>:".$_;
+ print $cgi->header;
+ print "<font color=red><b>SERVER ERROR</b></font>:".$_;
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 =~ /<MIG<>/);
- my @tick = split("`",$line);
-
- if( index( $line, '<<CONFIG<' ) == 0 ){$table_type = 0; $inData = 0;}
- elsif( index( $line, '<<CAT<' ) == 0 ) {$table_type = 1; $inData = 0;}
- elsif( index( $line, '<<LOG<' ) == 0 ) {$table_type = 2; $inData = 0;}
- elsif( index( $line, '<<~MIG<>' ) == 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 =~ /<MIG<>/);
+ my @tick = split("`",$line);
+
+ if( index( $line, '<<CONFIG<' ) == 0 ){$table_type = 0; $inData = 0;}
+ elsif( index( $line, '<<CAT<' ) == 0 ) {$table_type = 1; $inData = 0;}
+ elsif( index( $line, '<<LOG<' ) == 0 ) {$table_type = 2; $inData = 0;}
+ elsif( index( $line, '<<~MIG<>' ) == 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 "<font color=red><b>SERVER ERROR!</b></font><br> ".$_."<br><pre>$err</pre>";
- 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 "<font color=red><b>SERVER ERROR!</b></font><br> ".$_."<br><pre>$err</pre>";
+ 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(<font color="white"><center><h2>You have properly loged out of the Life Log Application!</h2>
- <br>
- <form action="login_ctr.cgi"><input type="submit" value="No, no, NO! Log me In Again."/></form><br>
- </br>
- <iframe width="60%" height="600px" src="https://www.youtube.com/embed/qTFojoffE78?autoplay=1"
- frameborder="0"
- allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen>
- </iframe>
- </center></font>
- );
-
- 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(<font color="white"><center><h2>You have properly loged out of the Life Log Application!</h2>
+ <br>
+ <form action="login_ctr.cgi"><input type="submit" value="No, no, NO! Log me In Again."/></form><br>
+ </br>
+ <iframe width="60%" height="600px" src="https://www.youtube.com/embed/qTFojoffE78?autoplay=1"
+ frameborder="0"
+ allow="accelerometer; autoplay; encrypted-media; gyroscope; picture-in-picture" allowfullscreen>
+ </iframe>
+ </center></font>
+ );
+
+ 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
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;
my $today = DateTime->now;
$today->set_time_zone($TIME_ZONE);
+
if ( !$rs_dat_to && $rs_dat_from ) {
my $dur = $today;
$dur->add( months => 1 );
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;
$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(
while ( $log =~ /<<I</ ) {
my $idx = $-[0];
my $len = index( $log, '>', $idx ) - 4;
+ last if $len<6;
my $sub = "<i>" . substr( $log, $idx + 4, $len - $idx ) . "</i>";
$log =~ s/<<I<(.*?)>/$sub/o;
$tagged = 1;
while ( $log =~ /<<TITLE</ ) {
my $idx = $-[0];
my $len = index( $log, '>', $idx ) - 8;
+ last if $len<9;
my $sub = "<h3>" . substr( $log, $idx + 8, $len - $idx ) . "</h3>";
$log =~ s/<<TITLE<(.*?)>/$sub/o;
$tagged = 1;
while ( $log =~ /<<LIST</ ) {
my $idx = $-[0];
my $len = index( $log, '>', $idx ) - 7;
+ last if $len<9;
my $lst = substr( $log, $idx + 7, $len - $idx );
my $sub = "";
my @arr = split( /\n|\\n/, $lst );
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] }
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];
+ #}
}
}
print "<font color=red><b>SERVER ERROR</b></font>:" . $_;
}
}
-
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{
<a id="a_toggle" href="#" onclick="return toggle('#tbl_hlp .collpsd');">$sp2</a>
</td></tr>
<tr class="collpsd"><td>
-<div id="rz" style="text-align:left; padding:10px;">
+<div id="rz" class="rz">
<h2>L-Tags Specs</h2>
- <p>
+ <p class="rz">
Life Log Tags are simple markup allowing fancy formatting and functionality
for your logs HTML layout.
</p>
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();
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;
my $today = DateTime->now;
$today->set_time_zone( $TIME_ZONE );
+
+
+#####################
+&getConfigurationForRemove;
+#####################
+&getTheme;
+
+
my %hshCats ={};
my $tbl_rc =0;
my $stm;
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 = '<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>';
+ <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>';
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;
}
sub DisplayDateDiffs{
$tbl = '<table class="tbl" width="'.$PRC_WIDTH.'%">
- <tr class="r0"><td colspan="2"><b>* DATE DIFFERENCES *</b></td></tr>';
+ <tr class="r0"><td colspan="2"><b>* DATE DIFFERENCES *</b></td></tr>';
$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 "<p>Error->"& $DBI::errstri &"</p>";
-
- 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 .= '<tr class="r1"><td>'. $dt->ymd . '</td>
- </td><td style="text-align:left;">'.$row[1]."</td></tr>".
- '<tr class="r0"><td colspan="2">'.$dif. '</td> </tr>';
- $dt_prev = $dt;
- }
+ foreach (@ids){
+ $stm .= "rowid = '" . $_ ."'";
+ if( \$_ != \$ids[-1] ) {
+ $stm = $stm." OR ";
+ }
+ }
+ $stm .= ';';
+ $st = $db->prepare( $stm );
+ $st->execute() or die or die "<p>Error->"& $DBI::errstri &"</p>";
+
+ 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 .= '<tr class="r1"><td>'. $dt->ymd . '</td>
+ </td><td style="text-align:left;">'.$row[1]."</td></tr>".
+ '<tr class="r0"><td colspan="2">'.$dif. '</td> </tr>';
+ $dt_prev = $dt;
+ }
$tbl .= '</table>';
print '<center><div>'.$tbl.'</div><br><div><a href="main.cgi">Back to Main Log</a></div></center>';
sub dateDiff{
- my($d1,$d2)=@_;
- my $span = DateTime::Format::Human::Duration->new();
- 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 <br>between %s and %s", $dur, boldDate($d1), boldDate($d2));
}
sub boldDate{
- my($d)=@_;
+ my($d)=@_;
return "<b>".$d->ymd."</b> ".$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 "<p>Error->"& $DBI::errstri &"</p>";
- $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 "<p>Error->"& $DBI::errstri &"</p>";
+ $st = $st = $db->prepare("DELETE FROM NOTES WHERE LID = '$id';");
+ $rv = $st->execute();
- if($rv < 0) {
-
print "<p>Error->"& $DBI::errstri &"</p>";
- exit;
- }
-
- }
-
-
- $st->finish;
+ if($rv < 0) {
+ print "<p>Error->"& $DBI::errstri &"</p>";
+ exit;
+ }
+
+ }
+
+
+ $st->finish;
- print $cgi->redirect('main.cgi');
+ print $cgi->redirect('main.cgi');
}
#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 "<p>Error->"& $DBI::errstri &"</p>";
if($rv < 0) {
-
print "<p>Error->"& $DBI::errstri &"</p>";
+ print "<p>Error->"& $DBI::errstri &"</p>";
}
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";
- }
- else{
- $rs = "r1";
- }
- $r_cnt++;
+ 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";
+ }
+ else{
+ $rs = "r1";
+ }
+ $r_cnt++;
}
my $plural = "";
if($r_cnt>1){
- $plural = "s";
+ $plural = "s";
}
$tbl = $tbl . '<tr class="r0"><td colspan="4">
$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 "<font color=red><b>SERVER ERROR</b></font>:".$_;
+ }
+}
+
+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 "<font color=red><b>SERVER ERROR</b></font>:".$_;
- }
}
\ No newline at end of file
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: $!";
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"},
);
+++ /dev/null
-#!/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 "<p>Error->" & $DBI::errstri & "</p>";
-
-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 "<p>Error->" & $DBI::errstri & "</p>";
-
-my $cats = qq(<select class="ui-widget-content" id="ec" name="ec"
- onFocus="showCat();"
- onBlur="helpSelCategory(this);"
- onScroll="helpSelCategory(this);updateSelCategory(this)"
- onChange="updateSelCategory(this)">
- <option value="0">---</option>\n);
-my %hshCats;
-my %desc = {};
-my $c_sel = 1;
-my $cats_v = $cats;
-$cats_v =~ s/\"ec\"/\"vc\"/g;
-
-while ( my @row = $st->fetchrow_array() ) {
- if ( $row[0] == $c_sel ) {
- $cats =
- $cats
- . '<option selected value="'
- . $row[0] . '">'
- . $row[1]
- . '</option>\n';
- }
- else {
- $cats =
- $cats
- . '<option value="'
- . $row[0] . '">'
- . $row[1]
- . '</option>\n';
- }
- if ( $row[0] == $prm_vc ) {
- $cats_v =
- $cats_v
- . '<option selected value="'
- . $row[0] . '">'
- . $row[1]
- . '</option>\n';
- }
- else {
- $cats_v =
- $cats_v
- . '<option value="'
- . $row[0] . '">'
- . $row[1]
- . '</option>\n';
- }
- $hshCats{ $row[0] } = $row[1];
- $desc{ $row[0] } = $row[2];
-}
-
-$cats = $cats . '</select>';
-
-my $cat_descriptions = "";
-for my $key ( keys %desc ) {
- my $kv = $desc{$key};
- if ( $kv ne ".." ) {
- $cat_descriptions .= qq(<li id="$key">$kv</li>\n);
- }
-}
-
-my $tbl =
-qq(<form id="frm_log" action="remove.cgi" onSubmit="return formDelValidation();">
-<table class="tbl" border="0" width="$PRC_WIDTH%">
-<tr class="r0">
- <th class="tbl">Date</th>
- <th class="tbl">Time</th>
- <th class="tbl">Log</th><th>#</th>
- <th class="tbl">Category</th><th>Edit</th>
-</tr>);
-
-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\s+.*?>.*<\/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 "<p>Error->" & $DBI::errstri & "</p>";
-if ( $rv < 0 ) {
- print "<p>Error->" & $DBI::errstri & "</p>";
-}
-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 =~ /<<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>);
- $tags .= qq(<input id="tag$id" type="hidden" value="$log"/>\n);
- $tagged = 1;
- $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"/>);
- if ( !$tagged ) {
- $tags .= qq(<input id="tag$id" type="hidden" value="$log"/>\n);
- }
- $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"/>);
- }
- if ( !$tagged ) {
- $tags .= qq(<input id="tag$id" type="hidden" value="$log"/>\n);
- }
- $log =~ s/<<FRM<(.*?)>/$lnk/o;
- }
- elsif ( $log =~ /<<LIST</ ) {
- my $idx = $-[0];
- my $len = index( $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 .= "<li>$ln</li>" if length($ln)>0;
- }
-
- $log = "<ul>$sub</ul>";
- #$log =~ s/<<LIST<(.*?)>/$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, "<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 );
-
- while ( $log =~ /<<B</ ) {
- my $idx = $-[0];
- my $len = index( $log, '>', $idx ) - 4;
- my $sub = "<b>" . substr( $log, $idx + 4, $len - $idx ) . "</b>";
- $log =~ s/<<B<(.*?)>/$sub/o;
- }
- while ( $log =~ /<<I</ ) {
- my $idx = $-[0];
- my $len = index( $log, '>', $idx ) - 4;
- my $sub = "<i>" . substr( $log, $idx + 4, $len - $idx ) . "</i>";
- $log =~ s/<<I<(.*?)>/$sub/o;
- }
- while ( $log =~ /<<TITLE</ ) {
- my $idx = $-[0];
- my $len = index( $log, '>', $idx ) - 8;
- my $sub = "<h3>" . substr( $log, $idx + 8, $len - $idx ) . "</h3>";
- $log =~ s/<<TITLE<(.*?)>/$sub/o;
- }
-
- #Decode escaped \\n
- $log =~ s/\r\n/<br>/gs;
- $log =~ s/\n/<br>/gs;
-
- if ( $CID_EVENT == $row[1] ) {
- $log = "<font color='#eb4848' style='font-weight:bold'>$log</font>";
- }
- elsif ( 1 == $row[1] ) {
- $log =
-"<font color='midnightblue' style='font-weight:bold;font-style:italic'>$log</font>";
- }
-
- 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(<tr class="r$tfId">
- <td width="15%">$dtf<input id="y$id" type="hidden" value="$dty"/></td>
- <td id="t$id" width="10%" class="tbl">$dth</td>
- <td id="v$id" class="log" width="40%">$log</td>
- <td id="a$id" width="10%" class="tbl">$amm</td>
- <td id="c$id" width="10%" class="tbl">$ct</td>
- <td width="20%">
- <button class="edit" value="Edit" onclick="return edit($id);">Edit</button>
- <input name="chk" type="checkbox" value="$id"/>
- </td>
- </tr>);
- $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 "<p>Error->" & $DBI::errstri & "</p>";
-if ( $rv < 0 ) {
- print "<p>Error->" & $DBI::errstri & "</p>";
-}
-&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 . '<tr><td colspan="5">
- <b>Search Failed to Retrive any records on select: [<i>' . $stmD
- . '</i>] !</b></td></tr>';
- }
- elsif ($rs_keys) {
- my $criter = "";
- if ( $rs_cat_idx > 0 ) {
- $criter = "->Criteria[" . $hshCats{$rs_cat_idx} . "]";
- }
- $tbl = $tbl . qq(<tr><td colspan="5">
- <b>Search Failed to Retrive any records on keywords: [<i>$rs_keys</i>]$criter!</b></td>
- </tr>);
- }
- else {
- $tbl = $tbl
- . '<tr><td colspan="5"><b>Database is New or Empty!</b></td></tr>\n';
- }
-}
-
-$tbl .=
-'<tr class="r0"><td><a id="menu_close" href="#" onclick="return showFloatingMenu();"><span class="ui-icon ui-icon-heart"></span></a>
-<a href="#top">↟</a></td><td colspan="5" align="right">
-<input type="hidden" name="datediff" id="datediff" value="0"/>
-<input type="submit" value="Date Diff Selected" onclick="return dateDiffSelected()"/>
-<button onclick="return selectAllLogs()">Select All</button>
-<input type="reset" value="Unselect All"/>
-<input id="del_sel" type="submit" value="Delete Selected"/>
-</td></tr></form>
-<tr class="r0"><form id="frm_srch" action="main.cgi"><td><b>Keywords:</b></td><td colspan="4" align="left">
-<input id="rs_keys2" name="keywords" type="text" size="60"/></td>
-<td><input type="submit" value="Search"/></form></td></tr>
-</table>';
-my $COLLAPSED_LOG = 's';
-my ($sp1,$sp2);
-$sp1 = '<span class="ui-icon ui-icon-heart" style="float:right;"></span>';
-$sp2 = qq(<span class="ui-icon ui-icon-circle-triangle-$COLLAPSED_LOG" style="float:right;"></span>);
-
-
-my $frm = qq(<a name="top"></a>
-<form id="frm_entry" action="main.cgi" onSubmit="return formValidation();">
- <table class="tbl" border="0" width="$PRC_WIDTH%">
- <tr class="r0"><td colspan="3"><b>* LOG ENTRY FORM *</b>
- <a id="log_close" href="#" onclick="return hideLog();">$sp1</a>
- <a id="log_close" href="#" onclick="return toggleLog();">$sp2</a>
- </td></tr>
- <tr class="collpsd">
- <td style="text-align:right; vertical-align:top; width:10%;">Date:</td>
- <td id="al" colspan="1" style="text-align:top; vertical-align:top"><input id="ed" type="text" name="date" size="18" value=")
- . $today->ymd . " "
- . $today->hms . qq(">
-
- <button type="button" onclick="return setNow();">Now</button>
- <button type="reset">Reset</button></td>
- <td style="text-align:top; vertical-align:top">Category:
-$cats
- <br><br><div id="cat_desc" name="cat_desc"></div>
- </td>
- </tr>
- <tr class="collpsd"><td style="text-align:right; vertical-align:top">Log:</td>
- <td id="al" colspan="2" style="text-align:top;">
- <textarea id="el" name="log" rows="3" style="float:left; width:99%;" onChange="toggleVisibility('cat_desc',true)"></textarea>
- </td>
- </tr>
- <tr class="collpsd"><td style="text-align:right"><a id="to_bottom" href="#bottom" title="Go to bottom of page.">↡</a> Ammount:</td>
- <td id="al">
- <input id="am" name="am" type="number" step="any"> <input id="RTF" type="checkbox" value="0" onclick="return toggleDocument();"> RTF Document</input>
- </td>
- <td align="right">
- <div style="float: right;"><button id="btn_srch" onclick="toggleSearch(); return false;">Show Search</button>
- <input id="log_submit" type="submit" onclick="saveRTF(); return true;" value="Submit"/></div>
- </td>
- </tr>
- <tr class="collpsd"><td colspan="3"></td></tr>
- </table>
- <input type="hidden" name="submit_is_edit" id="submit_is_edit" value="0"/>
- <input type="hidden" name="submit_is_view" id="submit_is_view" value="0"/>
- <input type="hidden" name="rs_all" value="0"/>
- <input type="hidden" name="rs_cur" value="0"/>
- <input type="hidden" name="rs_prev" value="$tbl_rc_prev"/>
- <input type="hidden" name="rs_page" value="$rs_page"/>
- <input type="hidden" name="CGISESSID" value="$sid"/>
- $tags</form>
- );
-
-my $srh = qq(
- <form id="frm_srch" action="main.cgi">
- <table class="tbl" border="0" width="$PRC_WIDTH%">
- <tr class="r0"><td colspan="4"><b>Search/View By</b>
- <a id="srch_close" href="#" onclick="return hideSrch();">$sp1</a>
- <a id="srch_close" href="#" onclick="return toggleSrch();">$sp2</a>
-
- </td></tr>
- );
-
-$srh .=
-qq(<tr class="collpsd"><td align="right"><b>View by Category:</b></td>
- <td align="left" colspan="2">$cats_v</td><td><button id="btn_cat" onclick="viewByCategory(this);" style="float:left">View</button>
- <input id="idx_cat" name="category" type="hidden" value="0"></td>
- </tr>
- <tr class="collpsd"><td align="right"><b>View by Date:</b></td>
- <td align="left">
- From: <input name="v_from" type="text" size="16"/></td><td align="left">
- To: <input name="v_to" type="text" size="16"/>
- <td align="left"><button id="btn_dat" onclick="viewByDate(this);">View</button></td>
- </tr>
- <tr class="collpsd"><td align="right"><b>Keywords:</b></td>
- <td colspan="2" align="left">
- <input id="rs_keys" name="keywords" type="text" size="60" value="$rs_keys"/></td>
- <td align="left"><input type="submit" value="Search" align="left"></td></tr>);
-
-if ( $rs_keys || $rs_cat_idx || $stmD ) {
- $srh .= '<tr class="collpsd"><td align="left" colspan="3"></td>
- <td><button onClick="resetView()" stule="align:left">Reset Whole View</button></td></tr>';
-}
-
-$srh .= '</table></form>';
-my $quill = &quill();
-#
-#Page printout from here!
-#
-print qq(<center>\n
-<div id="menu" title="To close this menu click on its heart, and wait.">
-<div class="hdr" style="marging=0;padding:0px;">
-<a id="to_top" href="#top" title="Go to top of page."><span class="ui-icon ui-icon-arrowthick-1-n"></span></a>
-<a id="to_bottom" href="#bottom" title="Go to bottom of page."><span class="ui-icon ui-icon-arrowthick-1-s"></span></a>
-<a id="menu_close" href="#" onclick="return hideLog();"><span class="ui-icon ui-icon-heart"></span></a>
-</div>
-<hr>
-<a class="a_" href="stats.cgi">Stats</a><hr>
-<a class="a_" href="config.cgi">Config</a><hr>
-<a class="a_" onclick="deleteSelected(); return false;">Delete</a><hr>
-<a class="a_" onclick="toggleSearch(this); return false;">Search</a><hr>
-<br>
-<a class="a_" href="login_ctr.cgi?logout=bye">LOGOUT</a>
-</div>
-
- <div id="div_log">\n$frm\n</div>\n
- <div id="div_srh">$srh</div>
- $quill
- <div>\n$tbl\n</div><br>
- <div><a class="a_" href="stats.cgi">View Statistics</a></div><br>
- <div><a class="a_" href="config.cgi">Configure Log</a></div><hr>
- <div><a class="a_" href="login_ctr.cgi?logout=bye">LOGOUT</a><hr><a name="bottom"/></div>
- );
-print qq(</center>
- <ul id="cat_lst">
- $cat_descriptions
- </ul>
- <script type="text/javascript">
- \$( function() {
- var tags = [$autowords];
- \$( "#rs_keys, #rs_keys2" ).autocomplete({
- source: tags
- });
- });
- </script>
-
- );
-
-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 "<font color=red><b>SERVER ERROR</b></font>date:$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('<b>Insert is in the past!</b>');
-
- #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!<tr class="r$tfId"><td></td>!;
-
- if ( $rs_prev && $rs_prev > 0 && $tbl_start > 0 && $rs_page > 0 ) {
-
- $tbl = $tbl . qq!<td><input type="hidden" value="$rs_prev"/>
- <input type="button" onclick="submitPrev($rs_prev);return false;"
- value="‹‹– Previous"/></td>!;
-
- }
- else {
- $tbl .= '<td><i>Top</i></td>';
- }
-
- $tbl .=
-'<td colspan="1"><input type="button" onclick="viewAll();return false;" value="View All"/></td>';
-
- if ( $is_end_of_rs == 1 ) {
- $tbl = $tbl . '<td><i>End</i></td>';
- }
- else {
-
- $tbl .=
-qq!<td><input type="button" onclick="submitNext($tbl_cur_id);return false;"
- value="Next –››"/></td>!;
-
- }
-
- $tbl = $tbl . '<td colspan="2"></td></tr>';
-}
-
-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("<b>Access Denied!</b> 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, "<img" ) > -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 "<font color=red><b>SERVER ERROR</b></font>:" . $_;
- }
-}
-
-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 "<font color=red><b>SERVER ERROR</b></font>:" . $_;
- }
-}
-
-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{
-
-
-<table id="tbl_doc" class="tbl" width="$PRC_WIDTH%" style="border:1; margin-top: 5px;"><tr><td>
- <div id="toolbar-container">
- <span class="ql-formats">
- <select class="ql-font"></select>
- <select class="ql-size"></select>
- </span>
- <span class="ql-formats">
- <button class="ql-bold"></button>
- <button class="ql-italic"></button>
- <button class="ql-underline"></button>
- <button class="ql-strike"></button>
- </span>
- <span class="ql-formats">
- <select class="ql-color"></select>
- <select class="ql-background"></select>
- </span>
- <span class="ql-formats">
- <button class="ql-script" value="sub"></button>
- <button class="ql-script" value="super"></button>
- </span>
- <span class="ql-formats">
- <button class="ql-header" value="1"></button>
- <button class="ql-header" value="2"></button>
- <button class="ql-blockquote"></button>
- <button class="ql-code-block"></button>
- </span>
- <span class="ql-formats">
- <button class="ql-list" value="ordered"></button>
- <button class="ql-list" value="bullet"></button>
- <button class="ql-indent" value="-1"></button>
- <button class="ql-indent" value="+1"></button>
- </span>
- <span class="ql-formats">
- <button class="ql-direction" value="rtl"></button>
- <select class="ql-align"></select>
- </span>
- <span class="ql-formats">
- <button class="ql-link"></button>
- <button class="ql-image"></button>
- <button class="ql-video"></button>
- <button class="ql-formula"></button>
- </span>
- <span class="ql-formats">
- <button class="ql-clean"></button>
- </span>
- </div>
- <div id="editor-container"></div>
- </td></tr></table>
-
-}
-}
\ No newline at end of file
lifelog.hopto.org / LifeLog.git / commitdiff