JBAS-1132 Self-register EGCatLoader API mods

* Upper-case most patron fields before inserting stage users.
* Normalize addresses
* De-duplicate addresses
* Handle KCLS-specific stat cats
* Honor opac.self_register.profile org setting

Signed-off-by: Bill Erickson <berickxx@gmail.com>

diff --git a/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm b/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm
index 4949d10..90cab58 100644 (file)
--- a/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm
+++ b/Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm
@@ -7,6 +7,7 @@ use OpenILS::Application::AppUtils;
 use OpenILS::Utils::CStoreEditor qw/:funcs/;
 use OpenILS::Event;
 use Data::Dumper;
+use OpenILS::Utils::KCLSNormalize;
 $Data::Dumper::Indent = 0;
 my $U = 'OpenILS::Application::AppUtils';
 
@@ -31,12 +32,11 @@ sub load_patron_reg {
         unless $cgi->request_method eq 'POST';
 
     my $user = Fieldmapper::staging::user_stage->new;
-    my $addr = Fieldmapper::staging::mailing_address_stage->new;
 
     # user
     foreach (grep /^stgu\./, $cgi->param) {
         my $val = $cgi->param($_);
-        $self->inspect_register_value($_, $val);
+        $val = $self->inspect_register_value($_, $val);
         s/^stgu\.//g;
         $user->$_($val);
     }
@@ -50,19 +50,9 @@ sub load_patron_reg {
     $ctx->{register}{invalid}{bad_home_ou} = 1 unless
         grep {$_ eq $user->home_ou} @{$ctx->{register}{valid_orgs}};
 
-    # address
-    my $has_addr = 0;
-    foreach (grep /^stgma\./, $cgi->param) {
-        my $val = $cgi->param($_);
-        $self->inspect_register_value($_, $val);
-        s/^stgma\.//g;
-        $addr->$_($val);
-        $has_addr = 1;
-    }
+    my ($bill_addr, $mail_addr) = $self->handle_addresses($cgi);
 
-    # if the form contains no address fields, do not 
-    # attempt to create a pending address
-    $addr = undef unless $has_addr;
+    my $stat_cats = $self->handle_stat_cats($cgi);
 
     # opt-in settings
     my $settings = [];
@@ -83,12 +73,18 @@ sub load_patron_reg {
 
     $self->test_requested_username($user);
 
+    # KCLS JBAS-1138
+    my $profile = $U->ou_ancestor_setting_value(
+        $user->home_ou, 'opac.self_register.profile');
+    
+    $user->profile($profile) if $profile;
+
     # user.stage.create will generate a temporary usrname and 
     # link the user and address objects via this username in the DB.
     my $resp = $U->simplereq(
         'open-ils.actor', 
         'open-ils.actor.user.stage.create',
-        $user, $addr, undef, [], $settings
+        $user, $mail_addr, $bill_addr, $stat_cats
     );
 
     if (!$resp or ref $resp) {
@@ -105,6 +101,102 @@ sub load_patron_reg {
     return Apache2::Const::OK;
 }
 
+# returns true if the addresses contain all of the same values.
+sub addrs_match {
+    my ($self, $addr1, $addr2) = @_;
+    for my $field ($addr1->real_fields) {
+        $logger->info("comparing addr fields $field: " .
+            $addr1->$field() . " : " . $addr2->$field());
+        return 0 if ($addr1->$field() || '') ne ($addr2->$field() || '');
+    }
+    return 1;
+}
+
+
+sub handle_addresses {
+    my $self = shift;
+    my $cgi = shift;
+    my $bill_addr;
+    my $mail_addr;
+
+    # billing ---
+    foreach (grep /^stgba\./, $cgi->param) {
+        my $val = $cgi->param($_) or next; # skip empty strings
+        $val = $self->inspect_register_value($_, $val);
+        s/^stgba\.//g;
+        $bill_addr = Fieldmapper::staging::billing_address_stage->new
+            unless $bill_addr;
+        $bill_addr->$_($val);
+    }
+
+    if ($bill_addr) {
+        # DB requires this field
+        $bill_addr->post_code('') unless $bill_addr->post_code;
+        # if no street1 is entered, don't create the addres
+        $bill_addr = undef unless $bill_addr->street1;
+    }
+
+    # DB requires this field
+    $bill_addr->post_code('') if $bill_addr && !$bill_addr->post_code;
+
+    # mailing ---
+    foreach (grep /^stgma\./, $cgi->param) {
+        my $val = $cgi->param($_) or next; # skip empty strings
+        $val = $self->inspect_register_value($_, $val);
+        s/^stgma\.//g;
+        $mail_addr = Fieldmapper::staging::mailing_address_stage->new
+            unless $mail_addr;
+        $mail_addr->$_($val);
+    }
+   
+    if ($mail_addr) {
+        # DB requires this field
+        $mail_addr->post_code('') unless $mail_addr->post_code;
+        # if no street1 is entered, don't create the addres
+        $mail_addr = undef unless $mail_addr->street1;
+    }
+
+    # only create the mailing address if it differs from the 
+    # billing (residential) address.  We know from the form
+    # data whether the user selected mailing-matches-billing, 
+    # but make the comparison anyway in case the option was 
+    # de-selected when the match anyway.
+    $mail_addr = undef if (
+        $bill_addr && 
+        $mail_addr && 
+        $self->addrs_match($bill_addr, $mail_addr)
+    );
+
+    if ($bill_addr) {
+        my ($bstreet1, $bstreet2) = 
+            OpenILS::Utils::KCLSNormalize::normalize_address_street(
+                $bill_addr->street1, $bill_addr->street2);
+
+        $bill_addr->street1($bstreet1);
+        if ($bstreet2) {
+            $bill_addr->street2($bstreet2);
+        } else {
+            $bill_addr->clear_street2;
+        }
+    }
+
+    if ($mail_addr) {
+        my ($mstreet1, $mstreet2) = 
+            OpenILS::Utils::KCLSNormalize::normalize_address_street(
+                $mail_addr->street1, $mail_addr->street2);
+
+        $mail_addr->street1($mstreet1);
+        if ($mstreet2) {
+            $mail_addr->street2($mstreet2);
+        } else {
+            $mail_addr->clear_street2;
+        }
+    }
+
+    return ($bill_addr, $mail_addr);
+}
+
+
 # if the pending account is requested by an existing user account,
 # load the existing user's data to pre-populate some fields.
 sub collect_requestor_info {
@@ -173,6 +265,48 @@ sub test_requested_username {
     }
 }
 
+# Stat cat handling is hard-coded, since there is not a one-to-one
+# relationship between form options and stat cat entry values.
+# We have to do some manual value mapping.
+sub handle_stat_cats {
+    my $self = shift;
+    my $cgi = shift;
+
+    my $stat_cats = [];
+
+    foreach (grep /^stgsc\./, $cgi->param) {
+        $logger->info(
+            "registering user with stat cat values $_ => ".$cgi->param($_));
+    }
+
+    # Gender
+    my $stat_cat = Fieldmapper::staging::statcat_stage->new;
+    $stat_cat->statcat(1);
+    $stat_cat->value($cgi->param('stgsc.1'));
+    push(@$stat_cats, $stat_cat);
+
+    if (my $pickup_auth = $cgi->param('stgsc.5')) {
+        my $stat_cat = Fieldmapper::staging::statcat_stage->new;
+        $stat_cat->statcat(5);
+        $stat_cat->value($pickup_auth);
+        push(@$stat_cats, $stat_cat);
+    }
+
+    # Events mailing
+    $stat_cat = Fieldmapper::staging::statcat_stage->new;
+    $stat_cat->statcat(3);
+    $stat_cat->value((grep {$_ eq 'stgsc.3'} $cgi->param) ? 'Y' : 'N');
+    push(@$stat_cats, $stat_cat);
+
+    # Foundation mailing
+    $stat_cat = Fieldmapper::staging::statcat_stage->new;
+    $stat_cat->statcat(4);
+    $stat_cat->value((grep {$_ eq 'stgsc.4'} $cgi->param) ? 'Y' : 'N');
+    push(@$stat_cats, $stat_cat);
+
+    return $stat_cats;
+}
+
 sub collect_register_validation_settings {
     my $self = shift;
     my $ctx = $self->ctx;
@@ -275,6 +409,10 @@ sub inspect_register_value {
         return;
     }
 
+    $value ||= ''; # avoid log warnings
+
+    $logger->info("Patron register processing value $field_path => $value");
+
     if (!$value) {
 
         if ($self->{register}{settings}{$scls}{$field}{require}) {
@@ -286,15 +424,20 @@ sub inspect_register_value {
         return;
     }
 
+    # KCLS JBAS-1133
+    # Make (most) patron fields upper-case.
+    my %keep_case = (usrname => 1, passwd => 1, email => 1);
+    $value = uc($value) unless $keep_case{$field};
+
     my $regex = $self->{register}{settings}{$scls}{$field}{regex};
-    return if !$regex or $value =~ /$regex/; # field is valid
+    return $value if !$regex or $value =~ /$regex/; # field is valid
 
     $logger->info("invalid value was provided for patron ".
         "register field=$field; pattern=$regex; value=$value");
 
     $ctx->{register}{invalid}{$scls}{$field}{regex} = 1;
 
-    return;
+    return $value;
 }