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.11';
   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  use namespace::autoclean;
  33
  34  extends 'Catalyst::Model::DBIC::Schema';
  35  with 'Catalyst::Component::InstancePerContext';
  36
  37  sub build_per_context_instance {
  38    my ($meth, $self) = (shift, shift);
  39    my ($c) = @_; # There are other params but we dont care about them
  40    my $new = bless({ %$self }, ref($self));
  41    my $user_info = $c->_user_in_session;
  42    $new->schema($new->schema->clone);
  43    my $user = $new->schema->resultset('User')->new_result({ %$user_info });
  44    $new->schema->current_user_id($user->id) if (defined $user_info);
  45    return $new;
  46  }
  47
  48
  49  package MyApp::Schema::SomeTable;
  50
  51  __PACKAGE__->load_components(qw( UserStamp ... Core ));
  52
  53  __PACKAGE__->add_columns(
  54     id => { data_type => 'integer' },
  55     u_created => { data_type => 'int', store_user_on_create => 1 },
  56     u_updated => { data_type => 'int',
  57         store_user_on_create => 1, store_user_on_update => 1 },
  58  );
  59
  60 Now, any update or create actions will update the specified columns with the
  61 current user_id, using the current_user_id accessor.
  62
  63 This is effectively trigger emulation to ease user id field insertion
  64
  65 =cut
  66
  67 sub add_columns {
  68     my ($self, @cols) = @_;
  69     my @columns;
  70
  71     while (my $col = shift @cols) {
  72         my $info = ref $cols[0] ? shift @cols : {};
  73
  74         if ( delete $info->{store_user_on_update} ) {
  75             $info->{dynamic_default_on_update} = 'get_current_user_id';
  76         }
  77         if ( delete $info->{store_user_on_create} ) {
  78             $info->{dynamic_default_on_create} = 'get_current_user_id';
  79         }
  80
  81         push @columns, $col => $info;
  82     }
  83
  84     return $self->next::method(@columns);
  85 }
  86
  87 =head1 METHODS
  88
  89 =head2 get_current_user_id
  90
  91 This method is meant to be overridden.  The default is to return a
  92 schema accessor called current_user_id which should be populated as such.
  93
  94 =cut
  95 sub get_current_user_id { shift->result_source->schema->current_user_id }
  96
  97 =head1 AUTHOR
  98
  99  Matt S. Trout     <mst@shadowcatsystems.co.uk>
 100
 101 =head1 CONTRIBUTORS
 102
 103  John Goulah     <jgoulah@cpan.org>
 104  Florian Ragwitz <rafl@debian.org>
 105
 106 =head1 COPYRIGHT
 107
 108 This program is free software; you can redistribute
 109 it and/or modify it under the same terms as Perl itself.
 110
 111 =cut
 112
 113 1;