diff --git a/MODULES b/MODULES index 95a2f135..2d1ab753 100644 --- a/MODULES +++ b/MODULES @@ -28,7 +28,6 @@ Module::Refresh Net::Dict Parse::RecDescent Proc::ProcessTable -SOAP::Lite String::LCSS Storable Text::Autoformat diff --git a/modules/ideone.pl b/modules/ideone.pl deleted file mode 100755 index 0cca8ed6..00000000 --- a/modules/ideone.pl +++ /dev/null @@ -1,773 +0,0 @@ -#!/usr/bin/perl - -# 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; -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)'}, - '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)'}, - '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 \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n", - '11' => - "#include \n#include \n#include \n#include \n#include \n#include \n#include \n#include \n", - '1' => "#include \n#include \n", -); - -if ($#ARGV <= 0) { - print "Usage: cc [-lang=] \n"; - exit 0; -} - -my $nick = shift @ARGV; -my $code = join ' ', @ARGV; -my @last_code; - -if (open FILE, "< ideone_last_code.txt") { - while (my $line = ) { - 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+$//; - -$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; -my $SUCCESSFUL = 15; -my $MEMORYLIMIT = 17; -my $ILLEGAL_SYSCALL = 19; -my $INTERNAL_ERROR = 20; - -# 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) { - $output .= "\n[Runtime error]"; - if ($result->{signal}) { $output .= "\n[Signal: $signame[$result->{signal}] ($result->{signal})]"; } -} else { - if ($result->{signal}) { $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}; - -$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+$/; - -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'); - print OUT "$code\n"; - close OUT; - while (my $line = ) { $result .= $line; } - close IN; - waitpid($pid, 0); - return $result; -}