view release on metacpan or  search on metacpan

lib/DBIx/Class/AuditAny/Collector/AutoDBIC.pm  view on Meta::CPAN

use MooX::Types::MooseLike::Base qw(:all);
extends 'DBIx::Class::AuditAny::Collector::DBIC';

=head1 NAME

DBIx::Class::AuditAny::Collector::AutoDBIC - Collector class for recording AuditAny 
changes in auto-generated DBIC schemas

=head1 DESCRIPTION

This Collector facilitates recording ChangeSets, Changes, and Column Changes within a
clean relational structure into an automatically configured and deployed DBIC schema
using SQLite database files.

This class extends L<DBIx::Class::AuditAny::Collector::DBIC> which provides greater 
flexibility for configuration, can record to different forms of databases and tables,
and so on

=head1 ATTRIBUTES

Docs regarding the API/purpose of the attributes and methods in this class still TBD...

=head2 auto_deploy

=head2 change_data_rel

=head2 change_source_name

=head2 changeset_source_name

=head2 column_change_source_name

=head2 column_data_rel

=head2 deploy_info_source_name

=head2 reverse_change_data_rel

=head2 reverse_changeset_data_rel

=head2 sqlite_db

=head1 METHODS

=head2 get_context_column_infos

=head2 init_schema_namespace

=head2 deploy_schema

=head2 get_clean_md5

=cut

use DBIx::Class::AuditAny::Util;
use DBIx::Class::AuditAny::Util::SchemaMaker;
use String::CamelCase qw(decamelize);
use Digest::MD5 qw(md5_hex);
use Data::Dumper;

has 'connect', is => 'ro', isa => ArrayRef, lazy => 1, default => sub {
	my $self = shift;
	my $db = $self->sqlite_db or die "no 'connect' or 'sqlite_db' specified.";
	return [ "dbi:SQLite:dbname=$db","","", { AutoCommit => 1 } ];
};

has 'sqlite_db', is => 'ro', isa => Maybe[Str], default => sub{undef};
has 'auto_deploy', is => 'ro', isa => Bool, default => sub{1};

has 'target_schema_namespace', is => 'ro', lazy => 1, default => sub {
	my $self = shift;
	return ref($self->AuditObj->schema) . '::AuditSchema';
};

has '+target_schema', default => sub {
	my $self = shift;
	
	my $class = $self->init_schema_namespace;
	my $schema = $class->connect(@{$self->connect});
	$self->deploy_schema($schema) if ($self->auto_deploy);
	
	return $schema;
};

has 'target_source', is => 'ro', isa => Str, lazy => 1, 
 default => sub { (shift)->changeset_source_name };

has 'changeset_source_name', 		is => 'ro', isa => Str, default => sub{'AuditChangeSet'};
has 'change_source_name', 			is => 'ro', isa => Str, default => sub{'AuditChange'};
has 'column_change_source_name',	is => 'ro', isa => Str, default => sub{'AuditChangeColumn'};
has 'deploy_info_source_name',	is => 'ro', isa => Str, default => sub{'DeployInfo'};

has 'changeset_table_name', is => 'ro', isa => Str, lazy => 1, 
 default => sub { decamelize((shift)->changeset_source_name) };
	
has 'change_table_name', is => 'ro', isa => Str, lazy => 1, 
 default => sub { decamelize((shift)->change_source_name) };
	
has 'column_change_table_name',	is => 'ro', isa => Str, lazy => 1, 
 default => sub { decamelize((shift)->column_change_source_name) };

has 'deploy_info_table_name',	is => 'ro', isa => Str, lazy => 1, 
 default => sub { decamelize((shift)->deploy_info_source_name) };

has '+change_data_rel', default => sub{'audit_changes'};
has '+column_data_rel', default => sub{'audit_change_columns'};
has 'reverse_change_data_rel', is => 'ro', isa => Str, default => sub{'change'};
has 'reverse_changeset_data_rel', is => 'ro', isa => Str, default => sub{'changeset'};

has 'changeset_columns', is => 'ro', isa => ArrayRef, lazy => 1,
 default => sub {
	my $self = shift;
	return [
		id => {
			data_type => "integer",
			extra => { unsigned => 1 },
			is_auto_increment => 1,
			is_nullable => 0,
		},
		$self->get_context_column_infos(qw(base set))
	];
};

has 'change_columns', is => 'ro', isa => ArrayRef, lazy => 1,
 default => sub {
	my $self = shift;
	return [
		id => {
			data_type => "integer",
			extra => { unsigned => 1 },
			is_auto_increment => 1,
			is_nullable => 0,
		}, 
		changeset_id => {
			data_type => "integer",
			extra => { unsigned => 1 },
			is_foreign_key => 1,
			is_nullable => 0,
		},
		$self->get_context_column_infos(qw(source change))
	];
};

has 'change_column_columns', is => 'ro', isa => ArrayRef, lazy => 1,
 default => sub {
	my $self = shift;
	return [
		id => {
			data_type => "integer",
			extra => { unsigned => 1 },
			is_auto_increment => 1,
			is_nullable => 0,
		}, 
		change_id => {
			data_type => "integer",
			extra => { unsigned => 1 },
			is_foreign_key => 1,
			is_nullable => 0,
		},
		$self->get_context_column_infos(qw(column))
	];
};

# Gets and validates DBIC column configs per supplied datapoint contexts
sub get_context_column_infos {
	my $self = shift;
	my @DataPoints = $self->AuditObj->get_context_datapoints(@_);
	return () unless (scalar @DataPoints > 0);
	
	my %reserved 		= map {$_=>1} qw(id changeset_id change_id);
	my %no_accessor 	= map {$_=>1} qw(new meta);
	
	my @cols = ();
	foreach my $DataPoint (@DataPoints) {
		my $name = $DataPoint->name;
		my $info = $DataPoint->column_info;
		$reserved{$name}		and die "Bad datapoint name '$name' - reserved keyword.";
		$no_accessor{$name}	and $info->{accessor} = undef;
		push @cols, ( $name => $info );
	}
	
	return @cols;
}


has 'schema_namespace_config', is => 'ro', isa => HashRef, init_arg => undef, lazy => 1,
 default => sub {
	my $self = shift;
	
	my $ColumnName = $self->AuditObj->get_datapoint_orig('column_name');
	my $col_context_uniq_const = $ColumnName ? 
		[ add_unique_constraint => ["change_id", ["change_id", $ColumnName->name]] ] : [];

	my $namespace = $self->target_schema_namespace;
	return {
		schema_namespace => $namespace,
		results => {
			$self->deploy_info_source_name => {
				table_name => $self->deploy_info_table_name,
				columns => [
					md5 => { 
						data_type => "char", 
						is_nullable => 0, 
						size => 32 
					},
					comment => { 
						data_type => "varchar", 
						is_nullable => 0, 
						size => 255 
					},
					deployed_ddl => {
						data_type	=> 'mediumtext',
						is_nullable	=> 0
					},
					deployed_ts	=> { 
						data_type => "datetime", 
						datetime_undef_if_invalid => 1, 
						is_nullable => 0 
					},
					auditany_params => {
						data_type	=> 'mediumtext',
						is_nullable	=> 0
					},
				],
				call_class_methods => [
					set_primary_key => ['md5'],
				]
			},
			$self->changeset_source_name => {
				table_name => $self->changeset_table_name,
				columns => $self->changeset_columns,
				call_class_methods => [
					set_primary_key => ['id'],
					has_many => [
						$self->change_data_rel,
						$namespace . '::' . $self->change_source_name,
						{ "foreign.changeset_id" => "self.id" },
						{ cascade_copy => 0, cascade_delete => 0 },
					]
				]
			},
			$self->change_source_name => {
				table_name => $self->change_table_name,
				columns => $self->change_columns,
				call_class_methods => [
					set_primary_key => ['id'],