view release on metacpan or  search on metacpan

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

package DBIx::Class::AuditAny;
use strict;
use warnings;

# ABSTRACT: Flexible change tracking framework for DBIx::Class

our $VERSION = '0.200200';

use 5.010;

use Moo;
use MooX::Types::MooseLike::Base 0.19 qw(:all);

use Class::MOP;
use Class::MOP::Class;
use DateTime;
use DBIx::Class::AuditAny::Util;
use DBIx::Class::AuditAny::Util::BuiltinDatapoints;
use DBIx::Class::AuditAny::Role::Schema;

use Term::ANSIColor qw(:constants);

has 'time_zone', is => 'ro', isa => Str, default => sub{'local'};
sub get_dt { DateTime->now( time_zone => (shift)->time_zone ) }

has 'schema', is => 'ro', required => 1, isa => InstanceOf['DBIx::Class::Schema']; #<--- This won't go back to Moose
has 'track_immutable', is => 'ro', isa => Bool, default => sub{0};
has 'track_actions', is => 'ro', isa => ArrayRef, default => sub { [qw(insert update delete)] };
has 'allow_multiple_auditors', is => 'ro', isa => Bool, default => sub{0};

has 'source_context_class', is => 'ro', default => sub{'AuditContext::Source'};
has 'change_context_class', is => 'ro', default => sub{'AuditContext::Change'};
has 'changeset_context_class', is => 'ro', default => sub{'AuditContext::ChangeSet'};
has 'column_context_class', is => 'ro', default => sub{'AuditContext::Column'};
has 'default_datapoint_class', is => 'ro', default => sub{'DataPoint'};
has 'collector_class', is => 'ro', isa => Str;

around $_ => sub { 
	my $orig = shift; my $self = shift; 
	resolve_localclass $self->$orig(@_);
} for qw(
 source_context_class change_context_class
 changeset_context_class column_context_class
 default_datapoint_class collector_class
);

has 'collector_params', is => 'ro', isa => HashRef, default => sub {{}};
has 'primary_key_separator', is => 'ro', isa => Str, default => sub{'|~|'};
has 'datapoint_configs', is => 'ro', isa => ArrayRef[HashRef], default => sub {[]};
has 'auto_include_user_defined_datapoints', is => 'ro', isa => Bool, default => sub{1};
has 'rename_datapoints', is => 'ro', isa => Maybe[HashRef[Str]], default => sub{undef};
has 'disable_datapoints', is => 'ro', isa => ArrayRef, default => sub {[]};
has 'record_empty_changes', is => 'ro', isa => Bool, default => sub{0};

has 'datapoints', is => 'ro', isa => ArrayRef[Str], 
 default => sub{[qw(
  change_ts
  action
  source
  pri_key_value
  column_name
  old_value
  new_value
)]};

has 'collector', is => 'ro', lazy => 1, default => sub {
	my $self = shift;
	return ($self->collector_class)->new(
		%{$self->collector_params},
		AuditObj => $self
	);
};

# Any sources within the tracked schema that the collector is writing to; these
# sources are not allowed to be tracked because it would create infinite recursion:
has 'log_sources', is => 'ro', isa => ArrayRef[Str], lazy => 1, init_arg => undef, default => sub {
	my $self = shift;
	return $self->collector->writes_bound_schema_sources;
};

has 'tracked_action_functions', is => 'ro', isa => HashRef, default => sub {{}};
has 'tracked_sources', is => 'ro', isa => HashRef[Str], default => sub {{}};
has 'calling_action_function', is => 'ro', isa => HashRef[Bool], default => sub {{}};
has 'active_changeset', is => 'rw', isa => Maybe[Object], default => sub{undef};
has 'auto_finish', is => 'rw', isa => Bool, default => sub{0};

has 'track_init_args', is => 'ro', isa => Maybe[HashRef], default => sub{undef};
has 'build_init_args', is => 'ro', isa => HashRef, required => 1;

around BUILDARGS => sub {
	my $orig = shift;
	my $class = shift;
	my %opts = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref

	die 'Cannot specify build_init_args in new()' if (exists $opts{build_init_args});
	$opts{build_init_args} = { %opts };
	return $class->$orig(%opts);
};

sub track {
	my $class = shift;
	my %opts = (ref($_[0]) eq 'HASH') ? %{ $_[0] } : @_; # <-- arg as hash or hashref
	die "track cannot be called on object instances" if (ref $class);
	
	# Record the track init arguments:
	$opts{track_init_args} = { %opts };
	
	my $sources = exists $opts{track_sources} ? delete $opts{track_sources} : undef;
	die 'track_sources must be an arrayref' if ($sources and ! ref($sources) eq 'ARRAY');
	my $track_all = exists $opts{track_all_sources} ? delete $opts{track_all_sources} : undef;
	die "track_sources and track_all_sources are incompatible" if ($sources && $track_all);
	
	my $init_sources = exists $opts{init_sources} ? delete $opts{init_sources} : undef;
	die 'init_sources must be an arrayref' if ($init_sources and ! ref($init_sources) eq 'ARRAY');
	my $init_all = exists $opts{init_all_sources} ? delete $opts{init_all_sources} : undef;
	die "init_sources and init_all_sources are incompatible" if ($init_sources && $init_all);
	
	my $collect = exists $opts{collect} ? delete $opts{collect} : undef;
	if ($collect) {
		die "'collect' cannot be used with 'collector_params', 'collector_class' or 'collector'"
			if ($opts{collector_params} || $opts{collector_class} || $opts{collector});
			
		$opts{collector_class} = 'Collector::Code';
		$opts{collector_params} = { collect_coderef => $collect };
	}
	
	if($opts{collector}) {
		die "'collector' cannot be used with 'collector_params', 'collector_class' or 'collect'"
			if ($opts{collector_params} || $opts{collector_class} || $opts{collect});
	}
	
	my $self = $class->new(%opts);
	
	$self->track_sources(@$sources) if ($sources);
	$self->track_all_sources if ($track_all);
	
	$self->init_sources(@$init_sources) if ($init_sources);
	$self->init_all_sources if ($init_all);
	return $self;
}


sub _get_datapoint_configs {
	my $self = shift;
	
	my @configs = DBIx::Class::AuditAny::Util::BuiltinDatapoints->all_configs;
	
	# strip out any being redefined:
	my %cust = map {$_->{name}=>1} @{$self->datapoint_configs};
	@configs = grep { !$cust{$_->{name}} } @configs;
	
	# Set flag to mark the configs that were user defined
	$_->{user_defined} = 1 for (@{$self->datapoint_configs});
	
	push @configs, @{$self->datapoint_configs};
	
	return @configs;
}

has '_datapoints', is => 'ro', isa => HashRef, default => sub {{}};
has '_datapoints_context', is => 'ro', isa => HashRef, default => sub {{}};

# Also index datapoints by 'original_name' which will be different from 'name'
# whenever 'rename_datapoints' has been applied
has '_datapoints_orig_names', is => 'ro', isa => HashRef, default => sub {{}};
sub get_datapoint_orig { (shift)->_datapoints_orig_names->{(shift)} }

sub add_datapoints {
	my $self = shift;
	my $class = $self->default_datapoint_class;
	foreach my $cnf (@_) {
		die "'$cnf' not expected ref" unless (ref $cnf);
		$class = delete $cnf->{class} if ($cnf->{class});
		my $DataPoint = ref($cnf) eq $class ? $cnf : $class->new($cnf);
		die "Error creating datapoint object" unless (ref($DataPoint) eq $class);
		die "Duplicate datapoint name '" . $DataPoint->name . "'" if ($self->_datapoints->{$DataPoint->name});
		$self->_datapoints->{$DataPoint->name} = $DataPoint;
		$self->_datapoints_context->{$DataPoint->context}->{$DataPoint->name} = $DataPoint;
		$self->_datapoints_orig_names->{$DataPoint->original_name} = $DataPoint;
	}
}
sub all_datapoints { values %{(shift)->_datapoints} }

sub get_context_datapoints {
	my $self = shift;
	my @contexts = grep { exists $self->_datapoints_context->{$_} } @_;
	return map { values %{$self->_datapoints_context->{$_}} } @contexts;
}

sub get_context_datapoint_names {
	my $self = shift;
	return map { $_->name } $self->get_context_datapoints(@_);
}


sub local_datapoint_data { (shift)->base_datapoint_values }
has 'base_datapoint_values', is => 'ro', isa => HashRef, lazy => 1, default => sub {
	my $self = shift;
	return { map { $_->name => $_->get_value($self) } $self->get_context_datapoints('base') };
};

sub _init_datapoints {
	my $self = shift;
	
	my @configs = $self->_get_datapoint_configs;
	
	if($self->rename_datapoints) {
		my $rename = $self->rename_datapoints;
		
		@{$self->datapoints} = map { $rename->{$_} || $_ } @{$self->datapoints};
		
		foreach my $cnf (@configs) {
			next unless (exists $rename->{$cnf->{name}});
			$cnf->{original_name} = $cnf->{name};
			$cnf->{name} = $rename->{$cnf->{name}};
		}
	}
	
	my %seen = ();
	$seen{$_}++ and die "Duplicate datapoint name '$_'" for (@{$self->datapoints});
	
	my %disable = map {$_=>1} @{$self->disable_datapoints};
	my %activ = map {$_=>1} grep { !$disable{$_} } @{$self->datapoints};
	
	if($self->auto_include_user_defined_datapoints) {
		$activ{$_->{name}} = 1 for(grep { $_->{name} && $_->{user_defined} } @configs);
	}
	
	foreach my $cnf (@configs) {
		# Do this just to throw the exception for no name:
		$self->add_datapoints($cnf) unless ($cnf->{name});
		
		next unless $activ{$cnf->{name}};
		delete $activ{$cnf->{name}};
		$self->add_datapoints({%$cnf, AuditObj => $self});
	}
	
	die "Unknown datapoint(s) specified (" . join(',',keys %activ) . ')'
		if (scalar(keys %activ) > 0);
}


sub BUILD {
	my $self = shift;
	
	# init all classes first:
	$self->change_context_class;
	$self->changeset_context_class;
	$self->source_context_class;
	$self->column_context_class;
	$self->default_datapoint_class;
	
	$self->_init_datapoints;
	$self->_bind_schema;
	
	# init collector object:
	$self->collector;