From: Metabox Date: Sat, 20 Jul 2019 23:09:38 +0000 (+1000) Subject: intitial work. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=e50035758ccfdc90a5e71e6fc16d8066af46b722;p=LifeLog.git intitial work. --- diff --git a/htdocs/cgi-bin/json.cgi b/htdocs/cgi-bin/json.cgi index 4bb4ded..f352241 100755 --- a/htdocs/cgi-bin/json.cgi +++ b/htdocs/cgi-bin/json.cgi @@ -20,6 +20,7 @@ use Date::Language; use Date::Parse; use Time::localtime; use Regexp::Common qw /URI/; +use JSON; #DEFAULT SETTINGS HERE! our $REC_LIMIT = 25; @@ -29,7 +30,7 @@ our $PRC_WIDTH = '60'; our $LOG_PATH = '../../dbLifeLog/'; our $SESSN_EXPR = '+30m'; our $DATE_UNI = '0'; -our $RELEASE_VER = '1.4'; +our $RELEASE_VER = '1.5'; our $AUTHORITY = ''; our $IMG_W_H = '210x120'; our $AUTO_WRD_LMT = 200; @@ -40,7 +41,7 @@ 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 $dbname = "";#$session->param('database'); my $userid = $session->param('alias'); my $password = $session->param('passw'); @@ -49,795 +50,54 @@ if ($AUTHORITY) { $dbname = 'data_' . $userid . '_log.db'; } elsif ( !$userid || !$dbname ) { - print $cgi->redirect("login_ctr.cgi?CGISESSID=$sid"); - exit; + # print $cgi->redirect("login_ctr.cgi?CGISESSID=$sid"); + # exit; } my $database = '../../dbLifeLog/' . $dbname; my $dsn = "DBI:SQLite:dbname=$database"; -my $db = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } ) - or die "

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

"; - -my ( $imgw, $imgh ); +my $db; +#$db = DBI->connect( $dsn, $userid, $password, { RaiseError => 1 } ); ### 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'}, +#&authenticate; - ], - -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; +#&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; +my $json = JSON->new->utf8->space_after->pretty->allow_blessed->encode + ({date => DateTime::Format::SQLite->format_datetime($today), + origin => "LifeLog.".$RELEASE_VER, + response => "Feature Under Development!" + }); -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); - } -} +print $cgi->header( -expires => "+0s", -charset => "UTF-8" ); +print $json; -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(); +#$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'); - + # my $date = $cgi->param('date'); + 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 { @@ -865,16 +125,10 @@ sub authenticate { 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->center( - $cgi->div("Access Denied! alias:$userid pass:$password") ); - print $cgi->end_html; $db->disconnect(); $session->flush(); @@ -889,147 +143,6 @@ sub authenticate { } } -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