I want to modify Perl for 3 things.
- Preprocessor
- if,for,while without brackets
- Useful things like current ram or average load
For this three things I wrote this script :
#!/usr/bin/perl
use Getopt::Long;
use Inline 'C';
#option vars
my $o_print,$o_help,$o_file;
#vars
my $data,$search0,$search1,$search2,$replace;
#get options
GetOptions(
"p" => $o_print,
"h" => $o_help,
"f" => $o_file
);
#print help
if($o_help){
print "Perl++ Interpreter V0.01".$/;
print "-p print Perl++ converted to Perl".$/;
print "-f print Perl++ file".$/;
print "-h print help".$/;
exit;
}
#print file
if($o_file){print $ARGV[0].$/;exit;}
#load file
open (FILE, $ARGV[0]) or die $!;
while(<FILE>){
$data = $data.$_;
}
close (FILE);
#define special vars
my $vars = q#
°define @°free_ram°@ @`free | awk "NR == 2" | awk '{print $4}'`@
°define @°load_1°@ @`uptime | awk '{print $10}' | cut -d "," -f 1,2 | tr "," "."`@
°define @°load_5°@ @`uptime | awk '{print $11}' | cut -d "," -f 1,2 | tr "," "."`@
°define @°load_15°@ @`uptime | awk '{print $12}' | cut -d "," -f 1,2 | tr "," "."`@
#;
#run preprocessor for user defined vars
prep();
#add them to data
$data =$vars.$data;
#run preprocessor for default defined vars
prep();
#prepare if|for|while without brackets
while($data =~ /(.{2,})((.+))([ nr]{0,}[^;{]+;)/om){
$search0 = $1;
$search1 = $2;
$search2 = $3;
$data = repl_str($data,"$search0($search1)$search2","$search0($search1){$search2}");
}
#remove leading n
$data =~ s/^n//o;
#print or run
if($o_print){
print $data.$/;
}else{
eval $data;
warn $@ if $@;
}
sub prep {
while($data =~ /^°define (.)(.+)n/om){
$search0 = $1.$2;
(undef,$search1,undef,$search2) = split(/$1/, $search0);
$data = repl_str($data,"°define $search0n","");
$data = repl_str($data,$search1,$search2);
}
}
__END__
__C__
char* repl_str(const char *str, const char *old, const char *new){
char *ret, *r;
const char *p, *q;
size_t oldlen = strlen(old);
size_t count, retlen, newlen = strlen(new);
if (oldlen != newlen) {
for (count = 0, p = str; (q = strstr(p, old)) != NULL; p = q + oldlen)
count++;
retlen = p - str + strlen(p) + count * (newlen - oldlen);
} else
retlen = strlen(str);
if ((ret = malloc(retlen + 1)) == NULL)
return NULL;
for (r = ret, p = str; (q = strstr(p, old)) != NULL; p = q + oldlen) {
ptrdiff_t l = q - p;
memcpy(r, p, l);
r += l;
memcpy(r, new, newlen);
r += newlen;
}
strcpy(r, p);
return ret;
}
if you want to test it you have to save it at “/usr/bin/perlp”.
#!/usr/bin/perlp
use strict;
use warnings;
°define '1' '5'
°define "2" "6"
°define /3/ /7/
°define '4' '8'
print °free_ram°.$/;
if(1) print "true".$/;
for(1..10)print $_.$/;
print "1".$/;
print "2".$/;
print "3".$/;
print "4".$/;
In line 4-7 I define some values for replace.
Line 10 you cant print the current free ram, for this the script replace the token via bash script Free Ram or Load Average .
Line 13 and 16 you see that you can use if without brackets.
Line 18-21 it prints the changed values.