Attachment 63246 Details for Bug 14539 – Bug 14539 - Koha::Objects->cast(). Introduction to cast() (ToObject), aka. make a Koha::Object from various input types and validate.

[patch] Bug 14539 - Koha::Objects->cast(). Introduction to cast() (ToObject), aka. make a Koha::Object from various input types and validate.

Bug-14539---KohaObjects-cast-Introduction-to-cast-.patch (text/plain), 16.91 KB, created by Lari Taskula on 2017-05-08 15:15:41 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Lari Taskula

Created: 2017-05-08 15:15:41 UTC

Size: 16.91 KB

patch

obsolete

>From 647353c428d902e09f9d6773fa6a298f0d177214 Mon Sep 17 00:00:00 2001
>From: Olli-Antti Kivilahti <olli-antti.kivilahti@jns.fi>
>Date: Wed, 29 Jul 2015 10:39:35 +0300
>Subject: [PATCH] Bug 14539 - Koha::Objects->cast(). Introduction to cast()
> (ToObject), aka. make a Koha::Object from various input types and validate.
>
>Finds a Patron-object (or any other type) from various different types of inputs.
>Also doubles as a validator function, dying if input is improper.
>
>USAGE:
>    my $member = C4::Members::GetMember(borrowernumber => $borrowernumber);
>    my $borrower = Koha::Patrons->cast($member);
>
>Currently Koha is like an archeological dig site, we have different layers of
>dealing with various business objects.
>
>We started with DBI and numerous ways of passing an HASH around. There is no
>telling if it will be a List of column => values, or a reference to HASH, or a
>HASH or just any of the business object's (eg. Patron's) unique identifiers
>(userid, cardnumber, borrowernumber).
>
>Then DBIx came to the rescue and now we are need to learn DBI and DBIx and SQL
>to do DB operatons in Koha. Migration to DBIx is on the way.
>
>Finally we have Koha::Object and subclasses, which include and use the DBIx,
>but those are not directly compatible, since Koha::Object is not a subclass of
>DBIx::Class making life occasionally miserable.
>Now we need to know 3 methods of DB accession.
>
>I am really frustrated with all of those different layers of history, and
>making things work nicely across all different programming patterns, I have
>had great success in using a casting system, where we take any value and try
>to make a Koha::Object-subclass out of it.
>
>So we try to cast a Scalar or a reference of Koha::Object-implementation or
>DBIx::ResultSet or HASH, to the desired Koha::Object-implementation.
>This is a nice validation/entry function in any subroutine dealing with
>business objects, making sure that we always have the "correct" implementation
>of the same business object.
>
>Unit tests included demonstrating the feature and possible pitfalls.
>---
> Koha/Acquisition/Booksellers.pm |   4 ++
> Koha/AuthUtils.pm               |  39 ++++++++++++
> Koha/Items.pm                   |   4 ++
> Koha/Objects.pm                 | 131 ++++++++++++++++++++++++++++++++++++++++
> Koha/Patrons.pm                 |  54 +++++++++++++++++
> Koha/Subscriptions.pm           |   4 ++
> t/db_dependent/Koha/Objects.t   |  85 +++++++++++++++++++++++++-
> 7 files changed, 320 insertions(+), 1 deletion(-)
>
>diff --git a/Koha/Acquisition/Booksellers.pm b/Koha/Acquisition/Booksellers.pm
>index 5fa3540..3f75b1c 100644
>--- a/Koha/Acquisition/Booksellers.pm
>+++ b/Koha/Acquisition/Booksellers.pm
>@@ -34,4 +34,8 @@ sub object_class {
>     return 'Koha::Acquisition::Bookseller';
> }
> 
>+sub _get_castable_unique_columns {
>+    return ['id'];
>+}
>+
> 1;
>diff --git a/Koha/AuthUtils.pm b/Koha/AuthUtils.pm
>index a8b391d..a2b8f41 100644
>--- a/Koha/AuthUtils.pm
>+++ b/Koha/AuthUtils.pm
>@@ -23,6 +23,8 @@ use Encode qw( encode is_utf8 );
> use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt
> use List::MoreUtils qw/ any /;
> 
>+use Koha::Patron;
>+
> use base 'Exporter';
> 
> our @EXPORT_OK   = qw(hash_password get_script_name);
>@@ -152,6 +154,43 @@ sub get_script_name {
>     }
> }
> 
>+=head checkKohaSuperuserFromUserid
>+See checkKohaSuperuser(), with only the "user identifier"-@PARAM.
>+@THROWS nothing.
>+=cut
>+
>+sub checkKohaSuperuserFromUserid {
>+    my ($userid) = @_;
>+
>+    if ( $userid && $userid eq C4::Context->config('user') ) {
>+        return _createTemporarySuperuser();
>+    }
>+}
>+
>+=head _createTemporarySuperuser
>+
>+Create a temporary superuser which should be instantiated only to the environment
>+and then discarded. So do not ->store() it!
>+@RETURN Koha::Patron
>+=cut
>+
>+sub _createTemporarySuperuser {
>+    my $patron = Koha::Patron->new();
>+
>+    my $superuserName = C4::Context->config('user');
>+    $patron->set({borrowernumber => 0,
>+                       userid     => $superuserName,
>+                       cardnumber => $superuserName,
>+                       firstname  => $superuserName,
>+                       surname    => $superuserName,
>+                       branchcode => 'NO_LIBRARY_SET',
>+                       flags      => 1,
>+                       email      => C4::Context->preference('KohaAdminEmailAddress')
>+                    });
>+    return $patron;
>+}
>+
>+
> 1;
> 
> __END__
>diff --git a/Koha/Items.pm b/Koha/Items.pm
>index 7b86c5a..db2f12f 100644
>--- a/Koha/Items.pm
>+++ b/Koha/Items.pm
>@@ -37,6 +37,10 @@ Koha::Items - Koha Item object set class
> 
> =cut
> 
>+sub _get_castable_unique_columns {
>+    return ['itemnumber', 'barcode'];
>+}
>+
> =head3 type
> 
> =cut
>diff --git a/Koha/Objects.pm b/Koha/Objects.pm
>index 7e73297..3bd70d7 100644
>--- a/Koha/Objects.pm
>+++ b/Koha/Objects.pm
>@@ -19,10 +19,15 @@ package Koha::Objects;
> 
> use Modern::Perl;
> 
>+use Scalar::Util qw(blessed);
> use Carp;
> 
> use Koha::Database;
> 
>+
>+use Koha::Exception::UnknownObject;
>+use Koha::Exception::BadParameter;
>+
> =head1 NAME
> 
> Koha::Objects - Koha Object set base class
>@@ -68,6 +73,132 @@ sub _new_from_dbic {
>     bless( $self, $class );
> }
> 
>+=head _get_castable_unique_columns
>+@ABSTRACT, OVERLOAD FROM SUBCLASS
>+
>+Get the columns this Object can use to find a matching Object from the DB.
>+These columns must be UNIQUE or preferably PRIMARY KEYs.
>+So if the castable input is not an Object, we can try to find these scalars and do
>+a DB search using them.
>+=cut
>+
>+sub _get_castable_unique_columns {}
>+
>+=head Koha::Objects->cast();
>+
>+Try to find a matching Object from the given input. Is basically a validator to
>+validate the given input and make sure we get a Koha::Object or an Exception.
>+
>+=head2 An example:
>+
>+    ### IN Koha/Patrons.pm ###
>+    package Koha::Patrons;
>+    ...
>+    sub _get_castable_unique_columns {
>+        return ['borrowernumber', 'cardnumber', 'userid'];
>+    }
>+
>+    ### SOMEWHERE IN A SCRIPT FAR AWAY ###
>+    my $borrower = Koha::Patrons->cast('cardnumber');
>+    my $borrower = Koha::Patrons->cast($Koha::Patron);
>+    my $borrower = Koha::Patrons->cast('userid');
>+    my $borrower = Koha::Patrons->cast('borrowernumber');
>+    my $borrower = Koha::Patrons->cast({borrowernumber => 123,
>+                                        });
>+    my $borrower = Koha::Patrons->cast({firstname => 'Olli-Antti',
>+                                                    surname => 'Kivi',
>+                                                    address => 'Koskikatu 25',
>+                                                    cardnumber => '11A001',
>+                                                    ...
>+                                        });
>+
>+=head Description
>+
>+Because there are gazillion million ways in Koha to invoke an Object, this is a
>+helper for easily creating different kinds of objects from all the arcane invocations present
>+in many parts of Koha.
>+Just throw the crazy and unpredictable return values from myriad subroutines returning
>+some kind of an objectish value to this casting function to get a brand new Koha::Object.
>+@PARAM1 Scalar, or HASHRef, or Koha::Object or Koha::Schema::Result::XXX
>+@RETURNS Koha::Object subclass, possibly already in DB or a completely new one if nothing was
>+                         inferred from the DB.
>+@THROWS Koha::Exception::BadParameter, if no idea what to do with the input.
>+@THROWS Koha::Exception::UnknownObject, if we cannot find an Object with the given input.
>+
>+=cut
>+
>+sub cast {
>+    my ($class, $input) = @_;
>+
>+    unless ($input) {
>+        Koha::Exception::BadParameter->throw(error => "$class->cast():> No parameter given!");
>+    }
>+    if (blessed($input) && $input->isa( $class->object_class )) {
>+        return $input;
>+    }
>+    if (blessed($input) && $input->isa( 'Koha::Schema::Result::'.$class->_type )) {
>+        return $class->object_class->_new_from_dbic($input);
>+    }
>+
>+    my %searchTerms; #Make sure the search terms are processed in the order they have been introduced.
>+    #Extract unique keys and try to get the object from them.
>+    my $castableColumns = $class->_get_castable_unique_columns();
>+    my $resultSource = $class->_resultset()->result_source();
>+
>+    if (ref($input) eq 'HASH') {
>+        foreach my $col (@$castableColumns) {
>+            if ($input->{$col} &&
>+                    $class->_cast_validate_column( $resultSource->column_info($col), $input->{$col}) ) {
>+                $searchTerms{$col} = $input->{$col};
>+            }
>+        }
>+    }
>+    elsif (not(ref($input))) { #We have a scalar
>+        foreach my $col (@$castableColumns) {
>+            if ($class->_cast_validate_column( $resultSource->column_info($col), $input) ) {
>+                $searchTerms{$col} = $input;
>+            }
>+        }
>+    }
>+
>+    if (scalar(%searchTerms)) {
>+        my @objects = $class->search({'-or' => \%searchTerms});
>+
>+        unless (scalar(@objects) == 1) {
>+            my @keys = keys %searchTerms;
>+            my $keys = join('|', @keys);
>+            my @values = values %searchTerms;
>+            my $values = join('|', @values);
>+            Koha::Exception::UnknownObject->throw(error => "$class->cast():> Cannot find an existing ".$class->object_class." from $keys '$values'.")
>+                            if scalar(@objects) < 1;
>+            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)
>+                            if scalar(@objects) > 1;
>+        }
>+        return $objects[0];
>+    }
>+
>+    Koha::Exception::BadParameter->throw(error => "$class->cast():> Unknown parameter '$input' given!");
>+}
>+
>+=head _cast_validate_column
>+
>+    For some reason MySQL decided that it is a good idea to cast String to Integer automatically
>+    For ex. SELECT * FROM borrowers WHERE borrowernumber = '11A001';
>+    returns the Borrower with borrowernumber => 11, instead of no results!
>+    This is potentially catastrophic.
>+    Validate integers and other data types here.
>+
>+=cut
>+
>+sub _cast_validate_column {
>+    my ($class, $column, $value) = @_;
>+
>+    if ($column->{data_type} eq 'integer' && $value !~ m/^\d+$/) {
>+        return 0;
>+    }
>+    return 1;
>+}
>+
> =head3 Koha::Objects->find();
> 
> my $object = Koha::Objects->find($id);
>diff --git a/Koha/Patrons.pm b/Koha/Patrons.pm
>index b8aebeb..968596a 100644
>--- a/Koha/Patrons.pm
>+++ b/Koha/Patrons.pm
>@@ -27,10 +27,14 @@ use Koha::DateUtils;
> 
> use Koha::ArticleRequests;
> use Koha::ArticleRequest::Status;
>+use Koha::AuthUtils;
> use Koha::Patron;
> 
> use base qw(Koha::Objects);
> 
>+use Scalar::Util qw(blessed);
>+use Try::Tiny;
>+
> =head1 NAME
> 
> Koha::Patron - Koha Patron Object class
>@@ -41,6 +45,10 @@ Koha::Patron - Koha Patron Object class
> 
> =cut
> 
>+sub _get_castable_unique_columns {
>+    return ['borrowernumber', 'cardnumber', 'userid'];
>+}
>+
> =head3 search_housebound_choosers
> 
> Returns all Patrons which are Housebound choosers.
>@@ -183,6 +191,52 @@ sub anonymise_issue_history {
>     $old_issues_to_anonymise->update( { 'old_issues.borrowernumber' => $anonymous_patron } );
> }
> 
>+=head cast
>+
>+    my $borrower = Koha::Patrons->cast('cardnumber');
>+    my $borrower = Koha::Patrons->cast($Koha::Patron);
>+    my $borrower = Koha::Patrons->cast('userid');
>+    my $borrower = Koha::Patrons->cast('borrowernumber');
>+    my $borrower = Koha::Patrons->cast({borrowernumber => 123,
>+                                                });
>+    my $borrower = Koha::Patrons->cast({firstname => 'Olli-Antti',
>+                                                    surname => 'Kivi',
>+                                                    address => 'Koskikatu 25',
>+                                                });
>+
>+Because there are gazillion million ways in Koha to invoke a Patron, this is a
>+omnibus for easily creating a Patron-object from all the arcane invocations present
>+in many parts of Koha.
>+Just throw the crazy and unpredictable return values from myriad subroutines returning
>+some kind of an patronish value to this casting function to get a brand new Koha::Patron.
>+@PARAM1 Scalar, or HASHRef.
>+@RETURNS Koha::Patron, possibly already in DB or a completely new one if nothing was
>+                         inferred from the DB.
>+@THROWS Koha::Exception::BadParameter, if no idea what to do with the input.
>+@THROWS Koha::Exception::UnknownObject, if we cannot find a Patron with the given input.
>+=cut
>+
>+sub cast {
>+    my ($class, $input) = @_;
>+
>+    my $patron;
>+    try {
>+        $patron = $class->SUPER::cast($input);
>+    } catch {
>+        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
>+            $patron = Koha::AuthUtils::checkKohaSuperuserFromUserid($input);
>+            unless ($patron) {
>+                $_->rethrow();
>+            }
>+        }
>+        else {
>+            die $_;
>+        }
>+    };
>+
>+    return $patron;
>+}
>+
> =head3 type
> 
> =cut
>diff --git a/Koha/Subscriptions.pm b/Koha/Subscriptions.pm
>index 3538c15..5d5ecb3 100644
>--- a/Koha/Subscriptions.pm
>+++ b/Koha/Subscriptions.pm
>@@ -49,6 +49,10 @@ sub object_class {
>     return 'Koha::Subscription';
> }
> 
>+sub _get_castable_unique_columns {
>+    return ['subscriptionid'];
>+}
>+
> =head1 AUTHOR
> 
> Kyle M Hall <kyle@bywatersolutions.com>
>diff --git a/t/db_dependent/Koha/Objects.t b/t/db_dependent/Koha/Objects.t
>index 935dc47..fd4d594 100644
>--- a/t/db_dependent/Koha/Objects.t
>+++ b/t/db_dependent/Koha/Objects.t
>@@ -19,9 +19,11 @@
> 
> use Modern::Perl;
> 
>-use Test::More tests => 13;
>+use Test::More tests => 14;
> use Test::Warn;
> 
>+use C4::Members;
>+
> use Koha::Authority::Types;
> use Koha::Cities;
> use Koha::Patron::Category;
>@@ -31,6 +33,7 @@ use Koha::Database;
> 
> use t::lib::TestBuilder;
> 
>+use Scalar::Util qw(blessed);
> use Try::Tiny;
> 
> my $schema = Koha::Database->new->schema;
>@@ -168,5 +171,85 @@ subtest 'Exceptions' => sub {
>     };
> };
> 
>+subtest 'Koha::Objects->cast() using Koha::Patrons 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::Patrons->cast($borrowernumber);
>+    is($borrower->cardnumber, '11A001', "Patron cast from AddMember() output");
>+
>+    $member = C4::Members::GetMember(borrowernumber => $borrower->borrowernumber);
>+    $borrower = Koha::Patrons->cast($member);
>+    is($borrower->cardnumber, '11A001', "Patron cast from GetMember() output, whatever that is");
>+
>+    $borrower = Koha::Patrons->cast('11A001');
>+    is($borrower->cardnumber, '11A001', "Patron cast from cardnumber");
>+
>+    $borrower = Koha::Patrons->cast('Uriel Septim VII');
>+    is($borrower->cardnumber, '11A001', "Patron cast from userid");
>+
>+    $borrower = Koha::Patrons->cast(C4::Context->config('user'));
>+    is($borrower->cardnumber, C4::Context->config('user'), "Patron cast from db user");
>+
>+    $testDescription = "Patron casting failed";
>+    try {
>+        $borrower = Koha::Patrons->cast('Uriel Septim IX');
>+        ok(0, $testDescription);
>+    } catch {
>+        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
>+            ok(1, $testDescription);
>+        }
>+        else {
>+            die $_;
>+        }
>+    };
>+
>+    $testDescription = "Patron casting from undef failed";
>+    try {
>+        my $undefVariable;
>+        $borrower = Koha::Patrons->cast($undefVariable);
>+        ok(0, $testDescription);
>+    } catch {
>+        if (blessed($_) && $_->isa('Koha::Exception::BadParameter')) {
>+            ok(1, $testDescription);
>+        }
>+        else {
>+            die $_;
>+        }
>+    };
>+
>+    #Under no circumstances we want to mix Patron 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::Patrons->cast($borrowernumber);
>+        ok(0, $testDescription);
>+    } catch {
>+        if (blessed($_) && $_->isa('Koha::Exception::UnknownObject')) {
>+            ok(1, $testDescription);
>+        }
>+        else {
>+            die $_;
>+        }
>+    };
>+};
>+
> $schema->storage->txn_rollback;
> 1;
>-- 
>2.7.4

Actions: View | Diff | Splinter Review

Attachments on bug 14539: 41025 | 41063 | 41122 | 41157 | 41250 | 41530 | 63235 | 63236 | 63237 | 63243 | 63246