From: Marius Gavrilescu Date: Sat, 13 Feb 2016 18:48:25 +0000 (+0000) Subject: Initial commit X-Git-Tag: 0.000_001^0 X-Git-Url: http://git.ieval.ro/?p=app-web-oof.git;a=commitdiff_plain;h=6e33dd6846a44f56a5c8bd187f0a89e4893c7b4a Initial commit --- 6e33dd6846a44f56a5c8bd187f0a89e4893c7b4a diff --git a/Changes b/Changes new file mode 100644 index 0000000..d83f15c --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for Perl extension App::Web::Oof. + +0.000_001 2016-02-13T18:48+00:00 + - Initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..3f7cc43 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,14 @@ +app.psgi +Changes +db.sql +lib/App/Web/Oof.pm +Makefile.PL +MANIFEST +README +static/Gravity-UltraLight.otf +static/pattern.png +static/style.css +t/App-Web-Oof.t +tmpl/continue.html +tmpl/form.html +tmpl/order.html diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..278e388 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,26 @@ +use 5.014000; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'App::Web::Oof', + VERSION_FROM => 'lib/App/Web/Oof.pm', + ABSTRACT_FROM => 'lib/App/Web/Oof.pm', + AUTHOR => 'Marius Gavrilescu ', + MIN_PERL_VERSION => '5.14.0', + LICENSE => 'perl', + SIGN => 1, + PREREQ_PM => { + qw/Plack::App::File 0 + Plack::Builder 0 + DBIx::Simple 0 + HTML::TreeBuilder 0 + HTML::Element::Library 0 + JSON::MaybeXS 0/, + }, + META_ADD => { + dynamic_config => 0, + resources => { + repository => 'https://git.ieval.ro/?p=app-web-oof.git', + }, + } +); diff --git a/README b/README new file mode 100644 index 0000000..d7e690a --- /dev/null +++ b/README @@ -0,0 +1,38 @@ +App-Web-Oof version 0.000_001 +============================= + +Oof (Oversimplified order form) is a very simple ecommerce website. +As of this moment it is incomplete (although functional), hence the +version number. + +To use just edit the templates in the "tmpl/" directory and then run +plackup -Ilib. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +* Plack +* DBIx::Simple +* HTML::Element +* HTML::Element::Library +* JSON::MaybeXS + +COPYRIGHT AND LICENCE + +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. + + diff --git a/app.psgi b/app.psgi new file mode 100644 index 0000000..785f9b3 --- /dev/null +++ b/app.psgi @@ -0,0 +1,12 @@ +#!/usr/bin/perl +use 5.014000; +use warnings; + +use App::Web::Oof; +use Plack::App::File; +use Plack::Builder; + +builder { + mount '/static/' => Plack::App::File->new(root => 'static')->to_app, + mount '/' => App::Web::Oof::app, +} diff --git a/db.sql b/db.sql new file mode 100644 index 0000000..56edc09 --- /dev/null +++ b/db.sql @@ -0,0 +1,37 @@ +CREATE TABLE IF NOT EXISTS products ( + product serial PRIMARY KEY, + title TEXT NOT NULL, + subtitle TEXT NOT NULL, + summary TEXT NOT NULL, + pictures TEXT[] NULL, + price INT NOT NULL, + stock INT NOT NULL, + CONSTRAINT positive_stock CHECK (stock >= 0) +); + +CREATE TABLE IF NOT EXISTS discounts ( + discount VARCHAR(20) PRIMARY KEY, + fraction DECIMAL, + flat INT, + CONSTRAINT fraction_xor_flat CHECK ((fraction IS NULL AND flat IS NOT NULL) OR (fraction IS NOT NULL AND flat IS NULL)) +); + +CREATE TABLE IF NOT EXISTS orders ( + id TEXT PRIMARY KEY, + products JSON NOT NULL, + total INT NOT NULL, + discount VARCHAR(20) REFERENCES discounts UNIQUE, + + -- DELIVERY + first_name VARCHAR(20) NOT NULL, + last_name VARCHAR(20) NOT NULL, + email VARCHAR(80) NOT NULL, + phone VARCHAR(20), + postcode VARCHAR(10) NOT NULL, + address1 VARCHAR(32) NOT NULL, + address2 VARCHAR(32), + address3 VARCHAR(32), + address4 VARCHAR(32), + safe_place VARCHAR(32), + instructions VARCHAR(32) +); diff --git a/lib/App/Web/.#Oof.pm b/lib/App/Web/.#Oof.pm new file mode 120000 index 0000000..2792ff4 --- /dev/null +++ b/lib/App/Web/.#Oof.pm @@ -0,0 +1 @@ +marius@mgvx.1727:1455362169 \ No newline at end of file diff --git a/lib/App/Web/Oof.pm b/lib/App/Web/Oof.pm new file mode 100644 index 0000000..b8fbaf5 --- /dev/null +++ b/lib/App/Web/Oof.pm @@ -0,0 +1,202 @@ +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, Emarius@ieval.roE + +=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 diff --git a/static/Gravity-UltraLight.otf b/static/Gravity-UltraLight.otf new file mode 100644 index 0000000..31b8567 Binary files /dev/null and b/static/Gravity-UltraLight.otf differ diff --git a/static/pattern.png b/static/pattern.png new file mode 100644 index 0000000..720549e Binary files /dev/null and b/static/pattern.png differ diff --git a/static/style.css b/static/style.css new file mode 100644 index 0000000..ba7af92 --- /dev/null +++ b/static/style.css @@ -0,0 +1,56 @@ +@font-face { + font-family: "Gravity Ultra Light"; + src: url("/static/Gravity-UltraLight.otf"); +} + +body { + background: url("/static/pattern.png"); + padding: 0.3em 1em; + line-height: 1.4; +} + +#title { + font-family: "Gravity Ultra Light"; + text-align: center; + font-size: 5em; + font-weight: normal; + margin: 0; + margin-bottom: 5px; +} + +#items, #order { + width: 100%; +} + +table,th,td { + border-collapse: collapse; +} + +th,td { + padding: 0.2em; +} + +a.title { + font-weight: bold; + text-decoration: none; +} + +#continue, #place_order{ + font-size: 1.2em; + font-weight: bold; + padding: 1em; + background-color: lightgreen; + border-radius: 2em; + border-style: solid; + border-width: medium; + margin: auto; + display: block; +} + +.stock { + text-align: center; +} + +#total { + font-weight: bold; +} \ No newline at end of file diff --git a/t/App-Web-Oof.t b/t/App-Web-Oof.t new file mode 100644 index 0000000..39453fe --- /dev/null +++ b/t/App-Web-Oof.t @@ -0,0 +1,18 @@ +# Before 'make install' is performed this script should be runnable with +# 'make test'. After 'make install' it should work as 'perl App-Web-Oof.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; + +use strict; +use warnings; + +use Test::More tests => 1; +BEGIN { use_ok('App::Web::Oof') }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + diff --git a/tmpl/continue.html b/tmpl/continue.html new file mode 100644 index 0000000..9f32342 --- /dev/null +++ b/tmpl/continue.html @@ -0,0 +1,42 @@ + + + +Order details + +

ledparts4you

+ +
  • Note
+ +

Your order

+
+ + + +
ItemQuantityPrice

+ +

Totals

+ + +
Subtotal +
Discount +
Postage and packaging +
Total
+ +

Your details

+
+
+
+
+
+
+
+
+
+
+
+ + + + + +
diff --git a/tmpl/form.html b/tmpl/form.html new file mode 100644 index 0000000..b5da6fc --- /dev/null +++ b/tmpl/form.html @@ -0,0 +1,17 @@ + + + +Order form + +

ledparts4you

+ +
+
+ + + +
ItemPriceStockQuantity

+ +
+ +
diff --git a/tmpl/order.html b/tmpl/order.html new file mode 100644 index 0000000..f105b14 --- /dev/null +++ b/tmpl/order.html @@ -0,0 +1,9 @@ + + + +Order placed + +

ledparts4you

+ +

Success

+Order FAKEID has been placed successfully. You will receive an email when the order has been dispatched.