From: wbudic Date: Wed, 15 Dec 2021 00:25:26 +0000 (+1100) Subject: Fixed unitialized warnings. See current dev. X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=630eae7388ed9262643d00e808fdb5c335bb4137;p=LifeLog.git Fixed unitialized warnings. See current dev. --- diff --git a/Current Development Check List.md b/Current Development Check List.md index 6fde31a..2e1df00 100644 --- a/Current Development Check List.md +++ b/Current Development Check List.md @@ -6,6 +6,8 @@ ### New Development v.2.3+ +* [x] Fix uninitialized $scalars and warnings. My style of programming uses this as a perl feature, as unutilized is also null or empty. Linter disagrees with that. Empty or null isn't also 0 for it. Null, empty and zero should be the same thing in scalar context and logic. +* [ ] Implement template based CGI processing (slower but better separation of concerns). * [ ] Module installation script should check, on main.cnf and on perl soundness and compatibility. * Should check and display autonomes that contain expected defaults changed or disabled in configuration. i.e AUTO_LOGIN or DBI_MULTI_USER_DB * A trouble_shoot_configuration.pl should be available to perform this, and be independently available from the main directory. diff --git a/htdocs/cgi-bin/data.cgi b/htdocs/cgi-bin/data.cgi index 180994d..71e7885 100755 --- a/htdocs/cgi-bin/data.cgi +++ b/htdocs/cgi-bin/data.cgi @@ -3,9 +3,9 @@ # Programed in vim by: Will Budic # Open Source License -> https://choosealicense.com/licenses/isc/ # -use v5.10; use warnings; use strict; +use experimental qw( switch ); use Exception::Class ('LifeLogException'); use Syntax::Keyword::Try; diff --git a/htdocs/cgi-bin/login_ctr.cgi b/htdocs/cgi-bin/login_ctr.cgi index 481bdc1..c773334 100755 --- a/htdocs/cgi-bin/login_ctr.cgi +++ b/htdocs/cgi-bin/login_ctr.cgi @@ -1,10 +1,11 @@ -#!/usr/bin/perl -w +#!/usr/local/bin/perl -w # # Programed by: Will Budic # Open Source License -> https://choosealicense.com/licenses/isc/ # use strict; use warnings; +use experimental qw( switch ); use Exception::Class ('LifeLogException'); use Syntax::Keyword::Try; use CGI; @@ -13,6 +14,7 @@ use DBI; use lib "system/modules"; require Settings; use CGI::Carp qw(fatalsToBrowser set_message); +use bignum qw/hex/; BEGIN { sub handle_errors { my $msg = shift; @@ -24,12 +26,12 @@ BEGIN { } my $cgi = CGI->new(); -my $session = new CGI::Session("driver:File",$cgi, {Directory=>&Settings::logPath, SameSite=>'Lax'}); +my $session = CGI::Session->new("driver:File",$cgi, {Directory=>&Settings::logPath, SameSite=>'Lax'}); my $sssCreatedDB = $session->param("cdb"); my $sid=$session->id(); my $cookie = $cgi->cookie(CGISESSID => $sid); -my ($db,$DB_NAME,$PAGE_EXCLUDES, $DBG, $frm)=""; +my ($db,$DB_NAME,$PAGE_EXCLUDES, $DBG, $frm)=("",""); my $alias = $cgi->param('alias'); my $passw = $cgi->param('passw'); my $pass; @@ -123,22 +125,22 @@ HTML } } catch { - my $err = $@; + my $err = $@; my $now=DateTime->now(); $now=~s/T/@/; my $dbg = ""; my $pwd = `pwd`; $pwd =~ s/\s*$//; - $dbg = "--DEBUG OUTPUT--\n$DBG" if Settings::debug(); + $dbg = "--DEBUG OUTPUT--\n$DBG" if Settings::debug(); print $cgi->header, - "
SERVER ERROR on ".DateTime->now(). + "
SERVER ERROR on $now". "
".$pwd."/$0 -> [\n$err]","\n$dbg
", $cgi->end_html; } exit; sub processSubmit { - if($alias&&$passw){ - $pass = $passw;$passw = uc crypt $passw, hex Settings->CIPHER_KEY; - #CheckTables will return 1 if it was an logout set in config table. + if($alias&&$passw){ + $pass = $passw; $passw = uc crypt $passw, hex Settings->CIPHER_KEY; + #CheckTables will return 1 if it was an logout set in the config table. To bypass redirection. if(checkCreateTables()==0){ $session->param('alias', $alias); $session->param('passw', $passw); @@ -151,6 +153,8 @@ sub processSubmit { print $cgi->header(-expires=>"0s", -charset=>"UTF-8", -cookie=>$cookie, -location=>"main.cgi"); ### return 1; #activated redirect to main, main will check credentials. + }else{ + die "Check Create tables failed!" } } else{ @@ -270,15 +274,15 @@ sub checkPreparePGDB { return 0; } -sub checkCreateTables { my ($pst, $sql,$rv, $changed) = 0; +sub checkCreateTables { my ($pst, $sql,$rv, $changed) = ("","","",0); try{ # We live check database for available tables now only once. # If brand new database, this sill returns fine an empty array. my %curr_config = (); my %curr_tables; $changed = checkPreparePGDB() if Settings::isProgressDB(); - $db = Settings::connectDB($DB_NAME, $alias, $passw); - %curr_tables = %{Settings::schema_tables($db)}; + $db = Settings::connectDB($DB_NAME, $alias, $passw); + %curr_tables = %{Settings::schema_tables($db)}; if($curr_tables{'CONFIG'}) { #Set changed if the configuration data has been wiped out, i.e. by db fix routines. @@ -585,12 +589,13 @@ sub checkCreateTables { my ($pst, $sql,$rv, $changed) = 0; $db->disconnect(); # #Still going through checking tables and data, all above as we might have an version update in code. - #Then we check if we are login in intereactively back. Interective, logout should bring us to the login screen. - #Bypassing auto login. So to start maybe working on another database, and a new session. - return $cgi->param('autologoff') == 1; + #Then we check if we are loged in intereactively back. Interective, logout should bring us to the login screen. + # Bypassing auto login. So to start maybe working on another database, and a new session. + return 1 if $cgi->param('autologoff') == 1; }catch{ - LifeLogException -> throw(error=>"DSN:".Settings::dsn()." Error:".$@."\nLAST_SQL:".$sql,show_trace=>1); + LifeLogException -> throw(error=>"DSN:".Settings::dsn()." Error:".$@."\nLAST_SQL:".$sql,show_trace=>1); } + return 0; } sub createPageViewExcludeSQL { @@ -908,5 +913,5 @@ sub logout { exit; } -1; + diff --git a/htdocs/cgi-bin/main.cgi b/htdocs/cgi-bin/main.cgi index 6d54123..39fe93d 100755 --- a/htdocs/cgi-bin/main.cgi +++ b/htdocs/cgi-bin/main.cgi @@ -1,11 +1,11 @@ -#!/usr/bin/perl +#!/usr/local/bin/perl # # Programed by: Will Budic # Open Source License -> https://choosealicense.com/licenses/isc/ # -use v5.10; use warnings; use strict; +use experimental qw( switch ); use Exception::Class ('LifeLogException'); use Syntax::Keyword::Try; use DBI; @@ -33,13 +33,14 @@ my $alias = Settings::alias(); my $passw = Settings::pass(); my $VW_PAGE = Settings->VW_LOG; -my $sssCDB = $sss->param('cdb'); +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; # @@ -47,18 +48,24 @@ my $log_rc = 0; my $log_rc_prev = 0; my $log_cur_id = 0; my $log_top = 0; -my $rs_keys = $cgi->param('keywords'); -my $prm_aa = $cgi->param("aa"); -my $prm_vc = $cgi->param("vc"); -my $prm_vc_lst = $cgi->param("vclst"); -my $prm_xc = $cgi->param("xc"); -my $prm_xc_lst = $cgi->param("xclst"); -my $prm_rtf = $cgi->param("vrtf"); -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 $rs_keys = param('keywords'); +my $prm_aa = param("aa"); +my $prm_vc = param("vc"); +my $prm_vc_lst = param("vclst"); +my $prm_xc = param("xc"); +my $prm_xc_lst = param("xclst"); +my $prm_rtf = param("vrtf"); +my $rs_dat_from = param('v_from'); +my $rs_dat_to = param('v_to'); +my $rs_prev = param('rs_prev'); +my $rs_cur = param('rs_cur'); +my $rs_page = param('rs_page'); +sub param{ + $_ = $cgi->param(shift); return 0 if !$_; +} +sub session{ + $_ = $sss->param(shift); return 0 if !$_; +} 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){ @@ -75,13 +82,13 @@ my $sqlView = 'SELECT ID, ID_CAT, DATE, LOG, RTF, AMOUNT, AFLAG, STICKY, PID my $stmS = $sqlView." WHERE"; my $stmE = ' LIMIT '.&Settings::viewAllLimit.';'; my $stmD = ""; -my $sm_reset_all; +my $sm_reset_all= ""; my $rec_limit = Settings::recordLimit(); #Set to 1 to get debug help. Switch off with 0. -my $DEBUG = Settings::debug(); +my $DEBUG = 1;#Settings::debug(); #END OF SETTINGS my $rtf_buffer = 0; -my ($BUFFER, $D_BUFF); +my ($BUFFER, $D_BUFF)=("",""); my $lang = Date::Language->new(Settings::language()); my $today = Settings->today(); @@ -120,7 +127,7 @@ $sss->param('bgcolor', Settings::theme('colBG')); #sss->param('sss_main', $today); # #Reset Clicked -if($cgi->param('srch_reset') == 1){ +if(param('srch_reset') == 1){ $sss->clear('sss_vc');$sss->clear('sss_xc');$sss->clear('sss_ord_cat'); } @@ -152,8 +159,8 @@ if($prm_vc &&$prm_vc ne ""){ } }else{ - $prm_vc = $sss->param('sss_vc'); - $prm_vc_lst = $sss->param('sss_vc_lst'); + $prm_vc = session('sss_vc'); + $prm_vc_lst = session('sss_vc_lst'); } if($prm_xc &&$prm_xc ne ""){ @@ -182,11 +189,11 @@ if($prm_xc &&$prm_xc ne ""){ } }else{ - $prm_xc = $sss->param('sss_xc'); - $prm_xc_lst = $sss->param('sss_xc_lst'); + $prm_xc = session('sss_xc'); + $prm_xc_lst = session('sss_xc_lst'); } #Either Session or requested. -if($cgi->param('sss_ord_cat') eq 'on'){ +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)} @@ -218,7 +225,7 @@ $st = $db->prepare($sqlCAT); $st->execute() or LifeLogException->throw($DBI::errstri); my %hshCats; -my %hshDesc = {}; +my %hshDesc = (); my $c_sel = 1; my $data_cats = ""; my $td_cat = "
    "; @@ -232,8 +239,8 @@ while ( my @row = $st->fetchrow_array() ) { $td_cat .= "
    "; $td_itm_cnt = 0; } - $td_cat .= "
  • $row[1]
    • "; - $td_itm_cnt++; + $td_cat .= "
  • ".$row[1]."
    • "; + $td_itm_cnt++ } if($td_itm_cnt<5){#fill spacing. for (my $i=0;$i<5-$td_itm_cnt;$i++){ @@ -244,7 +251,7 @@ $td_cat .= "
"; for my $key ( keys %hshDesc ) { - my $kv = $hshDesc{$key}; + my $kv = $hshDesc{$key}; next if !$kv; if ( $kv ne ".." && index($key,'HASH(0x')!=0) { my $n = $hshCats{$key}; $data_cats .= qq(\n); @@ -430,7 +437,7 @@ sub buildLog { 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++]; #LOG.AMOUNT + 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. @@ -877,26 +884,26 @@ HTML ); - my ($sss_checked, $sss_orderby); + my ($sss_checked, $sss_orderby) = ("",""); my ($vc_lst,$xc_lst) = ("",""); my $tdivvc = 'Includes:'; my $tdivxc = 'Excludes:'; my $catselected = '   -- Select --   '; my $xcatselected = '   -- Select --   '; if ($isInViewMode) { $sss_checked = 'checked'} - if ($sss->param('sss_ord_cat')){ $sss_orderby = 'checked'} + if (session('sss_ord_cat')){ $sss_orderby = 'checked'} if($prm_vc){ - $catselected = $hshCats{$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{$_}.',';$xc_lst.=$_.','} + 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 = $hshCats{$prm_xc}; $xcatselected ="" if !$xcatselected; my $n = 16 - length($xcatselected); $xcatselected =~ s/^(.*)/' ' x $n . $1/e; $tdivxc = 'Excludes:'.$xcls.''; @@ -910,7 +917,7 @@ HTML #select options of $prm_aa in dropdown. my $aopts = ""; my ($s,$i) = ("",0); - my $aa = $cgi->param('aa'); + my $aa = param('aa'); if(!$prm_aa){$aa = 0}else{$aa--}; foreach ('Asset','Income','Expense') { if($aa == $i){$s='selected'}else{$s=""} @@ -1037,7 +1044,7 @@ if($isPUBViewMode){$sideMenu=$frm=$srh=$tail=""}else{ } -my $quill = &quill( $cgi->param('submit_is_edit') ); +my $quill = &quill( param('submit_is_edit') ); my $help = &help; ################################## @@ -1082,18 +1089,18 @@ sub castToBool { sub processSubmit { - my $date = $cgi->param('date'); - my $log = $cgi->param('log'); - my $cat = $cgi->param('ec'); + my $date = param('date'); + my $log = param('log'); + my $cat = param('ec'); my $cnt =""; - my $am = $cgi->param('am'); - my $af = $cgi->param('amf'); - - my $edit_mode = $cgi->param('submit_is_edit'); - my $view_mode = $cgi->param('submit_is_view'); - my $view_all = $cgi->param('rs_all'); - my $rtf = $cgi->param('rtf'); - my $sticky = $cgi->param('sticky'); + 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; @@ -1331,7 +1338,7 @@ sub authenticate { } else{ print $cgi->center( - $cgi->div('

Sorry Access Denied!

You supplied wrong credentials.'), + $cgi->div('

Sorry Access Denied!

The credentials you supplied have failed!'), $cgi->div('

[Login]

') ); } @@ -1388,8 +1395,8 @@ sub fetchAutocomplete { undef %hsh; } -sub cam { - my $am = sprintf( "%.2f", shift @_ ); +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; diff --git a/htdocs/cgi-bin/stats.cgi b/htdocs/cgi-bin/stats.cgi index d800d65..fea0bdf 100755 --- a/htdocs/cgi-bin/stats.cgi +++ b/htdocs/cgi-bin/stats.cgi @@ -2,10 +2,9 @@ # Programed by: Will Budic # Open Source License -> https://choosealicense.com/licenses/isc/ # -use v5.10; use strict; use warnings; -#no warnings 'uninitialized'; +no warnings 'uninitialized'; use CGI; use CGI::Session '-ip_match'; @@ -18,7 +17,8 @@ use IPC::Run qw( run ); use Syntax::Keyword::Try; use lib "system/modules"; -use lib $ENV{'PWD'}.'/htdocs/cgi-bin/system/modules'; +my $PWD = $ENV{'PWD'}; $PWD="" if !$PWD; +use lib $PWD.'/htdocs/cgi-bin/system/modules'; require Settings; my $db = Settings::fetchDBSettings();