lib/DBIx/Class/UserStamp.pm

   1 package DBIx::Class::UserStamp;
   2
   3 use base qw(DBIx::Class);
   4
   5 use warnings;
   6 use strict;
   7
   8 our $VERSION = '0.10';
   9
  10 __PACKAGE__->load_components( qw/DynamicDefault/ );
  11
  12 =head1 NAME
  13
  14 DBIx::Class::UserStamp - Automatically set update and create user id fields
  15
  16 =head1 DESCRIPTION
  17
  18 Automatically set fields on 'update' and 'create' that hold user id
  19 values in a table. This can be used for any user id based
  20 field that needs trigger like functionality when a record is
  21 added or updated.
  22
  23 =head1 SYNOPSIS
  24
  25  package MyApp::Schema;
  26
  27  __PACKAGE__->mk_group_accessors('simple' => qw/current_user_id/);
  28
  29
  30  package MyApp::Model::MyAppDB;
  31  use Moose;
  32
  33  around 'build_per_context_instance' => sub {
  34    my ($meth, $self) = (shift, shift);
  35    my ($c) = @_; # There are other params but we dont care about them
  36    my $new = bless({ %$self }, ref($self));
  37    my $user_info = $c->_user_in_session;
  38    my $user = $new->schema->resultset('User')->new_result({ %$user_info });
  39    $new->schema->current_user_id($user->id) if (defined $user_info);
  40    return $new;
  41  };
  42
  43
  44  package MyApp::Schema::SomeTable;
  45
  46  __PACKAGE__->load_components(qw( UserStamp ... Core ));
  47
  48  __PACKAGE__->add_columns(
  49     id => { data_type => 'integer' },
  50     u_created => { data_type => 'int', store_user_on_create => 1 },
  51     u_updated => { data_type => 'int',
  52         store_user_on_create => 1, store_user_on_update => 1 },
  53  );
  54
  55 Now, any update or create actions will update the specified columns with the
  56 current user_id, using the current_user_id accessor.
  57
  58 This is effectively trigger emulation to ease user id field insertion
  59
  60 =cut
  61
  62 sub add_columns {
  63     my ($self, @cols) = @_;
  64     my @columns;
  65
  66     while (my $col = shift @cols) {
  67         my $info = ref $cols[0] ? shift @cols : {};
  68
  69         if ( delete $info->{store_user_on_update} ) {
  70             $info->{dynamic_default_on_update} = 'get_current_user_id';
  71         }
  72         if ( delete $info->{store_user_on_create} ) {
  73             $info->{dynamic_default_on_create} = 'get_current_user_id';
  74         }
  75
  76         push @columns, $col => $info;
  77     }
  78
  79     return $self->next::method(@columns);
  80 }
  81
  82 =head1 METHODS
  83
  84 =head2 get_current_user_id
  85
  86 This method is meant to be overridden.  The default is to return a
  87 schema accessor called current_user_id which should be populated as such.
  88
  89 =cut
  90 sub get_current_user_id { shift->result_source->schema->current_user_id }
  91
  92 =head1 AUTHOR
  93
  94  Matt S. Trout     <mst@shadowcatsystems.co.uk>
  95
  96 =head1 CONTRIBUTOR
  97
  98  John Goulah     <jgoulah@cpan.org>
  99
 100 =head1 COPYRIGHT
 101
 102 This program is free software; you can redistribute
 103 it and/or modify it under the same terms as Perl itself.
 104
 105 =cut
 106
 107 1;