turn debug on/off

diff --git a/lib/PXElator/boolean.pm b/lib/PXElator/boolean.pm
new file mode 100644 (file)
index 0000000..60f6b68
--- /dev/null
+++ b/lib/PXElator/boolean.pm
@@ -0,0 +1,8 @@
+package boolean;
+
+sub toggle {
+       my $v = shift;
+       return $v ? 0 : 1;
+}
+
+1;

diff --git a/lib/PXElator/html.pm b/lib/PXElator/html.pm
new file mode 100644 (file)
index 0000000..0578060
--- /dev/null
+++ b/lib/PXElator/html.pm
@@ -0,0 +1,14 @@
+package html;
+
+sub table {
+       my $cols = shift;
+       my @td = map { "<td>$_</td>" } @_;
+       my $html = qq{<table>\n<tr>};
+       foreach ( 0 .. $#td ) {
+                       $html .= $td[$_];
+                       $html .= qq{</tr>\n<tr>} if $_ % $cols == 1;
+       }
+       $html .= qq{</tr>\n</table>};
+}
+
+1;

diff --git a/lib/PXElator/httpd.pm b/lib/PXElator/httpd.pm
index b869c33..a203176 100644 (file)
--- a/lib/PXElator/httpd.pm
+++ b/lib/PXElator/httpd.pm
@@ -17,6 +17,7 @@ use Carp qw/confess/;
 use File::Slurp;
 #use JSON;
 use IO::Socket::INET;
+use Module::Refresh;
 
 our $port = 7777;
 our $debug = 1;
@@ -24,6 +25,8 @@ our $debug = 1;
 use server;
 our $url = "http://$server::ip:$port/";
 
+use html;
+
 sub static {
        my ($client,$path) = @_;
 
@@ -50,7 +53,40 @@ sub static {
 
 my $ok = "HTTP/1.0 200 OK\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n";
 
+use boolean;
+
+sub get_request {
+       my ( $client, $path, $param ) = @_;
+
+       warn "get_request $client $path $param";
+
+       if ( my $found = static( $client,$path ) ) {
+               warn "static $found" if $debug;
+       } elsif ( $path eq '/' ) {
+               print $client $ok,
+               html::table( 2,
+                       'pid',   $$,
+                       'debug', qq|<a href=/our/debug/| . boolean::toggle($debug) . qq|>$debug</a>|,
+               );
+
+       } elsif ( $path =~ m{^/our/(\w+)/(\S+)} ) {
+               eval 'our $' . $1 . ' = ' . $2;
+               warn $@ if $@;
+               print $client qq|HTTP/1.1 302 Found\r\nLocation: $url\r\nContent-type: text/html\r\n\r\n<big>$1 = $2</big><br>Location: <a href="$url">$url</a>|;
+       } elsif ( $path =~ m{/boot} ) {
+               print $client qq{$ok
+#!gpxe
+imgfree
+login
+chain http://$server::ip:$httpd::port/
 
+                       };
+       } else {
+               print $client "HTTP/1.0 404 $path\r\nConnection: close\r\nContent-type: text/html\r\n\r\n<big>404 $path</big>";
+               warn "404 $path";
+       }
+
+}
 sub start {
 
        my $server = IO::Socket::INET->new(
@@ -58,9 +94,7 @@ sub start {
                        LocalPort => $httpd::port,
                        Listen    => SOMAXCONN,
                        Reuse     => 1
-       );
-                                                                         
-       die "can't setup server" unless $server;
+       ) || die "can't start server on $url: $!";
 
        print "url $url\n";
 
@@ -72,48 +106,32 @@ sub start {
 
                warn "request $request\n" if $debug;
 
+               Module::Refresh->refresh;
+
                if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
-                       my $method = $1;
+                       my $path = $1;
                        my $param;
-                       if ( $method =~ s{\?(.+)}{} ) {
+                       if ( $path =~ s{\?(.+)}{} ) {
                                foreach my $p ( split(/[&;]/, $1) ) {
                                        my ($n,$v) = split(/=/, $p, 2);
                                        $param->{$n} = $v;
                                }
                                warn "param: ",dump( $param ) if $debug;
                        }
-                       warn "method $method";
-
-                       if ( my $path = static( $client,$1 ) ) {
-                               warn "static $path" if $debug;
-                       } elsif ( $method eq '/' ) {
-                               print $client qq{$ok
-                                       pid <tt>$$</tt>
-                                       debug $debug
-                               };
-                               
-                       } elsif ( $method =~ m{/boot} ) {
-                               print $client qq{$ok
-#!gpxe
-imgfree
-login
-chain http://$server::ip:$httpd::port/
-
-                                       };
-                       } else {
-                               print $client "HTTP/1.0 404 Unkown method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n404 $request";
-                               warn "404 $request";
-                       }
+                       warn "path $path param: ",dump( $param );
+                       get_request $client, $path, $param;
                } else {
                        print $client "HTTP/1.0 500 No method\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n500 $request";
                        warn "500 $request";
                }
 
                print $client qq{
-               <a href="">reload</a>   
-               };
+               <div style="font-size: 80%; color: #888">
+               <a href="">reload</a>
+               <a href="/">index</a>
+               </div>
+               } if $client->connected;
 
-               close($client);
        }
 
        die "server died";

diff --git a/lib/PXElator/t/boolean.t b/lib/PXElator/t/boolean.t
new file mode 100755 (executable)
index 0000000..12d352b
--- /dev/null
+++ b/lib/PXElator/t/boolean.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use autodie;
+
+use Test::More tests => 2;
+
+use_ok 'boolean';
+
+
+ok( boolean::toggle(0), 'toggle' );

diff --git a/lib/PXElator/t/html.t b/lib/PXElator/t/html.t
new file mode 100755 (executable)
index 0000000..4bac0c4
--- /dev/null
+++ b/lib/PXElator/t/html.t
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use autodie;
+
+use Test::More tests => 2;
+
+use_ok 'html';
+
+ok( my $html = html::table( 2, qw/a1 a2 b1 b2 c1 c2/ ), 'table' );
+diag $html;
+

diff --git a/lib/PXElator/t/httpd.t b/lib/PXElator/t/httpd.t
new file mode 100755 (executable)
index 0000000..3db2000
--- /dev/null
+++ b/lib/PXElator/t/httpd.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use autodie;
+
+use Test::More tests => 2;
+
+use_ok 'httpd';
+
+ok( my $url = $httpd::url, 'url' );
+diag $url;