#
use v5.34; #use diagnostics;
use warnings;
-use strict; no warnings "experimental::smartmatch";
+use strict;
+no warnings "experimental::smartmatch";
use Exception::Class ('LifeLogException');
use Syntax::Keyword::Try;
use DBI;
-use DBD::Pg; use DBD::Pg qw(:pg_types);
-use Date::Language; use Date::Parse;
+use DBD::Pg;
+use DBD::Pg qw(:pg_types);
+use Date::Language;
+use Date::Parse;
use Time::localtime;
use Regexp::Common qw /URI/;
my $db = Settings::fetchDBSettings();
my $cgi = Settings::cgi();
my $sss = Settings::session();
-my $sid = Settings::sid();
+my $sid = Settings::sid();
my $dbname = Settings::dbName();
my $alias = Settings::alias();
my $passw = Settings::pass();
-my $VW_PAGE = Settings->VW_LOG;
+my $VW_PAGE = Settings->VW_LOG;
my $sssCDB = session('cdb');
my ($vmode, $imgw, $imgh );
-if ( !$alias || !$passw ) {
- print $cgi->redirect("alogin_ctr.cgi?CGISESSID=$sid");
- exit;
+if ( !$alias || !$passw ) {
+ print $cgi->redirect("alogin_ctr.cgi?CGISESSID=$sid");
+ exit;
}
### Authenticate session to alias passw
- &authenticate;
+&authenticate;
#
my $log_rc = 0;
my $log_rc_prev = 0;
my $rs_prev = param('rs_prev');
my $rs_cur = param('rs_cur');
my $rs_page = param('rs_page');
+
+
sub param{
- my $v = $cgi->param(shift); return 0 if !$v;$v
+ my $v = $cgi->param(shift);
+ return 0 if !$v;
+ $v;
}
+
+
sub session{
- my $v = $sss->param(shift); return 0 if !$v;$v
+ my $v = $sss->param(shift);
+ return 0 if !$v;
+ $v;
}
if(Settings::anon('^VW_OVR_WHERE')){
- if(!$cgi->param('srch_reset')&&!$prm_vc&&!$prm_vc_lst&&!$prm_aa&&!$prm_rtf&&!$prm_xc&&!$prm_xc_lst&&!$rs_dat_from&&!$rs_dat_to&&!$rs_keys){
- $VW_PAGE = Settings->VW_LOG_OVERRIDE_WHERE;
- }
-}
-elsif(Settings::anon('^PAGE_EXCLUDES')){
- if(!$cgi->param('srch_reset')&&!$prm_vc&&!$prm_vc_lst&&!$prm_aa&&!$prm_rtf&&!$prm_xc&&!$prm_xc_lst&&!$rs_dat_from&&!$rs_dat_to&&!$rs_keys){
- $VW_PAGE = Settings->VW_LOG_WITH_EXCLUDES;
- }
+ if(!$cgi->param('srch_reset')&&!$prm_vc&&!$prm_vc_lst&&!$prm_aa&&!$prm_rtf&&!$prm_xc&&!$prm_xc_lst&&!$rs_dat_from&&!$rs_dat_to&&!$rs_keys){
+ $VW_PAGE = Settings->VW_LOG_OVERRIDE_WHERE;
+ }
+}elsif(Settings::anon('^PAGE_EXCLUDES')){
+ if(!$cgi->param('srch_reset')&&!$prm_vc&&!$prm_vc_lst&&!$prm_aa&&!$prm_rtf&&!$prm_xc&&!$prm_xc_lst&&!$rs_dat_from&&!$rs_dat_to&&!$rs_keys){
+ $VW_PAGE = Settings->VW_LOG_WITH_EXCLUDES;
+ }
}
my $sqlView = 'SELECT ID, ID_CAT, DATE, LOG, RTF, AMOUNT, AFLAG, STICKY, PID FROM '.$VW_PAGE;#Only to be found here, the main SQL select statement.
my $stmD = "";
my $sm_reset_all= "";
my $rec_limit = Settings::recordLimit();
+
#Set to 1 to get debug help. Switch off with 0.
my $DEBUG = Settings::debug();
+
#END OF SETTINGS
my $rtf_buffer = 0;
my ($BUFFER, $D_BUFF)=("","");
my $lang = Date::Language->new(Settings::language());
my $today = Settings->today();
+
# We buffer the whole page creation, for speed and control, or to send compressed or not to client.
-sub toBuf { if($DEBUG){$D_BUFF .= shift}else{$BUFFER .= shift} }
+sub toBuf {
+ if($DEBUG){$D_BUFF .= shift}
+ else{$BUFFER .= shift}
+}
if(!$prm_vc && &Settings::keepExcludes){
- if($prm_xc_lst){
- Settings::configProperty($db, 201, '^EXCLUDES', $prm_xc_lst);
- }
- else{
- $prm_xc_lst = &Settings::obtainProperty($db, '^EXCLUDES');
- $prm_xc = $prm_xc_lst if (!$prm_xc && !$cgi->param('srch_reset'));
- }
+ if($prm_xc_lst){
+ Settings::configProperty($db, 201, '^EXCLUDES', $prm_xc_lst);
+ }else{
+ $prm_xc_lst = &Settings::obtainProperty($db, '^EXCLUDES');
+ $prm_xc = $prm_xc_lst if (!$prm_xc && !$cgi->param('srch_reset'));
+ }
}
if ( !$rs_dat_to && $rs_dat_from ) {
- my $dur = $today;
- $dur->add( months => 1 );
- $rs_dat_to = DateTime::Format::SQLite->parse_datetime($dur);
+ my $dur = $today;
+ $dur->add( months => 1 );
+ $rs_dat_to = DateTime::Format::SQLite->parse_datetime($dur);
}
if ( $rs_dat_from && $rs_dat_to ) {
- $stmD = qq( DATE BETWEEN date('$rs_dat_from') AND date('$rs_dat_to') );
+ $stmD = qq( DATE BETWEEN date('$rs_dat_from') AND date('$rs_dat_to') );
}
#Toggle if search deployed.
$sss->expire(Settings::sessionExprs());
$sss->param('theme', Settings::theme('css'));
$sss->param('bgcolor', Settings::theme('colBG'));
+
#sss->param('sss_main', $today);
#
#Reset Clicked
if(param('srch_reset') == 1){
- $sss->clear('sss_vc');$sss->clear('sss_xc');$sss->clear('sss_ord_cat');
+ $sss->clear('sss_vc');
+ $sss->clear('sss_xc');
+ $sss->clear('sss_ord_cat');
}
if($prm_vc &&$prm_vc ne ""){
-#TODO (2020-11-05) This is a subrotine candidate. It gets too complicated. should not have both $prm_vc and $prm_vc_lst;
- $prm_xc =~ s/^0*//g;$prm_xc_lst=~ s/^\,$//g;
- if(!$prm_vc_lst||$prm_vc_lst==0){#} && index($prm_xc, ',') > 0){
- $prm_vc_lst = $prm_vc;
- }else{
- my $f;
- my @vc_lst = split /\,/, $prm_vc_lst; @vc_lst = uniq(sort { $a <=> $b } @vc_lst);
- foreach my $n(@vc_lst){
- if($n == $prm_vc){ $f=1; last; }
- }
- if(!$f){#not found view was clicked changing category but not adding it to vc list. Let's add it to the list.
- $prm_vc_lst .= ",$prm_vc";
- }
- $prm_vc_lst=~ s/\,$//g;$prm_vc_lst=~ s/\,\,/\,/g;
- }
-
-
- if ($cgi->param('sss_vc') eq 'on'){
- $sss->param('sss_vc', $prm_xc);
- $sss->param('sss_vc_lst', $prm_xc_lst);
- }
- else{
- $sss->clear('sss_vc');
- $sss->clear('sss_vc_lst');
- }
+
+ #TODO (2020-11-05) This is a subrotine candidate. It gets too complicated. should not have both $prm_vc and $prm_vc_lst;
+ $prm_xc =~ s/^0*//g;
+ $prm_xc_lst=~ s/^\,$//g;
+ if(!$prm_vc_lst||$prm_vc_lst==0){#} && index($prm_xc, ',') > 0){
+ $prm_vc_lst = $prm_vc;
+ }else{
+ my $f;
+ my @vc_lst = split /\,/, $prm_vc_lst;
+ @vc_lst = uniq(sort { $a <=> $b } @vc_lst);
+ foreach my $n(@vc_lst){
+ if($n == $prm_vc){ $f=1; last; }
+ }
+ if(!$f){#not found view was clicked changing category but not adding it to vc list. Let's add it to the list.
+ $prm_vc_lst .= ",$prm_vc";
+ }
+ $prm_vc_lst=~ s/\,$//g;
+ $prm_vc_lst=~ s/\,\,/\,/g;
+ }
+
+
+ if ($cgi->param('sss_vc') eq 'on'){
+ $sss->param('sss_vc', $prm_xc);
+ $sss->param('sss_vc_lst', $prm_xc_lst);
+ }else{
+ $sss->clear('sss_vc');
+ $sss->clear('sss_vc_lst');
+ }
}else{
- $prm_vc = session('sss_vc');
- $prm_vc_lst = session('sss_vc_lst');
+ $prm_vc = session('sss_vc');
+ $prm_vc_lst = session('sss_vc_lst');
}
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_lst', $prm_xc_lst);
- }
- else{
- $sss->clear('sss_xc');
- $sss->clear('sss_xc_lst');
- }
+
+ #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_lst', $prm_xc_lst);
+ }else{
+ $sss->clear('sss_xc');
+ $sss->clear('sss_xc_lst');
+ }
}else{
- $prm_xc = session('sss_xc');
- $prm_xc_lst = session('sss_xc_lst');
+ $prm_xc = session('sss_xc');
+ $prm_xc_lst = session('sss_xc_lst');
}
+
#Either Session or requested.
if(param('sss_ord_cat') eq 'on'){
- $stmE = ' ORDER BY ID_CAT '.$stmE;
- $sss->param('sss_ord_cat', 1);
-}else{$sss->param('sss_ord_cat', 0)}
+ $stmE = ' ORDER BY ID_CAT '.$stmE;
+ $sss->param('sss_ord_cat', 1);
+}else{
+ $sss->param('sss_ord_cat', 0);
+}
##
-my @vc_lst = split /\,/, $prm_vc_lst; @vc_lst = uniq(sort { $a <=> $b } @vc_lst);
-my @xc_lst = split /\,/, $prm_xc_lst; @xc_lst = uniq(sort { $a <=> $b } @xc_lst);
+my @vc_lst = split /\,/, $prm_vc_lst;
+@vc_lst = uniq(sort { $a <=> $b } @vc_lst);
+my @xc_lst = split /\,/, $prm_xc_lst;
+@xc_lst = uniq(sort { $a <=> $b } @xc_lst);
$sss->flush();
#tag related framed sizing.
my @arrwh = split /x/, &Settings::imgWidthHeight;
if ( @arrwh == 2 ) {
- $imgw = $arrwh[0];
- $imgh = $arrwh[1];
-}
-else { #defaults
- $imgw = 210;
- $imgh = 120;
+ $imgw = $arrwh[0];
+ $imgh = $arrwh[1];
+}else { #defaults
+ $imgw = 210;
+ $imgh = 120;
}
my $st;
my $td_cat = "<tr><td><ul>";
my $td_itm_cnt =0;
while ( my @row = $st->fetchrow_array() ) {
- my $n = $row[1];
- $n =~ s/\s*$//g;
- $hshCats{$row[0]} = $n;
- $hshDesc{$row[0]} = $row[2];
- if($td_itm_cnt>4){
- $td_cat .= "</ul></td><td><ul>";
- $td_itm_cnt = 0;
- }
- $td_cat .= "<li id='".$row[0]."'><a href='#'>".$row[1]."</a></li>";
- $td_itm_cnt++
+ my $n = $row[1];
+ $n =~ s/\s*$//g;
+ $hshCats{$row[0]} = $n;
+ $hshDesc{$row[0]} = $row[2];
+ if($td_itm_cnt>4){
+
$td_cat .= "</ul></td><td><ul>";
+ $td_itm_cnt = 0;
+ }
+
$td_cat .= "<li id='".$row[0]."'><a href='#'>".$row[1]."</a></li>";
+ $td_itm_cnt++;
}
if($td_itm_cnt<5){#fill spacing.
- for (my $i=0;$i<5-$td_itm_cnt;$i++){
- $td_cat .= "<li><a href='#'></a> </li>";
- }
+ for (my $i=0;$i<5-$td_itm_cnt;$i++){
+
$td_cat .= "<li><a href='#'></a> </li>";
+ }
}
$td_cat .= "</ul></td></tr>";
for my $key ( keys %hshDesc ) {
- my $kv = $hshDesc{$key}; next if !$kv;
- if ( $kv ne ".." && index($key,'HASH(0x')!=0) {
- my $n = $hshCats{$key};
- $data_cats .= qq(<meta id="cats[$key]" name="$n" content="$kv">\n);
- }
+ my $kv = $hshDesc{$key};
+ next if !$kv;
+ if ( $kv ne ".." && index($key,'HASH(0x')!=0) {
+ my $n = $hshCats{$key};
+ $data_cats .= qq(<meta id="cats[$key]" name="$n" content="$kv">\n);
+ }
}
-my $eh;my $currsymb = &Settings::currenySymbol;
-if($isPUBViewMode){$eh = ""}else{$eh='<th>Edit</th>'}
-my $log_output =
-qq(<FORM id="frm_log" action="data.cgi" onSubmit="return formDelValidation();">
+my $eh;
+my $currsymb = &Settings::currenySymbol;
+if($isPUBViewMode){$eh = ""}
+else{$eh='<th>Edit</th>'}
+my $log_output =qq(<FORM id="frm_log" action="data.cgi" onSubmit="return formDelValidation();">
<TABLE class="tbl" border="0" width=").&Settings::pagePrcWidth.qq(%">
<tr class="hdr">
<th>Date</th>
<th>Category</th>
$eh
</tr>);
- #We use js+perl, trickery to filter by amount type, as well.
- if($prm_aa >0){my $s = $prm_aa - 1;$prm_aa = " AFLAG=$s AND";}else{$prm_aa=""}
- if($prm_rtf){$stmS .= " RTF>0 AND";}
-
- if($isPUBViewMode){
- $sqlVWL = $stmS." ".Settings::sqlPubors().$stmE;
- }
- elsif ( $rs_keys && $rs_keys ne '*' ) {
-
- my @keywords = split /\W/, $rs_keys;
- if ($prm_vc && $prm_vc != $prm_xc) {
-
- if(@vc_lst){
- $stmS .= $prm_aa;
- foreach (@vc_lst){
- $stmS .= " ID_CAT=$_ OR";
- }
- }
- else{ $stmS .= $prm_aa . " ID_CAT=$prm_vc AND"; }
-
- }
- else {
- if($prm_xc>0){
- if(@xc_lst){
- $stmS .= $prm_aa;
- foreach (@xc_lst){
- $stmS .= " ID_CAT!=$_ AND";
- }
- }
- else{ $stmS .= $prm_aa . " ID_CAT!=$prm_xc AND"; }
- }
- }
-
- if ($stmD) {
- #was previous an OR?, replace with an AND we filter further by keywords.
- $stmS =~ s/\sOR$/ and/gi;
- $stmS .= $stmD . " AND";
- }
-
- if (@keywords) {
- foreach (@keywords) { next if $_ eq "";
- #was previous an OR?, replace with an AND we filter further by keywords.
- $stmS =~ s/\sOR$/ and/gi;
- if(Settings::isProgressDB()){$stmS .= " LOWER(LOG) ~ '" . lc $_ . "'"}
- else{$stmS .= " LOWER(LOG) REGEXP '\\b" . lc $_ . "\\b'"}
- if ( \$_ != \$keywords[-1] ) {
- $stmS = $stmS . " and ";
- }
- }
- $sqlVWL = $stmS . $stmE;
- }
- }
- elsif ($prm_vc) {
- if(@vc_lst){
- foreach (@vc_lst){
- $stmS .= " ID_CAT=$_ OR";
- }
- $sqlVWL = $stmS . $prm_aa; $sqlVWL =~ s/OR$//g;
- $sqlVWL .= $stmE;
- }
- elsif ($stmD) {
- $sqlVWL = $stmS . $prm_aa . $stmD . " AND ID_CAT=" . $prm_vc . $stmE;
- }
- else {
- $sqlVWL = $stmS . $prm_aa . " ID_CAT=" . $prm_vc . $stmE;
- }
- }
- else {
- if($prm_xc>0){
- if(@xc_lst){
- my $ands = "";
- foreach (@xc_lst){
- $ands .= " ID_CAT!=$_ AND";
- }
-
- $ands =~ s/AND$//g;
- $sqlVWL = $stmS .$prm_aa. $ands . $stmE;
- }
- else{
- $sqlVWL = $stmS . $prm_aa." ID_CAT!=$prm_xc;" . $stmE;
- }
- }
- if ($stmD) {
- $sqlVWL = $stmS . $prm_aa.' '. $stmD . $stmE;
- }
- elsif($prm_aa){
- $prm_aa =~ s/AND$//g;
- $sqlVWL = $stmS .$prm_aa.' '.$stmE;
- }
- elsif($prm_rtf){
- $stmS =~ s/AND$//g;
- $sqlVWL = $stmS.$stmE;
- }
- }
+
+#We use js+perl, trickery to filter by amount type, as well.
+if($prm_aa >0){my $s = $prm_aa - 1;$prm_aa = " AFLAG=$s AND";}
+else{$prm_aa=""}
+if($prm_rtf){$stmS .= " RTF>0 AND";}
+
+if($isPUBViewMode){
+ $sqlVWL = $stmS." ".Settings::sqlPubors().$stmE;
+}elsif ( $rs_keys && $rs_keys ne '*' ) {
+
+ my @keywords = split /\W/, $rs_keys;
+ if ($prm_vc && $prm_vc != $prm_xc) {
+
+ if(@vc_lst){
+ $stmS .= $prm_aa;
+ foreach (@vc_lst){
+ $stmS .= " ID_CAT=$_ OR";
+ }
+ }else{
+ $stmS .= $prm_aa . " ID_CAT=$prm_vc AND";
+ }
+
+ }else {
+ if($prm_xc>0){
+ if(@xc_lst){
+ $stmS .= $prm_aa;
+ foreach (@xc_lst){
+ $stmS .= " ID_CAT!=$_ AND";
+ }
+ }else{
+ $stmS .= $prm_aa . " ID_CAT!=$prm_xc AND";
+ }
+ }
+ }
+
+ if ($stmD) {
+
+ #was previous an OR?, replace with an AND we filter further by keywords.
+ $stmS =~ s/\sOR$/ and/gi;
+ $stmS .= $stmD . " AND";
+ }
+
+ if (@keywords) {
+ foreach (@keywords) {
+ next if $_ eq "";
+
+ #was previous an OR?, replace with an AND we filter further by keywords.
+ $stmS =~ s/\sOR$/ and/gi;
+ if(Settings::isProgressDB()){$stmS .= " LOWER(LOG) ~ '" . lc $_ . "'"}
+ else{$stmS .= " LOWER(LOG) REGEXP '\\b" . lc $_ . "\\b'"}
+ if ( \$_ != \$keywords[-1] ) {
+ $stmS = $stmS . " and ";
+ }
+ }
+ $sqlVWL = $stmS . $stmE;
+ }
+}elsif ($prm_vc) {
+ if(@vc_lst){
+ foreach (@vc_lst){
+ $stmS .= " ID_CAT=$_ OR";
+ }
+ $sqlVWL = $stmS . $prm_aa;
+ $sqlVWL =~ s/OR$//g;
+ $sqlVWL .= $stmE;
+ }elsif ($stmD) {
+ $sqlVWL = $stmS . $prm_aa . $stmD . " AND ID_CAT=" . $prm_vc . $stmE;
+ }else {
+ $sqlVWL = $stmS . $prm_aa . " ID_CAT=" . $prm_vc . $stmE;
+ }
+}else {
+ if($prm_xc>0){
+ if(@xc_lst){
+ my $ands = "";
+ foreach (@xc_lst){
+ $ands .= " ID_CAT!=$_ AND";
+ }
+
+ $ands =~ s/AND$//g;
+ $sqlVWL = $stmS .$prm_aa. $ands . $stmE;
+ }else{
+ $sqlVWL = $stmS . $prm_aa." ID_CAT!=$prm_xc;" . $stmE;
+ }
+ }
+ if ($stmD) {
+ $sqlVWL = $stmS . $prm_aa.' '. $stmD . $stmE;
+ }elsif($prm_aa){
+ $prm_aa =~ s/AND$//g;
+ $sqlVWL = $stmS .$prm_aa.' '.$stmE;
+ }elsif($prm_rtf){
+ $stmS =~ s/AND$//g;
+ $sqlVWL = $stmS.$stmE;
+ }
+}
###################
- &processSubmit;
+&processSubmit;
###################
- my $tfId = 0;
- my $id = 0;
- my $log_start = index $sqlVWL, "<=";
- my $re_a_tag = qr/<a\s+.*?>.*<\/a>/si; my $regex = 'REGEXP'; $regex = ') ~' if Settings::isProgressDB();
- my $isInViewMode = rindex ($sqlVWL, 'PID<=') > 0 || rindex ($sqlVWL, 'ID_CAT=') > 0 || $prm_aa || rindex ($sqlVWL, $regex)>0 || $prm_rtf;
-
- toBuf $cgi->pre("###[Session PARAMS->isV:$isInViewMode|vc=$prm_vc|xc=$prm_xc|aa: $prm_aa|xc_lst=$prm_xc_lst|\@xc_lst=@xc_lst|vrtf=$prm_rtf|keepExcludes=".&Settings::keepExcludes."] -> ".$sqlVWL) if $DEBUG;
-
- if ( $log_start > 0 ) {
-
- #check if we are at the beggining of the LOG table?
- my $stc = traceDBExe('SELECT PID from '.$VW_PAGE.' LIMIT 1;');
- my @row = $stc->fetchrow_array();
- $log_top = $row[0];
- if ($log_top == $rs_prev && $rs_cur == $rs_prev ) {
- $log_start = -1;
- }
- $stc->finish();
- }
- #
- # Fetch log entries!
- #
- my $CID_EVENT = 9;
- my $tags = "";
- my $sum = 0;
- my $exp = 0;
- my $ass = 0;
-
- #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( !$isInViewMode && !$prm_vc && !$prm_xc && !$rs_keys && !$rs_dat_from ){
- $sqlVWL = "$stmS STICKY = false $stmE";
- toBuf $cgi->pre("###2 -> ".$sqlVWL) if $DEBUG;
- buildLog(traceDBExe($sqlVWL));
- }
+my $tfId = 0;
+my $id = 0;
+my $log_start = index $sqlVWL, "<=";
+my $re_a_tag = qr/<a\s+.*?>.*<\/a>/si;
+my $regex = 'REGEXP';
+$regex = ') ~' if Settings::isProgressDB();
+my $isInViewMode = rindex ($sqlVWL, 'PID<=') > 0 || rindex ($sqlVWL, 'ID_CAT=') > 0 || $prm_aa || rindex ($sqlVWL, $regex)>0 || $prm_rtf;
+
+toBuf $cgi->pre("###[Session PARAMS->isV:$isInViewMode|vc=$prm_vc|xc=$prm_xc|aa: $prm_aa|xc_lst=$prm_xc_lst|\@xc_lst=@xc_lst|vrtf=$prm_rtf|keepExcludes=".&Settings::keepExcludes."] -> ".$sqlVWL) if $DEBUG;
+
+if ( $log_start > 0 ) {
+
+ #check if we are at the beggining of the LOG table?
+ my $stc = traceDBExe('SELECT PID from '.$VW_PAGE.' LIMIT 1;');
+ my @row = $stc->fetchrow_array();
+ $log_top = $row[0];
+ if ($log_top == $rs_prev && $rs_cur == $rs_prev ) {
+ $log_start = -1;
+ }
+ $stc->finish();
+}
+#
+# Fetch log entries!
+#
+my $CID_EVENT = 9;
+my $tags = "";
+my $sum = 0;
+my $exp = 0;
+my $ass = 0;
+
+#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( !$isInViewMode && !$prm_vc && !$prm_xc && !$rs_keys && !$rs_dat_from ){
+ $sqlVWL = "$stmS STICKY = false $stmE";
+ toBuf $cgi->pre("###2 -> ".$sqlVWL) if $DEBUG;
+ buildLog(traceDBExe($sqlVWL));
+}
sub traceDBExe {
- my $sql = shift;
- try{
- toBuf("do:$sql") if ($DEBUG);
- my $st = $db->prepare($sql);
- $st -> execute() or LifeLogException->throw("Execute failed [$DBI::errstri]", show_trace=>1);
- return $st;
- }catch{
- #BUG 31 fix.
- if(Settings::isProgressDB() && index($sql,Settings->VW_LOG)>0){
- $db -> do(Settings::createViewLOGStmt());
- my $st = $db->prepare($sql);
- $st -> execute() or LifeLogException->throw("Execute failed [$DBI::errstri]", show_trace=>1);
- return $st;
- }
- LifeLogException->throw(error=>"DSN: [".Settings::dsn()."] Error encountered -> $@", show_trace=>1);
- }
+ my $sql = shift;
+ try{
+ toBuf("do:$sql") if ($DEBUG);
+ my $st = $db->prepare($sql);
+ $st ->execute() or LifeLogException->throw("Execute failed [$DBI::errstri]", show_trace=>1);
+ return $st;
+ }catch{
+ #BUG 31 fix.
+ if(Settings::isProgressDB() && index($sql,Settings->VW_LOG)>0){
+ $db ->do(Settings::createViewLOGStmt());
+ my $st = $db->prepare($sql);
+ $st ->execute() or LifeLogException->throw("Execute failed [$DBI::errstri]", show_trace=>1);
+ return $st;
+ }
+ LifeLogException->throw(error=>"DSN: [".Settings::dsn()."] Error encountered -> $@", show_trace=>1);
+ }
}
+
sub buildLog {
- my $pst = shift;
- #toBuf "## 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 $dt = DateTime::Format::SQLite->parse_datetime( $row[$i++] ); #LOG.DATE
- my $log = $row[$i++]; #LOG.LOG
- my $rtf = $row[$i++]; #ID_RTF since v.1.8 but just RTF from v.2.1
- my $am = $row[$i++]; $am =0 if !$am; #LOG.AMOUNT
- my $af = $row[$i++]; #AFLAG -> Asset as 0, Income as 1, Expense as 2
- my $sticky = $row[$i++]; #Sticky to top
- my $pid = $row[$i++]; #PID actual log ID in View.
-
- $am =~ s/^\D|\,//g; #trim if it is money sql data type formated.
-
- if ( $af == 1 ) { #AFLAG Income, assets are neutral.
- $sum += $am;
- }
- elsif ( $af == 2 ) {
- $exp -= $am;
- }
- else{
- $ass += $am;
- }
- $am = &cam($am);
- #Apostrophe in the log value is doubled to avoid SQL errors.
- $log =~ s/''/'/g;
- #
- if ( !$ct ) {
- $ct = $hshCats{1};
- }
- if ( !$dt ) {
- $dt = $today;
- }
- if ( !$am ) {
- $am = "0.00";
- }
- if ( $log_rc_prev == 0 ) {
- $log_rc_prev = $id;
- }
- if ( $tfId > 0) {
- $tfId = 0;
- }
- else {
- $tfId = 1;
- }
-
- my $sub = "";
- my $tagged = 0;
- my $log_orig = $log;
-
-#Check for LNK takes precedence here as we also parse plain placed URL's for http protocol later.
- if ( $log =~ /<<LNK</ ) {
- my $idx = $-[0] + 5;
- my $len = index( $log, '>', $idx );
- $sub = substr( $log, $idx + 1, $len - $idx - 1 );
- my $url = qq(<a href="$sub" target=_blank>$sub</a>);
- $tagged = 1;
- $log =~ s/<<LNK<(.*?)>+/$url/osi;
- }
-
- if ( $log =~ /<<IMG</ ) {
- my $idx = $-[0] + 5;
- my $len = index( $log, '>', $idx );
- $sub = substr( $log, $idx + 1, $len - $idx - 1 );
- my $url = qq(<img src="$sub"/>);
- $tagged = 1;
- $log =~ s/<<IMG<(.*?)>+/$url/osi;
- }
- elsif ( $log =~ /<<FRM</ ) {
- my $idx = $-[0] + 5;
- my $len = index( $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<a href="./images/$lnk" style="border=0;" target="_IMG">
+ my $pst = shift;
+
+ #toBuf "## 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 $dt = DateTime::Format::SQLite->parse_datetime( $row[$i++] ); #LOG.DATE
+ my $log = $row[$i++]; #LOG.LOG
+ my $rtf = $row[$i++]; #ID_RTF since v.1.8 but just RTF from v.2.1
+ my $am = $row[$i++];
+ $am =0 if !$am; #LOG.AMOUNT
+ my $af = $row[$i++]; #AFLAG -> Asset as 0, Income as 1, Expense as 2
+ my $sticky = $row[$i++]; #Sticky to top
+ my $pid = $row[$i++]; #PID actual log ID in View.
+
+ $am =~ s/^\D|\,//g; #trim if it is money sql data type formated.
+
+ if ( $af == 1 ) { #AFLAG Income, assets are neutral.
+ $sum += $am;
+ }elsif ( $af == 2 ) {
+ $exp -= $am;
+ }else{
+ $ass += $am;
+ }
+ $am = &cam($am);
+
+ #Apostrophe in the log value is doubled to avoid SQL errors.
+ $log =~ s/''/'/g;
+ #
+ if ( !$ct ) {
+ $ct = $hshCats{1};
+ }
+ if ( !$dt ) {
+ $dt = $today;
+ }
+ if ( !$am ) {
+ $am = "0.00";
+ }
+ if ( $log_rc_prev == 0 ) {
+ $log_rc_prev = $id;
+ }
+ if ( $tfId > 0) {
+ $tfId = 0;
+ }else {
+ $tfId = 1;
+ }
+
+ my $sub = "";
+ my $tagged = 0;
+ my $log_orig = $log;
+
+ #Check for LNK takes precedence here as we also parse plain placed URL's for http protocol later.
+ if ( $log =~ /<<LNK</ ) {
+ my $idx = $-[0] + 5;
+ my $len = index( $log, '>', $idx );
+ $sub = substr( $log, $idx + 1, $len - $idx - 1 );
+ my $url = qq(<a href="$sub" target=_blank>$sub</a>);
+ $tagged = 1;
+ $log =~ s/<<LNK<(.*?)>+/$url/osi;
+ }
+
+ if ( $log =~ /<<IMG</ ) {
+ my $idx = $-[0] + 5;
+ my $len = index( $log, '>', $idx );
+ $sub = substr( $log, $idx + 1, $len - $idx - 1 );
+ my $url = qq(<img src="$sub"/>);
+ $tagged = 1;
+ $log =~ s/<<IMG<(.*?)>+/$url/osi;
+ }elsif ( $log =~ /<<FRM</ ) {
+ my $idx = $-[0] + 5;
+ my $len = index( $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<a href="./images/$lnk" style="border=0;" target="_IMG">
<img src="./images/$sub" width="$imgw" height="$imgh" class="tag_FRM"/></a>);
- }
- else {
- #TODO fetch from web locally the original image.
- $lnk =qq(\n<img src="$lnk" width="$imgw" height="$imgh" class="tag_FRM"/>);
- }
- $log =~ s/<<FRM<(.*?)>+/$lnk/o;
- $tagged = 1;
- }
-
- #Replace with a full link an HTTP URI
- if ( $log =~ /<iframe / ) {
- my $a = q(<iframe width="560" height="315"); my $b;
+ }else {
+
+ #TODO fetch from web locally the original image.
+ $lnk =qq(\n<img src="$lnk" width="$imgw" height="$imgh" class="tag_FRM"/>);
+ }
+ $log =~ s/<<FRM<(.*?)>+/$lnk/o;
+ $tagged = 1;
+ }
+
+ #Replace with a full link an HTTP URI
+ if ( $log =~ /<iframe / ) {
+ my $a = q(<iframe width="560" height="315");
+ my $b;
given (Settings::frameSize()) {
when("0") { $b = q(width="390" height="215") }
when("1") { $b = q(width="280" height="180") }
$b = &Settings::frameSize;
}
}
- $b = qq(<div><iframe align="center" $b);
- $log =~ s/$a/$b/o;
- $a = q(</iframe>);
- $b = q(</iframe></div>);
- $log =~ s/$a/$b/o;
- $tagged = 1;
- }
- else {
- 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, "<img" ) > -1;
- $ch_i =~ s/https/http/gsi;
- $ch_i =~
- s/($RE{URI}{HTTP})/<a href="$1" target=_blank>$1<\/a>/gsi;
- }
- $log = join( '', @chnks );
- }
-
- while ( $log =~ /<<B</ ) {
- my $idx = $-[0];
- my $len = index( $log, '>', $idx ) - 4;
- my $sub = "<b>" . substr( $log, $idx + 4, $len - $idx ) . "</b>";
- $log =~ s/<<B<(.*?)>+/$sub/o;
- $tagged = 1;
- }
- while ( $log =~ /<<I</ ) {
- my $idx = $-[0];
- my $len = index( $log, '>', $idx ) - 4;
- last if $len<6;
- my $sub = "<i>" . substr( $log, $idx + 4, $len - $idx ) . "</i>";
- $log =~ s/<<I<(.*?)>+/$sub/o;
- $tagged = 1;
- }
- while ( $log =~ /<<TITLE</ ) {
- my $idx = $-[0];
- my $len = index( $log, '>', $idx ) - 8;
- last if $len<9;
- my $sub = "<h3>" . substr( $log, $idx + 8, $len - $idx ) . "</h3>";
- $log =~ s/<<TITLE<(.*?)>+/$sub/o;
- $tagged = 1;
- }
- while ( $log =~ /<<LIST</ ) {
- my $idx = $-[0];
- my $len = index( $log, '>', $idx ) - 7;
- last if $len<9;
- my $lst = substr( $log, $idx + 7, $len - $idx );
- my $sub = "";
- my @arr = split( /\n|\\n/, $lst );
- my $ml = "";
- foreach my $ln (@arr) {
- $ln =~ s/^\s*//g;
- if ( $ln =~ /~$/ ) {
- $ln =~ s/~$/<br>/g;
- $ml .= $ln . ' ';
- }
- else {
- if ($ml) {
- $ml .= $ln if length($ln) > 0;
- $sub .= "<li>$ml</li>\n";
- $ml = "";
- }
- else {
- $sub .= "<li>$ln</li>" if length($ln) > 0;
- }
- }
- }
-
- $sub = "<div id='rz'><ul>$sub</ul></div>";
- $log =~ s/<<LIST<(\w*|\s*)*.*(>+?)/$sub/o;
- $tagged = 1;
- }
- #bold on start markup
- $log =~ s/(^\*)(.*)(\*)(\\n)/<b>$2<\/b><br>/oi;
- #Decode escaped \\n
- $log =~ s/\r\n/<br>/gs;
- $log =~ s/\\n/<br>/gs;
-
- if ( $CID_EVENT == $row[1] ) {
- $log = "<font color='#eb4848' style='font-weight:bold'>$log</font>";
- $tagged = 1;
- }
- elsif ( 1 == $row[1] ) {
- $log =
-"<font class='midnight' style='font-weight:bold;font-style:italic'>$log</font>";
- $tagged = 1;
- }
-
- #Tagged preserve originally stored entry in hidden numbered field.
- if ($tagged) {
- $log_orig =~ s/<br>\n/<br>/g;
- $log_orig =~ s/</</g;
- $log_orig =~ s/>/>/g;
- $log_orig =~ s/\\n/ /g;
- $log_orig =~ s/\n/ /g;
- $log_orig =~ s/\t/	/g;
- $log_orig =~ s/\"/"/g;
- $log_orig =~ s/\'/'/g;
- $tags .= qq(<input type="hidden" id="g$id" value="$log_orig"/>\n);
- }elsif(not &Settings::displayAll){
- my $h;
- if($log =~ m/(.*\s*.*?)<br>/){$h=$1}
- elsif($log =~ m/(\s*.*\n)/) {$h=$1}
- if($h){
- $log = $h.qq(<input type="hidden" id="h$id" value="$log"/><button id='btnRTF' onclick="return dispFullLog($id);"
+ $b = qq(<div><iframe align="center" $b);
+ $log =~ s/$a/$b/o;
+ $a = q(</iframe>);
+ $b = q(</iframe></div>);
+ $log =~ s/$a/$b/o;
+ $tagged = 1;
+ }else {
+ 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, "<img" ) > -1;
+ $ch_i =~ s/https/http/gsi;
+ $ch_i =~s/($RE{URI}{HTTP})/<a href="$1" target=_blank>$1<\/a>/gsi;
+ }
+ $log = join( '', @chnks );
+ }
+
+ while ( $log =~ /<<B</ ) {
+ my $idx = $-[0];
+ my $len = index( $log, '>', $idx ) - 4;
+ my $sub = "<b>" . substr( $log, $idx + 4, $len - $idx ) . "</b>";
+ $log =~ s/<<B<(.*?)>+/$sub/o;
+ $tagged = 1;
+ }
+ while ( $log =~ /<<I</ ) {
+ my $idx = $-[0];
+ my $len = index( $log, '>', $idx ) - 4;
+ last if $len<6;
+ my $sub = "<i>" . substr( $log, $idx + 4, $len - $idx ) . "</i>";
+ $log =~ s/<<I<(.*?)>+/$sub/o;
+ $tagged = 1;
+ }
+ while ( $log =~ /<<TITLE</ ) {
+ my $idx = $-[0];
+ my $len = index( $log, '>', $idx ) - 8;
+ last if $len<9;
+ my $sub = "<h3>" . substr( $log, $idx + 8, $len - $idx ) . "</h3>";
+ $log =~ s/<<TITLE<(.*?)>+/$sub/o;
+ $tagged = 1;
+ }
+ while ( $log =~ /<<LIST</ ) {
+ my $idx = $-[0];
+ my $len = index( $log, '>', $idx ) - 7;
+ last if $len<9;
+ my $lst = substr( $log, $idx + 7, $len - $idx );
+ my $sub = "";
+ my @arr = split( /\n|\\n/, $lst );
+ my $ml = "";
+ foreach my $ln (@arr) {
+ $ln =~ s/^\s*//g;
+ if ( $ln =~ /~$/ ) {
+ $ln =~ s/~$/<br>/g;
+ $ml .= $ln . ' ';
+ }else {
+ if ($ml) {
+ $ml .= $ln if length($ln) > 0;
+ $sub .= "<li>$ml</li>\n";
+ $ml = "";
+ }else {
+ $sub .= "<li>$ln</li>" if length($ln) > 0;
+ }
+ }
+ }
+
+ $sub = "<div id='rz'><ul>$sub</ul></div>";
+ $log =~ s/<<LIST<(\w*|\s*)*.*(>+?)/$sub/o;
+ $tagged = 1;
+ }
+
+ #bold on start markup
+ $log =~ s/(^\*)(.*)(\*)(\\n)/<b>$2<\/b><br>/oi;
+
+ #Decode escaped \\n
+ $log =~ s/\r\n/<br>/gs;
+ $log =~ s/\\n/<br>/gs;
+
+ if ( $CID_EVENT == $row[1] ) {
+ $log = "<font color='#eb4848' style='font-weight:bold'>$log</font>";
+ $tagged = 1;
+ }elsif ( 1 == $row[1] ) {
+ $log ="<font class='midnight' style='font-weight:bold;font-style:italic'>$log</font>";
+ $tagged = 1;
+ }
+
+ #Tagged preserve originally stored entry in hidden numbered field.
+ if ($tagged) {
+ $log_orig =~ s/<br>\n/<br>/g;
+ $log_orig =~ s/</</g;
+ $log_orig =~ s/>/>/g;
+ $log_orig =~ s/\\n/ /g;
+ $log_orig =~ s/\n/ /g;
+ $log_orig =~ s/\t/	/g;
+ $log_orig =~ s/\"/"/g;
+ $log_orig =~ s/\'/'/g;
+ $tags .= qq(<input type="hidden" id="g$id" value="$log_orig"/>\n);
+ }elsif(not &Settings::displayAll){
+ my $h;
+ if($log =~ m/(.*\s*.*?)<br>/){$h=$1}
+ elsif($log =~ m/(\s*.*\n)/) {$h=$1}
+ if($h){
+ $log = $h.qq(<input type="hidden" id="h$id" value="$log"/><button id='btnRTF' onclick="return dispFullLog($id);"
class="ui-button ui-corner-all ui-widget"><span>⇳<span></button>);
- }
- }
-
- my ( $dty, $dtf ) = $dt->ymd;
- my $dth = $dt->hms;
- $dth .= " id=($id)" if $DEBUG;
- if ( &Settings::universalDate == 1 ) {
- $dtf = $dty;
- }
- else {
- $dtf = $lang->time2str( "%d %b %Y", $dt->epoch, &Settings::timezone);
- }
-
- if ( $rtf > 0 ) {
- $log .= qq(<hr><button id="btnRTF" onClick="return loadRTF(true, $id);">RTF</button>);
- }
-
- if($af==2){
- $am = qq(<font color="maroon">$am</font>);
- }
-
- my $ssymb = "Edit";
- my $ssid = $tfId;
- if($sticky){
- $ssymb = "Edit ✵";
- $ssid = $tfId + 2;
- }
-
- $log_output .= qq(<tr class="r$ssid">
+ }
+ }
+
+ my ( $dty, $dtf ) = $dt->ymd;
+ my $dth = $dt->hms;
+ $dth .= " id=($id)" if $DEBUG;
+ if ( &Settings::universalDate == 1 ) {
+ $dtf = $dty;
+ }else {
+ $dtf = $lang->time2str( "%d %b %Y", $dt->epoch, &Settings::timezone);
+ }
+
+ if ( $rtf > 0 ) {
+ $log .= qq(<hr><button id="btnRTF" onClick="return loadRTF(true, $id);">RTF</button>);
+ }
+
+ if($af==2){
+ $am = qq(<font color="maroon">$am</font>);
+ }
+
+ my $ssymb = "Edit";
+ my $ssid = $tfId;
+ if($sticky){
+ $ssymb = "Edit ✵";
+ $ssid = $tfId + 2;
+ }
+
+ $log_output .= qq(<tr class="r$ssid">
<td width="15%">$dtf<input id="y$id" type="hidden" value="$dty"/></td>
<td id="t$id" width="10%" class="tbl">$dth</td>
<td id="v$id" ><div class="log">$log</div></td>
<td id="a$id" width="10%" class="tbl">$am</td>
<td id="c$id" width="10%" class="tbl">$ct</td>
);
- if(!$isPUBViewMode){$log_output .= qq(
+ if(!$isPUBViewMode){
+ $log_output .= qq(
<td width="10%">
<input id="r$id" type="hidden" value="$rtf"/>
<input id="s$id" type="hidden" value="$sticky"/>
<input id="f$id" type="hidden" value="$af"/>
<button class="edit" value="Edit" onclick="return edit($id);">$ssymb</button>
<input name="chk" type="checkbox" value="$pid"/>
- </td></tr>)};
+ </td></tr>);
+ }
- if ( $rtf > 0 ) {
- $log_output .= qq(<tr id="q-rtf$id" class="r$tfId" style="display:none;">
+ if ( $rtf > 0 ) {
+ $log_output .= qq(<tr id="q-rtf$id" class="r$tfId" style="display:none;">
<td colspan="6">
<div id="q-scroll$id" class="ql-editor ql-snow" style="max-height:480px; overflow-x:scroll;">
<div id="q-container$id" class="ql-container ql-snow"></div>
</div>
</td></tr>);
- }
- $log_rc += 1;
+ }
+ $log_rc += 1;
- if ( $rec_limit > 0 && $log_rc == $rec_limit ) {
- last;
- }
+ if ( $rec_limit > 0 && $log_rc == $rec_limit ) {
+ last;
+ }
- } #while end
+ } #while end
}#buildLog
if ( $tfId == 1 ) { $tfId = 0; }
if ( $log_rc == 0 ) {
- if ($stmD) {
- $log_output .= qq(<tr id="brw_row"><td colspan="5">
+ if ($stmD) {
+ $log_output .= qq(<tr id="brw_row"><td colspan="5">
<b>Search Failed to Retrive any records on select: [<i>$stmD</i>] !</b></td></tr>');
- }
- elsif ($rs_keys) {
- my $criter = "";
- if ( $prm_vc > 0 ) {
- $criter = "->Criteria[" . $hshCats{$prm_vc} . "]";
- }
- $log_output .= qq(<tr id="brw_row"><td colspan="5">
+ }elsif ($rs_keys) {
+ my $criter = "";
+ if ( $prm_vc > 0 ) {
+ $criter = "->Criteria[" . $hshCats{$prm_vc} . "]";
+ }
+ $log_output .= qq(<tr id="brw_row"><td colspan="5">
<b>Search Failed to Retrive any records on keywords: [<i>$rs_keys</i>]$criter!</b></td></tr>);
- }
- else {
- if ($isInViewMode) {
- if($prm_rtf){$log_output .= '<tr id="brw_row"><td colspan="6" class="r1"><b>No RTF records found matching criteria.</b></td></tr>'}
- else {$log_output .= '<tr id="brw_row"><td colspan="6" class="r1"><b>You have reached the end of the data view!</b></td></tr>'}
- }else{ $log_output .= '<tr id="brw_row"><td colspan="6" class="r1"><b>Database is New or Empty!</b></td></tr>'}
- }
+ }else {
+ if ($isInViewMode) {
+ if($prm_rtf){$log_output .= '<tr id="brw_row"><td colspan="6" class="r1"><b>No RTF records found matching criteria.</b></td></tr>'}
+ else {$log_output .= '<tr id="brw_row"><td colspan="6" class="r1"><b>You have reached the end of the data view!</b></td></tr>'}
+ }else{
+ $log_output .= '<tr id="brw_row"><td colspan="6" class="r1"><b>Database is New or Empty!</b></td></tr>';
+ }
+ }
}
my $auto_logoff = &Settings::autoLogoff;
if($isPUBViewMode){
-}
-else{
-$log_output .= <<HTML;
+}else{
+ $log_output .= <<HTML;
<tr class="r0" id="brw_row"><td colspan="2" style="font-size:small;text-align:left;">Show All hidden ➔
<a id="menu_close" href="#" onclick="return showAll();"><span class="ui-icon ui-icon-heart" style="float:none;"></span></a>
<a id="to_bottom" href="#top" title="Go to top of page.">↥</a>
</TABLE>
</form>
HTML
-};
+}
- my $frm = qq(
+my $frm = qq(
<form id="frm_entry" action="main.cgi" onSubmit="return formValidation();">
<table class="tbl" border="0" style="$std_bck opacity: 0.9;" width=").&Settings::pagePrcWidth.qq(%">
<tr class="r0">
<tr class="collpsd">
<td style="text-align:right; vertical-align:top; width:10%;">Date:</td>
<td id="al" colspan="2" style="text-align:top; vertical-align:top"><input id="ed" type="text" name="date" size="18" value=")
- . $today->ymd . " " . $today->hms . qq(">
+ . $today->ymd . " " . $today->hms . qq(">
<button type="button" onclick="return setNow();">Now</button>
<button type="reset" onclick="setNow();resetDoc(); return true;">Reset</button>
</form>
);
- my $srh = qq(
+my $srh = qq(
<form id="frm_srch" action="main.cgi">
<table class="tbl" border="0" style="background-color:).Settings::theme('colBG').qq(" width=").&Settings::pagePrcWidth.qq(%">
<tr class="r0">
</td>
</tr>
);
- my ($sss_checked, $sss_orderby) = ("","");
- my ($vc_lst,$xc_lst) = ("","");
- my $tdivvc = '<td id="divvc_lbl" align="right" style="display:none">Includes:</td><td align="left" id="divvc"></td>';
- my $tdivxc = '<td id="divxc_lbl" align="right" style="display:none">Excludes:</td><td align="left" id="divxc"></td>';
- my $catselected = '<i> <font size=1>-- Select --</font> </i>';
- my $xcatselected = '<i> <font size=1>-- Select --</font> </i>';
- if ($isInViewMode) { $sss_checked = 'checked'}
- if (session('sss_ord_cat')){ $sss_orderby = 'checked'}
-
- if($prm_vc){
- $catselected = $hshCats{$prm_vc}; $catselected ="" if !$catselected;
- 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{$_}.',' if $hshCats{$_}; $xc_lst.=$_.','}
- $xcls =~ s/\,$//g; $xcls =~ s/\,\,/\,/g; $xc_lst=~ s/^0\,$//g;
- $xcatselected = $hshCats{$prm_xc}; $xcatselected ="" if !$xcatselected;
- my $n = 16 - length($xcatselected);
- $xcatselected =~ s/^(.*)/' ' x $n . $1/e;
- $tdivxc = '<td id="divxc_lbl" align="right">Excludes:</td><td align="left" id="divxc">'.$xcls.'</td>';
- }
- elsif($prm_xc){
- $xcatselected = $hshCats{$prm_xc};
- my $n = 16 - length($xcatselected);
- $xcatselected =~ s/^(.*)/' ' x $n . $1/e;
- $tdivxc = '<td id="divxc_lbl" align="right">Excludes:</td><td align="left" id="divxc">'.$hshCats{$prm_xc}.'</td>';
- }
- #select options of $prm_aa in dropdown.
- my $aopts = "";
- my ($s,$i) = ("",0);
- my $aa = param('aa');
- if(!$prm_aa){$aa = 0}else{$aa--};
- foreach ('Asset','Income','Expense') {
- if($aa == $i){$s='selected'}else{$s=""}
- $aopts .= "\t<option value=\"$i\" $s>$_</option>\n";
- $i++;
- }
- $srh .=
- qq(
+my ($sss_checked, $sss_orderby) = ("","");
+my ($vc_lst,$xc_lst) = ("","");
+my $tdivvc = '<td id="divvc_lbl" align="right" style="display:none">Includes:</td><td align="left" id="divvc"></td>';
+my $tdivxc = '<td id="divxc_lbl" align="right" style="display:none">Excludes:</td><td align="left" id="divxc"></td>';
+my $catselected = '<i> <font size=1>-- Select --</font> </i>';
+my $xcatselected = '<i> <font size=1>-- Select --</font> </i>';
+if ($isInViewMode) { $sss_checked = 'checked'}
+if (session('sss_ord_cat')){ $sss_orderby = 'checked'}
+
+if($prm_vc){
+ $catselected = $hshCats{$prm_vc};
+ $catselected ="" if !$catselected;
+ 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{$_}.',' if $hshCats{$_}; $xc_lst.=$_.','}
+ $xcls =~ s/\,$//g;
+ $xcls =~ s/\,\,/\,/g;
+ $xc_lst=~ s/^0\,$//g;
+ $xcatselected = $hshCats{$prm_xc};
+ $xcatselected ="" if !$xcatselected;
+ my $n = 16 - length($xcatselected);
+ $xcatselected =~ s/^(.*)/' ' x $n . $1/e;
+ $tdivxc = '<td id="divxc_lbl" align="right">Excludes:</td><td align="left" id="divxc">'.$xcls.'</td>';
+}elsif($prm_xc){
+ $xcatselected = $hshCats{$prm_xc};
+ my $n = 16 - length($xcatselected);
+ $xcatselected =~ s/^(.*)/' ' x $n . $1/e;
+ $tdivxc = '<td id="divxc_lbl" align="right">Excludes:</td><td align="left" id="divxc">'.$hshCats{$prm_xc}.'</td>';
+}
+
+#select options of $prm_aa in dropdown.
+my $aopts = "";
+my ($s,$i) = ("",0);
+my $aa = param('aa');
+if(!$prm_aa){$aa = 0}
+else{$aa--}
+foreach ('Asset','Income','Expense') {
+ if($aa == $i){$s='selected'}
+ else{$s=""}
+ $aopts .= "\t<option value=\"$i\" $s>$_</option>\n";
+ $i++;
+}
+$srh .=qq(
<tr class="collpsd">
<td align="right" style="width:20%;">View by Category:</td>
<td align="left">
</td>
);
- if ( ( $rs_keys && $rs_keys ne '*' ) || $prm_vc || $stmD || $prm_xc ) {
-
$sm_reset_all = '<a class="a_" onclick="resetView();">Reset View</a><hr>';
- $srh .= '<tr class="collpsd"><td align="right" colspan="2">
+if ( ( $rs_keys && $rs_keys ne '*' ) || $prm_vc || $stmD || $prm_xc ) {
+ $sm_reset_all = '<a class="a_" onclick="resetView();">Reset View</a><hr>';
+ $srh .= '<tr class="collpsd"><td align="right" colspan="2">
<input id="srch_reset" name="srch_reset" type="hidden" value="0"/>
<button onClick="resetView()">Reset Whole View</button><br></td></tr>';
- }
- else {$srh .= '</tr>'};
+}else {
+ $srh .= '</tr>';
+}
- $srh .= '</table></form>';
+$srh .= '</table></form>';
my $sideMenu;
my $tail = q(<div><a class="a_" href="stats.cgi">View Statistics</a> <a class="a_" href="config.cgi">Configure Log</a></div><hr>
<div><a class="a_" href="login_ctr.cgi?logout=bye" id="btnLogout">LOGOUT</a><hr><a name="bottom"></a></div>);
-if($isPUBViewMode){$sideMenu=$frm=$srh=$tail=""}else{
- my $sql = Settings::dbSrc(); my $s = $sql =~ qr/:/; $s = $`; $' =~ qr/:/;
- if(lc $` eq 'pg'){$sql = $s.'➔'.'PostgreSQL'}else{$sql = $s.'➔'.$`};
- $sideMenu = qq(
+if($isPUBViewMode){$sideMenu=$frm=$srh=$tail=""}
+else{
+ my $sql = Settings::dbSrc();
+ my $s = $sql =~ qr/:/;
+ $s = $`;
+ $' =~ qr/:/;
+ if(lc $` eq 'pg'){$sql = $s.'➔'.'PostgreSQL'}
+ else{$sql = $s.'➔'.$`}
+ $sideMenu = qq(
<div id="menu" title="To close this menu click on its heart, and wait.">
<div class="hdr" style="marging=0;padding:0px;">
<a id="to_top" href="#top" title="Go to top of page."><span class="ui-icon ui-icon-arrowthick-1-n" style="float:none;"></span></a>
# Final Page Output from here! #
##################################
-toBuf (qq(
+toBuf (
+ qq(
$sideMenu
<a id="top" name="top"></a>
<div id="div_log">$frm</div>
Your browser does not support the
<code>audio</code> element.
</audio>
-));
+)
+);
outputPage();
undef($sss);
exit;
+
sub castToBool {
- my $v=shift;
- if($v eq"1"||$v eq"on"){return 'true'}else{return 'false'}
+ my $v=shift;
+ if($v eq"1"||$v eq"on"){return 'true'}
+ else{return 'false'}
}
+
sub processSubmit {
- my $date = param('date');
- my $log = param('log');
- my $cat = param('ec');
- my $cnt ="";
- my $am = param('am');
- my $af = param('amf');
-
- my $edit_mode = param('submit_is_edit');
- my $view_mode = param('submit_is_view');
- my $view_all = param('rs_all');
- my $rtf = param('rtf');
- my $sticky = param('sticky');
- my $stm;
- my $SQLID = 'rowid';
- my @gzero;
-
- toBuf $cgi->pre("###[loggin entry->cat:$cat log:$log") if $DEBUG;
-
- if($rtf eq 'on'){$rtf = 1} else {$rtf = 0}
- if($sticky eq 'on'){$sticky = 1} else {$sticky = 0}
- if(!$am){$am=0}
- if(Settings::isProgressDB()){$SQLID = 'ID'; $sticky = castToBool($sticky);}
-try {
-#Apostroph's need to be replaced with doubles and white space to be fixed for the SQL.
- $log =~ s/'/''/g;
-
- if ( $edit_mode && $edit_mode != "0" ) {
- $date = DateTime::Format::SQLite->parse_datetime($date); $date =~ s/T/ /g;
- $stm = qq(UPDATE LOG SET ID_CAT='$cat', RTF='$rtf',
+ my $date = param('date');
+ my $log = param('log');
+ my $cat = param('ec');
+ my $cnt ="";
+ my $am = param('am');
+ my $af = param('amf');
+
+ my $edit_mode = param('submit_is_edit');
+ my $view_mode = param('submit_is_view');
+ my $view_all = param('rs_all');
+ my $rtf = param('rtf');
+ my $sticky = param('sticky');
+ my $stm;
+ my $SQLID = 'rowid';
+ my @gzero;
+
+ toBuf $cgi->pre("###[loggin entry->cat:$cat log:$log") if $DEBUG;
+
+ if($rtf eq 'on'){$rtf = 1}
+ else {$rtf = 0}
+ if($sticky eq 'on'){$sticky = 1}
+ else {$sticky = 0}
+ if(!$am){$am=0}
+ if(Settings::isProgressDB()){$SQLID = 'ID'; $sticky = castToBool($sticky);}
+ try {
+ #Apostroph's need to be replaced with doubles and white space to be fixed for the SQL.
+ $log =~ s/'/''/g;
+
+ if ( $edit_mode && $edit_mode != "0" ) {
+ $date = DateTime::Format::SQLite->parse_datetime($date);
+ $date =~ s/T/ /g;
+ $stm = qq(UPDATE LOG SET ID_CAT='$cat', RTF='$rtf',
DATE='$date',
LOG='$log',
AMOUNT=$am,
AFLAG = $af,
STICKY=$sticky WHERE $SQLID=$edit_mode;);
- #
- toBuf $stm if $DEBUG;
- #
-
- traceDBExe($stm);
- return;
- }
-
- if ( $view_mode == "1" ) {
-
- if ($rs_cur) {
- my $sand = "";
- 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++;
- }
- if($prm_vc){
- $sand = "and ID_CAT == $prm_vc";
- }
- elsif($prm_xc){
-
- if(@xc_lst){
- foreach (@xc_lst){
- $sand .= "and ID_CAT!=$_ ";
- }
- }
- else{ $sand = "and ID_CAT != $prm_xc"; }
-
- }
- $sqlVWL = qq($stmS PID<=$rs_cur and STICKY=false $sand $stmE);
- return;
- }
- }
-
- if ( $log && $date && $cat ) {
- #
- # After Insert renumeration check
- #
- my $dt = DateTime::Format::SQLite->parse_datetime($date);
- my $dtCur = DateTime->now();
- $dtCur->set_time_zone(&Settings::timezone);
- $dtCur = $dtCur - DateTime::Duration->new( days => 1 );
- #
- # check and prevent double entry
- #
- $date = $dt;
- $stm = qq(SELECT DATE,LOG FROM LOG where DATE='$date' AND LOG='$log';);
- my $st = traceDBExe($stm);
- if ($st->fetchrow_array() ) {
- return;
- }
- if ($dtCur > $dt){$sticky = 1; toBuf $cgi->p("<b>Insert forced to be sticky, it is in the past!</b>");}
- $sticky=castToBool($sticky);
- $stm = qq(INSERT INTO LOG (ID_CAT, DATE, LOG, RTF, AMOUNT, AFLAG, STICKY) VALUES ($cat,'$date','$log',$rtf, $am,$af,$sticky););
- $st = traceDBExe($stm);
- # my $rv = $db->last_insert_id(undef, undef, "log", undef);
- # toBuf "\n<b>[".$rv."]</b>";
- $st->finish();
- if($sssCDB){
- #Allow further new database creation, it is not an login infinite db creation attack.
- $sss->param("cdb", 0);
- }
- if($rtf){ #Update 0 ground NOTES entry to the just inserted log.
- if ($dtCur > $dt){#New entry is set in the past. And wtf; has RTF attached.
- if(Settings::isProgressDB()){$stm = "SELECT ID FROM LOG WHERE date = timestamp '$date';"}
- else{$stm = 'SELECT ID FROM '.Settings->VW_LOG." WHERE datetime(date) = datetime('$date');"}
- $st = traceDBExe($stm);
- }else{
- $st = traceDBExe('SELECT ID FROM '.Settings->VW_LOG.' LIMIT 1;');
- }
- my @lids = $st->fetchrow_array();
- $st = traceDBExe('SELECT DOC FROM NOTES WHERE LID = 0;');
- my @gzero = $st->fetchrow_array();
- if(scalar @lids > 0){
- #By Notes.LID constraint, there should NOT be an already existing log rowid entry just submitted in the Notes table!
- #What happened? We must check and delete, regardles. As data is renumerated and shuffled from perl in database. :(
- $st = traceDBExe("SELECT LID FROM NOTES WHERE LID=".$lids[0].";");
- if($st->fetchrow_array()){
- $st = $db->do("DELETE FROM NOTES WHERE LID=".$lids[0].";");
- # NOTICE - There will be disparities here if renumeration failed, to update, run.
- # These are expected after upgrades. And if switching DB engine and SQL compatibilities.
- toBuf qq(<p>Warning deleted (possible old) NOTES.LID[$lids[0]] -> lid:@lids</p>);
- }
- toBuf("\nINSERT INTO NOTES($lids[0], {DOC[$date]})") if ($DEBUG);
- $st = $db->prepare("INSERT INTO NOTES(LID, DOC) VALUES (?, ?);");
- if(Settings::isProgressDB()){
- $st->bind_param(1, $lids[0]);
- $st->bind_param(2, $gzero[0],{ pg_type => DBD::Pg::PG_BYTEA });
- $st->execute();
- }else{
- $st->execute($lids[0], $gzero[0]);
- }
- #Flatten ground zero
- $st = $db->prepare("UPDATE NOTES SET DOC=null WHERE LID=0;");
- $st->execute();
- }
- }
- Settings::renumerate($db) if ( $dtCur > $dt );
- }
- if(!@gzero){$st = traceDBExe('SELECT DOC FROM NOTES WHERE LID = 0;');@gzero = $st->fetchrow_array()}
- $rtf_buffer = 1 if $gzero[0];
-}
- catch {
+ #
+ toBuf $stm if $DEBUG;
+ #
+
+ traceDBExe($stm);
+ return;
+ }
+
+ if ( $view_mode == "1" ) {
+
+ if ($rs_cur) {
+ my $sand = "";
+ 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++;
+ }
+ if($prm_vc){
+ $sand = "and ID_CAT == $prm_vc";
+ }elsif($prm_xc){
+
+ if(@xc_lst){
+ foreach (@xc_lst){
+ $sand .= "and ID_CAT!=$_ ";
+ }
+ }else{
+ $sand = "and ID_CAT != $prm_xc";
+ }
+
+ }
+ $sqlVWL = qq($stmS PID<=$rs_cur and STICKY=false $sand $stmE);
+ return;
+ }
+ }
+
+ if ( $log && $date && $cat ) {
+ #
+ # After Insert renumeration check
+ #
+ my $dt = DateTime::Format::SQLite->parse_datetime($date);
+ my $dtCur = DateTime->now();
+ $dtCur->set_time_zone(&Settings::timezone);
+ $dtCur = $dtCur - DateTime::Duration->new( days => 1 );
+ #
+ # check and prevent double entry
+ #
+ $date = $dt;
+ $stm = qq(SELECT DATE,LOG FROM LOG where DATE='$date' AND LOG='$log';);
+ my $st = traceDBExe($stm);
+ if ($st->fetchrow_array() ) {
+ return;
+ }
+ if ($dtCur > $dt){$sticky = 1; toBuf $cgi->p("<b>Insert forced to be sticky, it is in the past!</b>");}
+ $sticky=castToBool($sticky);
+ $stm = qq(INSERT INTO LOG (ID_CAT, DATE, LOG, RTF, AMOUNT, AFLAG, STICKY) VALUES ($cat,'$date','$log',$rtf, $am,$af,$sticky););
+ $st = traceDBExe($stm);
+
+ # my $rv = $db->last_insert_id(undef, undef, "log", undef);
+ # toBuf "\n<b>[".$rv."]</b>";
+ $st->finish();
+ if($sssCDB){
+
+ #Allow further new database creation, it is not an login infinite db creation attack.
+ $sss->param("cdb", 0);
+ }
+ if($rtf){ #Update 0 ground NOTES entry to the just inserted log.
+ if ($dtCur > $dt){#New entry is set in the past. And wtf; has RTF attached.
+ if(Settings::isProgressDB()){$stm = "SELECT ID FROM LOG WHERE date = timestamp '$date';"}
+ else{$stm = 'SELECT ID FROM '.Settings->VW_LOG." WHERE datetime(date) = datetime('$date');"}
+ $st = traceDBExe($stm);
+ }else{
+ $st = traceDBExe('SELECT ID FROM '.Settings->VW_LOG.' LIMIT 1;');
+ }
+ my @lids = $st->fetchrow_array();
+ $st = traceDBExe('SELECT DOC FROM NOTES WHERE LID = 0;');
+ my @gzero = $st->fetchrow_array();
+ if(scalar @lids > 0){
+
+ #By Notes.LID constraint, there should NOT be an already existing log rowid entry just submitted in the Notes table!
+ #What happened? We must check and delete, regardles. As data is renumerated and shuffled from perl in database. :(
+ $st = traceDBExe("SELECT LID FROM NOTES WHERE LID=".$lids[0].";");
+ if($st->fetchrow_array()){
+ $st = $db->do("DELETE FROM NOTES WHERE LID=".$lids[0].";");
+
+ # NOTICE - There will be disparities here if renumeration failed, to update, run.
+ # These are expected after upgrades. And if switching DB engine and SQL compatibilities.
+ toBuf qq(<p>Warning deleted (possible old) NOTES.LID[$lids[0]] -> lid:@lids</p>);
+ }
+ toBuf("\nINSERT INTO NOTES($lids[0], {DOC[$date]})") if ($DEBUG);
+ $st = $db->prepare("INSERT INTO NOTES(LID, DOC) VALUES (?, ?);");
+ if(Settings::isProgressDB()){
+ $st->bind_param(1, $lids[0]);
+ $st->bind_param(2, $gzero[0],{ pg_type => DBD::Pg::PG_BYTEA });
+ $st->execute();
+ }else{
+ $st->execute($lids[0], $gzero[0]);
+ }
+
+ #Flatten ground zero
+ $st = $db->prepare("UPDATE NOTES SET DOC=null WHERE LID=0;");
+ $st->execute();
+ }
+ }
+ Settings::renumerate($db) if ( $dtCur > $dt );
+ }
+ if(!@gzero){$st = traceDBExe('SELECT DOC FROM NOTES WHERE LID = 0;');@gzero = $st->fetchrow_array()}
+ $rtf_buffer = 1 if $gzero[0];
+ }catch {
-my $err = $@;
-my $pwd = `pwd`;
-$pwd =~ s/\s*$//;
+ my $err = $@;
+ my $pwd = `pwd`;
+ $pwd =~ s/\s*$//;
-my $dbg = qq(--DEBUG OUTPUT--\n
+ my $dbg = qq(--DEBUG OUTPUT--\n
DSN:) . Settings::dsn(). qq(
stm:$stm
\@DB::args:@DB::args
\$DBI::err:$DBI::errstr
cnt:$cnt, cat:$cat, date:$date, log:$log, am:$am, af:$af, rtf:$rtf, sticky:$sticky);
- print $cgi->header,
- "<hr><font color=red><b>SERVER ERROR</b></font> on ".DateTime->now.
- "<hr><pre>$pwd/$0 -> &".caller." -> [<font color=red><b>$DBI::errstr</b></font>] $err\n$dbg</pre>",
- $cgi->end_html;
+ print $cgi->header,"<hr><font color=red><b>SERVER ERROR</b></font> on ".DateTime->now."<hr><pre>$pwd/$0 -> &".caller." -> [<font color=red><b>$DBI::errstr</b></font>] $err\n$dbg</pre>",$cgi->end_html;
- exit;
-}
+ exit;
+ }
}
- sub buildNavigationButtons {
-
- if ( !$log_cur_id ) {
-
- #Following is a quick hack as previous id as current minus one might not
- #coincide in the database table!
- $log_cur_id = $id - 1;
- }
- if ( $tfId == 1 ) {
- $tfId = 0;
- }
- else {
- $tfId = 1;
- }
-
- $vmode = qq(<span style="font-size:small;">[In Page Mode]</span> );
- $vmode = qq(<span style="font-color:red;font-size:x-small">[In View Mode]</span> ) if$isInViewMode;
- if($isPUBViewMode){
- $log_output .=qq!<tr class="r$tfId" id="brw_row"><td style="text-align:left;">$vmode</td><td colspan="3"></td>!;
- }
- elsif($rec_limit == 0){
- $log_output .= qq!<tr class="r$tfId" id="brw_row"><td style="text-align:left;">$vmode</td><td colspan="3">
+
+sub buildNavigationButtons {
+
+ if ( !$log_cur_id ) {
+
+ #Following is a quick hack as previous id as current minus one might not
+ #coincide in the database table!
+ $log_cur_id = $id - 1;
+ }
+ if ( $tfId == 1 ) {
+ $tfId = 0;
+ }else {
+ $tfId = 1;
+ }
+
+ $vmode = qq(<span style="font-size:small;">[In Page Mode]</span> );
+ $vmode = qq(<span style="font-color:red;font-size:x-small">[In View Mode]</span> ) if$isInViewMode;
+ if($isPUBViewMode){
+ $log_output .=qq!<tr class="r$tfId" id="brw_row"><td style="text-align:left;">$vmode</td><td colspan="3"></td>!;
+ }elsif($rec_limit == 0){
+ $log_output .= qq!<tr class="r$tfId" id="brw_row"><td style="text-align:left;">$vmode</td><td colspan="3">
<input class="ui-button" type="button" onclick="submitTop($log_top);return false;" value="Back To Page View"/>!;
- }
- else{
- if ($rs_cur < $log_top && $rs_prev && $rs_prev > 0 && $log_start > 0 && $rs_page > 0) {
- $log_output .= qq!<tr class="r$tfId" id="brw_row"><td style="text-align:left;">$vmode</td><td colspan="3"><input class="ui-button" type="button" onclick="submitTop($log_top);return false;" value="TOP"/>
+ }else{
+ if ($rs_cur < $log_top && $rs_prev && $rs_prev > 0 && $log_start > 0 && $rs_page > 0) {
+ $log_output .= qq!<tr class="r$tfId" id="brw_row"><td style="text-align:left;">$vmode</td><td colspan="3"><input class="ui-button" type="button" onclick="submitTop($log_top);return false;" value="TOP"/>
<input type="hidden" value="$rs_prev"/>
<input class="ui-button" type="button" onclick="submitPrev($log_rc_prev, $rec_limit);return false;" value="‹‹ Previous"/> !;
- }
- else {
- my $v = "<font style='font-size:small'>You Are In ➔ $vmode</font>";
- $log_output .= qq(<tr class="r$tfId" id="brw_row"><td colspan="2" style="text-align:left;">$v</td><td colspan="3"><i>Top</i> );
- }
+ }else {
+ my $v = "<font style='font-size:small'>You Are In ➔ $vmode</font>";
+ $log_output .= qq(<tr class="r$tfId" id="brw_row"><td colspan="2" style="text-align:left;">$v</td><td colspan="3"><i>Top</i> );
+ }
- $log_output .= '<input class="ui-button" type="button" onclick="viewAll();return false;" value="View All"/> ';
+ $log_output .= '<input class="ui-button" type="button" onclick="viewAll();return false;" value="View All"/> ';
- if ( $log_cur_id == 0 ) {
- $log_output = $log_output . '<i>End</i></td>';
- }
- else {
+ if ( $log_cur_id == 0 ) {
+ $log_output = $log_output . '<i>End</i></td>';
+ }else {
- $log_output .= qq!<input class="ui-button" type="button" onclick="submitNext($log_cur_id, $rec_limit);return false;"
+ $log_output .= qq!<input class="ui-button" type="button" onclick="submitNext($log_cur_id, $rec_limit);return false;"
value="Next ››"/>
<input class="ui-button" type="button" onclick="submitEnd($rec_limit);return false;" value="END"/></td>!;
- }
- }
+ }
+ }
+
+ $log_output .= '<td colspan="1"></td></tr>';
+}
- $log_output .= '<td colspan="1"></td></tr>';
- }
sub authenticate {
- try {
-
- my $st = traceDBExe("SELECT alias FROM AUTH WHERE alias='$alias' and passw='$passw';");
- my @c = $st->fetchrow_array();
- if (@c && $c[0] eq $alias ) { return; }
-
- #Check if passw has been wiped for reset?
- $st = traceDBExe("SELECT * FROM AUTH WHERE alias='$alias';");
- @c = $st->fetchrow_array();
- if ( @c && $c[1] == "" ) {
- #Wiped with -> UPDATE AUTH SET passw='' WHERE alias='$alias';
- $st = traceDBExe("UPDATE AUTH SET passw='$passw' WHERE alias='$alias';");
- return;
- }
-
- #We log failed possible intruder access.
- Settings::toLog($db,"User $alias, failed to authenticate!");
-
- print $cgi->header( -expires => "+0s", -charset => "UTF-8" );
- print $cgi->start_html(
- -title => "Personal Log Login",
- -BGCOLOR => Settings::theme('colBG'),
- -script =>
- { -type => 'text/javascript', -src => 'wsrc/main.js' },
- -style => { -type => 'text/css', -src => 'wsrc/main.css' },
- );
- if($DEBUG){
- print $cgi->center(
- $cgi->div("<b>Access Denied!</b> alias:$alias pass:$passw SQL->SELECT * FROM AUTH WHERE alias='$alias' and passw='$passw'; ")
- );
- }
- else{
- print $cgi->center(
- $cgi->div('<h2>Sorry Access Denied!</h2><font color=red><b>The credentials you supplied have failed!</b></font>'),
- $cgi->div('<h3>[<a href="login_ctr.cgi">Login</a>]</h3>')
- );
- }
- print $cgi->end_html;
-
- $db->disconnect();
- $sss->flush();
- exit;
-
- }
- catch {
- print $cgi->header( -expires => "+0s", -charset => "UTF-8" );
- print $cgi->p( "PAGE ERROR:" . $_ );
- print $cgi->end_html;
- exit;
- }
+ try {
+
+ my $st = traceDBExe("SELECT alias FROM AUTH WHERE alias='$alias' and passw='$passw';");
+ my @c = $st->fetchrow_array();
+ if (@c && $c[0] eq $alias ) { return; }
+
+ #Check if passw has been wiped for reset?
+ $st = traceDBExe("SELECT * FROM AUTH WHERE alias='$alias';");
+ @c = $st->fetchrow_array();
+ if ( @c && $c[1] == "" ) {
+
+ #Wiped with -> UPDATE AUTH SET passw='' WHERE alias='$alias';
+ $st = traceDBExe("UPDATE AUTH SET passw='$passw' WHERE alias='$alias';");
+ return;
+ }
+
+ #We log failed possible intruder access.
+ Settings::toLog($db,"User $alias, failed to authenticate!");
+
+ print $cgi->header( -expires => "+0s", -charset => "UTF-8" );
+ print $cgi->start_html(
+ -title => "Personal Log Login",
+ -BGCOLOR => Settings::theme('colBG'),
+ -script =>{ -type => 'text/javascript', -src => 'wsrc/main.js' },
+ -style => { -type => 'text/css', -src => 'wsrc/main.css' },
+ );
+ if($DEBUG){
+ print $cgi->center($cgi->div("<b>Access Denied!</b> alias:$alias pass:$passw SQL->SELECT * FROM AUTH WHERE alias='$alias' and passw='$passw'; "));
+ }else{
+ print $cgi->center($cgi->div('<h2>Sorry Access Denied!</h2><font color=red><b>The credentials you supplied have failed!</b></font>'),$cgi->div('<h3>[<a href="login_ctr.cgi">Login</a>]</h3>'));
+ }
+ print $cgi->end_html;
+
+ $db->disconnect();
+ $sss->flush();
+ exit;
+
+ }catch {
+ print $cgi->header( -expires => "+0s", -charset => "UTF-8" );
+ print $cgi->p( "PAGE ERROR:" . $_ );
+ print $cgi->end_html;
+ exit;
+ }
}
sub fetchAutocomplete {
- my $st = traceDBExe('select LOG from '. $VW_PAGE . $stmE. '-- > '. &Settings::autoWordLimit.' < -- fetchAutocomplete');
- my $awl = Settings::autoWordLength();
- my %hsh = ();
- my $lst = "\"\"";
- while ( my @row = $st->fetchrow_array() ) {
- my ($wl,$log) = ("",$row[0]);
- #Decode escaped \\n
- $log =~ s/\\n/\n/gs;
- $log =~ s/''/'/g;
- my @words = split( /\s/, $log );
- foreach my $word (sort @words) {
- #remove all non alphanumerics
- $word =~ s/[^a-zA-Z]//gs;
- $wl = length($word);
- if ( $wl > 2 && $wl < $awl) {# Gas Bootle
- $word = lc $word;
- if(!$hsh{$word}){
- $hsh{$word}=1;
- $lst .= qq(,"$word");
- } else{
- next;
- }
- if ( $aw_cnt++ > &Settings::autoWordLimit ) {
- last;
- }
- }
- }
- if ( $aw_cnt > Settings::autoWordLimit() ) {
- last;
- }
- }
- $autowords = $lst if(length($lst)>1);
- undef %hsh;
+ my $st = traceDBExe('select LOG from '. $VW_PAGE . $stmE. '-- > '. &Settings::autoWordLimit.' < -- fetchAutocomplete');
+ my $awl = Settings::autoWordLength();
+ my %hsh = ();
+ my $lst = "\"\"";
+ while ( my @row = $st->fetchrow_array() ) {
+ my ($wl,$log) = ("",$row[0]);
+
+ #Decode escaped \\n
+ $log =~ s/\\n/\n/gs;
+ $log =~ s/''/'/g;
+ my @words = split( /\s/, $log );
+ foreach my $word (sort @words) {
+
+ #remove all non alphanumerics
+ $word =~ s/[^a-zA-Z]//gs;
+ $wl = length($word);
+ if ( $wl > 2 && $wl < $awl) {# Gas Bootle
+ $word = lc $word;
+ if(!$hsh{$word}){
+ $hsh{$word}=1;
+ $lst .= qq(,"$word");
+ } else{
+ next;
+ }
+ if ( $aw_cnt++ > &Settings::autoWordLimit ) {
+ last;
+ }
+ }
+ }
+ if ( $aw_cnt > Settings::autoWordLimit() ) {
+ last;
+ }
+ }
+ $autowords = $lst if(length($lst)>1);
+ undef %hsh;
}
-sub cam { my $am = sprintf( "%.2f", shift);
- $am = sprintf( "%.2f", shift @_ ) if @_;
- # Add one comma each time through the do-nothing loop
- 1 while $am =~ s/^(-?\d+)(\d\d\d)/$1,$2/;
- return $am;
+
+sub cam {
+ my $am = sprintf( "%.2f", shift);
+ $am = sprintf( "%.2f", shift @_ ) if @_;
+
+ # Add one comma each time through the do-nothing loop
+ 1 while $am =~ s/^(-?\d+)(\d\d\d)/$1,$2/;
+ return $am;
}
-sub quill{
- my ( $log_id, $height ) = shift;
+sub quill{
-given ( &Settings::windowRTFSize ) {
- when("0") { $height = q(height:420px;) }
- when("1") { $height = q(height:260px;) }
- when("2") { $height = q(height:140px;) }
- default {
- $height = &Settings::windowRTFSize;
- }
-}
-return qq(
+ my ( $log_id, $height ) = shift;
+
+ given ( &Settings::windowRTFSize ) {
+ when("0") { $height = q(height:420px;) }
+ when("1") { $height = q(height:260px;) }
+ when("2") { $height = q(height:140px;) }
+ default {
+ $height = &Settings::windowRTFSize;
+ }
+ }
+ return qq(
<table id="tbl_doc" class="tbl" width=").&Settings::pagePrcWidth.qq(%" style="border:1; margin-top: 5px;" hidden>
<tr class="r0" style="text-align:center"><td><b>* Document *</b>
<a id="log_close" href="#" onclick="return hide('#tbl_doc');">$sp1</a>
<input type="button" id="btn_save_doc" onclick="saveRTF(0, 'store'); return false;" value="Save"/>
</div>
</td></tr></table>
-)}
+);
+}
+
sub help{
-return qq(
+ return qq(
<table id="tbl_hlp" class="tbl" border="0" width=").&Settings::pagePrcWidth.qq(%" hidden>
<tr class="r0"><td colspan="3"><b>* HELP *</b>
<a id="a_close" href="#" onclick="return hide('#tbl_hlp');">$sp1</a>
</td></tr></table>)
}
+
sub outputPage {
- #Bug 26 -Fixed here by prefixing to collected html body buffer.
- $BUFFER = $cgi->start_html(
- -title => "Personal Log",
- -BGCOLOR => Settings::theme('colBG'),
- -onload => "onBodyLoad('$toggle','".&Settings::language."','".&Settings::timezone."','$today','".&Settings::sessionExprs."','$rs_cur',".&Settings::dbVLSZ.");",
- -style => [
- { -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-yellowsimple/tip-yellowsimple.css'
- },
-
- { -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' },
- { -type => 'text/css', -src => Settings::theme('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' },
- { -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'}
-
- ]) . ($DEBUG ?"<div class='debug_output' date='$today'>$D_BUFF</div>":"").
- $BUFFER;
-
- if(Settings->compressPage() && $cgi->http('Accept-Encoding') =~ m/gzip/){
- print $cgi->header(-expires => "1s", -charset => "UTF-8", -Content_Encoding => 'gzip');
- $BUFFER = gzip($BUFFER);
- }
- else{
- print $cgi->header(-expires => "1s", -charset => "UTF-8");
- }
- print $BUFFER;
- print $cgi->end_html;
+
+ #Bug 26 -Fixed here by prefixing to collected html body buffer.
+ $BUFFER = $cgi->start_html(
+ -title => "Personal Log",
+ -BGCOLOR => Settings::theme('colBG'),
+ -onload => "onBodyLoad('$toggle','".&Settings::language."','".&Settings::timezone."','$today','".&Settings::sessionExprs."','$rs_cur',".&Settings::dbVLSZ.");",
+ -style => [
+ { -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-yellowsimple/tip-yellowsimple.css'
+ },
+
+ { -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' },
+ { -type => 'text/css', -src => Settings::theme('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' },
+ { -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'}
+
+ ]
+ )
+ . ($DEBUG ?"<div class='debug_output' date='$today'>$D_BUFF</div>":"")
+ .$BUFFER;
+
+ if(Settings->compressPage() && $cgi->http('Accept-Encoding') =~ m/gzip/){
+ print $cgi->header(-expires => "1s", -charset => "UTF-8", -Content_Encoding => 'gzip');
+ $BUFFER = gzip($BUFFER);
+ }else{
+ print $cgi->header(-expires => "1s", -charset => "UTF-8");
+ }
+ print $BUFFER;
+ print $cgi->end_html;
}
lifelog.hopto.org / LifeLog.git / commitdiff