From: Matt S Trout <matthewt@hercule.scsys.co.uk>
Date: Sun, 29 Aug 2010 11:46:20 +0000 (+0100)
Subject: move to new DBIxDS code
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FApp-IdiotBox.git;a=commitdiff_plain;h=6df0509024f4a9c2c545615b6648ca1365689cfc

move to new DBIxDS code
---

diff --git a/lib/App/IdiotBox.pm b/lib/App/IdiotBox.pm
index 2b79dee..497cb98 100644
--- a/lib/App/IdiotBox.pm
+++ b/lib/App/IdiotBox.pm
@@ -128,7 +128,7 @@ method show_video ($video) {
   $self->html_response(video => sub {
     my $video_url = 
       $self->base_url
-      .$video_file;
+      .($video_file||'NO FILE FOUND SORRY');
 
     $_->select('.video-name')->replace_content($video->name)
       ->select('.author-name')->replace_content($video->author)
diff --git a/lib/App/IdiotBox/DataSet.pm b/lib/App/IdiotBox/DataSet.pm
deleted file mode 100644
index 0057d13..0000000
--- a/lib/App/IdiotBox/DataSet.pm
+++ /dev/null
@@ -1,53 +0,0 @@
-package App::IdiotBox::DataSet;
-
-use strict;
-use warnings FATAL => 'all';
-use Scalar::Util qw(blessed);
-
-use base qw(DBIx::Data::Collection::Set);
-
-sub _inflate {
-  my ($self, $raw) = @_;
-  my %new;
-  foreach my $k (keys %$raw) {
-    my @parts = split /\./, $k;
-    my $final = pop @parts;
-    @parts or ($new{$k} = $raw->{$k}, next);
-    my $targ = \%new;
-    $targ = $targ->{$_}||={} for @parts;
-    $targ->{$final} = $raw->{$k};
-  }
-  $self->_class->{inflate}->($self, \%new);
-}
-
-sub _deflate {
-  my ($self, $obj) = @_;
-  my $fat_raw = $self->_class->{deflate}->($self, $obj);
-  $self->_splat($fat_raw)
-}
-
-sub _splat {
-  my ($self, $fat) = @_;
-  my %raw;
-  foreach my $key (keys %$fat) {
-    my $v = $fat->{$key};
-    $v = { %$v } if blessed($v);
-    if (ref($v) eq 'HASH') {
-      #my $splat = $self->_splat($v);
-      my $splat = $v;
-      @raw{map "${key}.$_", keys %$splat} = values %$splat;
-    } else {
-      $raw{$key} = $v;
-    }
-  }
-  \%raw
-}
-
-sub _merge {
-  my ($self, $new, $to_merge) = @_;
-#require Carp; warn Carp::longmess; warn $new; warn $to_merge;
-  @{$new}{keys %$to_merge} = values %$to_merge;
-  return
-}
-
-1;
diff --git a/lib/App/IdiotBox/Store/SQLite.pm b/lib/App/IdiotBox/Store/SQLite.pm
index accf668..2f17260 100644
--- a/lib/App/IdiotBox/Store/SQLite.pm
+++ b/lib/App/IdiotBox/Store/SQLite.pm
@@ -1,190 +1,186 @@
 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;
diff --git a/t/store/sqlite.t b/t/store/sqlite.t
index dca7489..a31f1c0 100644
--- a/t/store/sqlite.t
+++ b/t/store/sqlite.t
@@ -2,14 +2,15 @@ use strict;
 use warnings FATAL => 'all';
 
 use App::IdiotBox::Store::SQLite;
+use App::IdiotBox;
 
 use Devel::Dwarn;
 
-my $ib = {};
+my $ib = App::IdiotBox->new;
 
 App::IdiotBox::Store::SQLite->bind($ib);
 
-#Dwarn [ $ib->{recent_announcements}->flatten ];
+Dwarn [ $ib->{recent_announcements}->flatten ];
 my $bucket = DwarnS $ib->{buckets}->get({ slug => 'opw2010'});
 
 #Dwarn [ $bucket->{videos}->flatten ];