Attachment #41250 for bug #14539

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

Lines 22-27 use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64); Link Here

(-)a/Koha/AuthUtils.pm (+39 lines)
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__

Lines 18-30 package Koha::Borrowers; Link Here

(-)a/Koha/Borrowers.pm (-1 / +54 lines)
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>

Lines 18-28 package Koha::Objects; Link Here

(-)a/Koha/Objects.pm (-1 / +130 lines)
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);




#!/usr/bin/perl

# Copyright Open Source Freedom Fighters 2015
#
# This file is part of Koha.
#
# Koha is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3 of the License, or (at your option) any later
# version.
#
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Koha; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use Modern::Perl;
use Test::More;
use Scalar::Util qw(blessed);
use Try::Tiny;

use C4::Context;
use C4::Members;
use Koha::Borrowers;

my $dbh = C4::Context->dbh;
$dbh->{AutoCommit} = 0;
$dbh->{RaiseError} = 1;

subtest 'Koha::Objects->cast() using Koha::Borrowers implementation' => sub {
    my ($borrower, $member, $testDescription);
    my $borrowernumber = C4::Members::AddMember(
                                        cardnumber => '11A001',
                                        userid     => 'Uriel Septim VII',
                                        branchcode => 'CPL',
                                        categorycode => 'YA',
                                        surname => 'Costly',
                                        firstname => 'Colt',
                                        address => 'Valaskjalf',
                                        zipcode => '10221');

    $borrower = Koha::Borrowers->cast($borrowernumber);
    is($borrower->cardnumber, '11A001', "Borrower cast from AddMember() output");

    $member = C4::Members::GetMember(borrowernumber => $borrower->borrowernumber);
    $borrower = Koha::Borrowers->cast($member);
    is($borrower->cardnumber, '11A001', "Borrower cast from GetMember() output, whatever that is");

    $borrower = Koha::Borrowers->cast('11A001');
    is($borrower->cardnumber, '11A001', "Borrower cast from cardnumber");

    $borrower = Koha::Borrowers->cast('Uriel Septim VII');
    is($borrower->cardnumber, '11A001', "Borrower cast from userid");

    $testDescription = "Borrower casting failed";
    try {
        $borrower = Koha::Borrowers->cast('Uriel Septim IX');
        ok(0, $testDescription);
    } catch {
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
            ok(1, $testDescription);
        }
        else {
            die $_;
        }
    };

    $testDescription = "Borrower casting from undef failed";
    try {
        my $undefVariable;
        $borrower = Koha::Borrowers->cast($undefVariable);
        ok(0, $testDescription);
    } catch {
        if (blessed($_) && $_->isa('Koha::Exception::BadParameter')) {
            ok(1, $testDescription);
        }
        else {
            die $_;
        }
    };

    #Under no circumstances we want to mix Borrower Objects. Imagine the terror!
    $testDescription = "Emergency abort if casting would result in multiple matching Objects";
    my $borrowernumber2 = C4::Members::AddMember(
                                        cardnumber => $borrowernumber, #This is bad, cardnumber is other borrowers borrowernumber!
                                        userid     => $borrowernumber,
                                        branchcode => 'CPL',
                                        categorycode => 'YA',
                                        surname => 'Costly',
                                        firstname => 'Colt',
                                        address => 'Gladsheim',
                                        zipcode => '10221');

    try {
        $borrower = Koha::Borrowers->cast($borrowernumber);
        ok(0, $testDescription);
    } catch {
        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
            ok(1, $testDescription);
        }
        else {
            die $_;
        }
    };
};

done_testing;

Return to bug 14539

Line 0 Link Here

(-)a/t/db_dependent/Koha/Objects.t (-1 / +110 lines)
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;