File Coverage

blib/lib/Dancer/Plugin/Interchange6/Cart.pm
Criterion Covered Total %
statement 149 149 100.0
branch 28 28 100.0
condition n/a
subroutine 29 29 100.0
pod 2 2 100.0
total 208 208 100.0


line stmt bran cond sub pod time code
1 5     5   19 use utf8;
  5         5  
  5         23  
2              
3             package Dancer::Plugin::Interchange6::Cart;
4              
5             =head1 NAME
6              
7             Dancer::Plugin::Interchange6::Cart
8              
9             =head1 DESCRIPTION
10              
11             Extends L<Interchange6::Cart> to tie cart to L<Interchange6::Schema::Result::Cart>.
12              
13             =cut
14              
15 5     5   168 use strict;
  5         8  
  5         79  
16 5     5   15 use warnings;
  5         5  
  5         120  
17              
18 5     5   16 use Dancer qw(:syntax !before !after);
  5         4  
  5         20  
19 5     5   1658 use Dancer::Plugin;
  5         8  
  5         285  
20 5     5   20 use Dancer::Plugin::Auth::Extensible;
  5         10  
  5         300  
21 5     5   17 use Dancer::Plugin::DBIC;
  5         6  
  5         202  
22 5     5   19 use Module::Runtime 'use_module';
  5         5  
  5         42  
23 5     5   201 use Scalar::Util 'blessed';
  5         6  
  5         193  
24 5     5   20 use Try::Tiny;
  5         6  
  5         501  
25              
26 5     5   919 use Moo;
  5         13686  
  5         34  
27 5     5   5920 use MooseX::CoverableModifiers;
  5         21032  
  5         29  
28 5     5   2405 use Interchange6::Types -types;
  5         586650  
  5         50  
29              
30             extends 'Interchange6::Cart';
31              
32 5     5   21811 use namespace::clean;
  5         14430  
  5         37  
33              
34             =head1 ATTRIBUTES
35              
36             See L<Interchange6::Cart/ATTRIBUTES> for a full list of attributes
37             inherited by this module.
38              
39             =head2 database
40              
41             The database name as defined in the L<Dancer::Plugin::DBIC> configuration.
42              
43             Defaults to 'default'.
44              
45             =cut
46              
47             has database => (
48             is => 'ro',
49             isa => Str,
50             default => 'default',
51             );
52              
53             =head2 dbic_cart
54              
55             =cut
56              
57             has dbic_cart => (
58             is => 'lazy',
59             isa => InstanceOf['Interchange6::Schema::Result::Cart'],
60             );
61              
62             sub _build_dbic_cart {
63 62     62   982 my $self = shift;
64              
65 62         317 my $cart = schema( $self->database )->resultset('Cart')->find_or_new(
66             {
67             name => $self->name,
68             sessions_id => $self->sessions_id,
69             },
70             { key => 'carts_name_sessions_id' }
71             );
72              
73 62 100       162063 if ( $cart->in_storage ) {
74 43         1680 debug( "Existing cart: ", $cart->carts_id, " ", $cart->name, "." );
75             }
76             else {
77 19         601 $cart->insert;
78 19         53216 debug( "New cart ", $cart->carts_id, " ", $cart->name, "." );
79             }
80 62         5821 return $cart;
81             }
82              
83             =head2 dbic_cart_products
84              
85             L</dbic_cart> related resultset C<cart_products> with prefetched C<product>.
86              
87             =cut
88              
89             has dbic_cart_products => (
90             is => 'lazy',
91             isa => InstanceOf['DBIx::Class::ResultSet'],
92             );
93              
94             sub _build_dbic_cart_products {
95 62     62   1940 return shift->dbic_cart->related_resultset('cart_products')->search(
96             undef,
97             {
98             prefetch => 'product'
99             }
100             );
101             }
102              
103             =head2 id
104              
105             Extends inherited L<Interchange6::Cart/id> attribute.
106              
107             Defaults to C<id> of L</dbic_cart>.
108              
109             =cut
110              
111             has '+id' => (
112             is => 'lazy',
113             );
114              
115             sub _build_id {
116             return shift->dbic_cart->id,
117 11     11   19262 }
118              
119             =head2 product_class
120              
121             Inherited. Change default to L<Dancer::Plugin::Interchange6::Cart::Product>.
122              
123             =cut
124              
125             has '+product_class' => (
126             default => 'Dancer::Plugin::Interchange6::Cart::Product',
127             );
128              
129             =head2 sessions_id
130              
131             Extends inherited sessions_id attribute.
132              
133             Defaults to C<< session->id >>.
134              
135             =cut
136              
137             has '+sessions_id' => (
138             is => 'lazy',
139             );
140              
141             sub _build_sessions_id {
142 6     6   11665 return session->id;
143             }
144              
145             =head1 METHODS
146              
147             See L<Interchange6::Cart/METHODS> for a full list of methods inherited by
148             this module.
149              
150             =head2 BUILD
151              
152             Load existing cart from the database along with any products it contains.
153              
154             =cut
155              
156             sub BUILD {
157 62     62 1 16374585 my $self = shift;
158 62         113 my ( @products, $roles );
159              
160 62         1068 my $rset = $self->dbic_cart_products->order_by( 'cart_position',
161             'cart_products_id' );
162              
163 62 100       79932 if (logged_in_user) {
164 12         118126 $roles = user_roles;
165             }
166              
167 62         339350 while ( my $record = $rset->next ) {
168              
169 54         387796 push @products,
170             {
171             dbic_product => $record->product,
172             id => $record->cart_products_id,
173             sku => $record->sku,
174             canonical_sku => $record->product->canonical_sku,
175             name => $record->product->name,
176             quantity => $record->quantity,
177             price => $record->product->price,
178             uri => $record->product->uri,
179             weight => $record->product->weight,
180             };
181             }
182              
183             # use seed to avoid hooks
184 62         235461 $self->seed( \@products );
185             }
186              
187             =head1 METHODS
188              
189             =head2 add
190              
191             Add one or more products to the cart.
192              
193             Possible arguments:
194              
195             =over
196              
197             =item * single product sku (scalar value)
198              
199             =item * hashref with keys 'sku' and 'quantity' (quantity is optional and defaults to 1)
200              
201             =item * an array reference of either of the above
202              
203             =back
204              
205             In list context returns an array of L<Interchange6::Cart::Product>s and in scalar context returns an array reference of the same.
206              
207             =cut
208              
209             around 'add' => sub {
210 26     26   49135 my ( $orig, $self, $args ) = @_;
211 26         51 my ( @products, @ret );
212              
213             # convert to array reference if we don't already have one
214 26 100       125 $args = [$args] unless ref($args) eq 'ARRAY';
215              
216 26         109 execute_hook( 'before_cart_add_validate', $self, $args );
217              
218             # basic validation + add each validated arg to @args
219              
220 26         55869 foreach my $arg (@$args) {
221              
222             # make sure we have hasref
223 27 100       105 unless ( ref($arg) eq 'HASH' ) {
224 7         18 $arg = { sku => $arg };
225             }
226              
227             die "Attempt to add product to cart without sku failed."
228 27 100       105 unless defined $arg->{sku};
229              
230             my $result =
231 25         165 schema( $self->database )->resultset('Product')->find( $arg->{sku} );
232              
233 25 100       96508 die "Product with sku '$arg->{sku}' does not exist."
234             unless defined $result;
235              
236             my $product = {
237             dbic_product => $result,
238             name => $result->name,
239             price => $result->price,
240             sku => $result->sku,
241             canonical_sku => $result->canonical_sku,
242             uri => $result->uri,
243             weight => $result->weight,
244 24 100       869 quantity => defined $arg->{quantity} ? $arg->{quantity} : 1,
245             };
246              
247 24         2744 push @products, $product;
248             }
249              
250 23         89 execute_hook( 'before_cart_add', $self, \@products );
251              
252             # add products to cart
253              
254 23         2976 foreach my $product ( @products ) {
255              
256             # bubble up the add
257 24         133 my $ret = $orig->( $self, $product );
258              
259             # update or create in db
260              
261 23         22084 my $cart_product =
262             $self->dbic_cart_products->search( { 'me.sku' => $ret->sku },
263             { rows => 1 } )->single;
264              
265 23 100       184388 if ( $cart_product ) {
266 7         330 $cart_product->update({ quantity => $ret->quantity });
267             }
268             else {
269 16         836 $cart_product = $self->dbic_cart_products->create(
270             {
271             sku => $ret->sku,
272             quantity => $ret->quantity,
273             cart_position => 0,
274             }
275             );
276             }
277              
278 23         66793 push @ret, $ret;
279             }
280              
281 22         575 execute_hook( 'after_cart_add', $self, \@ret );
282              
283 22 100       93750 return wantarray ? @ret : \@ret;
284             };
285              
286             =head2 clear
287              
288             Removes all products from the cart.
289              
290             =cut
291              
292             around clear => sub {
293 2     2   2339 my ( $orig, $self ) = @_;
294              
295 2         8 execute_hook( 'before_cart_clear', $self );
296              
297 2         5333 $orig->( $self, @_ );
298              
299             # delete all products from this cart
300 2         398 $self->dbic_cart_products->delete_all;
301              
302 2         20585 execute_hook( 'after_cart_clear', $self );
303              
304 2         393 return;
305             };
306              
307             =head2 load_saved_products
308              
309             Pulls old cart items into current cart - used after user login.
310              
311             =cut
312              
313             sub load_saved_products {
314 5     5 1 3223 my $self = shift;
315              
316             # should not be called unless user is logged in
317 5 100       28 return unless $self->users_id;
318              
319             # find old carts and see if they have products we should move into
320             # our new cart
321              
322 4         30 my $old_carts = schema( $self->database )->resultset('Cart')->search(
323             {
324             'me.name' => $self->name,
325             'me.users_id' => $self->users_id,
326             'me.sessions_id' => [ undef, { '!=', $self->sessions_id } ],
327             },
328             {
329             prefetch => { cart_products => 'product' },
330             }
331             );
332              
333 4         2084 while ( my $cart = $old_carts->next ) {
334              
335 1         18779 my $cart_products = $cart->cart_products;
336 1         175 while ( my $cart_product = $cart_products->next ) {
337              
338             # look for this sku in our current cart
339              
340 2         104 my $product = $self->dbic_cart_products->single(
341             { 'me.sku' => $cart_product->sku } );
342              
343 2 100       16002 if ( $product ) {
344              
345             # we have this sku in our new cart so update quantity
346 1         21 my $quantity = $product->quantity + $cart_product->quantity;
347              
348             # update in DB
349 1         31 $product->update( { quantity => $quantity } );
350              
351             # update Interchange6::Cart::Product object
352 1         1786 $self->find( $cart_product->sku )->set_quantity($quantity);
353             }
354             else {
355              
356             # move product into new cart
357 1         26 $cart_product->update( { carts_id => $self->id } );
358              
359             # add to Interchange6::Cart
360 1         1813 push @{ $self->products },
  1         13  
361             use_module( $self->product_class )->new(
362             dbic_product => $cart_product->product,
363             id => $cart_product->id,
364             sku => $cart_product->sku,
365             canonical_sku => $cart_product->product->canonical_sku,
366             name => $cart_product->product->name,
367             quantity => $cart_product->quantity,
368             price => $cart_product->product->price,
369             uri => $cart_product->product->uri,
370             weight => $cart_product->product->weight,
371             );
372             }
373             }
374             }
375              
376             # delete the old carts (cascade deletes related cart products)
377 4         32098 $old_carts->delete;
378             }
379              
380             =head2 remove
381              
382             Remove single product from the cart. Takes SKU of product to identify
383             the product.
384              
385             =cut
386              
387             around remove => sub {
388 6     6   2289 my ( $orig, $self, $arg ) = @_;
389              
390 6         24 execute_hook( 'before_cart_remove_validate', $self, $arg );
391              
392 6     10   21093 my $index = $self->product_index( sub { $_->sku eq $arg } );
  10         270  
393              
394 6 100       47 die "Product sku not found in cart: $arg." unless $index >= 0;
395              
396 4         14 execute_hook( 'before_cart_remove', $self, $arg );
397              
398 4         505 my $ret = $orig->( $self, $arg );
399              
400 4         2034 $self->dbic_cart_products->search( { 'me.sku' => $ret->sku } )->delete;
401              
402 4         40468 execute_hook( 'after_cart_remove', $self, $arg );
403              
404 4         1265 return $ret;
405             };
406              
407             =head2 rename
408              
409             Rename this cart. This is the writer method for L<Interchange6::Cart/name>.
410              
411             Arguments: new name
412              
413             Returns: new name
414              
415             =cut
416              
417             around rename => sub {
418 3     3   4858 my ( $orig, $self, $new_name ) = @_;
419              
420 3         13 my $old_name = $self->name;
421              
422 3         14 execute_hook( 'before_cart_rename', $self, $old_name, $new_name );
423              
424 3         465 my $ret = $orig->( $self, $new_name );
425              
426 3         166 $self->dbic_cart->update( { name => $ret } );
427              
428 3         6105 execute_hook( 'after_cart_rename', $self, $old_name, $ret );
429              
430 3         292 return $ret;
431             };
432              
433             sub _find_and_update {
434 5     5   7 my ( $self, $sku, $new_product ) = @_;
435              
436 5         69 $self->dbic_cart_products->search(
437             {
438             'me.sku' => $sku
439             }
440             )->update($new_product);
441             }
442              
443             =head2 set_sessions_id
444              
445             Writer method for L<Interchange6::Cart/sessions_id>.
446              
447             =cut
448              
449             around set_sessions_id => sub {
450 5     5   304 my ( $orig, $self, $arg ) = @_;
451              
452 5         25 execute_hook( 'before_cart_set_sessions_id', $self, $arg );
453              
454 5         28771 my $ret = $orig->( $self, $arg );
455              
456 2         76 debug( "Change sessions_id of cart " . $self->id . " to: ", $arg );
457              
458 2         249 $self->dbic_cart->update({ sessions_id => $arg });
459              
460 2         3935 execute_hook( 'after_cart_set_sessions_id', $ret, $arg );
461              
462 2         170 return $ret;
463             };
464              
465             =head2 set_users_id
466              
467             Writer method for L<Interchange6::Cart/users_id>.
468              
469             =cut
470              
471             around set_users_id => sub {
472 4     4   293 my ( $orig, $self, $arg ) = @_;
473              
474 4         20 execute_hook( 'before_cart_set_users_id', $self, $arg );
475              
476 4         21639 debug("Change users_id of cart " . $self->id . " to: $arg");
477              
478 4         505 my $ret = $orig->( $self, $arg );
479              
480 4         125 $self->dbic_cart->update( { users_id => $arg } );
481              
482 4         7222 execute_hook( 'after_cart_set_users_id', $ret, $arg );
483              
484 4         520 return $ret;
485             };
486              
487             =head2 update
488              
489             Update quantity of products in the cart.
490              
491             Parameters are pairs of SKUs and quantities, e.g.
492              
493             $cart->update(9780977920174 => 5,
494             9780596004927 => 3);
495              
496             Triggers before_cart_update and after_cart_update hooks.
497              
498             A quantity of zero is equivalent to removing this product,
499             so in this case the remove hooks will be invoked instead
500             of the update hooks.
501              
502             Returns updated products that are still in the cart. Products removed
503             via quantity 0 or products for which quantity has not changed will not
504             be returned.
505              
506             =cut
507              
508             around update => sub {
509 8     8   14520 my ( $orig, $self, @args ) = @_;
510 8         14 my ( @products, $product, $new_product, $count );
511              
512 8         29 ARGS: while ( @args > 0 ) {
513              
514 9         81 my $sku = shift @args;
515 9         15 my $qty = shift @args;
516              
517 9 100       55 die "Bad quantity argument to update: $qty" unless $qty =~ /^\d+$/;
518              
519 8 100       47 if ( $qty == 0 ) {
520              
521             # do remove instead of update
522 2         41 $self->remove($sku);
523 2         54 next ARGS;
524             }
525              
526 6         22 execute_hook( 'before_cart_update', $self, $sku, $qty );
527              
528 6         10638 my ($ret) = $orig->( $self, $sku => $qty );
529              
530 5         630 $self->_find_and_update( $sku, { quantity => $qty } );
531              
532 5         50691 execute_hook( 'after_cart_update', $ret, $sku, $qty );
533             }
534             };
535              
536             =head1 HOOKS
537              
538             The following hooks are available:
539              
540             =over 4
541              
542             =item before_cart_add_validate
543              
544             Executed in L</add> before arguments are validated as being valid. Hook
545             receives the following arguments:
546              
547             Receives: $cart, \%args
548              
549             The args are those that were passed to L<add>.
550              
551             Example:
552              
553             hook before_cart_add_validate => sub {
554             my ( $cart, $args ) = @_;
555             foreach my $arg ( @$args ) {
556             my $sku = ref($arg) eq 'HASH' ? $arg->{sku} : $arg;
557             die "bad product" if $sku eq "bad sku";
558             }
559             }
560              
561             =item before_cart_add
562              
563             Called in L</add> immediately before the products are added to the cart.
564              
565             Receives: $cart, \@products
566              
567             The products arrary ref contains simple hash references that will be passed
568             to L<Interchange6::Cart::Product/new>.
569              
570             =item after_cart_add
571              
572             Called in L</add> after products have been added to the cart.
573              
574             Receives: $cart, \@products
575              
576             The products arrary ref contains L<Interchange6::Cart::Product>s.
577              
578             =item before_cart_remove_validate
579              
580             Called at start of L</remove> before arg has been validated.
581              
582             Receives: $cart, $sku
583              
584             =item before_cart_remove
585              
586             Called in L</remove> before validated product is removed from cart.
587              
588             Receives: $cart, $sku
589              
590             =item after_cart_remove
591              
592             Called in L</remove> after product has been removed from cart.
593              
594             Receives: $cart, $sku
595              
596             =item before_cart_update
597              
598             Executed for each pair of sku/quantity passed to L<update> before the update is performed.
599              
600             Receives: $cart, $sku, $quantity
601              
602             A quantity of zero is equivalent to removing this product,
603             so in this case the remove hooks will be invoked instead
604             of the update hooks.
605              
606             =item after_cart_update
607              
608             Executed for each pair of sku/quantity passed to L<update> after the update is performed.
609              
610             Receives: $product, $sku, $quantity
611              
612             Where C<$product> is the L<Interchange6::Cart::Product> returned from
613             L<Interchange6::Cart::Product/update>.
614              
615             A quantity of zero is equivalent to removing this product,
616             so in this case the remove hooks will be invoked instead
617             of the update hooks.
618              
619             =item before_cart_clear
620              
621             Executed in L</clear> before the clear is performed.
622              
623             Receives: $cart
624              
625             =item after_cart_clear
626              
627             Executed in L</clear> after the clear is performed.
628              
629             Receives: $cart
630              
631             =item before_cart_set_users_id
632              
633             Executed in L<set_users_id> before users_id is updated.
634              
635             Receives: $cart, $userid
636              
637             =item after_cart_set_users_id
638              
639             Executed in L<set_users_id> after users_id is updated.
640              
641             Receives: $new_usersid, $requested_userid
642              
643             =item before_cart_set_sessions_id
644              
645             Executed in L<set_sessions_id> before sessions_id is updated.
646              
647             Receives: $cart, $sessionid
648              
649             =item after_cart_set_sessions_id
650              
651             Executed in L<set_sessions_id> after sessions_id is updated.
652              
653             Receives: $cart, $sessionid
654              
655             =item before_cart_rename
656              
657             Executed in L</rename> before cart L<Interchange6::Cart/name> is updated.
658              
659             Receives: $cart, $old_name, $new_name
660              
661             =item after_cart_rename
662              
663             Executed in L</rename> after cart L<Interchange6::Cart/name> is updated.
664              
665             Receives: $cart, $old_name, $new_name
666              
667             =back
668              
669             =head1 AUTHORS
670              
671             Stefan Hornburg (Racke), <racke@linuxia.de>
672             Peter Mottram (SysPete), <peter@sysnix.com>
673              
674             =head1 LICENSE AND COPYRIGHT
675              
676             Copyright 2011-2016 Stefan Hornburg (Racke) <racke@linuxia.de>.
677              
678             This program is free software; you can redistribute it and/or modify it
679             under the terms of either: the GNU General Public License as published
680             by the Free Software Foundation; or the Artistic License.
681              
682             See http://dev.perl.org/licenses/ for more information.
683              
684             =cut
685              
686             1;