]>
Commit | Line | Data |
---|---|---|
6e33dd68 MG |
1 | package App::Web::Oof; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | use utf8; | |
7 | use parent qw/Plack::Component/; | |
8 | ||
9 | our $VERSION = '0.000_001'; | |
10 | ||
11 | use DBIx::Simple; | |
12 | use HTML::TreeBuilder; | |
13 | use HTML::Element::Library; | |
14 | use JSON::MaybeXS qw/encode_json decode_json/; | |
15 | use Plack::Builder; | |
16 | use Plack::Request; | |
17 | ||
18 | sub HTML::Element::iter3 { | |
19 | my ($self, $data, $code) = @_; | |
20 | my $orig = $self; | |
21 | my $prev = $orig; | |
22 | for my $el (@$data) { | |
23 | my $current = $orig->clone; | |
24 | $code->($el, $current); | |
25 | $prev->postinsert($current); | |
26 | $prev = $current; | |
27 | } | |
28 | $orig->detach; | |
29 | } | |
30 | ||
31 | sub HTML::Element::fid { shift->look_down(id => shift) } | |
32 | sub HTML::Element::fclass { shift->look_down(class => qr/\b$_[0]\b/) } | |
33 | ||
34 | ################################################## | |
35 | ||
36 | my $db; | |
37 | my ($form, $continue, $order); | |
38 | ||
39 | { | |
40 | sub parse_html { | |
41 | my $builder = HTML::TreeBuilder->new; | |
42 | $builder->ignore_unknown(0); | |
43 | $builder->parse_file("tmpl/$_[0].html"); | |
44 | $builder | |
45 | } | |
46 | ||
47 | $form = parse_html 'form'; | |
48 | $continue = parse_html 'continue'; | |
49 | $order = parse_html 'order'; | |
50 | } | |
51 | ||
52 | sub stringify_money { sprintf "£%.2f", $_[0] / 100 } | |
53 | ||
54 | sub form_table_row { | |
55 | my ($data, $tr) = @_; | |
56 | $tr->fclass($_)->replace_content($data->{$_}) for qw/title subtitle stock/; | |
57 | $tr->fclass('price')->replace_content(stringify_money $data->{price}); | |
58 | $tr->fclass('title')->attr('data-product', $data->{product}); | |
59 | $tr->fclass('title')->attr('data-summary', $data->{summary}); | |
60 | $tr->look_down(_tag => 'input')->attr(max => $data->{stock}); | |
61 | $tr->look_down(_tag => 'input')->attr(name => 'quant'.$data->{product}); | |
62 | } | |
63 | ||
64 | sub form_app { | |
65 | my ($env) = @_; | |
66 | $db //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:'); | |
67 | ||
68 | my $data = $db->select(products => '*', {}, 'product')->hashes; | |
69 | my $tree = $form->clone; | |
70 | $tree->find('tbody')->find('tr')->iter3($data, \&form_table_row); | |
71 | ||
72 | [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]] | |
73 | } | |
74 | ||
75 | sub continue_table_row { | |
76 | my ($data, $tr) = @_; | |
77 | $tr->fclass($_)->replace_content($data->{$_}) for qw/title subtitle quantity/; | |
78 | $tr->fclass('price')->replace_content(stringify_money $data->{subtotal}); | |
79 | $tr->fclass('title')->attr('data-product', $data->{product}); | |
80 | } | |
81 | ||
82 | sub continue_app { | |
83 | my ($env) = @_; | |
84 | $db //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:'); | |
85 | my $tree = $continue->clone; | |
86 | my $req = Plack::Request->new($env); | |
87 | my $params = $req->body_parameters; | |
88 | ||
89 | my ($quant, $total, @data, @notes); | |
90 | for (sort keys %$params) { | |
91 | next unless /^quant/; | |
92 | next unless $params->{$_}; | |
93 | my $data = $db->select(products => '*', {product => substr $_, 5})->hash; | |
94 | $data->{quantity} = $params->{$_}; | |
95 | if ($data->{stock} == 0) { | |
96 | push @notes, 'Item is out of stock and was removed from order: '.$data->{title}; | |
97 | next | |
98 | } | |
99 | if ($data->{quantity} > $data->{stock}) { | |
100 | $data->{quantity} = $data->{stock}; | |
101 | push @notes, 'Not enough units of "'.$data->{title}.'" available. Quantity reduced to '.$data->{quantity} | |
102 | } | |
103 | $data->{subtotal} = $data->{price} * $data->{quantity}; | |
104 | $quant += $data->{quantity}; | |
105 | $total += $data->{subtotal}; | |
106 | push @data, $data | |
107 | } | |
108 | ||
109 | $tree->fid('subtotal')->replace_content(stringify_money $total); | |
110 | my $dvalue; | |
111 | if ($params->{discount}) { | |
112 | my $discount = $db->select(discounts => '*', {discount => $params->{discount}})->hash; | |
113 | if (!defined $discount) { | |
114 | push @notes, 'Discount code incorrect. No discount applied.' | |
115 | } elsif ($db->select(orders => 'COUNT(*)', {discount => $params->{discount}})->list) { | |
116 | push @notes, 'Discount code already used once. No discount applied.' | |
117 | } else { | |
118 | $dvalue = int (0.5 + $discount->{fraction} * $total) if $discount->{fraction}; | |
119 | $dvalue = $discount->{flat} if $discount->{flat}; | |
120 | $tree->fid('discount')->replace_content('-'.stringify_money $dvalue); | |
121 | $total -= $dvalue; | |
122 | $tree->look_down(name => 'discount')->attr(value => $params->{discount}); | |
123 | push @notes, 'Discount applied.' | |
124 | } | |
125 | } | |
126 | $tree->look_down(name => 'discount')->detach unless $dvalue; | |
127 | $tree->fid('discount_tr')->detach unless $dvalue; | |
128 | my $postage = 220 + 50 * $quant; | |
129 | $tree->fid('postage')->replace_content(stringify_money $postage); | |
130 | $total += $postage; | |
131 | $tree->fid('total')->replace_content(stringify_money $total); | |
132 | ||
133 | $tree->fid('order')->find('tbody')->find('tr')->iter3(\@data, \&continue_table_row); | |
134 | $tree->iter($tree->fid('notes')->find('li') => @notes); | |
135 | ||
136 | $tree->look_down(name => 'products')->attr(value => encode_json \@data); | |
137 | $tree->look_down(name => 'total')->attr(value => $total); | |
138 | ||
139 | [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]] | |
140 | } | |
141 | ||
142 | sub order_app { | |
143 | my ($env) = @_; | |
144 | $db //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:'); | |
145 | my $tree = $order->clone; | |
146 | my $req = Plack::Request->new($env); | |
147 | my $id = sprintf "%X", time; # Not good enough! | |
148 | ||
149 | $db->begin_work; | |
150 | $db->insert(orders => {id => $id, %{$req->body_parameters}}); | |
151 | my $products = decode_json $req->body_parameters->{products}; | |
152 | for my $prod (@$products) { | |
153 | my $stock = $db->select(products => 'stock', {product => $prod->{product}})->list; | |
154 | die "Not enough of " .$prod->{title}."\n" if $prod->{quantity} > $stock; | |
155 | $db->update(products => {stock => $stock - $prod->{quantity}}, {product => $prod->{product}}); | |
156 | } | |
157 | $db->commit; | |
158 | ||
159 | $tree->fid('orderid')->replace_content($id); | |
160 | [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]] | |
161 | } | |
162 | ||
163 | sub app { | |
164 | builder { | |
165 | mount '/' => sub { [301, [Location => '/form'], []] }; | |
166 | mount '/form' => \&form_app; | |
167 | mount '/continue' => \&continue_app; | |
168 | mount '/order' => \&order_app; | |
169 | } | |
170 | } | |
171 | ||
172 | 1; | |
173 | __END__ | |
174 | ||
175 | =head1 NAME | |
176 | ||
177 | App::Web::Oof - Oversimplified order form / ecommerce website | |
178 | ||
179 | =head1 SYNOPSIS | |
180 | ||
181 | use App::Web::Oof; | |
182 | ||
183 | =head1 DESCRIPTION | |
184 | ||
185 | Oof (Oversimplified order form) is a very simple ecommerce website. | |
186 | As of this moment it is incomplete (although functional), hence the | |
187 | version number. | |
188 | ||
189 | =head1 AUTHOR | |
190 | ||
191 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
192 | ||
193 | =head1 COPYRIGHT AND LICENSE | |
194 | ||
195 | Copyright (C) 2016 by Marius Gavrilescu | |
196 | ||
197 | This library is free software; you can redistribute it and/or modify | |
198 | it under the same terms as Perl itself, either Perl version 5.22.1 or, | |
199 | at your option, any later version of Perl 5 you may have available. | |
200 | ||
201 | ||
202 | =cut |