lib/App/IdiotBox/Store/SQLite.pm

   1 package App::IdiotBox::Store::SQLite;
   2
   3 use strictures 1;
   4
   5 use DBIx::Data::Collection::Set::Wrapper::Inflate;
   6 use DBIx::Data::Store::CRUD;
   7 use DBIx::Data::Store::Raw;
   8
   9 sub bind {
  10   my ($class, $ib) = @_;
  11   my $raw = DBIx::Data::Store::Raw->connect(
  12     'dbi:SQLite:'.$ib->config->{db_file}
  13   );
  14   $ib->{recent_announcements} = _bind_announcements($raw);
  15   $ib->{buckets} = _bind_buckets($raw);
  16 }
  17
  18 sub _bind_set {
  19   my ($raw, $inflator, $sql, $extra) = @_;
  20   DBIx::Data::Collection::Set::Wrapper::Inflate->new({
  21     inflator => $inflator,
  22     inner => DBIx::Data::Store::CRUD->new({
  23       raw => $raw,
  24       sql => $sql,
  25       %{$extra||{}},
  26     })
  27   });
  28 }
  29
  30 {
  31   package App::IdiotBox::Inflator::Announcement;
  32
  33   sub inflate {
  34     my ($self, $raw) = @_;
  35     my %new = (bucket => bless({}, 'App::IdiotBox::Bucket'));
  36     (@new{qw(id made_at video_count)},
  37      @{$new{bucket}}{qw(slug name video_count)})
  38        = @$raw;
  39     bless(\%new, 'App::IdiotBox::Announcement');
  40   }
  41
  42   sub deflate_body {
  43     my ($self, $body) = @_;
  44     [ $body->{bucket}{slug}, $body->{made_at} ]
  45   }
  46 }
  47
  48 sub _bind_announcements {
  49   _bind_set(
  50     $_[0],
  51     'App::IdiotBox::Inflator::Announcement',
  52     {
  53       select_all => q{
  54         SELECT
  55           announcement.id, announcement.made_at, COUNT(DISTINCT my_videos.slug),
  56           bucket.slug, bucket.name, COUNT(DISTINCT all_videos.slug)
  57         FROM
  58           announcements announcement
  59           JOIN buckets bucket
  60             ON bucket.slug = announcement.bucket_slug
  61           JOIN videos my_videos
  62             ON my_videos.announcement_id = announcement.id
  63           JOIN videos all_videos
  64             ON all_videos.bucket_slug = announcement.bucket_slug
  65           JOIN announcements all_announcements
  66             ON all_announcements.bucket_slug = announcement.bucket_slug
  67         GROUP BY
  68           announcement.made_at, bucket.slug, bucket.name
  69         HAVING
  70           announcement.made_at = MAX(all_announcements.made_at)
  71         ORDER BY
  72           announcement.made_at DESC
  73       },
  74       insert_one => sub {
  75         my ($store, undef, $dbh, $args) = @_;
  76         $store->_sth_for($dbh, q{
  77           INSERT INTO announcements
  78             (bucket_slug, made_at)
  79           VALUES
  80             (?, ?)
  81         }, $args);
  82         [ $dbh->last_insert_id(undef,undef,undef,undef),
  83           $args->[1], 0, $args->[0], undef, undef ];
  84       },
  85     }
  86   )
  87 }
  88
  89 {
  90   package App::IdiotBox::Inflator::Bucket;
  91
  92   use base qw(DBIx::Data::Store::Inflator::Simple);
  93
  94   sub _raw { shift->{raw} }
  95
  96   sub inflate {
  97     my $self = shift;
  98     my $inflated = $self->SUPER::inflate(@_);
  99     $inflated->{videos} = App::IdiotBox::Store::SQLite::_bind_bucket_videos(
 100       $self->_raw, $inflated
 101     );
 102     $inflated;
 103   }
 104 }
 105
 106 sub _bind_buckets {
 107   _bind_set(
 108     $_[0],
 109     App::IdiotBox::Inflator::Bucket->new({
 110       all_columns => [ qw(slug name) ],
 111       body_columns => [ qw(slug name) ],
 112       spec_columns => [ qw(slug) ],
 113       class => 'App::IdiotBox::Bucket',
 114       raw => $_[0],
 115     }),
 116     {
 117       select_all => q{
 118         SELECT slug, name
 119         FROM buckets
 120       },
 121       select_one => q{
 122         SELECT slug, name
 123         FROM buckets
 124         WHERE slug = ?
 125       },
 126       insert_one => q{
 127         INSERT INTO buckets
 128           (slug, name)
 129         VALUES
 130           (?, ?)
 131       },
 132       delete_one => q{
 133         DELETE FROM buckets WHERE slug = ?
 134       },
 135       update_one => q{
 136         UPDATE buckets SET slug = ?, name = ? WHERE slug = ?
 137       },
 138     }
 139   )
 140 }
 141
 142 {
 143   package App::IdiotBox::Inflator::BucketVideo;
 144
 145   use base qw(DBIx::Data::Store::Inflator::Simple);
 146   use Scalar::Util ();
 147
 148   sub new {
 149     my $new = shift->SUPER::new(@_);
 150     Scalar::Util::weaken($new->{bucket});
 151     $new;
 152   }
 153
 154   sub _bucket { shift->{bucket} }
 155
 156   sub inflate {
 157     my $self = shift;
 158     my $inflated = $self->SUPER::inflate(@_);
 159     Scalar::Util::weaken($inflated->{bucket} = $self->_bucket);
 160     $inflated;
 161   }
 162 }
 163
 164 sub _bind_bucket_videos {
 165   my ($raw, $bucket) = @_;
 166   _bind_set(
 167     $raw,
 168     App::IdiotBox::Inflator::BucketVideo->new({
 169       bucket => $bucket,
 170       spec_columns => [ qw(slug) ],
 171       all_columns => [ qw(slug name author details) ],
 172       body_columns => [ qw(announcement_id slug name author) ],
 173       class => 'App::IdiotBox::Video',
 174     }),
 175     {
 176       select_all => q{
 177         SELECT slug, name, author, details
 178         FROM videos
 179         WHERE bucket_slug = ?
 180         ORDER BY name
 181       },
 182       select_one => q{
 183         SELECT slug, name, author, details
 184         FROM videos
 185         WHERE slug = ? AND bucket_slug = ?
 186       },
 187       insert_one => q{
 188         INSERT INTO videos
 189           (announcement_id, slug, name, author, details, bucket_slug)
 190         VALUES
 191           (?, ?, ?, ?, '', ?)
 192       }
 193
 194     },
 195     { append_args => [ $bucket->slug ] }
 196   );
 197 }
 198
 199 1;