use OpenILS::Event;
use Data::Dumper;
use LWP::UserAgent;
-use OpenILS::Utils::KCLSNormalize;
use DateTime;
use Digest::MD5 qw(md5_hex);
$Data::Dumper::Indent = 0;
my $U = 'OpenILS::Application::AppUtils';
-
-my $PROVISIONAL_ECARD_GRP = 951;
-my $FULL_ECARD_GRP = 952;
-my $ECARD_VERIFY_IDENT = 102;
-
-my $HEADER_FOOTER_URL =
- 'https://kcls.bibliocommons.com/widgets/external_templates.json';
-my $HEADER_FOOTER_TIMEOUT = 5;
-
my @api_fields = (
{name => 'vendor_username', required => 1},
{name => 'vendor_password', required => 1},
{name => 'first_given_name', class => 'au', required => 1},
{name => 'second_given_name', class => 'au'},
{name => 'family_name', class => 'au', required => 1},
+ {name => 'suffix', class => 'au'},
{name => 'email', class => 'au', required => 1},
{name => 'passwd', class => 'au', required => 1},
{name => 'day_phone', class => 'au', required => 1},
{name => 'dob', class => 'au', required => 1},
{name => 'home_ou', class => 'au', required => 1},
- {name => 'ident_value2',
+ {name => 'ident_type', class => 'au', required => 1},
+ {name => 'ident_value', class => 'au', required => 1},
+ {name => 'guardian',
class => 'au',
notes => "AKA parent/guardian",
required_if => 'Patron is less than 18 years old'
},
- {name => 'billing_street1', class => 'aua', required => 1},
- {name => 'billing_street1_name'},
- {name => 'billing_street2', class => 'aua'},
- {name => 'billing_city', class => 'aua', required => 1},
- {name => 'billing_post_code', class => 'aua', required => 1},
- {name => 'billing_county', class => 'aua', required => 1},
- {name => 'billing_state', class => 'aua', required => 1},
- {name => 'billing_country', class => 'aua', required => 1},
- {name => 'events_mailing', class => 'asc'},
- {name => 'foundation_mailing', class => 'asc'}
+ {name => 'pref_first_given_name', class => 'au'},
+ {name => 'pref_second_given_name', class => 'au'},
+ {name => 'pref_family_name', class => 'au'},
+ {name => 'pref_suffix', class => 'au'},
+ {name => 'physical_street1', class => 'aua', required => 1},
+ {name => 'physical_street1_name'},
+ {name => 'physical_street2', class => 'aua'},
+ {name => 'physical_city', class => 'aua', required => 1},
+ {name => 'physical_post_code', class => 'aua', required => 1},
+ {name => 'physical_county', class => 'aua', required => 1},
+ {name => 'physical_state', class => 'aua', required => 1},
+ {name => 'physical_country', class => 'aua', required => 1},
+ {name => 'mailing_street1', class => 'aua', required => 1},
+ {name => 'mailing_street1_name'},
+ {name => 'mailing_street2', class => 'aua'},
+ {name => 'mailing_city', class => 'aua', required => 1},
+ {name => 'mailing_post_code', class => 'aua', required => 1},
+ {name => 'mailing_county', class => 'aua', required => 1},
+ {name => 'mailing_state', class => 'aua', required => 1},
+ {name => 'mailing_country', class => 'aua', required => 1},
+ {name => 'voter_registration', class => 'asvr', required => 1},
+ {name => 'in_house_registration', required => 1},
);
-# Random 6-character alpha-numeric code that avoids look-alike characters
-# https://ux.stackexchange.com/questions/53341/are-there-any-letters-numbers-that-should-be-avoided-in-an-id
-# Also exclude vowels to avoid creating any real (potentially offensive) words.
-my @code_chars = ('C','D','F','H','J'..'N','P','R','T','V','W','X','3','4','7','9');
-sub generate_verify_code {
- my $string = '';
- $string .= $code_chars[rand @code_chars] for 1..6;
- return $string;
-}
-
-sub load_ecard_form {
- my $self = shift;
- my $ctx = $self->ctx;
- my $cgi = $self->cgi;
-
- $self->collect_header_footer;
- return Apache2::Const::OK;
-}
-
-sub load_ecard_verify {
- my $self = shift;
- my $cgi = $self->cgi;
- $self->collect_header_footer;
-
- # Loading the form.
- return Apache2::Const::OK if $cgi->request_method eq 'GET';
-
- $self->verify_ecard;
- return Apache2::Const::OK;
-}
-
-sub verify_ecard {
- my $self = shift;
- my $cgi = $self->cgi;
- my $ctx = $self->ctx;
- $self->log_params;
-
- my $verify_code = $ctx->{verify_code} = $cgi->param('verification_code');
- my $barcode = $ctx->{barcode} = $cgi->param('barcode');
-
- $ctx->{verify_failed} = 1;
-
- my $e = new_editor();
-
- my $au = $e->search_actor_user({
- profile => $PROVISIONAL_ECARD_GRP,
- ident_type => $ECARD_VERIFY_IDENT,
- ident_value => $verify_code
- })->[0];
-
- if (!$au) {
- $logger->warn(
- "ECARD: No provisional ecard found with code $verify_code");
- sleep 2; # Mitigate brute-force attacks
- return;
- }
-
- my $card = $e->search_actor_card({
- usr => $au->id,
- barcode => $barcode
- })->[0];
-
- if (!$card) {
- $logger->warn("ECARD: Failed to match verify code ".
- "($verify_code) with provided barcode ($barcode)");
- sleep 2; # Mitigate brute-force attacks
- return;
- }
-
- # Verification looks good. Update the account.
-
- my $grp = new_editor()->retrieve_permission_grp_tree($FULL_ECARD_GRP);
-
- $au->profile($grp->id);
- $au->expire_date(
- DateTime->now(time_zone => 'local')->add(
- seconds => interval_to_seconds($grp->perm_interval))->iso8601()
- );
-
- $e->xact_begin;
-
- unless ($e->update_actor_user($au)) {
- $logger->error("ECARD update failed for $barcode: " . $e->die_event);
- return;
- }
-
- $e->commit;
- $logger->info("ECARD: Update to full ecard succeeded for $barcode");
-
- $ctx->{verify_success} = 1;
- $ctx->{verify_failed} = 0;
-
- return;
-}
+# TODO: wrap the following in a check for a library setting as to whether or not
+# to require emailed verification
+
+## Random 6-character alpha-numeric code that avoids look-alike characters
+## https://ux.stackexchange.com/questions/53341/are-there-any-letters-numbers-that-should-be-avoided-in-an-id
+## Also exclude vowels to avoid creating any real (potentially offensive) words.
+#my @code_chars = ('C','D','F','H','J'..'N','P','R','T','V','W','X','3','4','7','9');
+#sub generate_verify_code {
+# my $string = '';
+# $string .= $code_chars[rand @code_chars] for 1..6;
+# return $string;
+#}
+#
+#
+## only if we're verifying the card via email
+#sub load_ecard_verify {
+# my $self = shift;
+# my $cgi = $self->cgi;
+# $self->collect_header_footer;
+#
+# # Loading the form.
+# return Apache2::Const::OK if $cgi->request_method eq 'GET';
+#
+# #$self->verify_ecard;
+# return Apache2::Const::OK;
+#}
+#
+#sub verify_ecard {
+# my $self = shift;
+# my $cgi = $self->cgi;
+# my $ctx = $self->ctx;
+# $self->log_params;
+#
+# my $verify_code = $ctx->{verify_code} = $cgi->param('verification_code');
+# my $barcode = $ctx->{barcode} = $cgi->param('barcode');
+#
+# $ctx->{verify_failed} = 1;
+#
+# my $e = new_editor();
+#
+# my $au = $e->search_actor_user({
+# profile => $PROVISIONAL_ECARD_GRP,
+# ident_type => $ECARD_VERIFY_IDENT,
+# ident_value => $verify_code
+# })->[0];
+#
+# if (!$au) {
+# $logger->warn(
+# "ECARD: No provisional ecard found with code $verify_code");
+# sleep 2; # Mitigate brute-force attacks
+# return;
+# }
+#
+# my $card = $e->search_actor_card({
+# usr => $au->id,
+# barcode => $barcode
+# })->[0];
+#
+# if (!$card) {
+# $logger->warn("ECARD: Failed to match verify code ".
+# "($verify_code) with provided barcode ($barcode)");
+# sleep 2; # Mitigate brute-force attacks
+# return;
+# }
+#
+# # Verification looks good. Update the account.
+#
+# my $grp = new_editor()->retrieve_permission_grp_tree($FULL_ECARD_GRP);
+#
+# $au->profile($grp->id);
+# $au->expire_date(
+# DateTime->now(time_zone => 'local')->add(
+# seconds => interval_to_seconds($grp->perm_interval))->iso8601()
+# );
+#
+# $e->xact_begin;
+#
+# unless ($e->update_actor_user($au)) {
+# $logger->error("ECARD update failed for $barcode: " . $e->die_event);
+# return;
+# }
+#
+# $e->commit;
+# $logger->info("ECARD: Update to full ecard succeeded for $barcode");
+#
+# $ctx->{verify_success} = 1;
+# $ctx->{verify_failed} = 0;
+#
+# return;
+#}
sub log_params {
return $self->compile_response;
}
-
sub load_ecard_submit {
my $self = shift;
my $ctx = $self->ctx;
return $self->compile_response unless $self->make_user;
return $self->compile_response unless $self->add_addresses;
- return $self->compile_response unless $self->add_stat_cats;
return $self->compile_response unless $self->check_dupes;
return $self->compile_response unless $self->add_card;
+ return $self->compile_response unless $self->add_survey_responses;
return $self->compile_response unless $self->save_user;
+ return $self->compile_response unless $self->add_usr_settings;
return $self->compile_response if $ctx->{response}->{status};
$U->create_events_for_hook(
my $auth = $U->simplereq(
'open-ils.auth_internal',
'open-ils.auth_internal.session.create',
- {user_id => 1, org_unit => 4, login_type => 'temp'}
+ {user_id => 1, org_unit => 394, login_type => 'temp'}
);
return unless $auth && $auth->{textcode} eq 'SUCCESS';
return 1;
}
+
sub compile_response {
my $self = shift;
my $ctx = $self->ctx;
return $value;
}
-
# Create actor.usr perl object and populate column data
sub make_user {
my $self = shift;
my $cgi = $self->cgi;
my $au = Fieldmapper::actor::user->new;
+ my $in_house = $cgi->param('in_house_registration');
$au->isnew(1);
- $au->ident_type($ECARD_VERIFY_IDENT); # Ecard Verification
- $au->net_access_level(101); # No Access
- $au->ident_value(generate_verify_code());
+ $au->net_access_level(1); # Filtered
+ $au->name_keywords($in_house ? 'quipu_inhouse' : 'quipu_remote');
+ my $home_ou = $cgi->param('home_ou');
- $au->profile($PROVISIONAL_ECARD_GRP);
- my $grp = new_editor()->retrieve_permission_grp_tree($PROVISIONAL_ECARD_GRP);
+ my $perm_grp = $U->ou_ancestor_setting_value(
+ $home_ou,
+ 'lib.ecard_patron_profile'
+ );
+
+ $au->profile($perm_grp);
+ my $grp = new_editor()->retrieve_permission_grp_tree($perm_grp);
$au->expire_date(
DateTime->now(time_zone => 'local')->add(
my $val = $cgi->param($field);
- # Map to guardian field on the actor.usr object.
- $field = 'guardian' if $field eq 'ident_value2';
+ $au->juvenile(1) if $field eq 'guardian' && $val;
+ $au->day_phone(undef) if $field eq 'day_phone' && $val eq '--';
if ($field_info->{required} && !$val) {
my $msg = "Value required for field: '$field'";
}
$self->verify_dob($val) if $field eq 'dob' && $val;
- $au->$field($self->upperclense($field, $val));
+ $au->$field($val);
}
# Usename defaults to the user barcode
sub add_card {
my $self = shift;
my $ctx = $self->ctx;
+ my $cgi = $self->cgi;
my $user = $ctx->{user};
+ my $home_ou = $cgi->param('home_ou');
+ my $prefix = $U->ou_ancestor_setting_value(
+ $home_ou,
+ 'lib.ecard_barcode_prefix'
+ ) || 'AUTO';
my $bc = new_editor()->json_query({from => [
'actor.generate_barcode',
- '934', # ecard prefix
- 7, # length of autogenated portion
+ $prefix, # ecard prefix
+ 8, # length of autogenated portion
'actor.auto_barcode_ecard_seq' # base sequence for autogeneration.
]})->[0];
return 1;
}
-
# Returns 1 on success, undef on error.
sub verify_dob {
my $self = shift;
my $e = $ctx->{editor};
my $user = $ctx->{user};
- my $bill_addr = Fieldmapper::actor::user_address->new;
- $bill_addr->isnew(1);
- $bill_addr->usr($user->id);
- $bill_addr->address_type('RESIDENTIAL');
- $bill_addr->within_city_limits('f');
-
- # Use as both billing and mailing via virtual ID.
- $bill_addr->id(-1);
+ my $physical_addr = Fieldmapper::actor::user_address->new;
+ $physical_addr->isnew(1);
+ $physical_addr->usr($user->id);
+ $physical_addr->address_type('PHYSICAL');
+ $physical_addr->within_city_limits('f');
+
+ my $mailing_addr = Fieldmapper::actor::user_address->new;
+ $mailing_addr->isnew(1);
+ $mailing_addr->usr($user->id);
+ $mailing_addr->address_type('MAILING');
+ $mailing_addr->within_city_limits('f');
+
+ # Use as both billing and mailing via virtual ID.
+ $physical_addr->id(-1);
+ $mailing_addr->id(-2);
$user->billing_address(-1);
- $user->mailing_address(-1);
-
- my ($s1, $s2) =
- OpenILS::Utils::KCLSNormalize::normalize_address_street(
- $cgi->param('billing_street1'),
- $cgi->param('billing_street2')
- );
-
- # Toss the normalized values back into CGI to simplify the steps below.
- $cgi->param('billing_street1', $s1);
-
- if ($s2) {
- $cgi->param('billing_street2', $s2);
- } else {
- $cgi->delete('billing_street2');
- }
+ $user->mailing_address(-2);
# Confirm we have values for all of the required fields.
# Apply values to our in-progress address object.
for my $field_info (@api_fields) {
my $field = $field_info->{name};
- next unless $field =~ /billing/;
- next if $field =~ /billing_street1_/;
+ next unless $field =~ /physical|mailing/;
+ next if $field =~ /street1_/;
my $val = $cgi->param($field);
$logger->error("ECARD $msg");
}
- (my $col_field = $field) =~ s/billing_//g;
- $bill_addr->$col_field($self->upperclense($col_field, $val));
+ if ($field =~ /physical/) {
+ (my $col_field = $field) =~ s/physical_//g;
+ $physical_addr->$col_field($val);
+ } else {
+ (my $col_field = $field) =~ s/mailing_//g;
+ $mailing_addr->$col_field($val);
+ }
+
}
# exit if there were any errors above.
return undef if $ctx->{response}->{status};
- $user->billing_address($bill_addr);
- $user->addresses([$bill_addr]);
+ $user->billing_address($physical_addr);
+ $user->mailing_address($mailing_addr);
+ $user->addresses([$physical_addr, $mailing_addr]);
return 1;
}
-sub add_stat_cats {
+sub add_usr_settings {
my $self = shift;
my $cgi = $self->cgi;
- my $user = $self->ctx->{user};
+ my $ctx = $self->ctx;
+ my $user = $ctx->{user};
+ my %settings = (
+ 'opac.hold_notify' => 'email'
+ );
- my $ds_map = Fieldmapper::actor::stat_cat_entry_user_map->new;
- $ds_map->isnew(1);
- $ds_map->stat_cat(12);
- $ds_map->stat_cat_entry('KCLS');
+ $U->simplereq(
+ 'open-ils.actor',
+ 'open-ils.actor.patron.settings.update',
+ $self->ctx->{authtoken}, $user->id, \%settings);
- my $events = $cgi->param('events_mailing');
- my $em_map = Fieldmapper::actor::stat_cat_entry_user_map->new;
- $em_map->isnew(1);
- $em_map->stat_cat(3);
- $em_map->stat_cat_entry($events ? 'Y' : 'N');
+ return 1;
+}
+
+sub add_survey_responses {
+ my $self = shift;
+ my $cgi = $self->cgi;
+ my $user = $self->ctx->{user};
+ my $answer = $cgi->param('voter_registration');
- my $foundation = $cgi->param('foundation_mailing');
- my $fm_map = Fieldmapper::actor::stat_cat_entry_user_map->new;
- $fm_map->isnew(1);
- $fm_map->stat_cat(4);
- $fm_map->stat_cat_entry($foundation ? 'Y' : 'N');
+ my $survey_response = Fieldmapper::action::survey_response->new;
+ $survey_response->id(-1);
+ $survey_response->isnew(1);
+ $survey_response->survey(1); # voter registration survey
+ $survey_response->question(1);
+ $survey_response->answer($answer);
- $user->stat_cat_entries([$ds_map, $em_map, $fm_map]);
+ $user->survey_responses([$survey_response]);
return 1;
}
+# TODO: this is KCLS-specific, but maybe we can make it something
+# generic for adding stat cats to the patron
+
+#sub add_stat_cats {
+# my $self = shift;
+# my $cgi = $self->cgi;
+# my $user = $self->ctx->{user};
+#
+# my $ds_map = Fieldmapper::actor::stat_cat_entry_user_map->new;
+# $ds_map->isnew(1);
+# $ds_map->stat_cat(12);
+# $ds_map->stat_cat_entry('KCLS');
+#
+# my $events = $cgi->param('events_mailing');
+# my $em_map = Fieldmapper::actor::stat_cat_entry_user_map->new;
+# $em_map->isnew(1);
+# $em_map->stat_cat(3);
+# $em_map->stat_cat_entry($events ? 'Y' : 'N');
+#
+# my $foundation = $cgi->param('foundation_mailing');
+# my $fm_map = Fieldmapper::actor::stat_cat_entry_user_map->new;
+# $fm_map->isnew(1);
+# $fm_map->stat_cat(4);
+# $fm_map->stat_cat_entry($foundation ? 'Y' : 'N');
+#
+# $user->stat_cat_entries([$ds_map, $em_map, $fm_map]);
+# return 1;
+#}
+
# Returns true if no dupes found, false if dupes are found.
sub check_dupes {
my $self = shift;
$logger->info("ECARD found potential duplicate patrons: @$ids");
- if (my $streetname = $self->cgi->param('billing_street1_name')) {
+ if (my $streetname = $self->cgi->param('physical_street1_name')) {
# We found matching patrons. Perform a secondary check on the
# address street name only.
$ctx->{response}->{status} = 'DUPLICATE';
$ctx->{response}->{messages} = ['first_given_name',
- 'familiy_name', 'dob_year', 'billing_street1_name'];
+ 'family_name', 'dob_year', 'billing_street1_name'];
return undef;
}
return 1;
}
-my %bc_parts; # cache
-my @bc_part_keys = qw/css screen_reader_navigation header footer js/;
-sub collect_header_footer {
- my $self = shift;
-
- # kiosk == no header/footer
- return if $self->cgi->param('kiosk');
-
- if ($bc_parts{header}) {
- $self->ctx->{"bc_$_"} = $bc_parts{$_} for @bc_part_keys;
- return;
- }
-
- my $agent = LWP::UserAgent->new(timeout => 5);
- my $res = $agent->get($HEADER_FOOTER_URL);
- $logger->info("Self-reg header/footer request returned code ".$res->code);
-
- if (!$res->is_success) {
- $logger->error("Self-reg header/footer request ".
- "[$HEADER_FOOTER_URL] failed with error " . $res->status_line);
-
- return;
- }
-
- my $json = $res->content;
-
- if (!$json) {
- $logger->error("Self-reg header/footer ".
- "[$HEADER_FOOTER_URL] returned an empty response");
- return;
- }
-
-
- my $blob;
- eval { $blob = OpenSRF::Utils::JSON->JSON2perl($json) };
-
- if ($@) {
- $logger->error("Self-reg header/footer ".
- "[$HEADER_FOOTER_URL] returned invalid JSON : $@");
- return;
- }
-
- $self->ctx->{"bc_$_"} = $bc_parts{$_} = $blob->{$_} for @bc_part_keys;
-}
-
1;