2025-11-26 09:31:54 +00:00
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' ;
2026-02-03 12:35:43 +00:00
my $ logfile = "$cgipath/data/logs/$log" ;
2025-11-26 09:31:54 +00:00
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
2026-02-03 12:35:43 +00:00
my $ logfile = "$cgipath/data/logs/$log" ;
2025-11-26 09:31:54 +00:00
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' ;
2026-02-03 12:35:43 +00:00
my $ logfile = "$cgipath/data/logs/$log" ;
2025-11-26 09:31:54 +00:00
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: 11 px ; }
. 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: 8 px ; 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
2026-02-03 12:35:43 +00:00
my $ logfile = "$cgipath/data/logs/$log" ;
2025-11-26 09:31:54 +00:00
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 ;