1913 lines
69 KiB
Perl
1913 lines
69 KiB
Perl
|
use common_min ;
|
|||
|
|
|
|||
|
|
sub common_upload_files {
|
|||
|
|
|
|||
|
|
my ($folder) = @_ ;
|
|||
|
|
|
|||
|
|
for my $p ($q->param) {
|
|||
|
|
if (substr($p,0,7) eq 'iattach') {
|
|||
|
|
next if $ignore_attach{$p} ;
|
|||
|
|
my $val = $q->param($p) ;
|
|||
|
|
my $fol = substr($p,7) ;
|
|||
|
|
&common_upload_file($val,$p,$fol,$folder) ;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_append_log {
|
|||
|
|
|
|||
|
|
my ($log,$nline) = @_ ;
|
|||
|
|
|
|||
|
|
unless ($log) { return ; }
|
|||
|
|
|
|||
|
|
if (substr($now_min,0,1)==3) { &common_large_log($log,$nline) ; return ; } # run on 30 min for 10 min
|
|||
|
|
|
|||
|
|
$nline =~ s/[ ]+/ /g ; # Replaces all occurances of two spaces with one space
|
|||
|
|
|
|||
|
|
# my $serverpath = (substr($ENV{SERVER_NAME},0,6) eq 'client') ? 'gwtruckassist' : 'gatewaytruckassa' ;
|
|||
|
|
|
|||
|
|
my $logfile = "/home/libs/data/logs/$log";
|
|||
|
|
|
|||
|
|
open (LFILE, ">>$logfile") or die "can't open $logfile : $!" ;
|
|||
|
|
flock (LFILE, LOCK_EX) or die "can't lock $logfile : $!" ;
|
|||
|
|
print LFILE $nline . "\n" ;
|
|||
|
|
close (LFILE) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_large_log {
|
|||
|
|
|
|||
|
|
my ($log,$nline) = @_ ;
|
|||
|
|
|
|||
|
|
unless ($log) { return ; }
|
|||
|
|
|
|||
|
|
$nline =~ s/[ ]+/ /g ; # Replaces all occurances of two spaces with one space
|
|||
|
|
$nline =~ s/\n/ /g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/\t/ /g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/\r/ /g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
|
|||
|
|
my $logfile = "/home/libs/data/logs/$log";
|
|||
|
|
|
|||
|
|
open (LFILE, "+>>$logfile") or die "can't open $logfile : $!" ;
|
|||
|
|
flock (LFILE, LOCK_EX) or die "can't lock $logfile : $!" ;
|
|||
|
|
seek (LFILE, 0, 0) or die "can't rewind $logfile : $!" ;
|
|||
|
|
@lines = <LFILE> ;
|
|||
|
|
seek (LFILE, 0, 0) or die "can't rewind $logfile : $!" ;
|
|||
|
|
truncate (LFILE, 0) or die "can't truncate $logfile : $!" ;
|
|||
|
|
|
|||
|
|
my @sort_lines = reverse sort @lines ; # put newest ones first
|
|||
|
|
|
|||
|
|
my $log_cnt = 0 ;
|
|||
|
|
|
|||
|
|
print LFILE $nline . "\n" ;
|
|||
|
|
|
|||
|
|
foreach my $line (@sort_lines) { # 20181109104451||||
|
|||
|
|
chomp $line;
|
|||
|
|
@linex = split(/\|/,$line);
|
|||
|
|
|
|||
|
|
# my $hashkey = $linex[2] . $linex[3] . $linex[4] . substr($linex[5],0,12) ;
|
|||
|
|
my $hashkey = $linex[2] . $linex[3] . $linex[4] . substr($linex[0],0,8) ;
|
|||
|
|
|
|||
|
|
if ($done_log_line{$hashkey}) { next ; }
|
|||
|
|
|
|||
|
|
if ($log_cnt > 10000) { last ; } # only retain 10000 lines
|
|||
|
|
|
|||
|
|
print LFILE "$line\n";
|
|||
|
|
|
|||
|
|
$done_log_line{$hashkey} = 1 ;
|
|||
|
|
|
|||
|
|
$log_cnt++;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
close (LFILE) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_write_log {
|
|||
|
|
|
|||
|
|
my ($log,$nline) = @_ ;
|
|||
|
|
|
|||
|
|
unless ($log) { return ; }
|
|||
|
|
|
|||
|
|
$nline =~ s/\n//g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/\t//g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/\r//g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/\f//g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/[ ]+/ /g ; # Replaces all occurances of two spaces with one space
|
|||
|
|
$nline =~ s/> </></g ; # Replaces '> <' with '><'
|
|||
|
|
|
|||
|
|
# my $serverpath = (substr($ENV{SERVER_NAME},0,6) eq 'client') ? 'gwtruckassist' : 'gatewaytruckassa' ;
|
|||
|
|
|
|||
|
|
my $logfile = "/home/libs/data/logs/$log";
|
|||
|
|
|
|||
|
|
open (LFILE, "+>>$logfile") or die "can't open $logfile : $!" ;
|
|||
|
|
flock (LFILE, LOCK_EX) or die "can't lock $logfile : $!" ;
|
|||
|
|
seek (LFILE, 0, 0) or die "can't rewind $logfile : $!" ;
|
|||
|
|
@lines = <LFILE> ;
|
|||
|
|
seek (LFILE, 0, 0) or die "can't rewind $logfile : $!" ;
|
|||
|
|
truncate (LFILE, 0) or die "can't truncate $logfile : $!" ;
|
|||
|
|
|
|||
|
|
my @sort_lines = reverse sort @lines ; # put newest ones first
|
|||
|
|
|
|||
|
|
my $log_cnt = 0 ;
|
|||
|
|
|
|||
|
|
print LFILE $nline . "\n" ;
|
|||
|
|
|
|||
|
|
foreach my $line (@sort_lines) { # 20181109104451||||
|
|||
|
|
chomp $line;
|
|||
|
|
@linex = split(/\|/,$line);
|
|||
|
|
|
|||
|
|
if ($log_cnt > 5000) { last ; } # only retain 5000 lines
|
|||
|
|
|
|||
|
|
print LFILE "$line\n";
|
|||
|
|
|
|||
|
|
$log_cnt++;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
close (LFILE) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_upload_file {
|
|||
|
|
|
|||
|
|
my ($filename,$param,$type,$folder) = @_ ;
|
|||
|
|
|
|||
|
|
unless ($filename) { return ; }
|
|||
|
|
|
|||
|
|
$CGI::POST_MAX = 1024 * 5000;
|
|||
|
|
# my $safe_filename_characters = "a-zA-Z0-9_.-";
|
|||
|
|
|
|||
|
|
my $upload_dir = ($upload_files_to_sss) ? "$htmlpath_sss/uploads/$folder" : "$htmlpath/uploads/$folder";
|
|||
|
|
mkdir $upload_dir unless -d $upload_dir ;
|
|||
|
|
|
|||
|
|
# my ($name,$path,$extension) = fileparse ($filename, '..*') ;
|
|||
|
|
# $filename = $name . $extension;
|
|||
|
|
# $filename =~ tr/ /_/;
|
|||
|
|
# $filename =~ s/[^$safe_filename_characters]//g;
|
|||
|
|
|
|||
|
|
# if ( $filename =~ /^([$safe_filename_characters]+)$/ ) { $filename = "$type-$1" ; } else { die "Filename contains invalid characters" ; }
|
|||
|
|
|
|||
|
|
$filename = &common_process_uploaded_file_names($filename,$type) ;
|
|||
|
|
|
|||
|
|
$uploads_hash{$type}{$filename} = 1 if $type ;
|
|||
|
|
$uploads_file{$type} = $filename if $type ;
|
|||
|
|
|
|||
|
|
if (($testing == 1) and ($username eq 'rory')) { &common_debug("Upload $type - $filename") ; return; }
|
|||
|
|
|
|||
|
|
my $upload_filehandle = $q->upload($param) ;
|
|||
|
|
|
|||
|
|
open ( UPLOADFILE, ">$upload_dir/$filename" ) or die "can't open $upload_dir/$filename: $!" ;
|
|||
|
|
flock (UPLOADFILE, LOCK_EX) or die "can't lock $upload_dir/$filename: $!" ;
|
|||
|
|
binmode UPLOADFILE or die "$!" ;
|
|||
|
|
|
|||
|
|
while ( <$upload_filehandle> ) {
|
|||
|
|
print UPLOADFILE ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
close UPLOADFILE;
|
|||
|
|
|
|||
|
|
# my ($filename,$param,$type,$folder) = @_ ;
|
|||
|
|
|
|||
|
|
# unless ($filename) { return ; }
|
|||
|
|
|
|||
|
|
# $CGI::POST_MAX = 1024 * 5000;
|
|||
|
|
# my $safe_filename_characters = "a-zA-Z0-9_.-";
|
|||
|
|
# my $upload_dir = "$htmlpath/uploads/$folder";
|
|||
|
|
|
|||
|
|
# mkdir $upload_dir unless -d $upload_dir ;
|
|||
|
|
|
|||
|
|
# my ($name,$path,$extension) = fileparse ($filename, '..*') ;
|
|||
|
|
# $filename = $name . $extension;
|
|||
|
|
# $filename =~ tr/ /_/;
|
|||
|
|
# $filename =~ s/[^$safe_filename_characters]//g;
|
|||
|
|
|
|||
|
|
# if ( $filename =~ /^([$safe_filename_characters]+)$/ ) {
|
|||
|
|
# $filename = $type . '_' . $now_ccyymmdd . $now_hour . $now_min . $now_sec . '_' . $1 ;
|
|||
|
|
# }
|
|||
|
|
# else
|
|||
|
|
# {
|
|||
|
|
# die "Filename contains invalid characters" ;
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# my $upload_filehandle = $q->upload($param) ;
|
|||
|
|
|
|||
|
|
# open ( UPLOADFILE, ">$upload_dir/$filename" ) or die "can't open $upload_dir/$filename $!" ;
|
|||
|
|
# flock (UPLOADFILE, LOCK_EX) or die "can't lock $upload_dir/$filename: $!" ;
|
|||
|
|
# binmode UPLOADFILE or die "$!" ;
|
|||
|
|
|
|||
|
|
# while ( <$upload_filehandle> ) {
|
|||
|
|
# print UPLOADFILE ;
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# close UPLOADFILE;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_process_uploaded_file_names {
|
|||
|
|
|
|||
|
|
my ($filename,$type) = @_ ;
|
|||
|
|
|
|||
|
|
my $safe_filename_characters = "a-zA-Z0-9_.-";
|
|||
|
|
|
|||
|
|
my ($name,$path,$extension) = fileparse ($filename, '..*') ;
|
|||
|
|
$filename = $name . $extension;
|
|||
|
|
$filename =~ tr/ /_/;
|
|||
|
|
$filename =~ s/[^$safe_filename_characters]//g;
|
|||
|
|
|
|||
|
|
if ($filename =~ /^([$safe_filename_characters]+)$/ && $type) {
|
|||
|
|
$filename = "$type-$1" ;
|
|||
|
|
} elsif ($filename =~ /^([$safe_filename_characters]+)$/ && !$type) {
|
|||
|
|
$filename = "$1" ;
|
|||
|
|
} else {
|
|||
|
|
die "Filename contains invalid characters" ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($filename) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_get_field_uploads {
|
|||
|
|
|
|||
|
|
my ($id,$type,$folder,$custom_delete_attach_id) = @_ ;
|
|||
|
|
|
|||
|
|
unless ($id and $type) { return() ; }
|
|||
|
|
|
|||
|
|
my $uploads = '' ; my %uploads = () ;
|
|||
|
|
|
|||
|
|
my $field = $type ; my ($doctype,$num) = split(/\_/,$field) ; $doctype .= 's' ;
|
|||
|
|
|
|||
|
|
$table = $doctype unless $table ;
|
|||
|
|
|
|||
|
|
my $doc = $db{$table}{$id}{$field} ;
|
|||
|
|
|
|||
|
|
&common_debug("$doc") ;
|
|||
|
|
|
|||
|
|
if ($doc){
|
|||
|
|
my $tooltip = qq~data-toggle="tooltip" data-placement="top" data-title="$doc"~ ;
|
|||
|
|
my @docarr = split(/\./,$doc); my $ext = pop @docarr ; my $file = pop @docarr ;
|
|||
|
|
my $dlg_title = uc substr($doc,0,6) . 'ED ' . $ext ; ## UPLOADED ...
|
|||
|
|
$file_cnt++ ;
|
|||
|
|
|
|||
|
|
my $delete_attach_id = ($custom_delete_attach_id) ? $custom_delete_attach_id : "delete-attach-$id-$file_cnt" ;
|
|||
|
|
|
|||
|
|
my $test_icon_loc = qq~$htmlpath/img/icons/doc/$ext.png~;
|
|||
|
|
my $icon_loc = qq~/img/icons/doc/$ext.png~; $icon_loc = qq~/img/icons/doc/def.png~ unless -f $test_icon_loc ;
|
|||
|
|
|
|||
|
|
# $uploads{$type} .= qq~<a id="attach-$tag_id-$file_cnt" style='margin-left:10px;' $tooltip href="javascript:dlgMdl('/uploads/$doctype/$db{$table}{$id}{$folder}/$doc','$dlg_title','','max-dialog');"><img src='/img/icons/doc/$ext.png' style='width:40px;height:40px;'></a><a href="javascript:void(0);" id="delete-attach-$id-$file_cnt"><i class="glyphicon glyphicon-trash"></i></a>~ ;
|
|||
|
|
$uploads{$type} .= qq~<a id="attach-$id-$file_cnt" style='margin-left:10px;' $tooltip href="javascript:dlgMdl('/uploads/$doctype/$db{$table}{$id}{$folder}/$doc','$dlg_title','','max-dialog');"><img src='$icon_loc' style='width:30px;height:30px;'></a><a href="javascript:void(0);" id="$delete_attach_id"><i class="glyphicon glyphicon-trash"></i></a>~ ;
|
|||
|
|
|
|||
|
|
$trigger_jquery_raw .= qq(\$('#delete-attach-$id-$file_cnt').click(function (e) {
|
|||
|
|
BootstrapDialog.confirm({
|
|||
|
|
title: 'Confirm Delete',
|
|||
|
|
message: 'Are you sure you want to delete <strong>$doc</strong>?',
|
|||
|
|
type: BootstrapDialog.TYPE_DANGER, // <-- Default value is BootstrapDialog.TYPE_PRIMARY <-- Default value is BootstrapDialog.TYPE_WARNING
|
|||
|
|
callback: function(result) {
|
|||
|
|
if (result) {
|
|||
|
|
var url = "$useropts{scripts}/get/get_delete_attach.pl?$doctype/$db{$table}{$id}{$folder}&$doc&$table&$id&$field" ;
|
|||
|
|
\$.get(url);
|
|||
|
|
\$('#attach-$id-$file_cnt').hide() ;
|
|||
|
|
\$('#delete-attach-$id-$file_cnt').hide() ;
|
|||
|
|
} else {
|
|||
|
|
// alert('Nope.');
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
});
|
|||
|
|
});) unless $custom_delete_attach_id ;
|
|||
|
|
|
|||
|
|
# $uploads .= qq~<a id="attach-$tag_id-$file_cnt" style='margin-left:10px;' href="javascript:dlgMdl('/uploads/$doctype\s/$db{$table}{$id}{$folder}/$db{$table}{$id}{$field}','$dlg_title','','max-dialog');"><img src='/img/icons/doc/$ext.png' style='width:40px;height:40px;'></a><a href="javascript:void(0);" id="delete-attach-$tag_id-$file_cnt"><i class="glyphicon glyphicon-trash"></i></a>~;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if ($uploads{$type}) { $uploads = $uploads{$type} ; }
|
|||
|
|
|
|||
|
|
return ($uploads) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_get_uploads {
|
|||
|
|
|
|||
|
|
my ($id,$type) = @_ ;
|
|||
|
|
|
|||
|
|
unless ($id and $type) { return() ; }
|
|||
|
|
|
|||
|
|
my $upload_dir = "$htmlpath/uploads/$id";
|
|||
|
|
|
|||
|
|
&common_debug("$upload_dir") ;
|
|||
|
|
|
|||
|
|
unless (-e $upload_dir) { return ; }
|
|||
|
|
|
|||
|
|
my $uploads = '' ;
|
|||
|
|
|
|||
|
|
opendir(DIR, "$upload_dir") or die "cant open directory $upload_dir: $!\n";
|
|||
|
|
|
|||
|
|
while(defined($folder = readdir(DIR))) {
|
|||
|
|
if ($type ne 'all') { unless ((substr($folder,0,4) eq $type) or (substr($folder,0,5) eq $type)) { next ; } }
|
|||
|
|
if (length($folder) > 2) {
|
|||
|
|
my @docarr = split(/\./,$folder); my $ext = pop @docarr ; my $file = pop @docarr ;
|
|||
|
|
my $dlg_title = uc substr($folder,0,4) . ' ' . $ext ; if (substr($folder,0,5) eq $type) { $dlg_title = uc substr($folder,0,5) . ' ' . $ext ; } # leave
|
|||
|
|
$file_cnt++;
|
|||
|
|
|
|||
|
|
my $tag_id = $id ; $tag_id =~ s/\//\-/gi ;
|
|||
|
|
|
|||
|
|
if ($type eq 'all'){
|
|||
|
|
$uploads .= qq(<a title='$dlg_title' data-toggle='tooltip' href=javascript:dlgMdl('/uploads/$id/$folder','$folder','','max-dialog');><img src='/img/icons/doc/$ext.png' style='width:20px;height:20px;'></a> ) ;
|
|||
|
|
}
|
|||
|
|
elsif ($type eq 'canx'){
|
|||
|
|
$uploads .= qq(<a id="attach-$tag_id-$file_cnt" style='margin-left:10px;' href="javascript:parent.dlgMdl('/uploads/$id/$folder','$dlg_title','','max-dialog');"><img src='/img/icons/doc/$ext.png' style='width:40px;height:40px;'></a><a href="javascript:void(0);" id="delete-attach-$tag_id-$file_cnt"><i class="glyphicon glyphicon-trash"></i></a>);
|
|||
|
|
}
|
|||
|
|
else
|
|||
|
|
{
|
|||
|
|
$uploads .= qq(<a id="attach-$tag_id-$file_cnt" style='margin-left:10px;' href="javascript:dlgMdl('/uploads/$id/$folder','$dlg_title','','max-dialog');"><img src='/img/icons/doc/$ext.png' style='width:40px;height:40px;'></a><a href="javascript:void(0);" id="delete-attach-$tag_id-$file_cnt"><i class="glyphicon glyphicon-trash"></i></a>);
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
$trigger_jquery_raw .= qq(\$('#delete-attach-$tag_id-$file_cnt').click(function (e) {
|
|||
|
|
BootstrapDialog.confirm({
|
|||
|
|
title: 'Confirm Delete',
|
|||
|
|
message: 'Are you sure you want to delete <strong>$folder</strong>?',
|
|||
|
|
type: BootstrapDialog.TYPE_DANGER, // <-- Default value is BootstrapDialog.TYPE_PRIMARY <-- Default value is BootstrapDialog.TYPE_WARNING
|
|||
|
|
callback: function(result) {
|
|||
|
|
if(result) {
|
|||
|
|
var url = "$useropts{scripts}/get/get_delete_attach.pl?$id&$folder" ;
|
|||
|
|
\$.get(url);
|
|||
|
|
\$('#attach-$tag_id-$file_cnt').hide() ;
|
|||
|
|
\$('#delete-attach-$tag_id-$file_cnt').hide() ;
|
|||
|
|
}else {
|
|||
|
|
// alert('Nope.');
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
});
|
|||
|
|
});) ;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($uploads) ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
# sub common_load_params {
|
|||
|
|
|
|||
|
|
# for my $p ($q->param) {
|
|||
|
|
# my $val = $q->param($p) ;
|
|||
|
|
# $val =~ s/\"//g ;
|
|||
|
|
# $i{$p} = $val ;
|
|||
|
|
# # &common_debug("$p -> $p1 -> $p1cnt -> $val") ;
|
|||
|
|
# if ($p =~ /\_/g){
|
|||
|
|
# my ($p1,$p1cnt) = split(/\_/,$p) ;
|
|||
|
|
# $i{$p1}{$p1cnt} = $val ;
|
|||
|
|
# # print "<br>$p -> $p1 -> $p1cnt -> $val" ;
|
|||
|
|
# }
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# } #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_time_diff_seconds {
|
|||
|
|
|
|||
|
|
my ($date1,$date2) = @_ ;
|
|||
|
|
|
|||
|
|
my $difference = Time::Piece->strptime("$date2", '%Y-%m-%d %H:%M:%S') - Time::Piece->strptime("$date1", '%Y-%m-%d %H:%M:%S') ;
|
|||
|
|
|
|||
|
|
my $seconds = $difference->seconds ;
|
|||
|
|
|
|||
|
|
return $seconds ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_time_opts {
|
|||
|
|
|
|||
|
|
for (1 .. 24) {
|
|||
|
|
my $hh = sprintf("%02s",$_) ;
|
|||
|
|
$hour_opts .= qq(<option value="$hh">$hh</option>) ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
for (1 .. 60) {
|
|||
|
|
my $mm = sprintf("%02s",$_) ;
|
|||
|
|
$min_opts .= qq(<option value="$mm">$mm</option>) ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_curr_opts {
|
|||
|
|
|
|||
|
|
$curr_opts = qq(<option value="ZAR">ZAR</option><option value="USD">USD</option><option value="GBP">GBP</option><option value="EUR">EUR</option>) ;
|
|||
|
|
$curr_opts_2 = qq(<option SELECTED value="ZAR">ZAR</option><option value="USD">USD</option><option value="GBP">GBP</option><option value="EUR">EUR</option><option value="CAD">CAD</option><option value="AUD">AUD</option><option value="NZD">NZD</option>) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
# sub common_select_opts {
|
|||
|
|
|
|||
|
|
# my ($field,$table,$dispfield,$fid,$required,$addfield,$where,$valfield,$addmore) = @_ ;
|
|||
|
|
|
|||
|
|
# $select{$field} = 1 ;
|
|||
|
|
|
|||
|
|
# my $val = '' ;
|
|||
|
|
|
|||
|
|
# if ($required) { $required{$field} = 1 ; }
|
|||
|
|
|
|||
|
|
# &db_min_ro($table,'*',$where,'','') ;
|
|||
|
|
|
|||
|
|
# foreach my $id (keys %{$db{$table}}) {
|
|||
|
|
# # &common_debug("$table : $fid == $id") ;
|
|||
|
|
|
|||
|
|
# if ($fid == $id) { $selected = 'SELECTED'; } else { $selected = ''; }
|
|||
|
|
# if (($db{$table}{$id}{$addfield}) and ($db{$table}{$id}{$dispfield} ne $db{$table}{$id}{$addfield})) { $disp_addfield = " ($db{$table}{$id}{$addfield})" ; } else { $disp_addfield = '' ; }
|
|||
|
|
|
|||
|
|
# my $disp_addmore = '' ;
|
|||
|
|
|
|||
|
|
# if ($display_addmore{$table}{$addmore}) {
|
|||
|
|
# my $glyph = '' ;
|
|||
|
|
# if ($db{$table}{$id}{$addmore} == 1) {
|
|||
|
|
# # $glyph = qq(<i class="glyphicons glyphicons-tick"></i>);
|
|||
|
|
# $disp_addmore = " - $addmore" ;
|
|||
|
|
# }
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# if ($valfield) { $val = $db{$table}{$id}{$valfield} ; } else { $val = $id ; }
|
|||
|
|
# $opts{$field} .= qq(<option value="$val" $selected $selected_multi{$val}>$db{$table}{$id}{$dispfield}$disp_addfield$disp_addmore</option>) ;
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# } #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_curr_symbols {
|
|||
|
|
|
|||
|
|
$common{'symbol'}{'GBP'} = '£' ;
|
|||
|
|
$common{'symbol'}{'ZAR'} = 'R' ;
|
|||
|
|
$common{'symbol'}{'USD'} = '$' ;
|
|||
|
|
$common{'symbol'}{'EUR'} = '€' ;
|
|||
|
|
|
|||
|
|
$common{'pdfsymbol'}{'GBP'} = qq(£) ;
|
|||
|
|
$common{'pdfsymbol'}{'ZAR'} = 'R' ;
|
|||
|
|
$common{'pdfsymbol'}{'USD'} = '$' ;
|
|||
|
|
$common{'pdfsymbol'}{'EUR'} = '€' ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_exchange_rates {
|
|||
|
|
|
|||
|
|
my $exchgfile = "/usr/lib/cgi-bin/scripts/cron/feed.dat";
|
|||
|
|
|
|||
|
|
open (IFILE, "$exchgfile") or print "Unable to open $exchgfile: $!" ;
|
|||
|
|
flock (IFILE, LOCK_SH) or print "Can't lock $exchgfile: $!";
|
|||
|
|
@exchng = <IFILE> ;
|
|||
|
|
close (IFILE);
|
|||
|
|
|
|||
|
|
@exchng = sort @exchng ;
|
|||
|
|
|
|||
|
|
foreach $line (@exchng) {
|
|||
|
|
chomp $line;
|
|||
|
|
@linex = split(/\|/,$line);
|
|||
|
|
|
|||
|
|
my $from = $linex[0] ;
|
|||
|
|
my $to = $linex[1] ;
|
|||
|
|
my $rate = $linex[2] ;
|
|||
|
|
my $prate = $linex[3] ;
|
|||
|
|
my $ccapirate = $linex[4] ;
|
|||
|
|
|
|||
|
|
my $glyphicon = 'minus' ; if ($prate > $rate){ $glyphicon = 'arrow-down' ; } elsif ($rate > $prate) { $glyphicon = 'arrow-up' ; }
|
|||
|
|
|
|||
|
|
$x++ ;
|
|||
|
|
|
|||
|
|
# my $cushion = 10 ; # % cushion on exchange rate
|
|||
|
|
# my $sell_rate = sprintf("%.2f", ( $rate / ((100+$cushion) / 100) )) ;
|
|||
|
|
|
|||
|
|
my $buy_rate = $ccapirate ;
|
|||
|
|
my $sell_rate = sprintf("%.2f", ( $ccapirate / 0.975) ) ; # add 2.5%
|
|||
|
|
|
|||
|
|
$roe{$to} = $sell_rate ;
|
|||
|
|
$roe_buy{$to} = $buy_rate ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_customer_hidden_db_fields {
|
|||
|
|
|
|||
|
|
&common_customer_sort_fields;
|
|||
|
|
|
|||
|
|
$ignore{iaction} = 1 ;
|
|||
|
|
$ignore{logo} = 1 ;
|
|||
|
|
$ignore{customer_nr} = 1 ;
|
|||
|
|
|
|||
|
|
$required{name} = 1 ; # alphanumeric
|
|||
|
|
# $required{contact_email} = 6 ; # email
|
|||
|
|
# $required{phone} = 1 ;
|
|||
|
|
# $required{customer_nr} = 1 ;
|
|||
|
|
|
|||
|
|
$checkbox{active} = 1 ;
|
|||
|
|
$checkbox{events} = 1 ;
|
|||
|
|
$checkbox{analytics} = 1 ;
|
|||
|
|
|
|||
|
|
$hidden{last_updated} = 2 ;
|
|||
|
|
|
|||
|
|
$hidden{last_edited_by} = 2 ;
|
|||
|
|
$hidden{date_time} = 2 ;
|
|||
|
|
$hidden{user_id} = 2 ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_customer_sort_fields {
|
|||
|
|
|
|||
|
|
%sort_field = () ;
|
|||
|
|
|
|||
|
|
$sort_field{1} = 'active' ;
|
|||
|
|
$sort_field{2} = 'events' ;
|
|||
|
|
$sort_field{3} = 'analytics' ;
|
|||
|
|
$sort_field{4} = 'name' ; # $preferred_title{name} = 'Customer Name' ;
|
|||
|
|
$sort_field{5} = 'customer_nr' ;
|
|||
|
|
$sort_field{6} = 'phone' ; $preferred_title{phone} = 'Tel' ;
|
|||
|
|
$sort_field{7} = 'company_email' ;
|
|||
|
|
$sort_field{8} = 'contact_name' ;
|
|||
|
|
$sort_field{9} = 'contact_email' ;
|
|||
|
|
$sort_field{10} = 'physical_address' ;
|
|||
|
|
$sort_field{11} = 'postal_address' ;
|
|||
|
|
$sort_field{12} = 'city' ;
|
|||
|
|
$sort_field{13} = 'province' ;
|
|||
|
|
$sort_field{14} = 'country' ;
|
|||
|
|
$sort_field{15} = 'vat_nr' ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_load_quote_vars {
|
|||
|
|
|
|||
|
|
my ($sql_where) = @_ ;
|
|||
|
|
my $t1 = 'cameras' ;
|
|||
|
|
my $t2 = 'quotes' ;
|
|||
|
|
my $tables = "$t1,$t2" ;
|
|||
|
|
|
|||
|
|
# my $sql_match_credits = '' ;
|
|||
|
|
# if ($cnt_match_credits) { # match_credits_report.pl
|
|||
|
|
# for (1 .. $cnt_match_credits) {
|
|||
|
|
# $sql_match_credits .= qq~,$t2.item_$_\_costing_match_credits~ ;
|
|||
|
|
# }
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
my $sel_fields = qq~$t1.id AS 'cam_id',$t1.camera_nr,$t1.serial_nr,$t1.quote_linked_vpu,$t1.quote_delivery_date,$t1.quote_active_date,$t1.quote_cam_num,$t2.quote_nr AS 'q_nr',$t2.id AS 'quote_id',$t2.ref,$t2.camera_system_id,$t2.type,$t2.quote_to,$t2.quote_accepted,$t2.quote_cancelled,$t2.invoice_date,$t2.qty,$t2.total_1_purchase_summary,$t2.total_2_purchase_summary,$t2.total_3_purchase_summary$sql_match_credits~ ;
|
|||
|
|
&db_min_ro($tables,"$sel_fields",$sql_where,'','') ;
|
|||
|
|
|
|||
|
|
foreach my $id (keys %{$db{$tables}}) {
|
|||
|
|
|
|||
|
|
my $quote_id = $db{$tables}{$id}{quote_id} ;
|
|||
|
|
my $q_nr = $db{$tables}{$id}{q_nr} ;
|
|||
|
|
my $cam_id = $db{$tables}{$id}{cam_id} ;
|
|||
|
|
my $camera_nr = $db{$tables}{$id}{camera_nr} ;
|
|||
|
|
my $serial_nr = $db{$tables}{$id}{serial_nr} ;
|
|||
|
|
my $quote_linked_vpu = $db{$tables}{$id}{quote_linked_vpu} ;
|
|||
|
|
my $quote_cam_num = $db{$tables}{$id}{quote_cam_num} ;
|
|||
|
|
my $quote_delivery_date = $db{$tables}{$id}{quote_delivery_date} ;
|
|||
|
|
my $quote_active_date = $db{$tables}{$id}{quote_active_date} ;
|
|||
|
|
|
|||
|
|
$quote_id{$q_nr} = $quote_id ;
|
|||
|
|
|
|||
|
|
$cnt_cams{$q_nr}++ ;
|
|||
|
|
|
|||
|
|
$quote_cam_active_date{$q_nr}{$quote_cam_num} = $quote_active_date ;
|
|||
|
|
$quote_cam_delivery_date{$q_nr}{$quote_cam_num} = $quote_delivery_date ;
|
|||
|
|
|
|||
|
|
if (substr($camera_nr,0,3) eq 'VPU' and $quote_linked_vpu) {
|
|||
|
|
$linked_sn{$quote_linked_vpu} = $serial_nr ;
|
|||
|
|
$linked_cn{$quote_linked_vpu} = $camera_nr ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
$quote_customer{$cam_id} = $customer{$db{$tables}{$id}{quote_to}} ;
|
|||
|
|
$quote_ref{$cam_id} = $db{$tables}{$id}{ref} ;
|
|||
|
|
$quote_type{$cam_id} = ucfirst $db{$tables}{$id}{type} ;
|
|||
|
|
# $quote_date_from{$cam_id} = $db{$tables}{$id}{date_from} ;
|
|||
|
|
# $quote_date_to{$cam_id} = $db{$tables}{$id}{date_to} ;
|
|||
|
|
$quote_accepted{$cam_id} = $db{$tables}{$id}{quote_accepted} ;
|
|||
|
|
$quote_cancelled{$cam_id} = $db{$tables}{$id}{quote_cancelled} ;
|
|||
|
|
$invoice_date{$cam_id} = $db{$tables}{$id}{invoice_date} ;
|
|||
|
|
$quote_qty{$cam_id} = $db{$tables}{$id}{qty} ;
|
|||
|
|
$quote_camera_system_id{$cam_id} = $db{$tables}{$id}{camera_system_id} ;
|
|||
|
|
$quote_amount{$cam_id} = &common_commify(sprintf("%0.2f",($db{$tables}{$id}{total_1_purchase_summary} + $db{$tables}{$id}{total_2_purchase_summary} + $db{$tables}{$id}{total_3_purchase_summary}))) ;
|
|||
|
|
$quote_camera_serial_nr{$cam_id} = $serial_nr ;
|
|||
|
|
$quote_camera_camera_nr{$cam_id} = $camera_nr ;
|
|||
|
|
$quote_nr{$cam_id} = $q_nr ;
|
|||
|
|
|
|||
|
|
# if ($cnt_match_credits) {
|
|||
|
|
# for (1 .. $cnt_match_credits) {
|
|||
|
|
# $quote_match_credits{$_}{$cam_id} = $db{$tables}{$id}{"item_$_\_costing_match_credits"} ;
|
|||
|
|
# }
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_status_txt {
|
|||
|
|
|
|||
|
|
my ($completed,$accepted,$pending,$cancelled,$rejected) = @_ ;
|
|||
|
|
|
|||
|
|
my $txt = ($completed) ? 'Completed' : ($accepted) ? 'Accepted' : ($pending) ? 'Pending' : ($cancelled) ? 'Cancelled' : ($rejected) ? 'Rejected' : 'Changed' ;
|
|||
|
|
|
|||
|
|
return ($txt) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
# sub common_load_quote_vars {
|
|||
|
|
|
|||
|
|
# my ($sql_camera_nr_where) = @_ ;
|
|||
|
|
|
|||
|
|
# my $suffix = '_camera_details' ;
|
|||
|
|
|
|||
|
|
# # my $add_quote_fields = '' ; my $sql_or_where = '' ; my @sqlorwhere = () ;
|
|||
|
|
# # for (1 .. 10) {
|
|||
|
|
# # $add_quote_fields .= ",camera_nr_$_$suffix,delivery_date_$_$suffix,active_date_$_$suffix,ew_date_from_$_$suffix,ew_date_to_$_$suffix,ref_$_$suffix" ;
|
|||
|
|
# # push @sqlorwhere, "camera_nr_$_$suffix $sql_camera_nr_where" ;
|
|||
|
|
# # }
|
|||
|
|
# # $sql_or_where = join(" OR ",@sqlorwhere) ;
|
|||
|
|
|
|||
|
|
# my $sel_fields = qq~id,quote_nr,ref,camera_system_id,date_from,date_to,type,quote_to$add_quote_fields~ ;
|
|||
|
|
# &db_min_ro('quotes',"$sel_fields",$sql_or_where,'','') ;
|
|||
|
|
# foreach my $id (keys %{$db{quotes}}) {
|
|||
|
|
|
|||
|
|
# my $quote_id = $id ;
|
|||
|
|
# my $quote_nr = $db{quotes}{$id}{quote_nr} ;
|
|||
|
|
|
|||
|
|
# $quote_customer{$quote_nr} = $customer{$db{quotes}{$id}{quote_to}} ;
|
|||
|
|
# $quote_ref{$quote_nr} = $db{quotes}{$id}{ref} ;
|
|||
|
|
# $quote_type{$quote_nr} = ucfirst $db{quotes}{$id}{type} ;
|
|||
|
|
# $quote_date_from{$quote_nr} = $db{quotes}{$id}{date_from} ;
|
|||
|
|
# $quote_date_to{$quote_nr} = $db{quotes}{$id}{date_to} ;
|
|||
|
|
|
|||
|
|
# # for (1 .. 10) {
|
|||
|
|
# # my $field = $db{quotes}{$id}{"camera_nr_$_$suffix"} ;
|
|||
|
|
# # my $delivery_date = $db{quotes}{$id}{"delivery_date_$_$suffix"} ;
|
|||
|
|
# # my $active_date = $db{quotes}{$id}{"active_date_$_$suffix"} ;
|
|||
|
|
# # my $ew_date_from = $db{quotes}{$id}{"ew_date_from_$_$suffix"} ;
|
|||
|
|
# # my $ew_date_to = $db{quotes}{$id}{"ew_date_to_$_$suffix"} ;
|
|||
|
|
# # my $ref = $db{quotes}{$id}{"ref_$_$suffix"} ;
|
|||
|
|
|
|||
|
|
# # if ($field) {
|
|||
|
|
# # $camera_exists_on_quote{$field} = $id ;
|
|||
|
|
# # $quote_nr{$field} = $db{quotes}{$id}{quote_nr} ;
|
|||
|
|
# # $camera_on_quote_cnt{$quote_nr{$field}}{$_} = $field ;
|
|||
|
|
# # $quote_ref{$field} = $db{quotes}{$id}{ref} ;
|
|||
|
|
# # $quote_type{$field} = ucfirst $db{quotes}{$id}{type} ;
|
|||
|
|
# # $quote_date_from{$field} = $db{quotes}{$id}{date_from} ;
|
|||
|
|
# # $quote_date_to{$field} = $db{quotes}{$id}{date_to} ;
|
|||
|
|
# # $quote_customer{$field} = $customer{$db{quotes}{$id}{quote_to}} ;
|
|||
|
|
# # $quote_cam_ref{$field} = $ref ;
|
|||
|
|
# # $quote_delivery_date{$field} = $delivery_date ;
|
|||
|
|
# # $quote_active_date{$field} = $active_date ;
|
|||
|
|
# # $quote_ew_date_from{$field} = $ew_date_from ;
|
|||
|
|
# # $quote_ew_date_to{$field} = $ew_date_to ;
|
|||
|
|
# # }
|
|||
|
|
# }
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# } #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_check_for_linked_vpu {
|
|||
|
|
|
|||
|
|
my ($camera_nr,$quote_nr,$id,$req) = @_ ;
|
|||
|
|
|
|||
|
|
# unless (substr($camera_nr,0,2) eq 'S1' or substr($camera_nr,0,5) eq 'Prime' or substr($camera_nr,0,5) eq 'Coach') { return('','') ;
|
|||
|
|
|
|||
|
|
# &db_min_ro('cameras',"$sel_fields",$sql_or_where,'','') ;
|
|||
|
|
# foreach my $id (keys %{$db{quotes}}) {
|
|||
|
|
|
|||
|
|
# my $quote_id = $id ;
|
|||
|
|
# my $quote_nr = $db{quotes}{$id}{quote_nr} ;
|
|||
|
|
# }
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
$req = 'SN' unless $req ;
|
|||
|
|
|
|||
|
|
my $val = '' ;
|
|||
|
|
|
|||
|
|
# if (substr($camera_nr,0,2) eq 'S1' or substr($camera_nr,0,5) eq 'Prime' or substr($camera_nr,0,5) eq 'Coach') {
|
|||
|
|
if (substr($camera_nr,0,2) eq 'S1' or substr($camera_nr,0,2) eq 'S2' or substr($camera_nr,0,5) eq 'Prime' or substr($camera_nr,0,5) eq 'Coach') {
|
|||
|
|
# &common_debug("vpu_serial_nr : $camera_nr") ;
|
|||
|
|
# foreach $camcnt (sort {$camera_on_quote_cnt{$quote_nr}{$a} cmp $camera_on_quote_cnt{$quote_nr}{$b}} keys %{$camera_on_quote_cnt{$quote_nr}}) {
|
|||
|
|
foreach $camcnt (sort {$a <=> $b} keys %{$camera_on_quote_cnt{$quote_nr}}) {
|
|||
|
|
my $camid = $camera_on_quote_cnt{$quote_nr}{$camcnt} ;
|
|||
|
|
my $camnrabrv = substr($cam_nr{$camid},0,3) ;
|
|||
|
|
# &common_debug("vpu_serial_nr [3] camnrabrv=$camnrabrv, getnext=$getnext") ;
|
|||
|
|
if ($getnext and $camnrabrv eq 'VPU') { $val = $req eq 'CN' ? $cam_nr{$camid} : $serial_nr{$camid} ; }
|
|||
|
|
$getnext=0; if ($camid eq $id) { $getnext=1; }
|
|||
|
|
# &common_debug("vpu_serial_nr [$camcnt], camid=$camid, id=$id, camnrabrv=$camnrabrv, getnext=$getnext") ;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($val) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_camera_system_filter {
|
|||
|
|
|
|||
|
|
my ($table,$id) = @_ ;
|
|||
|
|
|
|||
|
|
my $next = 0 ;
|
|||
|
|
|
|||
|
|
if ($i{stock} eq 'stock') { if ($db{$table}{$id}{quote_nr} or $db{$table}{$id}{demo_recipient} or $db{$table}{$id}{replacement_date}) { $next = 1 ; } }
|
|||
|
|
|
|||
|
|
if ($i{stock} eq 'purchased') { unless ($db{$table}{$id}{quote_nr}) { $next = 1 ; } }
|
|||
|
|
if ($i{stock} eq 'purchase') { unless (lc $quote_type{$id} eq 'purchase' and $db{$table}{$id}{quote_nr}) { $next = 1 ; } }
|
|||
|
|
if ($i{stock} eq 'demo') { unless ($db{$table}{$id}{demo_recipient} ) { $next = 1 ; } }
|
|||
|
|
if ($i{stock} eq 'rental') { unless ($db{$table}{$id}{camera_system_id}<7 and lc $quote_type{$id} eq 'rental') { $next = 1 ; } }
|
|||
|
|
if ($i{stock} eq 'event') { unless ($db{$table}{$id}{event_system_id} > 0) { $next = 1 ; } }
|
|||
|
|
|
|||
|
|
if ($i{camera_system_id} eq 'main') { unless ($db{$table}{$id}{camera_system_id}<7) { $next = 1 ; } }
|
|||
|
|
if ($i{camera_system_id} eq 'other') { unless ($db{$table}{$id}{camera_system_id}>7) { $next = 1 ; } }
|
|||
|
|
|
|||
|
|
if ($db{$table}{$id}{event_system_id} > 0) { unless ($i{stock} eq 'event' or $i{stock} eq '') { $next = 1 ; } }
|
|||
|
|
|
|||
|
|
# &common_debug("common_camera_system_filter : next [$next], stock=$i{stock}, event_system_id=$db{$table}{$id}{event_system_id}, quote_type=$quote_type{$id}, camera_system_id=$db{$table}{$id}{camera_system_id}, quote_nr=$db{$table}{$id}{quote_nr}, demo_recipient=$db{$table}{$id}{demo_recipient}") ;
|
|||
|
|
|
|||
|
|
return ($next) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_camera_opts {
|
|||
|
|
|
|||
|
|
$opts{camera_system_id} = qq~<option SELECTED value="all">All</option><option value="main">Main</option><option value="other">Other</option>~ ;
|
|||
|
|
$opts{stock} = qq~<option value=""></option>
|
|||
|
|
<option value="purchase">Purchased</option>
|
|||
|
|
<option value="stock">In Stock</option>
|
|||
|
|
<option value="rental">Rental</option>
|
|||
|
|
<option value="demo">Demo</option>
|
|||
|
|
<option value="event">Event</option>~ ;
|
|||
|
|
|
|||
|
|
# <option value="active">Active</option>
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_camera_links {
|
|||
|
|
|
|||
|
|
my ($table,$id,$val) = @_ ;
|
|||
|
|
|
|||
|
|
if ($_ eq 'camera_nr') {
|
|||
|
|
my $class = 'info' ; $class = 'warning' if $db{$table}{$id}{quote_nr} ;
|
|||
|
|
my $style = '' ; $style = "background-color:purple;border:purple;" if $db{$table}{$id}{demo_recipient} ; $style = "background-color:#ff00fb;border:#ff00fb;" if $db{$table}{$id}{event_system_id} ;
|
|||
|
|
# &common_debug("event_system_id=$db{$table}{$id}{event_system_id}, camera_system_id=$db{$table}{$id}{camera_system_id}, camera_nr=$db{$table}{$id}{camera_nr} [style=$style]") ;
|
|||
|
|
# my $tooltip = qq~data-toggle="tooltip" data-placement="top" data-title=""~ ;
|
|||
|
|
$val = qq~<a class="btn btn-$class btn-xs" href="javascript:editMinItem('$id','cameras');" style="padding: 0px 3px 0px 3px;font-size:12px;$style" $tooltip>$val</a>~ ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if ($_ eq 'quote_nr' or $_ eq 'ref_nr' or $_ eq 'ref') {
|
|||
|
|
my $class = 'info' ; $class = 'warning' if $val ;
|
|||
|
|
my $style = '' ; $style = "style='background-color:purple;'" if $db{$table}{$id}{demo_recipient} ; $class = 'success' if $db{$table}{$id}{quote_accepted} or $quote_accepted{$id} ; $class = 'danger' if $db{$table}{$id}{quote_cancelled} or $quote_cancelled{$id} ;
|
|||
|
|
my $quote_id = $quote_id{$val} ? $quote_id{$val} : $id ;
|
|||
|
|
my $js_func = ($table eq 'event_quotes') ? 'editEventQuote' : 'editQuote' ;
|
|||
|
|
$val = $val ? qq~<a class="btn btn-$class btn-xs" href="javascript:$js_func('$quote_id');" style="padding: 0px 3px 0px 3px;font-size:12px">$val</a>~ : '' ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($val) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_write_date_interval {
|
|||
|
|
|
|||
|
|
my ($date_from,$date_to) = @_ ;
|
|||
|
|
|
|||
|
|
my @months = ("","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec") ;
|
|||
|
|
|
|||
|
|
$date_from = substr($date_from,0,10) ;
|
|||
|
|
|
|||
|
|
$date_to = substr($date_to,0,10) ;
|
|||
|
|
|
|||
|
|
my ($start_year,$start_mon,$start_day) = split("-",$date_from) ;
|
|||
|
|
|
|||
|
|
my ($end_year,$end_mon,$end_day) = split("-",$date_to) ;
|
|||
|
|
|
|||
|
|
$start_mon = int($start_mon) ; $end_mon = int($end_mon) ;
|
|||
|
|
|
|||
|
|
my $date = "" ;
|
|||
|
|
|
|||
|
|
if ($start_year ne $end_year) {
|
|||
|
|
$date = "$start_day $months[$start_mon] $start_year - $end_day $months[$end_mon] $end_year" ;
|
|||
|
|
} elsif ($start_mon ne $end_mon) {
|
|||
|
|
$date = "$start_day $months[$start_mon]- $end_day $months[$end_mon] $end_year" ;
|
|||
|
|
} elsif ($start_day ne $end_day) {
|
|||
|
|
$date = "$start_day - $end_day $months[$end_mon] $end_year" ;
|
|||
|
|
} elsif ($start_day eq $end_day) {
|
|||
|
|
$date = "$end_day $months[$end_mon] $end_year" ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($date) ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_check_if_string_contains_an_integer {
|
|||
|
|
|
|||
|
|
my $string = shift;
|
|||
|
|
return $string =~ /\d/ ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_check_if_time_is_greater {
|
|||
|
|
|
|||
|
|
local ($time1,$time2) = @_ ;
|
|||
|
|
|
|||
|
|
local $epoch1 = Time::Piece->strptime($time1, '%Y-%m-%d %H:%M:%S');
|
|||
|
|
local $epoch2 = Time::Piece->strptime($time2, '%Y-%m-%d %H:%M:%S');
|
|||
|
|
|
|||
|
|
local $moving_forward = 0 ;
|
|||
|
|
|
|||
|
|
if ($epoch1 <= $epoch2) {
|
|||
|
|
$moving_forward = 1 ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($moving_forward) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_add_delta_days {
|
|||
|
|
|
|||
|
|
my ($days) = @_ ;
|
|||
|
|
|
|||
|
|
my ($year,$month,$day) = Add_Delta_Days($now_year,$now_mm,$now_dd,$days); #
|
|||
|
|
|
|||
|
|
$month = sprintf("%02s", $month) ;
|
|||
|
|
$day = sprintf("%02s", $day) ;
|
|||
|
|
|
|||
|
|
return("$year-$month-$day");
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_add_delta_ymd {
|
|||
|
|
|
|||
|
|
my ($nyear,$nmonth,$nday) = @_ ;
|
|||
|
|
|
|||
|
|
my ($syear,$smonth,$sday) = Add_Delta_YMD($now_year,$now_mm,$now_dd, $nyear,$nmonth,$nday);
|
|||
|
|
|
|||
|
|
$smonth = sprintf("%02s", $smonth) ;
|
|||
|
|
$sday = sprintf("%02s", $sday) ;
|
|||
|
|
|
|||
|
|
return ($syear,$smonth,$sday) ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_add_delta_dhms {
|
|||
|
|
|
|||
|
|
my ($year,$mm,$dd,$hour,$min,$sec,$days_diff,$hrs_diff,$min_diff,$sec_diff) = @_ ;
|
|||
|
|
|
|||
|
|
my ($syear,$smonth,$sday,$shour,$smin,$ssec) = Add_Delta_DHMS($year,$mm,$dd,$hour,$min,$sec,$days_diff,$hrs_diff,$min_diff,$sec_diff) ; #
|
|||
|
|
|
|||
|
|
$smonth = sprintf("%02s", $smonth) ;
|
|||
|
|
$sday = sprintf("%02s", $sday) ;
|
|||
|
|
$shour = sprintf("%02s", $shour) ;
|
|||
|
|
$smin = sprintf("%02s", $smin) ;
|
|||
|
|
$ssec = sprintf("%02s", $ssec) ;
|
|||
|
|
|
|||
|
|
return("$syear-$smonth-$sday","$shour:$smin:$ssec","$syear$smonth$sday$shour$smin$ssec");
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_split_sql_time {
|
|||
|
|
|
|||
|
|
my ($datetime) = @_ ; # 2015-10-06 17:35:39
|
|||
|
|
|
|||
|
|
my ($date,$time) = split(/ /,$datetime) ;
|
|||
|
|
|
|||
|
|
my $dy = substr($date,0,4) ;
|
|||
|
|
my $dm = substr($date,5,2) ;
|
|||
|
|
my $dd = substr($date,8,2) ;
|
|||
|
|
|
|||
|
|
my ($th,$tm,$ts) = split(/:/,$time) ;
|
|||
|
|
|
|||
|
|
return ($dy,$dm,$dd,$th,$tm,$ts) ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_get_next_monday_sunday {
|
|||
|
|
|
|||
|
|
my $dow = Day_of_Week($now_year,$now_mm,$now_dd);
|
|||
|
|
|
|||
|
|
my ($next_monday_year, $next_monday_month, $next_monday_day) = Add_Delta_Days($now_year,$now_mm,$now_dd, 8 - $dow);
|
|||
|
|
$next_monday_month = sprintf("%02s", $next_monday_month) ;
|
|||
|
|
$next_monday_day = sprintf("%02s", $next_monday_day) ;
|
|||
|
|
|
|||
|
|
my ($next_sunday_year, $next_sunday_month, $next_sunday_day) = Add_Delta_Days($next_monday_year,$next_monday_month,$next_monday_day,6);
|
|||
|
|
$next_sunday_month = sprintf("%02s", $next_sunday_month) ;
|
|||
|
|
$next_sunday_day = sprintf("%02s", $next_sunday_day) ;
|
|||
|
|
|
|||
|
|
return("$next_monday_year-$next_monday_month-$next_monday_day","$next_sunday_year-$next_sunday_month-$next_sunday_day");
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_get_this_monday_sunday {
|
|||
|
|
|
|||
|
|
my $dow = Day_of_Week($now_year,$now_mm,$now_dd);
|
|||
|
|
|
|||
|
|
my ($this_monday_year, $this_monday_month, $this_monday_day) = Add_Delta_Days($now_year,$now_mm,$now_dd, 1 - $dow);
|
|||
|
|
$this_monday_month = sprintf("%02s", $this_monday_month) ;
|
|||
|
|
$this_monday_day = sprintf("%02s", $this_monday_day) ;
|
|||
|
|
|
|||
|
|
my ($this_sunday_year, $this_sunday_month, $this_sunday_day) = Add_Delta_Days($this_monday_year,$this_monday_month,$this_monday_day,6);
|
|||
|
|
$this_sunday_month = sprintf("%02s", $this_sunday_month) ;
|
|||
|
|
$this_sunday_day = sprintf("%02s", $this_sunday_day) ;
|
|||
|
|
|
|||
|
|
return("$this_monday_year-$this_monday_month-$this_monday_day","$this_sunday_year-$this_sunday_month-$this_sunday_day");
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_page_name {
|
|||
|
|
|
|||
|
|
my @splitlcpage = split(/\-/,$lcpage) ;
|
|||
|
|
my @ucfirstpage = map(ucfirst, map(lc,@splitlcpage));
|
|||
|
|
our $ucfirstpage = join(' ', @ucfirstpage);
|
|||
|
|
our $ucpage = uc $ucfirstpage ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_commify {
|
|||
|
|
|
|||
|
|
local($_) = shift;
|
|||
|
|
1 while s/^(-?\d+)(\d{3})/$1,$2/;
|
|||
|
|
return $_;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_debug {
|
|||
|
|
|
|||
|
|
my ($msg) = @_ ;
|
|||
|
|
|
|||
|
|
unless ((substr($username,0,4) eq 'rory' || $username eq 'handre') && ($testing || $debug)) { return ; }
|
|||
|
|
|
|||
|
|
print $msg . "\n" ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_send_mail {
|
|||
|
|
|
|||
|
|
my ($to,$cc,$bcc,$html,$thead,$msg,$subj,$tmsg) = @_ ;
|
|||
|
|
|
|||
|
|
return if $env eq 'DEV' ;
|
|||
|
|
return unless $msg ;
|
|||
|
|
return unless $subj ;
|
|||
|
|
|
|||
|
|
# my $cc = 'cc1@example.com, cc2@example.com'; # multiple cc's
|
|||
|
|
# $smtp->to(split(/\s*,\s*/, $cc)); # split and add each
|
|||
|
|
|
|||
|
|
use Net::SMTPS;
|
|||
|
|
|
|||
|
|
# # SMTP configuration
|
|||
|
|
# my $smtp_host = $afrihost_smtp ;
|
|||
|
|
# my $smtp_port = $afrihost_port ;
|
|||
|
|
# my $smtp_user = $afrihost_from ;
|
|||
|
|
# my $smtp_pass = $afrihost_psw ;
|
|||
|
|
my $from = $afrihost_from ;
|
|||
|
|
|
|||
|
|
# # Create SMTPS object
|
|||
|
|
# my $smtp = Net::SMTPS->new(
|
|||
|
|
# $smtp_host,
|
|||
|
|
# Port => $smtp_port,
|
|||
|
|
# doSSL => 'ssl', # Ensure SSL from start (port 465)
|
|||
|
|
# Timeout => 30,
|
|||
|
|
# Debug => 1, # Optional: for debug output
|
|||
|
|
# );
|
|||
|
|
|
|||
|
|
# # Authenticate
|
|||
|
|
# $smtp->auth($smtp_user, $smtp_pass) or die "SMTP Auth failed: $!";
|
|||
|
|
|
|||
|
|
my $smtp = Net::SMTPS->new('localhost') or die "Can't connect";
|
|||
|
|
|
|||
|
|
# Send the email
|
|||
|
|
$smtp->mail($from);
|
|||
|
|
$smtp->to($to);
|
|||
|
|
# $smtp->to($cc) if $cc ;
|
|||
|
|
$cc =~ s/\;/\,/g ;
|
|||
|
|
$smtp->to(split(/\s*,\s*/, $cc)) if $cc ; # split and add each
|
|||
|
|
$bcc =~ s/\;/\,/g ;
|
|||
|
|
$smtp->to(split(/\s*,\s*/, $bcc)) if $bcc;
|
|||
|
|
|
|||
|
|
my $body = ($html) ? &common_get_mail_body($msg,$tmsg,$thead) : $msg ;
|
|||
|
|
|
|||
|
|
$smtp->data();
|
|||
|
|
$smtp->datasend("From: $from\n");
|
|||
|
|
$smtp->datasend("To: $to\n");
|
|||
|
|
$smtp->datasend("Cc: $cc\n") if $cc ; # visible
|
|||
|
|
# Do NOT include Bcc in headers
|
|||
|
|
$smtp->datasend("Subject: $subj\n");
|
|||
|
|
$smtp->datasend("MIME-Version: 1.0\n") if $html ;
|
|||
|
|
$smtp->datasend("Content-Type: text/html; charset=UTF-8\n") if $html ;
|
|||
|
|
$smtp->datasend("\n"); # empty line between headers and body
|
|||
|
|
$smtp->datasend("$body\n");
|
|||
|
|
$smtp->dataend();
|
|||
|
|
|
|||
|
|
$smtp->quit;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_send_smtp_mail {
|
|||
|
|
|
|||
|
|
my ($from,$to,$cc,$bcc,$subj,$msg,$table_msg,$html,$thead,$attachpath,$attachname,$attachapplication,$uploaded_doc,$operator_email) = @_ ;
|
|||
|
|
|
|||
|
|
&common_debug("common_send_smtp_mail [$from,$to,$cc,$bcc,$subj,$msg,$table_msg,$html,$thead,$attachpath,$attachname,$attachapplication,$uploaded_doc,$operator_email]") ;
|
|||
|
|
|
|||
|
|
return if $env eq 'DEV' ;
|
|||
|
|
return unless $msg ;
|
|||
|
|
return unless $subj ;
|
|||
|
|
|
|||
|
|
# my $htype = (-f "$attachpath/$attachname" || $uploaded_doc || $operator_email) ? 'htmlattach' : ($html eq 'html') ? $html : 'text' ;
|
|||
|
|
|
|||
|
|
# my $res = &common_mailsend_sendgrid($htype,$to,$subj,$msg,$attachpath,$attachname,"$useropts{short} Events",'events@itvadmin.co.za',$cc,$bcc,$uploaded_doc,$operator_email);
|
|||
|
|
|
|||
|
|
# return if $res eq 'success' ; # carry on if mailsend_sendgrid failed
|
|||
|
|
|
|||
|
|
my $main_email = $email_add{'events'} ;
|
|||
|
|
|
|||
|
|
$to = $main_email unless $to ;
|
|||
|
|
$from = $afrihost_from unless $from ;
|
|||
|
|
|
|||
|
|
my $mail_body = ($html) ? &common_get_mail_body($msg,$table_msg,$thead) : $msg ;
|
|||
|
|
|
|||
|
|
if ($html) {
|
|||
|
|
if ($attachname && -f "$attachpath/$attachname") {
|
|||
|
|
&common_debug("common_send_smtp_mail attach : $attachpath/$attachname [$attachapplication]") ;
|
|||
|
|
&common_email_with_attachments($from,$to,$cc,$bcc,$subj,$msg,$table_msg,$html,$thead,$attachpath,$attachname,$attachapplication) ;
|
|||
|
|
return ;
|
|||
|
|
}
|
|||
|
|
if ($uploaded_doc) {
|
|||
|
|
my @parts = split(/\//,$uploaded_doc) ;
|
|||
|
|
$attachname = $parts[-1] ;
|
|||
|
|
pop @parts ;
|
|||
|
|
$attachpath = join("/",@parts) ;
|
|||
|
|
&common_email_with_attachments($from,$to,$cc,$bcc,$subj,$msg,$table_msg,$html,$thead,$attachpath,$attachname,'') ;
|
|||
|
|
return ;
|
|||
|
|
}
|
|||
|
|
if ($operator_email) {
|
|||
|
|
&common_email_with_attachments($from,$to,$cc,$bcc,$subj,$msg,$table_msg,$html,$thead,"$htmlpath/pdf/operator_flyer/operator_email_attach.pdf",'operator_email_attach.pdf','pdf') ;
|
|||
|
|
return ;
|
|||
|
|
}
|
|||
|
|
&common_send_mail($to,$cc,$bcc,$html,$thead,$msg,$subj,$table_msg) ;
|
|||
|
|
} else {
|
|||
|
|
&common_send_mail($to,$cc,$bcc,$html,$thead,$msg,$subj,$table_msg) ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_get_mail_body {
|
|||
|
|
|
|||
|
|
my ($email_msg,$table_msg,$thead) = @_ ;
|
|||
|
|
|
|||
|
|
my $br = ($email_msg) ? '<br><br>' : '' ;
|
|||
|
|
|
|||
|
|
my $mail_body = <<END_OF_BODY;
|
|||
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
|
|||
|
|
<html>
|
|||
|
|
<head>
|
|||
|
|
<meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
|
|||
|
|
<title></title>
|
|||
|
|
|
|||
|
|
<style type="text/css">
|
|||
|
|
body { background-color:#ffffff; color:#222222; }
|
|||
|
|
tbody tr td { font-size: 11px; }
|
|||
|
|
.table th{background-color:#fff !important}.btn>.caret,.dropup>.btn>.caret{border-top-color:#000 !important}.label{border:1px solid #000}.table{border-collapse:collapse !important}.table-bordered th,.table-bordered td{border:1px solid #ddd !important}
|
|||
|
|
.table-striped>tbody>tr:nth-child(odd)>td,.table-striped>tbody>tr:nth-child(odd)>th{background-color:#EEEEEE; color:#222222; }
|
|||
|
|
.table-striped>tbody>tr:nth-child(even)>td,.table-striped>tbody>tr:nth-child(even)>th{ background-color:#A4A2A2; color:#ffffff; }
|
|||
|
|
.table-striped>tbody>tr:nth-child(odd)>td a:not(.btn) { text-decoration: none; color: #FF6600; font-weight: bold; }
|
|||
|
|
.table-striped>tbody>tr:nth-child(even)>td a:not(.btn) { text-decoration: none; color: #EC1C24; font-weight: bold; }
|
|||
|
|
.table>thead>tr>th, .table>tbody>tr>th, .table>tfoot>tr>th, .table>thead>tr>td, .table>tbody>tr>td, .table>tfoot>tr>td { height: 8px; vertical-align: middle; }
|
|||
|
|
</style>
|
|||
|
|
|
|||
|
|
</head>
|
|||
|
|
<body style="background-color: #FFFFFF; font-family: Arial, Helvetica, sans-serif; font-size: 13px">
|
|||
|
|
|
|||
|
|
<div align="center">
|
|||
|
|
|
|||
|
|
<a href="https://interactivetvafrica.com/"><img alt="$useropts{short}" src="https://$useropts{web}/img/email_logo.jpg" border="0"></a>
|
|||
|
|
<br><br>
|
|||
|
|
$email_msg
|
|||
|
|
$br
|
|||
|
|
<table id="safet-table" class="table table-striped table-bordered bootstrap-datatable datatable responsive">
|
|||
|
|
$thead
|
|||
|
|
<tbody>
|
|||
|
|
$table_msg
|
|||
|
|
</tbody>
|
|||
|
|
</table>
|
|||
|
|
<br>
|
|||
|
|
<p>$display_notif_msg
|
|||
|
|
Best regards,
|
|||
|
|
<br>
|
|||
|
|
<br>
|
|||
|
|
The $useropts{short} Team.
|
|||
|
|
</p>
|
|||
|
|
</div>
|
|||
|
|
</body>
|
|||
|
|
</html>
|
|||
|
|
END_OF_BODY
|
|||
|
|
|
|||
|
|
return ($mail_body) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_email_with_attachments {
|
|||
|
|
|
|||
|
|
my ($from,$to,$cc,$bcc,$subj,$text_msg,$table_msg,$html,$thead,$attachpath,$attachname,$attachapplication) = @_ ;
|
|||
|
|
|
|||
|
|
use MIME::Lite;
|
|||
|
|
use Net::SMTP_auth;
|
|||
|
|
|
|||
|
|
return if $env eq 'DEV' ;
|
|||
|
|
|
|||
|
|
# # SMTP configuration
|
|||
|
|
# my $smtp_host = $afrihost_smtp ;
|
|||
|
|
# my $smtp_port = $afrihost_port ;
|
|||
|
|
# my $smtp_user = $afrihost_from ;
|
|||
|
|
# my $smtp_pass = $afrihost_psw ;
|
|||
|
|
$from = $afrihost_from ;
|
|||
|
|
|
|||
|
|
# HTML body part
|
|||
|
|
my $mail_body = &common_get_mail_body($text_msg,$table_msg) ;
|
|||
|
|
|
|||
|
|
my $fullattachpath = "$attachpath/$attachname";
|
|||
|
|
die "Attachment file not found: $fullattachpath" unless -e $fullattachpath;
|
|||
|
|
|
|||
|
|
# === build the MulitPart MIME Message ===
|
|||
|
|
|
|||
|
|
# Create the Message
|
|||
|
|
my $msg = MIME::Lite::->new(
|
|||
|
|
'From' => "$useropts{short} Events <$from>",
|
|||
|
|
'Reply-To' => $email_reply_to,
|
|||
|
|
'To' => $to,
|
|||
|
|
'Cc' => $cc,
|
|||
|
|
'Bcc' => $bcc,
|
|||
|
|
'Subject' => $subj,
|
|||
|
|
'Type' => 'multipart/mixed',
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
# Create the HTML part
|
|||
|
|
my $html_part = MIME::Lite::->new(
|
|||
|
|
'Type' => 'multipart/related',
|
|||
|
|
);
|
|||
|
|
|
|||
|
|
$html_part->attach(
|
|||
|
|
'Type' => 'text/html',
|
|||
|
|
'Data' => $mail_body,
|
|||
|
|
) ;
|
|||
|
|
|
|||
|
|
# === Attachments ===
|
|||
|
|
|
|||
|
|
my $attachtype = ($attachapplication) ? "application/$attachapplication" : 'AUTO' ; # application/pdf or application/vnd.openxmlformats-officedocument.spreadsheetml.sheet
|
|||
|
|
my $attach_part = MIME::Lite::->new(
|
|||
|
|
'Type' => 'multipart/mixed',
|
|||
|
|
);
|
|||
|
|
$attach_part->attach (
|
|||
|
|
Type => "$attachtype",
|
|||
|
|
Encoding => 'base64',
|
|||
|
|
Path => "$fullattachpath",
|
|||
|
|
Filename => $attachname,
|
|||
|
|
Disposition => 'attachement'
|
|||
|
|
) ;
|
|||
|
|
|
|||
|
|
$msg->attach($attach_part);
|
|||
|
|
$msg->attach($html_part);
|
|||
|
|
|
|||
|
|
my $email = $msg->as_string();
|
|||
|
|
|
|||
|
|
my $smtp_msg = Net::SMTP_auth->new('localhost') or die "Can't connect";
|
|||
|
|
|
|||
|
|
# my $smtp_msg = Net::SMTP_auth->new($smtp_host, Port=>587) or die "Can't connect";
|
|||
|
|
# $smtp_msg->auth('PLAIN', $smtp_user, $smtp_pass) or die "Can't authenticate:" . $smtp_msg->message();
|
|||
|
|
|
|||
|
|
$smtp_msg->mail($from) or die "Error:" . $smtp_msg->message();
|
|||
|
|
|
|||
|
|
$smtp_msg->to($_) for split(/\s*,\s*/, join(',', $to, $cc, $bcc));
|
|||
|
|
|
|||
|
|
# $smtp_msg->recipient($to) or die "Error:".$smtp_msg->message();
|
|||
|
|
$smtp_msg->data() or die "Error:".$smtp_msg->message();
|
|||
|
|
$smtp_msg->datasend($email) or die "Error:".$smtp_msg->message();
|
|||
|
|
$smtp_msg->dataend() or die "Error:".$smtp_msg->message();
|
|||
|
|
$smtp_msg->quit or die "Error:".$smtp_msg->message();
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
# sub common_send_mail {
|
|||
|
|
|
|||
|
|
# my ($to,$cc,$bcc,$html,$thead,$msg,$subj) = @_ ;
|
|||
|
|
|
|||
|
|
# return unless $msg ;
|
|||
|
|
# return unless $subj ;
|
|||
|
|
|
|||
|
|
# # my $res = &common_mailsend_sendgrid('html',$to,$subject,$emailmsg,'','','Film Freight','pod@ffwaybill.co.za');
|
|||
|
|
|
|||
|
|
# # return if $res eq 'success' ; # carry on if mailsend_sendgrid failed
|
|||
|
|
|
|||
|
|
# use Mail::Sendmail;
|
|||
|
|
|
|||
|
|
# my $main_email = 'tickets@interactivetvafrica.com' ;
|
|||
|
|
|
|||
|
|
# $to = $main_email unless $to ;
|
|||
|
|
|
|||
|
|
# my %mail = () ;
|
|||
|
|
|
|||
|
|
# %mail = (
|
|||
|
|
# smtp => 'localhost',
|
|||
|
|
# From => $main_email,
|
|||
|
|
# To => $to,
|
|||
|
|
# Cc => $cc,
|
|||
|
|
# Bcc => $bcc,
|
|||
|
|
# Subject => $subj
|
|||
|
|
# );
|
|||
|
|
|
|||
|
|
# $mail{smtp} = "smtp.interactivetvafrica.com";
|
|||
|
|
# # $mail{Debug} = 6;
|
|||
|
|
# $mail{port} = 587;
|
|||
|
|
# # $mail{port} = 465;
|
|||
|
|
# $mail{Auth} = {user => $main_email, pass => $send_mail_psw, method => "LOGIN", required => 1};
|
|||
|
|
|
|||
|
|
# $mail{body} = <<END_OF_BODY;
|
|||
|
|
|
|||
|
|
# $msg
|
|||
|
|
|
|||
|
|
# END_OF_BODY
|
|||
|
|
|
|||
|
|
# if ($html) {
|
|||
|
|
|
|||
|
|
# my $boundary = "====" . time() . "====";
|
|||
|
|
|
|||
|
|
# $mail{'content-type'} = "multipart/alternative; boundary=\"$boundary\"";
|
|||
|
|
|
|||
|
|
# $boundary = '--'.$boundary;
|
|||
|
|
|
|||
|
|
# $mail{body} = <<END_OF_BODY;
|
|||
|
|
# $boundary
|
|||
|
|
# Content-Type: text/html; charset=ISO-8859-1
|
|||
|
|
# Content-Transfer-Encoding: 7bit
|
|||
|
|
# <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
|
|||
|
|
# <html>
|
|||
|
|
# <head>
|
|||
|
|
# <meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
|
|||
|
|
# <title>$useropts{short}</title>
|
|||
|
|
# <style type="text/css">
|
|||
|
|
# body { background-color:#ffffff; color:#222222; }
|
|||
|
|
# tbody tr td { font-size: 11px; }
|
|||
|
|
# .table th{background-color:#fff !important}.btn>.caret,.dropup>.btn>.caret{border-top-color:#000 !important}.label{border:1px solid #000}.table{border-collapse:collapse !important}.table-bordered th,.table-bordered td{border:1px solid #ddd !important}
|
|||
|
|
# .table-striped>tbody>tr:nth-child(odd)>td,.table-striped>tbody>tr:nth-child(odd)>th{background-color:#EEEEEE; color:#222222; }
|
|||
|
|
# .table-striped>tbody>tr:nth-child(even)>td,.table-striped>tbody>tr:nth-child(even)>th{ background-color:#A4A2A2; color:#ffffff; }
|
|||
|
|
# .table-striped>tbody>tr:nth-child(odd)>td a:not(.btn) { text-decoration: none; color: #FF6600; font-weight: bold; }
|
|||
|
|
# .table-striped>tbody>tr:nth-child(even)>td a:not(.btn) { text-decoration: none; color: #EC1C24; font-weight: bold; }
|
|||
|
|
# .table>thead>tr>th, .table>tbody>tr>th, .table>tfoot>tr>th, .table>thead>tr>td, .table>tbody>tr>td, .table>tfoot>tr>td { height: 8px; vertical-align: middle; }
|
|||
|
|
# </style>
|
|||
|
|
# </head>
|
|||
|
|
# <body style="background-color: #FFFFFF; font-family: Arial, Helvetica, sans-serif; font-size: 13px">
|
|||
|
|
# <div align="center">
|
|||
|
|
# <a href="https://interactivetvafrica.com/"><img alt="$useropts{short}" src="https://$ENV{SERVER_NAME}/img/email_logo.jpg" border="0"></a>
|
|||
|
|
# <br><br>
|
|||
|
|
# <table id="itv-table" class="table table-striped table-bordered bootstrap-datatable datatable responsive">
|
|||
|
|
# $thead
|
|||
|
|
# <tbody>
|
|||
|
|
# $msg
|
|||
|
|
# </tbody>
|
|||
|
|
# </table>
|
|||
|
|
# <br>
|
|||
|
|
# <p>
|
|||
|
|
# Best regards,
|
|||
|
|
# <br>
|
|||
|
|
# <br>
|
|||
|
|
# The $useropts{short} Team.
|
|||
|
|
# </p>
|
|||
|
|
# </div>
|
|||
|
|
# </body>
|
|||
|
|
# </html>
|
|||
|
|
|
|||
|
|
# $boundary--
|
|||
|
|
|
|||
|
|
# END_OF_BODY
|
|||
|
|
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# sendmail(%mail) ;
|
|||
|
|
|
|||
|
|
# } #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
# sub common_send_smtp_mail {
|
|||
|
|
|
|||
|
|
# my ($from,$to,$cc,$bcc,$subj,$msg,$table_msg,$html,$thead,$attachpath,$attachname,$attachapplication,$uploaded_doc,$operator_email) = @_ ;
|
|||
|
|
|
|||
|
|
# &common_debug("common_send_smtp_mail [$from,$to,$cc,$bcc,$subj,$msg,$table_msg,$html,$thead,$attachpath,$attachname,$attachapplication,$uploaded_doc,$operator_email]") ;
|
|||
|
|
|
|||
|
|
# return unless $msg ;
|
|||
|
|
# return unless $subj ;
|
|||
|
|
|
|||
|
|
# # my $htype = (-f "$attachpath/$attachname" || $uploaded_doc || $operator_email) ? 'htmlattach' : ($html eq 'html') ? $html : 'text' ;
|
|||
|
|
|
|||
|
|
# # my $res = &common_mailsend_sendgrid($htype,$to,$subj,$msg,$attachpath,$attachname,"$useropts{short} Events",'events@itvadmin.co.za',$cc,$bcc,$uploaded_doc,$operator_email);
|
|||
|
|
|
|||
|
|
# # return if $res eq 'success' ; # carry on if mailsend_sendgrid failed
|
|||
|
|
|
|||
|
|
# my $main_email = $email_add{'events'} ;
|
|||
|
|
|
|||
|
|
# $to = $main_email unless $to ;
|
|||
|
|
# $from = $main_email unless $from ;
|
|||
|
|
|
|||
|
|
# my $mail_body = ($html) ? &common_get_mail_body($msg,$table_msg,$thead) : $msg ;
|
|||
|
|
|
|||
|
|
# if ($html) {
|
|||
|
|
|
|||
|
|
# if (($attachname && -f "$attachpath/$attachname") or $uploaded_doc) {
|
|||
|
|
|
|||
|
|
# use MIME::Lite;
|
|||
|
|
# use Net::SMTP_auth;
|
|||
|
|
|
|||
|
|
|
|||
|
|
# # #################################################################
|
|||
|
|
# # Lets build the MulitPart MIME Message
|
|||
|
|
# # #################################################################
|
|||
|
|
# # Create the Message
|
|||
|
|
# my $msg = MIME::Lite::->new(
|
|||
|
|
# 'From' => "$useropts{short} Events <$from>",
|
|||
|
|
# 'Reply-To' => $email_reply_to,
|
|||
|
|
# 'To' => $to,
|
|||
|
|
# 'Cc' => $cc,
|
|||
|
|
# 'Bcc' => $bcc,
|
|||
|
|
# 'Subject' => $subj,
|
|||
|
|
# 'Type' => 'multipart/mixed',
|
|||
|
|
# );
|
|||
|
|
|
|||
|
|
# # Create the text part
|
|||
|
|
# # my $text_part = MIME::Lite::->new(
|
|||
|
|
# # 'Type' => 'text/plain',
|
|||
|
|
# # 'Data' => 'Hi\nThis is a test message',
|
|||
|
|
# # );
|
|||
|
|
|
|||
|
|
# # Create the HTML part
|
|||
|
|
# my $html_part = MIME::Lite::->new(
|
|||
|
|
# 'Type' => 'multipart/related',
|
|||
|
|
# );
|
|||
|
|
|
|||
|
|
# $html_part->attach(
|
|||
|
|
# 'Type' => 'text/html',
|
|||
|
|
# 'Data' => $mail_body,
|
|||
|
|
# ) ;
|
|||
|
|
|
|||
|
|
# if ($attachname && -f "$attachpath/$attachname") {
|
|||
|
|
# my $attachtype = ($attachapplication) ? "application/$attachapplication" : 'AUTO' ;
|
|||
|
|
# my $attach_part = MIME::Lite::->new(
|
|||
|
|
# 'Type' => 'multipart/mixed',
|
|||
|
|
# );
|
|||
|
|
# $attach_part->attach (
|
|||
|
|
# Type => "$attachtype",
|
|||
|
|
# Encoding => 'base64',
|
|||
|
|
# Path => "$attachpath/$attachname",
|
|||
|
|
# Filename => $attachname,
|
|||
|
|
# Disposition => 'attachement'
|
|||
|
|
# ) or &common_send_mail('rory@kre8it.co.za','','','',"$useropts{short} ERROR : common.pm","common_send_smtp_mail cant attach $attachpath/$attachname : $!") ;
|
|||
|
|
# $msg->attach($attach_part);
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# if ($uploaded_doc) {
|
|||
|
|
# my $upload_part = MIME::Lite::->new(
|
|||
|
|
# 'Type' => 'multipart/mixed',
|
|||
|
|
# );
|
|||
|
|
# $upload_part->attach (
|
|||
|
|
# Type => 'AUTO',
|
|||
|
|
# FH => $uploaded_doc,
|
|||
|
|
# Filename => $uploaded_doc,
|
|||
|
|
# Disposition => 'attachment'
|
|||
|
|
# ) or die "Error adding : $uploaded_doc $!\n";
|
|||
|
|
# $msg->attach($upload_part);
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# if ($operator_email) {
|
|||
|
|
# my $attach_flyer = MIME::Lite::->new(
|
|||
|
|
# 'Type' => 'multipart/mixed',
|
|||
|
|
# );
|
|||
|
|
# $attach_flyer->attach (
|
|||
|
|
# Type => "application/$attachapplication",
|
|||
|
|
# Encoding => 'base64',
|
|||
|
|
# Path => "$htmlpath/pdf/operator_flyer",
|
|||
|
|
# Filename => "operator_email_attach.pdf",
|
|||
|
|
# Disposition => 'attachement'
|
|||
|
|
# ) or &common_send_mail('handre@kre8it.co.za','','','',"$useropts{short} ERROR : common.pm","common_send_smtp_mail cant attach $attachpath/$attachname : $!") ;
|
|||
|
|
# $msg->attach($attach_flyer);
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# # Now lets attach the text and html parts to the message
|
|||
|
|
# # $msg->attach($text_part);
|
|||
|
|
# $msg->attach($html_part);
|
|||
|
|
|
|||
|
|
# my $email = $msg->as_string();
|
|||
|
|
|
|||
|
|
# # #################################################################
|
|||
|
|
# # Lets sent the Message
|
|||
|
|
# # #################################################################
|
|||
|
|
|
|||
|
|
# my $smtp_msg = Net::SMTP_auth->new($smtp_server, Port=>587) or die "Can't connect";
|
|||
|
|
# # my $smtp_msg = Net::SMTP_auth->new($smtp_server, Port=>465) or die "Can't connect";
|
|||
|
|
# $smtp_msg->auth('PLAIN', $main_email, $send_mail_psw_events) or die "Can't authenticate:".$smtp_msg->message();
|
|||
|
|
|
|||
|
|
# $smtp_msg->mail($from) or die "Error:".$smtp_msg->message();
|
|||
|
|
# $smtp_msg->recipient($to) or die "Error:".$smtp_msg->message();
|
|||
|
|
|
|||
|
|
# $smtp_msg->data() or die "Error:".$smtp_msg->message();
|
|||
|
|
# $smtp_msg->datasend($email) or die "Error:".$smtp_msg->message();
|
|||
|
|
# $smtp_msg->dataend() or die "Error:".$smtp_msg->message();
|
|||
|
|
# $smtp_msg->quit or die "Error:".$smtp_msg->message();
|
|||
|
|
|
|||
|
|
# } else {
|
|||
|
|
# &common_send_mail($to,$cc,$bcc,$html,$thead,$msg,$subj,$table_msg) ;
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# } else {
|
|||
|
|
# &common_send_mail($to,$cc,$bcc,$html,$thead,$msg,$subj,$table_msg) ;
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# } #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
# sub common_mailsend_sendgrid {
|
|||
|
|
|
|||
|
|
# local ($qtype,$qemail,$qsubject,$qbody,$qattachfilepath,$qattachfilename,$qfromname,$qfromemail,$qccemail,$qbccemail,$uploaded_doc,$operator_email) = @_;
|
|||
|
|
|
|||
|
|
# $qccemail =~ s/\;/\,/g ;
|
|||
|
|
# $qbccemail =~ s/\;/\,/g ;
|
|||
|
|
|
|||
|
|
# use Email::SendGrid::V3;
|
|||
|
|
|
|||
|
|
# &common_debug("common_mailsend_sendgrid [$qtype,$qemail,$qsubject,$qbody,$qattachfilepath,$qattachfilename,$qfromname,$qfromemail,$qccemail,$qbccemail,$uploaded_doc,$operator_email]") ;
|
|||
|
|
|
|||
|
|
# #=======================
|
|||
|
|
# #REF1: https://docs.sendgrid.com/for-developers/sending-email/curl-examples
|
|||
|
|
# #REF2: https://github.com/GrantStreetGroup/Email-SendGrid-V3
|
|||
|
|
# #To Install:
|
|||
|
|
# #cpan -i Email::SendGrid::V3
|
|||
|
|
# #cd /root/perl5/lib/perl5
|
|||
|
|
# #cp -R Email /usr/local/lib64/perl5
|
|||
|
|
# #=======================
|
|||
|
|
|
|||
|
|
# my $sg = Email::SendGrid::V3->new(api_key => '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');
|
|||
|
|
|
|||
|
|
# $qbody =~ s/'/`/gi;
|
|||
|
|
# $qbody =~ s/\r//gi;
|
|||
|
|
# $qbody =~ s/\n//gi;
|
|||
|
|
|
|||
|
|
# #------------------------------------------------
|
|||
|
|
# #SEND TEXT ONLY MAIL
|
|||
|
|
# if ($qtype eq "text") {
|
|||
|
|
|
|||
|
|
# # , cc => [ $qccemail ], bcc => [ $qbccemail ]
|
|||
|
|
|
|||
|
|
# my %cc_args = ($qccemail) ? (cc => [ "$qccemail" ]) : () ;
|
|||
|
|
# my %bcc_args = ($qbccemail) ? (bcc => [ "$qbccemail" ]) : () ;
|
|||
|
|
|
|||
|
|
# my $result = $sg->from($qfromemail,$qfromname)
|
|||
|
|
# ->reply_to($email_reply_to, "$useropts{short} Events")
|
|||
|
|
# ->subject($qsubject)
|
|||
|
|
# ->add_content('text/plain', $qbody)
|
|||
|
|
# ->add_envelope( to => [ "$qemail" ], %cc_args, %bcc_args)
|
|||
|
|
# ->send;
|
|||
|
|
|
|||
|
|
# $qres = $result->{success} ? "success" : "error: " . $result->{reason};
|
|||
|
|
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# #------------------------------------------------
|
|||
|
|
# #SEND HTML ONLY MAIL
|
|||
|
|
# if ($qtype eq "html") {
|
|||
|
|
|
|||
|
|
# my $logo_domain = ($useropts{web}) ? $useropts{web} : $ENV{SERVER_NAME} ;
|
|||
|
|
|
|||
|
|
# $qbody = qq~<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
|||
|
|
# <html xmlns="http://www.w3.org/1999/xhtml">
|
|||
|
|
# <head>
|
|||
|
|
# <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
|
|||
|
|
# <title>$useropts{short}</title>
|
|||
|
|
# <style type="text/css"> .font { font-family: Tahoma, Geneva, sans-serif; } .font { font-size: 12px; }</style>
|
|||
|
|
# </head>
|
|||
|
|
# <body>
|
|||
|
|
# <p>
|
|||
|
|
# <img alt="" src="https://$logo_domain/img/email_logo.jpg" border="0">
|
|||
|
|
# </p>
|
|||
|
|
# <p>
|
|||
|
|
# $qbody
|
|||
|
|
# </p>
|
|||
|
|
# <br />
|
|||
|
|
# <br />
|
|||
|
|
# </body>
|
|||
|
|
# </html>
|
|||
|
|
# ~;
|
|||
|
|
# my %cc_args = ($qccemail) ? (cc => [ "$qccemail" ]) : () ;
|
|||
|
|
# my %bcc_args = ($qbccemail) ? (bcc => [ "$qbccemail" ]) : () ;
|
|||
|
|
|
|||
|
|
# my $result = $sg->from($qfromemail,$qfromname)
|
|||
|
|
# ->reply_to($email_reply_to, "$useropts{short} Events")
|
|||
|
|
# ->subject($qsubject)
|
|||
|
|
# ->add_content('text/html', $qbody)
|
|||
|
|
# ->add_envelope( to => [ "$qemail" ], %cc_args, %bcc_args)
|
|||
|
|
# ->send;
|
|||
|
|
|
|||
|
|
# $qres = $result->{success} ? "success" : "error: " . $result->{reason};
|
|||
|
|
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# #------------------------------------------------
|
|||
|
|
# #SEND HTML WITH ATTACHMENT MAIL
|
|||
|
|
# if ($qtype eq "htmlattach") {
|
|||
|
|
|
|||
|
|
# my $encodedcontent = &encode_attachment("$qattachfilepath/$qattachfilename");
|
|||
|
|
|
|||
|
|
# my %args = (
|
|||
|
|
# type => 'AUTO',
|
|||
|
|
# disposition => 'attachment'
|
|||
|
|
# );
|
|||
|
|
|
|||
|
|
# my $logo_domain = ($useropts{web}) ? $useropts{web} : $ENV{SERVER_NAME} ;
|
|||
|
|
|
|||
|
|
# $qbody = qq~<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
|
|||
|
|
# <html xmlns="http://www.w3.org/1999/xhtml">
|
|||
|
|
# <head>
|
|||
|
|
# <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
|
|||
|
|
# <title>$useropts{short}</title>
|
|||
|
|
# <style type="text/css"> .font { font-family: Tahoma, Geneva, sans-serif; } .font { font-size: 12px; }</style>
|
|||
|
|
# </head>
|
|||
|
|
# <body>
|
|||
|
|
# <p>
|
|||
|
|
# <img alt="" src="https://$logo_domain/img/email_logo.jpg" border="0">
|
|||
|
|
# </p>
|
|||
|
|
# <p>
|
|||
|
|
# $qbody
|
|||
|
|
# </p>
|
|||
|
|
# <br />
|
|||
|
|
# <br />
|
|||
|
|
# </body>
|
|||
|
|
# </html>
|
|||
|
|
# ~;
|
|||
|
|
|
|||
|
|
# my @attachments = ($qattachfilename, $encodedcontent, %args) ;
|
|||
|
|
|
|||
|
|
# if ($uploaded_doc) {
|
|||
|
|
# my $encodedcontent = &encode_attachment("$uploaded_doc") ;
|
|||
|
|
# push @attachments, ($uploaded_doc, $encodedcontent, %args) ;
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
# if ($operator_email) {
|
|||
|
|
# my $encodedcontent = &encode_attachment("$htmlpath/pdf/operator_flyer") ;
|
|||
|
|
# push @attachments, ("operator_email_attach.pdf", $encodedcontent, %args) ;
|
|||
|
|
# }
|
|||
|
|
|
|||
|
|
|
|||
|
|
# my %cc_args = ($qccemail) ? (cc => [ "$qccemail" ]) : () ;
|
|||
|
|
# my %bcc_args = ($qbccemail) ? (bcc => [ "$qbccemail" ]) : () ;
|
|||
|
|
|
|||
|
|
# my $result = $sg->from($qfromemail,$qfromname)
|
|||
|
|
# ->reply_to($email_reply_to, "$useropts{short} Events")
|
|||
|
|
# ->subject($qsubject)
|
|||
|
|
# ->add_content('text/html', $qbody)
|
|||
|
|
# ->add_attachment(@attachments)
|
|||
|
|
# ->add_envelope( to => [ "$qemail" ], %cc_args, %bcc_args)
|
|||
|
|
# ->send;
|
|||
|
|
|
|||
|
|
# $qres = $result->{success} ? "success" : "error: " . $result->{reason};
|
|||
|
|
|
|||
|
|
# #NOTE: Cannot use command line cURL here as the body (base64 pdf) is too large - below works for smaller content
|
|||
|
|
# #$qres = `/usr/bin/curl --request POST --url https://api.sendgrid.com/v3/mail/send --header 'authorization: Bearer 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' --header 'Content-Type: application/json' --data '{"personalizations": [{"to": [{"email": "$qemail"}]}],"from": {"email": "no-reply\@myappointment.co.za"},"subject":"$qsubject","content": [{"type": "text/html","value": "$qbody"}], "attachments": [{"content": "$encodedcontent", "type": "text/plain", "filename": "$qattachfilename"}]}'`;
|
|||
|
|
# }
|
|||
|
|
# #------------------------------------------------
|
|||
|
|
|
|||
|
|
# &common_debug("common_mailsend_sendgrid [$qres]") ;
|
|||
|
|
|
|||
|
|
# return "$qres";
|
|||
|
|
|
|||
|
|
# } #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub encode_attachment {
|
|||
|
|
|
|||
|
|
my ($fh) = @_ ;
|
|||
|
|
|
|||
|
|
use MIME::Base64 qw(encode_base64);
|
|||
|
|
|
|||
|
|
my $myfilecontents = '' ;
|
|||
|
|
|
|||
|
|
open (infile, "$fh");
|
|||
|
|
binmode infile;
|
|||
|
|
while (<infile>) {
|
|||
|
|
$myfilecontents .= "$_";
|
|||
|
|
}
|
|||
|
|
close(infile);
|
|||
|
|
|
|||
|
|
my $encodedcontent = encode_base64($myfilecontents);
|
|||
|
|
|
|||
|
|
$encodedcontent =~ s/'/`/gi;
|
|||
|
|
$encodedcontent =~ s/\r//gi;
|
|||
|
|
$encodedcontent =~ s/\n//gi;
|
|||
|
|
|
|||
|
|
return($encodedcontent) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_fix_str {
|
|||
|
|
|
|||
|
|
my ($txt) = @_ ;
|
|||
|
|
|
|||
|
|
$txt = lc $txt ;
|
|||
|
|
$txt =~ s/\'//iog ;
|
|||
|
|
$txt =~ s/^\s+|\s+$//g; # remove whitespace before and after
|
|||
|
|
local $txt_new = '' ;
|
|||
|
|
foreach (split(/ /,$txt)) {
|
|||
|
|
if ($_ ne 'and' and $_ ne 'or' and $_ ne 'of' and $_ ne 'in') {
|
|||
|
|
$txt_new .= ucfirst $_ ;
|
|||
|
|
} else {
|
|||
|
|
$txt_new .= "$_" ;
|
|||
|
|
}
|
|||
|
|
$txt_new .= ' ' ;
|
|||
|
|
}
|
|||
|
|
chop $txt_new if $txt_new ;
|
|||
|
|
|
|||
|
|
return ($txt_new) ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_date_array {
|
|||
|
|
|
|||
|
|
my ($from_date, $to_date) = @_ ;
|
|||
|
|
|
|||
|
|
my $date_array_date = $from_date ;
|
|||
|
|
|
|||
|
|
@common_date_array = () ;
|
|||
|
|
|
|||
|
|
# &common_debug ("common_date_array : $from_date, $to_date") ;
|
|||
|
|
|
|||
|
|
while ($date_array_date <= $to_date) {
|
|||
|
|
|
|||
|
|
# &common_debug ("common_date_array : push \@common_date_array, $date_array_date") ;
|
|||
|
|
push @common_date_array, $date_array_date ;
|
|||
|
|
|
|||
|
|
my $array_date_dd = substr($date_array_date,6,2) ;
|
|||
|
|
my $array_date_mm = substr($date_array_date,4,2) ;
|
|||
|
|
my $array_date_ccyy = substr($date_array_date,0,4) ;
|
|||
|
|
|
|||
|
|
$day_of_week{$date_array_date} = Day_of_Week($array_date_ccyy,$array_date_mm,$array_date_dd) unless $day_of_week{$date_array_date} ; # 1 is Monday
|
|||
|
|
# $day_of_week{"$array_date_ccyy-$array_date_mm-$array_date_dd"} = Day_of_Week($array_date_ccyy,$array_date_mm,$array_date_dd) unless $day_of_week{"$array_date_ccyy-$array_date_mm-$array_date_dd"} ; # 1 is Monday
|
|||
|
|
# $date_hash{$date_array_date} = 1 ;
|
|||
|
|
|
|||
|
|
my ($ccyy,$month,$day) = Add_Delta_Days($array_date_ccyy,$array_date_mm,$array_date_dd,1) ;
|
|||
|
|
$month = sprintf("%02s", $month) ;
|
|||
|
|
$day = sprintf("%02s", $day) ;
|
|||
|
|
|
|||
|
|
$date_array_date = "$ccyy$month$day" ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
&common_debug ("common_date_array : @common_date_array") ;
|
|||
|
|
|
|||
|
|
} #-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_clean_json_one {
|
|||
|
|
|
|||
|
|
my ($txt) = @_ ;
|
|||
|
|
|
|||
|
|
# $txt =~ s/ //g;
|
|||
|
|
$txt =~ s/\s+//g; # remove all spaces
|
|||
|
|
$txt =~ s/\r\n|\n//g;
|
|||
|
|
$txt =~ s/\t//g;
|
|||
|
|
|
|||
|
|
$txt = &common_clean_json_two($txt) ;
|
|||
|
|
|
|||
|
|
return ($txt) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_clean_json_two {
|
|||
|
|
|
|||
|
|
my ($txt) = @_ ;
|
|||
|
|
|
|||
|
|
$txt =~ s/\r\n|\n/ /g;
|
|||
|
|
$txt =~ s/\t/ /g;
|
|||
|
|
$txt =~ s/\"//g;
|
|||
|
|
$txt =~ s/\'//g;
|
|||
|
|
$txt =~ s/\’//g;
|
|||
|
|
$txt =~ s/\</</g;
|
|||
|
|
$txt =~ s/\>/>/g;
|
|||
|
|
$txt =~ s/\&/&/g;
|
|||
|
|
$txt =~ s/\Ë/E/g;
|
|||
|
|
$txt =~ s/ +/ /g; # remove excess spaces
|
|||
|
|
|
|||
|
|
return ($txt) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_reverse_geocode_osm_address {
|
|||
|
|
|
|||
|
|
my ($lat,$lng,$typ) = @_ ;
|
|||
|
|
|
|||
|
|
my $address = '' ; my $decoded_json = '' ;
|
|||
|
|
|
|||
|
|
my $url = "http://nominatim.openstreetmap.org/reverse?format=jsonv2&lat=$lat&lon=$lng" ; # http://nominatim.openstreetmap.org/reverse?format=jsonv2&lat=-32.851705&lon=24.727521&zoom=18&addressdetails=1&extratags=1 # https://wiki.openstreetmap.org/wiki/Key:highway # Google Roads API : https://roads.googleapis.com/v1/speedLimits?path=-32.851705,24.727521|-32.856349,24.730925|-32.89585,24.693126|-32.923483,24.675421&key=AIzaSyBVeP-dp1VpeceSo-80pukUBFaPsN_mcRw (https://developers.google.com/maps/documentation/roads/speed-limits)
|
|||
|
|
my $json = get ($url) ; # or die "Couldn't get $url : $!";
|
|||
|
|
|
|||
|
|
if ($json) {
|
|||
|
|
$decoded_json = decode_json $json ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if ($typ eq 'min') {
|
|||
|
|
my @add = () ; %gotpart = () ;
|
|||
|
|
push @add, $decoded_json->{'address'}->{'road'} if $decoded_json->{'address'}->{'road'} ;
|
|||
|
|
|
|||
|
|
my ($suburb,$junk) = split / Ward /, $decoded_json->{'address'}->{'suburb'} ;
|
|||
|
|
my ($suburb,$junk) = split / Industria /, $suburb ; $suburb =~ s/ Industrial//g ;
|
|||
|
|
push @add, $suburb if $suburb ;
|
|||
|
|
|
|||
|
|
$gotpart{$suburb} = 1 ;
|
|||
|
|
|
|||
|
|
my $city = $decoded_json->{'address'}->{'city'} ; $city =~ s/ Local Municipality//g ;
|
|||
|
|
|
|||
|
|
if ($gotpart{$city}) {
|
|||
|
|
push @add, $decoded_json->{'address'}->{'state'} if $decoded_json->{'address'}->{'state'} ;
|
|||
|
|
} else {
|
|||
|
|
push @add, $city if $city ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
my $country = $decoded_json->{'address'}->{'country'} ;
|
|||
|
|
push @add, $country if $country and $country ne 'South Africa' ;
|
|||
|
|
|
|||
|
|
$address = join ", ", @add ;
|
|||
|
|
} elsif ($json) {
|
|||
|
|
$address = $decoded_json->{'display_name'} ;
|
|||
|
|
&common_debug("[API] common_get_osm_address : [$url] [$address] ") ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($address) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_location_osm_address {
|
|||
|
|
|
|||
|
|
my ($loc) = @_ ;
|
|||
|
|
|
|||
|
|
my $address = '' ; my $postcode = '' ; my $suburb = '' ; my $city = '' ; my $decoded_json = '' ;
|
|||
|
|
|
|||
|
|
my $url = "https://nominatim.openstreetmap.org/search?q=$loc&format=json&addressdetails=1" ;
|
|||
|
|
my $json = get ($url) ; # or die "Couldn't get $url : $!";
|
|||
|
|
|
|||
|
|
if ($json) {
|
|||
|
|
$decoded_json = decode_json $json ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
&common_debug("[API] common_location_osm_address : [$url] [$decoded_json] ") ;
|
|||
|
|
|
|||
|
|
if (ref $decoded_json eq 'ARRAY' && @$decoded_json) {
|
|||
|
|
|
|||
|
|
my $amenity = $decoded_json->[0]->{'address'}->{'amenity'} ; # "Rondebosch Boys' High School"
|
|||
|
|
my $road = $decoded_json->[0]->{'address'}->{'road'} ; # "Canigou Avenue"
|
|||
|
|
$postcode = $decoded_json->[0]->{'address'}->{'postcode'} ; # "7700"
|
|||
|
|
|
|||
|
|
my @add = () ; %gotpart = () ;
|
|||
|
|
push @add, $amenity if $amenity ;
|
|||
|
|
push @add, $road if $road ;
|
|||
|
|
|
|||
|
|
($suburb,$junk) = split / Ward /, $decoded_json->[0]->{'address'}->{'suburb'} ;
|
|||
|
|
($suburb,$junk) = split / Industria /, $suburb ; $suburb =~ s/ Industrial//g ;
|
|||
|
|
push @add, $suburb if $suburb ;
|
|||
|
|
|
|||
|
|
$gotpart{$suburb} = 1 ;
|
|||
|
|
|
|||
|
|
$city = $decoded_json->[0]->{'address'}->{'city'} ; $city =~ s/ Local Municipality//g ; # "Cape Town"
|
|||
|
|
|
|||
|
|
if ($gotpart{$city}) {
|
|||
|
|
push @add, $decoded_json->[0]->{'address'}->{'state'} if $decoded_json->[0]->{'address'}->{'state'} ;
|
|||
|
|
} else {
|
|||
|
|
push @add, $city if $city ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
my $country = $decoded_json->[0]->{'address'}->{'country'} ;
|
|||
|
|
push @add, $country if $country and $country ne 'South Africa' ;
|
|||
|
|
|
|||
|
|
$address = join ", ", @add ;
|
|||
|
|
} else {
|
|||
|
|
return ('', '', '');
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
&common_debug("[API] common_location_osm_address : [suburb=$suburb] [postcode=$postcode] [address=$address]") ;
|
|||
|
|
|
|||
|
|
# 0
|
|||
|
|
# place_id 60085165
|
|||
|
|
# licence "Data © OpenStreetMap contributors, ODbL 1.0. http://osm.org/copyright"
|
|||
|
|
# osm_type "relation"
|
|||
|
|
# osm_id 3068903
|
|||
|
|
# lat "-33.9696668"
|
|||
|
|
# lon "18.477931506136713"
|
|||
|
|
# class "amenity"
|
|||
|
|
# type "school"
|
|||
|
|
# place_rank 30
|
|||
|
|
# importance 0.3041234681398241
|
|||
|
|
# addresstype "amenity"
|
|||
|
|
# name "Rondebosch Boys' High School"
|
|||
|
|
# display_name "Rondebosch Boys' High School, Canigou Avenue, Cape Town Ward 59, Cape Town, City of Cape Town, Western Cape, 7700, South Africa"
|
|||
|
|
# address
|
|||
|
|
# amenity "Rondebosch Boys' High School"
|
|||
|
|
# road "Canigou Avenue"
|
|||
|
|
# suburb "Cape Town Ward 59"
|
|||
|
|
# city "Cape Town"
|
|||
|
|
# county "City of Cape Town"
|
|||
|
|
# state "Western Cape"
|
|||
|
|
# ISO3166-2-lvl4 "ZA-WC"
|
|||
|
|
# postcode "7700"
|
|||
|
|
# country "South Africa"
|
|||
|
|
# country_code "za"
|
|||
|
|
# boundingbox
|
|||
|
|
# 0 "-33.9728789"
|
|||
|
|
# 1 "-33.9664854"
|
|||
|
|
# 2 "18.4755388"
|
|||
|
|
# 3 "18.4820403"
|
|||
|
|
|
|||
|
|
return ($suburb,$city,$postcode,$address) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_log_changes {
|
|||
|
|
|
|||
|
|
my ($log,$nline) = @_ ;
|
|||
|
|
|
|||
|
|
unless ($log) { return ; }
|
|||
|
|
|
|||
|
|
$nline =~ s/[ ]+/ /g ; # Replaces all occurances of two spaces with one space
|
|||
|
|
$nline =~ s/\n/ /g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/\t/ /g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
$nline =~ s/\r/ /g ; # substitutes a whitespace (\t\n\r\f) by a nothing - ie : removes all CR / LF etc
|
|||
|
|
|
|||
|
|
my $logfile = "/home/libs/data/logs/$log";
|
|||
|
|
|
|||
|
|
open (LFILE, "+>>$logfile") or die "can't open $logfile : $!" ;
|
|||
|
|
flock (LFILE, LOCK_EX) or die "can't lock $logfile : $!" ;
|
|||
|
|
seek (LFILE, 0, 0) or die "can't rewind $logfile : $!" ;
|
|||
|
|
@lines = <LFILE> ;
|
|||
|
|
seek (LFILE, 0, 0) or die "can't rewind $logfile : $!" ;
|
|||
|
|
truncate (LFILE, 0) or die "can't truncate $logfile : $!" ;
|
|||
|
|
|
|||
|
|
my @sort_lines = reverse sort @lines ; # put newest ones first
|
|||
|
|
|
|||
|
|
my $log_cnt = 0 ;
|
|||
|
|
|
|||
|
|
print LFILE $nline . "\n" ;
|
|||
|
|
|
|||
|
|
foreach my $line (@sort_lines) { # 20181109104451||||
|
|||
|
|
|
|||
|
|
next unless $line ;
|
|||
|
|
|
|||
|
|
chomp $line;
|
|||
|
|
|
|||
|
|
@linex = split(/\|/,$line);
|
|||
|
|
|
|||
|
|
my $data_col = ($linex[4] eq 'changed_from' || $linex[4] =~/action='Add'/ || $linex[4] =~/action='Edit'/) ? 5 : 4 ;
|
|||
|
|
|
|||
|
|
my $num_of_data_splits = scalar @linex ;
|
|||
|
|
|
|||
|
|
for ($data_col+1 .. $num_of_data_splits) {
|
|||
|
|
$linex[$data_col] .= qq~|$linex[$_]~ ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
my @changes = split(",","$linex[$data_col]") ;
|
|||
|
|
|
|||
|
|
my $num_of_changes = scalar @changes ;
|
|||
|
|
|
|||
|
|
next if $num_of_changes == 1 && ($changes[0] =~ /last_update/) ;
|
|||
|
|
|
|||
|
|
my $hashkey = $linex[2] . $linex[3] . $linex[$data_col] ;
|
|||
|
|
# my $hashkey = $linex[2] . $linex[3] . $linex[5] . substr($linex[0],0,8) ;
|
|||
|
|
|
|||
|
|
if ($done_log_line{$hashkey}) { next ; }
|
|||
|
|
|
|||
|
|
if ($log_cnt > 10000) { last ; } # only retain 10000 lines
|
|||
|
|
|
|||
|
|
print LFILE "$line\n";
|
|||
|
|
|
|||
|
|
$done_log_line{$hashkey} = 1 ;
|
|||
|
|
|
|||
|
|
$log_cnt++;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
close (LFILE) ;
|
|||
|
|
|
|||
|
|
} #----------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub common_fix_cell {
|
|||
|
|
|
|||
|
|
my ($cell) = @_ ;
|
|||
|
|
|
|||
|
|
$cell =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
|
|||
|
|
$cell =~ s/amp;//g;
|
|||
|
|
$cell =~ s/\(//g;
|
|||
|
|
$cell =~ s/\)//g;
|
|||
|
|
$cell =~ s/ //g;
|
|||
|
|
|
|||
|
|
if ($cell == 0) {
|
|||
|
|
return ;
|
|||
|
|
} elsif ((substr($cell,0,1) == 0) and (length($cell) == 10)) { # e.g. 0825564120
|
|||
|
|
$cell = 27 . substr($cell,1) ; # 27825564120
|
|||
|
|
} elsif (substr($cell,0,1) eq '+') {
|
|||
|
|
$cell = substr($cell,1) ; # 27825564120
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return ($cell) ;
|
|||
|
|
|
|||
|
|
} #------------------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
sub add_extra_region_filter {
|
|||
|
|
|
|||
|
|
my ($regions_sql) = @_ ;
|
|||
|
|
|
|||
|
|
my $sql_limit_user_regions = ($is_schools_manager || $is_operator) ? join(' OR ', map { "id = '$_'" } keys %{$glob_regids{$userid}}) : '' ;
|
|||
|
|
|
|||
|
|
if ($regions_sql && $sql_limit_user_regions) {
|
|||
|
|
$regions_sql = "$regions_sql AND ($sql_limit_user_regions)" ;
|
|||
|
|
} elsif (!$regions_sql && $sql_limit_user_regions) {
|
|||
|
|
$regions_sql = $sql_limit_user_regions ;
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
return $regions_sql ;
|
|||
|
|
|
|||
|
|
}#-------------------------------------------------------------------------------
|
|||
|
|
|
|||
|
|
1;
|