[Bast-commits] r4721 - in DBIx-Class-Preview/1.000/trunk: . lib
lib/DBIx lib/DBIx/Class lib/DBIx/Class/ResultSource
lib/DBIx/Class/ResultSource/Table lib/DBIx/Class/Schema
lukes at dev.catalyst.perl.org
lukes at dev.catalyst.perl.org
Fri Aug 1 20:55:14 BST 2008
Author: lukes
Date: 2008-08-01 20:55:12 +0100 (Fri, 01 Aug 2008)
New Revision: 4721
Added:
DBIx-Class-Preview/1.000/trunk/lib/
DBIx-Class-Preview/1.000/trunk/lib/DBIx/
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Preview.pm
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Preview.pm
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Previewed.pm
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Schema/
DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Schema/Preview.pm
Log:
filed copied from takkle
Added: DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Preview.pm
===================================================================
--- DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Preview.pm (rev 0)
+++ DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Preview.pm 2008-08-01 19:55:12 UTC (rev 4721)
@@ -0,0 +1,49 @@
+package DBIx::Class::Preview;
+
+use warnings;
+use strict;
+use Storable ();
+use base qw/DBIx::Class/;
+
+=head1 NAME
+
+=head1 VERSION
+
+Version 1.000
+
+=cut
+
+our $VERSION = '1.000';
+
+__PACKAGE__->mk_group_accessors( 'simple' => qw/_current_partition/ );
+
+sub table {
+ my $class = shift;
+
+ my $table_class = 'DBIx::Class::ResultSource::Table::Previewed';
+ $class->ensure_class_loaded($table_class), $class->table_class($table_class)
+ unless $class->table_class->isa($table_class);
+
+ my $ret = $class->next::method(@_);
+ return $ret;
+}
+
+sub update {
+ my $self = shift;
+
+ # mark row as dirty
+ if ($self->result_source->schema->preview_active() && $self->result_source->can('is_preview_source')) {
+ $_[0] = {} unless ref $_[0];
+ $_[0]->{dirty} = 1 unless defined $_[0]->{dirty};
+ }
+
+ return $self->next::method(@_);
+}
+
+# dirty col set here by default value on the table def
+sub new {
+ my $self = shift;
+ return $self->next::method(@_);
+}
+
+1;
Added: DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Preview.pm
===================================================================
--- DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Preview.pm (rev 0)
+++ DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Preview.pm 2008-08-01 19:55:12 UTC (rev 4721)
@@ -0,0 +1,14 @@
+package DBIx::Class::ResultSource::Table::Preview;
+
+use warnings;
+use strict;
+
+use Scalar::Util ();
+use base qw/DBIx::Class::ResultSource::Table/;
+
+__PACKAGE__->mk_group_accessors( simple => qw/preview_table/ );
+
+sub from { return shift->preview_table }
+sub is_preview_source { 1 };
+
+1;
Added: DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Previewed.pm
===================================================================
--- DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Previewed.pm (rev 0)
+++ DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/ResultSource/Table/Previewed.pm 2008-08-01 19:55:12 UTC (rev 4721)
@@ -0,0 +1,42 @@
+package DBIx::Class::ResultSource::Table::Previewed;
+
+use warnings;
+use strict;
+
+use DBIx::Class::ResultSource::Table::Preview;
+use base qw/DBIx::Class::ResultSource::Table/;
+
+sub schema {
+ my $self = shift;
+
+ if ( @_ && !$self->schema ) { # only fire if we're getting schema set for first time
+ my ($schema) = @_;
+
+ my $new_source = DBIx::Class::ResultSource::Table::Preview->new({
+ %$self,
+ name => 'top_100_batch_preview',
+ _relationships => Storable::dclone( $self->_relationships ),
+ });
+ $new_source->add_column('dirty' => { data_type => 'integer', default_value => 1 });
+ $new_source->preview_table($self->from . '_preview');
+ $new_source->relationship_info($_)->{attrs}{cascade_delete} = 0
+ for $new_source->relationships;
+ my $new_source_name =
+ $self->source_name . '->preview(top_100_batch_preview)';
+ $schema->register_extra_source( $new_source_name => $new_source );
+ }
+
+ return $self->next::method(@_);
+}
+
+sub previewed {
+ my ( $self ) = @_;
+
+ my $schema = $self->schema || die "No schema";
+ my $partition =
+ $schema->source( $self->source_name . '->preview(top_100_batch_preview)' );
+ return $partition;
+}
+
+
+1;
Added: DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Schema/Preview.pm
===================================================================
--- DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Schema/Preview.pm (rev 0)
+++ DBIx-Class-Preview/1.000/trunk/lib/DBIx/Class/Schema/Preview.pm 2008-08-01 19:55:12 UTC (rev 4721)
@@ -0,0 +1,72 @@
+package DBIx::Class::Schema::Preview;
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->mk_group_accessors( simple => 'preview_active' );
+
+sub source {
+ my $self = shift;
+ my $source = $self->next::method(@_);
+
+ if (ref $self && $self->preview_active && $source->can('previewed') && (my $obj = $source->previewed())) {
+ $source = $obj;
+ }
+
+ return $source;
+}
+
+sub unpreviewed {
+ my $self = shift;
+
+ my $clone = { (ref $self ? %$self : ()) };
+ bless $clone, (ref $self || $self);
+ $clone->preview_active(0);
+ foreach my $moniker ($self->sources) {
+ my $source = $clone->source($moniker);
+ my $new = $source->new($source);
+ $clone->register_extra_source($moniker => $new);
+ }
+ $clone->storage->set_schema($clone) if $clone->storage;
+ return $clone;
+}
+
+# call this to move all dirty rows to the main table
+sub publish {
+ my $self = shift;
+
+ unless ($self->preview_active) {
+ warn 'preview mode not activated, can not publish';
+ return;
+ }
+ my $schema = $self->unpreviewed;
+
+ $schema->txn_do(
+ sub {
+ foreach my $source_name ($schema->sources) {
+ my $source = $schema->source($source_name);
+ if ($source->can('previewed')) {
+ my $original_rs = $schema->resultset($source->source_name);
+ my $previewed_rs = $self->resultset($source->source_name);
+
+ my $dirty_previewed_rs = $previewed_rs->search({ dirty => 1 });
+ while (my $dirty_row = $dirty_previewed_rs->next) {
+ my $original_row = $original_rs->find($dirty_row->id);
+ my %dirty_cols = $dirty_row->get_columns;
+ delete $dirty_cols{dirty};
+ if ($original_row) {
+ $original_row->update(\%dirty_cols);
+ } else {
+ $original_rs->create(\%dirty_cols);
+ }
+ }
+ $dirty_previewed_rs->update({ dirty => 0 });
+ }
+ }
+ }
+ );
+}
+
+1;
More information about the Bast-commits
mailing list