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

(-)a/Koha/AuthUtils.pm (+39 lines)
Lines 22-27 use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64); Link Here
22
use Encode qw( encode is_utf8 );
22
use Encode qw( encode is_utf8 );
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
24
25
use Koha::Borrower;
26
25
use base 'Exporter';
27
use base 'Exporter';
26
28
27
our $VERSION = '1.01';
29
our $VERSION = '1.01';
Lines 133-138 sub generate_salt { Link Here
133
    close SOURCE;
135
    close SOURCE;
134
    return $string;
136
    return $string;
135
}
137
}
138
139
=head checkKohaSuperuserFromUserid
140
See checkKohaSuperuser(), with only the "user identifier"-@PARAM.
141
@THROWS nothing.
142
=cut
143
144
sub checkKohaSuperuserFromUserid {
145
    my ($userid) = @_;
146
147
    if ( $userid && $userid eq C4::Context->config('user') ) {
148
        return _createTemporarySuperuser();
149
    }
150
}
151
152
=head _createTemporarySuperuser
153
154
Create a temporary superuser which should be instantiated only to the environment
155
and then discarded. So do not ->store() it!
156
@RETURN Koha::Borrower
157
=cut
158
159
sub _createTemporarySuperuser {
160
    my $borrower = Koha::Borrower->new();
161
162
    my $superuserName = C4::Context->config('user');
163
    $borrower->set({borrowernumber => 0,
164
                       userid     => $superuserName,
165
                       cardnumber => $superuserName,
166
                       firstname  => $superuserName,
167
                       surname    => $superuserName,
168
                       branchcode => 'NO_LIBRARY_SET',
169
                       flags      => 1,
170
                       email      => C4::Context->preference('KohaAdminEmailAddress')
171
                    });
172
    return $borrower;
173
}
174
136
1;
175
1;
137
176
138
__END__
177
__END__
(-)a/Koha/Borrowers.pm (-1 / +54 lines)
Lines 18-30 package Koha::Borrowers; Link Here
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
use Scalar::Util qw(blessed);
22
use Try::Tiny;
21
23
22
use Carp;
24
use Carp;
23
25
24
use Koha::Database;
26
use Koha::Database;
25
27
use Koha::AuthUtils;
26
use Koha::Borrower;
28
use Koha::Borrower;
27
29
30
use Koha::Exception::UnknownObject;
31
28
use base qw(Koha::Objects);
32
use base qw(Koha::Objects);
29
33
30
=head1 NAME
34
=head1 NAME
Lines 49-54 sub object_class { Link Here
49
    return 'Koha::Borrower';
53
    return 'Koha::Borrower';
50
}
54
}
51
55
56
=head cast
57
58
    my $borrower = Koha::Borrowers->cast('cardnumber');
59
    my $borrower = Koha::Borrowers->cast($Koha::Borrower);
60
    my $borrower = Koha::Borrowers->cast('userid');
61
    my $borrower = Koha::Borrowers->cast('borrowernumber');
62
    my $borrower = Koha::Borrowers->cast({borrowernumber => 123,
63
                                                });
64
    my $borrower = Koha::Borrowers->cast({firstname => 'Olli-Antti',
65
                                                    surname => 'Kivi',
66
                                                    address => 'Koskikatu 25',
67
                                                });
68
69
Because there are gazillion million ways in Koha to invoke a Borrower, this is a
70
omnibus for easily creating a Borrower-object from all the arcane invocations present
71
in many parts of Koha.
72
Just throw the crazy and unpredictable return values from myriad subroutines returning
73
some kind of an borrowerish value to this casting function to get a brand new Koha::Borrower.
74
@PARAM1 Scalar, or HASHRef.
75
@RETURNS Koha::Borrower, possibly already in DB or a completely new one if nothing was
76
                         inferred from the DB.
77
@THROWS Koha::Exception::BadParameter, if no idea what to do with the input.
78
@THROWS Koha::Exception::UnknownObject, if we cannot find a Borrower with the given input.
79
=cut
80
81
sub cast {
82
    my ($class, $input) = @_;
83
84
    my $borrower;
85
    try {
86
        $borrower = $class->SUPER::cast($input);
87
    } catch {
88
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
89
            $borrower = Koha::AuthUtils::checkKohaSuperuserFromUserid($input);
90
            unless ($borrower) {
91
                $_->rethrow();
92
            }
93
        }
94
        else {
95
            die $_;
96
        }
97
    };
98
99
    return $borrower;
100
}
101
sub _get_castable_unique_columns {
102
    return ['borrowernumber', 'cardnumber', 'userid'];
103
}
104
52
=head1 AUTHOR
105
=head1 AUTHOR
53
106
54
Kyle M Hall <kyle@bywatersolutions.com>
107
Kyle M Hall <kyle@bywatersolutions.com>
(-)a/Koha/Objects.pm (-1 / +130 lines)
Lines 18-28 package Koha::Objects; Link Here
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
use Scalar::Util qw(blessed);
22
use Carp;
22
use Carp;
23
23
24
use Koha::Database;
24
use Koha::Database;
25
25
26
use Koha::Exception::UnknownObject;
27
use Koha::Exception::BadParameter;
28
26
our $type;
29
our $type;
27
30
28
=head1 NAME
31
=head1 NAME
Lines 70-75 sub _new_from_dbic { Link Here
70
    bless( $self, $class );
73
    bless( $self, $class );
71
}
74
}
72
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/Borrowers.pm ###
95
    package Koha::Borrowers;
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::Borrowers->cast('cardnumber');
103
    my $borrower = Koha::Borrowers->cast($Koha::Borrower);
104
    my $borrower = Koha::Borrowers->cast('userid');
105
    my $borrower = Koha::Borrowers->cast('borrowernumber');
106
    my $borrower = Koha::Borrowers->cast({borrowernumber => 123,
107
                                        });
108
    my $borrower = Koha::Borrowers->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
73
=head3 Koha::Objects->find();
202
=head3 Koha::Objects->find();
74
203
75
my $object = Koha::Objects->find($id);
204
my $object = Koha::Objects->find($id);
(-)a/t/db_dependent/Koha/Objects.t (-1 / +110 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright Open Source Freedom Fighters 2015
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it under the
8
# terms of the GNU General Public License as published by the Free Software
9
# Foundation; either version 3 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use Modern::Perl;
21
use Test::More;
22
use Scalar::Util qw(blessed);
23
use Try::Tiny;
24
25
use C4::Context;
26
use C4::Members;
27
use Koha::Borrowers;
28
29
my $dbh = C4::Context->dbh;
30
$dbh->{AutoCommit} = 0;
31
$dbh->{RaiseError} = 1;
32
33
subtest 'Koha::Objects->cast() using Koha::Borrowers implementation' => sub {
34
    my ($borrower, $member, $testDescription);
35
    my $borrowernumber = C4::Members::AddMember(
36
                                        cardnumber => '11A001',
37
                                        userid     => 'Uriel Septim VII',
38
                                        branchcode => 'CPL',
39
                                        categorycode => 'YA',
40
                                        surname => 'Costly',
41
                                        firstname => 'Colt',
42
                                        address => 'Valaskjalf',
43
                                        zipcode => '10221');
44
45
    $borrower = Koha::Borrowers->cast($borrowernumber);
46
    is($borrower->cardnumber, '11A001', "Borrower cast from AddMember() output");
47
48
    $member = C4::Members::GetMember(borrowernumber => $borrower->borrowernumber);
49
    $borrower = Koha::Borrowers->cast($member);
50
    is($borrower->cardnumber, '11A001', "Borrower cast from GetMember() output, whatever that is");
51
52
    $borrower = Koha::Borrowers->cast('11A001');
53
    is($borrower->cardnumber, '11A001', "Borrower cast from cardnumber");
54
55
    $borrower = Koha::Borrowers->cast('Uriel Septim VII');
56
    is($borrower->cardnumber, '11A001', "Borrower cast from userid");
57
58
    $testDescription = "Borrower casting failed";
59
    try {
60
        $borrower = Koha::Borrowers->cast('Uriel Septim IX');
61
        ok(0, $testDescription);
62
    } catch {
63
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
64
            ok(1, $testDescription);
65
        }
66
        else {
67
            die $_;
68
        }
69
    };
70
71
    $testDescription = "Borrower casting from undef failed";
72
    try {
73
        my $undefVariable;
74
        $borrower = Koha::Borrowers->cast($undefVariable);
75
        ok(0, $testDescription);
76
    } catch {
77
        if (blessed($_) && $_->isa('Koha::Exception::BadParameter')) {
78
            ok(1, $testDescription);
79
        }
80
        else {
81
            die $_;
82
        }
83
    };
84
85
    #Under no circumstances we want to mix Borrower Objects. Imagine the terror!
86
    $testDescription = "Emergency abort if casting would result in multiple matching Objects";
87
    my $borrowernumber2 = C4::Members::AddMember(
88
                                        cardnumber => $borrowernumber, #This is bad, cardnumber is other borrowers borrowernumber!
89
                                        userid     => $borrowernumber,
90
                                        branchcode => 'CPL',
91
                                        categorycode => 'YA',
92
                                        surname => 'Costly',
93
                                        firstname => 'Colt',
94
                                        address => 'Gladsheim',
95
                                        zipcode => '10221');
96
97
    try {
98
        $borrower = Koha::Borrowers->cast($borrowernumber);
99
        ok(0, $testDescription);
100
    } catch {
101
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
102
            ok(1, $testDescription);
103
        }
104
        else {
105
            die $_;
106
        }
107
    };
108
};
109
110
done_testing;

Return to bug 14539