#!/usr/bin/perl
# hello_get.cgi
# RJM Programming
# February, 2023
use DateTime;
use DateTime::TimeZone;
use DBI;
use DBD::mysql;
use Spreadsheet::WriteExcel;
use Data::Dumper qw(Dumper);
use LWP::UserAgent ();
#use PDF::Create;
use utf8;
#use Unicode::Escape;
# https://www-rjmprogramming-com-au.translate.goog/ITblog/perl-cgi-intranet-audio-tutorial/?_x_tr_sl=en&_x_tr_tl=eu&_x_tr_hl=en-GB&_x_tr_pto=nui
local ($buffer, @pairs, $pair, $name, $value, %FORM);
# Read in text
$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$buffer = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
# Split information into name/value pairs
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%(..)/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
my $rest = "";
$first_name = $FORM{first_name};
$last_name = $FORM{last_name};
$inurl = $FORM{inurl};
my $voice = "";
if (defined $FORM{voice}) {
$voice = $FORM{voice};
$voice =~ s/%20/ /ig;
$voice =~ s/%2D/-/ig;
$voice =~ s/%2d/-/ig;
}
my $lang = "";
if (defined $FORM{lang}) {
$lang = $FORM{lang};
}
my $before_page = "";
my $allbutlastbit = "";
my $lastbit = (split '/', $ENV{REQUEST_URI})[-1];
my $page_url = 'http';
$page_url.='s' if $ENV{HTTPS};
$page_url.='://';
if ($ENV{SERVER_PORT} != 80) {
$before_page="$ENV{SERVER_NAME}:$ENV{SERVER_PORT}/";
$page_url.="$ENV{SERVER_NAME}:$ENV{SERVER_PORT}$ENV{REQUEST_URI}";
} else {
$before_page="$ENV{SERVER_NAME}/";
$page_url.="$ENV{SERVER_NAME}.$ENV{REQUEST_URI}";
}
if (length($lastbit) > 0) {
$allbutlastbit = substr($page_url, 0, (length($page_url) - length($lastbit)));
} else {
$allbutlastbit = $page_url;
}
if (length($inurl) == 0) {
$inurl = $inurl;
} else {
$inurl =~ s/%3A/:/ig;
$inurl =~ s/%2F/\//ig;
$inurl =~ s/%3F/?/ig;
$inurl =~ s/%26/&/ig;
my $ipage_url = $inurl;
my $ibefore_page = "";
my $iallbutlastbit = "";
my $ilastbit = (split '/', $inurl)[-1];
my $lenseven = (7 + length($ilastbit));
my $leneight = (8 + length($ilastbit));
my $leni = length($inurl);
if (length($ilastbit) > 0) {
if ($lenseven == $leni) {
$iallbutlastbit = "${inurl}/";
} elsif ($leneight == $leni) {
$iallbutlastbit = "${inurl}/";
} else {
$iallbutlastbit = substr($ipage_url, 0, (length($ipage_url) - length($ilastbit)));
}
} else {
$iallbutlastbit = $ipage_url;
}
my $ua = LWP::UserAgent->new(timeout => 10);
$ua->env_proxy;
my $response = $ua->get($inurl);
if ($response->is_success) {
my $dcont = $response->decoded_content;
#$dcont =~ s/html\>/div\>/ig;
#$dcont =~ s/body\>/div\>/ig;
$dcont =~ s/"\/\//"\/\//ig;
$dcont =~ s/"http/"http/ig;
$dcont =~ s/"file/"file/ig;
$dotdot = "..\/";
if (index($dcont, "rjmprogramming.com.au") >= 0) {
$allbutlastbit =~ s/:443//ig;
$allbutlastbit =~ s/\/cgi-bin\//\//ig;
if (substr($allbutlastbit, -1, 1) == "/") {
$allbutlastbit = substr($allbutlastbit, 0, (-1 + length($allbutlastbit)));
}
$dcont =~ s/"\//"${allbutlastbit}\//ig;
#$dcont =~ s/ src="/ src="..\//ig;
#$dcont =~ s/ href="/ href="..\//ig;
$dcont =~ s/ src="/ src="${dotdot}/ig;
$dcont =~ s/ action="/ action="${dotdot}/ig;
$dcont =~ s/ srcset="/ srcset="${dotdot}/ig;
$dcont =~ s/ href="/ href="${dotdot}/ig;
} else {
if (index($dcont, "wikipedia.org") >= 0) {
$dotdot =~ s/\/wiki\//\//ig;
${iallbutlastbit} =~ s/\/wiki\//\//ig;
} else {
$dotdot = $iallbutlastbit;
}
if (substr($iallbutlastbit, -1, 1) == "/") {
$iallbutlastbit = substr($iallbutlastbit, 0, (-1 + length($iallbutlastbit)));
}
$dcont =~ s/"\//"${iallbutlastbit}\//ig;
$dcont =~ s/ src="/ src="${dotdot}/ig;
$dcont =~ s/ srcset="/ srcset="${dotdot}/ig;
$dcont =~ s/ action="/ action="${dotdot}/ig;
$dcont =~ s/ href="/ href="${dotdot}/ig;
$dcont =~ s/url\("/url\("${dotdot}/ig;
$dcont =~ s/url\(portal\//url\(${dotdot}portal\//ig;
$dcont =~ s/url\(static\//url\(${dotdot}static\//ig;
$dcont =~ s/url\(wiki\//url\(${dotdot}wiki\//ig;
$dcont =~ s/url\(er\//url\(${dotdot}er\//ig;
}
$dcont =~ s/"/"/ig;
$dcont =~ s/\r\n//ig;
$dcont =~ s/\n//ig;
$dcont =~ s/\r//ig;
# print "Content-type: text/html\n\n";
$rest .= "
";
}
#else {
# die $response->status_line;
#}
}
$blogp = $FORM{blogp};
$blogp =~ s/%2C/,/ig;
$blogi = $blogp;
my $blogt = $FORM{blogt};
$blogt =~ s/%2C/,/ig;
$oneletter = substr( $first_name, 0, 1 );
#my $uemoji = Unicode::Escape->new($FORM{emoji});
my $emoji = chr(0x0001F517); # "\xf0\x9f\x98\x80"; #$uemoji->unescape;
#my $ucutei = Unicode::Escape->new($FORM{cutei});
my $cutei = chr(0x0001F3C3); # "\xf0\x9f\x98\x80"; #$ucutei->unescape;
#my $uimgei = Unicode::Escape->new($FORM{imgei});
my $imgei = chr(0x0001F5BC); # "\xf0\x9f\x98\x80"; #$uimgei->unescape;
$dt = DateTime->now; # same as ( epoch => time )
$dttz = DateTime::TimeZone->new( name => 'local' )->name();
$dt->set_time_zone( $dttz );
$year = $dt->year;
$month = $dt->month; # 1-12
$day = $dt->day; # 1-31
$dow = $dt->day_of_week; # 1-7 (Monday is 1)
$hour = $dt->hour; # 0-23
$minute = $dt->minute; # 0-59
$second = $dt->second; # 0-61 (leap seconds!)
$doy = $dt->day_of_year; # 1-366 (leap years)
$doq = $dt->day_of_quarter; # 1..
$qtr = $dt->quarter; # 1-4
$dmy = $dt->dmy('/'); # 06/12/2002
$hms = $dt->hms; # 14:02:29
$tt = "";
$cont = "";
$oneletter = " ";
print "Content-type:text/html\r\n\r\n";
print "";
print "