From: Will Budic Date: Tue, 18 Feb 2020 08:48:11 +0000 (+1100) Subject: Exception handling changes. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=d656514b9e06219bb33fbc3af079b300c0659802;p=LifeLog.git Exception handling changes. --- diff --git a/Current Development Check List.md b/Current Development Check List.md index 67da500..75b1a08 100644 --- a/Current Development Check List.md +++ b/Current Development Check List.md @@ -9,7 +9,19 @@ This version is not compatible in data structure to prior versions. Data migrati ### v.1.7 Encountered +* ✔Change all code to use Exceptions as project is becoming hard to manage. + * The harder it is to foresee possible problems, the less likely you will add unnecessary complexity. -- bud@ +* ✔ Notes to Log table should be other way in relationship direction. + * LOG.ID_RTF -> NOTES.rowid + * This is currently causing problems when the log renumerates, or entries are imported. +* Database backup tar ball, download button on config page. +* New Categories dropdown, grouping in ascending order and presenting in columns of five at a time. * New CNF Development. + * Migration is currently hard to maintain and data export and import is wrongly reliant to CVS. + * CVS imports are to be made obsolete in the future. +* ✔ In config page Categories section to appear after system settings. As less likelly to be changed. + * System Configuration section is to be sorted. As in future it is more likelly to grow. +* ✔ New system setting, $VIEW_ALL_LMT=1000. To limit view all records displayed on huge databases. * ✔ Provide system logs on stats page runs. * ✔ Menus updated in other pages to have button look. * ✔ main.cnf newer versions should have precedence to id and entry name to previously set or stored in db. @@ -20,8 +32,6 @@ This version is not compatible in data structure to prior versions. Data migrati * ✔ Mutli new alias access flood attack security trigger implementation. * ✔ Debug system settings implementaiton. * ✔ Delete page updated to show better display of entries. -* Provide sub alias login that sets data visible to only a set of categories. - * View specific based login on a different password. * ✔ Login page to indentify host. * ✔ Session cleanup on autologin not clearing properly. * A dbfix, should clear older entries as well. @@ -41,7 +51,9 @@ This version is not compatible in data structure to prior versions. Data migrati ## Planned New Possible Features of Minor Relevance -* Table sort in config system settings by variable name. +* Provide sub alias login that sets data visible to only a set of categories. + * View specific based login on a different password. +* ✔ Table sort in config system settings by variable name. * Enable automatic bold title heading for specified cattegories. * Theme colours to be revisited, bettered * Enable file attachment to log entries. @@ -56,12 +68,14 @@ This version is not compatible in data structure to prior versions. Data migrati ## Bugs ### v. 1.8 Encountered/Fixed -* Bug 17 - Editimg of entries on occasions, duplicates entries. -* Bug 16 - Saving new log entries with rtf overides previous log entries rtf. -* ✔ Issue 15 Date diff, showes upside down first range by current date with multiple selections. +* ✔ Issue 18 - Setting excludes for views, deliveres page but long delays with server finished exchange (page doesn't hang). + * The page is server delivered, if sections contain external internet links, this timeouts page browser delivery if the internet is down. +* ✔ Bug 17 - Editimg of entries on occasions, duplicates entries. +* ✔ Bug 16 - Saving new log entries with rtf overides previous log entries rtf. + * Issue 16.1 - Currently importing of records linked to rtf notes is not supported. +* ✔ Issue 15 Date diff, showes upside down first range by current date with multiple selections. * Range should be selected from date in selected latest to current date last as inbetween difference. - * ✔ Issue 14 Subpages pages links to main, restart main page session counter, making the main page fully usable. * Not really a bug. Session will expire but time remaining will be displayed wrong on the main page. * All subpages need either to inherit the counter, and jump user to the login screen if expired. diff --git a/Installation.txt b/Installation.txt index 80108d7..87e31cc 100644 --- a/Installation.txt +++ b/Installation.txt @@ -8,7 +8,7 @@ -- Note - Perl and some modules might take time to install as their fetched and tested for your computer. - + ## Install tiny thttpd web server. ## @@ -65,7 +65,7 @@ git clone https://github.com/wbudic/LifeLog.git -#Install cpanm to make installing other modules easier (you'll thank us later). +#Install cpanm to make installing other modules easier (you'll thank us later). #You need to type these commands into a Terminal emulator (Mac OS X, Win32, Linux) sudo apt install cpanminus @@ -105,24 +105,29 @@ NOTICE -> Above Perl installation and modules can take time as they build (compi -# LifeLOg Required Perl modules. - -sudo cpanm DateTime; -sudo cpanm DateTime::Format::Human::Duration -sudo cpanm DateTime::Format::SQLite; -sudo cpanm Text::CSV; -sudo cpanm Number::Bytes::Human; -sudo cpanm CGI::Session; -sudo cpanm Try::Tiny; -sudo cpanm Number/Bytes/Human.pm; -sudo cpanm Regexp::Common; -sudo cpanm JSON; -sudo cpanm Switch; -sudo cpanm install IPC::Run +# LifeLog Required Perl modules. + +### +# since 1.8 switched to: +# before was -> sudo cpanm Try::Tiny; +sudo cpan Log::Log4per +sudo cpan Syntax::Keyword::Try + +sudo cpan DateTime; +sudo cpan DateTime::Format::Human::Duration +sudo cpan DateTime::Format::SQLite; +sudo cpan Text::CSV; +sudo cpan Number::Bytes::Human; +sudo cpan CGI::Session; +sudo cpan Number/Bytes/Human.pm; +sudo cpan Regexp::Common; +sudo cpan JSON; +sudo cpan Switch; +sudo cpan install IPC::Run #Install DBI module -sudo cpanm DBI; -sudo cpanm DBD::SQLite; +sudo cpan DBI; +sudo cpan DBD::SQLite; #Final Perl Installation Notes @@ -130,7 +135,7 @@ This perl setup might take time and efforts. But, it is worth it. You get it build and tested professionally, based on your hardware. Platforms supported, Windows, Unix (all), Mac. -Installing perl as an developer, requires no sudo. +Installing perl as an developer, requires no sudo. But hence can't run server (system level) like. If developer and running perlbrew, recommended is to use @@ -145,7 +150,7 @@ cd /home/{user}/thttpd_dev/dbLifeLog sqlite3 -csv data_log.db "select * from LOG;" > current_log.csv ##Install LifeLog Independently -cd /home/{user}/ +cd /home/{user}/ git clone https://github.com/wbudic/LifeLog mkdir /home/{user}/thttpd_dev/dbLifeLog chmod +x /home/{user}/thttpd_dev/cgi-bin/*.cgi @@ -157,7 +162,7 @@ Access the webserver cgi-bin. http://localhost:8080/cgi-bin/main.cgi (this might redirect to login.cgi or config.cgi in the future) ##Install LifeLog Dependably (not automatic, manual developer way) -cd /home/{user}/ +cd /home/{user}/ git clone https://github.com/wbudic/LifeLog run thttpd with: cd LifeLog; ./startDevWebServer.sh @@ -168,7 +173,7 @@ Once created you must import the from above example current_log.csv cd /home/{user}/thttpd_dev/dbLifeLog see: http://www.sqlitetutorial.net/sqlite-import-csv/ -Example (data_dev1_2_log.db would be created as the latest version by the CGI created): +Example (data_dev1_2_log.db would be created as the latest version by the CGI created): cd /home/{user}/thttpd_dev/dbLifeLog sqlite3 data_dev1_2_log.db sqlite> .mode csv @@ -189,7 +194,7 @@ can be installed to start on reboot. sudo cp startDevWebServer.sh /etc/init.d/ -Modify the following to the path of your development environment +Modify the following to the path of your development environment where thttpd.conf file is in /etc/init.d/startDevWebServer.sh Modify line -> cd /home/will/thttpd_dev @@ -225,7 +230,7 @@ You can export and modify your added categories via an CSV file. Making sure the ID first column across all entries has a unique number. #Install AUTO_LOGIN -On a personal network or small network, you might prefere to auto login when browsing to the LifeLog, +On a personal network or small network, you might prefere to auto login when browsing to the LifeLog, instead of entering every time user name and password. It makese sense, as you are the only one using it, don't need that extra security. diff --git a/htdocs/cgi-bin/config.cgi b/htdocs/cgi-bin/config.cgi index 4b0b4d8..d6983e0 100755 --- a/htdocs/cgi-bin/config.cgi +++ b/htdocs/cgi-bin/config.cgi @@ -5,13 +5,14 @@ # use strict; use warnings; -use Try::Tiny; use Switch; use CGI; use CGI::Session '-ip_match'; use CGI::Carp qw ( fatalsToBrowser ); use DBI; +use Exception::Class ('LifeLogException'); +use Syntax::Keyword::Try; use DateTime; use DateTime::Format::SQLite; @@ -24,9 +25,6 @@ use lib "system/modules"; require Settings; ## -#This is the OS developer release key, replace on istallation. As it is not secure. -my $cipher_key = '95d7a85ba891da'; - #15mg data post limit $CGI::POST_MAX = 1024 * 15000; my ($LOGOUT,$ERROR) = (0,""); @@ -35,8 +33,8 @@ my $session = new CGI::Session("driver:File", $cgi, {Directory=>&Settings::logPa my $sid=$session->id(); my $dbname =$session->param('database'); my $userid =$session->param('alias'); -my $password=$session->param('passw'); -my $sys = `uname -n`; +my $pass =$session->param('passw'); +my $sys = `uname -n`; #my $acumululator=""; if(!$userid||!$dbname){ @@ -46,7 +44,7 @@ if(!$userid||!$dbname){ my $database = &Settings::logPath.$dbname; my $dsn= "DBI:SQLite:dbname=$database"; -my $db = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die "

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

"; +my $db = DBI->connect($dsn, $userid, $pass, { RaiseError => 1 }) or die "

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

"; ### Fetch settings Settings::getConfiguration($db); @@ -95,10 +93,10 @@ print qq(
Stats
Log
Jump to Sections
-Categories
+Categories
System
DB Fix
-Password +Pass

@@ -110,7 +108,7 @@ my $tbl = ' '; -$dbs = dbExecute($stmtCat); +$dbs = Settings::selectRecords($db, $stmtCat); while(my @row = $dbs->fetchrow_array()) { if($row[0]>0){ $tbl .= ' @@ -120,7 +118,7 @@ while(my @row = $dbs->fetchrow_array()) { } } -my $frm = qq( +my $frmCats = qq( ).$tbl.qq( @@ -128,7 +126,7 @@ my $frm = qq( - + @@ -147,12 +145,11 @@ $tbl = qq(
* CATEGORIES CONFIGURATION *
IDCategoryDescription
'.$row[0].'
↡   ↡    or Categories Configuration In -> $dbname 
- + ); -my $stm = 'SELECT ID, NAME, VALUE, DESCRIPTION FROM CONFIG;'; -$dbs = $db->prepare( $stm ); -$rv = $dbs->execute() or die or die "

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

"; +my $stm = 'SELECT ID, NAME, VALUE, DESCRIPTION FROM CONFIG ORDER BY NAME;'; +$dbs = Settings::selectRecords($db, $stm ); while(my @row = $dbs->fetchrow_array()) { @@ -305,8 +302,7 @@ my $frmVars = qq( - -
Variable ValueDescriptionDescription
System Settings In -> $dbname 

); +
); @@ -332,33 +328,31 @@ my $frmDB = qq( WARNING! Checking any of the above extra actions will cause loss of your changes. Please, export/backup first. - -
+
); $tbl = qq( - + ); my $frmPASS = qq( $tbl - - - + + + - + - -
* CHANGE PASSWORD *
* CHANGE PASS *
Existing:
New:
Confirmation:
Existing:
New:
Confirmation:
Password change for -> $userid Pass change for -> $userid 

+
); # -#Page printout from here! +# Page printout from here! # print qq(
-
$frm
$frmVars
+
$frmCats
$frmDB
$frmPASS
@@ -366,20 +360,20 @@ print qq(

+
- + - -); + ); my $sss_checked = 'checked' if &isInViewMode; my $divxc = ''; if(@xc_lst){#Do list of excludes, past from browser in form of category id's. @@ -860,7 +855,6 @@ _TXT # Page printout from here! # ################################ - print qq( +$tbl .=qq( @@ -171,16 +151,27 @@ print qq( 
$processes
); print $cgi->end_html; -my $date = DateTime::Format::SQLite->parse_datetime($today); -dbExecute(qq( INSERT INTO LOG (ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY) VALUES(6, '$date', '$syslog', 0, 0, 0, 0); )); + +&Settings::toLog($db,$syslog); $db->disconnect(); + +} + catch { + my $err = $@; + my $pwd = `pwd`; + $pwd =~ s/\s*$//; + print $cgi->header, + "SERVER ERROR on ".DateTime->now. + "
".$pwd."/$0 -> &".caller." -> [$err]","\n
", + $cgi->end_html; + }; + + exit; -sub selectSQL{ - my ($sth,$ret) = dbExecute( @_ ); - my @row = $sth->fetchrow_array(); - $sth->finish; - $ret = $row[0]; +sub selectSQL { + my @row = Settings::selectRecords($db, shift)->fetchrow_array(); + my $ret = $row[0]; $ret = 0 if !$ret; return $ret; } @@ -201,27 +192,4 @@ sub camm { return $amm; } -sub getConfiguration { - try{ - my $st = dbExecute('SELECT ID, NAME, VALUE FROM CONFIG;'); - while (my @r=$st->fetchrow_array()){ - switch ($r[1]) { - case "RELEASE_VER" { $RELEASE_VER = $r[2] } - case "THEME" {$THEME= $r[2]} - } - } - } - catch{ - print "SERVER ERROR:".$_; - } - -} - -sub dbExecute{ - my $ret = $db->prepare(shift); - $ret->execute() or die "

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

"; - return $ret; -} - - -### CGI END \ No newline at end of file +1. \ No newline at end of file diff --git a/htdocs/cgi-bin/system/modules/Settings.pm b/htdocs/cgi-bin/system/modules/Settings.pm index 0818d0c..90d8996 100644 --- a/htdocs/cgi-bin/system/modules/Settings.pm +++ b/htdocs/cgi-bin/system/modules/Settings.pm @@ -8,12 +8,17 @@ package Settings; use strict; use warnings; use Switch; +use Exception::Class ('SettingsException'); +use Syntax::Keyword::Try; use DBI; +#This is the default developer release key, replace on istallation. As it is not secure. +use constant CIPHER_KEY => '95d7a85ba891da'; + + #DEFAULT SETTINGS HERE! -our $RELEASE_VER = '1.7'; -our $REC_LIMIT = 25; +our $RELEASE_VER = '1.8'; our $TIME_ZONE = 'Australia/Sydney'; our $LANGUAGE = 'English'; our $PRC_WIDTH = '60'; @@ -22,7 +27,9 @@ our $SESSN_EXPR = '+30m'; our $DATE_UNI = '0'; our $AUTHORITY = ''; our $IMG_W_H = '210x120'; +our $REC_LIMIT = 25; our $AUTO_WRD_LMT = 1000; +our $VIEW_ALL_LMT = 1000; our $FRAME_SIZE = 0; our $RTF_SIZE = 0; our $THEME = 'Standard'; @@ -32,17 +39,14 @@ our $KEEP_EXCS = 0; our $TH_CSS = 'main.css'; our $BGCOL = '#c8fff8'; #Set to 1 to get debug help. Switch off with 0. -our $DEBUG = 0; +our $DEBUG = 1; #END OF SETTINGS - ### Private Settings sofar (id -> name : def.value): #200 -> '^REL_RENUM' : this.$RELEASE_VER (Used in login_ctr.cgi) #201 -> '^EXCLUDES' : 0 (Used in main.cgi) - - - +##Not to be used, Settings are static. sub new { return bless {}, shift; } @@ -54,16 +58,64 @@ sub timezone {return $TIME_ZONE;} sub sessionExprs {return $SESSN_EXPR;} sub imgWidthHeight {return $IMG_W_H;} sub pagePrcWidth {return $PRC_WIDTH;} -sub recordLimit {return $REC_LIMIT;} sub frameSize {return $FRAME_SIZE;} sub universalDate {return $DATE_UNI;} +sub recordLimit {return $REC_LIMIT;} sub autoWordLimit {return $AUTO_WRD_LMT;} +sub viewAllLimit {return $VIEW_ALL_LMT;} sub windowRTFSize {return $RTF_SIZE;} sub keepExcludes {return $KEEP_EXCS;} sub bgcol {return $BGCOL;} sub css {return $TH_CSS;} sub debug {my $ret=shift; if($ret){$DEBUG = $ret;}; return $DEBUG;} +sub createCONFIGStmt { +return 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); +)} +sub createLOGStmt { +return qq( + CREATE TABLE LOG ( + ID_CAT TINY NOT NULL, + ID_RTF INTEGER DEFAULT 0, + DATE DATETIME NOT NULL, + LOG VCHAR (128) NOT NULL, + AMOUNT INTEGER, + AFLAG TINY DEFAULT 0, + STICKY BOOL DEFAULT 0 + ); +)} +sub createVW_LOGStmt { +return qq( +CREATE VIEW VW_LOG AS + SELECT rowid as ID,*, (select count(rowid) from LOG as recount where a.rowid >= recount.rowid) as PID + FROM LOG as a ORDER BY DATE DESC;' +)} +sub createCATStmt { +return qq( + CREATE TABLE CAT( + ID TINY PRIMARY KEY NOT NULL, + NAME VCHAR(16), + DESCRIPTION VCHAR(64) + ); + CREATE INDEX idx_cat_name ON CAT (NAME); +)} +sub createAUTHStmt { +return 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); +)} sub getConfiguration { @@ -76,14 +128,15 @@ sub getConfiguration { switch ( $r[1] ) { 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 "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 "REC_LIMIT" { $REC_LIMIT = $r[2] } case "AUTO_WRD_LMT" { $AUTO_WRD_LMT = $r[2] } + case "VIEW_ALL_LMT" { $VIEW_ALL_LMT = $r[2] } case "FRAME_SIZE" { $FRAME_SIZE = $r[2] } case "RTF_SIZE" { $RTF_SIZE = $r[2] } case "THEME" { $THEME = $r[2] } @@ -116,52 +169,69 @@ sub getTheme { } + +#From v.1.8 Changed sub renumerate { my $db = shift; #Renumerate Log! Copy into temp. table. my $sql; - my $dbs = dbExecute($db, 'CREATE TABLE life_log_temp_table AS SELECT * FROM LOG;'); - $dbs = dbExecute($db, 'SELECT rowid, DATE FROM LOG WHERE RTF == 1 ORDER BY DATE;'); - #update notes with new log id - while(my @row = $dbs->fetchrow_array()) { + selectRecords($db, 'CREATE TABLE life_log_temp_table AS SELECT * FROM LOG;'); + #update notes table with new log id only for reference sake. + my $st = selectRecords($db, 'SELECT rowid, DATE FROM LOG WHERE ID_RTF > 0 ORDER BY DATE;'); + while(my @row =$st->fetchrow_array()) { my $sql_date = $row[1]; #$sql_date =~ s/T/ /; $sql_date = DateTime::Format::SQLite->parse_datetime($sql_date); - $sql = "SELECT rowid, DATE FROM life_log_temp_table WHERE RTF = 1 AND DATE = '".$sql_date."';"; - $dbs = dbExecute($db, $sql); - my @new = $dbs->fetchrow_array(); + $sql = "SELECT rowid, DATE FROM life_log_temp_table WHERE ID_RTF > 0 AND DATE = '".$sql_date."';"; + my @new = selectRecords($db, $sql); if(scalar @new > 0){ $db->do("UPDATE NOTES SET LID =". $new[0]." WHERE LID==".$row[0].";"); } } - # Delete Orphaned Notes entries. - $dbs = dbExecute($db, "SELECT LID, LOG.rowid from NOTES LEFT JOIN LOG ON + # Delete any possible orphaned Notes records. + $st = selectRecords($db, "SELECT LID, LOG.rowid from NOTES LEFT JOIN LOG ON NOTES.LID = LOG.rowid WHERE LOG.rowid is NULL;"); - while(my @row = $dbs->fetchrow_array()) { - $db->do("DELETE FROM NOTES WHERE LID=$row[0];"); + while($st->fetchrow_array()) { + $db->do("DELETE FROM NOTES WHERE LID=".$_[0].";") } - $dbs = dbExecute($db, 'DROP TABLE LOG;'); - $dbs = dbExecute($db, qq(CREATE TABLE LOG ( - ID_CAT TINY NOT NULL, - DATE DATETIME NOT NULL, - LOG VCHAR (128) NOT NULL, - AMOUNT INTEGER, - AFLAG TINY DEFAULT 0, - RTF BOOL DEFAULT 0, - STICKY BOOL DEFAULT 0 - );)); - $dbs = dbExecute($db, 'INSERT INTO LOG (ID_CAT,DATE,LOG,AMOUNT,AFLAG, RTF) - SELECT ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF - FROM life_log_temp_table ORDER by DATE;'); - $dbs = dbExecute($db, 'DROP TABLE life_log_temp_table;'); + $db->do('DROP TABLE LOG;'); + $db->do(&createLOGStmt); + $db->do('INSERT INTO LOG (ID_CAT, ID_RTF, DATE, LOG, AMOUNT,AFLAG) + SELECT ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG FROM life_log_temp_table ORDER by DATE;'); + $db->do('DROP TABLE life_log_temp_table;'); } -sub dbExecute { - my ($db,$sql) = @_; - my $ret = $db->prepare($sql); - $ret->execute() or die "

ERROR with->$sql

"; - return $ret; +sub selectRecords { + my ($db, $sql) = @_; + if(scalar(@_) < 2){ + SettingsException->throw("ERROR Argument number is wrong->db is:$db\n", show_trace=>$DEBUG); + } + try{ + my $pst = $db->prepare($sql); + $pst->execute() or SettingsException->throw("

ERROR with->$sql

", show_trace=>$DEBUG); + return 0 if(!$pst); + return $pst; + }catch{ + SettingsException->throw(error=>"Database error encountered.", show_trace=>$DEBUG); + } +} + +sub getTableColumnNames { + my ($db, $table_name) = @_; + if(scalar(@_) < 2){ + SettingsException->throw("ERROR Argument number is wrong->db is:$db\n", show_trace=>$DEBUG); + } + try{ + my $pst = selectRecords($db, "SELECT name FROM PRAGMA_table_info('$table_name');"); + my @ret = (); + while(my @r = $pst->fetchrow_array()){ + push @ret, $r[0]; + } + return \@ret; + }catch{ + SettingsException->throw(error=>"Database error encountered.", show_trace=>$DEBUG); + } } sub printDebugHTML { @@ -170,15 +240,33 @@ sub printDebugHTML { } sub toLog { - my ($db,$stamp,$log) = @_; - # try { - #Apostrophe in the log value is doubled to avoid SQL errors. - $log =~ s/'/''/g; - $db->do("INSERT INTO LOG (ID_CAT, DATE, LOG) VALUES(6,'$stamp', \"$log\");"); - # } - # catch { - # print "SERVER ERROR toLog(6,$stamp,$log):" . $_; - # } + my ($db,$log,$cat) = @_; + my $stamp = getCurrentSQLTimeStamp(); + if(!$cat){ + $cat = selectRecords($db,"SELECT ID FROM CAT WHERE name == 'System Log';")->fetchrow_array(); + $cat = 0 if not $cat; + } + $log =~ s/'/''/g; + $db->do("INSERT INTO LOG (ID_CAT, DATE, LOG) VALUES(6,'$stamp', \"$log\");"); +} + +sub countRecordsIn { + my ($db,$name) = @_; + if(scalar(@_) < 2){ + SettingsException->throw("ERROR Argument number is wrong.name:$name\n", show_trace=>$DEBUG); + } + my $ret = selectRecords($db, "SELECT count(ID) FROM $name;"); + if($ret){ + $ret ->fetchrow_array(); + $ret = 0 if not $ret; + } + return $ret; +} + +sub getCurrentSQLTimeStamp { + my $dat = DateTime->now; + $dat -> set_time_zone(timezone()); + return DateTime::Format::SQLite->format_datetime($dat); } sub removeOldSessions { @@ -195,30 +283,34 @@ sub removeOldSessions { } -#TODO move this subroutine to settings. + sub obtainProperty { my($db, $name) = @_; - die "Invalid use of subroutine obtainProperty($db, $name)" if(!$db || !$name); - my $dbs = Settings::dbExecute($db, "SELECT ID, VALUE FROM CONFIG WHERE NAME IS '$name';"); + SettingsException->throw("Invalid use of subroutine obtainProperty($db, $name)", show_trace=>$DEBUG) if(!$db || !$name); + my $dbs = selectRecords($db, "SELECT ID, VALUE FROM CONFIG WHERE NAME IS '$name';"); my @row = $dbs->fetchrow_array(); if(scalar @row > 0){ return $row[1]; - } - else{ + } + else{ return 0; - } + } } -#TODO move this subroutine to settings. + sub configProperty { my($db, $id, $name, $value) = @_; - die "Invalid use of subroutine configProperty($db,$name,$value)" if(!$db || !$name|| !$value); - - my $dbs = Settings::dbExecute($db, "SELECT ID, NAME FROM CONFIG WHERE NAME IS '$name';"); + $id = '0' if not $id; + if(!$db || !$name|| not defined $value){ + SettingsException->throw( + error => "ERROR Invalid number of arguments in call -> Settings::configProperty('$db',$id,'$name','$value')\n", show_trace=>$DEBUG + ); + }; + my $dbs = selectRecords($db, "SELECT ID, NAME FROM CONFIG WHERE NAME IS '$name';"); if($dbs->fetchrow_array()){ - Settings::dbExecute($db, "UPDATE CONFIG SET VALUE = '$value' WHERE NAME IS '$name';"); + $db->do("UPDATE CONFIG SET VALUE = '$value' WHERE NAME IS '$name';"); } else{ - Settings::dbExecute($db,"INSERT INTO CONFIG (ID, NAME, VALUE) VALUES ($id, '$name', '$value');"); + $db->do("INSERT INTO CONFIG (ID, NAME, VALUE) VALUES ($id, '$name', '$value');"); } }

CSV File Format

Import Categories:
Export Categories:  
Import Log:
@@ -401,22 +395,22 @@ print qq( for your logs HTML layout.

- <<B<{Text To Bold}> + <<B<{Text To Bold}>>

- <<I<{Text To Italic}> + <<I<{Text To Italic}>>

- <<TITLE<{Title Text}> + <<TITLE<{Title Text}>>

- <<LIST<{List of items delimited by new line to terminate item or with '~' otherwise.}> + <<LIST<{List of items delimited by new line to terminate item or with '~' otherwise.}>>

- <<IMG<{url to image}> + <<IMG<{url to image}>>

- <<FRM<{file name}_frm.png}>

+ <<FRM<{file name}_frm.png}>>

*_frm.png images file pairs are located in the ./images folder of the cgi-bin directory.
These are manually resized by the user. Next to the original. Otherwise considered as stand alone icons. *_frm.png Image resized to -> width="210" height="120" @@ -428,22 +422,20 @@ print qq( For log entry, place: - <<FRM>my_cat_simon_frm.png> <<TITLE<Simon The Cat> + <<FRM>my_cat_simon_frm.png> <<TITLE<Simon The Cat>> This is my pet, can you hold him for a week while I am on holiday? - +

-

- <<LNK<{url to image}>

+ +

<<LNK<{url to image}>>

+

Explicitly tag an URL in the log entry. Required if using in log IMG or FRM tags. Otherwise link appears as plain text.

-

Log Page Particulars

↟ or ↡ - Jump links to top or bottom of page respectivelly. -

- ↟
@@ -507,23 +499,20 @@ my $del_date_from = $cgi->param("date_from"); my ($s, $d); try{ - -$dbs = $db->prepare( $stmtCat ); -$rv = $dbs->execute() or die "

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

"; - +$dbs = Settings::selectRecords($db, $stmtCat ); if($passch){ my ($ex,$ne,$cf) = ($cgi->param("existing"),$cgi->param("new"),$cgi->param("confirm")); if($ne ne $cf){ - $status = "New password must match confirmation!"; + $status = "New pass must match confirmation!"; print "

Client Error: $status

"; } else{ - if(&confirmExistingPassword($ex)){ - &changePassword($ne); - $status = "Password Has Been Changed"; + if(&confirmExistingPass($ex)){ + &changePass($ne); + $status = "Pass Has Been Changed"; } else{ - $status = "Wrong existing password was entered, are you user by alias: $userid ?"; + $status = "Wrong existing pass was entered, are you user by alias: $userid ?"; print "

Client Error: $status

"; } } @@ -632,8 +621,7 @@ elsif($chdbfix){ } - $dbs = $db->prepare( "SELECT rowid, ID_CAT, DATE, LOG FROM LOG WHERE $sel ORDER BY DATE;" ); - $rv = $dbs->execute() or die "

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

"; + $dbs = $dbs = Settings::selectRecords($db, "SELECT rowid, ID_CAT, DATE, LOG FROM LOG WHERE $sel ORDER BY DATE;" ); while(my @row = $dbs->fetchrow_array()) { my $id = $row[0];# rowid my $ct = $hshCats{$row[1]}; #ID_CAT @@ -684,33 +672,41 @@ elsif($chdbfix){ } catch{ - $ERROR = qq(

SERVER ERROR -> $_

); + + my $err = $@; + my $pwd = `pwd`; + $pwd =~ s/\s*$//; + + $ERROR = + "
SERVER ERROR on ".DateTime->now. + "
".$pwd."/$0 -> &".caller." -> [$err]","
", + + + } } -sub confirmExistingPassword { +sub confirmExistingPass { my $pass = $_[0]; - my $crypt = encryptPassw($pass); + my $crypt = encryptPassw($pass); my $sql = "SELECT ALIAS, PASSW from AUTH WHERE ALIAS='$userid' AND PASSW='$crypt';"; # print "

DEBUG:[$pass]
$sql

"; - $dbs = $db->prepare($sql); - $dbs->execute(); + $dbs = Settings::selectRecords($db, $stmtCat ); if($dbs->fetchrow_array()){ return 1; } return 0; } -sub changePassword { +sub changePass { my $pass = encryptPassw($_[0]); - $dbs = $db->prepare("UPDATE AUTH SET PASSW='$pass' WHERE ALIAS='$userid';"); - $dbs->execute(); + $dbs = Settings::selectRecords($db, "UPDATE AUTH SET PASSW='$pass' WHERE ALIAS='$userid';"); if($dbs->fetchrow_array()){ return 1; } return 0; } sub encryptPassw { - return uc crypt $_[0], hex $cipher_key; + return uc crypt $_[0], hex Settings->CIPHER_KEY; } @@ -738,7 +734,7 @@ try{ $db->do('BEGIN TRANSACTION;'); #Check for duplicates, which are possible during imports or migration as internal rowid is not primary in log. - $dbs = dbExecute('SELECT rowid, DATE FROM LOG ORDER BY DATE;'); + $dbs = Settings::selectRecords($db, 'SELECT rowid, DATE FROM LOG ORDER BY DATE;'); while(@row = $dbs->fetchrow_array()) { my $existing = $dates{$row[0]}; if($existing && $existing eq $row[1]){ @@ -767,7 +763,7 @@ try{ $db->do('COMMIT;'); $db->disconnect(); - $db = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die "

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

"; + $db = DBI->connect($dsn, $userid, $pass, { RaiseError => 1 }) or die "

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

"; $dbs = $db->do("VACUUM;"); @@ -827,14 +823,14 @@ try{ $err .= "UID{$id} taken by $vars{$id}-> $line\n"; } else{ - $dbs = dbExecute( + $dbs = Settings::selectRecords($db, "SELECT ID, NAME, VALUE, DESCRIPTION FROM CONFIG WHERE NAME LIKE '$name';"); $inData = 1; my @row = $dbs->fetchrow_array(); if(scalar @row == 0){ #The id in config file has precedence to the one in the db, #from a ppossible previous version. - $dbs = dbExecute("SELECT ID FROM CONFIG WHERE ID = $id;"); + $dbs = Settings::selectRecords($db, "SELECT ID FROM CONFIG WHERE ID = $id;"); @row = $dbs->fetchrow_array(); if(scalar @row == 0){ $insert->execute($id,$name,$value,$tick[1]); @@ -887,28 +883,23 @@ sub logout { } sub changeSystemSettings { - try{ - my $updated; - $dbs = dbExecute("SELECT ID, NAME FROM CONFIG;"); - while (my @r=$dbs->fetchrow_array()){ - my $var = $cgi->param('var'.$r[0]); - if(defined $var){ - updCnf($r[0],$var); - $updated = 1; - } - } - Settings::getConfiguration($db) if($updated); - } - catch{ - print "SERVER ERROR->changeSystemSettings:".$_; + my $updated; + $dbs = Settings::selectRecords($db, "SELECT ID, NAME FROM CONFIG;"); + while (my @r=$dbs->fetchrow_array()){ + my $var = $cgi->param('var'.$r[0]); + if(defined $var){ + updCnf($r[0],$var); + $updated = 1; + } } + Settings::getConfiguration($db) if($updated); } sub updCnf { my ($id, $val, $s) = @_; $s = "UPDATE CONFIG SET VALUE='".$val."' WHERE ID=".$id.";"; try{ - dbExecute($s); + Settings::selectRecords($db, $s); } catch{ print "SERVER ERROR->updCnf[$s]:".$_; @@ -920,10 +911,10 @@ sub exportToCSV { try{ my $csv = Text::CSV->new ( { binary => 1, strict => 1,eol => $/ } ); if($csvp > 2){ - $dbs = dbExecute("SELECT ID, NAME, DESCRIPTION FROM CAT ORDER BY ID;"); + $dbs = Settings::selectRecords($db, "SELECT ID, NAME, DESCRIPTION FROM CAT ORDER BY ID;"); } else{ - $dbs = dbExecute("SELECT * FROM LOG;"); + $dbs = Settings::selectRecords($db, "SELECT * FROM LOG;"); } if($csvp==2 || $csvp==4){ @@ -958,8 +949,8 @@ sub importCatCSV { while (my $line = <$hndl>) { chomp $line; if ($csv->parse($line)) { - my @flds = $csv->fields(); - updateCATDB(@flds); + my @fields = $csv->fields(); + updateCATDB(@fields); }else{ warn "Data could not be parsed: $line\n"; } @@ -967,16 +958,16 @@ sub importCatCSV { } sub updateCATDB { - my @flds = @_; - if(@flds>2){ + my @fields = @_; + if(@fields>2){ try{ - my $id = $flds[0]; - my $name = $flds[1]; - my $desc = $flds[2]; + my $id = $fields[0]; + my $name = $fields[1]; + my $desc = $fields[2]; #is it existing entry? - $dbs = dbExecute("SELECT ID, NAME, DESCRIPTION FROM CAT WHERE ID = '$id';"); - if(not defined $dbs->fetchrow_array()){ + $dbs = Settings::selectRecords($db, "SELECT ID FROM CAT WHERE ID = '$id';"); + if(!$dbs->fetchrow_array()){ $dbs = $db->prepare('INSERT INTO CAT VALUES (?,?,?)'); $dbs->execute($id, $name, $desc); $dbs->finish; @@ -999,8 +990,8 @@ sub importLogCSV { while (my $line = <$hndl>) { chomp $line; if ($csv->parse($line)) { - my @flds = $csv->fields(); - updateLOGDB(@flds); + my @fields = $csv->fields(); + updateLOGDB(@fields); }else{ warn "Data could not be parsed: $line\n"; } @@ -1012,29 +1003,28 @@ sub importLogCSV { } sub updateLOGDB { - my @flds = @_; - if(@flds>3){ + my @fields = @_; + if(@fields>3){ try{ - my $id_cat = $flds[0]; - my $date = $flds[1]; - my $log = $flds[2]; - my $amv = $flds[3]; - my $amf = $flds[4]; - my $rtf = $flds[5]; - my $sticky = $flds[6]; + my $i = 0; + my $id_cat = $fields[$i++]; + my $id_rtf = $fields[$i++]; + my $date = $fields[$i++]; + my $log = $fields[$i++]; + my $amv = $fields[$i++]; + my $amf = $fields[$i++]; + my $sticky = $fields[$i++]; my $pdate = DateTime::Format::SQLite->parse_datetime($date); #Check if valid date log entry? if($id_cat==0||$id_cat==""||!$pdate){ return; } #is it existing entry? - my $sql = "SELECT DATE FROM LOG WHERE DATE is '$pdate';"; - $dbs = $db->prepare($sql); - $dbs->execute(); + $dbs = Settings::selectRecords($db,"SELECT DATE FROM LOG WHERE DATE is '$pdate';"); my @rows = $dbs->fetchrow_array(); if(scalar @rows == 0){ $dbs = $db->prepare('INSERT INTO LOG VALUES (?,?,?,?,?,?,?)'); - $dbs->execute( $id_cat, $pdate, $log, $amv, $amf, $rtf, $sticky); + $dbs->execute($id_cat, $id_rtf, $pdate, $log, $amv, $amf, $sticky); } $dbs->finish(); } @@ -1046,7 +1036,7 @@ sub updateLOGDB { sub cats { $cats = qq('; } -sub dbExecute { - my $ret = $db->prepare(shift); - $ret->execute() or die "

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

"; - return $ret; -} sub error { my $url = $cgi->url(); @@ -1079,15 +1064,15 @@ sub error { sub renumerate { #Renumerate Log! Copy into temp. table. my $sql; - $dbs = dbExecute("CREATE TABLE life_log_temp_table AS SELECT * FROM LOG;"); - $dbs = dbExecute('SELECT rowid, DATE FROM LOG WHERE RTF == 1 ORDER BY DATE;'); + $dbs = Settings::selectRecords($db, "CREATE TABLE life_log_temp_table AS SELECT * FROM LOG;"); + $dbs = Settings::selectRecords($db, 'SELECT rowid, DATE FROM LOG WHERE RTF == 1 ORDER BY DATE;'); #update notes with new log id while(my @row = $dbs->fetchrow_array()) { my $sql_date = $row[1]; #$sql_date =~ s/T/ /; $sql_date = DateTime::Format::SQLite->parse_datetime($sql_date); $sql = "SELECT rowid, DATE FROM life_log_temp_table WHERE RTF = 1 AND DATE = '".$sql_date."';"; - $dbs = dbExecute($sql); + $dbs = Settings::selectRecords($db, $sql); my @new = $dbs->fetchrow_array(); if(scalar @new > 0){ $db->do("UPDATE NOTES SET LID =". $new[0]." WHERE LID==".$row[0].";"); @@ -1095,13 +1080,13 @@ sub renumerate { } # Delete Orphaned Notes entries. - $dbs = dbExecute("SELECT LID, LOG.rowid from NOTES LEFT JOIN LOG ON + $dbs = Settings::selectRecords($db, "SELECT LID, LOG.rowid from NOTES LEFT JOIN LOG ON NOTES.LID = LOG.rowid WHERE LOG.rowid is NULL;"); while(my @row = $dbs->fetchrow_array()) { $db->do("DELETE FROM NOTES WHERE LID=$row[0];"); } - $dbs = dbExecute('DROP TABLE LOG;'); - $dbs = dbExecute(qq(CREATE TABLE LOG ( + $dbs = Settings::selectRecords($db, 'DROP TABLE LOG;'); + $dbs = Settings::selectRecords($db, qq(CREATE TABLE LOG ( ID_CAT TINY NOT NULL, DATE DATETIME NOT NULL, LOG VCHAR (128) NOT NULL, @@ -1110,10 +1095,10 @@ sub renumerate { RTF BOOL DEFAULT 0, STICKY BOOL DEFAULT 0 );)); - $dbs = dbExecute('INSERT INTO LOG (ID_CAT,DATE,LOG,AMOUNT,AFLAG, RTF) + $dbs = Settings::selectRecords($db, 'INSERT INTO LOG (ID_CAT,DATE,LOG,AMOUNT,AFLAG, RTF) SELECT ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF FROM life_log_temp_table ORDER by DATE;'); - $dbs = dbExecute('DROP TABLE life_log_temp_table;'); + $dbs = Settings::selectRecords($db, 'DROP TABLE life_log_temp_table;'); } 1; \ No newline at end of file diff --git a/htdocs/cgi-bin/login_ctr.cgi b/htdocs/cgi-bin/login_ctr.cgi index 8e5bc79..bd6bbca 100755 --- a/htdocs/cgi-bin/login_ctr.cgi +++ b/htdocs/cgi-bin/login_ctr.cgi @@ -5,7 +5,8 @@ # use strict; use warnings; -use Try::Tiny; +use Exception::Class ('LifeLogException'); +use Syntax::Keyword::Try; use CGI; use CGI::Session '-ip_match'; use DBI; @@ -13,8 +14,8 @@ use DBI; use DateTime; use DateTime::Format::SQLite; use DateTime::Duration; -use Text::CSV; - +#Bellow perl 5.28+ +#use experimental 'smartmatch'; #DEFAULT SETTINGS HERE! use lib "system/modules"; @@ -35,71 +36,77 @@ my ($debug,$frm) = ""; #Codebase release version. Release in the created db or existing one can be different, through time. my $RELEASE = Settings::release(); -#This is the OS developer release key, replace on istallation. As it is not secure. -my $cipher_key = '95d7a85ba891da'; - if($cgi->param('logout')){&logout} -&checkAutologinSet; -if(&processSubmit==0){ - - print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie); - print $cgi->start_html( - -title => "Personal Log Login", - -BGCOLOR => &Settings::bgcol, - -script => [ - { -type => 'text/javascript', -src => 'wsrc/main.js' }, ], - -style => [ - { -type => 'text/css', -src => 'wsrc/'.&Settings::css } - ] -); - -my @ht = split(m/\s/,`hostname -I`); -my $hst = `hostname` . "($ht[0])"; - -$frm = qq( - - - - - - - - - - - - - -
LOGIN
Alias:
Password:
NOTICE!   - Alias will create a new database if it doesn't exist. Note down your password. - -
Your Host -> $hst
); - -print qq(

-
-

Welcome to Life Log

$frm

- Get latest version of this application here!
-
); - -Settings::printDebugHTML($debug) if (&Settings::debug); -print $cgi->end_html; - +try{ + &checkAutologinSet; + if(&processSubmit==0){ + + print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie); + print $cgi->start_html( + -title => "Personal Log Login", + -BGCOLOR => &Settings::bgcol, + -script => [ + { -type => 'text/javascript', -src => 'wsrc/main.js' }, ], + -style => [ + { -type => 'text/css', -src => 'wsrc/'.&Settings::css } + ] + ); -} -else{ - print $cgi->start_html; + my @ht = split(m/\s/,`hostname -I`); + my $hst = `hostname` . "($ht[0])"; + + $frm = qq( +
+ + + + + + + + + + + + +
LOGIN
Alias:
Password:
NOTICE!   + Alias will create a new database if it doesn't exist. Note down your password. + +
Your Host -> $hst
); + + print qq(

+
+

Welcome to Life Log

$frm

+ Get latest version of this application here!
+
); + + Settings::printDebugHTML($debug) if (&Settings::debug); print $cgi->end_html; -} + } + else{ + print $cgi->start_html; + print $cgi->end_html; + } +} + catch { + my $err = $@; + my $dbg = "" ; + my $pwd = `pwd`; + $pwd =~ s/\s*$//; + $dbg = "--DEBUG OUTPUT--\n$debug" if $debug; + print $cgi->header, + "SERVER ERROR on ".DateTime->now. + "
".$pwd."/$0 -> &".caller." -> [$err]","\n$dbg
", + $cgi->end_html; + }; exit; -sub processSubmit{ -try{ - +sub processSubmit { if($alias&&$passw){ - $passw = uc crypt $passw, hex $cipher_key; + $passw = uc crypt $passw, hex Settings->CIPHER_KEY; #CheckTables will return 1 if it was an logout set in config table. if(&checkCreateTables()==0){ $session->param('alias', $alias); @@ -107,89 +114,141 @@ try{ $session->param('database', 'data_'.$alias.'_log.db'); $session->flush(); print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie, -location=>"main.cgi"); - return 1; #activate redirect to main, main will check credentials. + return 1; #activated redirect to main, main will check credentials. } } else{ $alias = $passw = ""; } &Settings::removeOldSessions; #and prompt for login returning 0 -return 0; -} - catch{ - print $cgi->header; - print "SERVER ERROR processSubmit(): $_ dump ->". $session->dump(); - print $cgi->end_html; - } + return 0; } sub checkAutologinSet { -try{ - #We don't need to slurp as it is expected setting in header. - my @cre; - open(my $fh, '<', &Settings::logPath.'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, '<', &Settings::logPath.'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 = &Settings::logPath.'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]; - &Settings::removeOldSessions; - } - $db->disconnect(); - } -} - catch{ - print $cgi->header; - print "SERVER ERROR:".$_; - print $cgi->end_html; - exit; - } + if(@cre &&scalar(@cre)>1){ + my $database = &Settings::logPath.'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]; + &Settings::removeOldSessions; + } + $db->disconnect(); + } + } sub checkCreateTables { -try{ + my $today = DateTime->now; - $today->set_time_zone( &Settings::timezone ); + $today-> set_time_zone( &Settings::timezone ); my $database = &Settings::logPath.'data_'.$alias.'_log.db'; my $dsn= "DBI:SQLite:dbname=$database"; my $db = DBI->connect($dsn, $alias, $passw, { RaiseError => 1 }) - or die "

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

"; + or die "

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

"; my $rv; - my $st = $db->prepare(selSQLTbl('LOG')); - $st->execute(); - my $changed = 0; + # We live check database for available tables now only once. + # If brand new database, this sill returns fine an empty array. + my $pst = Settings::selectRecords($db,"SELECT name FROM sqlite_master WHERE type='table' or type='view';"); + my %curr_tables = (); + while(my @r = $pst->fetchrow_array()){ + $curr_tables{$r[0]} = 1; + } - 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, - STICKY BOOL DEFAULT 0 - ); - CREATE INDEX idx_log_dates ON LOG (DATE); - ); + if($curr_tables{'CONFIG'}) { + #Has configuration data been wiped out? + $changed = 1 if Settings::countRecordsIn($db, 'CONFIG') == 0; + } + else{ + #v.1.3 -> v.1.4 + #has alter table CONFIG add DESCRIPTION VCHAR(128); + $rv = $db->do(&Settings::createCONFIGStmt); + $changed = 1; + } + # Now we got a db with CONFIG, lets get settings from there. + # Default version is the scripted current one, which could have been updated. + # We need to maybe update further, if these versions differ. + # Source default and the one from the CONFIG table. + my $DEF_VERSION = Settings::release(); + Settings::getConfiguration($db); + my $DB_VERSION = Settings::release(); + my $hasLogTbl = $curr_tables{'LOG'}; + my $hasNotesTbl = $curr_tables{'NOTES'}; + # + # From v.1.8 Log has changed, to have LOG to NOTES relation. + # + if($hasLogTbl && $DEF_VERSION > $DB_VERSION && $DB_VERSION < 1.8){ + # We must upgrade now. If existing LOG table is now invalid old version containing boolean RTF. + my @names = @{Settings::getTableColumnNames($db, 'LOG')}; + #perl 5.28+ <-- + #if ( 'RTF' ~~ @names ) { + if(grep( /RTF/, @names)){ + #$db->begin_work(); + $db->do('CREATE TABLE life_log_login_ctr_temp_table AS SELECT * FROM LOG;'); + my %notes_ids = (); + if($hasNotesTbl){ + my $pst = Settings::selectRecords($db, 'SELECT rowid, DATE FROM LOG WHERE RTF > 0 ORDER BY DATE;'); + while(my @row = $pst->fetchrow_array()) { + my $sql_date = $row[1];; + $sql_date = DateTime::Format::SQLite->parse_datetime($sql_date); + my $pst2 = Settings::selectRecords($db, "SELECT rowid, DATE FROM life_log_login_ctr_temp_table WHERE RTF > 0 AND DATE = '".$sql_date."';"); + my @rec = $pst2->fetchrow_array(); + if(@rec){ + $db->do("UPDATE NOTES SET LID =". $rec[0]." WHERE LID ==".$row[0].";"); + $pst2 = Settings::selectRecords($db, "SELECT rowid FROM NOTES WHERE LID == ".$rec[0].";"); + @rec = $pst2->fetchrow_array(); + if(@rec){ + $notes_ids{$sql_date} = $rec[0]; + } + } + } + + } + $db->do('DROP TABLE LOG;'); + $db->do(&Settings::createLOGStmt); + $db->do('INSERT INTO LOG (ID_CAT, DATE, LOG, AMOUNT,AFLAG) + SELECT ID_CAT, DATE, LOG, AMOUNT, AFLAG FROM life_log_login_ctr_temp_table ORDER by DATE;'); + $db->do('DROP TABLE life_log_login_ctr_temp_table;'); + + #Update new LOG with notes RTF ids, in future versions, this will never be required anymore. + foreach my $date (keys %notes_ids){ + #next if(ref($notes_ids{$date}) eq 'HASH'); + my $nid = $notes_ids{$date}; + my $stmt= "UPDATE LOG SET ID_RTF =". $nid." WHERE DATE == '".$date."';"; + try{ + $db->do($stmt); + } + catch{ + LifeLogException -> throw(error=>"Upgrade statement -> [$stmt] failed!", show_trace=>1); + } + } + undef %notes_ids; + $changed = 1; + } + } + + if(!$hasLogTbl) { if($sssCreatedDB){ print $cgi->header; @@ -200,128 +259,57 @@ try{ exit; } - $db->do($stmt); + $db->do(&Settings::createLOGStmt); - $st = $db->prepare('INSERT INTO LOG(ID_CAT,DATE,LOG) VALUES (?,?,?)'); - $st->execute( 3, $today, "DB Created!"); - $session->param("cdb", "1"); + my $st = $db->prepare('INSERT INTO LOG(ID_CAT,DATE,LOG) VALUES (?,?,?)'); + $st->execute( 3, $today, "DB Created!"); + $session->param("cdb", "1"); } # From v.1.6 view use server side views, for pages and correct record by ID and PID lookups. # This should make queries faster, less convulsed, and log renumeration less needed, for accurate pagination. - $st = $db->prepare(selSQLView('VW_LOG')); - $st->execute(); - if(!$st->fetchrow_array()) { - $rv = $db->do('CREATE VIEW VW_LOG AS - SELECT rowid as ID,*, (select count(rowid) from LOG as recount where a.rowid >= recount.rowid) as PID - FROM LOG as a ORDER BY DATE DESC;'); - if($rv < 0){print "

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

";} + if(!$curr_tables{'VW_LOG'}) { + $rv = $db->do(&Settings::createVW_LOGStmt); } - - $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); + if(!$curr_tables{'CAT'}) { + $db->do(&Settings::createCATStmt); $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()) { - - - 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); - ); + $changed = 1 if Settings::countRecordsIn($db, 'CAT') == 0; - - $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 (?,?,?,?);'); + if(!$curr_tables{'AUTH'}) { + $rv = $db->do(&Settings::createAUTHStmt); + my $st = $db->prepare('INSERT INTO AUTH VALUES (?,?,?,?);'); $st->execute($alias, $passw,"",0); - } } # # Scratch FTS4 implementation if present. # - $st = $db->prepare(selSQLTbl('NOTES_content')); - $st->execute(); - if($st->fetchrow_array()) { + if($curr_tables{'NOTES_content'}) { $rv = $db->do('DROP TABLE NOTES;'); - if($rv < 0){print "

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

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

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

"}; } - - $st = $db->prepare(selSQLTbl('CONFIG')); - $st->execute(); - if(!$st->fetchrow_array()) { - #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{ - #Has configuration been wiped out? - $st = $db->prepare('SELECT count(ID) FROM CONFIG;'); $st->execute(); - $changed = 1 if(!$st->fetchrow_array()); - } - #We got an db now, lets get settings from there. - Settings::getConfiguration($db); - if(!$changed){ - #Run db fix renum if this is an relese update? Relese in software might not be what is in db, which counts. - #$st = Settings::dbExecute($db, 'SELECT NAME, VALUE FROM CONFIG WHERE NAME == "RELEASE_VER";'); - $st = $db->prepare('SELECT ID, NAME, VALUE FROM CONFIG WHERE NAME IS "RELEASE_VER";'); - $st->execute() or die "

ERROR with->$DBI::errstri

"; - my @pair = $st->fetchrow_array(); - my $cmp = $pair[2] eq $RELEASE; - $debug .= "Upgrade cmp(RELESE_VER:'$pair[2]' eq Settings::release:'$RELEASE') == $cmp"; + if($changed){ + #It is also good to run db fix (config page) to renum if this is an release update? + #Release in software might not be what is in db, which counts. + #This here newxt we now update. + my @r = Settings::selectRecords($db, 'SELECT ID, VALUE FROM CONFIG WHERE NAME IS "RELEASE_VER";')->fetchrow_array(); + my $did = $r[0]; + my $dnm = $r[1]; + my $cmp = $dnm eq $RELEASE; + $debug .= "Upgrade cmp(RELESE_VER:'$dnm' eq Settings::release:'$RELEASE') == $cmp"; #Settings::debug(1); if(!$cmp){ Settings::renumerate($db); @@ -329,14 +317,14 @@ try{ #^REL_RENUM is marker that an renumeration is issued during upgrade. my $pv = &Settings::obtainProperty($db, '^REL_RENUM'); if($pv){ - $pv += 1; + $pv++; } else{ - $pv = "1"; + $pv = 0; } &Settings::configProperty($db, 200, '^REL_RENUM',$pv); - &Settings::configProperty($db, $pair[0], 'RELEASE_VER', $RELEASE); - &Settings::toLog($db,&dbTimeStamp, "Upgraded LifeLog from ".$pair[2]." to $RELEASE version, this is the $pv upgrade."); + &Settings::configProperty($db, $did>0?$did:0, 'RELEASE_VER', $RELEASE); + &Settings::toLog($db, "Upgraded Life Log from v.$dnm to v.$RELEASE version, this is the $pv upgrade.") if $pv; &populate($db); } } @@ -344,48 +332,33 @@ try{ &populate($db); } # - $db->disconnect(); + $db->disconnect(); # #Still going through checking tables and data, all above as we might have an version update in code. #Then we check if we are login in intereactively back. Interective, logout should bring us to the login screen. #Bypassing auto login. So to start maybe working on another database, and a new session. return $cgi->param('autologoff') == 1; -} - catch{ - print $cgi->header; - print "SERVER ERROR:".$_; - print $cgi->end_html; - exit; - } } -#TODO move this subroutine to settings. -sub dbTimeStamp { - my $dat = DateTime->now; - $dat -> set_time_zone(Settings::timezone()); - return DateTime::Format::SQLite->format_datetime($dat); -} + sub populate { - my $db = shift; - my ($did,$name, $value, $desc); - my $inData = 0; - my $err = ""; - my %vars = (); - my @lines; - my $table_type = 0; + 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", &Settings::logPath.'main.cnf' ) or die "Can't open main.cnf: $!"; - read $fh, my $content, -s $fh; + open(my $fh, "<:perlio", &Settings::logPath.'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{ + close $fh; - my $insConfig = $db->prepare('INSERT INTO CONFIG VALUES (?,?,?,?)'); - my $insCat = $db->prepare('INSERT INTO CAT VALUES (?,?,?)'); + my $insConfig = $db->prepare('INSERT INTO CONFIG VALUES (?,?,?,?)'); + my $insCat = $db->prepare('INSERT INTO CAT VALUES (?,?,?)'); $db->begin_work(); foreach my $line (@lines) { @@ -395,7 +368,7 @@ try{ if( index( $line, '<' ) == 0 ) {next;} #Migration is complex main.cnf contains though SQL alter statements. + elsif( index( $line, '<<~MIG<>' ) == 0 ) {next;} #Migration is complex main.cnf might contain SQL alter statements. if( scalar @tick == 2 ) { @@ -454,34 +427,28 @@ $err .= "Invalid, spec'ed {uid}|{category}`{description}-> $line\n"; } } - die "Configuration script ".&Settings::logPath."/main.cnf [$fh] contains errors." if $err; - $db->commit(); - } catch{ - print $cgi->header; - print "SERVER ERROR!
".$_."
$err
"; - print $cgi->end_html; - exit; - } + die "Configuration script ".&Settings::logPath."/main.cnf [$fh] contains errors." if $err; + $db->commit(); } -sub selSQLTbl{ +sub selSQLTbl { my $name = $_[0]; return "SELECT name FROM sqlite_master WHERE type='table' AND name='$name';" } -sub selSQLView{ +sub selSQLView { my $name = $_[0]; return "SELECT name FROM sqlite_master WHERE type='view' AND name='$name';" } -sub logout{ +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'}, + -style =>{-type => 'text/css', -src => 'wsrc/main.css'}, ); print qq(

You have properly loged out of the Life Log Application!

diff --git a/htdocs/cgi-bin/main.cgi b/htdocs/cgi-bin/main.cgi index 24eaa45..7ce6c88 100755 --- a/htdocs/cgi-bin/main.cgi +++ b/htdocs/cgi-bin/main.cgi @@ -5,7 +5,8 @@ # use warnings; use strict; -use Try::Tiny; +use Exception::Class ('LifeLogException'); +use Syntax::Keyword::Try; use Switch; use CGI; @@ -27,7 +28,7 @@ use lib "system/modules"; require Settings; my $cgi = CGI->new; -my $sss = new CGI::Session( "driver:File", $cgi, { Directory => Settings::logPath() } ); +my $sss = new CGI::Session( "driver:File", $cgi, { Directory => &Settings::logPath } ); my $sid = $sss->id(); my $dbname = $sss->param('database'); my $userid = $sss->param('alias'); @@ -40,11 +41,10 @@ if ( !$userid || !$dbname ) { exit; } -my $database = Settings::logPath() . $dbname; +my $database = &Settings::logPath . $dbname; my $dsn = "DBI:SQLite:dbname=$database"; my $db = DBI->connect( $dsn, $userid, $password, { PrintError => 0, RaiseError => 1 } ) - or die "

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

"; - + or LifeLogException->throw("Execute failed [$DBI::errstri]"); my ( $imgw, $imgh ); #Fetch settings Settings::getConfiguration($db); @@ -55,7 +55,7 @@ my ( $imgw, $imgh ); my $log_rc = 0; my $log_rc_prev = 0; my $log_cur_id = 0; -my $log_top = 0; +my $log_top = 0; my $rs_keys = $cgi->param('keywords'); my $rs_cat_idx = $cgi->param('category'); my $prm_vc = $cgi->param("vc"); @@ -66,7 +66,7 @@ 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 PID, ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY from VW_LOG WHERE'; +my $stmS = 'SELECT PID, ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY from VW_LOG WHERE'; my $stmE = ""; my $stmD = ""; my $sm_reset_all; @@ -209,15 +209,15 @@ print $cgi->start_html( ], ); -my $rv; + my $st; -my $stmtCat = "SELECT ID, NAME, DESCRIPTION FROM CAT ORDER BY ID;"; -my $stmt = "SELECT PID, ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY FROM VW_LOG WHERE STICKY = 1;"; +my $str_sqlCat = "SELECT ID, NAME, DESCRIPTION FROM CAT ORDER BY ID;"; +my $str_sql = "SELECT ID, ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY FROM VW_LOG WHERE STICKY = 1;"; -print qq("## Using db -> $dsn) if $DEBUG; +print qq(## Using db -> $dsn\n) if $DEBUG; -$st = $db->prepare($stmtCat); -$rv = $st->execute() or die "

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

"; +$st = $db->prepare($str_sqlCat); +$st->execute() or LifeLogException->throw($DBI::errstri); my $cats = qq(
LifeLog App. Version:$RELEASE_VER
LifeLog App. Version:).&Settings::release.qq(
Number of Records:$log_rc
No. of Records This Year:$log_this_year_rc
No. of RTF Documents:$notes_rc