Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

RFC: Web Presentations

by polettix (Vicar)
on Apr 06, 2007 at 02:04 UTC ( #608585=perlmeditation: print w/replies, xml ) Need Help??

Update: I started WWW::Slides from the base of this script.

Hi all,

I came up with an idea that I'd like to share with you, hoping for some feedback/suggestions. I did not find any reference to the tecnique I'm going to show, but it's probable that I didn't search well, so any pointer is appreciated as well.

Basically, it's a sistem to make presentations online. No, it's not "yet another text-to-html-slides" system - you have to prepare your html slides before. This is a system to present these slides online, with many listeners around the web and the presenter that controls the display of the different slides for each of them.

Strictly speaking this is not a Perl issue, but I realised it in Perl, of course :). Here comes the skeleton script:

#!/usr/bin/perl use strict; use warnings; use IO::Socket; use IO::Select; use Socket qw( sockaddr_in inet_ntoa ); # Socket to receive commands my $controllers_listener = IO::Socket::INET->new( Proto => 'udp', LocalPort => 50605, ReuseAddr => 1, ) or die "new socket: $!"; # Socket for listening to incoming connections my $clients_listener = IO::Socket::INET->new( Proto => 'tcp', LocalPort => 50605, ReuseAddr => 1, Listen => 3, ) or die "new socket: $!"; my %clients; # Use select to coordinate requests my $sel = IO::Select->new($controllers_listener, $clients_listener); my @slides = load_slides(); $|++; my $slide = 0; # Tracks current slide my %shown_marker_for; # Tracks slides sent to different clients my %callback_for = ( # Available commands 'first' => sub { goto_slide(0); }, 'last' => sub { goto_slide($#slides); }, 'next' => sub { goto_slide($slide + 1); }, previous => sub { goto_slide($slide - 1); }, show => sub { my $slide = shift; goto_slide($slide - 1) if $slide; }, ); # Main loop while (my @ready = $sel->can_read()) { FILEHANDLE: for my $fh (@ready) { if ($fh == $clients_listener) { # add new client my ($socket, $peer) = $clients_listener->accept(); exhaust_input($socket); # ignore input data $clients{$socket} = [$socket, $peer]; $sel->add($socket); activity($peer, 'client entered'); # Send the current slide print_header($socket); print_slide($socket, $slide); } ## end if ($fh == $clients_listener) elsif (exists $clients{$fh}) { # close connection activity($clients{$fh}[1], 'client exited'); $sel->remove($fh); $fh->close(); delete $clients{$fh}; } else { # Command received, via UDP # Command from controller my $peer = $fh->recv(my $command_string, 1500) or next FILEHANDLE; next FILEHANDLE unless $command_string; for my $command_line (split /\n+/, $command_string) { next unless $command_line =~ /\S/; my ($command, @args) = split /\s+/, $command_line; activity($peer, "trying command '$command_line'"); $callback_for{$command}->(@args) if exists $callback_for{$command}; } } ## end else [ if ($fh == $controllers_listener) } ## end for my $fh (@ready) } ## end while (@ready = $sel->can_read... # Log on STDOUT about what's happening sub activity { my ($peer, $msg) = @_; my ($port, $iaddr) = sockaddr_in($peer); my $addr = inet_ntoa($iaddr); print {*STDOUT} "$addr:$port - $msg\n"; return; } # Send header to the client sub print_header { my ($socket) = @_; print {$socket} "HTTP/1.1 200 OK\r\n"; print {$socket} "Content-type: text/html\r\n\r\n"; print {$socket} "<html><head></head><body>\n"; } ## end sub print_header sub hide_slide { my ($socket, $slide) = @_; print {$socket} "<style>#slide$slide { display: none }</style>\n"; } sub print_slide { my ($socket, $slide) = @_; if ($shown_marker_for{$socket}{$slide}) { # just resume print {$socket} "<style>#slide$slide { display: block }</style>\ +n"; } else { print {$socket} qq( <div id="slide$slide"> $slides[$slide] </div> ); } $shown_marker_for{$socket}{$slide} = 1; } ## end sub print_slide # Transition function, for each client hides the previous # and shows the new sub goto_slide { my ($new_slide) = @_; return unless $new_slide =~ /\A\d+\z/mxs; return unless $new_slide < @slides; my $old_slide = $slide; print {*STDOUT} "going to $new_slide from $old_slide\n"; for my $client (values %clients) { hide_slide($client->[0], $old_slide); print_slide($client->[0], $new_slide); } $slide = $new_slide; return; } ## end sub goto_slide # Eliminate input data coming from clients sub exhaust_input { my ($socket) = @_; my $sel = IO::Select->new($socket); while ($sel->can_read(0)) { $socket->sysread(my $input, 1500); return 0 unless length $input; } return 1; # for many reasons... } ## end sub exhaust_input # Dummy function, loads test slides after __END__ sub load_slides { local $/ = "\n----------\n"; chomp(@slides = <DATA>); return @slides; } __END__ <h1>This is slide 1</h1> Here you can find the contents for slide #1. You can insert images: <p> <img src=" +png" alt="Perl flowers" title="Perl flowers"> <p>as well as other elements: <ul> <li>a</li> <li>simple</li> <li>list</li> </ul> ---------- <h1>This is slide 2</h1> The contents are completely different here. <hr> <p> <img src=" +luzione.png" alt="solution" title="solution"> ---------- <h1>This is slide 3</h1> The contents are completely different here, with respect to the other two pages. <hr> <p> <img src="" alt="solution" title="solution"> <p>I live here!
Update: some bug fixes.


  • users connect with the browser to the given port (50605 in the example), starting an "infinite download", i.e. an HTTP streaming session;
  • the "speaker" can send commands via UDP messages (again, on port 50605), for example using netcat from the shell:
    shell$ netcat -q 0 -u 50605 <<<'next' shell$ netcat -q 0 -u 50605 <<<'next' shell$ netcat -q 0 -u 50605 <<<'next' shell$ netcat -q 0 -u 50605 <<<'first' shell$ netcat -q 0 -u 50605 <<<'show 2' shell$ netcat -q 0 -u 50605 <<<'previous' shell$ netcat -q 0 -u 50605 <<<'last'
    or using an ad-hoc Perl script, a CGI, etc. The supported commands are in the %callback_for hash.

Each slide is enclosed in a div with id "slideN", where N is the number of the slide (from 0). Each time a new slide is visited, the previuos one is hidden setting the display style of the div to "none". The script keeps track of already-sent slides, that can be re-visited with a simple style change (back to "display: block").

It's far from a good shape, of course. It has bugs (e.g. it does not handle client browser stops very well) and has a design that can be surely improved. For example, should it be implemented as a CGI? Comments and suggestions are welcome!!!

perl -ple'$_=reverse' <<<ti.xittelop@oivalf

Don't fool yourself.

Replies are listed 'Best First'.
Re: RFC: Web Presentations
by f00li5h (Chaplain) on Apr 06, 2007 at 03:20 UTC

    You're right, I was all set up for the disappointment of 'yet another text to html' type device, and it turned to be a party in my IP stack!

    Horah! frodo72++

    @_=qw; ask f00li5h to appear and remain for a moment of pretend better than a lifetime;;s;;@_[map hex,split'',B204316D8C2A4516DE];;y/05/os/&print;
Re: RFC: Web Presentations
by wazoox (Prior) on Apr 08, 2007 at 14:48 UTC
    That's great! I've made something roughly similar ten years ago, but I used html pragmas, like <meta http-equiv="Refresh" content="5; URL=self.html"> and <meta http-equiv="Pragma" CONTENT="no-cache"> :) horrid, isn't it ?

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://608585]
Approved by McDarren
Front-paged by Old_Gray_Bear
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (7)
As of 2021-06-22 18:12 GMT
Find Nodes?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)

    Results (108 votes). Check out past polls.