mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-19 10:29:30 +01:00
ideone compiler: added run command to interactive editor
This commit is contained in:
Pragmatic Software
parent
0d5bf85f46
commit
023dd4bd09
@ -13,7 +13,7 @@ use warnings;
|
|||||||
# These are set automatically by the build/commit script
|
# These are set automatically by the build/commit script
|
||||||
use constant {
|
use constant {
|
||||||
BUILD_NAME => "PBot",
|
BUILD_NAME => "PBot",
|
||||||
BUILD_REVISION => 238,
|
BUILD_REVISION => 239,
|
||||||
BUILD_DATE => "2011-01-19",
|
BUILD_DATE => "2011-01-19",
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@ -24,6 +24,7 @@ my %languages = (
|
|||||||
'Ada' => { 'id' => '7', 'name' => 'Ada (gnat-4.3.2)' },
|
'Ada' => { 'id' => '7', 'name' => 'Ada (gnat-4.3.2)' },
|
||||||
'asm' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
'asm' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
||||||
'nasm' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
'nasm' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
||||||
|
'gas' => { 'id' => '45', 'name' => 'Assembler (gcc-4.3.4)' },
|
||||||
'Assembler' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
'Assembler' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
||||||
'Assembler' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
'Assembler' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
|
||||||
'gawk' => { 'id' => '104', 'name' => 'AWK (gawk) (gawk-3.1.6)' },
|
'gawk' => { 'id' => '104', 'name' => 'AWK (gawk) (gawk-3.1.6)' },
|
||||||
@ -118,398 +119,412 @@ if($code =~ m/^\s*show\s*$/i) {
|
|||||||
exit 0;
|
exit 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $subcode = $code;
|
my $got_run;
|
||||||
my $got_undo = 0;
|
|
||||||
my $got_sub = 0;
|
|
||||||
|
|
||||||
while($subcode =~ s/^\s*(and)?\s*undo//) {
|
if($code =~ m/^\s*run\s*$/i) {
|
||||||
splice @last_code, 0, 1;
|
if(defined $last_code[0]) {
|
||||||
if(not defined $last_code[0]) {
|
|
||||||
print "$nick: No more undos remaining.\n";
|
|
||||||
exit 0;
|
|
||||||
} else {
|
|
||||||
$code = $last_code[0];
|
$code = $last_code[0];
|
||||||
$got_undo = 1;
|
$got_run = 1;
|
||||||
|
} else {
|
||||||
|
print "$nick: No recent code to run.\n";
|
||||||
|
exit 0;
|
||||||
}
|
}
|
||||||
}
|
} else {
|
||||||
|
my $subcode = $code;
|
||||||
|
my $got_undo = 0;
|
||||||
|
my $got_sub = 0;
|
||||||
|
|
||||||
my @replacements;
|
while($subcode =~ s/^\s*(and)?\s*undo//) {
|
||||||
my $prevchange = $last_code[0];
|
splice @last_code, 0, 1;
|
||||||
my $got_changes = 0;
|
if(not defined $last_code[0]) {
|
||||||
|
print "$nick: No more undos remaining.\n";
|
||||||
while(1) {
|
|
||||||
$got_sub = 0;
|
|
||||||
$got_changes = 0;
|
|
||||||
|
|
||||||
if($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) {
|
|
||||||
my $modifier = 'first';
|
|
||||||
|
|
||||||
$subcode =~ s/^\s*(and)?\s*//;
|
|
||||||
$subcode =~ s/remove\s*([^']+)?\s*//i;
|
|
||||||
$modifier = $1 if defined $1;
|
|
||||||
$modifier =~ s/\s+$//;
|
|
||||||
|
|
||||||
my ($e, $r) = extract_delimited($subcode, "'");
|
|
||||||
|
|
||||||
my $text;
|
|
||||||
|
|
||||||
if(defined $e) {
|
|
||||||
$text = $e;
|
|
||||||
$text =~ s/^'//;
|
|
||||||
$text =~ s/'$//;
|
|
||||||
$subcode = "replace $modifier '$text' with ''$r";
|
|
||||||
} else {
|
|
||||||
print "$nick: Unbalanced single quotes. Usage: !cc remove [all, first, .., tenth, last] 'text' [and ...]\n";
|
|
||||||
exit 0;
|
exit 0;
|
||||||
|
} else {
|
||||||
|
$code = $last_code[0];
|
||||||
|
$got_undo = 1;
|
||||||
}
|
}
|
||||||
next;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if($subcode =~ s/^\s*(and)?\s*add '//) {
|
my @replacements;
|
||||||
$subcode = "'$subcode";
|
my $prevchange = $last_code[0];
|
||||||
|
my $got_changes = 0;
|
||||||
|
|
||||||
my ($e, $r) = extract_delimited($subcode, "'");
|
while(1) {
|
||||||
|
$got_sub = 0;
|
||||||
|
$got_changes = 0;
|
||||||
|
|
||||||
my $text;
|
if($subcode =~ m/^\s*(and)?\s*remove \s*([^']+)?\s*'/) {
|
||||||
|
my $modifier = 'first';
|
||||||
|
|
||||||
if(defined $e) {
|
$subcode =~ s/^\s*(and)?\s*//;
|
||||||
$text = $e;
|
$subcode =~ s/remove\s*([^']+)?\s*//i;
|
||||||
$text =~ s/^'//;
|
$modifier = $1 if defined $1;
|
||||||
$text =~ s/'$//;
|
$modifier =~ s/\s+$//;
|
||||||
$subcode = $r;
|
|
||||||
|
|
||||||
|
my ($e, $r) = extract_delimited($subcode, "'");
|
||||||
|
|
||||||
|
my $text;
|
||||||
|
|
||||||
|
if(defined $e) {
|
||||||
|
$text = $e;
|
||||||
|
$text =~ s/^'//;
|
||||||
|
$text =~ s/'$//;
|
||||||
|
$subcode = "replace $modifier '$text' with ''$r";
|
||||||
|
} else {
|
||||||
|
print "$nick: Unbalanced single quotes. Usage: !cc remove [all, first, .., tenth, last] 'text' [and ...]\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
if($subcode =~ s/^\s*(and)?\s*add '//) {
|
||||||
|
$subcode = "'$subcode";
|
||||||
|
|
||||||
|
my ($e, $r) = extract_delimited($subcode, "'");
|
||||||
|
|
||||||
|
my $text;
|
||||||
|
|
||||||
|
if(defined $e) {
|
||||||
|
$text = $e;
|
||||||
|
$text =~ s/^'//;
|
||||||
|
$text =~ s/'$//;
|
||||||
|
$subcode = $r;
|
||||||
|
|
||||||
|
$got_sub = 1;
|
||||||
|
$got_changes = 1;
|
||||||
|
|
||||||
|
if(not defined $prevchange) {
|
||||||
|
print "$nick: No recent code to append to.\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
$code = $prevchange;
|
||||||
|
$code =~ s/$/ $text/;
|
||||||
|
$prevchange = $code;
|
||||||
|
} else {
|
||||||
|
print "$nick: Unbalanced single quotes. Usage: !cc add 'text' [and ...]\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
if($subcode =~ m/^\s*(and)?\s*replace\s*([^']+)?\s*'.*'\s*with\s*'.*'/i) {
|
||||||
$got_sub = 1;
|
$got_sub = 1;
|
||||||
$got_changes = 1;
|
my $modifier = 'first';
|
||||||
|
|
||||||
if(not defined $prevchange) {
|
$subcode =~ s/^\s*(and)?\s*//;
|
||||||
print "$nick: No recent code to append to.\n";
|
$subcode =~ s/replace\s*([^']+)?\s*//i;
|
||||||
|
$modifier = $1 if defined $1;
|
||||||
|
$modifier =~ s/\s+$//;
|
||||||
|
|
||||||
|
my ($from, $to);
|
||||||
|
my ($e, $r) = extract_delimited($subcode, "'");
|
||||||
|
|
||||||
|
if(defined $e) {
|
||||||
|
$from = $e;
|
||||||
|
$from =~ s/^'//;
|
||||||
|
$from =~ s/'$//;
|
||||||
|
$from = quotemeta $from;
|
||||||
|
$subcode = $r;
|
||||||
|
$subcode =~ s/\s*with\s*//i;
|
||||||
|
} else {
|
||||||
|
print "$nick: Unbalanced single quotes. Usage: !cc replace 'from' with 'to' [and ...]\n";
|
||||||
exit 0;
|
exit 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
$code = $prevchange;
|
($e, $r) = extract_delimited($subcode, "'");
|
||||||
$code =~ s/$/ $text/;
|
|
||||||
$prevchange = $code;
|
|
||||||
} else {
|
|
||||||
print "$nick: Unbalanced single quotes. Usage: !cc add 'text' [and ...]\n";
|
|
||||||
exit 0;
|
|
||||||
}
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
|
|
||||||
if($subcode =~ m/^\s*(and)?\s*replace\s*([^']+)?\s*'.*'\s*with\s*'.*'/i) {
|
if(defined $e) {
|
||||||
$got_sub = 1;
|
$to = $e;
|
||||||
my $modifier = 'first';
|
$to =~ s/^'//;
|
||||||
|
$to =~ s/'$//;
|
||||||
|
$subcode = $r;
|
||||||
|
} else {
|
||||||
|
print "$nick: Unbalanced single quotes. Usage: !cc replace 'from' with 'to' [and replace ... with ... [and ...]]\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
$subcode =~ s/^\s*(and)?\s*//;
|
given($modifier) {
|
||||||
$subcode =~ s/replace\s*([^']+)?\s*//i;
|
when($_ eq 'all' ) {}
|
||||||
$modifier = $1 if defined $1;
|
when($_ eq 'last' ) {}
|
||||||
$modifier =~ s/\s+$//;
|
when($_ eq 'first' ) { $modifier = 1; }
|
||||||
|
when($_ eq 'second' ) { $modifier = 2; }
|
||||||
|
when($_ eq 'third' ) { $modifier = 3; }
|
||||||
|
when($_ eq 'fourth' ) { $modifier = 4; }
|
||||||
|
when($_ eq 'fifth' ) { $modifier = 5; }
|
||||||
|
when($_ eq 'sixth' ) { $modifier = 6; }
|
||||||
|
when($_ eq 'seventh') { $modifier = 7; }
|
||||||
|
when($_ eq 'eighth' ) { $modifier = 8; }
|
||||||
|
when($_ eq 'nineth' ) { $modifier = 9; }
|
||||||
|
when($_ eq 'tenth' ) { $modifier = 10; }
|
||||||
|
default { print "$nick: Bad replacement modifier '$modifier'; valid modifiers are 'all', 'first', 'second', ..., 'tenth', 'last'\n"; exit 0; }
|
||||||
|
}
|
||||||
|
|
||||||
my ($from, $to);
|
my $replacement = {};
|
||||||
my ($e, $r) = extract_delimited($subcode, "'");
|
$replacement->{'from'} = $from;
|
||||||
|
$replacement->{'to'} = $to;
|
||||||
|
$replacement->{'modifier'} = $modifier;
|
||||||
|
|
||||||
if(defined $e) {
|
push @replacements, $replacement;
|
||||||
$from = $e;
|
next;
|
||||||
$from =~ s/^'//;
|
|
||||||
$from =~ s/'$//;
|
|
||||||
$from = quotemeta $from;
|
|
||||||
$subcode = $r;
|
|
||||||
$subcode =~ s/\s*with\s*//i;
|
|
||||||
} else {
|
|
||||||
print "$nick: Unbalanced single quotes. Usage: !cc replace 'from' with 'to' [and ...]\n";
|
|
||||||
exit 0;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
($e, $r) = extract_delimited($subcode, "'");
|
if($subcode =~ m/^\s*(and)?\s*s\/.*\//) {
|
||||||
|
$got_sub = 1;
|
||||||
|
$subcode =~ s/^\s*(and)?\s*s//;
|
||||||
|
|
||||||
if(defined $e) {
|
my ($regex, $to);
|
||||||
$to = $e;
|
my ($e, $r) = extract_delimited($subcode, '/');
|
||||||
$to =~ s/^'//;
|
|
||||||
$to =~ s/'$//;
|
|
||||||
$subcode = $r;
|
|
||||||
} else {
|
|
||||||
print "$nick: Unbalanced single quotes. Usage: !cc replace 'from' with 'to' [and replace ... with ... [and ...]]\n";
|
|
||||||
exit 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
given($modifier) {
|
if(defined $e) {
|
||||||
when($_ eq 'all' ) {}
|
$regex = $e;
|
||||||
when($_ eq 'last' ) {}
|
$regex =~ s/^\///;
|
||||||
when($_ eq 'first' ) { $modifier = 1; }
|
$regex =~ s/\/$//;
|
||||||
when($_ eq 'second' ) { $modifier = 2; }
|
$subcode = "/$r";
|
||||||
when($_ eq 'third' ) { $modifier = 3; }
|
} else {
|
||||||
when($_ eq 'fourth' ) { $modifier = 4; }
|
print "$nick: Unbalanced slashes. Usage: !cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n";
|
||||||
when($_ eq 'fifth' ) { $modifier = 5; }
|
exit 0;
|
||||||
when($_ eq 'sixth' ) { $modifier = 6; }
|
}
|
||||||
when($_ eq 'seventh') { $modifier = 7; }
|
|
||||||
when($_ eq 'eighth' ) { $modifier = 8; }
|
|
||||||
when($_ eq 'nineth' ) { $modifier = 9; }
|
|
||||||
when($_ eq 'tenth' ) { $modifier = 10; }
|
|
||||||
default { print "$nick: Bad replacement modifier '$modifier'; valid modifiers are 'all', 'first', 'second', ..., 'tenth', 'last'\n"; exit 0; }
|
|
||||||
}
|
|
||||||
|
|
||||||
my $replacement = {};
|
($e, $r) = extract_delimited($subcode, '/');
|
||||||
$replacement->{'from'} = $from;
|
|
||||||
$replacement->{'to'} = $to;
|
|
||||||
$replacement->{'modifier'} = $modifier;
|
|
||||||
|
|
||||||
push @replacements, $replacement;
|
if(defined $e) {
|
||||||
next;
|
$to = $e;
|
||||||
}
|
$to =~ s/^\///;
|
||||||
|
$to =~ s/\/$//;
|
||||||
|
$subcode = $r;
|
||||||
|
} else {
|
||||||
|
print "$nick: Unbalanced slashes. Usage: !cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
if($subcode =~ m/^\s*(and)?\s*s\/.*\//) {
|
my $suffix;
|
||||||
$got_sub = 1;
|
$suffix = $1 if $subcode =~ s/^([^ ]+)//;
|
||||||
$subcode =~ s/^\s*(and)?\s*s//;
|
|
||||||
|
|
||||||
my ($regex, $to);
|
if(length $suffix and $suffix =~ m/[^gi]/) {
|
||||||
my ($e, $r) = extract_delimited($subcode, '/');
|
print "$nick: Bad regex modifier '$suffix'. Only 'i' and 'g' are allowed.\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
if(defined $prevchange) {
|
||||||
|
$code = $prevchange;
|
||||||
|
} else {
|
||||||
|
print "$nick: No recent code to change.\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
if(defined $e) {
|
my $ret = eval {
|
||||||
$regex = $e;
|
my $ret;
|
||||||
$regex =~ s/^\///;
|
my $a;
|
||||||
$regex =~ s/\/$//;
|
my $b;
|
||||||
$subcode = "/$r";
|
my $c;
|
||||||
} else {
|
my $d;
|
||||||
print "$nick: Unbalanced slashes. Usage: !cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n";
|
my $e;
|
||||||
exit 0;
|
my $f;
|
||||||
}
|
my $g;
|
||||||
|
my $h;
|
||||||
|
my $i;
|
||||||
|
my $before;
|
||||||
|
my $after;
|
||||||
|
|
||||||
($e, $r) = extract_delimited($subcode, '/');
|
if(not length $suffix) {
|
||||||
|
$ret = $code =~ s|$regex|$to|;
|
||||||
|
$a = $1;
|
||||||
|
$b = $2;
|
||||||
|
$c = $3;
|
||||||
|
$d = $4;
|
||||||
|
$e = $5;
|
||||||
|
$f = $6;
|
||||||
|
$g = $7;
|
||||||
|
$h = $8;
|
||||||
|
$i = $9;
|
||||||
|
$before = $`;
|
||||||
|
$after = $';
|
||||||
|
} elsif($suffix =~ /^i$/) {
|
||||||
|
$ret = $code =~ s|$regex|$to|i;
|
||||||
|
$a = $1;
|
||||||
|
$b = $2;
|
||||||
|
$c = $3;
|
||||||
|
$d = $4;
|
||||||
|
$e = $5;
|
||||||
|
$f = $6;
|
||||||
|
$g = $7;
|
||||||
|
$h = $8;
|
||||||
|
$i = $9;
|
||||||
|
$before = $`;
|
||||||
|
$after = $';
|
||||||
|
} elsif($suffix =~ /^g$/) {
|
||||||
|
$ret = $code =~ s|$regex|$to|g;
|
||||||
|
$a = $1;
|
||||||
|
$b = $2;
|
||||||
|
$c = $3;
|
||||||
|
$d = $4;
|
||||||
|
$e = $5;
|
||||||
|
$f = $6;
|
||||||
|
$g = $7;
|
||||||
|
$h = $8;
|
||||||
|
$i = $9;
|
||||||
|
$before = $`;
|
||||||
|
$after = $';
|
||||||
|
} elsif($suffix =~ /^ig$/ or $suffix =~ /^gi$/) {
|
||||||
|
$ret = $code =~ s|$regex|$to|gi;
|
||||||
|
$a = $1;
|
||||||
|
$b = $2;
|
||||||
|
$c = $3;
|
||||||
|
$d = $4;
|
||||||
|
$e = $5;
|
||||||
|
$f = $6;
|
||||||
|
$g = $7;
|
||||||
|
$h = $8;
|
||||||
|
$i = $9;
|
||||||
|
$before = $`;
|
||||||
|
$after = $';
|
||||||
|
}
|
||||||
|
|
||||||
if(defined $e) {
|
if($ret) {
|
||||||
$to = $e;
|
$code =~ s/\$1/$a/g;
|
||||||
$to =~ s/^\///;
|
$code =~ s/\$2/$b/g;
|
||||||
$to =~ s/\/$//;
|
$code =~ s/\$3/$c/g;
|
||||||
$subcode = $r;
|
$code =~ s/\$4/$d/g;
|
||||||
} else {
|
$code =~ s/\$5/$e/g;
|
||||||
print "$nick: Unbalanced slashes. Usage: !cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n";
|
$code =~ s/\$6/$f/g;
|
||||||
exit 0;
|
$code =~ s/\$7/$g/g;
|
||||||
}
|
$code =~ s/\$8/$h/g;
|
||||||
|
$code =~ s/\$9/$i/g;
|
||||||
|
$code =~ s/\$`/$before/g;
|
||||||
|
$code =~ s/\$'/$after/g;
|
||||||
|
}
|
||||||
|
|
||||||
my $suffix;
|
return $ret;
|
||||||
$suffix = $1 if $subcode =~ s/^([^ ]+)//;
|
};
|
||||||
|
|
||||||
if(length $suffix and $suffix =~ m/[^gi]/) {
|
if($@) {
|
||||||
print "$nick: Bad regex modifier '$suffix'. Only 'i' and 'g' are allowed.\n";
|
print "$nick: $@\n";
|
||||||
exit 0;
|
exit 0;
|
||||||
}
|
|
||||||
if(defined $prevchange) {
|
|
||||||
$code = $prevchange;
|
|
||||||
} else {
|
|
||||||
print "$nick: No recent code to change.\n";
|
|
||||||
exit 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
my $ret = eval {
|
|
||||||
my $ret;
|
|
||||||
my $a;
|
|
||||||
my $b;
|
|
||||||
my $c;
|
|
||||||
my $d;
|
|
||||||
my $e;
|
|
||||||
my $f;
|
|
||||||
my $g;
|
|
||||||
my $h;
|
|
||||||
my $i;
|
|
||||||
my $before;
|
|
||||||
my $after;
|
|
||||||
|
|
||||||
if(not length $suffix) {
|
|
||||||
$ret = $code =~ s|$regex|$to|;
|
|
||||||
$a = $1;
|
|
||||||
$b = $2;
|
|
||||||
$c = $3;
|
|
||||||
$d = $4;
|
|
||||||
$e = $5;
|
|
||||||
$f = $6;
|
|
||||||
$g = $7;
|
|
||||||
$h = $8;
|
|
||||||
$i = $9;
|
|
||||||
$before = $`;
|
|
||||||
$after = $';
|
|
||||||
} elsif($suffix =~ /^i$/) {
|
|
||||||
$ret = $code =~ s|$regex|$to|i;
|
|
||||||
$a = $1;
|
|
||||||
$b = $2;
|
|
||||||
$c = $3;
|
|
||||||
$d = $4;
|
|
||||||
$e = $5;
|
|
||||||
$f = $6;
|
|
||||||
$g = $7;
|
|
||||||
$h = $8;
|
|
||||||
$i = $9;
|
|
||||||
$before = $`;
|
|
||||||
$after = $';
|
|
||||||
} elsif($suffix =~ /^g$/) {
|
|
||||||
$ret = $code =~ s|$regex|$to|g;
|
|
||||||
$a = $1;
|
|
||||||
$b = $2;
|
|
||||||
$c = $3;
|
|
||||||
$d = $4;
|
|
||||||
$e = $5;
|
|
||||||
$f = $6;
|
|
||||||
$g = $7;
|
|
||||||
$h = $8;
|
|
||||||
$i = $9;
|
|
||||||
$before = $`;
|
|
||||||
$after = $';
|
|
||||||
} elsif($suffix =~ /^ig$/ or $suffix =~ /^gi$/) {
|
|
||||||
$ret = $code =~ s|$regex|$to|gi;
|
|
||||||
$a = $1;
|
|
||||||
$b = $2;
|
|
||||||
$c = $3;
|
|
||||||
$d = $4;
|
|
||||||
$e = $5;
|
|
||||||
$f = $6;
|
|
||||||
$g = $7;
|
|
||||||
$h = $8;
|
|
||||||
$i = $9;
|
|
||||||
$before = $`;
|
|
||||||
$after = $';
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if($ret) {
|
if($ret) {
|
||||||
$code =~ s/\$1/$a/g;
|
$got_changes = 1;
|
||||||
$code =~ s/\$2/$b/g;
|
|
||||||
$code =~ s/\$3/$c/g;
|
|
||||||
$code =~ s/\$4/$d/g;
|
|
||||||
$code =~ s/\$5/$e/g;
|
|
||||||
$code =~ s/\$6/$f/g;
|
|
||||||
$code =~ s/\$7/$g/g;
|
|
||||||
$code =~ s/\$8/$h/g;
|
|
||||||
$code =~ s/\$9/$i/g;
|
|
||||||
$code =~ s/\$`/$before/g;
|
|
||||||
$code =~ s/\$'/$after/g;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
return $ret;
|
$prevchange = $code;
|
||||||
};
|
}
|
||||||
|
|
||||||
if($@) {
|
if($got_sub and not $got_changes) {
|
||||||
print "$nick: $@\n";
|
print "$nick: No substitutions made.\n";
|
||||||
exit 0;
|
exit 0;
|
||||||
|
} elsif($got_sub and $got_changes) {
|
||||||
|
next;
|
||||||
}
|
}
|
||||||
|
|
||||||
if($ret) {
|
last;
|
||||||
$got_changes = 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
$prevchange = $code;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if($got_sub and not $got_changes) {
|
if($#replacements > -1) {
|
||||||
print "$nick: No substitutions made.\n";
|
@replacements = sort { $a->{'from'} cmp $b->{'from'} or $a->{'modifier'} <=> $b->{'modifier'} } @replacements;
|
||||||
exit 0;
|
|
||||||
} elsif($got_sub and $got_changes) {
|
|
||||||
next;
|
|
||||||
}
|
|
||||||
|
|
||||||
last;
|
my ($previous_from, $previous_modifier);
|
||||||
}
|
|
||||||
|
|
||||||
if($#replacements > -1) {
|
foreach my $replacement (@replacements) {
|
||||||
@replacements = sort { $a->{'from'} cmp $b->{'from'} or $a->{'modifier'} <=> $b->{'modifier'} } @replacements;
|
my $from = $replacement->{'from'};
|
||||||
|
my $to = $replacement->{'to'};
|
||||||
|
my $modifier = $replacement->{'modifier'};
|
||||||
|
|
||||||
my ($previous_from, $previous_modifier);
|
if(defined $previous_from) {
|
||||||
|
if($previous_from eq $from and $previous_modifier =~ /^\d+$/) {
|
||||||
foreach my $replacement (@replacements) {
|
$modifier -= $modifier - $previous_modifier;
|
||||||
my $from = $replacement->{'from'};
|
}
|
||||||
my $to = $replacement->{'to'};
|
|
||||||
my $modifier = $replacement->{'modifier'};
|
|
||||||
|
|
||||||
if(defined $previous_from) {
|
|
||||||
if($previous_from eq $from and $previous_modifier =~ /^\d+$/) {
|
|
||||||
$modifier -= $modifier - $previous_modifier;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if(defined $prevchange) {
|
||||||
|
$code = $prevchange;
|
||||||
|
} else {
|
||||||
|
print "$nick: No recent code to change.\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $ret = eval {
|
||||||
|
my $got_change;
|
||||||
|
|
||||||
|
my ($first_char, $last_char, $first_bound, $last_bound);
|
||||||
|
$first_char = $1 if $from =~ m/^(.)/;
|
||||||
|
$last_char = $1 if $from =~ m/(.)$/;
|
||||||
|
|
||||||
|
if($first_char =~ /\W/) {
|
||||||
|
$first_bound = '.';
|
||||||
|
} else {
|
||||||
|
$first_bound = '\b';
|
||||||
|
}
|
||||||
|
|
||||||
|
if($last_char =~ /\W/) {
|
||||||
|
$last_bound = '\B';
|
||||||
|
} else {
|
||||||
|
$last_bound = '\b';
|
||||||
|
}
|
||||||
|
|
||||||
|
if($modifier eq 'all') {
|
||||||
|
while($code =~ s/($first_bound)$from($last_bound)/$1$to$2/) {
|
||||||
|
$got_change = 1;
|
||||||
|
}
|
||||||
|
} elsif($modifier eq 'last') {
|
||||||
|
if($code =~ s/(.*)($first_bound)$from($last_bound)/$1$2$to$3/) {
|
||||||
|
$got_change = 1;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
my $count = 0;
|
||||||
|
my $unescaped = $from;
|
||||||
|
$unescaped =~ s/\\//g;
|
||||||
|
if($code =~ s/($first_bound)$from($last_bound)/if(++$count == $modifier) { "$1$to$2"; } else { "$1$unescaped$2"; }/gex) {
|
||||||
|
$got_change = 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $got_change;
|
||||||
|
};
|
||||||
|
|
||||||
|
if($@) {
|
||||||
|
print "$nick: $@\n";
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
if($ret) {
|
||||||
|
$got_sub = 1;
|
||||||
|
$got_changes = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
$prevchange = $code;
|
||||||
|
$previous_from = $from;
|
||||||
|
$previous_modifier = $modifier;
|
||||||
}
|
}
|
||||||
|
|
||||||
if(defined $prevchange) {
|
if($got_sub and not $got_changes) {
|
||||||
$code = $prevchange;
|
print "$nick: No replacements made.\n";
|
||||||
} else {
|
|
||||||
print "$nick: No recent code to change.\n";
|
|
||||||
exit 0;
|
exit 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $ret = eval {
|
|
||||||
my $got_change;
|
|
||||||
|
|
||||||
my ($first_char, $last_char, $first_bound, $last_bound);
|
|
||||||
$first_char = $1 if $from =~ m/^(.)/;
|
|
||||||
$last_char = $1 if $from =~ m/(.)$/;
|
|
||||||
|
|
||||||
if($first_char =~ /\W/) {
|
|
||||||
$first_bound = '.';
|
|
||||||
} else {
|
|
||||||
$first_bound = '\b';
|
|
||||||
}
|
|
||||||
|
|
||||||
if($last_char =~ /\W/) {
|
|
||||||
$last_bound = '\B';
|
|
||||||
} else {
|
|
||||||
$last_bound = '\b';
|
|
||||||
}
|
|
||||||
|
|
||||||
if($modifier eq 'all') {
|
|
||||||
while($code =~ s/($first_bound)$from($last_bound)/$1$to$2/) {
|
|
||||||
$got_change = 1;
|
|
||||||
}
|
|
||||||
} elsif($modifier eq 'last') {
|
|
||||||
if($code =~ s/(.*)($first_bound)$from($last_bound)/$1$2$to$3/) {
|
|
||||||
$got_change = 1;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
my $count = 0;
|
|
||||||
my $unescaped = $from;
|
|
||||||
$unescaped =~ s/\\//g;
|
|
||||||
if($code =~ s/($first_bound)$from($last_bound)/if(++$count == $modifier) { "$1$to$2"; } else { "$1$unescaped$2"; }/gex) {
|
|
||||||
$got_change = 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return $got_change;
|
|
||||||
};
|
|
||||||
|
|
||||||
if($@) {
|
|
||||||
print "$nick: $@\n";
|
|
||||||
exit 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
if($ret) {
|
|
||||||
$got_sub = 1;
|
|
||||||
$got_changes = 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
$prevchange = $code;
|
|
||||||
$previous_from = $from;
|
|
||||||
$previous_modifier = $modifier;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if($got_sub and not $got_changes) {
|
open FILE, "> ideone_last_code.txt";
|
||||||
print "$nick: No replacements made.\n";
|
|
||||||
|
unless ($got_undo and not $got_sub) {
|
||||||
|
unshift @last_code, $code;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $i = 0;
|
||||||
|
foreach my $line (@last_code) {
|
||||||
|
last if(++$i > $MAX_UNDO_HISTORY);
|
||||||
|
print FILE "$line\n";
|
||||||
|
}
|
||||||
|
close FILE;
|
||||||
|
|
||||||
|
if($got_undo and not $got_sub) {
|
||||||
|
print "$nick: $code\n";
|
||||||
exit 0;
|
exit 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
open FILE, "> ideone_last_code.txt";
|
unless($got_run) {
|
||||||
|
open FILE, ">> ideone_log.txt";
|
||||||
unless ($got_undo and not $got_sub) {
|
print FILE "$nick: $code\n";
|
||||||
unshift @last_code, $code;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
my $i = 0;
|
|
||||||
foreach my $line (@last_code) {
|
|
||||||
last if(++$i > $MAX_UNDO_HISTORY);
|
|
||||||
print FILE "$line\n";
|
|
||||||
}
|
|
||||||
close FILE;
|
|
||||||
|
|
||||||
if($got_undo and not $got_sub) {
|
|
||||||
print "$nick: $code\n";
|
|
||||||
exit 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
open FILE, ">> ideone_log.txt";
|
|
||||||
print FILE "$nick: $code\n";
|
|
||||||
|
|
||||||
my $lang = "C99";
|
my $lang = "C99";
|
||||||
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i;
|
||||||
|
|
||||||
@ -584,8 +599,8 @@ if($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$
|
|||||||
$code = pretty($code)
|
$code = pretty($code)
|
||||||
}
|
}
|
||||||
|
|
||||||
$code =~ s/\\n/\n/g if $languages{$lang}{'id'} == 13 or $languages{$lang}{'id'} == 101;
|
$code =~ s/\\n/\n/g if $languages{$lang}{'id'} == 13 or $languages{$lang}{'id'} == 101 or $languages{$lang}{'id'} == 45;
|
||||||
$code =~ s/;/\n/g if $languages{$lang}{'id'} == 13;
|
$code =~ s/;/\n/g if $languages{$lang}{'id'} == 13 or $languages{$lang}{'id'} == 45;
|
||||||
$code =~ s/\|n/\n/g;
|
$code =~ s/\|n/\n/g;
|
||||||
$code =~ s/^\s+//;
|
$code =~ s/^\s+//;
|
||||||
$code =~ s/\s+$//;
|
$code =~ s/\s+$//;
|
||||||
@ -724,7 +739,7 @@ $output =~ s/cc1: warnings being treated as errors//;
|
|||||||
$output =~ s/ Line \d+ ://g;
|
$output =~ s/ Line \d+ ://g;
|
||||||
$output =~ s/ \(first use in this function\)//g;
|
$output =~ s/ \(first use in this function\)//g;
|
||||||
$output =~ s/error: \(Each undeclared identifier is reported only once.*?\)//msg;
|
$output =~ s/error: \(Each undeclared identifier is reported only once.*?\)//msg;
|
||||||
$output =~ s/prog\.c[:\d\s]*//g;
|
$output =~ s/prog\.c:[:\s\d]*//g;
|
||||||
$output =~ s/ld: warning: cannot find entry symbol _start; defaulting to [^ ]+//;
|
$output =~ s/ld: warning: cannot find entry symbol _start; defaulting to [^ ]+//;
|
||||||
$output =~ s/error: (.*?) error/error: $1; error/msg;
|
$output =~ s/error: (.*?) error/error: $1; error/msg;
|
||||||
|
|
||||||
@ -735,9 +750,11 @@ $output =~ s/$right_quote/'/g;
|
|||||||
|
|
||||||
$output = $nooutput if $output =~ m/^\s+$/;
|
$output = $nooutput if $output =~ m/^\s+$/;
|
||||||
|
|
||||||
print FILE localtime() . "\n";
|
unless($got_run) {
|
||||||
print FILE "$nick: [ http://ideone.com/$url ] $output\n\n";
|
print FILE localtime() . "\n";
|
||||||
close FILE;
|
print FILE "$nick: [ http://ideone.com/$url ] $output\n\n";
|
||||||
|
close FILE;
|
||||||
|
}
|
||||||
|
|
||||||
if($show_link) {
|
if($show_link) {
|
||||||
print "$nick: [ http://ideone.com/$url ] $output\n";
|
print "$nick: [ http://ideone.com/$url ] $output\n";
|
||||||
@ -750,12 +767,15 @@ if($show_link) {
|
|||||||
sub get_result {
|
sub get_result {
|
||||||
my $result = shift @_;
|
my $result = shift @_;
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
if($result->fault) {
|
if($result->fault) {
|
||||||
print join ', ', $result->faultcode, $result->faultstring, $result->faultdetail;
|
print join ', ', $result->faultcode, $result->faultstring, $result->faultdetail;
|
||||||
exit 0;
|
exit 0;
|
||||||
} else {
|
} else {
|
||||||
if($result->result->{error} ne "OK") {
|
if($result->result->{error} ne "OK") {
|
||||||
print $result->result->{error};
|
print "error\n";
|
||||||
|
print Dumper($result->result->{error});
|
||||||
exit 0;
|
exit 0;
|
||||||
} else {
|
} else {
|
||||||
return $result->result;
|
return $result->result;
|
||||||
@ -767,7 +787,7 @@ sub pretty {
|
|||||||
my $code = join '', @_;
|
my $code = join '', @_;
|
||||||
my $result;
|
my $result;
|
||||||
|
|
||||||
my $pid = open2(\*IN, \*OUT, 'astyle -Upf');
|
my $pid = open2(\*IN, \*OUT, 'astyle -xUpf');
|
||||||
print OUT "$code\n";
|
print OUT "$code\n";
|
||||||
close OUT;
|
close OUT;
|
||||||
while(my $line = <IN>) {
|
while(my $line = <IN>) {
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user