From 67525bb2a9a1fe72d6a036c07b4d14e007d06a69 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Wed, 4 Mar 2020 04:52:39 +1100 Subject: [PATCH] Merge 1.8.dev --- .gitignore | 16 + CNF_Specs.md | 307 ++++++-- Current Development Check List.md | 69 +- Installation.txt | 56 +- README.md | 7 +- dbLifeLog/main.cnf | 15 +- htdocs/cgi-bin/config.cgi | 671 ++++++++++------- htdocs/cgi-bin/configFileTester.pl | 37 - htdocs/cgi-bin/{remove.cgi => data.cgi} | 182 ++--- htdocs/cgi-bin/json.cgi | 123 ++-- htdocs/cgi-bin/login_ctr.cgi | 627 ++++++++-------- htdocs/cgi-bin/main.cgi | 675 ++++++++++-------- htdocs/cgi-bin/stats.cgi | 118 ++- htdocs/cgi-bin/system/modules/Settings.pm | 373 +++++++--- htdocs/cgi-bin/wsrc/jquery.sweet-dropdown.css | 413 +++++++++++ htdocs/cgi-bin/wsrc/jquery.sweet-dropdown.js | 11 + htdocs/cgi-bin/wsrc/main.css | 79 +- htdocs/cgi-bin/wsrc/main.js | 355 ++++++--- htdocs/cgi-bin/wsrc/main_earth.css | 59 +- htdocs/cgi-bin/wsrc/main_moon.css | 80 ++- htdocs/cgi-bin/wsrc/main_sun.css | 50 +- stopDevWebServer.sh | 4 +- thttpd.conf | 2 +- 23 files changed, 2809 insertions(+), 1520 deletions(-) delete mode 100755 htdocs/cgi-bin/configFileTester.pl rename htdocs/cgi-bin/{remove.cgi => data.cgi} (62%) create mode 100644 htdocs/cgi-bin/wsrc/jquery.sweet-dropdown.css create mode 100644 htdocs/cgi-bin/wsrc/jquery.sweet-dropdown.js diff --git a/.gitignore b/.gitignore index 440d599..8178fe3 100644 --- a/.gitignore +++ b/.gitignore @@ -1,11 +1,14 @@ .vscode .vstags log/thttpd.log +*.log +*.pid thttpd-2.29/ thttpd-2.29/* startDevWebServer.sh thttpd.conf cgisess_* +*.pid # Compiled source # ################### *.com @@ -44,4 +47,17 @@ cgisess_* .Trashes *.db *.swp +*.log + +log/thttpd.log +.gitignore +htdocs/thttpd.pid +htdocs/cgi-bin/wsrc/examples.css +dbLifeLog/*.db-journal +log/*.log +/home/will/dev/LifeLog/log/thttpd.log +dbLifeLog/*.db.tgz +dbLifeLog/*.db.toz +*.db.osz +dbLifeLog/bck/* \ No newline at end of file diff --git a/CNF_Specs.md b/CNF_Specs.md index 1df1d77..d86aa10 100644 --- a/CNF_Specs.md +++ b/CNF_Specs.md @@ -1,111 +1,278 @@ # Configuration Network File Format Specifications - Moon Stage v.1.0 ## Introduction -This is a simple and fast file format. That allowes setting an network application with constant values. -SQL database structures and data. It is designed to accomodate an parser to read and parse CNF tags. -These can be of three types, using an textual similar presentation. -And are recognised as constants, anons and sqlites. -## CNF Formatting Rules - -* Text that isn't CNF tagged is ignored in the file and can be used as comments. -* CNF tag begins with an **<<** and ends with an **>>** -* CNF instructions and constants are uppercase. -* CNF instructions are all uppercase and unique, to its processor. -* A CNF constant in its propety name is prefixed with an '**$**' signifier. - * Constants are ususally scripted at the begining of the file, or parsed first in a separate file. - * The instruction processor can use them if signifier $ surounds the constant name. Therefore, replacing it with the contants value if further found in the file. - - <<$APP_PATH=~/MyApplication>> - <$APP_PATH$/module/main>> - * CNF Constant values can't be changed for th life of the application. - * CNF Constant values can be changed in the file itself only. -* A CNF Anon is to similar to constants but a more simpler property and value only pair. - * Anon is not instruction processed. Hence anonymouse in nature for its value. - * Anon has no signifier. - * Anon value is global to the application and its value can be modified. - - <true>> - <MyApplication Title>> - -* CNF supports basic SQL Database structure statment generation. This is done via instruction based CNF tags. Named sqlites. - * Supported is table, view, index and data creation statments. - * Database statments are generic text, that is not further processed. - * There is no database interaction, handling or processing as part of this processing. +This is a simple and fast file format. That allows setting up of network applications with initial configuration values. +These are usually standard, property and value pairs. Containing possible also SQL database structures statements with basic data. +It is designed to accommodate a parser to read and provide for CNF property tags. These can be of three types, using all a textual similar presentation. +In general are recognised as constants, anons or sqlites. + +Operating system environmental settings or variables are considered only as the last resort to provide for a value. +This is however to be avoided as it hides the attention and expectation for a setting. + +With this type of an application configuration system. Global settings can also be individual scripted with an meaningful description. +Which is pretty much welcomed and encouraged. + +## General CNF Formatting Rules + +1. Text that isn't CNF tagged is ignored in the file and can be used as comments. +2. CNF tag begins with an **<<** or **<<<** and ends with an **>>>** or **>>**. +3. If instruction is contained the tag begins with **<<** and ends with a **>>**. +4. Multi line values are tag ended on a separate line with an **>>>**. +5. CNF tag value can post processed by placing macros making it a template. +6. Standard markup of a macro is to enclose the property name or number with a triple dollar signifier **\$\$\$**{macro}**\$\$\$**. + 1. Presedence of resloving the property name/value is by first passed macros, then config anons and finally the looking up constances. + 2. Nested macros resolving from linked in other properties is currently not supported. +7. CNF instructions and constants are uppercase. + 1. Example 1 format with instruction: ```<<>>``` autonoumus const, with inner properties. + 2. Example 2 format with instruction: ```<<{$sig}{NAME}>>``` A single const property with a multi line value. + 3. Example 3 format with instruction: ```<>>``` A single const property with a multi line value. + 4. Example 4 format with instruction: ```<<{NAME}<{INSTRUCTION}<{value}>>>``` A anon. + 5. Example 5 format with instruction: ```<<{$sig}{NAME}<{INSTRUCTION}\n{value}\n>>>```. + +8. CNF instructions are all uppercase and unique, to the processor. +9. A CNF constant in its property name is prefixed with an '**$**' signifier. +10. Constants are usually scripted at the beginning of the file, or parsed first in a separate file. +11. The instruction processor can use them if signifier $ surrounds the constant name. Therefore, replacing it with the constants value if further found in the file. + +```HTML + <<>> + <>> + ``` + +12. Property names, Constant, Anon refer to the programmatically assinged variable name. +13. CNF Constant values are store specific. +14. Constants can't be changed for the life of the application or service issued. +15. Storage of CNF constants declared can be preceded to the file based one. +16. i.e. If stored in a database or on a network node. After the file declaration fact. +17. Missing file based storage settings can be next queried from the environmental one. + 1. This is to be avoided if possible. +18. File storage encountered constants override system environmental ones. + 1. i.e. System administrator has set them. +19. Database storage encountered constants override file set ones. + 1. i.e. User of application has set them. +20. CNF Constant values can be changed in the script file. + 1. If not present in script file, then an application setting must procede with its default. + 2. CNF Constants can be declared only once during initial parsing of script files. + 3. Rule of thumb is that Constants are synchonized with an applications release version. + 4. Static constants, are script or code only assigned values. + 5. CNF Anons can overide in contrast previously assigned value. +21. A CNF Anon is similar to constants but a more simpler property and value only pair. + 1. Anons are so called because they are unknown or unexpected by the configuration framework, store to object intermidiate. + 2. Constants that turn up in the anon list, are a good indicator that they are not handled from script. Forgotten become anons. + 3. Anons similar to constants, once in the database, overtake the scripted or application default settings value. + 4. Static anons, are those that are set in the database, and/or are not merged with application defaults. + 5. Anons hashed are programatically accessed separately to constants. + 1. It is fine to have several different applications, to share same storage, even if they have different implementation. + 2. Contants will be specific to application, while anons can change in different purpose script files. +22. Anon is not instruction processed. Hence anonymous in nature for its value. +23. Anon has no signifier, and doesn't need to have an application default. +24. Anon value is global to the application and its value can be modified. + + ```HTML + <>> + <>> + ``` + 1. Anon value can be scripted to contain template like but numbered parameters. + 2. When querying for an anon value, replacement parameter array can be passed. + 3. Numbering is from **\$\$\$1\$\$\$**..**$$$(n...)\$\$\$** to be part of its value. Strategically placed. + + ```HTML + <>> + ``` + ```PERL + # Perl language + my $url = $cnf->anon('GET_SUB_URL',('tech','main.cgi')); + # $url now should be: https://www.tech.acme.com/main.cgi + eval ($url =~ m/https:\.*/) + or warn "Failed to obtain expected URL when querying anon -> GET_SUB_URL" + ``` ## CNF Tag Formats ### Property Value Tag - <<{name}<{value}>> + ```HTML + <<{name}<{value}>>> + ``` ### Instruction Value Tag - <<<{instruction} - {value\n...valuen\n}>> + ```HTML + <<<{INSTRUCTION} + {value\n...valuen\n}>>> + ``` ### Full Tag - <<{name}>{instruction} - {value\n...value\n} - >> + ```javascript + <<{$sig}{name}<{INSTRUCTION} + {value\n...value\n} + >>> + ``` **Examples:** - <$HELP - Sorry help is currently. - Not available. - >> - <<> - <> + ```HTML + <<$HELP> + <<> + <> + ``` + +## Database and SQL Instruction Formatting + +(Note - this documentation section not complete, as of 2020-02-14) + +### About + +CNF supports basic SQL Database structure statement generation. This is done via instruction based CNF tags. Named **sqlites**. -## SQL Instruction Formatting +1. Supported is table, view, index and data creation statements. +2. Database statements are generic text, that is not further processed. +3. There is limited database interaction, handling or processing to be provided. + 1. Mainly for storage transfer of CNF constants, from file to database. + 2. File changes precede database storage only in newly assigned constants. +4. Database generated is expected to have a system SYS_CNF_CONFIG table, containing the constants unique name value pairs, with optional description for each. + 1. This is a reserved table and name. + 2. This table must contain a **$RELEASE_VER** constants record at least. -(section not complete, as of 2020-02-04) +### SQLite Formatting -* SQLites have the following reserved instructions. - * TABLE +* SQLites have the following reserved instructions: +1. TABLE - <TABLE + ```HTML + <> - - * INDEX + >>> + ``` +2. INDEX + ```HTML <>> + ``` +3. SQL + 1. SQL statements are actual full SQL placed in the tag body value. + + ```HTML + <VIEW + CREATE VIEW VW_ALIASES AS SELECT ID,ALIAS ORDER BY ALIAS; + >>> + ``` + +4. DATA + 1. Data rows are ended with the **~** delimiter. In the tag body. + 2. Data columns are delimited with the invert quote **`** (back tick) within a row. + 3. These should appear as last in the config file as they are translated into insert statements. + 4. First column is taken as the unique and record identity column (UID). + 5. Data is to be updated in storage if any column other than the UID, has its contents changed in the file. + 1. This behaviour can be controlled by disabling something like an auto file storage update. i.e. during application upgrades. To prevent user set settings to reset to factory defaults. + 2. The result would then be that database already stored data remains, and only new ones are added. This exercise is out of scope of this specification. + + ```HTML + <> + ``` + +1. FILE + 1. Expects a file name assigned value, file containing actual further CNF DATA rows instructions, separately. + 2. The file is expected to be located next to the main config file. + 3. File is to be sequentially buffer read and processed instead as a whole in one go. + 4. The same principles apply in the file as to the DATA instruction CNF tag format, expected to be contained in it. - * SQL - * SQL statments are actual full SQL statments placed in the tag body. + ```HTML + < + ``` - <VIEW - CREATE VIEW VW_ALIASES AS SELECT ID,ALIAS ORDER BY ALIAS; - >> +2. MIGRATE + 1. Migration are brute sql statements to be run based on currently installed previous version of the SQL database. + 2. Migration is to be run from version upwards as stated and in the previous database encountered. + 1. i.e. If encountered old v.1.5, it will be upgraded to v.1.6 first, then v.1.7... + 3. Migration is not run on newly created databases. These create the expected latest data structure. + 4. SQL Statements a separated by ';' terminator. To be executed one by one. - * DATA - * Data columns are delimited with the **`** delimiter. In the tag body. - * These should apear as last in the config file as they are translated into insert statements. + ```HTML + <<1.6> + <<1.8> + ``` - <> +## Sample Perl Language Usage +**~/my_application.pl** file contents: +```PERL + +use lib "system/modules"; +use lib $ENV{'PWD'}.'/perl_dev/WB_CNF/system/modules'; +require CNFParser; +require Settings; + +my @expected = ("$MY_APP_LIB_RELATIVE", "$MY_APP_DB_RELATIVE"); +my $path = $ENV{'PWD'}."/perl_dev/WB_CNF/db/configuration.cnf"; +# Loading twice config here with object constructor with and without path. +# To show dual purpose use. +my $cnf1 = CNFParser->new($path); +# Nothing parsed yet construct. +my $cnf2 = CNFParser->new(); + # We relay that the OS environment has been set for CNF constant settings if missing + # in the configuration file. Adding after parse has no effect if found in file. + $cnf2 -> addENVList(@expected); + # Parse finally now. Parse can be called on multiple different files, if desired. + $cnf2 -> parse($path); +my $LIB_PATH; + +print "List of constants in file: $path\n"; +foreach my $prp ($cnf->constants()){ + print "$prp=", $cnf->constant($prp),"\n"; +} +if(!$cnf->constant('$MY_APP_LIB_RELATIVE')){ + warn 'Missing $MY_APP_LIB_RELATIVE setting.'; + $LIB_PATH = $cnf2->constant('$MY_APP_LIB_RELATIVE'); + die 'Unable to get required $MY_APP_LIB_RELATIVE setting!' if(not $LIB_PATH) +} + +print "Welcome to ", $cnf->constant('$APP_NAME'), " version ", $cnf->constant('$RELEASE_VER'), ".\n"; + +``` +**~//perl_dev/WB_CNF/db/configuration.cnf** file contents: +```HTML +# List command anon with the name of 'list'. +<ls -lh dev|sort> +<<>> + +``` *** + Document is from project -> + + An open source application. +
Moon Stage - v.1.1 2020
- Project -> diff --git a/Current Development Check List.md b/Current Development Check List.md index e0b6640..d7071da 100644 --- a/Current Development Check List.md +++ b/Current Development Check List.md @@ -1,4 +1,4 @@ -# Branch Development LifeLog in Perl - Sun Stage v. 1.7 +# Branch Development LifeLog in Perl *This page lists current development and issues being worked on in the LifeLog app. Being in the **Sun** stage, means there is a production environment. And usable, used. When, the project reaches **Earth** stage. It will be at its final specification. No data structures or major new features can be added or requested anymore. Only bug fixes, enhancements and efficiency fixes, if any at the **Earth** stage.* @@ -9,7 +9,29 @@ This version is not compatible in data structure to prior versions. Data migrati ### v.1.7 Encountered +* ✔ Database backup tgz ball, upload and download button on config page. + * You must have the password you logged in to unscramble the backup. + * Alias -> pass -> backup password. Information required. +* Application log needed in the background for System based logs. * New CNF Development. + * ✔ Migration is currently hard to maintain and data export and import is wrongly reliant to CVS. + * ✔ Anons to be enabled. + * CVS imports/exports are to be made obsolete in the future. It is not safe. + * This will be still available via command line. +* RTF Documents header lister page, to provide for, new log entry assignment, deletion, edits. + * There isnt and shouldn't be a full relationship to docs. Hence new log entries can link to existing, docs. +* ✔Use the pages cat_list meta data elements for dealing with categories in java scripts. +* ✔ New Categories dropdown, grouping in ascending order and presenting in columns of five at a time. +* ✔ Sticky rows bg colour, to be a shade different to other normal rows. +* ✔ Login system log and out to be implemented. With system variable $TRACK_LOGINS to disable/enable. +* ✔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. +* ✔ 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 +42,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. @@ -29,18 +49,31 @@ This version is not compatible in data structure to prior versions. Data migrati ### v.1.6 and less * $CUR_MTH_SVIEW - Start view page is for current month, and the sticky set. -* Some System settings to be stored in session. As these are known even before logon. +* ✔ Some System settings to be stored in session. As these are known even before logon. * i.e. $SESSN_EXPR, $RELEASE_VER, $TIME_ZONE, $LOG_PATH * ✔ Various system setups, not dealing well with $ENV{'home'} in multi perl environment, releases. ## Urgent FIXES and Known Issuses -* Expired sessions, swallow submits into void. +* ✔ Expired sessions, swallow submits into void. * CVS Export and Import has not been implemented for RTF type log entries. -✔ Dynamic toggle of page sections, interaction fixed, bettered. - -## New Features of Minor Relevance - +* ✔ Dynamic toggle of page sections, interaction fixed, bettered. + +## Planned New Possible Features of Minor Relevance + +* Plugin subpages. + * Configured in main.cnf + * Appear on menu or as dropdouwn in the header. + * Downloaded/Configurated from the configuration page. +* View save feature. Where you name and save to config or session a dropdown of views. +* Fit to page log. Making log subpage scrollable rather than whole page to see the bottom. +* Make session timeot sub pages aware via JSON. +* Multiple category assignment table (set via hashtags and end of a post). +* Log cards Export/Import. Send log entries via email or USB, why not? +* 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. * Enable Armour Mode @@ -53,8 +86,16 @@ This version is not compatible in data structure to prior versions. Data migrati ## Bugs -### v. 1.7 Encountered/Fixed +### v. 1.8 Encountered/Fixed +* ✔ Bug 19 - Same day datediff is displaying wrong report in time stack on the page. +* ✔ 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 - Editing 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. @@ -77,11 +118,13 @@ This version is not compatible in data structure to prior versions. Data migrati * ✔ Bug - 04, Local not picked up properly on current date. * ✔ Bug - 03, Keyword search not working on words as they are categorized wrongly by other dropdown in the background. * ✔ Bug - 02, Record set paging to previous page not always working. Getting stuck. - * This occurs on new records placed in the far past. Complex problem. + * This occurs on new records placed in the far past. Complex problem. * ✔ Bug - 01, date validation for proper entered time, there is no 24 h. *** - Checked (✔) Are items that have been done and submitted to the branch. + Document is from project -> + + An open source application. - Project -> +
Sun Stage v.1.8 - 2020
diff --git a/Installation.txt b/Installation.txt index 80108d7..4244fe1 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 @@ -103,26 +103,34 @@ NOTICE -> Above Perl installation and modules can take time as they build (compi using your computers configuration and hardware for optimal performance. The Perl::LanguageServer, can fail in tests, as it development specific, can be ignored. +#Install OpenSSL (Optional) +https://www.openssl.org/ +sudo apt install openssl + + +# LifeLog Required Perl modules. +### +# since 1.8 switched to: +# before was -> sudo cpanm Try::Tiny; +sudo cpan Log::Log4per +sudo cpan Syntax::Keyword::Try -# 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 +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 +138,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 +153,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 +165,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 +176,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 +197,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 +233,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/README.md b/README.md index 955a80e..cc8571e 100644 --- a/README.md +++ b/README.md @@ -11,12 +11,15 @@ Latest version is **1.7 release** in **Sun** stable stage, requiring some Perl https://www.sqlite.org/index.html database is required to run this web application. -## New in Life Log version 1.7 +## New in Life Log version 1.7 + - Views updated, having option to exlude by category now, during the session logging. -- New system configuration options. +- New system configuration options. i.e. $DEBUG for some sql statements. - Server system based snapshot logs, on stats invocation. - Server indentifier on login. + ## Life Log version 1.5+ + - Ritch Text Documents can be attached to Logs. - Theme support. Change the look and feel. From the congiguration page. - Expenses and Income totals, various new calculations. diff --git a/dbLifeLog/main.cnf b/dbLifeLog/main.cnf index 5686d79..a690b4c 100644 --- a/dbLifeLog/main.cnf +++ b/dbLifeLog/main.cnf @@ -1,11 +1,14 @@ +!CNF1.0 This is the main configuration file for the LifeLog applications settings. https://github.com/wbudic/LifeLog This is an Open Source License project -> https://choosealicense.com/licenses/isc/ Credential format:< , dont enable here using AUTO_LOGIN option bellow, use config in app. < +# BACKUP_ENABLED -> Enable (1), disable (0) backups to be restored from config page. +< < -00|$RELEASE_VER = 1.7`LifeLog Application Version. +00|$RELEASE_VER = 1.8`LifeLog Application Version. 01|$REC_LIMIT = 25`Records shown per page. 03|$TIME_ZONE = Australia/Sydney`Time zone of your country. 05|$PRC_WIDTH = 80`Default presentation width for pages. @@ -21,6 +24,8 @@ Credential format:< , dont enable here using AUT 28|$THEME = Standard`Theme to applay, Standard, Sun, Moon, Earth. 30|$DEBUG = 0`Development page additional debug output, off (default) or on. 32|$KEEP_EXCS = 0`Cache excludes between sessions, off (default) or on. +34|$VIEW_ALL_LMT=1000`Limit of all records displayed for large logs. Set to 0, for unlimited. +36|$TRACK_LOGINS=1`Create system logs on login/logout of Life Log. < 01|Unspecified `For quick uncategorised entries. 03|File System `Operating file system/Application short log. @@ -35,6 +40,8 @@ Credential format:< , dont enable here using AUT 52|Sport/Club `Sport or Social related entry. 55|Cars `Car(s) related entry. 60|Online `Online purchases (ebay, or received/ordered from online source). +88|Diary `Diary specific log and entry. Your daily yaddi-yadda that have decided to place here. +90|Fitness `Fitness steps, news, info, and usefull links. Ammount is steps. < NOTES|DROP TABLE NOTES;' ver. 1.5 fts4 virtual tables have been scratched as they require special SQLite compilation. LOG<5>|Run Query ' ver. 1.5 @@ -79,3 +86,9 @@ UPDATE LOG SET AFLAG=2 WHERE ID_CAT=%EXPENSE_ID%; LOG<6>|Run Query ' ver. 1.6 ALTER TABLE LOG ADD STICKY BOOL DEFAULT 0; +LOG<6>|Run Query ' ver. 1.8 + +CREATE TABLE notes_temp_table (LID INTEGER PRIMARY KEY NOT NULL, DOC TEXT); +INSERT INTO notes_temp_table SELECT `LID`,`DOC` FROM `NOTES`; +DROP TABLE `NOTES`; +ALTER TABLE `notes_temp_table` RENAME TO `NOTES`; diff --git a/htdocs/cgi-bin/config.cgi b/htdocs/cgi-bin/config.cgi index 4b0b4d8..f2d2682 100755 --- a/htdocs/cgi-bin/config.cgi +++ b/htdocs/cgi-bin/config.cgi @@ -5,28 +5,28 @@ # 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; use DateTime::Duration; use Date::Language; use Text::CSV; +use Scalar::Util qw(looks_like_number); +use Sys::Syslog qw(:DEFAULT :standard :macros); #DEFAULT SETTINGS HERE! 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 +35,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 +46,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); @@ -55,20 +55,21 @@ my $db = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }) or die "

my $rv; my $dbs; -my $today = DateTime->now; my $lang = Date::Language->new(&Settings::language); +my $today = DateTime->now; + $today->set_time_zone( &Settings::timezone ); my $tz = $cgi->param('tz'); my $csvp = $cgi->param('csv'); &exportToCSV if ($csvp); -if($cgi->param('data_cat')){ - &importCatCSV; -}elsif($cgi->param('data_log')){ - &importLogCSV; -} +if($cgi->param('bck')) {&backup;} +elsif($cgi->param('bck_del')) {&backupDelete;} +elsif($cgi->param('data_bck')){&restore;} +elsif($cgi->param('data_cat')){&importCatCSV;} +elsif($cgi->param('data_log')){&importLogCSV;} + -$today->set_time_zone( &Settings::timezone ); my $stmtCat = 'SELECT * FROM CAT ORDER BY ID;'; my $status = "Ready for change!"; @@ -95,10 +96,11 @@ print qq(

@@ -507,26 +531,30 @@ 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

"; } } + + openlog($dsn, 'cons,pid', "user"); + syslog('info', 'Status:%s', $status); + syslog('info', 'Password change request for %s', $$userid); + closelog(); + + } elsif ($change == 1){ @@ -548,7 +576,7 @@ elsif ($change == 1){ $d->execute(); while(my @r = $d->fetchrow_array()) { - $s = " LOG SET ID_CAT=1 WHERE rowid=".$r[0].";"; + $s = "UPDATE LOG SET ID_CAT=1 WHERE rowid=".$r[0].";"; $d = $db->prepare($s); $d->execute(); } @@ -572,7 +600,6 @@ elsif ($change == 1){ if($change > 1){ - my $caid = $cgi->param('caid'); my $canm = $cgi->param('canm'); my $cade = $cgi->param('cade'); @@ -615,57 +642,62 @@ elsif($chdbfix){ if( $isByCat || $isByDate){ - my $output = qq(
+ my $output = qq( - - - + + + ); my $sel =""; - if ($isByCat){$sel = "ID_CAT ='$category'"} + if($isByCat){$sel = "ID_CAT ='$category'"} if($isByDate){ - if ($isByCat){ $sel .= " AND ";} + $sel .= " AND " if ($isByCat); $sel .= "DATE<='$del_date_from'"; } - $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 = 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 - my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] ); - my $log = $row[3]; - - my ( $dty, $dtf ) = $dt->ymd; - my $dth = $dt->hms; - if ( &Settings::universalDate == 1 ) { - $dtf = $dty; - } - else { - $dtf = $lang->time2str( "%d %b %Y", $dt->epoch, &Settings::timezone ); - } + my $ct = $hshCats{$row[1]}; #ID_CAT + my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] ); + my $log = $row[3]; + my ( $dty, $dtf ) = $dt->ymd; + my $dth = $dt->hms; + if ( &Settings::universalDate == 1 ) { + $dtf = $dty; + } + else { + $dtf = $lang->time2str( "%d %b %Y", $dt->epoch, &Settings::timezone ); + } - $output .= qq( - - - - - ); + $log =~ s/''/'/g; + $log =~ s/\\n/
/gs; + + $output .= qq( + + + + + ); }#while - $output .= qq( +

Select Categories To Delete

Date

Select Categories To Delete

Date Time Log# Category
$dtf$dth$log$ct - -
$dtf$dth$log$ct + +
- + $output .= qq(
+ To Top + Go Back + +
); - &getTheme; + &Settings::getTheme; &getHeader; print "
$output
"; @@ -684,33 +716,46 @@ 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]","
", + + + } + + openlog($dsn, 'cons,pid', "user"); + syslog('info', 'Status:%s', $status); + syslog('err', '%s', $ERROR) if ($ERROR); + closelog(); } -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 +783,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 +812,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 LifeLogException->throw($DBI::errstri); $dbs = $db->do("VACUUM;"); @@ -779,7 +824,7 @@ try{ } catch{ $db->do('ROLLBACK;'); - die qq(@&processDBFix error -> $_ with statement->$sql for $date update counter:$cntr_upd); + LifeLogException->throw(error=>qq(@&processDBFix error -> $_ with statement->[$sql] for $date update counter:$cntr_upd \nERROR->$@),show_trace=>1); } } @@ -827,14 +872,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,43 +932,166 @@ 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); + 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){ + Settings::configProperty($db, $r[0], undef, $var); + $updated = 1; + } } - catch{ - print "SERVER ERROR->changeSystemSettings:".$_; + Settings::getConfiguration($db) if($updated); +} + + +sub backupDelete { + my $n = $cgi->param('bck_del'); + my $f = &Settings::logPath.$n; +try{ + if (-e $f) { + LifeLogException->throw("File -> [$n] is not a backup file or it doesn't belong to $userid (you)!") if(index ($file , /bck_\d+$userid\_log/) == -1 ); + unlink($f) or LifeLogException->throw("Failed to delete $n! -> $!"); + print $cgi->redirect("config.cgi?CGISESSID=$sid"); + exit; + } else { + LifeLogException->throw( "File $n does not exist!"); } +}catch{ + my $err = $@; + &getHeader; + print $cgi->start_html; + print qq(
Delete Has Failed!
[$err]
+ + ); + print $cgi->end_html; + exit; +}; } +sub backup { -sub updCnf { - my ($id, $val, $s) = @_; - $s = "UPDATE CONFIG SET VALUE='".$val."' WHERE ID=".$id.";"; + my $ball = 'bck__'.$today->strftime('%Y%m%d%H%M%S_')."$dbname.osz"; + my $pipe = "tar czf - ".&Settings::logPath.'main.cnf' ." $database | openssl enc -k $pass:$userid -e -des-ede3-cfb -out ".Settings::logPath().$ball." 2>/dev/null"; + my $rez = `$pipe`; + + #print $cgi->header; + #print $cgi->start_html; + print $cgi->header(-charset=>"UTF-8", -type=>"application/octet-stream", -attachment=>$ball); + open (TAR, "<".Settings::logPath().$ball) or die "Failed creating backup -> $ball"; + while(){print $_;} + close TAR; + + #print $cgi->end_html; + exit; + +} + + +sub restore { + + my $hndl = $cgi->upload("data_bck"); + my ($pipe,@br); try{ - dbExecute($s); + + + &getHeader; + print $cgi->start_html; + print "
Reading->$hndl
"; + my $dbck = &Settings::logPath."bck/"; `mkdir $dbck` if (!-d $dbck); + my $tar = $dbck.$hndl; $tar =~ s/osz$/tar/; + my $pipe; + open ($pipe, "| openssl enc -k $pass:$userid -d -des-ede3-cfb -in /dev/stdin 2>/dev/null > $tar"); #| tar zt");#1>/dev/null"); + while(<$hndl>){print $pipe $_;}; + close $pipe; + + print "
\n";
+        my $m1 = "it is not permitted to restore another aliases log backup.";
+        $m1= "has your log password changed?" if ($tar=~/_data_$userid/);
+
+        my $cmd = `tar tvf $tar 2>/dev/null`  or die qq(, possible an security issue, $m1\nFAILED READING $tar. \nYour alias is: $userid.\n);
+
+        print "Contents->".$cmd."\n\n";
+        $cmd = `tar xzvf $tar -C $dbck --strip-components 1 2>/dev/null` or die "Failed extracting $tar";
+        print "Extracted->\n".$cmd."\n" or die "Failed extracting $tar";;
+
+        my $b_base = $dbck.$dbname;
+        my $dsn= "DBI:SQLite:dbname=$b_base";
+        my $b_db = DBI->connect($dsn, $userid, $pass, { RaiseError => 1 }) or LifeLogException->throw(error=>"Invalid database! $dsn->$hndl [$@]", show_trace=>&Settings::debug);
+        print "Connected to -> $dsn\n";
+
+        print "Merging from backup categories table...\n";
+        my $insCAT   = $db->prepare('INSERT INTO CAT (ID, NAME, DESCRIPTION) VALUES(?,?,?);') or die "Failed CAT prepare.";
+
+        my $b_pst = Settings::selectRecords($b_db,'SELECT ID, NAME, DESCRIPTION FROM CAT;');
+        while ( @br = $b_pst->fetchrow_array() ) {
+            my $pst = Settings::selectRecords($db, "SELECT ID,NAME,DESCRIPTION FROM CAT WHERE ID='".$br[0]."';");
+            my @ext = $pst->fetchrow_array();
+            if(scalar(@ext)==0){
+                $insCAT->execute($br[0],$br[1],$br[2]);
+                print "Added CAT->".$br[0]."|".$br[1]."\n";
+            }
+            elsif($br[0] ne $ext[0] or $br[1] ne $ext[1]){
+                $db->do("UPDATE CAT SET NAME='".$br[1]."', DESCRIPTION='".$br[2]."' WHERE ID=?;") or die "Cat update failed!";
+                print "Updated->".$br[0]."|".$br[1]."|".$br[2]."\n";
+            }
+
+        }
+        print "\nFinished with merging CAT table.\n";
+
+        print "\n\nMerging from backup LOG table...\n";
+        my $insLOG   = $db->prepare('INSERT INTO LOG (ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY) VALUES(?,?,?,?,?,?,?);')or die "Failed LOG prepare.";
+
+        $b_pst = Settings::selectRecords($b_db,'SELECT ID, ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY FROM VW_LOG;');
+        while ( @br = $b_pst->fetchrow_array() ) {
+            my $pst = Settings::selectRecords($db,"SELECT DATE FROM VW_LOG WHERE DATE='".$br[3]."';");
+            my @ext = $pst->fetchrow_array();
+            if(scalar(@ext)==0){
+                $insLOG->execute($br[1],$br[2],$br[3],$br[4],$br[5],$br[6],$br[7]);
+                print "Added->".$br[0]."|".$br[3]."|".$br[4]."\n";
+            }
+
+        }
+        print "\nFinished with merging LOG table.\n";
+
+        print "\n\nMerging from backup NOTES table...\n";
+        my $insNOTES   = $db->prepare('INSERT INTO NOTES (LID, DOC) VALUES(?,?);')or die "Failed NOTESprepare.";
+        $b_pst = Settings::selectRecords($b_db,'SELECT LID, DOC FROM NOTES;');
+        while ( @br = $b_pst->fetchrow_array() ) {
+            my $pst = Settings::selectRecords($db,"SELECT LID FROM NOTES WHERE LID=".$br[0].";");
+            my @ext = $pst->fetchrow_array();
+            if(@ext==0&&$br[0]&&$br[1]){
+                $insNOTES->execute($br[0], $br[1]) or die "Failed NOTES INSERT[".$br[0]."]";
+                print "Added NOTES->".$br[0]."\n";
+            }
+
+        }
+        print "\nFinished with merging NOTES table.\n";
+
+        $b_db->disconnect();
+        $db->disconnect();
+        print "Done!";
     }
     catch{
-        print "SERVER ERROR->updCnf[$s]:".$_;
-    }
-}
+        $ERROR = "Restore failed! hndl->$hndl $@ \nbr:[@br]";#,show_trace=>&Settings::debug);
+    };
 
+    my $back = $cgi->url( -relative => 1 );
+    print $ERROR if($ERROR);
+    print "\n
"; + print qq(
Go Back
or Go to LOG
); + print $cgi->end_html; + exit; + +} 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){ @@ -954,29 +1122,33 @@ sub exportToCSV { sub importCatCSV { my $hndl = $cgi->upload("data_cat"); - my $csv = Text::CSV->new ( { binary => 1, strict => 1, eol => $/ } ); - while (my $line = <$hndl>) { - chomp $line; - if ($csv->parse($line)) { - my @flds = $csv->fields(); - updateCATDB(@flds); - }else{ - warn "Data could not be parsed: $line\n"; - } + my $csv; try{ + $csv = Text::CSV->new ( { binary => 1, strict => 1, eol => $/ } ); + while (my $line = <$hndl>) { + chomp $line; + if ($csv->parse($line)) { + my @fields = $csv->fields(); + updateCATDB(@fields); + }else{ + warn "Data could not be parsed: $line\n"; + } + } } + catch{ + LifeLogException->throw(error=>"Category update failed! CSV_STATUS->".$csv->error_diag()."\nfile_hndl->$hndl",show_trace=>&Settings::debug); + }; } sub updateCATDB { - my @flds = @_; - if(@flds>2){ - try{ - my $id = $flds[0]; - my $name = $flds[1]; - my $desc = $flds[2]; + my @fields = @_; + if(@fields>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; @@ -984,69 +1156,84 @@ sub updateCATDB { else{ #TODO Update } - - } - catch{ - print "SERVER ERROR->updateCATDB:".$_; } + else{ + LifeLogException->throw("Invalid CSV data format!"); } } sub importLogCSV { my $hndl = $cgi->upload("data_log"); - my $csv = Text::CSV->new ( { binary => 1, strict => 1, eol => $/ } ); + my $csv; + try{ + + $csv = Text::CSV->new ( { binary => 1, strict => 1, eol => $/ } ); + + while (my $line = <$hndl>) { + chomp $line; + if ($csv->parse($line)) { + my @fields = $csv->fields(); + updateLOGDB(@fields); + }else{ + warn "Data could not be parsed: $line\n"; + } + } + &renumerate; + $db->disconnect(); + print $cgi->redirect('main.cgi'); - while (my $line = <$hndl>) { - chomp $line; - if ($csv->parse($line)) { - my @flds = $csv->fields(); - updateLOGDB(@flds); - }else{ - warn "Data could not be parsed: $line\n"; - } } - &renumerate; - $db->disconnect(); - print $cgi->redirect('main.cgi'); + catch{ + LifeLogException->throw(error=>"Log update failed! CSV_STATUS->".$csv->error_diag()."\nfile_hndl->$hndl",show_trace=>&Settings::debug); + }; exit; } sub updateLOGDB { - my @flds = @_; - if(@flds>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 $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(); - 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->finish(); - } - catch{ - print "SERVER ERROR->exportLogToCSV:".$_; + my @fields = @_; + if(scalar(@fields)>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++]; + # Is it old pre. 1.8 format -> ID, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY + if(!looks_like_number($id_rtf)){ + $i = 0; + $id_cat = $fields[$i++]; + $date = $fields[$i++]; + $log = $fields[$i++]; + $amv = $fields[$i++]; + $amf = $fields[$i++]; + $id_rtf = $fields[$i++]; + $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? + $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, $id_rtf, $pdate, $log, $amv, $amf, $sticky); + } + $dbs->finish(); } + else{ + LifeLogException->throw("Invalid CSV data format!"); } } 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(); + my $url = $cgi->url(-path_info => 1); print qq(

Sorry Encountered Errors

Page -> $url

$ERROR

); print qq(

CGI Parameters

); print "
    \n"; @@ -1079,41 +1261,34 @@ 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;'); + $db->do("CREATE TABLE life_log_temp_table AS SELECT * FROM LOG;"); + $dbs = Settings::selectRecords($db, 'SELECT rowid, DATE FROM LOG WHERE ID_RTF >0 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); - my @new = $dbs->fetchrow_array(); - if(scalar @new > 0){ - $db->do("UPDATE NOTES SET LID =". $new[0]." WHERE LID==".$row[0].";"); + if($sql_date){#could be an improperly deleted record in there? Skip if there is! + #$sql_date =~ s/T/ /; + $sql_date = DateTime::Format::SQLite->parse_datetime($sql_date); + $sql = "SELECT rowid, DATE FROM life_log_temp_table WHERE ID_RTF > 0 AND DATE = '".$sql_date."';"; + $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 ( - 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('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;'); + $db->do('DROP TABLE LOG;'); + $db->do(&Settings::createLOGStmt); + $db->do(q(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;'); } 1; \ No newline at end of file diff --git a/htdocs/cgi-bin/configFileTester.pl b/htdocs/cgi-bin/configFileTester.pl deleted file mode 100755 index 11628d6..0000000 --- a/htdocs/cgi-bin/configFileTester.pl +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl -w -# -# Programed by: Will Budic -# Open Source License -> https://choosealicense.com/licenses/isc/ -# -use strict; -use warnings; -use Try::Tiny; - -use DateTime; -use DateTime::Format::SQLite; -use DateTime::Duration; -use Text::CSV; - -#DEFAULT SETTINGS HERE! -use lib "system/modules"; - -use lib $ENV{'PWD'}.'/htdocs/cgi-bin/system/modules'; -require CNFParser; - -my $cnf = CNFParser->new(); - -$cnf->parse($ENV{'PWD'}."/dbLifeLog/database.cnf"); - -foreach ($cnf->SQLStatments()){ - print "$_\n"; -} -foreach my $p ($cnf->constants()){ - - print "$p=", $cnf->constant($p),"\n"; -} -# foreach (sort keys %ENV) { -# print "$_= $ENV{$_}\n"; -# } - -### CGI END -1; diff --git a/htdocs/cgi-bin/remove.cgi b/htdocs/cgi-bin/data.cgi similarity index 62% rename from htdocs/cgi-bin/remove.cgi rename to htdocs/cgi-bin/data.cgi index db7792b..6fa00f4 100755 --- a/htdocs/cgi-bin/remove.cgi +++ b/htdocs/cgi-bin/data.cgi @@ -6,13 +6,14 @@ use strict; use warnings; -use Try::Tiny; use Switch; - + use CGI; use CGI::Session '-ip_match'; use DBI; +use Exception::Class ('LifeLogException'); +use Syntax::Keyword::Try; use DateTime qw(); use DateTime::Format::SQLite; @@ -37,14 +38,14 @@ 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, $password, { RaiseError => 1 }) or LifeLogException->throw($DBI::errstri); #Fetch settings my $imgw = 210; my $imgh = 120; Settings::getConfiguration($db); Settings::getTheme(); - +my $human = DateTime::Format::Human::Duration->new(); ### Page specific settings Here @@ -52,52 +53,35 @@ my $PRC_WIDTH = &Settings::pagePrcWidth; my $TH_CSS = &Settings::css; my $BGCOL = &Settings::bgcol; #Set to 1 to get debug help. Switch off with 0. -my $DEBUG = &Settings::debug; +my $DEBUG = &Settings::debug; #END OF SETTINGS my $today = DateTime->now; $today->set_time_zone(&Settings::timezone); -my %hshCats ={}; my $tbl_rc =0; -my $stm; -my $stmtCat = "SELECT ID, NAME FROM CAT;"; -my $st = $db->prepare( $stmtCat ); -my $rv = $st->execute(); +my ($stm,$st, $rv); - -while(my @row = $st->fetchrow_array()) { - $hshCats{$row[0]} = $row[1]; -} - - -my $tbl = '
    +my $tbl = ' - '; + '; my $datediff = $cgi->param("datediff"); my $confirmed = $cgi->param('confirmed'); if ($datediff){ - print $cgi->header(-expires=>"+6os"); + print $cgi->header(-expires=>"+6os"); print $cgi->start_html(-title => "Date Difference Report", -BGCOLOR => $BGCOL, -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"} - ); + ); &DisplayDateDiffs; -}elsif (!$confirmed){ - print $cgi->header(-expires=>"+6os"); - print $cgi->start_html(-title => "Personal Log Record Removal", -BGCOLOR => $BGCOL, - -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, - -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"} - - ); - - - &NotConfirmed; +}elsif ($confirmed){ + &ConfirmedDelition; }else{ - &ConfirmedDelition; + print $cgi->redirect('main.cgi') if not $cgi->param('chk'); + &NotConfirmed; } @@ -106,104 +90,136 @@ $db->disconnect(); exit; sub DisplayDateDiffs{ + $tbl = '
    Date TimeLogCategory
    Date Time Log Category
    '; - $stm = 'SELECT DATE, LOG FROM LOG WHERE '; + $stm = 'SELECT DATE, LOG FROM VW_LOG WHERE '; my @ids = $cgi->param('chk'); + @ids = reverse @ids; + foreach (@ids){ - $stm .= "rowid = '" . $_ ."'"; + $stm .= "PID = " . $_ .""; if( \$_ != \$ids[-1] ) { $stm = $stm." OR "; } } - $stm .= ';'; + $stm .= ' ORDER BY PID;'; + print $cgi->pre("###[stm:$stm]") if($DEBUG); $st = $db->prepare( $stm ); - $st->execute() or die or die "

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

    "; + $st->execute(); - my $dt_prev = $today; + my ($dt,$dif,$first,$last,$tnext, $dt_prev) = (0,0,0,0,0,$today); while(my @row = $st->fetchrow_array()) { - - my $dt = DateTime::Format::SQLite->parse_datetime( $row[0] ); - my $dif = dateDiff($dt_prev, $dt); - $tbl .= ' - ". - ''; - $dt_prev = $dt; + my $rdat = $row[0]; + my $rlog = $row[1]; + $rlog =~ m/\n/; + $dt = DateTime::Format::SQLite->parse_julianday( $rdat ); + $dt->set_time_zone(&Settings::timezone); + $dif = dateDiff($dt_prev, $dt); + $tbl .= ' + ". + ''; + $last = $dt_prev; + $dt_prev = $dt; + if($tnext){ + $dif = dateDiff($today, $dt,''); + $tbl .= ''; + } + else{$tnext=1; $first = $dt;} + } + if($first != $last){ + $dif = dateDiff($first, $dt_prev,'(first above)'); + $tbl .= ''; } $tbl .= '
    * DATE DIFFERENCES *
    '. $dt->ymd . ''.$row[1]."
    '.$dif. '
    '. $dt->ymd . ''.$rlog."
    '.$dif.'
    '.$dif. '
    '.$dif. '
    '; -print '
    '.$tbl.'

    '; +print '
    '.$tbl.'

    '; } -sub dateDiff{ - my($d1,$d2)=@_; - my $span = DateTime::Format::Human::Duration->new(); - my $dur = $span->format_duration($d2 - $d1); -return sprintf( "%s
    between %s and %s", $dur, boldDate($d1), boldDate($d2)); +sub dateDiff { + my($d1,$d2,$ff,$sw)=@_; + if($d1->epoch()>$d2->epoch()){ + $sw = $d1; + $d1 = $d2; + $d2 = $sw; + }else{$sw="";} + my $dur = $human->format_duration_between($d1, $d2); + my ($t1,$t2) = ("",""); + $t1 = " today " if ($d1->ymd() eq $today->ymd());# Notice in perl == can't be used here! + $t2 = " today " if ($d2->ymd() eq $today->ymd()); +return sprintf( "%s
    between $ff $t1 %s and $t2 %s[%s]", $dur, boldDate($d1), boldDate($d2), $d1->ymd()); } -sub boldDate{ +sub boldDate { my($d)=@_; -return "".$d->ymd." ".$d->hms; +return "".$d->ymd()." ".$d->hms; } -sub ConfirmedDelition{ +sub ConfirmedDelition { +try{ foreach my $id ($cgi->param('chk')){ - + print $cgi->p("###[deleting:$id]") if(Settings::debug()); $st = $db->prepare("DELETE FROM LOG WHERE rowid = '$id';"); $rv = $st->execute() or die or die "

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

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

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

    "; - exit; - } - + # if($rv == 0) { + # die "

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

    "; + # } + } - - $st->finish; print $cgi->redirect('main.cgi'); +}catch{ + print $cgi->p("ERROR " . $_); } -sub NotConfirmed{ +} - my $stmS = "SELECT rowid, ID_CAT, DATE, LOG from LOG WHERE"; - my $stmE = " ORDER BY DATE DESC, rowid DESC;"; +sub NotConfirmed { + + my $stmS = "SELECT ID, PID, (select NAME from CAT WHERE ID_CAT == CAT.ID) as CAT, DATE, LOG from VW_LOG WHERE"; + my $stmE = " ORDER BY DATE DESC, ID DESC;"; #Get ids and build confirm table and check my $stm = $stmS ." "; foreach my $id ($cgi->param('chk')){ - $stm = $stm . "rowid = '" . $id . "' OR "; + $stm = $stm . "PID = " . $id . " OR "; } - #OR end to rid=0 hack! ;) - $stm = $stm . "rowid = '0' " . $stmE; - # + $stm =~ s/ OR $//; $stm .= $stmE; + $st = $db->prepare( $stm ); - $rv = $st->execute() or die "

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

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

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

    "; - } + $rv = $st->execute(); + print $cgi->header(-expires=>"+6os"); + print $cgi->start_html(-title => "Personal Log Record Removal", -BGCOLOR => $BGCOL, + -script=>{-type => 'text/javascript', -src => 'wsrc/main.js'}, + -style =>{-type => 'text/css', -src => "wsrc/$TH_CSS"} + + ); + + print $cgi->pre("###NotConfirmed($rv,$st)->[stm:$stm]") if($DEBUG); my $r_cnt = 0; my $rs = "r1"; + + while(my @row = $st->fetchrow_array()) { - my $ct = $hshCats{$row[1]}; - my $dt = DateTime::Format::SQLite->parse_datetime( $row[2] ); - my $log = log2html($row[3]); - - $tbl = $tbl . ''. $dt->ymd . "" . + my $ct = $row[2]; + my $dt = DateTime::Format::SQLite->parse_datetime( $row[3] ); + my $log = log2html($row[4]); + + $tbl = $tbl . ''. $dt->ymd . "" . '' . $dt->hms . "" . ''."$log\n". '' . $ct. ''; @@ -220,9 +236,9 @@ sub NotConfirmed{ $plural = "s"; } - $tbl = $tbl . ' + $tbl = $tbl . '
    -

    Please Confirm You Want
    The Above Record'.$plural.' Deleted?

    +

    Please Confirm You Want
    The Above Record'.$plural.' Deleted?

    (Or hit you Browsers Back Button!)
    @@ -240,7 +256,7 @@ print '
    ' . $tbl .'
    '; sub log2html{ my $log = shift; my ($re_a_tag, $sub) = qr/.*<\/a>/si; - $log =~ s/''/'/g; + $log =~ s/''/'/g; $log =~ s/\r\n/
    /gs; $log =~ s/\\n/
    /gs; @@ -249,7 +265,7 @@ sub log2html{ my $len = index( $log, '>', $idx ); $sub = substr( $log, $idx + 1, $len - $idx - 1 ); my $url = qq($sub); - $log =~ s/</$url/osi; + $log =~ s/<+/$url/osi; } if ( $log =~ /<', $idx ); $sub = substr( $log, $idx + 1, $len - $idx - 1 ); my $url = qq(); - $log =~ s/</$url/osi; + $log =~ s/<+/$url/osi; } elsif ( $log =~ /<); } - $log =~ s/</$lnk/o; + $log =~ s/<+/$lnk/o; } #Replace with a full link an HTTP URI @@ -300,7 +316,7 @@ sub log2html{ $log =~ s/$a/$b/o; $a = q(); $b = q(); - $log =~ s/$a/$b/o; + $log =~ s/$a/$b/o; } else { my @chnks = split( /($re_a_tag)/si, $log ); diff --git a/htdocs/cgi-bin/json.cgi b/htdocs/cgi-bin/json.cgi index 9675152..89f00ff 100755 --- a/htdocs/cgi-bin/json.cgi +++ b/htdocs/cgi-bin/json.cgi @@ -26,25 +26,13 @@ use IO::Compress::Gzip qw(gzip $GzipError); use Compress::Zlib; -#DEFAULT SETTINGS HERE! -our $REC_LIMIT = 25; -our $TIME_ZONE = 'Australia/Sydney'; -our $LANGUAGE = 'English'; -our $PRC_WIDTH = '60'; -our $LOG_PATH = '../../dbLifeLog/'; -our $SESSN_EXPR = '+30m'; -our $DATE_UNI = '0'; -our $RELEASE_VER = '1.5'; -our $AUTHORITY = ''; -our $IMG_W_H = '210x120'; -our $AUTO_WRD_LMT = 200; - -#END OF SETTINGS +use lib "system/modules"; +require Settings; + my $cgi = CGI->new; -my $session = - new CGI::Session( "driver:File", $cgi, { Directory => $LOG_PATH } ); -my $sid = $session->id(); +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'); @@ -53,17 +41,14 @@ my $lid = $cgi->param('id'); my $doc = $cgi->param('doc'); my $bg = $cgi->param('bg'); my $error = ""; -my ($response, $json) = 'Session Expired'; +my ($nid,$response, $json) = 'Session Expired'; -my $lang = Date::Language->new($LANGUAGE); +#my $lang = Date::Language->new($LANGUAGE); my $today = DateTime->now; -$today->set_time_zone($TIME_ZONE); +$today->set_time_zone(&Settings::timezone); -if ($AUTHORITY) { - $userid = $password = $AUTHORITY; - $dbname = 'data_' . $userid . '_log.db'; -} -elsif ( !$userid || !$dbname ) { + +if ( !$userid || !$dbname ) { &defaultJSON; print $cgi->header( -expires => "+0s", -charset => "UTF-8" ); @@ -72,18 +57,17 @@ elsif ( !$userid || !$dbname ) { exit; } -my $database = '../../dbLifeLog/' . $dbname; -my $dsn = "DBI:SQLite:dbname=$database"; -my $db = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } ); +my $database = Settings::logPath().$dbname; +my $dsn= "DBI:SQLite:dbname=$database"; +my $db = DBI->connect($dsn, $userid, $password, { RaiseError => 1 }); -### Authenticate session to alias password -#&authenticate; +Settings::getConfiguration($db); my $strp = DateTime::Format::Strptime->new( pattern => '%F %T', locale => 'en_AU', - time_zone => $TIME_ZONE, + time_zone => Settings::timezone(), on_error => 'croak', ); @@ -102,56 +86,55 @@ undef($session); exit; -sub defaultJSON(){ +sub defaultJSON { - my $content = ""; + my $content = ""; if($action eq 'load' && !$error){ - $content = JSON->new->utf8->decode($doc); + $content = JSON->new->utf8->decode($doc); } $json = JSON->new->utf8->space_after->pretty->allow_blessed->encode - ({date => $strp->format_datetime($today), - response_origin => "LifeLog.".$RELEASE_VER, + ({date => $strp->format_datetime($today), + response_origin => "LifeLog.".Settings::release(), alias => $userid, log_id => $lid, database=>$database, action => $action, error=>$error, - response=>$response, + response=>$response, content=>$content - #received => $doc - }); + #received => $doc + }); } sub processSubmit { # my $date = $cgi->param('date'); my $st; - - try { + + try { if($action eq 'store'){ -$doc = qq({ -"lid":"$lid", -"bg":"$bg", -"doc":$doc -}); + $doc = qq({ + "lid":"$lid", + "bg":"$bg", + "doc":$doc + }); my $zip = compress($doc, Z_BEST_COMPRESSION); - $st = $db->prepare("SELECT LID FROM NOTES WHERE LID = '$lid';"); - $st -> execute(); + $st = $db->prepare("SELECT LID FROM NOTES WHERE LID = $lid;"); + $st -> execute(); if($st->fetchrow_array() eq undef) { - $st = $db->prepare("INSERT INTO NOTES(LID, DOC) VALUES (?, ?);"); + $st = $db->prepare("INSERT INTO NOTES(LID, DOC) VALUES (?, ?);"); $st->execute($lid, $zip); $response = "Stored Document (id:$lid)!"; } else{ - $st = $db->prepare("UPDATE NOTES SET DOC = ? WHERE LID = '$lid';"); + $st = $db->prepare("UPDATE NOTES SET DOC = ? WHERE LID = $lid;"); $st->execute($zip); $response = "Updated Document (id:$lid)!"; } - } elsif($action eq 'load'){ - $st = $db->prepare("SELECT DOC FROM NOTES WHERE LID = '$lid';"); + $st = $db->prepare("SELECT DOC FROM NOTES WHERE LID = $lid;"); $st -> execute(); my @arr = $st->fetchrow_array(); - if(!@arr){ - $st = $db->prepare("SELECT DOC FROM NOTES WHERE LID = '0';"); + if(@arr eq undef){ + $st = $db->prepare("SELECT DOC FROM NOTES WHERE LID = '0';"); $st -> execute(); @arr = $st->fetchrow_array(); } @@ -167,23 +150,17 @@ $doc = qq({ $error = "Your action ($action) sux's a lot!"; } - } - catch { - $error = ":LID[$lid]-> ".$_; + }catch { + $error = ":LID[$lid]-> ".$_; } } sub authenticate { - try { + try { - if ($AUTHORITY) { - return; - } - my $st = $db->prepare( - "SELECT * FROM AUTH WHERE alias='$userid' and passw='$password';" - ); + my $st = $db->prepare("SELECT * FROM AUTH WHERE alias='$userid' and passw='$password';"); $st->execute(); if ( $st->fetchrow_array() ) { return; } @@ -200,7 +177,7 @@ sub authenticate { return; } - + print $cgi->center( $cgi->div("Access Denied! alias:$userid pass:$password") ); @@ -209,15 +186,11 @@ sub authenticate { $session->flush(); exit; - } - catch { - print $cgi->header( -expires => "+0s", -charset => "UTF-8" ); - print $cgi->p( "ERROR:" . $_ ); - print $cgi->end_html; - exit; + }catch { + print $cgi->header( -expires => "+0s", -charset => "UTF-8" ); + print $cgi->p( "ERROR:" . $_ ); + print $cgi->end_html; + exit; } } - - - - +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..ef02d33 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,13 +14,13 @@ 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"; require Settings; - +my $BACKUP_ENABLED = 0; my $cgi = CGI->new; my $session = new CGI::Session("driver:File",$cgi, {Directory=>&Settings::logPath}); @@ -35,161 +36,249 @@ 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 = ""; + $hst = `hostname` . "($ht[0])" if (@ht); + + $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); $session->param('passw', $passw); $session->param('database', 'data_'.$alias.'_log.db'); $session->flush(); + ### To MAIN PAGE 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, $end,$crest); + open(my $fh, '<', &Settings::logPath.'main.cnf' ) or LifeLogException->throw("Can't open main.cnf: $!"); + while (my $line = <$fh>) { + chomp $line; + if(rindex ($line, "<", 14; + $crest = substr $line, 13, $end - 13; + @cre = split '/', $crest; + next; + } + elsif(rindex ($line, "<", 18; + $BACKUP_ENABLED = substr $line, 17, $end - 17; + last; #we expect as last anon to be set. + } + elsif(rindex ($line, "<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){##TODO we already connected here to the db, why do it again later? + 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 LifeLogException->throw("

    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 &"

    "; - my $rv; - my $st = $db->prepare(selSQLTbl('LOG')); - $st->execute(); - - my $changed = 0; - - if(!$st->fetchrow_array()) { - my $stmt = qq( - CREATE TABLE LOG ( - ID_CAT TINY NOT NULL, - DATE DATETIME NOT NULL, - LOG VCHAR(128) NOT NULL, - AMOUNT INTEGER DEFAULT 0, - AFLAG TINY DEFAULT 0, - RTF BOOL DEFAULT 0, - STICKY BOOL DEFAULT 0 - ); - CREATE INDEX idx_log_dates ON LOG (DATE); - ); + my $db = DBI->connect($dsn, $alias, $passw, { RaiseError => 1 }) or LifeLogException->throw($DBI::errstri); + my ($pst, $sql,$rv, $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($curr_tables{'CONFIG'}) { + #Set changed if 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 in the (present) database. + my $DEF_VERSION = Settings::release(); + Settings::getConfiguration($db,{backup_enabled=>$BACKUP_ENABLED}); + my $DB_VERSION = Settings::release(); + my $hasLogTbl = $curr_tables{'LOG'}; + my $hasNotesTbl = $curr_tables{'NOTES'}; + my @annons = Settings::anons(); + LifeLogException -> throw("Annons!") if (@annons==0);#We even added above the backup_enabled anon, so WTF? + + # Reflect anons to db config. + $sql = "SELECT ID, NAME, VALUE FROM CONFIG WHERE"; + foreach my $ana(@annons){$sql .= " NAME LIKE '$ana' OR";};$sql =~ s/OR$//; $sql .=';'; + $pst = Settings::selectRecords($db, $sql); + while(my @row = $pst->fetchrow_array()) { + my ($vid,$n,$sv, $dv) = ($row[0], $row[1], Settings::anon($row[1]), $row[2]); + $db->do("UPDATE CONFIG SET VALUE='$sv' WHERE ID=$vid;") if($dv ne $sv); + } + # + # 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. + Settings::debug(1); + my @names = @{Settings::getTableColumnNames($db, 'LOG')}; + #perl 5.28+ <-- + #if ( 'RTF' ~~ @names ) { + if(grep( /RTF/, @names)){ + $db->do('DROP TABLE life_log_login_ctr_temp_table;') if($curr_tables{'life_log_login_ctr_temp_table'}); + $db->do('CREATE TABLE life_log_login_ctr_temp_table AS SELECT * FROM LOG;'); + my %notes_ids = (); + if($hasNotesTbl){ + $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;'); + #v.1.8 Has fixes, time also properly to take into the sort. Not crucial to drop. + $db->do('DROP TABLE VW_LOG;');delete($curr_tables{'VW_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;'); + + #Experimental sofar NOTES table has LID changed to proper number type. + $db->do(qq(CREATE TABLE life_log_rename_column_new_table ( + LID INTEGER NOT NULL PRIMARY KEY, DOC TEXT);)); + $db->do('INSERT INTO life_log_rename_column_new_table SELECT `LID`,`DOC` FROM `NOTES`;'); + $db->do('DROP TABLE `NOTES`;'); + $db->do('ALTER TABLE `life_log_rename_column_new_table` RENAME TO `NOTES`'); + + + #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; + } + #Version change still detected above. + #Need to run slow populuate check from config file. + $changed = 1; + } + + if(!$hasLogTbl) { if($sssCreatedDB){ print $cgi->header; @@ -200,128 +289,61 @@ 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 &"

    ";} + # This should make queries faster, less convulsed, and log renumeration less needed for accurate pagination. + 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; + }else{ + # If empty something happened to it. It shouldn't be EMPTY! + my @ret=Settings::selectRecords($db, "SELECT count(0) from CAT;")->fetchrow_array(); + $changed = 1 if (!$ret[0]); } #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; + #TODO Multiple cats per log future table. + if(!$curr_tables{'LOGCATSREF'}) { + $db->do(&Settings::createLOGCATSREFStmt); + } - $rv = $db->do($stmt); - if($rv < 0){print "

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

    "}; - $st = $db->prepare("SELECT ALIAS, PASSW, EMAIL, ACTION FROM AUTH WHERE alias='$alias' AND passw='$passw';"); - $st->execute(); - my @res = $st->fetchrow_array(); - if(scalar @res == 0) { - $st = $db->prepare('INSERT INTO AUTH VALUES (?,?,?,?);'); - $st->execute($alias, $passw,"",0); - } + if(!$curr_tables{'AUTH'}) { + $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()) { - $rv = $db->do('DROP TABLE NOTES;'); - if($rv < 0){print "

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

    "}; + if($curr_tables{'NOTES_content'}) { + $db->do('DROP TABLE NOTES;'); + $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()) { - my $stmt = qq( - CREATE TABLE NOTES (LID PRIMARY KEY NOT NULL, DOC TEXT); - ); - $rv = $db->do($stmt); - if($rv < 0){print "

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

    "}; - } - - - $st = $db->prepare(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(!$hasNotesTbl) {$db->do(&Settings::createNOTEStmt);} + + 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 next 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,74 +351,56 @@ 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."); - &populate($db); + &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; } - } - else{ &populate($db); } + Settings::toLog($db, "Log accessed by $alias.") if(&Settings::trackLogins); # - $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 $tt = 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 LifeLogException->throw( "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 (?,?,?)'); - $db->begin_work(); + my $insConfig = $db->prepare('INSERT INTO CONFIG VALUES (?,?,?,?)'); + my $insCat = $db->prepare('INSERT INTO CAT VALUES (?,?,?)'); + $db->begin_work(); foreach my $line (@lines) { - last if ($line =~ //); - my @tick = split("`",$line); + last if ($line =~ //);#Not doing it with CNF1.0 - if( index( $line, '<' ) == 0 ) {next;} #Migration is complex main.cnf contains though SQL alter statements. + if( index( $line, '<prepare("SELECT ID FROM CAT WHERE NAME LIKE '$pair[1]';"); - $st->execute(); - $inData = 1; - if(!$st->fetchrow_array()) { - $insCat->execute($pair[0],$pair[1],$tick[1]); + # In older DB versions the Category name could be different, user modified. + # The unique id and name interwined, changed. Hence we check on name first. + # Then check if the ID is available. If not just skip, the import. Reseting can fix that latter. + if(!Settings::selectRecords($db, "SELECT ID FROM CAT WHERE NAME LIKE '$pair[1]';")->fetchrow_array()) { + if(!Settings::selectRecords($db, "SELECT ID FROM CAT WHERE ID = $pair[0];")->fetchrow_array()){ + $insCat->execute($pair[0],$pair[1],$tick[1]); + } } + $inData = 1; } else { $err .= "Invalid, spec'ed {uid}|{category}`{description}-> $line\n"; } - }elsif($table_type==2){ - #TODO Do we really want this? + }elsif($tt==2){ + #TODO Do we really want this? Insert into log from config script. } }elsif($inData && length($line)>0){ @@ -454,34 +461,51 @@ $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; - } + LifeLogException->throw(error=>"Configuration script ".&Settings::logPath."/main.cnf [$fh] contains errors. Err:$err", show_trace=>1) 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 { + + if(&Settings::trackLogins){ + try{ + $alias = $session->param('alias'); + $passw = $session->param('passw'); + my $database = &Settings::logPath.'data_'.$alias.'_log.db'; + my $dsn= "DBI:SQLite:dbname=$database"; + my $db = DBI->connect($dsn, $alias, $passw, { RaiseError => 1 }) + or LifeLogException->throw($DBI::errstri); + Settings::toLog($db, "Log properly loged out by $alias."); + $db->disconnect(); + }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; + } + } + - $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!

    @@ -496,6 +520,11 @@ sub logout{ ); print $cgi->end_html; + + $session->delete(); + $session->flush(); + + exit; } diff --git a/htdocs/cgi-bin/main.cgi b/htdocs/cgi-bin/main.cgi index 9159591..371d2af 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; @@ -21,13 +22,14 @@ use Date::Parse; use Time::localtime; use Regexp::Common qw /URI/; +use List::MoreUtils qw(uniq); #DEFAULT SETTINGS HERE! 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 +42,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("Connection failed [$DBI::errstri]"); my ( $imgw, $imgh ); #Fetch settings Settings::getConfiguration($db); @@ -55,18 +56,17 @@ 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"); my $prm_xc = $cgi->param("xc"); -my $prm_xc_lst = $cgi->param("idx_cat_x"); +my $prm_xc_lst = $cgi->param("xclst"); my $rs_dat_from = $cgi->param('v_from'); my $rs_dat_to = $cgi->param('v_to'); my $rs_prev = $cgi->param('rs_prev'); my $rs_cur = $cgi->param('rs_cur'); my $rs_page = $cgi->param('rs_page'); -my $stmS = 'SELECT ID, 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; @@ -84,8 +84,9 @@ my $lang = Date::Language->new(Settings::language()); my $today = DateTime->now; $today -> set_time_zone(Settings::timezone()); -#Excludes can be now set as permanent to page view excluded, visible if view searched. +#Excludes can be now be set as permanent to page view excluded, visible if view searched. #http://localhost:8080/cgi-bin/main.cgi?vc=0&category=0&xc=0&idx_cat_x=0&v_from=&v_to=&keywords=&srch_reset=0 + if(!$prm_vc && &Settings::keepExcludes){ if($prm_xc_lst){ &Settings::configProperty($db, 201, '^EXCLUDES', $prm_xc_lst); @@ -108,7 +109,7 @@ if ( $rs_dat_from && $rs_dat_to ) { #Toggle if search deployed. my $toggle = ""; -if ( $rs_keys || $rs_cat_idx || $stmD || $prm_vc > 0 || $prm_xc > 0) { $toggle = 1; } +if ( $rs_keys || $stmD || $prm_vc > 0 || $prm_xc > 0) { $toggle = 1; } ##Handle Session Keeps @@ -124,28 +125,43 @@ if($cgi->param('srch_reset') == 1){ $sss->clear('sss_xc'); } -if($prm_vc){ - if ($cgi->param('sss_xc') eq 'on'){ - $sss->param('sss_vc', $prm_vc) - } - else{ - $sss->clear('sss_vc'); - } -}else{ - $prm_vc = $sss->param('sss_vc'); -} -if($prm_xc){ + +if($prm_xc &&$prm_xc ne ""){ +#TODO (2020-02-23) It gets too complicated. should not have both $prm_xc and $prm_xc_lst; + $prm_xc =~ s/^0*//g;$prm_xc_lst=~ s/^\,$//g; + if(!$prm_xc_lst||$prm_xc_lst==0){#} && index($prm_xc, ',') > 0){ + $prm_xc_lst = $prm_xc; + }else{ + my $f; + my @xc_lst = split /\,/, $prm_xc_lst; @xc_lst = uniq(sort { $a <=> $b } @xc_lst); + foreach my $n(@xc_lst){ + if($n == $prm_xc){ $f=1; last; } + } + if(!$f){#not found view was clicked changing category but not adding it to ex list. Let's add it to the list. + $prm_xc_lst .= ",$prm_xc"; + } + $prm_xc_lst=~ s/\,$//g;$prm_xc_lst=~ s/\,\,/\,/g; + } + + if ($cgi->param('sss_xc') eq 'on'){ - $sss->param('sss_xc', $prm_xc) + $sss->param('sss_xc', $prm_xc); + $sss->param('sss_xc_lst', $prm_xc_lst); } else{ $sss->clear('sss_xc'); + $sss->clear('sss_xc_lst'); } + + }else{ $prm_xc = $sss->param('sss_xc'); + $prm_xc_lst = $sss->param('sss_xc_lst'); } -my @xc_lst = split /\,/, $prm_xc_lst; + +## +my @xc_lst = split /\,/, $prm_xc_lst; @xc_lst = uniq(sort { $a <=> $b } @xc_lst); $sss->flush(); @@ -183,6 +199,7 @@ print $cgi->start_html( { -type => 'text/css', -src => 'wsrc/quill/katex.min.css' }, { -type => 'text/css', -src => 'wsrc/quill/monokai-sublime.min.css' }, { -type => 'text/css', -src => 'wsrc/quill/quill.snow.css' }, + { -type => 'text/css', -src => 'wsrc/jquery.sweet-dropdown.css' }, ], -script => [ @@ -205,69 +222,57 @@ print $cgi->start_html( { -type => 'text/javascript', -src => 'wsrc/jscolor.js' }, { -type => 'text/javascript', -src => 'wsrc/moment.js' }, { -type => 'text/javascript', -src => 'wsrc/moment-timezone-with-data.js' }, + { -type => 'text/javascript', -src => 'wsrc/jquery.sweet-dropdown.js'} ], ); -my $rv; + my $st; -my $stmtCat = "SELECT ID, NAME, DESCRIPTION FROM CAT ORDER BY ID;"; -my $stmt = "SELECT ID, ID_CAT, DATE, LOG, AMOUNT, AFLAG, RTF, STICKY FROM VW_LOG WHERE STICKY = 1;"; +my $sqlCAT = "SELECT ID, NAME, DESCRIPTION FROM CAT ORDER BY ID;"; +my $sqlVWL = "SELECT ID, ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY FROM VW_LOG WHERE STICKY = 1 LIMIT ".&Settings::viewAllLimit.";"; -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($sqlCAT); +$st->execute() or LifeLogException->throw($DBI::errstri); -my $cats = qq('; -$cats_v .= ''; -$cats_x .= ''; for my $key ( keys %hshDesc ) { my $kv = $hshDesc{$key}; - if ( $kv ne ".." ) { - $cat_desc .= qq(
  1. $kv
  2. \n); + if ( $kv ne ".." && index($key,'HASH(0x')!=0) { + my $n = $hshCats{$key}; + $data_cats .= qq(\n); } } my $log_output = -qq(
    +qq( @@ -277,15 +282,12 @@ qq(Edit); - if ( defined $prm_vc ) { #view category form selection - $rs_cat_idx = $prm_vc; - } if ( $rs_keys && $rs_keys ne '*' ) { my @keywords = split / /, $rs_keys; - if ($rs_cat_idx && $rs_cat_idx != $prm_xc) { - $stmS .= " ID_CAT='" . $rs_cat_idx . "' AND"; + if ($prm_vc && $prm_vc != $prm_xc) { + $stmS .= " ID_CAT='" . $prm_vc . "' AND"; } else { if($prm_xc>0){ @@ -308,16 +310,16 @@ qq(vc=$prm_vc|xc=$prm_xc|xc_lst=@xc_lst|keepExcludes=".&Settings::keepExcludes."] -> ".$stmt) if $DEBUG; + print $cgi->pre("###[Session PARAMS->isV:$isView|vc=$prm_vc|xc=$prm_xc|xc_lst=$prm_xc_lst|\@xc_lst=@xc_lst|keepExcludes=".&Settings::keepExcludes."] -> ".$sqlVWL) 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; } @@ -375,41 +377,45 @@ qq(prepare($stmt); - $rv = $st->execute() or die "

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

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

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

    "; - } - - &buildLog; - if(index ($stmt, 'PID <=') < 1 && !$prm_vc && !$prm_xc && !$rs_keys && !$rs_dat_from){ + #place sticky or view param.ed entries first! + buildLog(traceDBExe($sqlVWL)); + #Following is saying is in page selection, not view selection, or accounting on type of sticky entries. + if( !$isView && !$prm_vc && !$prm_xc && !$rs_keys && !$rs_dat_from ){ + $sqlVWL = "SELECT ID, ID_CAT, ID_RTF, DATE, LOG, AMOUNT, AFLAG, STICKY FROM VW_LOG WHERE STICKY != 1 LIMIT ".&Settings::viewAllLimit.";"; + print $cgi->pre("###2 -> ".$sqlVWL) if $DEBUG; + ; + &buildLog(traceDBExe($sqlVWL)); + } - $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 "

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

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

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

    "; - } - &buildLog; +sub traceDBExe { + my $sql = shift; + try{ + print "do:$sql" if ($DEBUG); + 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 "## sqlVWL: $sqlVWL\n"; + while ( my @row = $pst->fetchrow_array() ) { + my $i = 0; + $id = $row[$i++]; #ID must be rowid in LOG. + my $cid = $row[$i++]; #CID ID_CAT not used. + my $ct = $hshCats{$cid}; #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; @@ -436,7 +442,7 @@ sub buildLog { if ( $log_rc_prev == 0 ) { $log_rc_prev = $id; } - if ( $tfId == 1 ) { + if ( $tfId > 0) { $tfId = 0; } else { @@ -454,7 +460,7 @@ sub buildLog { $sub = substr( $log, $idx + 1, $len - $idx - 1 ); my $url = qq($sub); $tagged = 1; - $log =~ s/</$url/osi; + $log =~ s/<+/$url/osi; } if ( $log =~ /<); $tagged = 1; - $log =~ s/</$url/osi; + $log =~ s/<+/$url/osi; } elsif ( $log =~ /<); + $lnk =qq(\n); } - $log =~ s/</$lnk/o; + $log =~ s/<+/$lnk/o; $tagged = 1; } @@ -527,7 +532,7 @@ qq(\n); my $idx = $-[0]; my $len = index( $log, '>', $idx ) - 4; my $sub = "" . substr( $log, $idx + 4, $len - $idx ) . ""; - $log =~ s/</$sub/o; + $log =~ s/<+/$sub/o; $tagged = 1; } while ( $log =~ /<); my $len = index( $log, '>', $idx ) - 4; last if $len<6; my $sub = "" . substr( $log, $idx + 4, $len - $idx ) . ""; - $log =~ s/</$sub/o; + $log =~ s/<+/$sub/o; $tagged = 1; } while ( $log =~ /<); my $len = index( $log, '>', $idx ) - 8; last if $len<9; my $sub = "

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

    "; - $log =~ s/</$sub/o; + $log =~ s/<+/$sub/o; $tagged = 1; } @@ -623,9 +628,13 @@ qq(\n); } my $ssymb = "Edit"; - $ssymb = "Edit ✵" if $sticky; + my $ssid = $tfId; + if ($sticky){ + $ssymb = "Edit ✵"; + $ssid = $tfId + 2; + } - $log_output .= qq(
    + $log_output .= qq( @@ -680,13 +689,9 @@ qq(\n); ## #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 "

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

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

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

    "; - } + &fetchAutocomplete; if ( $log_rc == 0 ) { @@ -697,8 +702,8 @@ qq(\n); } elsif ($rs_keys) { my $criter = ""; - if ( $rs_cat_idx > 0 ) { - $criter = "->Criteria[" . $hshCats{$rs_cat_idx} . "]"; + if ( $prm_vc > 0 ) { + $criter = "->Criteria[" . $hshCats{$prm_vc} . "]"; } $log_output .= qq(); @@ -749,10 +754,20 @@ _TXT . $today->ymd . " " . $today->hms . qq(">   -   - + @@ -779,6 +794,7 @@ _TXT
    Date
    $dtf $dth $log
    Search Failed to Retrive any records on keywords: [$rs_keys]$criter!
    Category: - $cats -

    +   + + + Enter log... + +
    Category:  +       --Select --       + + + +
    Log:
    + @@ -799,35 +815,74 @@ _TXT $sp2 -); + ); my $sss_checked = 'checked' if &isInViewMode; - my $divxc = 'Excludes:'; + my $tdivxc = 'Excludes:'; + my $catselected = '   -- Select --   '; + my $xcatselected = '   -- Select --   '; + my $xc_lst = ''; + if($prm_vc){ + $catselected = $hshCats{$prm_vc}; + my $n = 16 - length($catselected); + $catselected =~ s/^(.*)/' ' x $n . $1/e; + } + if(@xc_lst){#Do list of excludes, past from browser in form of category id's. my $xcls =""; - foreach(@xc_lst){ $xcls .= $hshCats{$_}.','} - $xcls =~ s/\,$//g; - $divxc = 'Excludes:'.$xcls.''; + foreach(@xc_lst){ $xcls .= $hshCats{$_}.',';$xc_lst.=$_.','} + $xcls =~ s/\,$//g; $xcls =~ s/\,\,/\,/g; $xc_lst=~ s/^0\,$//g; + $xcatselected = $hshCats{$prm_xc}; + my $n = 16 - length($xcatselected); + $xcatselected =~ s/^(.*)/' ' x $n . $1/e; + $tdivxc = 'Excludes:'.$xcls.''; + } + elsif($prm_xc){ + $xcatselected = $hshCats{$prm_xc}; + my $n = 16 - length($xcatselected); + $xcatselected =~ s/^(.*)/' ' x $n . $1/e; + $tdivxc = 'Excludes:'.$hshCats{$prm_xc}.''; } $srh .= qq( View by Category: - $cats_v   - - + + + $catselected + + + + + + Exclude Category: - $cats_x   - + + + $xcatselected + + + + + + + + +    -    +   +        Keep In Seession - $divxc + $tdivxc View by Date: @@ -844,7 +899,7 @@ _TXT ); - if ( ( $rs_keys && $rs_keys ne '*' ) || $rs_cat_idx || $stmD || $prm_xc ) { + if ( ( $rs_keys && $rs_keys ne '*' ) || $prm_vc || $stmD || $prm_xc ) { $sm_reset_all = 'Reset View
    '; $srh .= ' @@ -860,8 +915,8 @@ _TXT # Page printout from here! # ################################ - -print qq(