lib/App/IdiotBox/Store/SQLite.pm

   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 sub _new_db_store {
 133   DBIx::Data::Store->connect("dbi:SQLite:$_[1]");
 134 }
 135
 136 sub _bind {
 137   my $self = shift;
 138   my $idiotbox = $self->{idiotbox};
 139
 140   my $db_store = $self->_new_db_store($idiotbox->config->{db_file});
 141
 142   foreach my $to_bind (qw(recent_announcements buckets)) {
 143     $idiotbox->{$to_bind} = _bind_set($to_bind, { raw_store => $db_store });
 144   }
 145   $idiotbox;
 146 }
 147
 148 sub _bind_set {
 149   my ($type, $store_args, $set_args) = @_;
 150   my $store = DBIx::Data::Store::CRUD->new({
 151     %{$SQL{$type}},
 152     %{$store_args},
 153   });
 154   return App::IdiotBox::DataSet->new({
 155     %{$BIND{$type}},
 156     store => $store,
 157     %{$set_args||{}},
 158   });
 159 }
 160
 161 1;