view release on metacpan or  search on metacpan

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

This Collector facilitates recording ChangeSets, Changes, and Column Changes within a
clean relational structure into a DBIC schema.

If you don't want to handle the details of configuring this yourself, see 
L<DBIx::Class::AuditAny::Collector::AutoDBIC> which is a subclass of us, but handles
most of the defaults for you w/o fuss.

=head1 ATTRIBUTES

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

=head2 target_schema

=head2 target_source

=head2 change_data_rel

=head2 column_data_rel

=cut

has 'target_schema', is => 'ro', isa => Object, lazy => 1, default => sub { (shift)->AuditObj->schema };
has 'target_source', is => 'ro', isa => Str, required => 1;
has 'change_data_rel', is => 'ro', isa => Maybe[Str];
has 'column_data_rel', is => 'ro', isa => Maybe[Str];


# the top level source; could be either change or changeset
has 'targetSource', is => 'ro', isa => Object, 
 lazy => 1, init_arg => undef, default => sub {
	my $self = shift;
	my $Source = $self->target_schema->source($self->target_source) 
		or die "Bad target_source name '" . $self->target_source . "'";
	return $Source;
};

has 'changesetSource', is => 'ro', isa => Maybe[Object], 
 lazy => 1, init_arg => undef, default => sub {
	my $self = shift;
	return $self->change_data_rel ? $self->targetSource : undef;
};

has 'changeSource', is => 'ro', isa => Object, 
 lazy => 1, init_arg => undef, default => sub {
	my $self = shift;
	my $SetSource = $self->changesetSource or return $self->targetSource;
	my $Source = $SetSource->related_source($self->change_data_rel)
		or die "Bad change_data_rel name '" . $self->change_data_rel . "'";
	return $Source;
};

has 'columnSource', is => 'ro', isa => Maybe[Object], 
 lazy => 1, init_arg => undef, default => sub {
	my $self = shift;
	return undef unless ($self->column_data_rel);
	my $Source = $self->changeSource->related_source($self->column_data_rel)
		or die "Bad column_data_rel name '" . $self->column_data_rel . "'";
	return $Source;
};

has 'changeset_datapoints', is => 'ro', isa => ArrayRef[Str],
 lazy => 1, default => sub {
	my $self = shift;
	return [] unless ($self->changesetSource);
	my @DataPoints = $self->AuditObj->get_context_datapoints(qw(base set));
	my @names = map { $_->name } @DataPoints;
	$self->enforce_source_has_columns($self->changesetSource,@names);
	return \@names;
};

has 'change_datapoints', is => 'ro', isa => ArrayRef[Str],
 lazy => 1, default => sub {
	my $self = shift;
	my @contexts = qw(source change);
	push @contexts,(qw(base set)) unless ($self->changesetSource);
	my @DataPoints = $self->AuditObj->get_context_datapoints(@contexts);
	my @names = map { $_->name } @DataPoints;
	$self->enforce_source_has_columns($self->changeSource,@names);
	return \@names;
};

has 'column_datapoints', is => 'ro', isa => ArrayRef[Str],
 lazy => 1, default => sub {
	my $self = shift;
	return [] unless ($self->columnSource);
	my @DataPoints = $self->AuditObj->get_context_datapoints(qw(column));
	my @names = map { $_->name } @DataPoints;
	$self->enforce_source_has_columns($self->columnSource,@names);
	return \@names;
};

has 'write_sources', is => 'ro', isa => ArrayRef[Str], lazy => 1, default => sub {
	my $self = shift;
	my @sources = ();
	push @sources, $self->changesetSource->source_name if ($self->changesetSource);
	push @sources, $self->changeSource->source_name if ($self->changeSource);
	push @sources, $self->columnSource->source_name if ($self->columnSource);
	return \@sources;
};

has '+writes_bound_schema_sources', default => sub {
	my $self = shift;
	return $self->target_schema == $self->AuditObj->schema ? 
		$self->write_sources : [];
};

sub BUILD {
	my $self = shift;
	
	$self->validate_target_schema;

}

=head1 METHODS

=head2 validate_target_schema

=cut
sub validate_target_schema {
	my $self = shift;
	
	$self->changeset_datapoints;
	$self->change_datapoints;
	$self->column_datapoints;
	
}

=head2 enforce_source_has_columns

=cut
sub enforce_source_has_columns {
	my $self = shift;
	my $Source = shift;
	my @columns = @_;
	
	my @missing = ();
	$Source->has_column($_) or push @missing, $_ for (@columns);
	
	return 1 unless (scalar(@missing) > 0);
	
	die "Source '" . $Source->source_name . "' missing required columns: " . 
		join(',',map { "'$_'" } @missing);
}

=head2 get_add_create_change

=cut
sub get_add_create_change {
	my $self = shift;
	my $ChangeContext = shift;
	
	my $create = $ChangeContext->get_datapoints_data($self->change_datapoints);