--- /dev/null
+package App::Web::Oof;
+
+use 5.014000;
+use strict;
+use warnings;
+use utf8;
+use parent qw/Plack::Component/;
+
+our $VERSION = '0.000_001';
+
+use DBIx::Simple;
+use HTML::TreeBuilder;
+use HTML::Element::Library;
+use JSON::MaybeXS qw/encode_json decode_json/;
+use Plack::Builder;
+use Plack::Request;
+
+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 $db;
+my ($form, $continue, $order);
+
+{
+ sub parse_html {
+ my $builder = HTML::TreeBuilder->new;
+ $builder->ignore_unknown(0);
+ $builder->parse_file("tmpl/$_[0].html");
+ $builder
+ }
+
+ $form = parse_html 'form';
+ $continue = parse_html 'continue';
+ $order = parse_html 'order';
+}
+
+sub stringify_money { sprintf "£%.2f", $_[0] / 100 }
+
+sub form_table_row {
+ my ($data, $tr) = @_;
+ $tr->fclass($_)->replace_content($data->{$_}) for qw/title subtitle stock/;
+ $tr->fclass('price')->replace_content(stringify_money $data->{price});
+ $tr->fclass('title')->attr('data-product', $data->{product});
+ $tr->fclass('title')->attr('data-summary', $data->{summary});
+ $tr->look_down(_tag => 'input')->attr(max => $data->{stock});
+ $tr->look_down(_tag => 'input')->attr(name => 'quant'.$data->{product});
+}
+
+sub form_app {
+ my ($env) = @_;
+ $db //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
+
+ my $data = $db->select(products => '*', {}, 'product')->hashes;
+ my $tree = $form->clone;
+ $tree->find('tbody')->find('tr')->iter3($data, \&form_table_row);
+
+ [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]]
+}
+
+sub continue_table_row {
+ my ($data, $tr) = @_;
+ $tr->fclass($_)->replace_content($data->{$_}) for qw/title subtitle quantity/;
+ $tr->fclass('price')->replace_content(stringify_money $data->{subtotal});
+ $tr->fclass('title')->attr('data-product', $data->{product});
+}
+
+sub continue_app {
+ my ($env) = @_;
+ $db //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
+ my $tree = $continue->clone;
+ my $req = Plack::Request->new($env);
+ my $params = $req->body_parameters;
+
+ my ($quant, $total, @data, @notes);
+ for (sort keys %$params) {
+ next unless /^quant/;
+ next unless $params->{$_};
+ my $data = $db->select(products => '*', {product => substr $_, 5})->hash;
+ $data->{quantity} = $params->{$_};
+ if ($data->{stock} == 0) {
+ push @notes, 'Item is out of stock and was removed from order: '.$data->{title};
+ next
+ }
+ if ($data->{quantity} > $data->{stock}) {
+ $data->{quantity} = $data->{stock};
+ push @notes, 'Not enough units of "'.$data->{title}.'" available. Quantity reduced to '.$data->{quantity}
+ }
+ $data->{subtotal} = $data->{price} * $data->{quantity};
+ $quant += $data->{quantity};
+ $total += $data->{subtotal};
+ push @data, $data
+ }
+
+ $tree->fid('subtotal')->replace_content(stringify_money $total);
+ my $dvalue;
+ if ($params->{discount}) {
+ my $discount = $db->select(discounts => '*', {discount => $params->{discount}})->hash;
+ if (!defined $discount) {
+ push @notes, 'Discount code incorrect. No discount applied.'
+ } elsif ($db->select(orders => 'COUNT(*)', {discount => $params->{discount}})->list) {
+ push @notes, 'Discount code already used once. No discount applied.'
+ } else {
+ $dvalue = int (0.5 + $discount->{fraction} * $total) if $discount->{fraction};
+ $dvalue = $discount->{flat} if $discount->{flat};
+ $tree->fid('discount')->replace_content('-'.stringify_money $dvalue);
+ $total -= $dvalue;
+ $tree->look_down(name => 'discount')->attr(value => $params->{discount});
+ push @notes, 'Discount applied.'
+ }
+ }
+ $tree->look_down(name => 'discount')->detach unless $dvalue;
+ $tree->fid('discount_tr')->detach unless $dvalue;
+ my $postage = 220 + 50 * $quant;
+ $tree->fid('postage')->replace_content(stringify_money $postage);
+ $total += $postage;
+ $tree->fid('total')->replace_content(stringify_money $total);
+
+ $tree->fid('order')->find('tbody')->find('tr')->iter3(\@data, \&continue_table_row);
+ $tree->iter($tree->fid('notes')->find('li') => @notes);
+
+ $tree->look_down(name => 'products')->attr(value => encode_json \@data);
+ $tree->look_down(name => 'total')->attr(value => $total);
+
+ [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]]
+}
+
+sub order_app {
+ my ($env) = @_;
+ $db //= DBIx::Simple->connect($ENV{OOF_DSN} // 'dbi:Pg:');
+ my $tree = $order->clone;
+ my $req = Plack::Request->new($env);
+ my $id = sprintf "%X", time; # Not good enough!
+
+ $db->begin_work;
+ $db->insert(orders => {id => $id, %{$req->body_parameters}});
+ my $products = decode_json $req->body_parameters->{products};
+ for my $prod (@$products) {
+ my $stock = $db->select(products => 'stock', {product => $prod->{product}})->list;
+ die "Not enough of " .$prod->{title}."\n" if $prod->{quantity} > $stock;
+ $db->update(products => {stock => $stock - $prod->{quantity}}, {product => $prod->{product}});
+ }
+ $db->commit;
+
+ $tree->fid('orderid')->replace_content($id);
+ [200, ['Content-type' => 'text/html; charset=utf-8'], [$tree->as_HTML]]
+}
+
+sub app {
+ builder {
+ mount '/' => sub { [301, [Location => '/form'], []] };
+ mount '/form' => \&form_app;
+ mount '/continue' => \&continue_app;
+ mount '/order' => \&order_app;
+ }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+App::Web::Oof - Oversimplified order form / ecommerce website
+
+=head1 SYNOPSIS
+
+ use App::Web::Oof;
+
+=head1 DESCRIPTION
+
+Oof (Oversimplified order form) is a very simple ecommerce website.
+As of this moment it is incomplete (although functional), hence the
+version number.
+
+=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
--- /dev/null
+<!DOCTYPE html>
+<meta charset="utf-8">
+<link rel="stylesheet" href="/static/style.css">
+<title>Order details</title>
+
+<h1 id="title">ledparts4you</h1>
+
+<ul id="notes"><li>Note</ul>
+
+<h2>Your order</h2>
+<form action="/order" method="POST">
+<table id="order">
+<thead><tr><th>Item<th>Quantity<th>Price</thead>
+<tbody><tr><td class="item"><a href="#" class="title"></a><br><span class="subtitle"></span><td class="quantity"><td class="price"></tbody>
+</table>
+
+<h2>Totals</h2>
+<table id="totals">
+<tbody><tr><td>Subtotal<td id="subtotal">
+<tr id="discount_tr"><td>Discount<td id="discount">
+<tr><td>Postage and packaging<td id="postage">
+<tr><td><strong>Total</strong><td id="total"></tbody>
+</table>
+
+<h2>Your details</h2>
+<label>First name<br> <input name="first_name" autocomplete="given-name" type="text" maxlength="20" required></label><br>
+<label>Last name<br> <input name="last_name" autocomplete="family-name" type="text" maxlength="20" required></label><br>
+<label>Email address<br><input name="email" autocomplete="email" type="email" maxlength="80" required></label><br>
+<label>Phone number <em>(optional)</em><br><input name="phone" autocomplete="tel" type="tel" maxlength="20"></label><br>
+<label>Postcode<br> <input name="postcode" autocomplete="postal-code" type="text" maxlength="10" required></label><br>
+<label>Address line 1<br><input name="address1" autocomplete="address-line1" type="text" maxlength="32" required></label><br>
+<label>Address line 2 <em>(optional)</em><br><input name="address2" autocomplete="address-line2" type="text" maxlength="32"></label><br>
+<label>Address line 3 <em>(optional)</em><br><input name="address3" autocomplete="address-line3" type="text" maxlength="32"></label><br>
+<label>Address line 4 <em>(optional)</em><br><input name="address4" type="text" maxlength="32"></label><br>
+<label>Safe place <em>(optional)</em><br><input name="safe_place" type="text" maxlength="32"></label><br>
+<label>Delivery instructions <em>(optional)</em><br><input name="instructions" type="text" maxlength="32"></label><br>
+
+<input type="hidden" name="discount">
+<input type="hidden" name="products">
+<input type="hidden" name="total">
+<input type="submit" value="Place order" id="place_order">
+</form>
projects / app-web-oof.git / commitdiff
