experimental-projects/cgi-projects/sidef-simple-web-interface/index.cgi

#!/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;