View | Details | Raw Unified | Return to bug 14539
Collapse All | Expand All

(-)a/Koha/Acquisition/Booksellers.pm (+4 lines)
Lines 34-37 sub object_class { Link Here
34
    return 'Koha::Acquisition::Bookseller';
34
    return 'Koha::Acquisition::Bookseller';
35
}
35
}
36
36
37
sub _get_castable_unique_columns {
38
    return ['id'];
39
}
40
37
1;
41
1;
(-)a/Koha/AuthUtils.pm (+39 lines)
Lines 23-28 use Encode qw( encode is_utf8 ); Link Here
23
use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt
23
use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt
24
use List::MoreUtils qw/ any /;
24
use List::MoreUtils qw/ any /;
25
25
26
use Koha::Patron;
27
26
use base 'Exporter';
28
use base 'Exporter';
27
29
28
our @EXPORT_OK   = qw(hash_password get_script_name);
30
our @EXPORT_OK   = qw(hash_password get_script_name);
Lines 152-157 sub get_script_name { Link Here
152
    }
154
    }
153
}
155
}
154
156
157
=head checkKohaSuperuserFromUserid
158
See checkKohaSuperuser(), with only the "user identifier"-@PARAM.
159
@THROWS nothing.
160
=cut
161
162
sub checkKohaSuperuserFromUserid {
163
    my ($userid) = @_;
164
165
    if ( $userid && $userid eq C4::Context->config('user') ) {
166
        return _createTemporarySuperuser();
167
    }
168
}
169
170
=head _createTemporarySuperuser
171
172
Create a temporary superuser which should be instantiated only to the environment
173
and then discarded. So do not ->store() it!
174
@RETURN Koha::Patron
175
=cut
176
177
sub _createTemporarySuperuser {
178
    my $patron = Koha::Patron->new();
179
180
    my $superuserName = C4::Context->config('user');
181
    $patron->set({borrowernumber => 0,
182
                       userid     => $superuserName,
183
                       cardnumber => $superuserName,
184
                       firstname  => $superuserName,
185
                       surname    => $superuserName,
186
                       branchcode => 'NO_LIBRARY_SET',
187
                       flags      => 1,
188
                       email      => C4::Context->preference('KohaAdminEmailAddress')
189
                    });
190
    return $patron;
191
}
192
193
155
1;
194
1;
156
195
157
__END__
196
__END__
(-)a/Koha/Items.pm (+4 lines)
Lines 37-42 Koha::Items - Koha Item object set class Link Here
37
37
38
=cut
38
=cut
39
39
40
sub _get_castable_unique_columns {
41
    return ['itemnumber', 'barcode'];
42
}
43
40
=head3 type
44
=head3 type
41
45
42
=cut
46
=cut
(-)a/Koha/Objects.pm (+131 lines)
Lines 19-28 package Koha::Objects; Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use Scalar::Util qw(blessed);
22
use Carp;
23
use Carp;
23
24
24
use Koha::Database;
25
use Koha::Database;
25
26
27
28
use Koha::Exception::UnknownObject;
29
use Koha::Exception::BadParameter;
30
26
=head1 NAME
31
=head1 NAME
27
32
28
Koha::Objects - Koha Object set base class
33
Koha::Objects - Koha Object set base class
Lines 68-73 sub _new_from_dbic { Link Here
68
    bless( $self, $class );
73
    bless( $self, $class );
69
}
74
}
70
75
76
=head _get_castable_unique_columns
77
@ABSTRACT, OVERLOAD FROM SUBCLASS
78
79
Get the columns this Object can use to find a matching Object from the DB.
80
These columns must be UNIQUE or preferably PRIMARY KEYs.
81
So if the castable input is not an Object, we can try to find these scalars and do
82
a DB search using them.
83
=cut
84
85
sub _get_castable_unique_columns {}
86
87
=head Koha::Objects->cast();
88
89
Try to find a matching Object from the given input. Is basically a validator to
90
validate the given input and make sure we get a Koha::Object or an Exception.
91
92
=head2 An example:
93
94
    ### IN Koha/Patrons.pm ###
95
    package Koha::Patrons;
96
    ...
97
    sub _get_castable_unique_columns {
98
        return ['borrowernumber', 'cardnumber', 'userid'];
99
    }
100
101
    ### SOMEWHERE IN A SCRIPT FAR AWAY ###
102
    my $borrower = Koha::Patrons->cast('cardnumber');
103
    my $borrower = Koha::Patrons->cast($Koha::Patron);
104
    my $borrower = Koha::Patrons->cast('userid');
105
    my $borrower = Koha::Patrons->cast('borrowernumber');
106
    my $borrower = Koha::Patrons->cast({borrowernumber => 123,
107
                                        });
108
    my $borrower = Koha::Patrons->cast({firstname => 'Olli-Antti',
109
                                                    surname => 'Kivi',
110
                                                    address => 'Koskikatu 25',
111
                                                    cardnumber => '11A001',
112
                                                    ...
113
                                        });
114
115
=head Description
116
117
Because there are gazillion million ways in Koha to invoke an Object, this is a
118
helper for easily creating different kinds of objects from all the arcane invocations present
119
in many parts of Koha.
120
Just throw the crazy and unpredictable return values from myriad subroutines returning
121
some kind of an objectish value to this casting function to get a brand new Koha::Object.
122
@PARAM1 Scalar, or HASHRef, or Koha::Object or Koha::Schema::Result::XXX
123
@RETURNS Koha::Object subclass, possibly already in DB or a completely new one if nothing was
124
                         inferred from the DB.
125
@THROWS Koha::Exception::BadParameter, if no idea what to do with the input.
126
@THROWS Koha::Exception::UnknownObject, if we cannot find an Object with the given input.
127
128
=cut
129
130
sub cast {
131
    my ($class, $input) = @_;
132
133
    unless ($input) {
134
        Koha::Exception::BadParameter->throw(error => "$class->cast():> No parameter given!");
135
    }
136
    if (blessed($input) && $input->isa( $class->object_class )) {
137
        return $input;
138
    }
139
    if (blessed($input) && $input->isa( 'Koha::Schema::Result::'.$class->_type )) {
140
        return $class->object_class->_new_from_dbic($input);
141
    }
142
143
    my %searchTerms; #Make sure the search terms are processed in the order they have been introduced.
144
    #Extract unique keys and try to get the object from them.
145
    my $castableColumns = $class->_get_castable_unique_columns();
146
    my $resultSource = $class->_resultset()->result_source();
147
148
    if (ref($input) eq 'HASH') {
149
        foreach my $col (@$castableColumns) {
150
            if ($input->{$col} &&
151
                    $class->_cast_validate_column( $resultSource->column_info($col), $input->{$col}) ) {
152
                $searchTerms{$col} = $input->{$col};
153
            }
154
        }
155
    }
156
    elsif (not(ref($input))) { #We have a scalar
157
        foreach my $col (@$castableColumns) {
158
            if ($class->_cast_validate_column( $resultSource->column_info($col), $input) ) {
159
                $searchTerms{$col} = $input;
160
            }
161
        }
162
    }
163
164
    if (scalar(%searchTerms)) {
165
        my @objects = $class->search({'-or' => \%searchTerms});
166
167
        unless (scalar(@objects) == 1) {
168
            my @keys = keys %searchTerms;
169
            my $keys = join('|', @keys);
170
            my @values = values %searchTerms;
171
            my $values = join('|', @values);
172
            Koha::Exception::UnknownObject->throw(error => "$class->cast():> Cannot find an existing ".$class->object_class." from $keys '$values'.")
173
                            if scalar(@objects) < 1;
174
            Koha::Exception::UnknownObject->throw(error => "$class->cast():> Too many ".$class->object_class."s found with $keys '$values'. Will not possibly return the wrong ".$class->object_class)
175
                            if scalar(@objects) > 1;
176
        }
177
        return $objects[0];
178
    }
179
180
    Koha::Exception::BadParameter->throw(error => "$class->cast():> Unknown parameter '$input' given!");
181
}
182
183
=head _cast_validate_column
184
185
    For some reason MySQL decided that it is a good idea to cast String to Integer automatically
186
    For ex. SELECT * FROM borrowers WHERE borrowernumber = '11A001';
187
    returns the Borrower with borrowernumber => 11, instead of no results!
188
    This is potentially catastrophic.
189
    Validate integers and other data types here.
190
191
=cut
192
193
sub _cast_validate_column {
194
    my ($class, $column, $value) = @_;
195
196
    if ($column->{data_type} eq 'integer' && $value !~ m/^\d+$/) {
197
        return 0;
198
    }
199
    return 1;
200
}
201
71
=head3 Koha::Objects->find();
202
=head3 Koha::Objects->find();
72
203
73
my $object = Koha::Objects->find($id);
204
my $object = Koha::Objects->find($id);
(-)a/Koha/Patrons.pm (+54 lines)
Lines 27-36 use Koha::DateUtils; Link Here
27
27
28
use Koha::ArticleRequests;
28
use Koha::ArticleRequests;
29
use Koha::ArticleRequest::Status;
29
use Koha::ArticleRequest::Status;
30
use Koha::AuthUtils;
30
use Koha::Patron;
31
use Koha::Patron;
31
32
32
use base qw(Koha::Objects);
33
use base qw(Koha::Objects);
33
34
35
use Scalar::Util qw(blessed);
36
use Try::Tiny;
37
34
=head1 NAME
38
=head1 NAME
35
39
36
Koha::Patron - Koha Patron Object class
40
Koha::Patron - Koha Patron Object class
Lines 41-46 Koha::Patron - Koha Patron Object class Link Here
41
45
42
=cut
46
=cut
43
47
48
sub _get_castable_unique_columns {
49
    return ['borrowernumber', 'cardnumber', 'userid'];
50
}
51
44
=head3 search_housebound_choosers
52
=head3 search_housebound_choosers
45
53
46
Returns all Patrons which are Housebound choosers.
54
Returns all Patrons which are Housebound choosers.
Lines 183-188 sub anonymise_issue_history { Link Here
183
    $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
191
    $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
184
}
192
}
185
193
194
=head cast
195
196
    my $borrower = Koha::Patrons->cast('cardnumber');
197
    my $borrower = Koha::Patrons->cast($Koha::Patron);
198
    my $borrower = Koha::Patrons->cast('userid');
199
    my $borrower = Koha::Patrons->cast('borrowernumber');
200
    my $borrower = Koha::Patrons->cast({borrowernumber => 123,
201
                                                });
202
    my $borrower = Koha::Patrons->cast({firstname => 'Olli-Antti',
203
                                                    surname => 'Kivi',
204
                                                    address => 'Koskikatu 25',
205
                                                });
206
207
Because there are gazillion million ways in Koha to invoke a Patron, this is a
208
omnibus for easily creating a Patron-object from all the arcane invocations present
209
in many parts of Koha.
210
Just throw the crazy and unpredictable return values from myriad subroutines returning
211
some kind of an patronish value to this casting function to get a brand new Koha::Patron.
212
@PARAM1 Scalar, or HASHRef.
213
@RETURNS Koha::Patron, possibly already in DB or a completely new one if nothing was
214
                         inferred from the DB.
215
@THROWS Koha::Exception::BadParameter, if no idea what to do with the input.
216
@THROWS Koha::Exception::UnknownObject, if we cannot find a Patron with the given input.
217
=cut
218
219
sub cast {
220
    my ($class, $input) = @_;
221
222
    my $patron;
223
    try {
224
        $patron = $class->SUPER::cast($input);
225
    } catch {
226
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
227
            $patron = Koha::AuthUtils::checkKohaSuperuserFromUserid($input);
228
            unless ($patron) {
229
                $_->rethrow();
230
            }
231
        }
232
        else {
233
            die $_;
234
        }
235
    };
236
237
    return $patron;
238
}
239
186
=head3 type
240
=head3 type
187
241
188
=cut
242
=cut
(-)a/Koha/Subscriptions.pm (+4 lines)
Lines 49-54 sub object_class { Link Here
49
    return 'Koha::Subscription';
49
    return 'Koha::Subscription';
50
}
50
}
51
51
52
sub _get_castable_unique_columns {
53
    return ['subscriptionid'];
54
}
55
52
=head1 AUTHOR
56
=head1 AUTHOR
53
57
54
Kyle M Hall <kyle@bywatersolutions.com>
58
Kyle M Hall <kyle@bywatersolutions.com>
(-)a/t/db_dependent/Koha/Objects.t (-2 / +84 lines)
Lines 19-27 Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use Test::More tests => 13;
22
use Test::More tests => 14;
23
use Test::Warn;
23
use Test::Warn;
24
24
25
use C4::Members;
26
25
use Koha::Authority::Types;
27
use Koha::Authority::Types;
26
use Koha::Cities;
28
use Koha::Cities;
27
use Koha::Patron::Category;
29
use Koha::Patron::Category;
Lines 31-36 use Koha::Database; Link Here
31
33
32
use t::lib::TestBuilder;
34
use t::lib::TestBuilder;
33
35
36
use Scalar::Util qw(blessed);
34
use Try::Tiny;
37
use Try::Tiny;
35
38
36
my $schema = Koha::Database->new->schema;
39
my $schema = Koha::Database->new->schema;
Lines 168-172 subtest 'Exceptions' => sub { Link Here
168
    };
171
    };
169
};
172
};
170
173
174
subtest 'Koha::Objects->cast() using Koha::Patrons implementation' => sub {
175
    my ($borrower, $member, $testDescription);
176
    my $borrowernumber = C4::Members::AddMember(
177
                                        cardnumber => '11A001',
178
                                        userid     => 'Uriel Septim VII',
179
                                        branchcode => 'CPL',
180
                                        categorycode => 'YA',
181
                                        surname => 'Costly',
182
                                        firstname => 'Colt',
183
                                        address => 'Valaskjalf',
184
                                        zipcode => '10221');
185
186
    $borrower = Koha::Patrons->cast($borrowernumber);
187
    is($borrower->cardnumber, '11A001', "Patron cast from AddMember() output");
188
189
    $member = C4::Members::GetMember(borrowernumber => $borrower->borrowernumber);
190
    $borrower = Koha::Patrons->cast($member);
191
    is($borrower->cardnumber, '11A001', "Patron cast from GetMember() output, whatever that is");
192
193
    $borrower = Koha::Patrons->cast('11A001');
194
    is($borrower->cardnumber, '11A001', "Patron cast from cardnumber");
195
196
    $borrower = Koha::Patrons->cast('Uriel Septim VII');
197
    is($borrower->cardnumber, '11A001', "Patron cast from userid");
198
199
    $borrower = Koha::Patrons->cast(C4::Context->config('user'));
200
    is($borrower->cardnumber, C4::Context->config('user'), "Patron cast from db user");
201
202
    $testDescription = "Patron casting failed";
203
    try {
204
        $borrower = Koha::Patrons->cast('Uriel Septim IX');
205
        ok(0, $testDescription);
206
    } catch {
207
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
208
            ok(1, $testDescription);
209
        }
210
        else {
211
            die $_;
212
        }
213
    };
214
215
    $testDescription = "Patron casting from undef failed";
216
    try {
217
        my $undefVariable;
218
        $borrower = Koha::Patrons->cast($undefVariable);
219
        ok(0, $testDescription);
220
    } catch {
221
        if (blessed($_) && $_->isa('Koha::Exception::BadParameter')) {
222
            ok(1, $testDescription);
223
        }
224
        else {
225
            die $_;
226
        }
227
    };
228
229
    #Under no circumstances we want to mix Patron Objects. Imagine the terror!
230
    $testDescription = "Emergency abort if casting would result in multiple matching Objects";
231
    my $borrowernumber2 = C4::Members::AddMember(
232
                                        cardnumber => $borrowernumber, #This is bad, cardnumber is other borrowers borrowernumber!
233
                                        userid     => $borrowernumber,
234
                                        branchcode => 'CPL',
235
                                        categorycode => 'YA',
236
                                        surname => 'Costly',
237
                                        firstname => 'Colt',
238
                                        address => 'Gladsheim',
239
                                       zipcode => '10221');
240
241
    try {
242
        $borrower = Koha::Patrons->cast($borrowernumber);
243
        ok(0, $testDescription);
244
    } catch {
245
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
246
            ok(1, $testDescription);
247
        }
248
        else {
249
            die $_;
250
        }
251
    };
252
};
253
171
$schema->storage->txn_rollback;
254
$schema->storage->txn_rollback;
172
1;
255
1;
173
- 

Return to bug 14539