|
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); |