Add product description on product page
[app-web-oof.git] / lib / App / Web / Oof.pm
CommitLineData
6e33dd68
MG
1package App::Web::Oof;
2
3use 5.014000;
4use strict;
5use warnings;
6use utf8;
7use parent qw/Plack::Component/;
8
b11f7d46 9our $VERSION = '0.000_004';
6e33dd68
MG
10
11use DBIx::Simple;
1576fc41 12use File::Slurp;
6e33dd68
MG
13use HTML::TreeBuilder;
14use HTML::Element::Library;
15use JSON::MaybeXS qw/encode_json decode_json/;
16use Plack::Builder;
17use Plack::Request;
1576fc41 18use Try::Tiny;
6e33dd68
MG
19
20sub HTML::Element::iter3 {
21 my ($self, $data, $code) = @_;
22 my $orig = $self;
23 my $prev = $orig;
24 for my $el (@$data) {
25 my $current = $orig->clone;
26 $code->($el, $current);
27 $prev->postinsert($current);
28 $prev = $current;
29 }
30 $orig->detach;
31}
32
33sub HTML::Element::fid { shift->look_down(id => shift) }
34sub HTML::Element::fclass { shift->look_down(class => qr/\b$_[0]\b/) }
35
36##################################################
37
1576fc41
MG
38my %db;
39my ($form, $continue, $order, $details, $pay);
6e33dd68
MG
40
41{
42 sub parse_html {
43 my $builder = HTML::TreeBuilder->new;
44 $builder->ignore_unknown(0);
45 $builder->parse_file("tmpl/$_[0].html");
46 $builder
47 }
48
49 $form = parse_html 'form';
50 $continue = parse_html 'continue';
51 $order = parse_html 'order';
1576fc41
MG
52 $details = parse_html 'details';
53 $pay = parse_html 'pay';
6e33dd68
MG
54}
55
56sub stringify_money { sprintf "£%.2f", $_[0] / 100 }
57
1576fc41
MG
58sub make_slug {
59 my $slug = $_[0];
60 $slug =~ y/ /-/;
61 $slug =~ y/a-zA-Z0-9-//cd;
62 $slug
63}
64
6e33dd68
MG
65sub form_table_row {
66 my ($data, $tr) = @_;
67 $tr->fclass($_)->replace_content($data->{$_}) for qw/title subtitle stock/;
68 $tr->fclass('price')->replace_content(stringify_money $data->{price});
8bbff1bc 69 $tr->fclass('freepost')->detach unless $data->{freepost};
6e33dd68 70 $tr->fclass('title')->attr('data-product', $data->{product});
1576fc41
MG
71 $tr->fclass('title')->attr('href', '/details/'.$data->{product}.'/'.make_slug $data->{title});
72# $tr->fclass('title')->attr('data-summary', $data->{summary});
6e33dd68
MG
73 $tr->look_down(_tag => 'input')->attr(max => $data->{stock});
74 $tr->look_down(_tag => 'input')->attr(name => 'quant'.$data->{product});
75}
76
77sub form_app {
78 my ($env) = @_;
1576fc41 79 $db{$$} //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
6e33dd68 80
1576fc41 81 my $data = $db{$$}->select(products => '*', {}, 'product')->hashes;
6e33dd68
MG
82 my $tree = $form->clone;
83 $tree->find('tbody')->find('tr')->iter3($data, \&form_table_row);
84
85 [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]]
86}
87
88sub continue_table_row {
89 my ($data, $tr) = @_;
90 $tr->fclass($_)->replace_content($data->{$_}) for qw/title subtitle quantity/;
8bbff1bc 91 $tr->fclass('freepost')->detach unless $data->{freepost};
6e33dd68
MG
92 $tr->fclass('price')->replace_content(stringify_money $data->{subtotal});
93 $tr->fclass('title')->attr('data-product', $data->{product});
94}
95
96sub continue_app {
97 my ($env) = @_;
1576fc41 98 $db{$$} //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
6e33dd68
MG
99 my $tree = $continue->clone;
100 my $req = Plack::Request->new($env);
101 my $params = $req->body_parameters;
102
8bbff1bc 103 my ($quant, $quant_freepost, $total, @data, @notes) = (0) x 3;
6e33dd68
MG
104 for (sort keys %$params) {
105 next unless /^quant/;
106 next unless $params->{$_};
1576fc41 107 my $data = $db{$$}->select(products => '*', {product => substr $_, 5})->hash;
6e33dd68
MG
108 $data->{quantity} = $params->{$_};
109 if ($data->{stock} == 0) {
110 push @notes, 'Item is out of stock and was removed from order: '.$data->{title};
111 next
112 }
113 if ($data->{quantity} > $data->{stock}) {
114 $data->{quantity} = $data->{stock};
115 push @notes, 'Not enough units of "'.$data->{title}.'" available. Quantity reduced to '.$data->{quantity}
116 }
117 $data->{subtotal} = $data->{price} * $data->{quantity};
118 $quant += $data->{quantity};
8bbff1bc 119 $quant_freepost += $data->{quantity} if $data->{freepost};
6e33dd68
MG
120 $total += $data->{subtotal};
121 push @data, $data
122 }
123
1576fc41
MG
124 return [500, ['Content-type' => 'text/plain'], ['Error: no items in order.']] unless $quant;
125
6e33dd68
MG
126 $tree->fid('subtotal')->replace_content(stringify_money $total);
127 my $dvalue;
128 if ($params->{discount}) {
1576fc41 129 my $discount = $db{$$}->select(discounts => '*', {discount => $params->{discount}})->hash;
6e33dd68
MG
130 if (!defined $discount) {
131 push @notes, 'Discount code incorrect. No discount applied.'
1576fc41 132 } elsif ($db{$$}->select(orders => 'COUNT(*)', {discount => $params->{discount}})->list) {
6e33dd68
MG
133 push @notes, 'Discount code already used once. No discount applied.'
134 } else {
135 $dvalue = int (0.5 + $discount->{fraction} * $total) if $discount->{fraction};
136 $dvalue = $discount->{flat} if $discount->{flat};
137 $tree->fid('discount')->replace_content('-'.stringify_money $dvalue);
138 $total -= $dvalue;
139 $tree->look_down(name => 'discount')->attr(value => $params->{discount});
140 push @notes, 'Discount applied.'
141 }
142 }
143 $tree->look_down(name => 'discount')->detach unless $dvalue;
144 $tree->fid('discount_tr')->detach unless $dvalue;
8bbff1bc
MG
145 my $postage = 220 + 50 * ($quant - $quant_freepost);
146 $postage = 0 if $quant == $quant_freepost;
6e33dd68
MG
147 $tree->fid('postage')->replace_content(stringify_money $postage);
148 $total += $postage;
149 $tree->fid('total')->replace_content(stringify_money $total);
150
151 $tree->fid('order')->find('tbody')->find('tr')->iter3(\@data, \&continue_table_row);
152 $tree->iter($tree->fid('notes')->find('li') => @notes);
153
154 $tree->look_down(name => 'products')->attr(value => encode_json \@data);
155 $tree->look_down(name => 'total')->attr(value => $total);
156
157 [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]]
158}
159
160sub order_app {
161 my ($env) = @_;
1576fc41 162 $db{$$} //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
6e33dd68
MG
163 my $tree = $order->clone;
164 my $req = Plack::Request->new($env);
1576fc41
MG
165 my ($id) = $env->{PATH_INFO} =~ m,^/([0-9A-F]+),;
166 if ($id) {
85e0d9a2
MG
167 my $total = $db{$$}->select(orders => 'total', {id => $id})->list or
168 return [500, ['Content-type', 'text/plain'], ['Order not found']];
1576fc41
MG
169 $tree->fid('orderid')->replace_content($id);
170 $tree->look_down(name => 'order')->attr(value => $id);
171 $tree->fid('total')->replace_content(stringify_money $total);
172 $tree->find('script')->attr('data-amount', $total);
173 return [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]]
174 } else {
175 my %parms = %{$req->body_parameters};
176 my $id = sprintf "%X%04X", time, $$;
177 my $err;
178 try {
179 $db{$$}->begin_work;
180 my $products = decode_json $req->body_parameters->{products};
181 for my $prod (@$products) {
182 my $stock = $db{$$}->select(products => 'stock', {product => $prod->{product}})->list;
183 die "Not enough of " .$prod->{title}."\n" if $prod->{quantity} > $stock;
184 $db{$$}->update(products => {stock => $stock - $prod->{quantity}}, {product => $prod->{product}});
185 }
186 $db{$$}->insert(orders => {id => $id, %parms});
187 $db{$$}->commit;
188 } catch {
189 $db{$$}->rollback;
190 $err = [500, ['Content-type', 'text/plain'], ["Error: $_"]]
191 };
192 return $err if $err;
193 return [303, [Location => "/order/$id"], []]
6e33dd68 194 }
1576fc41
MG
195}
196
5eeddbd0
MG
197sub cancel {
198 my ($order) = @_;
199 $db{$$} //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
200 $order = $db{$$}->select(orders => '*', {id => $order})->hash;
201 my $products = decode_json $order->{products};
202 $db{$$}->begin_work;
203 try {
204 for my $prod (@$products) {
205 my $stock = $db{$$}->select(products => 'stock', {product => $prod->{product}})->list;
206 $db{$$}->update(products => {stock => $stock + $prod->{quantity}}, {product => $prod->{product}});
207 }
208 $db{$$}->delete(orders => {id => $order->{id}});
209 $db{$$}->commit;
210 } catch {
211 $db{$$}->rollback;
212 die $_
213 }
214}
215
1576fc41
MG
216sub details_list_element {
217 my ($data, $li) = @_;
218 $li->find('a')->attr(href => "/$data");
219 my $thumb = $data =~ s/fullpics/thumbs/r;
220 $thumb = $data unless -f $thumb;
221 $li->find('img')->attr(src => "/$thumb");
222}
223
224sub details_app {
225 my ($env) = @_;
226 $db{$$} //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
227 my $tree = $details->clone;
228 my ($id) = $env->{PATH_INFO} =~ m,^/(\d+),;
b312852e 229 my ($title, $summary) = $db{$$}->select(products => [qw/title summary/], {product => $id})->list;
1576fc41
MG
230 my @pics = <static/fullpics/$id-*>;
231 my $slug = make_slug $title;
5d7b5400 232 $tree->find('title')->replace_content("Pictures of $title | ledparts4you");
1576fc41 233 $tree->find('h2')->replace_content($title);
b312852e 234 $tree->fid('summary')->replace_content($summary);
1576fc41 235 $tree->look_down(rel => 'canonical')->attr(href => "/details/$id/$slug");
b66954a0 236 $tree->fid('pictures')->find('li')->iter3(\@pics, \&details_list_element);
6e33dd68 237
6e33dd68
MG
238 [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]]
239}
240
1576fc41
MG
241sub pay_app {
242 my ($env) = @_;
243 my $req = Plack::Request->new($env);
244 $db{$$} //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
245 my $order = $req->body_parameters->{order};
246 my $token = $req->body_parameters->{stripeToken};
247 return [500, ['Content-type' => 'text/html; charset=utf-8'], ['No token received, payment did not succeed.']] unless $token;
248 $db{$$}->update(orders => {stripe_token => $token}, {id => $order});
249 [200, ['Content-type' => 'text/html; charset=utf-8'], [$pay->as_HTML]];
250}
251
6e33dd68 252sub app {
1576fc41 253 my $footer = read_file 'tmpl/footer.html';
6e33dd68 254 builder {
1576fc41
MG
255 enable sub {
256 my $app = shift;
257 sub {
258 my $res = $app->(@_);
0c3c4e70 259 $res->[2][0] =~ s,</body>,$footer</body>, if $res->[0] == 200;
1576fc41
MG
260 $res;
261 }
262 };
6e33dd68
MG
263 mount '/' => sub { [301, [Location => '/form'], []] };
264 mount '/form' => \&form_app;
265 mount '/continue' => \&continue_app;
266 mount '/order' => \&order_app;
1576fc41
MG
267 mount '/details' => \&details_app;
268 mount '/pay' => \&pay_app;
6e33dd68
MG
269 }
270}
271
2721;
273__END__
274
275=head1 NAME
276
277App::Web::Oof - Oversimplified order form / ecommerce website
278
279=head1 SYNOPSIS
280
281 use App::Web::Oof;
282
283=head1 DESCRIPTION
284
285Oof (Oversimplified order form) is a very simple ecommerce website.
39be4169
MG
286It is the code behind L<https://ledparts4you.uk.to>.
287
288This version is reasonably functional, yet not very reusable, hence
289the version number.
6e33dd68
MG
290
291=head1 AUTHOR
292
293Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
294
295=head1 COPYRIGHT AND LICENSE
296
297Copyright (C) 2016 by Marius Gavrilescu
298
299This library is free software; you can redistribute it and/or modify
300it under the same terms as Perl itself, either Perl version 5.22.1 or,
301at your option, any later version of Perl 5 you may have available.
302
303
304=cut
This page took 0.029922 seconds and 4 git commands to generate.