]>
iEval git - app-web-comstock.git/blob - Web/Comstock.pm
1 package App
:: Web
:: Comstock
;
6 our $VERSION = '0.000_001' ;
10 use HTML
:: TreeBuilder
;
11 use HTML
:: Element
:: Library
;
14 use POSIX qw
/strftime/ ;
16 sub HTML
:: Element
:: iter3
{
17 my ( $self , $data , $code ) = @_ ;
21 my $current = $orig -> clone ;
22 $code ->( $el , $current );
23 $prev -> postinsert ( $current );
29 sub HTML
:: Element
:: fid
{ shift -> look_down ( id
=> shift ) }
30 sub HTML
:: Element
:: fclass
{ shift -> look_down ( class => qr/\b$_[0]\b/ ) }
32 ##################################################
38 my $builder = HTML
:: TreeBuilder
-> new ;
39 $builder -> ignore_unknown ( 0 );
40 $builder -> parse_file ( "tmpl/ $_ [0].html" );
44 $index = parse_html
'index' ;
48 shift ->{ 'comstock.db' }
53 $li -> find ( 'a' )-> replace_content ( $data ->{ title
});
54 $li -> find ( 'a' )-> attr ( href
=> '?item=' . $data ->{ item
});
59 $ul -> find ( 'li' )-> iter3 ( $data , \
& nav_li
);
64 my $req = Plack
:: Request
-> new ( $env );
65 my $tree = $index -> clone ;
66 my @items = db
( $env )-> select ( items
=> '*' )-> hashes ;
69 for my $item ( @items ) {
70 $items { $item ->{ category
}} // = [];
71 push @
{ $items { $item ->{ category
}}}, $item
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' );
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 )
85 $tree -> fid ( 'book_div' )-> detach
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' ;
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
=> {
113 name
=> scalar $req -> param ( 'name' ),
114 begin_time
=> $begin ,
117 return [ 200 , [ 'Content-Type' => 'text/plain' ], [ 'Booking was successful' ]];
122 my $req = Plack
:: Request
-> new ( $env );
123 my $item = $req -> param ( 'item' );
125 $time -= $time % 86400 ;
126 my @bookings = db
( $env )-> select ( bookings
=> '*' , { item
=> $item , begin_time
=> { '>' , $time }}, 'begin_time' )-> hashes ;
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
};
132 [ 200 , [ 'Content-type' => 'text/plain' ], [ $ans ]]
137 enable
'ContentLength' ;
140 my $db = DBIx
:: Simple
-> connect ( $ENV { COMSTOCK_DSN
} // 'dbi:Pg:' );
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 ]]
148 return [ 500 , [ 'Content-type' => 'text/plain' ], [ " $res " ]]
151 mount
'/book' => \
& book_app
;
152 mount
'/view' => \
& view_app
;
153 mount
'/' => \
& display_app
;
164 App::Web::Comstock - Website for managing bookings of generic items
168 use App::Web::Comstock;
169 App::Web::Comstock->app
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.
179 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
181 =head1 COPYRIGHT AND LICENSE
183 Copyright (C) 2016 by Marius Gavrilescu
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.
This page took 0.072305 seconds and 4 git commands to generate.