Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

Choose your own Adventure - for Perl & Windows

by FreeBeerReekingMonk (Chaplain)
on Apr 10, 2017 at 18:30 UTC ( #1187583=CUFP: print w/replies, xml ) Need Help??

There is more than one way to Choose your own Adventure.

Abstract: Self contained single thread Perl webbrowserserver with dancer-like URL paths and moustache-like templates ... but only using core modules. It uses jquery and bootstrap Contains a simple way to write text and buttons
The basic HTML template comes after _END_ which is the end of the perl program. It is read as "<DATA>".

Step 1. Download and install Perl for Windows.

Step 2. Copy this file as to a directory on your harddrive.

Step 3. You can run the Perl script by double clicking on it. It will ask for Windows Firewall permissions. Make sure only "Private Networks" is selected and "Public networks" is not. Then press on "Allow access". Oh, and download an image from the web, call it title.jpg and put it in the same directory.

Step 4. Open a browser (preferably Firefox or Chrome, those do not complain about http://localhost being a security risk)

Step 5. Point your browser to: http://localhost:1337

Here is the code, scroll to the bottom for a "save" button

use strict; use warnings; use IO::Socket; my $DEBUG = 1; print "STARTING($0)\n" if $DEBUG; # first we define our story: our %I; sub get {$I{'GET'}{$_[0]} = $_[1]} my $DEFAULTS = '*'; get $DEFAULTS => { 'title' => "The Foo of the Bar Baz", 'label' => 'story', 'paragraph' => 'story', 'link' => '/', 'content-page' => qq( <div class="clearfix"></div> <div class="row"> <div class="col-md-12 col-sm-12 col-xs-12"> <div class="page"> <div class="title"> <h2>{{title}}</h2> </div> <div class="clearfix"></div> <div id="paragraph"> {{paragraph}} </div> <div class="menupanel"> <br/> <div class="menu"> {{#button}} <a href="{{link}}" class="btn btn-primary" rol +e="button">{{label}}</a> {{/button}} </div> </div> </div> </div> </div> ), # Before and after parsing '(' => sub {my($page,$HAVE,$msg)=@_; return $msg }, ')' => sub {my($page,$HAVE,$msg)=@_; print "msg=$msg\nDmsg=$$msg\n" if $DEBUG; $$msg=~s{<div id="paragraph">([\s\S]*?)</div>}{PUTITBACKLATER} +; $_ = $1; if($_){ s{^\s*(\w)}{<span style="font-size: 150%">&nbsp;&nbsp; $1< +/span>}; s{\b(drunkard)\b}{<span title="Just a silly ol' drunkard"> +<b>$1</b></span>}gi; s{\b(pub)\b}{<span title="a tavern, really"><b>$1</b></spa +n>}gi; s{\b(cave)\b}{<span title="home sweat home... yup, it stin +ks"><b>$1</b></span>}gi; s{\b(dragon)\b}{<span title="The protagonist of this story +"><b>$1</b></span>}gi; s{\n\n}{<br/><br/>}gi; } $$msg =~ s{PUTITBACKLATER}{<div id="paragraph">$_</div>}; }, }; get '/' => { 'title' => 'The story of the Thirsty Dragon', 'paragraph' => "In a little cave, there once lived a dragon. It wa +s a scary dragon. Somewhat temperamental. And around it's abodes, the +re were small piles of skeletons. It was afternoon. And the dragon wa +s thirsty.", '&' => sub { my($page,$HAVE,$msg)=@_; $I{'HAVE'}{'STARTED'}++; $msg; }, 'button' => [ {'label' => 'Go out and drink', 'link' => '/outside'}, {'label' => 'Stay inside', 'link' => '/sleep'}, ], }; get '/sleep' => { 'title' => 'sleepy...', 'paragraph' => "And night fell, and the dragon got sleepy. He roll +ed up and fell asleep. Kind of a boring story, don't you think? How a +bout trying again?", '&' => sub { my($page,$HAVE,$msg)=@_; if($I{'HAVE'}{'STARTED'} > 1){ $I{$HAVE}{$page}->{'button'}[0]->{'label'} = "Not AGAIN! ( +$I{HAVE}{STARTED})"; } $msg; }, 'button' => [ {'label' => 'Try again', 'link' => '/'}, ], }; get '/outside' =>{ 'title' => 'Where to?', 'paragraph' => "Yes, well... I don't mind going to the pub, but I +could also go to the lake.", 'button' => [ {'label' => 'Go to the Pub', 'link' => '/pub'}, {'label' => 'Go to the Lake', 'link' => '/lake'}, ], }; get '/pub' =>{ 'title' => 'Dragons not welcome', 'paragraph' => "I will have to be careful though. Those humans do +not like dragons. And the pub is full of humans. Now, how do I disgui +se myself?", 'button' => [ {'label' => 'Put on a wig and walk like a chicken', 'link' => '/pubfrontchicken'}, {'label' => 'put on a hat and walk on back legs only', 'link' => '/pubfrontlegs'}, ], }; get '/pubfrontlegs' =>{ 'title' => 'A gentleman with a hat', 'paragraph' => "The dragon produces a gentleman's hat and puts it +on his head. he stands on his back legs, and starts walking towards t +he village. On the way, he picks up a stick, which he uses as a cane. + Suddenly he bumps into a drunkard. - Hic... pardon kind sir - And the drunkard walks off, a bottle in + his hand. You are now in a back alley, next to the pub. You can hear + laughter and loud noises. Want to try walking in from the main entra +nce, or use the back door?", 'button' => [ {'label' => 'Make a pompous entrance through the main gate...d +oor...whatever', 'link' => '/grandentrance'}, {'label' => 'sneak in through the side window', 'link' => '/sneak'}, ], }; # get '/pubfrontchicken' =>{ 'title' => 'Walk like an Egy^H^H^Hchicken', 'paragraph' => "This wig is too small, it barely covers the top of + the head of the Dragon. But that was all the props he had. He took a + deep breath, flapped his arms and walked towards the village. Near t +he village the dragon also started bobbing his head, like chickens do +. A drunkard gazed with open mouth and dropped his bottle. But nobody + else noticed. You are now in a back alley, next to the pub. You can +hear laughter and loud noises. Want to try walking in from the main e +ntrance, or use the back-door?", 'button' => [ {'label' => 'Make a pompous entrance through the main gate...d +oor...whatever', 'link' => '/grandentrance'}, {'label' => 'sneak in through the side window', 'link' => '/sneak'}, ], }; get '/grandentrance' =>{ 'title' => 'The grand entrance', 'paragraph' => "The dragon takes a deep breath, and walks into the + pub bobbing his head and flapping his arms. The bartender looks up a +nd points to a sign. The sign says 'No chickens allowed'. Patrons are + standing up towards you and shooing you out. Now you are standing in + the back alley. There is this other option: Use the window!", 'button' => [ {'label' => 'sneak in through the side window', 'link' => '/sneak'}, ], }; get '/sneak' =>{ 'title' => 'sneaking in', 'paragraph' => "This window is too small for dragons. You try to t +wist and shove. The window cracks and bends... you are stuck", 'button' => [ {'label' => 'look around', 'link' => '/lookaround'}, ], }; get '/lake' =>{ 'title' => 'Where to?', 'paragraph' => "Ah well... water is refreshing, although a bit bor +ing. The dragon drank, then returned to the cave to sleep", 'button' => [ {'label' => 'Go back to the cave', 'link' => '/sleep'}, ], }; get '/404' => sub { 'Sorry. This page has not been created yet. (press back on your br +owser)' }; # Some basic types we can serve. You can add your own of course. my %TYPES = ( 'PL' => "text/html", 'HTM' => "text/html", 'HTML' => "text/html", 'JS' => "text/javascript", 'CSS' => "text/css", 'ICO' => "image/", "GIF" => "image/gif", "JPEG" => "image/jpeg", "JPG" => "image/jpeg", "BMP" => "image/bmp", "PNG" => "image/png", "SVG" => "image/svg+xml", "SVGZ" => "image/svg+xml", 'TXT' => "text/plain", ); my %CFG = ( 'MYPORT' => 1337, 'MAXCONNECT' => 10 ); # read the html template at the end of this file (after __DATA__) in o +ne gulp { local $/; $CFG{'TEMPLATE'} = <DATA>; close DATA; }; my %ESC_LIST = ('&'=>'&amp;', '>'=>'&gt;', '<'=>'&lt;'); # open a listening port on your computer. Note: ports under 1000 requi +re Administrator/superuser rights. my $server = IO::Socket::INET->new( LocalPort => $CFG{'MYPORT'}, Type => SOCK_STREAM, Reuse => 1, Listen => $CFG{'MAXCONNECT'}, Timeout => 2 ) or die "Can not open port $CFG{'MYPORT'}: $!\n"; # Automatically start a webbrowser to http://localhost:$CFG{'MYPORT'} if( ($0 =~/.exe$/i) && ($^O eq 'MSWin32') ){ system("start","http://localhost:$CFG{'MYPORT'}"); } # This is an infinite loop. (press control C on the commandline to sto +p the webserver) while(1){ my ($client,$client_adress,%request,$type); while ( ($client,$client_adress) = $server->accept() ) { my $DATA = ''; my ($client_port, $client_iaddr) = sockaddr_in($client_adress) +; my $client_dot_ip = inet_ntoa($client_iaddr); my $client_name = gethostbyaddr($client_iaddr, AF_INET); print "\nAccepting $client_dot_ip:$client_port [$client_name] +(".(scalar localtime).")\n" if $DEBUG; eval { local $SIG{ALRM} = sub { die 'TIMEOUT'; }; alarm 1; # does not work, default is 5 seconds... hardcode +d somewhere $client->recv($_,2048); alarm 0; }; alarm 0; print "$$ Read ".length($_)." bytes:$_\n" if $DEBUG; # Normally, here we would fork and let the child process (new +process) # do all the work, while the program is free to keep listening + to new connections # As webbrowsers make several connections at once, this is alm +ost a requirement # but makes the program harder to understand. if($_){ m{^\s*(\w+)\s+(.+)\s+HTTP/(\d.\d)}; $request{METHOD} = uc $1; # GET $request{URL} = $2; # / $request{KEEPALIVE} = 1 if m{Keep-Alive}i; $_ = $request{URL}; $_ = '/404' if m/\.\./; # not so waterproof way of not acc +essing any file on disk $_ = '/' if m/^index.html$/i; if(m/\./){ $DATA = slurp('./'.$_) || ''; s/.*\.//; # leave extension only $type = uc($_); # the type of file is the extension na +me }else{ $DATA = jap($request{METHOD},$_); $type = "HTML"; } } my $HEADER = http_header("OK",length($DATA)||0,$TYPES{$type}, +$request{KEEPALIVE}); print "$HEADER\n" if $DEBUG; print $client $HEADER . $DATA; if($request{KEEPALIVE}){ print "KEEPALIVE\n" if $DEBUG; }else{ close($client); print "CONNECTION CLOSED\n" if $DEBUG; } } } # setup an http header string sub http_header { my ($returnvalue, $size, $ctype, $keepalive) = @_; my $HEADER = "HTTP/1.0 " . $returnvalue . Socket::CRLF . ($ctype ? "Content-Type: ". $ctype ."; charset=utf-8". Socke +t::CRLF : '') . (defined($size)? "Content-Length: ". $size . Socket::CRLF : +'') . "Connection: ". ($keepalive?'Keep-Alive':'close') . Socket:: +CRLF . Socket::CRLF; return $HEADER; } sub slurp{ return "" unless -r $_[0]; open(IN,'<:raw',$_[0]) or return ""; # Windows requires binmode local $/; my $X = <IN>; close IN; $X } sub jap{ my($HAVE,$page) = @_; my $msg; $page = '/404' unless $I{$HAVE}{$page}; my $me = $I{$HAVE}{$page}; my $default = $I{$HAVE}{$DEFAULTS}; print "page=$page;me=$me;\n" if $DEBUG; # Run the default before if(ref($default) eq 'HASH'){ &{$_}($page,$HAVE,\$msg) if $_=$default->{'('}; } # First load template, then use sub code if(ref($me) eq 'HASH'){ &{$_}($page,$HAVE,\$msg) if $_=$me->{'('}; if(($_=$me->{_}) && -f $_){ $msg = slurp $_ }elsif($_=$me->{'#'}){ $msg = $_; } if($_=$me->{'&'}){ $msg = &{$_}($page,$HAVE,$msg); } &{$_}($page,$HAVE,\$msg) if $_=$me->{')'}; } # If there is no msg, use the appended template $msg = $CFG{'TEMPLATE'} unless $msg; # use the function as a post processing or independant $msg genera +tor if(ref($_=$me) eq 'CODE'){ $msg = &{$_}($page,$HAVE,$msg); } # Moustache $msg = TinyMoustache($msg, $me, $default); # Run the default after if(ref($default) eq 'HASH'){ &{$_}($page,$HAVE,\$msg) if $_=$default->{')'}; } return $msg; } # $escaped_string = esc("string>with<possible>html") sub esc { $_ = $_[0]; s/([&<>])/$ESC_LIST{$1}/gex; $_ } # template language; a subset of Moustache # Escaped: {{var}} # Non-Escaped: {{{var}}} # Loops: {{#loop}} here add {{{var}}} or {{var}} then {{/loop}} sub TinyMoustache { my($TXT, $ME, $DEFAULTS) = @_; my $i = 1; do{ $TXT =~ s/\{\{([\#\^])\s*([\w\-]+)\s*\}\}([\s\S]*?)\{\{\/\s*\2 +\s*\}\}/loop($1,$2,$3,($ME->{$2}||$DEFAULTS->{$2}||""))/gem; $TXT =~ s/\{\{\{\s*([\w\-]+)\s*\}\}\}/$ME->{$1}||$DEFAULTS->{$ +1}||""/gme; $TXT =~ s/\{\{\s*([\w\-]+)\s*\}\}/esc($ME->{$1}||$DEFAULTS->{$ +1}||"")/gme unless $TXT=~/\{\{#/; }while($TXT=~/\{\{/ && $i--); $TXT; } # handle moustache {{^tag}} or {{#tag}} ... {{/tag}} sub loop { my($n,$a,$b,$t,$r)=@_; print "loop($n,$a,$b,$t,$r)\n" if $DEBUG; return ($t ? '' : $b) if $n eq '^'; $t = &$t($a,$b) if ref($t) eq 'CODE'; if(ref($t) eq 'ARRAY'){ print " loop ARRAY @$t\n" if $DEBUG; $DEBUG && print " >> $_\n" for (@$t); for my $x (@$t){ $r .= TinyMoustache($b,$x); } #$r .= TinyMoustache($b,$_) for @$t; }elsif(ref($t) eq 'SCALAR'){ $r = $t; }elsif(ref($t) eq 'SUB'){ $r = &$t($a,$b,$t); } $r; } __DATA__ <!DOCTYPE html> <html lang="en"> <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" +> <!-- Meta, title, CSS, favicons, etc. --> <meta charset="utf-8"> <meta http-equiv="X-UA-Compatible" content="IE=edge"> <meta name="viewport" content="width=device-width, initial-scale=1 +"> <title>{{title}}</title> <!-- Latest compiled and minified Bootstrap CSS --> <link rel="stylesheet" href=" +trap/3.3.7/css/bootstrap.min.css"> <!-- Font Awesome not used --> <!-- Custom Theme Style --> <link href="/css/custom.css" rel="stylesheet"> </head> <body class="nav-md"> <div class="container body"> <div class="main_container"> <!-- page content --> <div class="page-title"> <div class="title_left"> <img src="/title.jpg" height=50/> </div> </div> {{{content-page}}} <!-- footer content --> <footer> <div class="pull-right"> Story by Foo Bar &nbsp;</div> </footer> <!-- /footer content --> <!-- /page content --> </div> </div> <!-- jQuery library --> <script src=" +uery.min.js"></script> <!-- Latest compiled Bootstrap JavaScript --> <script type="text/javascript" src=" +m/bootstrap/3.3.7/js/bootstrap.min.js"></script> <!-- Custom Theme Scripts (does not exist) --> <script src="/js/custom.js"></script> </body> </html>

Ok, hopefully you made that work. Now, let's compile it to EXE!

6. Drop to the cmd command shell and go to your directory with

7. use pp to compile it: pp -o story.exe

8. Unfortunately, the executable requires extra code to run (on other machines that do not have Perl installed), you need the following files:
* perl524.dll (might have another version number, that is ok)
* libstdc++-6.dll
* libwinpthread-1.dll

To know where these files are located, use the following commandline command: where perl

you can ship your story.exe program (the is not required, it's inside the story.exe) with these DLL's

Have fun perusing and editing!

edits: incorporated windows check as suggested by afoken.

Replies are listed 'Best First'.
Re: Choose your own Adventure - for Perl & Windows
by afoken (Abbot) on Apr 11, 2017 at 17:31 UTC
    Self contained single thread Perl webbrowser

    Are you sure? I don't see anything looking like a browser, but much code that looks like a primitive web server.


    Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
      ... but it's right there:

      # Automatically start a webbrowser to http://localhost:$CFG{'MYPORT'} if($0 =~/.exe$/i){ system("start","http://localhost:$CFG{'MYPORT'}"); }

      And it starts any default OS browser defined by the user currently logged in (user friendly!)

      /joke Yes... a typo... should I fix the text or leave it in?

        # Automatically start a webbrowser to http://localhost:$CFG{'MYPORT'} if($0 =~/.exe$/i){ system("start","http://localhost:$CFG{'MYPORT'}"); }

        That won't work on Linux, *BSD, other Unixes (and yes, .exe is a legal file extension for a perl script on any Unix).

        The following code fragment correctly identifies Windows, and also starts the web browser if you run the bare perl script:

        if ($^O eq 'MSWin32') { system("start","http://localhost:$CFG{'MYPORT'}"); }

        Yes... a typo... should I fix the text or leave it in?

        You could use <strike></strike>.


        Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
Re: Choose your own Adventure - for Perl & Windows
by dasgar (Priest) on Apr 13, 2017 at 04:11 UTC

    To be honest, I didn't read through your posted code.

    What I'm confused about is if you're going to bundle your code into an executable so that it can be distributed to others and used on systems that don't have Perl installed, why limit yourself to only use core modules and why not bundle in the needed DLLs into the executable? I'm not saying that there's anything "wrong" with your approach. There's just a few aspects that differ from how I personally would do things - which would be to use whatever modules I want to and create an executable that doesn't need other files (such as DLLs) in order to be used.

    Here's a blog post where someone described the steps to use Strawberry Perl and PAR::Packer to package a Mojolicious app (including the required DLL files) into a stand alone executable.

    Just thought I'd share some info on another approach.

Re: Choose your own Adventure - for Perl & Windows
by RonW (Vicar) on Apr 12, 2017 at 21:07 UTC

    I think it's cool. I also see an opportunity for you to make a CPAN module or 2.

    Template::Moustache::Tiny, since there is no Moustache CPAN module.

    Maybe Dancer::Tiny

    Side note: Moustache is not, as it claims, logic-less. {{#tag}} is if or foreach. {{^tag}} is unless.

      There are CPAN modules for Moustache already available. Also, their marketing gimmick is just hyperbole: less logic, not void of logic.

        When I searched CPAN/MetaCPAN, I got 4 results that had nothing (as best I can tell) to do with Moustache templates. Just tried again and got the same 4 results.

Re:Choose your own Adventure - for Perl & Windows
by Anonymous Monk on Apr 10, 2017 at 22:29 UTC
    It's like you want to confuse people who want to make sane web apps. This is so not how you do it.

      Lighten up, Francis.

        No. We are perfectly free to criticize at this site, especially code like the OP posted which is: unmaintainable, non-robust, highly coupled and is clearly aimed to confuse others. It flies in the face of best practices and only serves as an example of how to write garbage.
      It looks like you want to propose a better way... I welcome your tutorial.

      Well. I present a gentle way to install Strawberry Perl executable, that sets the path for you, and registers .pl extensions to perl.exe... and then you double click on it and poof it works. Quick results. One file. All in there (well, I removed cookies, threading, and ssl). Sure, takes a while to understand, but everything is exposed, instead of hidden in perl-modules which also take time to grasp. I would double the installation time with Dancer or Mojo (due to the large amount of tests during the cpan install).

        "I welcome your tutorial."
        use strict; use warnings; use Mojolicious::Lite; my %pages = ( '/' => { title => 'Begin', blurb => 'This is where you begin.', choices => [ { text => 'Choice 1', link => '/foo' }, { text => 'Choice 2', link => '/bar' }, ], }, 'foo' => { title => 'Foo', blurb => 'This is what happens when you Foo.', choices => [ { text => 'End', link => '/end' }, ], }, 'bar' => { title => 'Foo', blurb => 'This is what happens when you Bar.', choices => [ { text => 'Restart', link => '/' }, { text => 'End', link => '/end' }, ], }, 'end' => { title => 'End', blurb => 'This is the end.', choices => [], }, ); get '/' => { template => 'index', %{ $pages{'/'} } }; get '/:key' => sub { my $c = shift; my $key = $c->param('key'); return $c->reply->not_found unless $pages{$key}; $c->render( template => 'index', %{ $pages{$key} } ); }; app->start; __DATA__ @@ index.html.ep <html> <head> <!-- links to bootstrap here --> <title><%= $title %></title> </head> <body> <div class="container"> <h1><%= $blurb %></h1> % for my $choice (@$choices) { <a href="<%= $choice->{link} %>" class="btn btn-primary" role="but +ton"><%= $choice->{text} %></a> % } </div> </body> </html>
        All that extra code you have is unnecessary.
        "I would double the installation time with Dancer or Mojo (due to the large amount of tests during the cpan install)."

        Don't run the tests then.

        "but everything is exposed, instead of hidden in perl-modules which also take time to grasp"

        That is a poor way of looking at things. Rather than expose your own solution which simply reinvents a wheel that was already produced, tested AND deployed ... you get to use a solution that maintained by someone else. Nothing is hidden.

        "Sure, takes a while to understand, "

        It takes LONGER to understand your code and more importantly, it will take longer to correct, improve and maintain your code base. Really, you should be ashamed for posting that crap here and you should be publicly berated for your attitude.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1187583]
Approved by herveus
Front-paged by Discipulus
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (6)
As of 2018-06-23 08:48 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (125 votes). Check out past polls.