update for SDL::Event
[sdlgit/SDL-Site.git] / cgi-bin / sdl.cgi
1 #!/usr/bin/perl
2
3 use FindBin;
4 use lib $FindBin::RealBin.'/../code';
5 use Web::Simple 'SDL_Perl::WebSite';
6
7 sub SDL_Perl::WebSite::Page::html { ${+shift} }
8
9 package SDL_Perl::WebSite;
10
11 use HTML::Zoom;
12
13 default_config(
14   pages_dir => $FindBin::RealBin.'/../pages',
15   layout_file => $FindBin::RealBin.'/../layout.html',
16 );
17
18 sub page {
19   my ($self, $page) = @_;
20   my $file = $self->config->{pages_dir}.'/'.$page.'.html-inc';
21   return () unless -e $file;
22   return bless(
23     \do { local (@ARGV, $/) = $file; <> },
24     'SDL_Perl::WebSite::Page'
25   )
26 }
27
28 dispatch [
29   sub (GET + /) { redispatch_to '/index.html' },
30   sub (GET + /**/) {
31     redispatch_to join('/','',$_[1],'index.html');
32   },
33   sub (.html) {
34     filter_response { $self->render_html($_[1]) }
35   },
36   sub (GET + /**) {
37     $self->page($_[1])
38   },
39 ];
40
41 { my $DATA; sub _read_data { $DATA ||= do { local $/; <DATA>; } } }
42
43 sub layout_zoom {
44   my $self = shift;
45   $self->{layout_zoom} ||= do {
46     HTML::Zoom->from_string($self->_layout_html)
47   };
48 }
49
50 sub _layout_html {
51   my $self = shift;
52   my $file = $self->config->{layout_file};
53   if (-f $file) {
54     return do { local(@ARGV, $/) = ($file); <> }
55   } else {
56     return $self->_read_data
57   }
58 }
59
60 sub render_html {
61   my ($self, $data) = @_;
62   return $data if ref($data) eq 'ARRAY';
63   my ($zoom) = map {
64     if ($data->isa('SDL_Perl::WebSite::Page')) {
65       $_->with_selectors(
66         '#main' => {
67           -replace_content_raw => $data->html
68         }
69       );
70     } else {
71       die "WTF is ${data} supposed to be? A mallard?";
72     }
73   } ($self->layout_zoom);
74   $self->zoom_to_response($zoom);
75 }
76
77 sub zoom_to_response {
78   my ($self, $zoom) = @_;
79   open my $fh, '>', \my $out_str;
80   $zoom->render_to($fh);
81   return [
82     200,
83     [ 'Content-type' => 'text/html' ],
84     [ $out_str ]
85   ];
86 }
87
88
89 SDL_Perl::WebSite->run_if_script;
90 __DATA__
91 <html>
92   <body>
93     <div id="main"/>
94   </body>
95 </html>