Permalink
Browse files

new example: websockets

  • Loading branch information...
1 parent 4147add commit 2a7dd4958c9f582323ee5c536ee3c4a970de2d1e @zzzcpan committed Apr 21, 2012
@@ -0,0 +1,34 @@
+
+worker_processes 1;
+daemon off;
+master_process off;
+
+error_log /dev/stderr debug;
+
+events {
+ worker_connections 1024;
+}
+
+http {
+ default_type text/plain;
+
+ perl_inc ../../blib/lib;
+ perl_inc ../../blib/arch;
+
+ perl_inc lib;
+ perl_inc ../lib;
+
+ perl_require Websockets/Echo.pm;
+ perl_require Websockets/Draw.pm;
+
+ server {
+ listen 55555;
+
+ location /echo/ { perl_handler Websockets::Echo::handler; }
+ location /draw/ { perl_handler Websockets::Draw::handler; }
+
+ location = /echo { rewrite ^ /echo/ permanent; }
+ location = /draw { rewrite ^ /draw/ permanent; }
+ }
+}
+
@@ -0,0 +1,151 @@
+package Here::Template;
+
+=head1 NAME
+
+Here::Template - heredoc templates
+
+=head1 SYNOPSIS
+
+ use Here::Template;
+
+ print <<'TMPL';
+
+ Hello, my pid is <?= $$ ?>
+ Let's count to 10: <? for (1..10) { ?>$_ <? } ?>
+
+ TMPL
+
+=head1 DESCRIPTION
+
+Simple Filter::Util::Call based implementation of heredoc templates.
+
+To enable templates in some heredoc use quoted heredoc mark that contains
+B<TMPL>. Output is added to the buffer C<$here>. You can append data
+there as well:
+
+ print <<'TMPL';
+
+ Hello, my pid is <?= $$ ?>
+ Let's count to 10: <? for (1..10) { $here.= "$_" } ?>
+
+ TMPL
+
+=head1 EXPORT
+
+This module doesn't export anything by default.
+
+Special argument B<relaxed> can be used to disable strict and
+warnings inside templates. E.g.:
+
+ use strict;
+ use warnings;
+
+ use Here::Template 'relaxed';
+
+ print <<'TMPL';
+
+ Let's count to 10: <?
+ for $k (1..10) {
+ $here .= "$k ";
+ }
+ ?>
+
+ TMPL
+
+=cut
+
+our $VERSION = '0.2';
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use Filter::Util::Call;
+
+sub import {
+ my $ctl = $_[1] eq 'relaxed'
+ ? 'no strict; no warnings;' : '';
+
+ filter_add sub {
+
+ my $st = filter_read();
+
+ if ( m/ << \s* (['"]) ( [^\1]* TMPL [^\1]* ) \1 \s* /gcx ) {
+ my $q = $1;
+ my $eof = quotemeta $2;
+ my $start = quotemeta '<?';
+ my $out = '$here';
+ my $end = quotemeta '?>';
+
+ my $buf = substr($_, 0, pos($_) - length($&));
+ my $buf_end = substr($_, pos($_));
+
+ chomp($buf_end);
+
+ return $st
+ if /^\s*#/;
+
+ $_ = '';
+
+ # do { my $var = '
+ $buf .= "do{ $ctl \n".($out eq '$_' ? 'local' : 'my')." $out =$q";
+
+ while (1) {
+ $st = filter_read();
+
+ if (/ $start (=)? /gcx) {
+ my $echo = $1;
+
+ # foo bar\' baz
+ my $tmp = substr($_, 0, pos($_) - length($&));
+ $_ = substr($_, pos($_));
+ $tmp =~ s/$q/\\$q/g;
+ $buf .= $tmp;
+
+ $st = filter_read()
+ while !/ $end /gcx;
+
+ # '; ... ; $out .='
+ $tmp = substr($_, 0, pos($_) - length($&));
+ $_ = substr($_, pos($_));
+ $buf .= "$q; ".
+ ($echo ? "$out.=$tmp" : "$tmp").
+ "; $out .=$q";
+ }
+
+ if (/ $eof /gcx) {
+ my $tmp = substr($_, 0, pos($_) - length($&));
+ $_ = substr($_, pos($_));
+ $tmp =~ s/$q/\\$q/g;
+ $buf .= $tmp;
+
+ # '; $var }
+ $buf .= "$q; $out }";
+ $_ = $buf.$buf_end.$_;
+ last;
+ }
+
+ last
+ unless $st;
+ }
+ }
+
+ return $st;
+ };
+}
+
+
+=head1 AUTHOR
+
+Alexandr Gomoliako <zzz@zzz.org.ua>
+
+=head1 LICENSE
+
+Copyright 2011-2012 Alexandr Gomoliako. All rights reserved.
+
+This module is free software. It may be used, redistributed and/or modified
+under the same terms as perl itself.
+
+=cut
+
+1;
Oops, something went wrong.

0 comments on commit 2a7dd49

Please sign in to comment.