1use warnings;
2use strict;
3
4=head1 NAME
5
6Jifty::RightsFrom - Delegate access control to a related object
7
8=head1 SYNOPSIS
9
10  package Application::Model::Thing;
11  use Jifty::DBI::Schema;
12  use Application::Record schema {
13    column owner => refers_to Application::Model::Person;
14  }
15
16  use Jifty::RightsFrom column => 'owner';
17
18=head1 DESCRIPTION
19
20Provides a C<delegate_current_user_can> method that various
21task-related objects can use as a base to make their own access
22control decisions based on their
23task. L<Jifty::Record/current_user_can> uses this method to make an
24access control decision if it exists.
25
26Note that this means that a model class can use Jifty::RightsFrom,
27and still have a custom C<current_user_can> method, and they will not
28interfere with each other.
29
30=cut
31
32package Jifty::RightsFrom;
33use base qw/Exporter/;
34
35
36sub import {
37    my $class = shift;
38    export_curried_sub(
39        sub_name  => 'delegate_current_user_can',
40        as        => 'delegate_current_user_can',
41        export_to => $class,
42        args      => \@_
43    );
44}
45
46
47=head2 export_curried_sub HASHREF
48
49Takes:
50
51=over
52
53=item sub_name
54
55The subroutine in this package that you want to export.
56
57=item export_to
58
59The name of the package you want to export to.
60
61=item as
62
63The name your new curried sub should be exported into in the package
64C<export_to>
65
66
67=item args (arrayref)
68
69The arguments you want to hand to your sub.
70
71
72=back
73
74=cut
75
76sub export_curried_sub {
77    my %args = (
78        sub_name   => undef,
79        export_to  => undef,
80        as         => undef,
81        args       => undef,
82        @_
83    );
84    no strict 'refs';
85    no warnings 'redefine';
86    local *{ $args{'as'} } = sub { &{ $args{'sub_name'} }(shift @_, @{ $args{'args'} }, @_ ) };
87
88    local @{Jifty::RightsFrom::EXPORT_OK} = ($args{as});
89    Jifty::RightsFrom->export_to_level( 2, $args{export_to}, $args{as} );
90}
91
92=head2 delegate_current_user_can C<'column'>, C<$column_name>, C<$right_name>, C<@attributes>
93
94Make a decision about permissions based on checking permissions on the
95column of this record specified in the call to C<import>. C<create>,
96C<delete>, and C<update> rights all check for the C<update> right on
97the delegated object. On create, we look in the passed attributes for
98an argument with the name of that column.
99
100=cut
101
102sub delegate_current_user_can {
103    my $self        = shift;
104    my $object_type = shift;    #always 'column' for now
105    my $col_name    = shift;
106    my $right       = shift;
107    my %attribs     = @_;
108
109    $right = 'update' if $right ne 'read';
110    my $obj;
111
112    $col_name =~ s/_id$//;
113    my $column   = $self->column($col_name);
114    my $obj_type = $column->refers_to();
115
116    # XXX TODO: this card is bloody hard to follow. it's my fault. --jesse
117
118    my $foreign_key = $attribs{ $column->name };
119    # We only do the isa if the foreign_key is a reference
120    # We could also do this using eval, but it's an order of magnitude slower
121    if ( ref($foreign_key) and $foreign_key->isa($obj_type) ) {
122        $obj = $foreign_key;    # the fk is actually an object
123    } elsif (
124        my $fk_value = (
125                   $foreign_key
126                || $self->__value( $column->name )
127                || $self->{ $column->name }
128        )
129        )
130    {
131        $obj = $obj_type->new( current_user => $self->current_user );
132        $obj->load_by_cols( ( $column->by || 'id' ) => $fk_value );
133    } else {
134        return 0;
135    }
136
137    return $obj->current_user_can($right);
138}
139
140
1411;
142
143