re-work coupons to allow multiple coupon types
[bse.git] / site / cgi-bin / modules / BSE / TB / Coupons.pm
CommitLineData
023761bd
TC
1package BSE::TB::Coupons;
2use strict;
3use Squirrel::Table;
4our @ISA = qw(Squirrel::Table);
5use BSE::TB::Coupon;
6
b55d4af1 7our $VERSION = "1.002";
023761bd
TC
8
9sub rowClass {
10 return 'BSE::TB::Coupon';
11}
12
13sub make {
14 my ($self, %opts) = @_;
15
16 my $tiers = delete $opts{tiers};
17
b55d4af1
TC
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
023761bd
TC
25 my $coupon = $self->SUPER::make(%opts);
26
27 if ($tiers) {
28 $coupon->set_tiers($tiers);
78e38142 29 $coupon->save;
023761bd
TC
30 }
31
32 return $coupon;
33}
34
b55d4af1
TC
35=item behaviour_class
36
37Return the class name of a behaviour class given a class id.
38
39Loads the class.
40
41Throws an exception if no class if configured for the class id or if
42the class cannot be loaded.
43
44=cut
45
46sub 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
59Returns a hash of all behaviour classes with the keys being the
60classid and the value the class name.
61
62=cut
63
64sub 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
023761bd 761;