### 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.
* ✔ 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.
## 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.
## 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.
-- Note - Perl and some modules might take time to install
as their fetched and tested for your computer.
-
+
## Install tiny thttpd web server. ##
-#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
-# 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
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
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
(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
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
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
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.
#
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;
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,"");
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){
my $database = &Settings::logPath.$dbname;
my $dsn= "DBI:SQLite:dbname=$database";
-my $db = DBI->connect($dsn, $userid, $pass
word, { RaiseError => 1 }) or die "<p>Error->"& $DBI::errstri &"</p>";
+my $db = DBI->connect($dsn, $userid, $pass, { RaiseError => 1 }) or die "<p>Error->"& $DBI::errstri &"</p>";
### Fetch settings
Settings::getConfiguration($db);
<a class="a_" href="stats.cgi">Stats</a><hr>
<a class="a_" href="main.cgi">Log</a><hr>
<font size="2"><b>Jump to Sections</b><br>
-<a href="#top">Categories</a><br>
+<a href="#categories">Categories</a><br>
<a href="#vars">System</a><br>
<a href="#dbsets">DB Fix</a><br>
-<a href="#passets">Password</a>
+<a href="#passets">Pass</a>
</font>
<hr>
<br>
<tr class="r0"><td colspan="4"><b>* CATEGORIES CONFIGURATION *</b></td></tr>
<tr class="r1"><th>ID</th><th>Category</th><th align="left">Description</th></tr>
';
-$dbs = dbExecute($stmtCat);
+$dbs = Settings::selectRecords($db, $stmtCat);
while(my @row = $dbs->fetchrow_array()) {
if($row[0]>0){
$tbl .= '<tr class="r0"><td>'.$row[0].'</td>
}
}
-my $frm = qq(
+my $frmCats = qq(
<form id="frm_config" action="config.cgi">).$tbl.qq(
<tr class="r1">
<td><input type="text" name="caid" value="" size="3"/></td>
<td align="left"><input type="text" name="cade" value="" size="64"/></td>
</tr>
<tr class="r1">
- <td colspan="2"><a href="#bottom">↡</a> <input type="submit" value="Add New Category" onclick="return submitNewCategory()"/></td>
+ <td colspan="2"><a href="#bottom">↡</a> <input type="submit" value="Add New Category First" onclick="return submitNewCategory()"/> or <input type="submit" value="Change"/></td>
<td colspan="1" align="right"><b>Categories Configuration In -> $dbname</b> <input type="submit" value="Change"/></td>
</tr>
<tr class="r1">
<tr class="r1" align="left">
<th width="20%">Variable</th>
<th width="20%">Value</th>
- <th width="60%">Description</th>
+ <th width="60%">Description <input type="submit" value="Change" style="float:right"/></th>
</tr>
);
-my $stm = 'SELECT ID, NAME, VALUE, DESCRIPTION FROM CONFIG;';
-$dbs = $db->prepare( $stm );
-$rv = $dbs->execute() or die or die "<p>Error->"& $DBI::errstri &"</p>";
+my $stm = 'SELECT ID, NAME, VALUE, DESCRIPTION FROM CONFIG ORDER BY NAME;';
+$dbs = Settings::selectRecords($db, $stm );
while(my @row = $dbs->fetchrow_array()) {
<tr class="r1">
<td colspan="3" align=right><b>System Settings In -> $dbname</b> <input type="submit" value="Change"/></td>
</tr>
- <input type="hidden" name="sys" value="1"/>
- </table></form><br>);
+ </table><input type="hidden" name="sys" value="1"/></form><br>);
<font color="red">WARNING!</font> Checking any of the above extra actions will cause loss
of your changes. Please, export/backup first.</td>
</tr>
- <input type="hidden" name="db_fix" value="1"/>
- </table></form><br>
+ </table><input type="hidden" name="db_fix" value="1"/></form><br>
);
$tbl = qq(<table id="cnf_fix" class="tbl" border="1" width=").&Settings::pagePrcWidth.qq(%">
- <tr class="r0"><td colspan="2"><b>* CHANGE PASSWORD *</b></td></tr>
+ <tr class="r0"><td colspan="2"><b>* CHANGE PASS *</b></td></tr>
);
my $frmPASS = qq(
<form id="frm_PASS" action="config.cgi">$tbl
- <tr class="r1" align="left"><td style="width:100px">Existing:</td><td><input type="password" name="existing" value="" size="12"/></td></tr>
- <tr class="r1" align="left"><td>New:</td><td><input type="password" name="new" value="" size="12"/></td></tr>
- <tr class="r1" align="left"><td>Confirmation:</td><td><input type="password" name="confirm" value="" size="12"/></td></tr>
+ <tr class="r1" align="left"><td style="width:100px">Existing:</td><td><input type="pass" name="existing" value="" size="12"/></td></tr>
+ <tr class="r1" align="left"><td>New:</td><td><input type="pass" name="new" value="" size="12"/></td></tr>
+ <tr class="r1" align="left"><td>Confirmation:</td><td><input type="pass" name="confirm" value="" size="12"/></td></tr>
<tr class="r1">
- <td colspan="2" align="right"><b>Password change for -> $userid</b> <input type="submit" value="Change"/></td>
+ <td colspan="2" align="right"><b>Pass change for -> $userid</b> <input type="submit" value="Change"/></td>
</tr>
- <input type="hidden" name="pass_change" value="1"/>
- </table></form><br>
+ </table><input type="hidden" name="pass_change" value="1"/></form><br>
);
#
-#Page printout from here!
+# Page printout from here!
#
print qq(
<a name="top"></a><center>
- <div>$frm</div>
<div><a name="vars"></a>$frmVars</div>
+ <div><a name="categories"></a>$frmCats</div>
<div><a name="dbsets"></a>$frmDB</div>
<div><a name="passets"></a>$frmPASS</div>
<div id="rz" style="text-align:center;width:).&Settings::pagePrcWidth.qq(%;">
</div>
<br>
<div id="rz" style="text-align:left; width:640px; padding:10px; background-color:).&Settings::bgcol.qq(">
+ <form action="config.cgi" method="post" enctype="multipart/form-data">
<table border="0" width="100%">
<tr><td><H3>CSV File Format</H3></td></tr>
- <form action="config.cgi" method="post" enctype="multipart/form-data">
<tr style="border-left: 1px solid black;"><td>
<b>Import Categories</b>: <input type="file" name="data_cat" /></td></tr>
<tr style="border-left: 1px solid black;"><td style="text-align:right;">
<input type="submit" name="Submit" value="Submit"/></td>
</tr>
</form>
+ <form action="config.cgi" method="post" enctype="multipart/form-data">
<tr><td><b>Export Categories:</b>
<input type="button" onclick="return exportToCSV('cat',0);" value="Export"/>
<input type="button" onclick="return exportToCSV('cat',1);" value="View"/>
</td></tr>
- <form action="config.cgi" method="post" enctype="multipart/form-data">
<tr style="border-top: 1px solid black;border-right: 1px solid black;"><td>
<b>Import Log</b>: <input type="file" name="data_log" /></td></tr>
<tr style="border-right: 1px solid black;"><td style="text-align:right;">
for your logs HTML layout.
</p>
<p>
- <b><<B<<i>{Text To Bold}</i><b>></b>
+ <b><<B<<i>{Text To Bold}</i><b>>></b>
</p>
<p>
- <b><<I<<i>{Text To Italic}</i><b>></b>
+ <b><<I<<i>{Text To Italic}</i><b>>></b>
</p>
<p>
- <b><<TITLE<<i>{Title Text}</i><b>></b>
+ <b><<TITLE<<i>{Title Text}</i><b>>></b>
</p>
<p>
- <b><<LIST<<i>{List of items delimited by new line to terminate item or with '~' otherwise.}</i><b>></b>
+ <b><<LIST<<i>{List of items delimited by new line to terminate item or with '~' otherwise.}</i><b>>></b>
</p>
<p>
- <b><<IMG<<i>{url to image}</i><b>></b>
+ <b><<IMG<<i>{url to image}</i><b>>></b>
</p>
<p>
- <b><<FRM<<i>{file name}_frm.png}</i><b>></b><br><br>
+ <b><<FRM<<i>{file name}_frm.png}</i><b>>></b><br><br>
*_frm.png images file pairs are located in the ./images folder of the cgi-bin directory.<br>
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"
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?
- </pre>
+ </pre>
</p>
- <p>
- <b><<LNK<<i>{url to image}</i><b>></b><br><br>
+
+ <p><b><<LNK<<i>{url to image}</i><b>>></b><br><br></p>
+ <p>
Explicitly tag an URL in the log entry.
Required if using in log IMG or FRM tags.
Otherwise link appears as plain text.
</p>
<hr>
- </p>
<h3>Log Page Particulars</h3>
↟ or ↡ - Jump links to top or bottom of page respectivelly.
- </p>
- </div>
</center><a name="bottom"></a><a href="#top">↟</a>
<hr>
</div>
my ($s, $d);
try{
-
-$dbs = $db->prepare( $stmtCat );
-$rv = $dbs->execute() or die "<p>Error->"& $DBI::errstri &"</p>";
-
+$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 "<center><div><p><font color=red>Client Error</font>: $status</p></div></center>";
}
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 "<center><div><p><font color=red>Client Error</font>: $status</p></div></center>";
}
}
}
- $dbs = $db->prepare( "SELECT rowid, ID_CAT, DATE, LOG FROM LOG WHERE $sel ORDER BY DATE;" );
- $rv = $dbs->execute() or die "<p>Error->"& $DBI::errstri &"</p>";
+ $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
}
catch{
- $ERROR = qq(<p><font color=red><b>SERVER ERROR</b></font> -> $_</p>);
+
+ my $err = $@;
+ my $pwd = `pwd`;
+ $pwd =~ s/\s*$//;
+
+ $ERROR =
+ "<hr><font color=red><b>SERVER ERROR</b></font> on ".DateTime->now.
+ "<hr><pre>".$pwd."/$0 -> &".caller." -> [$err]","</pre>",
+
+
+
}
}
-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 "<center><div><p><font color=red><b>DEBUG</b></font>:[$pass]<br>$sql</p></div></center>";
- $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;
}
$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]){
$db->do('COMMIT;');
$db->disconnect();
- $db = DBI->connect($dsn, $userid, $pass
word, { RaiseError => 1 }) or die "<p>Error->"& $DBI::errstri &"</p>";
+ $db = DBI->connect($dsn, $userid, $pass, { RaiseError => 1 }) or die "<p>Error->"& $DBI::errstri &"</p>";
$dbs = $db->do("VACUUM;");
$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]);
}
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 "<font color=red><b>SERVER ERROR->changeSystemSettings</b></font>:".$_;
+ 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 "<font color=red><b>SERVER ERROR</b>->updCnf[$s]</font>:".$_;
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){
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";
}
}
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;
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";
}
}
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();
}
sub cats {
$cats = qq(<select id="cats" name="cats"><option value="0">---</option>\n);
- $dbs = dbExecute("SELECT ID, NAME FROM CAT ORDER BY ID;");
+ $dbs = Settings::selectRecords($db, "SELECT ID, NAME FROM CAT ORDER BY ID;");
while ( my @row = $dbs->fetchrow_array() ) {
$cats .= qq(<option value="$row[0]">$row[1]</option>\n);
$hshCats{ $row[0] } = $row[1];
$cats .= '</select>';
}
-sub dbExecute {
- my $ret = $db->prepare(shift);
- $ret->execute() or die "<p>ERROR->"& $DBI::errstri &"</p>";
- return $ret;
-}
sub error {
my $url = $cgi->url();
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].";");
}
# 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,
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
#
use strict;
use warnings;
-use Try::Tiny;
+use Exception::Class ('LifeLogException');
+use Syntax::Keyword::Try;
use CGI;
use CGI::Session '-ip_match';
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";
#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(
- <form id="frm_login" action="login_ctr.cgi" method="post"><table border="0" width=").&Settings::pagePrcWidth.qq(%">
- <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">Your Host -> <b>$hst</b></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>
- </center><div>);
-
-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(
+ <form id="frm_login" action="login_ctr.cgi" method="post"><table border="0" width=").&Settings::pagePrcWidth.qq(%">
+ <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">Your Host -> <b>$hst</b></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>
+ </center><div>);
+
+ 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,
+ "<font color=red><b>SERVER ERROR</b></font> on ".DateTime->now.
+ "<pre>".$pwd."/$0 -> &".caller." -> [$err]","\n$dbg</pre>",
+ $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);
$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 "<font color=red><b>SERVER ERROR processSubmit()</b></font>: $_ 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, "<<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, '<', &Settings::logPath.'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 = &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 "<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];
- &Settings::removeOldSessions;
- }
- $db->disconnect();
- }
-}
- catch{
- print $cgi->header;
- print "<font color=red><b>SERVER ERROR</b></font>:".$_;
- 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 "<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];
+ &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 "<p>Error->"& $DBI::errstri &"</p>";
+
or die "<p>Error->"& $DBI::errstri &"</p>";
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;
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 "<p>Error->"& $DBI::errstri &"</p>";}
+ 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 "<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 (?,?,?,?);');
+ 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 "<p>Error->"& $DBI::errstri &"</p>"};
+ $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 "<p>Error->"& $DBI::errstri &"</p>"};
}
-
- $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 "<p>ERROR with->$DBI::errstri</p>";
- 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);
#^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);
}
}
&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 "<font color=red><b>SERVER ERROR</b></font>:".$_;
- 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) {
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.
+ elsif( index( $line, '<<~MIG<>' ) == 0 ) {next;} #Migration is complex main.cnf might contain SQL alter statements.
if( scalar @tick == 2 ) {
}
}
- die "Configuration script ".&Settings::logPath."/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;
- }
+ 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(<font color="white"><center><h2>You have properly loged out of the Life Log Application!</h2>
#
use warnings;
use strict;
-use Try::Tiny;
+use Exception::Class ('LifeLogException');
+use Syntax::Keyword::Try;
use Switch;
use CGI;
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');
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 "<p>Error->" & $DBI::errstri & "</p>";
-
+ or LifeLogException->throw("Execute failed [$DBI::errstri]");
my ( $imgw, $imgh );
#Fetch settings
Settings::getConfiguration($db);
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");
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;
],
);
-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 "<p>Error->" & $DBI::errstri & "</p>";
+$st = $db->prepare($str_sqlCat);
+$st->execute() or LifeLogException->throw($DBI::errstri);
my $cats = qq(<select class="ui-widget-content" id="ec" name="ec"
onFocus="show('#cat_desc');"
$stmS = $stmS . " OR ";
}
}
- $stmt = $stmS . $stmE;
+ $str_sql = $stmS . $stmE;
}
}
elsif ($rs_cat_idx && $rs_cat_idx != $prm_xc) {
if ($stmD) {
- $stmt = $stmS . $stmD . " AND ID_CAT='" . $rs_cat_idx . "'" . $stmE;
+ $str_sql = $stmS . $stmD . " AND ID_CAT='" . $rs_cat_idx . "'" . $stmE;
}
else {
- $stmt = $stmS . " ID_CAT='" . $rs_cat_idx . "'" . $stmE;
+ $str_sql = $stmS . " ID_CAT=" . $rs_cat_idx . ";" . $stmE;
}
}
else {
$ands .= " ID_CAT!=$_ AND";
}
$ands =~ s/AND$//g;
- $stmt = $stmS . $ands . $stmE;
+ $str_sql = $stmS . $ands . $stmE;
}
else{
- $stmt = $stmS . " ID_CAT!=$prm_xc" . $stmE;
+ $str_sql = $stmS . " ID_CAT!=$prm_xc;" . $stmE;
}
}
if ($stmD) {
- $stmt = $stmS . $stmD . $stmE;
+ $str_sql = $stmS . $stmD . $stmE;
}
}
my $tfId = 0;
my $id = 0;
- my $log_start = index $stmt, "<=";
+ my $log_start = index $str_sql, "<=";
my $re_a_tag = qr/<a\s+.*?>.*<\/a>/si;
- print $cgi->pre("###[Session PARAMS->vc=$prm_vc|xc=$prm_xc|xc_lst=@xc_lst|keepExcludes=".&Settings::keepExcludes."] -> ".$stmt) if $DEBUG;
+ print $cgi->pre("###[Session PARAMS->vc=$prm_vc|xc=$prm_xc|xc_lst=@xc_lst|keepExcludes=".&Settings::keepExcludes."] -> ".$str_sql) if $DEBUG;
if ( $log_start > 0 ) {
#check if we are at the beggining of the LOG table?
- my $stc =
- $db->prepare('SELECT PID from VW_LOG LIMIT 1;');
- $stc->execute();
+ my $stc = traceDBExe('SELECT PID from VW_LOG LIMIT 1;');
my @row = $stc->fetchrow_array();
- $log_top = $row[0];
+ $log_top = $row[0];
if ($log_top == $rs_prev && $rs_cur == $rs_prev ) {
$log_start = -1;
}
my $sum = 0;
my $exp = 0;
my $ass = 0;
- $st = $db->prepare($stmt);
- $rv = $st->execute() or die "<p>Error->" & $DBI::errstri & "</p>";
- if ( $rv < 0 ) {
- print "<p>Error->" & $DBI::errstri & "</p>";
- }
- &buildLog;
+ #place sticky or view param.ed entries first!
+ buildLog(traceDBExe($str_sql));
- if(index ($stmt, 'PID <=') < 1 && !$prm_vc && !$prm_xc && !$rs_keys && !$rs_dat_from){
+ if(index ($str_sql, 'PID <=') < 1 && !$prm_vc && !$prm_xc && !$rs_keys && !$rs_dat_from){
+ $str_sql = "SELECT ID, ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY FROM VW_LOG WHERE STICKY != 1 ORDER BY DATE DESC;";
+ print $cgi->pre("###2 -> ".$str_sql) if $DEBUG;
+ ;
+ &buildLog(traceDBExe($str_sql));
+ }
- $stmt = "SELECT PID, ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY FROM VW_LOG WHERE STICKY != 1;";
- print $cgi->pre("###2 -> ".$stmt) if $DEBUG;
- $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>";
- }
- &buildLog;
+sub traceDBExe {
+ my $sql = shift;
+ try{
+ my $st = $db->prepare($sql);
+ $st -> execute() or LifeLogException->throw("Execute failed [$DBI::errstri]", show_trace=>1);
+ return $st;
+ }catch{
+ LifeLogException->throw(error=>"database error encountered.", show_trace=>1);
}
+}
sub buildLog {
-
- while ( my @row = $st->fetchrow_array() ) {
-
- $id = $row[0];# PID
-
- my $ct = $hshCats{$row[1]}; #ID_CAT
- my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] );
- my $log = $row[3];
- my $am = $row[4];
- my $af = $row[5]; #AFLAG -> Asset as 0, Income as 1, Expense as 2
- my $rtf = $row[6]; #RTF has document true or false
- my $sticky = $row[7]; #Sticky to top
+ my $pst = shift;
+ #print "## str_sql: $str_sql\n";
+ while ( my @row = $pst->fetchrow_array() ) {
+ my $i = 0;
+ $id = $row[$i++]; #ID must be rowid in LOG.
+ my $ct = $hshCats{$row[$i++]}; #ID_CAT
+ my $rtf = $row[$i++]; #ID_RTF since v.1.8
+ my $dt = DateTime::Format::SQLite->parse_datetime( $row[$i++] ); #LOG.DATE
+ my $log = $row[$i++]; #LOG.LOG
+ my $am = $row[$i++]; #LOG.AMOUNT
+ my $af = $row[$i++]; #AFLAG -> Asset as 0, Income as 1, Expense as 2
+ my $sticky = $row[$i++]; #Sticky to top
if ( $af == 1 ) { #AFLAG Income
$sum += $am;
$sub = substr( $log, $idx + 1, $len - $idx - 1 );
my $url = qq(<a href="$sub" target=_blank>$sub</a>);
$tagged = 1;
- $log =~ s/<<LNK<(.*?)>/$url/osi;
+ $log =~ s/<<LNK<(.*?)>+/$url/osi;
}
if ( $log =~ /<<IMG</ ) {
$sub = substr( $log, $idx + 1, $len - $idx - 1 );
my $url = qq(<img src="$sub"/>);
$tagged = 1;
- $log =~ s/<<IMG<(.*?)>/$url/osi;
+ $log =~ s/<<IMG<(.*?)>+/$url/osi;
}
elsif ( $log =~ /<<FRM</ ) {
my $idx = $-[0] + 5;
}
else {
#TODO fetch from web locally the original image.
- $lnk =
-qq(\n<img src="$lnk" width="$imgw" height="$imgh" class="tag_FRM"/>);
+ $lnk =qq(\n<img src="$lnk" width="$imgw" height="$imgh" class="tag_FRM"/>);
}
- $log =~ s/<<FRM<(.*?)>/$lnk/o;
+ $log =~ s/<<FRM<(.*?)>+/$lnk/o;
$tagged = 1;
}
my $idx = $-[0];
my $len = index( $log, '>', $idx ) - 4;
my $sub = "<b>" . substr( $log, $idx + 4, $len - $idx ) . "</b>";
- $log =~ s/<<B<(.*?)>/$sub/o;
+ $log =~ s/<<B<(.*?)>+/$sub/o;
$tagged = 1;
}
while ( $log =~ /<<I</ ) {
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;
+ $log =~ s/<<I<(.*?)>+/$sub/o;
$tagged = 1;
}
while ( $log =~ /<<TITLE</ ) {
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;
+ $log =~ s/<<TITLE<(.*?)>+/$sub/o;
$tagged = 1;
}
##
#Fetch Keywords autocomplete we go by words larger then three.
#
- $st = $db->prepare( 'select LOG from LOG' . $stmE );
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;
if ( $log_rc == 0 ) {
<a id="srch_close" href="#" onclick="return toggle('#div_srh .collpsd');">$sp2</a>
</td>
</tr>
-);
+ );
my $sss_checked = 'checked' if &isInViewMode;
my $divxc = '<td id="divxc_lbl" align="right" style="display:none"><b>Excludes:</b></td><td align="left" id="divxc"></td>';
if(@xc_lst){#Do list of excludes, past from browser in form of category id's.
# Page printout from here! #
################################
-
print qq(<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" style="float:none;"></span></a>
my $date = $cgi->param('date');
my $log = $cgi->param('log');
my $cat = $cgi->param('ec');
- my $cnt;
+ my $cnt ="";
my $am = $cgi->param('am');
my $af = $cgi->param('amf');
my $view_all = $cgi->param('rs_all');
my $rtf = $cgi->param('rtf');
my $sticky = $cgi->param('sticky');
+ my $stm;
-
+ ##TODO
if($rtf eq 'on'){$rtf = 1} else {$rtf = 0}
if($sticky eq 'on'){$sticky = 1} else {$sticky = 0}
if(!$am){$am=0}
#Update
$date = DateTime::Format::SQLite->parse_datetime($date);
- my $stm = qq( UPDATE LOG SET ID_CAT='$cat',
+ $stm = qq( UPDATE LOG SET ID_CAT='$cat', ID_RTF='$rtf',
DATE='$date',
LOG='$log',
AMOUNT='$am',
AFLAG = '$af',
- RTF='$rtf',
- STICKY='$sticky' WHERE rowid="$edit_mode";);
+ STICKY='$sticky' WHERE rowid="$edit_mode";
+ <br>);
#
print $stm if $DEBUG;
#
- my $dbUpd = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } ) or die "<p>Error->" & $DBI::errstri & "</p>";
- my $st = $dbUpd->prepare($stm);
- $st->execute();
+ my $dbUpd = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } ) or LifeLogException->throw("Execute failed [$DBI::errstri]");
+ traceDBExe($stm);
return;
}
if ( $view_all && $view_all == "1" ) {
- $rec_limit = 0;
+ $rec_limit = &Settings::viewAllLimit;
}
if ( $view_mode == "1" ) {
}
- $stmt = qq(SELECT PID, ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY from VW_LOG where PID <= $rs_cur and STICKY != 1 $sand;);
+ $str_sql = qq(SELECT PID, ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY from VW_LOG where PID <= $rs_cur and STICKY != 1 $sand;);
return;
}
}
#check for double entry
#
- my $stm = qq(SELECT DATE,LOG FROM LOG where DATE='$date' AND LOG='$log';);
-
- my $st = $db->prepare($stm);
- $st->execute();
-
+ $date = DateTime::Format::SQLite->parse_datetime($date);
+ $stm = qq(SELECT DATE,LOG FROM LOG where DATE='$date' AND LOG='$log';);
+ my $st = traceDBExe($stm);
if ($st->fetchrow_array() ) {
return;
}
- $stm = qq(INSERT INTO LOG (ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY)
- VALUES($cat, '$date', '$log', $am, $af, $rtf, $sticky);
- );
- print "\n###$stm\n" if $DEBUG;
-
- $st = $db->prepare($stm);
- $st->execute();
+ $stm = qq(INSERT INTO LOG (ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY) VALUES($cat, $rtf, '$date', '$log', $am, $af, $sticky););
+ $st = traceDBExe($stm);
if($sssCDB){
#Allow further new database creation, it is not an login infinite db creation attack.
$sss->param("cdb", 0);
}
-
if($rtf){ #Update 0 ground NOTES entry to the just inserted log.
- $st = $db->prepare('SELECT ID FROM VW_LOG LIMIT 1;');
- $st -> execute();
+ $st = traceDBExe('SELECT ID FROM VW_LOG LIMIT 1;');
my @lid = $st->fetchrow_array();
- $st = $db->prepare("SELECT DOC FROM NOTES WHERE LID = '0';");
- $st -> execute();
+ $st = traceDBExe('SELECT DOC FROM NOTES WHERE LID = 0;');
my @gzero = $st->fetchrow_array();
-
-
if(scalar @lid > 0){
#By Notes.LID constraint, there should NOT be an already existing log rowid entry just submitted in the Notes table!
#What happened? We must check and delete, regardles. As data is renumerated and shuffled from perl in database. :(
- $st = $db->prepare("SELECT LID FROM NOTES WHERE LID = '$lid[0]';");
- $st->execute();
+ $st = traceDBExe("SELECT LID FROM NOTES WHERE LID = '$lid[0]';");
if($st->fetchrow_array()){
- $st = $db->prepare("DELETE FROM NOTES WHERE LID = '$lid[0]';");
- $st->execute();
+ $st = $db->do("DELETE FROM NOTES WHERE LID = '$lid[0]';");
print qq(<p>Warning deleted (possible old) NOTES.LID[$lid[0]] -> lid:@lid</p>);
}
$st = $db->prepare("INSERT INTO NOTES(LID, DOC) VALUES (?, ?);");
- #
$st->execute($lid[0], $gzero[0]);
-
#Flatten ground zero
- $st = $db->prepare("UPDATE NOTES SET DOC='' WHERE LID = 0;");
- $st->execute();
+ $st = $db->prepare("UPDATE NOTES SET DOC='' WHERE LID = 0;");
+ $st->execute();
}
-
-
}
#
# After Insert renumeration check
}
catch {
- print "<font color=red><b>ERROR</b></font> -> " . $_;
- print qq(<html><body><pre>Reached2! -> $cnt, $cat, $date, $log, $am, $af, $rtf, $sticky </pre></body></html
- );
-exit;
- }
+my $err = $@;
+my $pwd = `pwd`;
+$pwd =~ s/\s*$//;
+
+my $dbg = qq(--DEBUG OUTPUT--\n
+ DSN:$dsn
+ stm:$stm
+ \@DB::args:@DB::args
+ \$DBI::err:$DBI::errstr
+ cnt:$cnt, cat:$cat, date:$date, log:$log, am:$am, af:$af, rtf:$rtf, sticky:$sticky);
+print $cgi->header,
+ "<hr><font color=red><b>SERVER ERROR</b></font> on ".DateTime->now.
+ "<hr><pre>$pwd/$0 -> &".caller." -> [<font color=red><b>$DBI::errstr</b></font>] $err\n$dbg</pre>",
+ $cgi->end_html;
+
+ exit;
+}
}
sub buildNavigationButtons {
}
sub authenticate {
- try {
-
- my $st = $db->prepare( "SELECT alias FROM AUTH WHERE alias='$userid' and passw='$password';");
- $st->execute();
- my @c = $st->fetchrow_array();
- if (@c && $c[0] eq $userid ) { return; }
-
- #Check if passw has been wiped for reset?
- $st = $db->prepare("SELECT * FROM AUTH WHERE alias='$userid';");
- $st->execute();
- @c = $st->fetchrow_array();
- if ( @c && $c[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",
- -BGCOLOR => $BGCOL,
- -script =>
- { -type => 'text/javascript', -src => 'wsrc/main.js' },
- -style => { -type => 'text/css', -src => 'wsrc/main.css' },
- );
- if($DEBUG){
- print $cgi->center(
- $cgi->div("<b>Access Denied!</b> alias:$userid pass:$password SQL->SELECT * FROM AUTH WHERE alias='$userid' and passw='$password'; ")
- );
- }
- else{
- print $cgi->center(
- $cgi->div('<h2>Sorry Access Denied!</h2><font color=red><b>You supplied wrong credentials.</b></font>'),
- $cgi->div('<h3>[<a href="login_ctr.cgi">Login</a>]</h3>')
- );
- }
- print $cgi->end_html;
+ try {
- $db->disconnect();
- $sss->flush();
- exit;
+ my $st = traceDBExe("SELECT alias FROM AUTH WHERE alias='$userid' and passw='$password';");
+ my @c = $st->fetchrow_array();
+ if (@c && $c[0] eq $userid ) { return; }
+
+ #Check if passw has been wiped for reset?
+ $st = traceDBExe("SELECT * FROM AUTH WHERE alias='$userid';");
+ @c = $st->fetchrow_array();
+ if ( @c && $c[1] == "" ) {
+ #Wiped with -> UPDATE AUTH SET passw='' WHERE alias='$userid';
+ $st = traceDBExe("UPDATE AUTH SET passw='$password' WHERE alias='$userid';");
+ return;
+ }
+ print $cgi->header( -expires => "+0s", -charset => "UTF-8" );
+ print $cgi->start_html(
+ -title => "Personal Log Login",
+ -BGCOLOR => $BGCOL,
+ -script =>
+ { -type => 'text/javascript', -src => 'wsrc/main.js' },
+ -style => { -type => 'text/css', -src => 'wsrc/main.css' },
+ );
+ if($DEBUG){
+ print $cgi->center(
+ $cgi->div("<b>Access Denied!</b> alias:$userid pass:$password SQL->SELECT * FROM AUTH WHERE alias='$userid' and passw='$password'; ")
+ );
}
- catch {
- print $cgi->header( -expires => "+0s", -charset => "UTF-8" );
- print $cgi->p( "ERROR:" . $_ );
- print $cgi->end_html;
- exit;
+ else{
+ print $cgi->center(
+ $cgi->div('<h2>Sorry Access Denied!</h2><font color=red><b>You supplied wrong credentials.</b></font>'),
+ $cgi->div('<h3>[<a href="login_ctr.cgi">Login</a>]</h3>')
+ );
}
-}
+ print $cgi->end_html;
-sub fetchAutocomplete {
- try {
+ $db->disconnect();
+ $sss->flush();
+ exit;
- while ( my @row = $st->fetchrow_array() ) {
- my $log = $row[0];
+ }
+ catch {
+ print $cgi->header( -expires => "+0s", -charset => "UTF-8" );
+ print $cgi->p( "PAGE ERROR:" . $_ );
+ print $cgi->end_html;
+ exit;
+ }
+}
- #Decode escaped \\n
- $log =~ s/\\n/\n/gs;
- $log =~ s/''/'/g;
+sub fetchAutocomplete {
+ my $st = traceDBExe('SELECT LOG from LOG' . $stmE );
+ while ( my @row = $st->fetchrow_array() ) {
+ my $log = $row[0];
- #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;
- }
+ #Decode escaped \\n
+ $log =~ s/\\n/\n/gs;
+ $log =~ s/''/'/g;
- $autowords .= qq(,"$word");
- if ( $aw_cnt++ > &Settings::autoWordLimit ) {
- last;
- }
+ #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;
}
- }
- if ( $aw_cnt > &Settings::autoWordLimit ) {
- last;
+ $autowords .= qq(,"$word");
+ if ( $aw_cnt++ > &Settings::autoWordLimit ) {
+ last;
+ }
}
}
- }
- catch {
- print "<font color=red><b>SERVER ERROR</b></font>:" . $_;
+ if ( $aw_cnt > &Settings::autoWordLimit ) {
+ last;
+ }
}
}
for your logs HTML layout.
</p>
<p>
- <b><<B<<i>{Text To Bold}</i><b>></b>
+ <b><<B<<i>{Text To Bold}</i><b>>></b>
</p>
<p>
- <b><<I<<i>{Text To Italic}</i><b>></b>
+ <b><<I<<i>{Text To Italic}</i><b>>></b>
</p>
<p>
- <b><<TITLE<<i>{Title Text}</i><b>></b>
+ <b><<TITLE<<i>{Title Text}</i><b>>></b>
</p>
<p>
<b><<LIST<<i>{List of items delimited by new line to terminate item or with '~' otherwise.}</i><b>></b>
</p>
<p>
- <b><<IMG<<i>{url to image}</i><b>></b>
+ <b><<IMG<<i>{url to image}</i><b>>></b>
</p>
<p>
- <b><<FRM<<i>{file name}_frm.png}</i><b>></b><br><br>
+ <b><<FRM<<i>{file name}_frm.png}</i><b>>></b><br><br>
*_frm.png images file pairs are located in the ./images folder of the cgi-bin directory.<br>
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"
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?
</pre>
</p>
<p>
- <b><<LNK<<i>{url to image}</i><b>></b><br><br>
+ <b><<LNK<<i>{url to image}</i><b>>></b><br><br>
Explicitly tag an URL in the log entry.
Required if using in log IMG or FRM tags.
Otherwise link appears as plain text.
use strict;
use warnings;
#no warnings 'uninitialized';
-
-use Try::Tiny;
use Switch;
use CGI;
use DateTime::Format::SQLite;
use Number::Bytes::Human qw(format_bytes);
use IPC::Run qw( run );
+use Syntax::Keyword::Try;
+use lib "system/modules";
+use lib $ENV{'PWD'}.'/htdocs/cgi-bin/system/modules';
+require Settings;
-#SETTINGS HERE!
-my $REC_LIMIT = 25;
-my $TIME_ZONE = 'Australia/Sydney';
-my $LOG_PATH = '../../dbLifeLog/';
-my $RELEASE_VER = "";
-my $THEME = 0;
-my $TH_CSS = 'main.css';
-my $DEBUG = 0;
-#END OF SETTINGS
my $cgi = CGI->new;
-my $session = new CGI::Session("driver:File",$cgi, {Directory=>$LOG_PATH});
+my $session = new CGI::Session("driver:File",$cgi, {Directory=>&Settings::logPath});
my $sid=$session->id();
my $dbname =$session->param('database');
my $userid =$session->param('alias');
my $password=$session->param('passw');
if(!$userid||!$dbname){
- if ($DEBUG){
+ if (&Settings::debug){
$userid ="admin";
$dbname = "data_admin_log.db";
$password = "admin";
exit;
}
}
+my $db = "";
-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>";
+try{
+
+my $database = &Settings::logPath . $dbname;
my @stat = stat $database;
+my $dsn = "DBI:SQLite:dbname=$database";
+$db = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } );
-##################
-&getConfiguration;
-##################
+Settings::getConfiguration($db);
my $today = DateTime->now;
-$today->set_time_zone( $TIME_ZONE );
-
-
-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';
-}
+$today->set_time_zone(&Settings::timezone);
$ENV{'HOME'} = "~/";
print $cgi->header(-expires=>"+6os", -charset=>"UTF-8");
-print $cgi->start_html(-title => "Log Data Stats", -BGCOLOR=>"$BGCOL",
+print $cgi->start_html(-title => "Log Data Stats", -BGCOLOR=>&Settings::bgcol,
-script=> [{-type => 'text/javascript', -src => 'wsrc/main.js'},
{-type => 'text/javascript', -src => 'wsrc/jquery.js' },
- { -type => 'text/javascript', -src => 'wsrc/jquery-ui.js' }],
- -style => [{-type => 'text/css', -src => "wsrc/$TH_CSS"},
- { -type => 'text/css', -src => 'wsrc/jquery-ui.css' },
- { -type => 'text/css', -src => 'wsrc/jquery-ui.theme.css' }],
+ {-type => 'text/javascript', -src => 'wsrc/jquery-ui.js' }],
+ -style => [{-type => 'text/css', -src => "wsrc/".&Settings::css},
+ {-type => 'text/css', -src => 'wsrc/jquery-ui.css' },
+ {-type => 'text/css', -src => 'wsrc/jquery-ui.theme.css' }],
-onload => "onBodyLoadGeneric()"
);
my $IPPublic = `curl -s https://www.ifconfig.me`;
my $IPPrivate = `hostname -I`; $IPPrivate =~ s/\s/<br>/g;
-$tbl .=qq(<tr class="r1"><td>LifeLog App. Version:</td><td>$RELEASE_VER</td></tr>
+$tbl .=qq(<tr class="r1"><td>LifeLog App. Version:</td><td>).&Settings::release.qq(</td></tr>
<tr class="r0"><td>Number of Records:</td><td>$log_rc</td></tr>
<tr class="r1"><td>No. of Records This Year:</td><td>$log_this_year_rc</td></tr>
<tr class="r0"><td>No. of RTF Documents:</td><td>$notes_rc</td></tr>
</div>
<pre>$processes</pre>);
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,
+ "<font color=red><b>SERVER ERROR</b></font> on ".DateTime->now.
+ "<pre>".$pwd."/$0 -> &".caller." -> [$err]","\n</pre>",
+ $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;
}
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 "<font color=red><b>SERVER ERROR</b></font>:".$_;
- }
-
-}
-
-sub dbExecute{
- my $ret = $db->prepare(shift);
- $ret->execute() or die "<p>Error->"& $DBI::errstri &"</p>";
- return $ret;
-}
-
-
-### CGI END
\ No newline at end of file
+1.
\ No newline at end of file
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';
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';
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;
}
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 {
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] }
}
+
+#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 "<p>ERROR with->$sql</p>";
- 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("<p>ERROR with->$sql</p>", 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 {
}
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 "<font color=red><b>SERVER ERROR toLog(6,$stamp,$log)</b></font>:" . $_;
- # }
+ 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 {
}
-#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');");
}
}
lifelog.hopto.org / LifeLog.git / commitdiff