The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package DBIx::Class::AuditLog;
$DBIx::Class::AuditLog::VERSION = '0.6.4';
use base qw/DBIx::Class/;

use strict;
use warnings;

# local $DBIx::Class::AuditLog::enabled = 0;
# can be set to temporarily disable audit logging
our $enabled = 1;

sub insert {
    my $self = shift;

    return $self->next::method(@_) if !$enabled || $self->in_storage;

    my $result = $self->next::method(@_);

    my ( $action, $table ) = $self->_action_setup( $result, 'insert' );

    if ($action) {
        my %column_data = $result->get_columns;
        $self->_store_changes( $action, $table, {}, \%column_data );
    }

    return $result;
}

sub update {
    my $self = shift;

    return $self->next::method(@_) if !$enabled;

    my $stored_row      = $self->get_from_storage;
    my %new_data        = $self->get_columns;
    my @changed_columns = keys %{ $_[0] || {} };

    my $result = $self->next::method(@_);

    return unless $stored_row; # update on deleted row - nothing to log

    my %old_data = $stored_row->get_columns;

    if (@changed_columns) {
        @new_data{@changed_columns} = map $self->get_column($_),
            @changed_columns;
    }

    foreach my $col ( $self->columns ) {
        if ( $self->_force_audit($col) ) {
            $old_data{$col} = $stored_row->get_column($col)
                unless defined $old_data{$col};
            $new_data{$col} = $self->get_column($col)
                unless defined $new_data{$col};
        }
    }

    # remove unwanted columns
    foreach my $key ( keys %new_data ) {
        next if $self->_force_audit($key);    # skip forced cols
        if (   defined $old_data{$key}
            && defined $new_data{$key}
            && $old_data{$key} eq $new_data{$key}
            || !defined $old_data{$key} && !defined $new_data{$key} )
        {
            delete $new_data{$key};           # remove unchanged cols
        }
    }

    if ( keys %new_data ) {
        my ( $action, $table )
            = $self->_action_setup( $stored_row, 'update' );

        if ($action) {
            $self->_store_changes( $action, $table, \%old_data, \%new_data );
        }
    }

    return $result;
}

sub delete {
    my $self = shift;

    return $self->next::method(@_) if !$enabled;

    my $stored_row = $self->get_from_storage;

    my $result = $self->next::method(@_);

    my ( $action, $table ) = $self->_action_setup( $stored_row, 'delete' );

    if ($action) {
        my %old_data = $stored_row->get_columns;
        $self->_store_changes( $action, $table, \%old_data, {} );
    }

    return $result;
}


sub _audit_log_schema {
    my $self = shift;
    return $self->result_source->schema->audit_log_schema;
}

sub _action_setup {
    my $self = shift;
    my $row  = shift;
    my $type = shift;

    return $self->_audit_log_schema->audit_log_create_action(
        {   row         => join( '-', $row->id ),
            table       => $row->result_source_instance->name,
            action_type => $type,
        }
    );
}

sub _store_changes {
    my $self       = shift;
    my $action     = shift;
    my $table      = shift;
    my $old_values = shift;
    my $new_values = shift;

    foreach my $column (
        keys %{$new_values} ? keys %{$new_values} : keys %{$old_values} )
    {
        if ( $self->_do_audit($column) ) {
            my $field = $table->find_or_create_related( 'Field',
                { name => $column } );

            my $create_params = { field_id => $field->id, };

            if ( $self->_do_modify_audit_value($column) ) {
                $create_params->{new_value}
                    = $self->_modify_audit_value( $column,
                    $new_values->{$column} );
                $create_params->{old_value}
                    = $self->_modify_audit_value( $column,
                    $old_values->{$column} );
            }
            else {
                $create_params->{new_value} = $new_values->{$column};
                $create_params->{old_value} = $old_values->{$column};
            }

            $action->create_related( 'Change', $create_params, );
        }
    }
}

sub _force_audit {
    my ( $self, $column ) = @_;

    ## make sure that this is an actual column, and is not
    ## a correlated column
    return unless $self->has_column($column);

    my $info = $self->column_info($column);

    return defined $info->{force_audit_log_column}
        && $info->{force_audit_log_column};
}

sub _do_audit {
    my $self   = shift;
    my $column = shift;

    return 1 if $self->_force_audit($column);

    my $info = $self->column_info($column);
    return defined $info->{audit_log_column}
        && $info->{audit_log_column} == 0 ? 0 : 1;
}

sub _do_modify_audit_value {
    my $self   = shift;
    my $column = shift;

    my $info = $self->column_info($column);

    return $info->{modify_audit_value} ? 1 : 0;
}

sub _modify_audit_value {
    my $self   = shift;
    my $column = shift;
    my $value  = shift;

    my $info = $self->column_info($column);
    my $meth = $info->{modify_audit_value};
    return $value
        unless defined $meth;

    return &$meth( $self, $value )
        if ref($meth) eq 'CODE';

    $meth = "modify_audit_$column"
        unless $self->can($meth);

    return $self->$meth($value)
        if $self->can($meth);

    die "unable to find modify_audit_method ($meth) for $column in $self";

}

# ABSTRACT: Simple activity audit logging for DBIx::Class

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

DBIx::Class::AuditLog - Simple activity audit logging for DBIx::Class

=head1 VERSION

version 0.6.4

=head1 NAME

DBIx::Class::AuditLog - Simple activity audit logging for DBIx::Class

=head1 VERSION

version 0.2.6

=head1 DBIx::Class OVERRIDDEN METHODS

=head2 insert

=head2 update

=head2 delete

=head1 HELPER METHODS

=head2 _audit_log_schema

Returns the AuditLog schema from storage.

    my $al_schema = $schmea->audit_log_schema;

=head2 _action_setup

Creates a new AuditLog Action for a specific type.

Requires:
    row: primary key of the table that is being audited
    action_type: action type, 1 of insert/update/delete

=head2 _store_changes

Store the column data that has changed

Requires:
    action: the action object that has associated changes
    old_values: the old values are being replaced
    new_values: the new values that are replacing the old
    table: dbic object of the audit_log_table object

=head2 _do_audit

Returns 1 or 0 if the column should be audited or not.

Requires:
    column: the name of the column/field to check

=head2 _force_audit

Returns 1 or 0 if the column should be audited even if its value did not change.

Requires:
    column: the name of the column/field to check

=head2 _do_modify_audit_value

Returns 1 or 0 if the columns value should be modified before audit.

Requires:
    column: the name of the column/field to check

=head2 _modify_audit_value

Modifies the colums audit-value. Dies if no modify-method could be found.

Returns:
    the modified value

Requires:
    column: the name of the column/field to check
    value: the original value

=head1 AUTHOR

Mark Jubenville <ioncache@gmail.com>

=head1 CONTRIBUTORS

Lukas Thiemeier <lukast@cpan.org>

Dimitar Petrov <dcpetrov@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Mark Jubenville.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 AUTHOR

Mark Jubenville <ioncache@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Mark Jubenville.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut