apparently vaguely working store code
[catagits/App-IdiotBox.git] / lib / App / IdiotBox / Store / SQLite.pm
CommitLineData
265c2b91 1package App::IdiotBox::Store::SQLite;
2
3use strict;
4use warnings FATAL => 'all';
5use DBIx::Data::Store;
6use DBIx::Data::Store::CRUD;
7use App::IdiotBox::DataSet;
8use Scalar::Util qw(weaken);
9
10my (%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
127sub bind {
128 my ($class, $idiotbox) = @_;
129 bless({ idiotbox => $idiotbox }, $class)->_bind;
130}
131
132my $DSN = 'dbi:SQLite:idiotbox.db';
133
134sub _new_db_store {
135 DBIx::Data::Store->connect($DSN);
136}
137
138sub _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
150sub _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
1631;