DBIx-Class-AuditAny

 view release on metacpan or  search on metacpan

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

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);
};

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

	@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);

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

	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) {

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

=cut
has 'action', is => 'ro', isa => Enum[qw(insert update delete select)], required => 1;


=head2 old_columns

The column values of the row, -according to the db- *before* the change happens.
This should be an empty hashref in the case of 'insert'

=cut
has 'old_columns', is => 'ro', isa => HashRef, lazy => 1, default => sub {{}};

=head2 to_columns

The column changes specified -by the change- (specified by
the client/query). Note that this is different from 'new_columns' and
probably doesn't contain all the columns. This should be an empty
hashref in the case of 'delete'
(TODO: would 'change_columns' a better name than 'to_columns'?)

=cut
has 'to_columns', is => 'ro', isa => HashRef, lazy => 1, default => sub{{}};

=head2 new_columns

The column values of the row, -according to the db- *after* the change happens.
This should be an empty hashref in the case of 'delete' 

=cut
has 'new_columns', is => 'ro', isa => HashRef, lazy => 1, default => sub {{}};

=head2 condition

The condition associated with this change, applies to 'update' and 'delete'

=cut
has 'condition', is => 'ro', isa => Ref, lazy => 1, default => sub {{}};

=head2 recorded

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

has 'start_timeofday', is => 'ro', default => sub { [gettimeofday] };

=head2 change_elapsed

=cut
has 'change_elapsed', is => 'rw', default => sub{undef};

=head2 column_changes

=cut
has 'column_changes', is => 'ro', isa => HashRef[Object], lazy => 1, default => sub {
	my $self = shift;
	$self->enforce_recorded;
	
	my $old = $self->old_columns;
	my $new = $self->new_columns;
	
	# This logic is duplicated in DbicLink2. Not sure how to avoid it, though,
	# and keep a clean API
	my @changed = ();
	foreach my $col (uniq(keys %$new,keys %$old)) {

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

			column_name => $column, 
			old_value => $old->{$column}, 
			new_value => $new->{$column},
		);
		$col_context{$ColumnContext->column_name} = $ColumnContext;
	}
	
	return \%col_context;
};

has 'column_datapoint_values', is => 'ro', isa => HashRef, lazy => 1, default => sub {
	my $self = shift;
	#my @Contexts = $self->all_column_changes;
	my @Contexts = values %{$self->column_changes};
	return { map { $_->column_name => $_->local_datapoint_data } @Contexts };
};


has 'column_changes_ascii', is => 'ro', isa => Str, lazy => 1, default => sub {
	my $self = shift;
	my $table = $self->column_changes_arr_arr_table;

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

};

has 'column_changes_json', is => 'ro', isa => Str, lazy => 1, default => sub {
	my $self = shift;
	my $table = $self->column_changes_arr_arr_table;
	require JSON;
	return JSON::encode_json($table);
};


has 'column_changes_arr_arr_table', is => 'ro', isa => ArrayRef,
 lazy => 1, default => sub {
	my $self = shift;
	my @cols = $self->get_context_datapoint_names('column');
	
	my @col_datapoints = values %{$self->column_datapoint_values};
	
	my $table = [\@cols];
	foreach my $col_data (@col_datapoints) {
		my @row = map { $col_data->{$_} || undef } @cols;
		push @$table, \@row;

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

=head2 changeset_ts

=head2 start_timeofday

=head2 changeset_finish_ts

=head2 changeset_elapsed

=cut

has 'changes', is => 'ro', isa => ArrayRef, default => sub {[]};
has 'finished', is => 'rw', isa => Bool, default => sub{0}, init_arg => undef;

has 'changeset_ts', is => 'ro', isa => InstanceOf['DateTime'], lazy => 1, default => sub { (shift)->get_dt };
has 'start_timeofday', is => 'ro', default => sub { [gettimeofday] };

has 'changeset_finish_ts', is => 'rw', isa => Maybe[InstanceOf['DateTime']], default => sub{undef};
has 'changeset_elapsed', is => 'rw', default => sub{undef};

sub BUILD {
	my $self = shift;

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

=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;

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

 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 => {

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

		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,

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

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;

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

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

=head2 column_info

defines the schema needed to store this datapoint within
a DBIC Result/table. Only used in collectors like Collector::AutoDBIC

=cut
has 'column_info', is => 'ro', isa => HashRef, lazy => 1, 
 default => sub { my $self = shift; $self->_get_column_info->($self) };
  
has '_get_column_info', is => 'ro', isa => CodeRef, lazy => 1,
 default => sub {{ data_type => "varchar" }};
# --

=head1 METHODS

=head2 get_value

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

=head2 writes_bound_schema_sources

these are part of the base class because the AuditObj expects all
Collectors to know if a particular tracked source is also a source used
by the collector which would create a deep recursion situation. in other words,
we don't want to try to track changes of the tables that we're using to 
store changes. We rely on the Collector to identify these exclude cases
my setting those source names here

=cut
has 'writes_bound_schema_sources', is => 'ro', isa => ArrayRef[Str], lazy => 1, default => sub {[]};

=head1 METHODS

=head2 has_full_row_stored

This is part of the "init" system for loading existing data. This is going
to be refactored/replaced, but with what is not yet known

=cut
sub has_full_row_stored {

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

			#$cascade_cols->{$_} ||= [] for (@cols); #<-- don't need this
			push @{$cascade_cols->{$_}}, $rel for (@cols);
		}
	
		return $cascade_cols;
	};
	
	return $self->_source_cascade_rekey_rels->{$Source->source_name};
}

has '_source_cascade_rekey_cols', is => 'ro', isa => HashRef, lazy => 1, default => sub {{}};

sub _parse_cond_cols_by_alias {
	my $self = shift;
	my $cond = shift;
	my $alias = shift;
	
	# Get the string elements (keys and values)
	# (TODO: deep walk any hahs/array structure)
	my @elements = %$cond;
	

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

Required. Full class name of the result class to be created

=cut
has 'class_name', 			is => 'ro', isa => Str, required => 1;

=head2 class_opts

Optional extra params to supply to C<< Class::MOP::Class->create >>

=cut
has 'class_opts', 			is => 'ro', isa => HashRef, default => sub {{}};

=head2 table_name

Required. The name of the table as would be supplied to C<< ->table() >> in the
result class.

=cut
has 'table_name', 			is => 'ro', isa => Str, required => 1;

=head2 columns

Required. ArrayRef of DBIC column definitions suitable as arguments for C<< ->add_columns() >>

=cut
has 'columns', 				is => 'ro', isa => ArrayRef, required => 1;

=head2 call_class_methods

Optional ArrayRef consumed in pairs, with the first value used as a method name, and the
second value an ArrayRef holding the args to supply to the method. Each of these are called
as class methods on the result class. This allows for any other calls to be handled, such as
adding uniq keys, and so on.

=cut
has 'call_class_methods',	is => 'ro', isa => ArrayRef, default => sub {[]};


=head1 METHODS

=head2 initialize

Initialization constructor. Expects the above attrs as a HashRef as they would be passed to
C<new()>. Creates the specified result class and invokes all the setup methods as defined above.

=cut

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

Required - the class name of the DBIC schema to be created

=cut
has 'schema_namespace', is => 'ro', isa => Str, required => 1;

=head2 class_opts

Optional extra params to supply to C<< Class::MOP::Class->create >>

=cut
has 'class_opts', is => 'ro', isa => HashRef, default => sub {{}};

=head2 results

HashRef of key/value pairs defining the result/sources to be created. The key
is the source name, while the value must be a HashRef to be supplied to the
C<initialize> constructor of L<DBIx::Class::AuditAny::Util::ResultMaker>. The
C<class_name> does not need to be specified here as it is automatically set
according to the C<schema_namespace> and the source name (key value).

=cut
has 'results', is => 'ro', isa => HashRef[HashRef], required => 1;

=head1 METHODS

=head2 initialize

Initialization constructor. Expects the above attrs as a HashRef as they would be passed to
C<new()>. Creates the specified schema and associated result classes on-the-spot.

=cut
sub initialize {

t/lib/Routine/AuditAny.pm  view on Meta::CPAN

use Test::Routine;

# This is the Routine for attaching an AuditAny auditor to a test
# schema. Expects to be composed on top of Routine::Base

use Test::More; 
use namespace::autoclean;

requires 'build_Schema';

has 'track_params', is => 'ro', isa => 'HashRef', required => 1;

has 'Auditor', is => 'rw', isa => 'Maybe[Object]', 
 default => sub{undef}, init_arg => undef;

around 'build_Schema' => sub {
	my $orig = shift;
	my $self = shift;
	
	my $schema = $self->$orig(@_);
	

t/lib/Routine/Base.pm  view on Meta::CPAN

use Test::More; 
use namespace::autoclean;

use SQL::Translator 0.11016;
use Module::Runtime;

has 'test_schema_class', is => 'ro', isa => 'Str', required => 1;

has 'test_schema_dsn', is => 'ro', isa => 'Str', default => sub{'dbi:SQLite::memory:'};
has 'test_schema_connect', is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub {
	return [ (shift)->test_schema_dsn, '', '', {
		AutoCommit			=> 1,
		on_connect_call	=> 'use_foreign_keys'
	}];
};

sub new_test_schema {
	my $self = shift;
	my $class = shift;
	Module::Runtime::require_module($class);

t/lib/Routine/One/ToAutoDBIC.pm  view on Meta::CPAN

			new_value => 'new',
			old_value => 'old',
			column_name => 'column',
		},
	};
	
	return $params;
};


has 'colnames', is => 'ro', isa => 'HashRef[Str]', default => sub {{
	old		=> 'old',
	new		=> 'new',
	column	=> 'column'
}};


test 'Verify Collected Data' => sub {
	my $self = shift;
	my $schema = $self->Auditor->collector->target_schema;
	my $c = $self->colnames;

t/lib/Routine/Sakila/ToAutoDBIC.pm  view on Meta::CPAN

			new_value => 'new',
			old_value => 'old',
			column_name => 'column',
		},
	};
	
	return $params;
};


has 'colnames', is => 'ro', isa => 'HashRef[Str]', default => sub {{
	old		=> 'old',
	new		=> 'new',
	column	=> 'column'
}};


test 'Verify Collected Data' => sub {
	my $self = shift;
	my $schema = $self->Auditor->collector->target_schema;
	my $c = $self->colnames;

t/lib/Routine/WackyRels/ToAutoDBIC.pm  view on Meta::CPAN

			new_value => 'new',
			old_value => 'old',
			column_name => 'column',
		},
	};
	
	return $params;
};


has 'colnames', is => 'ro', isa => 'HashRef[Str]', default => sub {{
	old		=> 'old',
	new		=> 'new',
	column	=> 'column'
}};


test 'Verify Collected Data' => sub {
	my $self = shift;
	my $schema = $self->Auditor->collector->target_schema;
	my $c = $self->colnames;