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         \%raw;
  25       }
  26     },
  27     set_over => [ 'id' ],
  28   },
  29   buckets => {
  30     class => {
  31       inflate => sub {
  32         my ($self, $obj) = @_;
  33         bless($obj, 'App::IdiotBox::Bucket');
  34         weaken (my $weak = $obj);
  35         $obj->{videos} = _bind_set('bucket_videos',
  36           {
  37             raw_store => $self->_store->raw_store,
  38             implicit_arguments => { 'bucket.slug' => $obj->{slug} },
  39           },
  40           {
  41             class => {
  42               inflate => sub {
  43                 my ($self, $obj) = @_;
  44                 bless($obj, 'App::IdiotBox::Video');
  45                 weaken($obj->{bucket} = $weak);
  46                 $obj;
  47               },
  48               deflate => sub {
  49                 my ($self, $obj) = @_;
  50                 my %raw = %$obj;
  51                 delete $raw{bucket};
  52                 \%raw;
  53               },
  54             }
  55           }
  56         );
  57         $obj;
  58       },
  59       deflate => sub {
  60         my ($self, $obj) = @_;
  61         my %raw = %$obj;
  62         delete $raw{videos};
  63         \%raw;
  64       }
  65     },
  66     set_over => [ 'slug' ],
  67   },
  68   bucket_videos => {
  69     set_over => [ 'slug' ]
  70   },
  71 );
  72
  73 %SQL = (
  74   recent_announcements => {
  75     select_column_order => [ qw(
  76       id made_at video_count bucket.slug bucket.name bucket.video_count
  77     ) ],
  78     select_sql => q{
  79       SELECT
  80         announcement.id, announcement.made_at, COUNT(DISTINCT my_videos.slug),
  81         bucket.slug, bucket.name, COUNT(DISTINCT all_videos.slug)
  82       FROM
  83         announcements announcement
  84         JOIN buckets bucket
  85           ON bucket.slug = announcement.bucket_slug
  86         JOIN videos my_videos
  87           ON my_videos.announcement_id = announcement.id
  88         JOIN videos all_videos
  89           ON all_videos.bucket_slug = announcement.bucket_slug
  90         JOIN announcements all_announcements
  91           ON all_announcements.bucket_slug = announcement.bucket_slug
  92       GROUP BY
  93         announcement.made_at, bucket.slug, bucket.name
  94       HAVING
  95         announcement.made_at = MAX(all_announcements.made_at)
  96       ORDER BY
  97         announcement.made_at DESC
  98     },
  99     insert_command_constructor => sub {
 100       require DBIx::Data::Store::Command::Insert::LastInsertId;
 101       my $self = shift;
 102       DBIx::Data::Store::Command::Insert::LastInsertId->new(
 103         id_column => 'id',
 104         raw_store => $self->raw_store,
 105         insert_call_command => $self->raw_store->new_call_command(@_)
 106       );
 107     },
 108     insert_sql => q{
 109       INSERT INTO announcements
 110         (bucket_slug, made_at)
 111       VALUES
 112         (?, ?)
 113     },
 114     insert_argument_order => [ qw(bucket.slug made_at) ],
 115   },
 116   buckets => {
 117     select_column_order => [ qw(slug name) ],
 118     select_single_sql => q{
 119       SELECT slug, name
 120       FROM buckets
 121       WHERE slug = ?
 122     },
 123     select_sql => q{
 124       SELECT slug, name
 125       FROM buckets
 126     },
 127     select_single_argument_order => [ 'slug' ],
 128   },
 129   bucket_videos => {
 130     select_column_order => [ qw(slug name author details) ],
 131     select_sql => q{
 132       SELECT slug, name, author, details
 133       FROM videos
 134       WHERE bucket_slug = ?
 135       ORDER BY name
 136     },
 137     select_argument_order => [ 'bucket.slug' ],
 138     select_single_sql => q{
 139       SELECT slug, name, author, details
 140       FROM videos
 141       WHERE bucket_slug = ? AND slug = ?
 142     },
 143     select_single_argument_order => [ qw(bucket.slug slug) ],
 144     insert_sql => q{
 145       INSERT INTO videos
 146         (announcement_id, bucket_slug, slug, name, author, details)
 147       VALUES
 148         (?, ?, ?, ?, ?, '')
 149     },
 150     insert_argument_order => [
 151       qw(announcement.id bucket.slug slug name author)
 152     ],
 153   },
 154 );
 155
 156 sub bind {
 157   my ($class, $idiotbox) = @_;
 158   bless({ idiotbox => $idiotbox }, $class)->_bind;
 159 }
 160
 161 sub _new_db_store {
 162   DBIx::Data::Store->connect("dbi:SQLite:$_[1]");
 163 }
 164
 165 sub _bind {
 166   my $self = shift;
 167   my $idiotbox = $self->{idiotbox};
 168
 169   my $db_store = $self->_new_db_store($idiotbox->config->{db_file});
 170
 171   foreach my $to_bind (qw(recent_announcements buckets)) {
 172     $idiotbox->{$to_bind} = _bind_set($to_bind, { raw_store => $db_store });
 173   }
 174   $idiotbox;
 175 }
 176
 177 sub _bind_set {
 178   my ($type, $store_args, $set_args) = @_;
 179   my $store = DBIx::Data::Store::CRUD->new({
 180     %{$SQL{$type}},
 181     %{$store_args},
 182   });
 183   return App::IdiotBox::DataSet->new({
 184     %{$BIND{$type}},
 185     store => $store,
 186     %{$set_args||{}},
 187   });
 188 }
 189
 190 1;