[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