Initial commit

[app-web-comstock.git] / lib / App / Web / Comstock.pm

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