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 use Carp qw/ confess /;
   8
   9 our $VERSION = '0.11';
  10
  11 __PACKAGE__->load_components( qw/DynamicDefault/ );
  12
  13 =head1 NAME
  14
  15 DBIx::Class::UserStamp - Automatically set update and create user id fields
  16
  17 =head1 DESCRIPTION
  18
  19 Automatically set fields on 'update' and 'create' that hold user id
  20 values in a table. This can be used for any user id based
  21 field that needs trigger like functionality when a record is
  22 added or updated.
  23
  24 =head1 SYNOPSIS
  25
  26  package MyApp::Schema;
  27
  28  __PACKAGE__->mk_group_accessors('simple' => qw/current_user/);
  29
  30
  31  package MyApp::Model::MyAppDB;
  32  use Moose;
  33  use namespace::autoclean;
  34
  35  extends 'Catalyst::Model::DBIC::Schema';
  36
  37  __PACKAGE->config(
  38         traits => ['WithCurrentUser'], # Requires Catalyst::TraitFor::Model::DBIC::Schema::WithCurrentUser
  39  );
  40
  41  package MyApp::Schema::SomeTable;
  42
  43  __PACKAGE__->load_components(qw( UserStamp ... Core ));
  44
  45  __PACKAGE__->add_columns(
  46     id => { data_type => 'integer' },
  47     u_created => { data_type => 'int', store_user_on_create => 1 },
  48     u_updated => { data_type => 'int',
  49         store_user_on_create => 1, store_user_on_update => 1 },
  50  );
  51
  52 Now, any update or create actions will update the specified columns with the
  53 current user_id, using the current_user_id accessor.
  54
  55 This is effectively trigger emulation to ease user id field insertion
  56
  57 =cut
  58
  59 sub add_columns {
  60     my ($self, @cols) = @_;
  61     my @columns;
  62
  63     while (my $col = shift @cols) {
  64         my $info = ref $cols[0] ? shift @cols : {};
  65
  66         if ( delete $info->{store_user_on_update} ) {
  67             $info->{dynamic_default_on_update} = 'get_current_user_id';
  68         }
  69         if ( delete $info->{store_user_on_create} ) {
  70             $info->{dynamic_default_on_create} = 'get_current_user_id';
  71         }
  72
  73         push @columns, $col => $info;
  74     }
  75
  76     return $self->next::method(@columns);
  77 }
  78
  79 =head1 METHODS
  80
  81 =head2 get_current_user_id
  82
  83 This method is meant to be overridden.  The default is to look for a
  84 'current_user' accessor on the schema, and call an ->id method
  85 on it.
  86
  87 =cut
  88
  89 sub get_current_user_id {
  90     my $self = shift;
  91     my $schema = $self->result_source->schema;
  92     if ($schema->can('current_user')) {
  93         return $schema->current_user->id
  94             if $schema->current_user;
  95     }
  96     elsif ($schema->can('current_user_id')) {
  97         return $schema->current_user_id;
  98     }
  99     else {
 100         confess("Your schema $schema does not have either a 'current_user' or 'current_user_id' accessors needed by " . __PACKAGE__);
 101     }
 102 }
 103
 104 =head1 AUTHOR
 105
 106  Matt S. Trout     <mst@shadowcatsystems.co.uk>
 107
 108 =head1 CONTRIBUTORS
 109
 110  John Goulah     <jgoulah@cpan.org>
 111  Florian Ragwitz <rafl@debian.org>
 112
 113 =head1 COPYRIGHT
 114
 115 This program is free software; you can redistribute
 116 it and/or modify it under the same terms as Perl itself.
 117
 118 =cut
 119
 120 1;