re-work coupons to allow multiple coupon types
[bse.git] / site / cgi-bin / modules / BSE / TB / Coupons.pm
1 package BSE::TB::Coupons;
2 use strict;
3 use Squirrel::Table;
4 our @ISA = qw(Squirrel::Table);
5 use BSE::TB::Coupon;
6
7 our $VERSION = "1.002";
8
9 sub rowClass {
10   return 'BSE::TB::Coupon';
11 }
12
13 sub make {
14   my ($self, %opts) = @_;
15
16   my $tiers = delete $opts{tiers};
17
18   my $config_obj = delete $opts{config_obj};
19   if ($config_obj) {
20     $opts{discount_percent} = delete $config_obj->{discount_percent};
21     require JSON;
22     $opts{config} = JSON->new->encode($config_obj);
23   }
24
25   my $coupon = $self->SUPER::make(%opts);
26
27   if ($tiers) {
28     $coupon->set_tiers($tiers);
29     $coupon->save;
30   }
31
32   return $coupon;
33 }
34
35 =item behaviour_class
36
37 Return the class name of a behaviour class given a class id.
38
39 Loads the class.
40
41 Throws an exception if no class if configured for the class id or if
42 the class cannot be loaded.
43
44 =cut
45
46 sub behaviour_class {
47   my ($class, $classid) = @_;
48
49   my $bclass = BSE::Cfg->single->entryErr("coupon classes", $classid);
50   (my $bfile = $bclass . ".pm") =~ s(::)(/)g;
51
52   require $bfile;
53
54   return $bclass;
55 }
56
57 =item behaviour_classes
58
59 Returns a hash of all behaviour classes with the keys being the
60 classid and the value the class name.
61
62 =cut
63
64 sub behaviour_classes {
65   my ($class) = @_;
66
67   my %entries = BSE::Cfg->single->entries("coupon classes");
68   my %bclasses;
69   for my $classid (keys %entries) {
70     $bclasses{$classid} = $class->behaviour_class($classid);
71   }
72
73   \%bclasses;
74 }
75
76 1;