1 package DBIx::Class::UserStamp;
3 use base qw(DBIx::Class);
10 __PACKAGE__->load_components( qw/DynamicDefault/ );
14 DBIx::Class::UserStamp - Automatically set update and create user id fields
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
25 package MyApp::Schema;
27 __PACKAGE__->mk_group_accessors('simple' => qw/current_user_id/);
30 package MyApp::Model::MyAppDB;
32 use namespace::autoclean;
34 extends 'Catalyst::Model::DBIC::Schema';
35 with 'Catalyst::Component::InstancePerContext';
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);
49 package MyApp::Schema::SomeTable;
51 __PACKAGE__->load_components(qw( UserStamp ... Core ));
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 },
60 Now, any update or create actions will update the specified columns with the
61 current user_id, using the current_user_id accessor.
63 This is effectively trigger emulation to ease user id field insertion
68 my ($self, @cols) = @_;
71 while (my $col = shift @cols) {
72 my $info = ref $cols[0] ? shift @cols : {};
74 if ( delete $info->{store_user_on_update} ) {
75 $info->{dynamic_default_on_update} = 'get_current_user_id';
77 if ( delete $info->{store_user_on_create} ) {
78 $info->{dynamic_default_on_create} = 'get_current_user_id';
81 push @columns, $col => $info;
84 return $self->next::method(@columns);
89 =head2 get_current_user_id
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.
95 sub get_current_user_id { shift->result_source->schema->current_user_id }
99 Matt S. Trout <mst@shadowcatsystems.co.uk>
103 John Goulah <jgoulah@cpan.org>
104 Florian Ragwitz <rafl@debian.org>
108 This program is free software; you can redistribute
109 it and/or modify it under the same terms as Perl itself.