kalipso/racalmas
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactoring

Browse Source 
optimize imports
reformat source code
remove unused cpu and memory log functionality
This commit is contained in:
Milan
2018-08-29 00:10:15 +02:00
parent c37c71f29e
commit 05b1251c1a
81 changed files with 9242 additions and 9962 deletions
Download Patch File Download Diff File Expand all files Collapse all files

188
lib/calcms/log.pm
View File

@@ -1,166 +1,92 @@
use warnings "all";
use strict;
use template;
use config;
use template();
use config();
package log;
use Data::Dumper;
require Exporter;
our @ISA = qw(Exporter);
#our @EXPORT = qw(all);
our @EXPORT_OK = qw(init write read error mem);
our %EXPORT_TAGS = ( 'all' => [ @EXPORT_OK ] );
sub error {
my $config = $_[0];
my $message = "Error: $_[1]\n";
#our $debug=0;
our $debug_params='';
our $header="Content-type:text/html\n\n";
our $gtop = undef;
our $proc = undef;
sub init{
my $request =$_[0];
$log::debug_params =$request->{params}->{checked}->{debug}||'';
$log::header =$request->{header}if (defined $request->{header});
#if ($config->{system}->{debug_memory}>0){
#use GTop();
#$log::gtop=GTop->new;
#$log::proc=$gtop->proc_mem($$);
#}
}
sub write{
my $config = shift;
my $key = shift;
my $data = shift;
my $dump = shift;
return unless(defined $config::config->{system}->{debug});
return unless(($config::config->{system}->{debug}>0) &&($log::debug_params=~/$key/));
my $line=Dumper($data);
$line=~s/^\$VAR1 = \{\n/<code>/g;
$line=~s/\};\n$/<\/code>/g;
$line=~s/\n/\\n/g;
my $msg=localtime()." [$key] ".$ENV{REQUEST_URI}."\\n".$line;
$msg.=Dumper($dump) if (defined $dump);
$msg.="\n";
log::print($config, $msg);
}
sub print{
my $config = $_[0];
my $message= $_[1];
unless (defined $config){
print STDERR "missing config at log::error\n";
return;
}
my $filename=$config->{system}->{log_debug_file}||'';
if ($filename eq ''){
print STDERR "calcms config parameter 'system/log_debug_file' not set!\n";
return;
};
open my $FILE, ">>:utf8", $filename or warn("cant write log file '$filename'");
print $FILE $message;
close $FILE;
}
sub error{
my $config = $_[0];
my $message="Error: $_[1]\n";
unless (defined $config){
print STDERR "missing config at log::error\n";
}
print STDERR $message."\n";
if($config::config->{system}->{debug}){
log::write($config, '', $message);# if ($config::config->{system}->{debug}>1);
my $out='';
#do not call template::check to avoid deep recursion!
template::process('print','templates/default.html', {
static_files_url => $config::config->{locations}->{static_files_url},
error=>$message
});
print STDERR $message;
unless ( defined $config ) {
print STDERR "missing config at log::error\n";
die();
}
# TODO: remove exit
die();
#exit;
#do not call template::check to avoid deep recursion!
if ( $config::config->{system}->{debug} ) {
template::process(
'print',
'templates/default.html',
{
static_files_url => $config::config->{locations}->{static_files_url},
error => $message
}
);
}
die();
}
sub mem{
my $config = $_[0];
return unless $config::config->{system}->{debug_memory};
my $size=$log::gtop->proc_mem($$)->size();
my $format_size=$size;
$format_size=~s/(\d)(\d\d\d)$/$1\.$2/g;
$format_size=~s/(\d)(\d\d\d)(\d\d\d)$/$1\.$2\.$3/g;
my $line=localtime(time())."\t".$$."\t".$format_size."\t".$_[0];
$line.="\t\t".($size-$_[1]) if(defined $_[1]);
log::error($config, "log_memory_file is not defined!") if (!defined $config::config->{system}->{log_debug_memory_file});
log::append_file($config::config->{system}->{log_debug_memory_file} , $line);
}
#do not delete last line!
1;
sub load_file{
my $filename=$_[0];
# my $content=$_[1];
sub load_file {
my $filename = $_[0];
# binmode STDOUT, ":utf8";
my $content='';
if (-e $filename){
my $FILE=undef;
# my $content=$_[1];
# binmode STDOUT, ":utf8";
my $content = '';
if ( -e $filename ) {
my $FILE = undef;
open $FILE, "<:utf8", $filename || warn "cant read file '$filename'";
$content=join "",(<$FILE>);
$content = join "", (<$FILE>);
close $FILE;
return $content;
}
}
sub save_file{
my $filename=$_[0];
my $content=$_[1];
sub save_file {
my $filename = $_[0];
my $content = $_[1];
#check if directory is writeable
if ($filename=~/^(.+?)\/[^\/]+$/){
my $dir=$1;
unless (-w $dir){
if ( $filename =~ /^(.+?)\/[^\/]+$/ ) {
my $dir = $1;
unless ( -w $dir ) {
print STDERR `pwd;id -a;`;
print STDERR "log::save_file : cannot write to directory ($dir)\n";
return;
}
}
open my $FILE, ">:utf8", $filename || warn("cant write file '$filename'");
if (defined $FILE){
print $FILE $content."\n";
close $FILE;
open my $FILE, ">:utf8", $filename || warn("cant write file '$filename'");
if ( defined $FILE ) {
print $FILE $content . "\n";
close $FILE;
}
}
sub append_file{
my $filename =$_[0];
my $content =$_[1];
sub append_file {
my $filename = $_[0];
my $content = $_[1];
unless ( (defined $filename) && ($filename ne'') && (-e $filename) ){
print STDERR "cannot append, file '$filename' does not exist\n";
return;
}
unless ( ( defined $filename ) && ( $filename ne '' ) && ( -e $filename ) ) {
print STDERR "cannot append, file '$filename' does not exist\n";
return;
}
if (defined $content){
open my $FILE, ">>:utf8", $filename or warn("cant write file '$filename'");
print $FILE $content."\n";
close $FILE;
if ( defined $content ) {
open my $FILE, ">>:utf8", $filename or warn("cant write file '$filename'");
print $FILE $content . "\n";
close $FILE;
}
}
#do not delete last line!
1;
return 1;