Commit | Line | Data |
265c2b91 |
1 | package App::IdiotBox::Store::SQLite; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | use DBIx::Data::Store; |
6 | use DBIx::Data::Store::CRUD; |
7 | use App::IdiotBox::DataSet; |
8 | use Scalar::Util qw(weaken); |
9 | |
10 | my (%BIND, %SQL); |
11 | |
12 | %BIND = ( |
13 | recent_announcements => { |
14 | class => { |
15 | inflate => sub { |
16 | my ($self, $obj) = @_; |
17 | bless($obj, 'App::IdiotBox::Announcement'); |
18 | bless($obj->{bucket}, 'App::IdiotBox::Bucket'); |
19 | $obj; |
20 | }, |
21 | deflate => sub { |
22 | my ($self, $obj) = @_; |
23 | my %raw = %$obj; |
24 | delete $raw{bucket}; |
25 | \%raw; |
26 | } |
27 | }, |
28 | set_over => [ 'id' ], |
29 | }, |
30 | buckets => { |
31 | class => { |
32 | inflate => sub { |
33 | my ($self, $obj) = @_; |
34 | bless($obj, 'App::IdiotBox::Bucket'); |
35 | weaken (my $weak = $obj); |
36 | $obj->{videos} = _bind_set('bucket_videos', |
37 | { |
38 | raw_store => $self->_store->raw_store, |
39 | implicit_arguments => { bucket_slug => $obj->{slug} }, |
40 | }, |
41 | { |
42 | class => { |
43 | inflate => sub { |
44 | my ($self, $obj) = @_; |
45 | bless($obj, 'App::IdiotBox::Video'); |
46 | weaken($obj->{bucket} = $weak); |
47 | $obj; |
48 | }, |
49 | deflate => sub { |
50 | my ($self, $obj) = @_; |
51 | my %raw = %$obj; |
52 | delete $raw{bucket}; |
53 | \%raw; |
54 | }, |
55 | } |
56 | } |
57 | ); |
58 | $obj; |
59 | }, |
60 | deflate => sub { |
61 | my ($self, $obj) = @_; |
62 | my %raw = %$obj; |
63 | delete $raw{videos}; |
64 | \%raw; |
65 | } |
66 | }, |
67 | set_over => [ 'slug' ], |
68 | }, |
69 | bucket_videos => { |
70 | set_over => [ 'slug' ] |
71 | }, |
72 | ); |
73 | |
74 | %SQL = ( |
75 | recent_announcements => { |
76 | select_column_order => [ qw( |
77 | id made_at video_count bucket.slug bucket.name bucket.video_count |
78 | ) ], |
79 | select_sql => q{ |
80 | SELECT |
81 | announcement.id, announcement.made_at, COUNT(DISTINCT my_videos.slug), |
82 | bucket.slug, bucket.name, COUNT(DISTINCT all_videos.slug) |
83 | FROM |
84 | announcements announcement |
85 | JOIN buckets bucket |
86 | ON bucket.slug = announcement.bucket_slug |
87 | JOIN videos my_videos |
88 | ON my_videos.announcement_id = announcement.id |
89 | JOIN videos all_videos |
90 | ON all_videos.bucket_slug = announcement.bucket_slug |
91 | JOIN announcements all_announcements |
92 | ON all_announcements.bucket_slug = announcement.bucket_slug |
93 | GROUP BY |
94 | announcement.made_at, bucket.slug, bucket.name |
95 | HAVING |
96 | announcement.made_at = MAX(all_announcements.made_at) |
97 | ORDER BY |
98 | announcement.made_at DESC |
99 | }, |
100 | }, |
101 | buckets => { |
102 | select_column_order => [ qw(slug name) ], |
103 | select_single_sql => q{ |
104 | SELECT slug, name |
105 | FROM buckets |
106 | WHERE slug = ? |
107 | }, |
108 | select_single_argument_order => [ 'slug' ], |
109 | }, |
110 | bucket_videos => { |
111 | select_column_order => [ qw(slug name author details) ], |
112 | select_sql => q{ |
113 | SELECT slug, name, author, details |
114 | FROM videos |
115 | WHERE bucket_slug = ? |
116 | }, |
117 | select_argument_order => [ 'bucket_slug' ], |
118 | select_single_sql => q{ |
119 | SELECT slug, name, author, details |
120 | FROM videos |
121 | WHERE bucket_slug = ? AND slug = ? |
122 | }, |
123 | select_single_argument_order => [ qw(bucket_slug slug) ], |
124 | }, |
125 | ); |
126 | |
127 | sub bind { |
128 | my ($class, $idiotbox) = @_; |
129 | bless({ idiotbox => $idiotbox }, $class)->_bind; |
130 | } |
131 | |
132 | my $DSN = 'dbi:SQLite:idiotbox.db'; |
133 | |
134 | sub _new_db_store { |
135 | DBIx::Data::Store->connect($DSN); |
136 | } |
137 | |
138 | sub _bind { |
139 | my $self = shift; |
140 | my $idiotbox = $self->{idiotbox}; |
141 | |
142 | my $db_store = $self->_new_db_store; |
143 | |
144 | foreach my $to_bind (qw(recent_announcements buckets)) { |
145 | $idiotbox->{$to_bind} = _bind_set($to_bind, { raw_store => $db_store }); |
146 | } |
147 | $idiotbox; |
148 | } |
149 | |
150 | sub _bind_set { |
151 | my ($type, $store_args, $set_args) = @_; |
152 | my $store = DBIx::Data::Store::CRUD->new({ |
153 | %{$SQL{$type}}, |
154 | %{$store_args}, |
155 | }); |
156 | return App::IdiotBox::DataSet->new({ |
157 | %{$BIND{$type}}, |
158 | store => $store, |
159 | %{$set_args||{}}, |
160 | }); |
161 | } |
162 | |
163 | 1; |