LP1207396 Patron self-registration web form
[working/Evergreen.git] / 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     # just loading the form
28     return Apache2::Const::OK
29         unless $cgi->request_method eq 'POST';
30
31     my $user = Fieldmapper::staging::user_stage->new;
32     my $addr = Fieldmapper::staging::mailing_address_stage->new;
33
34     # user
35     foreach (grep /^stgu\./, $cgi->param) {
36         my $val = $cgi->param($_);
37         $self->inspect_register_value($_, $val);
38         s/^stgu\.//g;
39         $user->$_($val);
40     }
41
42     # requestor is logged in, capture who is making this request
43     $user->requesting_usr($ctx->{user}->id) if $ctx->{user};
44
45     # make sure the selected home org unit is in the list 
46     # of valid orgs.  This can happen if the selector 
47     # defaults to CONS, for example.
48     $ctx->{register}{invalid}{bad_home_ou} = 1 unless
49         grep {$_ eq $user->home_ou} @{$ctx->{register}{valid_orgs}};
50
51     # address
52     my $has_addr = 0;
53     foreach (grep /^stgma\./, $cgi->param) {
54         my $val = $cgi->param($_);
55         $self->inspect_register_value($_, $val);
56         s/^stgma\.//g;
57         $addr->$_($val);
58         $has_addr = 1;
59     }
60
61     # if the form contains no address fields, do not 
62     # attempt to create a pending address
63     $addr = undef unless $has_addr;
64
65     # At least one value was invalid. Exit early and re-render.
66     return Apache2::Const::OK if $ctx->{register}{invalid};
67
68     $self->test_requested_username($user);
69
70     # user.stage.create will generate a temporary usrname and 
71     # link the user and address objects via this username in the DB.
72     my $resp = $U->simplereq(
73         'open-ils.actor', 
74         'open-ils.actor.user.stage.create',
75         $user, $addr
76     );
77
78     if (!$resp or ref $resp) {
79
80         $logger->warn("Patron self-reg failed ".Dumper($resp));
81         $ctx->{register}{error} = 1;
82
83     } else {
84
85         $logger->info("Patron self-reg success; usrname $resp");
86         $ctx->{register}{success} = 1;
87     }
88
89     return Apache2::Const::OK;
90 }
91
92 # if the pending account is requested by an existing user account,
93 # load the existing user's data to pre-populate some fields.
94 sub collect_requestor_info {
95     my $self = shift;
96     return unless $self->ctx->{user};
97
98     my $user = $self->editor->retrieve_actor_user([
99         $self->ctx->{user}->id,
100         {flesh => 1, flesh_fields => {
101             au => [qw/mailing_address billing_address/]}
102         }
103     ]);
104
105
106     my $vhash = $self->ctx->{register}{values} = {};
107     my $addr = $user->mailing_address || $user->billing_address;
108     $vhash->{stgu}{home_ou} = $user->home_ou;
109
110     if ($addr) {
111         $vhash->{stgma}{city} = $addr->city;
112         $vhash->{stgma}{county} = $addr->county;
113         $vhash->{stgma}{state} = $addr->state;
114         $vhash->{stgma}{post_code} = $addr->post_code;
115     }
116 }
117
118 # if the username is in use by an actor.usr OR a 
119 # pending user treat it as taken and warn the user.
120 sub test_requested_username {
121     my ($self, $user) = @_;
122     my $uname = $user->usrname || return;
123     my $e = $self->editor;
124
125     my $taken = $e->search_actor_user(
126         {usrname => $uname, deleted => 'f'}, 
127         {idlist => 1}
128     )->[0];
129
130     $taken = $e->search_staging_user_stage(
131         {usrname => $uname}, 
132         {idlist => 1}
133     )->[0] unless $taken;
134
135     if ($taken) {
136         $self->ctx->{register}{username_taken} = 1;
137         $user->clear_usrname;
138     }
139 }
140
141 sub collect_register_validation_settings {
142     my $self = shift;
143     my $ctx = $self->ctx;
144     my $e = new_editor();
145     my $ctx_org = $ctx->{physical_loc} || $self->_get_search_lib;
146     my $shash = $self->{register}{settings} = {};
147
148     # retrieve the org unit setting types and values
149     # that are relevant to our validation tasks.
150
151     my $settings = $e->json_query({
152         select => {coust => ['name']},
153         from => 'coust',
154         where => {name => {like => 'ui.patron.edit.%.%.%'}}
155     });
156
157     # load org setting values for all of the regex, 
158     # example, show, and require settings
159     for my $set (@$settings) {
160         $set = $set->{name};
161         next unless $set =~ /regex$|show$|require$|example$/;
162
163         my $val = $ctx->{get_org_setting}->($ctx_org, $set);
164         next unless $val; # no configured org setting
165
166         # extract the field class, name, and 
167         # setting type from the setting name
168         my (undef, undef, undef, $cls, $field, $type) = split(/\./, $set);
169
170         # translate classes into stage classes
171         my $scls = ($cls eq 'au') ? 'stgu' : 'stgma';
172
173         $shash->{$scls}{$field}{$type} = $val;
174     }
175
176     # use the generic phone settings where none are provided for day_phone.
177
178     $shash->{stgu}{day_phone}{example} =
179         $ctx->{get_org_setting}->($ctx_org, 'ui.patron.edit.phone.example')
180         unless $shash->{stgu}{day_phone}{example};
181
182     $shash->{stgu}{day_phone}{regex} =
183         $ctx->{get_org_setting}->($ctx_org, 'ui.patron.edit.phone.regex')
184         unless $shash->{stgu}{day_phone}{regex};
185
186     # some fields are assumed to be visible / required even without the            
187     # presence of org unit settings.  E.g. we obviously want the user to 
188     # enter a name, since a name is required for ultimately creating a user 
189     # account.  We can mimic that by forcing some org unit setting values
190     
191     $shash->{stgu}{first_given_name}{require} = 1
192         unless defined $shash->{stgu}{first_given_name}{require};
193     $shash->{stgu}{second_given_name}{show} = 1
194         unless defined $shash->{stgu}{second_given_name}{show};
195     $shash->{stgu}{family_name}{require} = 1
196         unless defined $shash->{stgu}{family_name}{require};
197     $shash->{stgma}{street1}{require} = 1
198         unless defined $shash->{stgma}{street1}{require};
199     $shash->{stgma}{street2}{show} = 1
200         unless defined $shash->{stgma}{street2}{show};
201     $shash->{stgma}{city}{require} = 1
202         unless defined $shash->{stgma}{city}{require};
203     $shash->{stgma}{post_code}{require} = 1
204         unless defined $shash->{stgma}{post_code}{require};
205     $shash->{stgu}{usrname}{show} = 1
206         unless defined $shash->{stgu}{usrname}{show};
207
208     $ctx->{register}{settings} = $shash;
209 }
210
211 # inspects each value and determines, based on org unit settings, 
212 # if the value is invalid.  Invalid is defined as not providing 
213 # a value when one is required or not matching the configured regex.
214 sub inspect_register_value {
215     my ($self, $field_path, $value) = @_;
216     my $ctx = $self->ctx;
217     my ($scls, $field) = split(/\./, $field_path);
218
219     if (!$value) {
220
221         if ($self->{register}{settings}{$scls}{$field}{require}) {
222             $ctx->{register}{invalid}{$scls}{$field}{require} = 1;
223
224             $logger->info("patron register field $field ".
225                 "requires a value, but none was entered");
226         }
227         return;
228     }
229
230     my $regex = $self->{register}{settings}{$scls}{$field}{regex};
231     return if !$regex or $value =~ /$regex/; # field is valid
232
233     $logger->info("invalid value was provided for patron ".
234         "register field=$field; pattern=$regex; value=$value");
235
236     $ctx->{register}{invalid}{$scls}{$field}{regex} = 1;
237
238     return;
239 }
240
241
242