lib/App/Web/Comstock.pm

   1 package App::Web::Comstock;
   2
   3 use 5.010000;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '0.000_001';
   7
   8 use DateTime;
   9 use DBIx::Simple;
  10 use HTML::TreeBuilder;
  11 use HTML::Element::Library;
  12 use Plack::Builder;
  13 use Plack::Request;
  14 use POSIX qw/strftime/;
  15
  16 sub HTML::Element::iter3 {
  17         my ($self, $data, $code) = @_;
  18         my $orig = $self;
  19         my $prev = $orig;
  20         for my $el (@$data) {
  21                 my $current = $orig->clone;
  22                 $code->($el, $current);
  23                 $prev->postinsert($current);
  24                 $prev = $current;
  25         }
  26         $orig->detach;
  27 }
  28
  29 sub HTML::Element::fid    { shift->look_down(id    => shift) }
  30 sub HTML::Element::fclass { shift->look_down(class => qr/\b$_[0]\b/) }
  31
  32 ##################################################
  33
  34 my ($index);
  35
  36 {
  37         sub parse_html {
  38                 my $builder = HTML::TreeBuilder->new;
  39                 $builder->ignore_unknown(0);
  40                 $builder->parse_file("tmpl/$_[0].html");
  41                 $builder
  42         }
  43
  44         $index = parse_html 'index';
  45 }
  46
  47 sub db : lvalue {
  48         shift->{'comstock.db'}
  49 }
  50
  51 sub nav_li {
  52         my ($data, $li) = @_;
  53         $li->find('a')->replace_content($data->{title});
  54         $li->find('a')->attr(href => '?item='.$data->{item});
  55 }
  56
  57 sub nav_ul {
  58         my ($data, $ul) = @_;
  59         $ul->find('li')->iter3($data, \&nav_li);
  60 }
  61
  62 sub display_app {
  63         my ($env) =  @_;
  64         my $req = Plack::Request->new($env);
  65         my $tree = $index->clone;
  66         my @items = db($env)->select(items => '*')->hashes;
  67         my %items;
  68
  69         for my $item (@items) {
  70                 $items{$item->{category}} //= [];
  71                 push @{$items{$item->{category}}}, $item
  72         }
  73
  74         my @data = sort { $a->[0]{category} cmp $b->[0]{category} } values %items; #map { $items{$_} } sort keys %items;
  75         $tree->fid('comstock_nav')->find('ul')->iter3(\@data, \&nav_ul);
  76         my $item = $req->param('item');
  77         if ($item) {
  78                 $tree->look_down(name => 'item')->attr(value => $item);
  79                 my ($begin, $end) = db($env)->select(items => [qw/begin_hour end_hour/], {item => $item})->list;
  80                 for my $name (qw/begin_hour end_hour/) {
  81                         my $select = $tree->look_down(name => $name);
  82                         $select->iter($select->find('option') => $begin .. $end)
  83                 }
  84         } else {
  85                 $tree->fid('book_div')->detach
  86         }
  87         $tree
  88 }
  89
  90 sub error {
  91         'Error: ' . $_[0]
  92 }
  93
  94 sub book_app {
  95         my ($env) = @_;
  96         my $req = Plack::Request->new($env);
  97         my ($begin_year, $begin_month, $begin_day) = split '/', $req->param('begin');
  98         my ($end_year, $end_month, $end_day) = split '/', $req->param('end');
  99         my $begin_hour = $req->param('begin_hour');
 100         my $end_hour = $req->param('end_hour');
 101         my $begin = DateTime->new(year => $begin_year, month => $begin_month, day => $begin_day, hour => $begin_hour)->epoch;
 102         my $end = DateTime->new(year => $end_year, month => $end_month, day => $end_day, hour => $end_hour)->epoch;
 103         my $item = 0+$req->param('item');
 104         my ($begin_range, $end_range, $min_hours, $max_hours) = db($env)->select(items => [qw/begin_hour end_hour min_hours max_hours/], {item => $item})->list or return error 'No such item';
 105
 106         return error 'End time is not later than begin time' if $end <= $begin;
 107         return error 'Begin/end hour not in allowed range' if $begin_hour < $begin_range || $begin_hour > $end_range || $end_hour < $begin_range || $end_hour > $end_range;
 108         return error 'Bookings must last for at least $min_hours hours' if (($end - $begin) / 3600 < $min_hours);
 109         return error 'Bookings must last for at most $max_hours hours' if (($end - $begin) / 3600 > $max_hours);
 110         return error 'Item is not available for the selected period' if db($env)->query('SELECT item FROM bookings WHERE item = ? AND (end_time - begin_time + ? - ?) > GREATEST(end_time, ?) - LEAST(begin_time, ?)', $item, $end, $begin, $end, $begin)->list;
 111         db($env)->insert(bookings => {
 112                 item => $item,
 113                 name => scalar $req->param('name'),
 114                 begin_time => $begin,
 115                 end_time => $end,
 116         });
 117         return [200, ['Content-Type' => 'text/plain'], ['Booking was successful']];
 118 }
 119
 120 sub view_app {
 121         my ($env) = @_;
 122         my $req = Plack::Request->new($env);
 123         my $item = $req->param('item');
 124         my $time = time;
 125         $time -= $time % 86400;
 126         my @bookings = db($env)->select(bookings => '*', {item => $item, begin_time => {'>', $time}}, 'begin_time')->hashes;
 127         my $ans;
 128         for my $booking (@bookings) {
 129                 $booking->{name} =~ y/\n//d;
 130                 $ans .= sprintf "%s -> %s  %s\n", strftime ('%c', gmtime $booking->{begin_time}), strftime ('%c', gmtime $booking->{end_time}), $booking->{name};
 131         }
 132         [200, ['Content-type' => 'text/plain'], [$ans]]
 133 }
 134
 135 sub app {
 136         builder {
 137                 enable 'ContentLength';
 138                 enable sub {
 139                         my $app = shift;
 140                         my $db = DBIx::Simple->connect($ENV{COMSTOCK_DSN} // 'dbi:Pg:');
 141                         sub {
 142                                 my ($env) = @_;
 143                                 db($env) = $db;
 144                                 my $res = $app->($env);
 145                                 return $res if ref $res eq 'ARRAY';
 146                                 return [200, ['Content-type' => 'text/html; charset=utf-8'], [$res->as_HTML]]
 147                                   if ref $res;
 148                                 return [500, ['Content-type' => 'text/plain'], ["$res"]]
 149                         }
 150                 };
 151                 mount '/book' => \&book_app;
 152                 mount '/view' => \&view_app;
 153                 mount '/'     => \&display_app;
 154         }
 155 }
 156
 157 1;
 158 __END__
 159
 160 =encoding utf-8
 161
 162 =head1 NAME
 163
 164 App::Web::Comstock - Website for managing bookings of generic items
 165
 166 =head1 SYNOPSIS
 167
 168   use App::Web::Comstock;
 169   App::Web::Comstock->app
 170
 171 =head1 DESCRIPTION
 172
 173 Comstock is an unfinished website for managing bookings of generic
 174 items. Users will be able to see the availability of existing items,
 175 book them for some periods and view existing bookings.
 176
 177 =head1 AUTHOR
 178
 179 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 180
 181 =head1 COPYRIGHT AND LICENSE
 182
 183 Copyright (C) 2016 by Marius Gavrilescu
 184
 185 This library is free software; you can redistribute it and/or modify
 186 it under the same terms as Perl itself, either Perl version 5.22.1 or,
 187 at your option, any later version of Perl 5 you may have available.
 188
 189
 190 =cut