package App::IdiotBox::Store::SQLite;
-use strict;
-use warnings FATAL => 'all';
-use DBIx::Data::Store;
+use strictures 1;
+
+use DBIx::Data::Collection::Set::Wrapper::Inflate;
use DBIx::Data::Store::CRUD;
-use App::IdiotBox::DataSet;
-use Scalar::Util qw(weaken);
-
-my (%BIND, %SQL);
-
-%BIND = (
- recent_announcements => {
- class => {
- inflate => sub {
- my ($self, $obj) = @_;
- bless($obj, 'App::IdiotBox::Announcement');
- bless($obj->{bucket}, 'App::IdiotBox::Bucket');
- $obj;
+use DBIx::Data::Store::Raw;
+
+sub bind {
+ my ($class, $ib) = @_;
+ my $raw = DBIx::Data::Store::Raw->connect(
+ 'dbi:SQLite:'.$ib->config->{db_file}
+ );
+ $ib->{recent_announcements} = _bind_announcements($raw);
+ $ib->{buckets} = _bind_buckets($raw);
+}
+
+sub _bind_set {
+ my ($raw, $inflator, $sql, $extra) = @_;
+ DBIx::Data::Collection::Set::Wrapper::Inflate->new({
+ inflator => $inflator,
+ inner => DBIx::Data::Store::CRUD->new({
+ raw => $raw,
+ sql => $sql,
+ %{$extra||{}},
+ })
+ });
+}
+
+{
+ package App::IdiotBox::Inflator::Announcement;
+
+ sub inflate {
+ my ($self, $raw) = @_;
+ my %new = (bucket => bless({}, 'App::IdiotBox::Bucket'));
+ (@new{qw(id made_at video_count)},
+ @{$new{bucket}}{qw(slug name video_count)})
+ = @$raw;
+ bless(\%new, 'App::IdiotBox::Announcement');
+ }
+
+ sub deflate_body {
+ my ($self, $body) = @_;
+ [ $body->{bucket}{slug}, $body->{made_at} ]
+ }
+}
+
+sub _bind_announcements {
+ _bind_set(
+ $_[0],
+ 'App::IdiotBox::Inflator::Announcement',
+ {
+ select_all => q{
+ SELECT
+ announcement.id, announcement.made_at, COUNT(DISTINCT my_videos.slug),
+ bucket.slug, bucket.name, COUNT(DISTINCT all_videos.slug)
+ FROM
+ announcements announcement
+ JOIN buckets bucket
+ ON bucket.slug = announcement.bucket_slug
+ JOIN videos my_videos
+ ON my_videos.announcement_id = announcement.id
+ JOIN videos all_videos
+ ON all_videos.bucket_slug = announcement.bucket_slug
+ JOIN announcements all_announcements
+ ON all_announcements.bucket_slug = announcement.bucket_slug
+ GROUP BY
+ announcement.made_at, bucket.slug, bucket.name
+ HAVING
+ announcement.made_at = MAX(all_announcements.made_at)
+ ORDER BY
+ announcement.made_at DESC
},
- deflate => sub {
- my ($self, $obj) = @_;
- my %raw = %$obj;
- \%raw;
- }
- },
- set_over => [ 'id' ],
- },
- buckets => {
- class => {
- inflate => sub {
- my ($self, $obj) = @_;
- bless($obj, 'App::IdiotBox::Bucket');
- weaken (my $weak = $obj);
- $obj->{videos} = _bind_set('bucket_videos',
- {
- raw_store => $self->_store->raw_store,
- implicit_arguments => { 'bucket.slug' => $obj->{slug} },
- },
- {
- class => {
- inflate => sub {
- my ($self, $obj) = @_;
- bless($obj, 'App::IdiotBox::Video');
- weaken($obj->{bucket} = $weak);
- $obj;
- },
- deflate => sub {
- my ($self, $obj) = @_;
- my %raw = %$obj;
- delete $raw{bucket};
- \%raw;
- },
- }
- }
- );
- $obj;
+ insert_sql => sub {
+ my ($store, undef, $dbh, $args) = @_;
+ $store->_sth_for($dbh, q{
+ INSERT INTO announcements
+ (bucket_slug, made_at)
+ VALUES
+ (?, ?)
+ }, $args);
+ [ $dbh->last_insert_id(undef,undef,undef,undef),
+ $args->[1], 0, $args->[0], undef, undef ];
},
- deflate => sub {
- my ($self, $obj) = @_;
- my %raw = %$obj;
- delete $raw{videos};
- \%raw;
- }
- },
- set_over => [ 'slug' ],
- },
- bucket_videos => {
- set_over => [ 'slug' ]
- },
-);
-
-%SQL = (
- recent_announcements => {
- select_column_order => [ qw(
- id made_at video_count bucket.slug bucket.name bucket.video_count
- ) ],
- select_sql => q{
- SELECT
- announcement.id, announcement.made_at, COUNT(DISTINCT my_videos.slug),
- bucket.slug, bucket.name, COUNT(DISTINCT all_videos.slug)
- FROM
- announcements announcement
- JOIN buckets bucket
- ON bucket.slug = announcement.bucket_slug
- JOIN videos my_videos
- ON my_videos.announcement_id = announcement.id
- JOIN videos all_videos
- ON all_videos.bucket_slug = announcement.bucket_slug
- JOIN announcements all_announcements
- ON all_announcements.bucket_slug = announcement.bucket_slug
- GROUP BY
- announcement.made_at, bucket.slug, bucket.name
- HAVING
- announcement.made_at = MAX(all_announcements.made_at)
- ORDER BY
- announcement.made_at DESC
- },
- insert_command_constructor => sub {
- require DBIx::Data::Store::Command::Insert::LastInsertId;
- my $self = shift;
- DBIx::Data::Store::Command::Insert::LastInsertId->new(
- id_column => 'id',
- raw_store => $self->raw_store,
- insert_call_command => $self->raw_store->new_call_command(@_)
- );
- },
- insert_sql => q{
- INSERT INTO announcements
- (bucket_slug, made_at)
- VALUES
- (?, ?)
- },
- insert_argument_order => [ qw(bucket.slug made_at) ],
- },
- buckets => {
- select_column_order => [ qw(slug name) ],
- select_single_sql => q{
- SELECT slug, name
- FROM buckets
- WHERE slug = ?
- },
- select_sql => q{
- SELECT slug, name
- FROM buckets
- },
- select_single_argument_order => [ 'slug' ],
- },
- bucket_videos => {
- select_column_order => [ qw(slug name author details) ],
- select_sql => q{
- SELECT slug, name, author, details
- FROM videos
- WHERE bucket_slug = ?
- ORDER BY name
- },
- select_argument_order => [ 'bucket.slug' ],
- select_single_sql => q{
- SELECT slug, name, author, details
- FROM videos
- WHERE bucket_slug = ? AND slug = ?
- },
- select_single_argument_order => [ qw(bucket.slug slug) ],
- insert_sql => q{
- INSERT INTO videos
- (announcement_id, bucket_slug, slug, name, author, details)
- VALUES
- (?, ?, ?, ?, ?, '')
- },
- insert_argument_order => [
- qw(announcement.id bucket.slug slug name author)
- ],
- },
-);
+ }
+ )
+}
-sub bind {
- my ($class, $idiotbox) = @_;
- bless({ idiotbox => $idiotbox }, $class)->_bind;
+{
+ package App::IdiotBox::Inflator::Bucket;
+
+ use base qw(DBIx::Data::Store::Inflator::Simple);
+
+ sub _raw { shift->{raw} }
+
+ sub inflate {
+ my $self = shift;
+ my $inflated = $self->SUPER::inflate(@_);
+ $inflated->{videos} = App::IdiotBox::Store::SQLite::_bind_bucket_videos(
+ $self->_raw, $inflated
+ );
+ $inflated;
+ }
}
-sub _new_db_store {
- DBIx::Data::Store->connect("dbi:SQLite:$_[1]");
+sub _bind_buckets {
+ _bind_set(
+ $_[0],
+ App::IdiotBox::Inflator::Bucket->new({
+ all_columns => [ qw(slug name) ],
+ spec_columns => [ qw(slug) ],
+ class => 'App::IdiotBox::Bucket',
+ raw => $_[0],
+ }),
+ {
+ select_all => q{
+ SELECT slug, name
+ FROM buckets
+ },
+ select_one => q{
+ SELECT slug, name
+ FROM buckets
+ WHERE slug = ?
+ },
+ }
+ )
}
-sub _bind {
- my $self = shift;
- my $idiotbox = $self->{idiotbox};
+{
+ package App::IdiotBox::Inflator::BucketVideo;
- my $db_store = $self->_new_db_store($idiotbox->config->{db_file});
+ use base qw(DBIx::Data::Store::Inflator::Simple);
+ use Scalar::Util ();
- foreach my $to_bind (qw(recent_announcements buckets)) {
- $idiotbox->{$to_bind} = _bind_set($to_bind, { raw_store => $db_store });
+ sub new {
+ my $new = shift->SUPER::new(@_);
+ Scalar::Util::weaken($new->{bucket});
+ $new;
+ }
+
+ sub _bucket { shift->{bucket} }
+
+ sub inflate {
+ my $self = shift;
+ my $inflated = $self->SUPER::inflate(@_);
+ Scalar::Util::weaken($inflated->{bucket} = $self->_bucket);
+ $inflated;
}
- $idiotbox;
}
-sub _bind_set {
- my ($type, $store_args, $set_args) = @_;
- my $store = DBIx::Data::Store::CRUD->new({
- %{$SQL{$type}},
- %{$store_args},
- });
- return App::IdiotBox::DataSet->new({
- %{$BIND{$type}},
- store => $store,
- %{$set_args||{}},
- });
+sub _bind_bucket_videos {
+ my ($raw, $bucket) = @_;
+ _bind_set(
+ $raw,
+ App::IdiotBox::Inflator::BucketVideo->new({
+ bucket => $bucket,
+ spec_columns => [ qw(slug) ],
+ all_columns => [ qw(slug name author details) ],
+ body_columns => [ qw(announcement_id slug name author) ],
+ class => 'App::IdiotBox::Video',
+ }),
+ {
+ select_all => q{
+ SELECT slug, name, author, details
+ FROM videos
+ WHERE bucket_slug = ?
+ ORDER BY name
+ },
+ select_one => q{
+ SELECT slug, name, author, details
+ FROM videos
+ WHERE slug = ? AND bucket_slug = ?
+ },
+ insert_one => q{
+ INSERT INTO videos
+ (announcement_id, slug, name, author, details, bucket_slug)
+ VALUES
+ (?, ?, ?, ?, '', ?)
+ }
+
+ },
+ { append_args => [ $bucket->slug ] }
+ );
}
1;
projects / catagits/App-IdiotBox.git / blobdiff