3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-12-25 12:12:34 +01:00
pbot/modules/ideone.pl

804 lines
25 KiB
Perl
Raw Normal View History

#!/usr/bin/perl
License project under MPL2 This patch adds the file LICENSE which is the verbatim copy of the Mozilla Public License Version 2.0 as retreived from https://www.mozilla.org/media/MPL/2.0/index.815ca599c9df.txt on 2017-03-05. This patch also places license headers for the MPL2 type A variant of the license header in the following files: PBot/AntiFlood.pm PBot/BanTracker.pm PBot/BlackList.pm PBot/BotAdminCommands.pm PBot/BotAdmins.pm PBot/ChanOpCommands.pm PBot/ChanOps.pm PBot/Channels.pm PBot/Commands.pm PBot/DualIndexHashObject.pm PBot/EventDispatcher.pm PBot/FactoidCommands.pm PBot/FactoidModuleLauncher.pm PBot/Factoids.pm PBot/HashObject.pm PBot/IRCHandlers.pm PBot/IgnoreList.pm PBot/IgnoreListCommands.pm PBot/Interpreter.pm PBot/LagChecker.pm PBot/Logger.pm PBot/MessageHistory.pm PBot/MessageHistory_SQLite.pm PBot/NickList.pm PBot/PBot.pm PBot/Plugins.pm PBot/Plugins/AntiAway.pm PBot/Plugins/AntiKickAutoRejoin.pm PBot/Plugins/AntiRepeat.pm PBot/Plugins/AntiTwitter.pm PBot/Plugins/AutoRejoin.pm PBot/Plugins/Counter.pm PBot/Plugins/Quotegrabs.pm PBot/Plugins/Quotegrabs/Quotegrabs_Hashtable.pm PBot/Plugins/Quotegrabs/Quotegrabs_SQLite.pm PBot/Plugins/UrlTitles.pm PBot/Plugins/_Example.pm PBot/Refresher.pm PBot/Registerable.pm PBot/Registry.pm PBot/RegistryCommands.pm PBot/SQLiteLogger.pm PBot/SQLiteLoggerLayer.pm PBot/SelectHandler.pm PBot/StdinReader.pm PBot/Timer.pm PBot/Utils/ParseDate.pm PBot/VERSION.pm build/update-version.pl modules/acronym.pl modules/ago.pl modules/c11std.pl modules/c2english.pl modules/c2english/CGrammar.pm modules/c2english/c2eng.pl modules/c99std.pl modules/cdecl.pl modules/cfaq.pl modules/cjeopardy/IRCColors.pm modules/cjeopardy/QStatskeeper.pm modules/cjeopardy/Scorekeeper.pm modules/cjeopardy/cjeopardy.pl modules/cjeopardy/cjeopardy_answer.pl modules/cjeopardy/cjeopardy_filter.pl modules/cjeopardy/cjeopardy_hint.pl modules/cjeopardy/cjeopardy_qstats.pl modules/cjeopardy/cjeopardy_scores.pl modules/cjeopardy/cjeopardy_show.pl modules/codepad.pl modules/compiler_block.pl modules/compiler_client.pl modules/compiler_vm/Diff.pm modules/compiler_vm/cc modules/compiler_vm/compiler_client.pl modules/compiler_vm/compiler_server.pl modules/compiler_vm/compiler_server_vbox_win32.pl modules/compiler_vm/compiler_server_watchdog.pl modules/compiler_vm/compiler_vm_client.pl modules/compiler_vm/compiler_vm_server.pl modules/compiler_vm/compiler_watchdog.pl modules/compiler_vm/languages/_c_base.pm modules/compiler_vm/languages/_default.pm modules/compiler_vm/languages/bash.pm modules/compiler_vm/languages/bc.pm modules/compiler_vm/languages/bf.pm modules/compiler_vm/languages/c11.pm modules/compiler_vm/languages/c89.pm modules/compiler_vm/languages/c99.pm modules/compiler_vm/languages/clang.pm modules/compiler_vm/languages/clang11.pm modules/compiler_vm/languages/clang89.pm modules/compiler_vm/languages/clang99.pm modules/compiler_vm/languages/clangpp.pm modules/compiler_vm/languages/clisp.pm modules/compiler_vm/languages/cpp.pm modules/compiler_vm/languages/freebasic.pm modules/compiler_vm/languages/go.pm modules/compiler_vm/languages/haskell.pm modules/compiler_vm/languages/java.pm modules/compiler_vm/languages/javascript.pm modules/compiler_vm/languages/ksh.pm modules/compiler_vm/languages/lua.pm modules/compiler_vm/languages/perl.pm modules/compiler_vm/languages/python.pm modules/compiler_vm/languages/python3.pm modules/compiler_vm/languages/qbasic.pm modules/compiler_vm/languages/scheme.pm modules/compiler_vm/languages/server/_c_base.pm modules/compiler_vm/languages/server/_default.pm modules/compiler_vm/languages/server/c11.pm modules/compiler_vm/languages/server/c89.pm modules/compiler_vm/languages/server/c99.pm modules/compiler_vm/languages/server/clang.pm modules/compiler_vm/languages/server/clang11.pm modules/compiler_vm/languages/server/clang89.pm modules/compiler_vm/languages/server/clang99.pm modules/compiler_vm/languages/server/cpp.pm modules/compiler_vm/languages/server/freebasic.pm modules/compiler_vm/languages/server/haskell.pm modules/compiler_vm/languages/server/java.pm modules/compiler_vm/languages/server/qbasic.pm modules/compiler_vm/languages/server/tendra.pm modules/compiler_vm/languages/sh.pm modules/compiler_vm/languages/tendra.pm modules/compliment modules/cstd.pl modules/define.pl modules/dice_roll.pl modules/excuse.sh modules/expand_macros.pl modules/fnord.pl modules/funnyish_quote.pl modules/g.pl modules/gdefine.pl modules/gen_cfacts.pl modules/gencstd.pl modules/get_title.pl modules/getcfact.pl modules/google.pl modules/gspy.pl modules/gtop10.pl modules/gtop15.pl modules/headlines.pl modules/horoscope modules/horrorscope modules/ideone.pl modules/insult.pl modules/love_quote.pl modules/man.pl modules/map.pl modules/math.pl modules/prototype.pl modules/qalc.pl modules/random_quote.pl modules/seen.pl modules/urban modules/weather.pl modules/wikipedia.pl pbot.pl pbot.sh It is highly recommended that this list of files is reviewed to ensure that all files are the copyright of the sole maintainer of the repository. If any files with license headers contain the intellectual property of anyone else, it is recommended that a request is made to revise this patch or that the explicit permission of the co-author is gained to allow for the license of the work to be changed. I (Tomasz Kramkowski), the contributor, take no responsibility for any legal action taken against the maintainer of this repository for incorrectly claiming copyright to any work not owned by the maintainer of this repository.
2017-03-05 22:33:31 +01:00
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
# use warnings;
use strict;
use feature qw(switch);
use SOAP::Lite;
$SOAP::Constants::DO_NOT_USE_XML_PARSER = 1;
use IPC::Open2;
2010-05-08 03:51:57 +02:00
use HTML::Entities;
use Text::Balanced qw(extract_codeblock extract_delimited);
my $user = 'test';
my $pass = 'test';
my $soap = SOAP::Lite->new(proxy => 'http://ideone.com/api/1/service');
my $result;
my $MAX_UNDO_HISTORY = 100;
my $output = "";
my $nooutput = 'No output.';
my %languages = (
'Ada' => { 'id' => '7', 'name' => 'Ada (gnat-4.3.2)' },
2010-04-26 01:24:47 +02:00
'asm' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
'nasm' => { 'id' => '13', 'name' => 'Assembler (nasm-2.07)' },
'gas' => { 'id' => '45', 'name' => 'Assembler (gcc-4.3.4)' },
2010-04-26 01:24:47 +02:00
'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)' },
'mawk' => { 'id' => '105', 'name' => 'AWK (mawk) (mawk-1.3.3)' },
'Bash' => { 'id' => '28', 'name' => 'Bash (bash 4.0.35)' },
'bc' => { 'id' => '110', 'name' => 'bc (bc-1.06.95)' },
'Brainfuck' => { 'id' => '12', 'name' => 'Brainf**k (bff-1.0.3.1)' },
'bf' => { 'id' => '12', 'name' => 'Brainf**k (bff-1.0.3.1)' },
'gnu89' => { 'id' => '11', 'name' => 'C (gcc-4.3.4)' },
'C89' => { 'id' => '11', 'name' => 'C (gcc-4.3.4)' },
'C' => { 'id' => '11', 'name' => 'C (gcc-4.3.4)' },
'C#' => { 'id' => '27', 'name' => 'C# (gmcs 2.0.1)' },
'C++' => { 'id' => '1', 'name' => 'C++ (gcc-4.3.4)' },
'C99' => { 'id' => '34', 'name' => 'C99 strict (gcc-4.3.4)' },
'CLIPS' => { 'id' => '14', 'name' => 'CLIPS (clips 6.24)' },
'Clojure' => { 'id' => '111', 'name' => 'Clojure (clojure 1.1.0)' },
'COBOL' => { 'id' => '118', 'name' => 'COBOL (open-cobol-1.0)' },
'COBOL85' => { 'id' => '106', 'name' => 'COBOL 85 (tinycobol-0.65.9)' },
'clisp' => { 'id' => '32', 'name' => 'Common Lisp (clisp) (clisp 2.47)' },
'D' => { 'id' => '102', 'name' => 'D (dmd) (dmd-2.042)' },
'Erlang' => { 'id' => '36', 'name' => 'Erlang (erl-5.7.3)' },
'Forth' => { 'id' => '107', 'name' => 'Forth (gforth-0.7.0)' },
'Fortran' => { 'id' => '5', 'name' => 'Fortran (gfortran-4.3.4)' },
'Go' => { 'id' => '114', 'name' => 'Go (gc 2010-01-13)' },
'Haskell' => { 'id' => '21', 'name' => 'Haskell (ghc-6.8.2)' },
'Icon' => { 'id' => '16', 'name' => 'Icon (iconc 9.4.3)' },
'Intercal' => { 'id' => '9', 'name' => 'Intercal (c-intercal 28.0-r1)' },
'Java' => { 'id' => '10', 'name' => 'Java (sun-jdk-1.6.0.17)' },
'JS' => { 'id' => '35', 'name' => 'JavaScript (rhino) (rhino-1.6.5)' },
'JScript' => { 'id' => '35', 'name' => 'JavaScript (rhino) (rhino-1.6.5)' },
'JavaScript' => { 'id' => '35', 'name' => 'JavaScript (rhino) (rhino-1.6.5)' },
'JavaScript-rhino' => { 'id' => '35', 'name' => 'JavaScript (rhino) (rhino-1.6.5)' },
'JavaScript-spidermonkey' => { 'id' => '112', 'name' => 'JavaScript (spidermonkey) (spidermonkey-1.7)' },
'Lua' => { 'id' => '26', 'name' => 'Lua (luac 5.1.4)' },
'Nemerle' => { 'id' => '30', 'name' => 'Nemerle (ncc 0.9.3)' },
'Nice' => { 'id' => '25', 'name' => 'Nice (nicec 0.9.6)' },
'Ocaml' => { 'id' => '8', 'name' => 'Ocaml (ocamlopt 3.10.2)' },
'Pascal' => { 'id' => '22', 'name' => 'Pascal (fpc) (fpc 2.2.0)' },
'Pascal-fpc' => { 'id' => '22', 'name' => 'Pascal (fpc) (fpc 2.2.0)' },
'Pascal-gpc' => { 'id' => '2', 'name' => 'Pascal (gpc) (gpc 20070904)' },
'Perl' => { 'id' => '3', 'name' => 'Perl (perl 5.8.8)' },
'PHP' => { 'id' => '29', 'name' => 'PHP (php 5.2.11)' },
'Pike' => { 'id' => '19', 'name' => 'Pike (pike 7.6.86)' },
'Prolog' => { 'id' => '108', 'name' => 'Prolog (gnu) (gprolog-1.3.1)' },
'Prolog-gnu' => { 'id' => '108', 'name' => 'Prolog (gnu) (gprolog-1.3.1)' },
'Prolog-swi' => { 'id' => '15', 'name' => 'Prolog (swi) (swipl 5.6.64)' },
'Python' => { 'id' => '4', 'name' => 'Python (python 2.6.4)' },
'Python3' => { 'id' => '116', 'name' => 'Python3 (python-3.1.1)' },
'R' => { 'id' => '117', 'name' => 'R (R-2.9.2)' },
'Ruby' => { 'id' => '17', 'name' => 'Ruby (ruby 1.8.7)' },
'Scala' => { 'id' => '39', 'name' => 'Scala (Scalac 2.7.7)' },
'Scheme' => { 'id' => '33', 'name' => 'Scheme (guile) (guile 1.8.5)' },
'Smalltalk' => { 'id' => '23', 'name' => 'Smalltalk (gst 3.1)' },
'Tcl' => { 'id' => '38', 'name' => 'Tcl (tclsh 8.5.7)' },
'Unlambda' => { 'id' => '115', 'name' => 'Unlambda (unlambda-2.0.0)' },
'VB' => { 'id' => '101', 'name' => 'Visual Basic .NET (mono-2.4.2.3)' },
);
# C 11
# C99 34
# C++ 1
my %preludes = (
'34' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'11' => "#include <stdio.h>\n#include <stdlib.h>\n#include <string.h>\n#include <unistd.h>\n#include <math.h>\n#include <limits.h>\n#include <sys/types.h>\n#include <stdint.h>\n",
'1' => "#include <iostream>\n#include <cstdio>\n",
);
if ($#ARGV <= 0) {
print "Usage: cc [-lang=<language>] <code>\n";
exit 0;
}
my $nick = shift @ARGV;
my $code = join ' ', @ARGV;
my @last_code;
if (open FILE, "< ideone_last_code.txt") {
while (my $line = <FILE>) {
chomp $line;
push @last_code, $line;
}
close FILE;
}
if ($code =~ m/^\s*show\s*$/i) {
if (defined $last_code[0]) {
print "$nick: $last_code[0]\n";
} else {
print "$nick: No recent code to show.\n"
}
exit 0;
}
my $got_run;
if ($code =~ m/^\s*run\s*$/i) {
if (defined $last_code[0]) {
$code = $last_code[0];
$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;
while ($subcode =~ s/^\s*(and)?\s*undo//) {
splice @last_code, 0, 1;
if (not defined $last_code[0]) {
print "$nick: No more undos remaining.\n";
exit 0;
} else {
$code = $last_code[0];
$got_undo = 1;
}
}
my @replacements;
my $prevchange = $last_code[0];
my $got_changes = 0;
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;
}
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;
my $modifier = 'first';
$subcode =~ s/^\s*(and)?\s*//;
$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;
}
($e, $r) = extract_delimited($subcode, "'");
if (defined $e) {
$to = $e;
$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) {
when($_ eq 'all' ) {}
when($_ eq 'last' ) {}
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 $replacement = {};
$replacement->{'from'} = $from;
$replacement->{'to'} = $to;
$replacement->{'modifier'} = $modifier;
push @replacements, $replacement;
next;
}
if ($subcode =~ m/^\s*(and)?\s*s\/.*\//) {
$got_sub = 1;
$subcode =~ s/^\s*(and)?\s*s//;
my ($regex, $to);
my ($e, $r) = extract_delimited($subcode, '/');
if (defined $e) {
$regex = $e;
$regex =~ s/^\///;
$regex =~ s/\/$//;
$subcode = "/$r";
} else {
print "$nick: Unbalanced slashes. Usage: !cc s/regex/substitution/[gi] [and s/.../.../ [and ...]]\n";
exit 0;
}
($e, $r) = extract_delimited($subcode, '/');
if (defined $e) {
$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;
}
my $suffix;
$suffix = $1 if $subcode =~ s/^([^ ]+)//;
if (length $suffix and $suffix =~ m/[^gi]/) {
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;
}
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) {
$code =~ s/\$1/$a/g;
$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;
};
if ($@) {
print "$nick: $@\n";
exit 0;
}
if ($ret) {
$got_changes = 1;
}
$prevchange = $code;
}
if ($got_sub and not $got_changes) {
print "$nick: No substitutions made.\n";
exit 0;
} elsif ($got_sub and $got_changes) {
next;
}
last;
}
if ($#replacements > -1) {
@replacements = sort { $a->{'from'} cmp $b->{'from'} or $a->{'modifier'} <=> $b->{'modifier'} } @replacements;
my ($previous_from, $previous_modifier);
foreach my $replacement (@replacements) {
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 ($got_sub and not $got_changes) {
print "$nick: No replacements made.\n";
exit 0;
}
}
open FILE, "> ideone_last_code.txt";
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;
}
}
unless ($got_run) {
open FILE, ">> ideone_log.txt";
print FILE "$nick: $code\n";
}
my $lang = "C99";
$lang = $1 if $code =~ s/-lang=([^\b\s]+)//i;
$lang = "C" if $code =~ s/-nowarn[ings]*//i;
my $show_link = 0;
$show_link = 1 if $code =~ s/-showurl//i;
my $found = 0;
my @langs;
foreach my $l (sort { uc $a cmp uc $b } keys %languages) {
push @langs, sprintf(" %-30s => %s", $l, $languages{$l}{'name'});
if (uc $lang eq uc $l) {
$lang = $l;
$found = 1;
}
}
if (not $found) {
print "$nick: Invalid language '$lang'. Supported languages are:\n", (join ",\n", @langs), "\n";
exit 0;
}
my $input = "";
$input = $1 if $code =~ s/-input=(.*)$//i;
$code =~ s/#include <([^>]+)>/\n#include <$1>\n/g;
$code =~ s/#([^ ]+) (.*?)\\n/\n#$1 $2\n/g;
$code =~ s/#([\w\d_]+)\\n/\n#$1\n/g;
my $precode = $preludes{$languages{$lang}{'id'}} . $code;
$code = '';
if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 34) {
my $has_main = 0;
my $prelude = '';
$prelude = "$1$2" if $precode =~ s/^\s*(#.*)(#.*?[>\n])//s;
while ($precode =~ s/([ a-zA-Z0-9_*\[\]]+)\s+([a-zA-Z0-9_*]+)\s*\((.*?)\)\s*({.*)//) {
my ($ret, $ident, $params, $potential_body) = ($1, $2, $3, $4);
my @extract = extract_codeblock($potential_body, '{}');
my $body;
if (not defined $extract[0]) {
$output .= "error: unmatched brackets for function '$ident';\n";
$body = $extract[1];
} else {
$body = $extract[0];
$precode .= $extract[1];
}
$code .= "$ret $ident($params) $body\n\n";
$has_main = 1 if $ident eq 'main';
}
$precode =~ s/^\s+//;
$precode =~ s/\s+$//;
if (not $has_main) {
$code = "$prelude\n\n$code\n\nint main(int argc, char **argv) { $precode\n;\n return 0;}\n";
$nooutput = "Success [no output].";
} else {
$code = "$prelude\n\n$precode\n\n$code\n";
$nooutput = "No output.";
}
} else {
$code = $precode;
}
if ($languages{$lang}{'id'} == 1 or $languages{$lang}{'id'} == 11 or $languages{$lang}{'id'} == 35
or $languages{$lang}{'id'} == 27 or $languages{$lang}{'id'} == 10 or $languages{$lang}{'id'} == 34) {
$code = pretty($code)
}
$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 or $languages{$lang}{'id'} == 45;
$code =~ s/\|n/\n/g;
$code =~ s/^\s+//;
$code =~ s/\s+$//;
2010-04-26 04:53:52 +02:00
$result = get_result($soap->createSubmission($user, $pass, $code, $languages{$lang}{'id'}, $input, 1, 1));
my $url = $result->{link};
# wait for compilation/execution to complete
while (1) {
$result = get_result($soap->getSubmissionStatus($user, $pass, $url));
last if $result->{status} == 0;
sleep 1;
}
$result = get_result($soap->getSubmissionDetails($user, $pass, $url, 0, 0, 1, 1, 1));
my $COMPILER_ERROR = 11;
my $RUNTIME_ERROR = 12;
my $TIMELIMIT = 13;
2010-04-26 04:53:52 +02:00
my $SUCCESSFUL = 15;
my $MEMORYLIMIT = 17;
my $ILLEGAL_SYSCALL = 19;
my $INTERNAL_ERROR = 20;
2010-04-26 04:53:52 +02:00
# signals extracted from ideone.com
my @signame;
$signame[0] = 'SIGZERO';
$signame[1] = 'SIGHUP';
$signame[2] = 'SIGINT';
$signame[3] = 'SIGQUIT';
$signame[4] = 'SIGILL';
$signame[5] = 'SIGTRAP';
$signame[6] = 'SIGABRT';
$signame[7] = 'SIGBUS';
$signame[8] = 'SIGFPE';
$signame[9] = 'SIGKILL';
$signame[10] = 'SIGUSR1';
$signame[11] = 'SIGSEGV';
$signame[12] = 'SIGUSR2';
$signame[13] = 'SIGPIPE';
$signame[14] = 'SIGALRM';
$signame[15] = 'SIGTERM';
$signame[16] = 'SIGSTKFLT';
$signame[17] = 'SIGCHLD';
$signame[18] = 'SIGCONT';
$signame[19] = 'SIGSTOP';
$signame[20] = 'SIGTSTP';
$signame[21] = 'SIGTTIN';
$signame[22] = 'SIGTTOU';
$signame[23] = 'SIGURG';
$signame[24] = 'SIGXCPU';
$signame[25] = 'SIGXFSZ';
$signame[26] = 'SIGVTALRM';
$signame[27] = 'SIGPROF';
$signame[28] = 'SIGWINCH';
$signame[29] = 'SIGIO';
$signame[30] = 'SIGPWR';
$signame[31] = 'SIGSYS';
$signame[32] = 'SIGNUM32';
$signame[33] = 'SIGNUM33';
$signame[34] = 'SIGRTMIN';
$signame[35] = 'SIGNUM35';
$signame[36] = 'SIGNUM36';
$signame[37] = 'SIGNUM37';
$signame[38] = 'SIGNUM38';
$signame[39] = 'SIGNUM39';
$signame[40] = 'SIGNUM40';
$signame[41] = 'SIGNUM41';
$signame[42] = 'SIGNUM42';
$signame[43] = 'SIGNUM43';
$signame[44] = 'SIGNUM44';
$signame[45] = 'SIGNUM45';
$signame[46] = 'SIGNUM46';
$signame[47] = 'SIGNUM47';
$signame[48] = 'SIGNUM48';
$signame[49] = 'SIGNUM49';
$signame[50] = 'SIGNUM50';
$signame[51] = 'SIGNUM51';
$signame[52] = 'SIGNUM52';
$signame[53] = 'SIGNUM53';
$signame[54] = 'SIGNUM54';
$signame[55] = 'SIGNUM55';
$signame[56] = 'SIGNUM56';
$signame[57] = 'SIGNUM57';
$signame[58] = 'SIGNUM58';
$signame[59] = 'SIGNUM59';
$signame[60] = 'SIGNUM60';
$signame[61] = 'SIGNUM61';
$signame[62] = 'SIGNUM62';
$signame[63] = 'SIGNUM63';
$signame[64] = 'SIGRTMAX';
$signame[65] = 'SIGIOT';
$signame[66] = 'SIGCLD';
$signame[67] = 'SIGPOLL';
$signame[68] = 'SIGUNUSED';
if ($result->{result} != $SUCCESSFUL or $languages{$lang}{'id'} == 13) {
$output .= $result->{cmpinfo};
$output =~ s/[\n\r]/ /g;
}
if ($result->{result} == $RUNTIME_ERROR) {
2010-04-26 04:53:52 +02:00
$output .= "\n[Runtime error]";
if ($result->{signal}) {
2010-04-26 04:53:52 +02:00
$output .= "\n[Signal: $signame[$result->{signal}] ($result->{signal})]";
}
} else {
if ($result->{signal}) {
2010-04-26 04:53:52 +02:00
$output .= "\n[Exit code: $result->{signal}]";
}
}
if ($result->{result} == $TIMELIMIT) {
$output .= "\n[Time limit exceeded]";
}
if ($result->{result} == $MEMORYLIMIT) {
$output .= "\n[Out of memory]";
}
if ($result->{result} == $ILLEGAL_SYSCALL) {
$output .= "\n[Disallowed system call]";
}
if ($result->{result} == $INTERNAL_ERROR) {
$output .= "\n[Internal error]";
}
$output .= "\n" . $result->{stderr};
$output .= "\n" . $result->{output};
2010-05-08 03:51:57 +02:00
$output = decode_entities($output);
$output =~ s/cc1: warnings being treated as errors//;
$output =~ s/ Line \d+ ://g;
$output =~ s/ \(first use in this function\)//g;
$output =~ s/error: \(Each undeclared identifier is reported only once.*?\)//msg;
$output =~ s/prog\.c:[:\s\d]*//g;
$output =~ s/ld: warning: cannot find entry symbol _start; defaulting to [^ ]+//;
$output =~ s/error: (.*?) error/error: $1; error/msg;
my $left_quote = chr(226) . chr(128) . chr(152);
my $right_quote = chr(226) . chr(128) . chr(153);
$output =~ s/$left_quote/'/g;
$output =~ s/$right_quote/'/g;
$output = $nooutput if $output =~ m/^\s+$/;
2010-04-26 01:24:47 +02:00
unless ($got_run) {
print FILE localtime() . "\n";
print FILE "$nick: [ http://ideone.com/$url ] $output\n\n";
close FILE;
}
if ($show_link) {
print "$nick: [ http://ideone.com/$url ] $output\n";
} else {
print "$nick: $output\n";
}
# ---------------------------------------------
sub get_result {
my $result = shift @_;
use Data::Dumper;
if ($result->fault) {
print join ', ', $result->faultcode, $result->faultstring, $result->faultdetail;
exit 0;
} else {
if ($result->result->{error} ne "OK") {
print "error\n";
print Dumper($result->result->{error});
exit 0;
} else {
return $result->result;
}
}
}
sub pretty {
my $code = join '', @_;
my $result;
my $pid = open2(\*IN, \*OUT, 'astyle -xUpf');
2010-04-28 00:57:34 +02:00
print OUT "$code\n";
close OUT;
while (my $line = <IN>) {
$result .= $line;
}
close IN;
waitpid($pid, 0);
return $result;
}