File Coverage

blib/lib/App/Web/Comstock.pm

Criterion	Covered	Total	%
statement	33	115	28.7
branch	0	18	0.0
condition	0	13	0.0
subroutine	11	23	47.8
pod	0	12	0.0
total	44	181	24.3

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__