Open-ILS/src/perlmods/lib/OpenILS/WWW/EGCatLoader/Register.pm

   1 package OpenILS::WWW::EGCatLoader;
   2 use strict; use warnings;
   3 use Apache2::Const -compile => qw(OK FORBIDDEN HTTP_INTERNAL_SERVER_ERROR);
   4 use OpenSRF::Utils::Logger qw/$logger/;
   5 use OpenILS::Utils::Fieldmapper;
   6 use OpenILS::Application::AppUtils;
   7 use OpenILS::Utils::CStoreEditor qw/:funcs/;
   8 use OpenILS::Event;
   9 use Data::Dumper;
  10 $Data::Dumper::Indent = 0;
  11 my $U = 'OpenILS::Application::AppUtils';
  12
  13 sub load_patron_reg {
  14     my $self = shift;
  15     my $ctx = $self->ctx;
  16     my $cgi = $self->cgi;
  17     $ctx->{register} = {};
  18     $self->collect_register_validation_settings;
  19     $self->collect_requestor_info;
  20
  21     # in the home org unit selector, we only want to present
  22     # org units to the patron which support self-registration.
  23     # all other org units will be disabled
  24     $ctx->{register}{valid_orgs} =
  25         $self->setting_is_true_for_orgs('opac.allow_pending_user');
  26
  27     $self->collect_opt_in_settings;
  28
  29     # just loading the form
  30     return Apache2::Const::OK
  31         unless $cgi->request_method eq 'POST';
  32
  33     my $user = Fieldmapper::staging::user_stage->new;
  34     my $addr = Fieldmapper::staging::mailing_address_stage->new;
  35
  36     # user
  37     foreach (grep /^stgu\./, $cgi->param) {
  38         my $val = $cgi->param($_);
  39         $self->inspect_register_value($_, $val);
  40         s/^stgu\.//g;
  41         $user->$_($val);
  42     }
  43
  44     # requestor is logged in, capture who is making this request
  45     $user->requesting_usr($ctx->{user}->id) if $ctx->{user};
  46
  47     # make sure the selected home org unit is in the list
  48     # of valid orgs.  This can happen if the selector
  49     # defaults to CONS, for example.
  50     $ctx->{register}{invalid}{bad_home_ou} = 1 unless
  51         grep {$_ eq $user->home_ou} @{$ctx->{register}{valid_orgs}};
  52
  53     # address
  54     my $has_addr = 0;
  55     foreach (grep /^stgma\./, $cgi->param) {
  56         my $val = $cgi->param($_);
  57         $self->inspect_register_value($_, $val);
  58         s/^stgma\.//g;
  59         $addr->$_($val);
  60         $has_addr = 1;
  61     }
  62
  63     # if the form contains no address fields, do not
  64     # attempt to create a pending address
  65     $addr = undef unless $has_addr;
  66
  67     # opt-in settings
  68     my $settings = [];
  69     foreach (grep /^stgs\./, $cgi->param) {
  70         my $val = $cgi->param($_);
  71         next unless $val; # opt-in settings are always Boolean,
  72                           # so just skip if not set
  73         $self->inspect_register_value($_, $val);
  74         s/^stgs.//g;
  75         my $setting = Fieldmapper::staging::setting_stage->new;
  76         $setting->setting($_);
  77         $setting->value('true');
  78         push @$settings, $setting;
  79     }
  80
  81     # At least one value was invalid. Exit early and re-render.
  82     return Apache2::Const::OK if $ctx->{register}{invalid};
  83
  84     $self->test_requested_username($user);
  85
  86     # user.stage.create will generate a temporary usrname and
  87     # link the user and address objects via this username in the DB.
  88     my $resp = $U->simplereq(
  89         'open-ils.actor',
  90         'open-ils.actor.user.stage.create',
  91         $user, $addr, undef, [], $settings
  92     );
  93
  94     if (!$resp or ref $resp) {
  95
  96         $logger->warn("Patron self-reg failed ".Dumper($resp));
  97         $ctx->{register}{error} = 1;
  98
  99     } else {
 100
 101         $logger->info("Patron self-reg success; usrname $resp");
 102         $ctx->{register}{success} = 1;
 103     }
 104
 105     return Apache2::Const::OK;
 106 }
 107
 108 # if the pending account is requested by an existing user account,
 109 # load the existing user's data to pre-populate some fields.
 110 sub collect_requestor_info {
 111     my $self = shift;
 112     return unless $self->ctx->{user};
 113
 114     my $user = $self->editor->retrieve_actor_user([
 115         $self->ctx->{user}->id,
 116         {flesh => 1, flesh_fields => {
 117             au => [qw/mailing_address billing_address/]}
 118         }
 119     ]);
 120
 121
 122     my $vhash = $self->ctx->{register}{values} = {};
 123     my $addr = $user->mailing_address || $user->billing_address;
 124     $vhash->{stgu}{home_ou} = $user->home_ou;
 125
 126     if ($addr) {
 127         $vhash->{stgma}{city} = $addr->city;
 128         $vhash->{stgma}{county} = $addr->county;
 129         $vhash->{stgma}{state} = $addr->state;
 130         $vhash->{stgma}{post_code} = $addr->post_code;
 131     }
 132 }
 133
 134 sub collect_opt_in_settings {
 135     my $self = shift;
 136     my $e = $self->editor;
 137
 138     my $types = $e->json_query({
 139         select => {cust => ['name']},
 140         from => {atevdef => 'cust'},
 141         transform => 'distinct',
 142         where => {
 143             '+atevdef' => {
 144                 owner => [ map { $_ } @{ $self->ctx->{register}{valid_orgs} } ],
 145                 active => 't'
 146             }
 147         }
 148     });
 149     $self->ctx->{register}{opt_in_settings} =
 150         $e->search_config_usr_setting_type({name => [map {$_->{name}} @$types]});
 151 }
 152
 153 # if the username is in use by an actor.usr OR a
 154 # pending user treat it as taken and warn the user.
 155 sub test_requested_username {
 156     my ($self, $user) = @_;
 157     my $uname = $user->usrname || return;
 158     my $e = $self->editor;
 159
 160     my $taken = $e->search_actor_user(
 161         {usrname => $uname, deleted => 'f'},
 162         {idlist => 1}
 163     )->[0];
 164
 165     $taken = $e->search_staging_user_stage(
 166         {usrname => $uname},
 167         {idlist => 1}
 168     )->[0] unless $taken;
 169
 170     if ($taken) {
 171         $self->ctx->{register}{username_taken} = 1;
 172         $user->clear_usrname;
 173     }
 174 }
 175
 176 sub collect_register_validation_settings {
 177     my $self = shift;
 178     my $ctx = $self->ctx;
 179     my $e = new_editor();
 180     my $ctx_org = $ctx->{physical_loc} || $self->_get_search_lib;
 181     my $shash = $self->{register}{settings} = {};
 182
 183     # retrieve the org unit setting types and values
 184     # that are relevant to our validation tasks.
 185
 186     my $settings = $e->json_query({
 187         select => {coust => ['name']},
 188         from => 'coust',
 189         where => {name => {like => 'ui.patron.edit.%.%.%'}}
 190     });
 191
 192     # load org setting values for all of the regex,
 193     # example, show, and require settings
 194     for my $set (@$settings) {
 195         $set = $set->{name};
 196         next unless $set =~ /regex$|show$|require$|example$/;
 197
 198         my $val = $ctx->{get_org_setting}->($ctx_org, $set);
 199         next unless $val; # no configured org setting
 200
 201         # extract the field class, name, and
 202         # setting type from the setting name
 203         my (undef, undef, undef, $cls, $field, $type) = split(/\./, $set);
 204
 205         # translate classes into stage classes
 206         my $scls = ($cls eq 'au') ? 'stgu' : 'stgma';
 207
 208         $shash->{$scls}{$field}{$type} = $val;
 209     }
 210
 211     # use the generic phone settings where none are provided for day_phone.
 212
 213     $shash->{stgu}{day_phone}{example} =
 214         $ctx->{get_org_setting}->($ctx_org, 'ui.patron.edit.phone.example')
 215         unless $shash->{stgu}{day_phone}{example};
 216
 217     $shash->{stgu}{day_phone}{regex} =
 218         $ctx->{get_org_setting}->($ctx_org, 'ui.patron.edit.phone.regex')
 219         unless $shash->{stgu}{day_phone}{regex};
 220
 221     # The regex OUS for username does not match the format of the other
 222     # org settings.  Wrangle it into place.
 223     $shash->{stgu}{usrname}{regex} =
 224         $ctx->{get_org_setting}->($ctx_org, 'opac.username_regex');
 225
 226     # some fields are assumed to be visible / required even without the
 227     # presence of org unit settings.  E.g. we obviously want the user to
 228     # enter a name, since a name is required for ultimately creating a user
 229     # account.  We can mimic that by forcing some org unit setting values
 230
 231     $shash->{stgu}{first_given_name}{require} = 1
 232         unless defined $shash->{stgu}{first_given_name}{require};
 233     $shash->{stgu}{second_given_name}{show} = 1
 234         unless defined $shash->{stgu}{second_given_name}{show};
 235     $shash->{stgu}{family_name}{require} = 1
 236         unless defined $shash->{stgu}{family_name}{require};
 237     $shash->{stgma}{street1}{require} = 1
 238         unless defined $shash->{stgma}{street1}{require};
 239     $shash->{stgma}{street2}{show} = 1
 240         unless defined $shash->{stgma}{street2}{show};
 241     $shash->{stgma}{city}{require} = 1
 242         unless defined $shash->{stgma}{city}{require};
 243     $shash->{stgma}{post_code}{require} = 1
 244         unless defined $shash->{stgma}{post_code}{require};
 245     $shash->{stgu}{usrname}{show} = 1
 246         unless defined $shash->{stgu}{usrname}{show};
 247
 248     $ctx->{register}{settings} = $shash;
 249
 250     # laod the page timeout setting
 251     $shash->{refresh_timeout} =
 252         $ctx->{get_org_setting}->($ctx_org, 'opac.self_register.timeout');
 253 }
 254
 255 # inspects each value and determines, based on org unit settings,
 256 # if the value is invalid.  Invalid is defined as not providing
 257 # a value when one is required or not matching the configured regex.
 258 sub inspect_register_value {
 259     my ($self, $field_path, $value) = @_;
 260     my $ctx = $self->ctx;
 261     my ($scls, $field) = split(/\./, $field_path, 2);
 262
 263     if ($scls eq 'stgs') {
 264         my $found = 0;
 265         foreach my $type (@{ $self->ctx->{register}{opt_in_settings} }) {
 266             if ($field eq $type->name) {
 267                 $found = 1;
 268             }
 269         }
 270         if (!$found) {
 271             $ctx->{register}{invalid}{$scls}{$field}{invalid} = 1;
 272             $logger->info("patron register: trying to set an opt-in ".
 273                           "setting $field that is not allowed.");
 274         }
 275         return;
 276     }
 277
 278     if (!$value) {
 279
 280         if ($self->{register}{settings}{$scls}{$field}{require}) {
 281             $ctx->{register}{invalid}{$scls}{$field}{require} = 1;
 282
 283             $logger->info("patron register field $field ".
 284                 "requires a value, but none was entered");
 285         }
 286         return;
 287     }
 288
 289     my $regex = $self->{register}{settings}{$scls}{$field}{regex};
 290     return if !$regex or $value =~ /$regex/; # field is valid
 291
 292     $logger->info("invalid value was provided for patron ".
 293         "register field=$field; pattern=$regex; value=$value");
 294
 295     $ctx->{register}{invalid}{$scls}{$field}{regex} = 1;
 296
 297     return;
 298 }
 299
 300
 301