-
Notifications
You must be signed in to change notification settings - Fork 0
/
index.cgi
executable file
·140 lines (112 loc) · 3.38 KB
/
index.cgi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
#!/usr/bin/perl
# Run Sidef code inside the browser
use utf8;
use 5.018;
use strict;
#use autodie;
use CGI qw(:standard -utf8);
#use CGI::Carp qw(fatalsToBrowser);
use Capture::Tiny qw(capture);
use HTML::Entities qw(encode_entities);
# Path where Sidef exists (when not installed)
#use lib qw(/home/user/Sidef/lib);
# Limit the size of Sidef scripts to 500KB
$CGI::POST_MAX = 1024 * 500;
use Sidef;
binmode(STDOUT, ':utf8');
print header(
-charset => 'UTF-8',
'Referrer-Policy' => 'no-referrer',
'X-Frame-Options' => 'DENY',
'X-Xss-Protection' => '1; mode=block',
'X-Content-Type-Options' => 'nosniff',
),
start_html(
-lang => 'en',
-title => 'Sidef Programming Language',
-base => 'true',
-meta => {
'keywords' => 'sidef programming language web interface',
'viewport' => 'width=device-width, initial-scale=1.0',
},
-style => [{-src => 'css/main.css'}],
-script => [
{
-src => 'js/jquery-3.6.0.min.js',
},
{
-src => 'js/tabby.js',
},
{
-src => 'js/main.js',
},
],
);
print h1("Sidef");
print start_form(
-method => 'POST',
-action => 'index.cgi',
'accept-charset' => "UTF-8",
),
textarea(
-name => 'code',
-default => 'Write your code here...',
-rows => 10,
-columns => 80,
-onfocus => 'clearContents(this);',
),
br, submit(-name => "Run!"), end_form;
sub compile {
my ($sidef, $code) = @_;
my $errors = '';
local $SIG{__WARN__} = sub {
$errors .= join("\n", @_);
};
local $SIG{__DIE__} = sub {
$errors .= join("\n", @_);
};
my $ccode = eval { $sidef->compile_code($code, 'Perl') };
return ($ccode, $errors);
}
sub execute {
my ($sidef, $ccode) = @_;
my $errors = '';
local $SIG{__WARN__} = sub {
$errors .= join("\n", @_);
};
local $SIG{__DIE__} = sub {
$errors .= join("\n", @_);
};
my ($stdout, $stderr) = capture {
alarm 5;
$sidef->execute_perl($ccode);
alarm(0);
};
return ($stdout, $errors . $stderr);
}
if (param) {
if (defined(my $code = param('code'))) {
# Replace any newline characters with "\n"
$code =~ s/\R/\n/g;
my $sidef = Sidef->new(name => '-');
my ($ccode, $errors) = compile($sidef, $code);
if ($errors ne '') {
chomp($errors);
print pre(encode_entities($errors));
print hr;
$errors = '';
}
if (defined($ccode)) {
my ($output, $errors) = execute($sidef, $ccode);
if ($errors ne "") {
chomp($errors);
print pre(encode_entities($errors));
print hr;
}
if (defined $output and $output ne '') {
print pre(encode_entities($output));
}
}
}
}
print end_html;