From bfeb2bd20ead195357a7cc733a3fb1029198521c Mon Sep 17 00:00:00 2001 From: Metabox Date: Thu, 18 Jul 2019 13:06:11 +1000 Subject: [PATCH] Added JSON module. --- Installation.txt | 1 + htdocs/cgi-bin/json.cgi | 1035 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 1036 insertions(+) create mode 100755 htdocs/cgi-bin/json.cgi diff --git a/Installation.txt b/Installation.txt index 9a5b940..402b971 100644 --- a/Installation.txt +++ b/Installation.txt @@ -77,6 +77,7 @@ sudo cpanm CGI::Session; sudo cpanm Try::Tiny; sudo cpanm Number/Bytes/Human.pm; sudo cpanm Regexp::Common; +sudo cpanm JSON; #Upgrade Instructions diff --git a/htdocs/cgi-bin/json.cgi b/htdocs/cgi-bin/json.cgi new file mode 100755 index 0000000..4bb4ded --- /dev/null +++ b/htdocs/cgi-bin/json.cgi @@ -0,0 +1,1035 @@ +#!/usr/bin/perl +# +# Programed in vim by: Will Budic +# Open Source License -> https://choosealicense.com/licenses/isc/ +# +use strict; +use warnings; +use Try::Tiny; +use Switch; + +use CGI; +use CGI::Session '-ip_match'; +use CGI::Carp qw ( fatalsToBrowser ); +use DBI; + +use DateTime; +use DateTime::Format::SQLite; +use DateTime::Duration; +use Date::Language; +use Date::Parse; +use Time::localtime; +use Regexp::Common qw /URI/; + +#DEFAULT SETTINGS HERE! +our $REC_LIMIT = 25; +our $TIME_ZONE = 'Australia/Sydney'; +our $LANGUAGE = 'English'; +our $PRC_WIDTH = '60'; +our $LOG_PATH = '../../dbLifeLog/'; +our $SESSN_EXPR = '+30m'; +our $DATE_UNI = '0'; +our $RELEASE_VER = '1.4'; +our $AUTHORITY = ''; +our $IMG_W_H = '210x120'; +our $AUTO_WRD_LMT = 200; + +#END OF SETTINGS + +my $cgi = CGI->new; +my $session = + new CGI::Session( "driver:File", $cgi, { Directory => $LOG_PATH } ); +my $sid = $session->id(); +my $dbname = $session->param('database'); +my $userid = $session->param('alias'); +my $password = $session->param('passw'); + +if ($AUTHORITY) { + $userid = $password = $AUTHORITY; + $dbname = 'data_' . $userid . '_log.db'; +} +elsif ( !$userid || !$dbname ) { + print $cgi->redirect("login_ctr.cgi?CGISESSID=$sid"); + exit; +} + +my $database = '../../dbLifeLog/' . $dbname; +my $dsn = "DBI:SQLite:dbname=$database"; +my $db = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } ) + or die "

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    +
    View Statistics

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