--- /dev/null
+package App::Web::Comstock;
+
+use 5.010000;
+use strict;
+use warnings;
+our $VERSION = '0.000_001';
+
+use DateTime;
+use DBIx::Simple;
+use HTML::TreeBuilder;
+use HTML::Element::Library;
+use Plack::Builder;
+use Plack::Request;
+use POSIX qw/strftime/;
+
+sub HTML::Element::iter3 {
+ my ($self, $data, $code) = @_;
+ my $orig = $self;
+ my $prev = $orig;
+ for my $el (@$data) {
+ my $current = $orig->clone;
+ $code->($el, $current);
+ $prev->postinsert($current);
+ $prev = $current;
+ }
+ $orig->detach;
+}
+
+sub HTML::Element::fid { shift->look_down(id => shift) }
+sub HTML::Element::fclass { shift->look_down(class => qr/\b$_[0]\b/) }
+
+##################################################
+
+my ($index);
+
+{
+ sub parse_html {
+ my $builder = HTML::TreeBuilder->new;
+ $builder->ignore_unknown(0);
+ $builder->parse_file("tmpl/$_[0].html");
+ $builder
+ }
+
+ $index = parse_html 'index';
+}
+
+sub db : lvalue {
+ shift->{'comstock.db'}
+}
+
+sub nav_li {
+ my ($data, $li) = @_;
+ $li->find('a')->replace_content($data->{title});
+ $li->find('a')->attr(href => '?item='.$data->{item});
+}
+
+sub nav_ul {
+ my ($data, $ul) = @_;
+ $ul->find('li')->iter3($data, \&nav_li);
+}
+
+sub display_app {
+ my ($env) = @_;
+ my $req = Plack::Request->new($env);
+ my $tree = $index->clone;
+ my @items = db($env)->select(items => '*')->hashes;
+ my %items;
+
+ for my $item (@items) {
+ $items{$item->{category}} //= [];
+ push @{$items{$item->{category}}}, $item
+ }
+
+ my @data = sort { $a->[0]{category} cmp $b->[0]{category} } values %items; #map { $items{$_} } sort keys %items;
+ $tree->fid('comstock_nav')->find('ul')->iter3(\@data, \&nav_ul);
+ my $item = $req->param('item');
+ if ($item) {
+ $tree->look_down(name => 'item')->attr(value => $item);
+ my ($begin, $end) = db($env)->select(items => [qw/begin_hour end_hour/], {item => $item})->list;
+ for my $name (qw/begin_hour end_hour/) {
+ my $select = $tree->look_down(name => $name);
+ $select->iter($select->find('option') => $begin .. $end)
+ }
+ } else {
+ $tree->fid('book_div')->detach
+ }
+ $tree
+}
+
+sub error {
+ 'Error: ' . $_[0]
+}
+
+sub book_app {
+ my ($env) = @_;
+ my $req = Plack::Request->new($env);
+ my ($begin_year, $begin_month, $begin_day) = split '/', $req->param('begin');
+ my ($end_year, $end_month, $end_day) = split '/', $req->param('end');
+ my $begin_hour = $req->param('begin_hour');
+ my $end_hour = $req->param('end_hour');
+ my $begin = DateTime->new(year => $begin_year, month => $begin_month, day => $begin_day, hour => $begin_hour)->epoch;
+ my $end = DateTime->new(year => $end_year, month => $end_month, day => $end_day, hour => $end_hour)->epoch;
+ my $item = 0+$req->param('item');
+ 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';
+
+ return error 'End time is not later than begin time' if $end <= $begin;
+ 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;
+ return error 'Bookings must last for at least $min_hours hours' if (($end - $begin) / 3600 < $min_hours);
+ return error 'Bookings must last for at most $max_hours hours' if (($end - $begin) / 3600 > $max_hours);
+ 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;
+ db($env)->insert(bookings => {
+ item => $item,
+ name => scalar $req->param('name'),
+ begin_time => $begin,
+ end_time => $end,
+ });
+ return [200, ['Content-Type' => 'text/plain'], ['Booking was successful']];
+}
+
+sub view_app {
+ my ($env) = @_;
+ my $req = Plack::Request->new($env);
+ my $item = $req->param('item');
+ my $time = time;
+ $time -= $time % 86400;
+ my @bookings = db($env)->select(bookings => '*', {item => $item, begin_time => {'>', $time}}, 'begin_time')->hashes;
+ my $ans;
+ for my $booking (@bookings) {
+ $booking->{name} =~ y/\n//d;
+ $ans .= sprintf "%s -> %s %s\n", strftime ('%c', gmtime $booking->{begin_time}), strftime ('%c', gmtime $booking->{end_time}), $booking->{name};
+ }
+ [200, ['Content-type' => 'text/plain'], [$ans]]
+}
+
+sub app {
+ builder {
+ enable 'ContentLength';
+ enable sub {
+ my $app = shift;
+ my $db = DBIx::Simple->connect($ENV{COMSTOCK_DSN} // 'dbi:Pg:');
+ sub {
+ my ($env) = @_;
+ db($env) = $db;
+ my $res = $app->($env);
+ return $res if ref $res eq 'ARRAY';
+ return [200, ['Content-type' => 'text/html; charset=utf-8'], [$res->as_HTML]]
+ if ref $res;
+ return [500, ['Content-type' => 'text/plain'], ["$res"]]
+ }
+ };
+ mount '/book' => \&book_app;
+ mount '/view' => \&view_app;
+ mount '/' => \&display_app;
+ }
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+App::Web::Comstock - Website for managing bookings of generic items
+
+=head1 SYNOPSIS
+
+ use App::Web::Comstock;
+ App::Web::Comstock->app
+
+=head1 DESCRIPTION
+
+Comstock is an unfinished website for managing bookings of generic
+items. Users will be able to see the availability of existing items,
+book them for some periods and view existing bookings.
+
+=head1 AUTHOR
+
+Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2016 by Marius Gavrilescu
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.22.1 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
projects / app-web-comstock.git / commitdiff