3170 lines
140 KiB
Perl
3170 lines
140 KiB
Perl
|
package TBB::BenefitDelivery::DataIntegrator;
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
use TBB::Crash;
|
||
|
use Data::Dumper;
|
||
|
|
||
|
use TBB::LogManager;
|
||
|
use TBB::Resource::BNode;
|
||
|
use TBB::ID_old;
|
||
|
use TBB::Resource::Condition;
|
||
|
use TBB::Expression;
|
||
|
use TBB::XML;
|
||
|
use TBB::ID;
|
||
|
use TBB::Utils::Method qw/argument named_argument/;
|
||
|
|
||
|
##?REFACTOR: Make the word 'ordinal' TBB::Crash::crash1 everywhere in this module
|
||
|
# EXCEPT when we are actually setting things in the XML
|
||
|
# (which will be used by the XSL).
|
||
|
# Also, while I'm suggesting global changes, I'm going
|
||
|
# to go on record saying ALL methods in this module should
|
||
|
# use opts hashes rather than the long param lists they
|
||
|
# currently have.
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
TBB::BenefitDelivery::DataIntegrator
|
||
|
|
||
|
=head1 SYNOPSIS
|
||
|
|
||
|
use TBB::BenefitDelivery::DataIntegrator;
|
||
|
|
||
|
my $data_integrator = TBB::BenefitDelivery::DataIntegrator->new($bnode);
|
||
|
|
||
|
my $user_data = TBB::UserData->new();
|
||
|
$user_data->add($some_data);
|
||
|
|
||
|
my $action = '/tbb/bds';
|
||
|
my $primary_lang = 'en-US';
|
||
|
my $secondary_lang = 'es';
|
||
|
my $id_user = get_client_id_user();
|
||
|
|
||
|
$data_integrator->populate_bnode($action,
|
||
|
$primary_lang,
|
||
|
$secondary_lang,
|
||
|
$user_data);
|
||
|
|
||
|
my $integrated_bnode = $data_integrator->get_bnode();
|
||
|
|
||
|
=head2 Description
|
||
|
|
||
|
TBB::BenefitDelivery::DataIntegrator populates a bnode with various pieces of dynamic data.
|
||
|
It populates the bnode with language preferences and the form action, and it
|
||
|
pre-populates the MQs with any pre-existing data. For group questions, the
|
||
|
DataIntegrator determines how many instances of the question should be displayed
|
||
|
and what id_users are be associated with each instance.
|
||
|
|
||
|
|
||
|
=item new($bnode)
|
||
|
|
||
|
Constructor
|
||
|
|
||
|
$bnode is the TBB::Resource::BNode object you want to populate
|
||
|
|
||
|
=cut
|
||
|
sub new
|
||
|
{
|
||
|
my $type = shift;
|
||
|
my $class = (ref $type) || $type;
|
||
|
my ($bnode, %opts) = @_;
|
||
|
|
||
|
my $self =
|
||
|
{
|
||
|
bnode => $bnode,
|
||
|
system_hidden_field_node_name => 'system_field',
|
||
|
##?REFACTOR: don't use 'descendant::...' here (*especially* here)
|
||
|
##?REFACTOR: see my comments in __populate_glossary
|
||
|
system_hidden_field_parent_node_xpath => 'descendant::body',
|
||
|
gq_question_default_order => $TBB::Config->get_config_parameters('order'=>'bds_parameters/gq_group_question_default_order') || 'question',
|
||
|
resource_manager => ( $opts{resource_manager} || $TBB::BenefitDelivery::ResourceManager),
|
||
|
bmod_id => $opts{bmod_id},
|
||
|
primary_lang => '',
|
||
|
secondary_lang => '',
|
||
|
};
|
||
|
$self->{system_hidden_field_xpath} = $self->{system_hidden_field_parent_node_xpath} . '/system_hidden_fields';
|
||
|
|
||
|
##?REFACTOR: Move the following to the populate_bnode method
|
||
|
# Just check (out of paranoia) to make sure we haven't been given a redirect bnode to integrate.
|
||
|
TBB::Crash::crash2 "DataIntegrator mistakenly called on to integrate "
|
||
|
. $bnode->get_id()
|
||
|
. " which is a REDIRECT bnode!\n"
|
||
|
if ($bnode->is_redirect_bnode());
|
||
|
|
||
|
# Equally, we really shouldn't be trying to integrate end BNodes.
|
||
|
TBB::Crash::crash3 "DataIntegrator mistkenly called on to integrate END bnode.\n" if $bnode->is_end();
|
||
|
|
||
|
# If necessary, add a system_hidden_fields node to the BNode tree.
|
||
|
my $bnode_tree = $bnode->get_xml_resource();
|
||
|
|
||
|
my $shf_nodes = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
$self->{system_hidden_field_xpath});
|
||
|
unless (scalar @$shf_nodes)
|
||
|
{
|
||
|
##?REFACTOR: move this unless block to its own private method
|
||
|
my $new_shf_node = $bnode_tree->create_node('system_hidden_fields');
|
||
|
my $potential_parents_nodelist = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
$self->{system_hidden_field_parent_node_xpath});
|
||
|
|
||
|
TBB::Crash::crash4 "Should be one-and-only-one parent node for System Hidden Fields found by '"
|
||
|
. $self->{system_hidden_field_parent_node_xpath}
|
||
|
. ". But found "
|
||
|
. (scalar @$potential_parents_nodelist || "0")
|
||
|
. " nodes that match!\n"
|
||
|
unless ((scalar @$potential_parents_nodelist) == 1);
|
||
|
my $parent_node = $potential_parents_nodelist->[0];
|
||
|
$bnode_tree->append_child($parent_node, $new_shf_node);
|
||
|
}
|
||
|
|
||
|
$shf_nodes = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
$self->{system_hidden_field_xpath});
|
||
|
|
||
|
##?REFACTOR: This looks suspiciously like debugging stuff.
|
||
|
unless (scalar @$shf_nodes)
|
||
|
{
|
||
|
TBB::Crash::crash5 "Here's the problem: That xpath don't set shit!\n";
|
||
|
}
|
||
|
|
||
|
# Bless self into the class.
|
||
|
bless ($self, $class);
|
||
|
|
||
|
return $self;
|
||
|
}
|
||
|
|
||
|
=item get_bnode()
|
||
|
|
||
|
Returns the $bnode attribute. Call this after calling populate_bnode to
|
||
|
retrieve the resulting bnode.
|
||
|
|
||
|
=cut
|
||
|
sub get_bnode
|
||
|
{
|
||
|
my $self = shift;
|
||
|
|
||
|
return $self->{bnode};
|
||
|
}
|
||
|
|
||
|
=item populate_bnode($action, $primary_lang, $secondary_lang,
|
||
|
$user_data_obj, $resource_manager)
|
||
|
|
||
|
For each group gq, populates all the necessary instances of the gq.
|
||
|
Pre-populates with default values from $user_data (if necessary).
|
||
|
Populates the primary and secondary language preferences.
|
||
|
Populates the action attribute of the form with the value of $action.
|
||
|
|
||
|
$action is the form action
|
||
|
|
||
|
$primary_lang is the primary language preference
|
||
|
|
||
|
$secondary_lang is the secondary language preference
|
||
|
|
||
|
$user_data_obj is a reference to a TBB::UserData object
|
||
|
|
||
|
$resource_manager is a reference to the TBB::BenefitDelivery::ResourceManager object.
|
||
|
if $resource_manager is not provided, it uses the global
|
||
|
$TBB::BenefitDelivery::ResourceManager object
|
||
|
|
||
|
=cut
|
||
|
sub populate_bnode
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($action, $primary_lang, $secondary_lang, $user_data, %opts) = @_;
|
||
|
|
||
|
my $subtime = TBB::LogManager::log_elapsed_time(undef, "POPULATE: starting");
|
||
|
#&TBB::LogManager::write_log('crit', "populate_bnode(): primary_lang = \"$primary_lang\", secondary_lang = \"$secondary_lang\"\n");
|
||
|
$self->{'primary_lang'} = $primary_lang;
|
||
|
$self->{'secondary_lang'} = $secondary_lang;
|
||
|
|
||
|
# Initialize an empty opts hash if we weren't passed one.
|
||
|
%opts = () unless %opts;
|
||
|
|
||
|
# Process optional_arguments.
|
||
|
|
||
|
##?REFACTOR: Can we just do this the New School way and set a $self->{resource_manager} in
|
||
|
##?REFACTOR: the constructor now?
|
||
|
my $resource_manager = $opts{resource_manager} || $TBB::BenefitDelivery::ResourceManager;
|
||
|
my $navigator = $opts{navigator};
|
||
|
$self->{navigator} = $navigator;
|
||
|
|
||
|
##?TEST:
|
||
|
TBB::Crash::crash6 "populate_bnode : Given a resource_manager object which is a '"
|
||
|
. (ref $resource_manager)
|
||
|
. "' not a TBB::BenefitDelivery::ResourceManager!\n"
|
||
|
unless ((ref $resource_manager) eq 'TBB::BenefitDelivery::ResourceManager');
|
||
|
TBB::Crash::crash7 "populate_bnode : Given a user_data object which is a '"
|
||
|
. (ref $user_data)
|
||
|
. "' not a TBB::UserData!\n"
|
||
|
unless ( ((ref $user_data) eq 'TBB::UserData') || ((ref $user_data) eq 'TBB::UserData::New')
|
||
|
|| ($opts{test} && ((ref $user_data) eq 'Test::MockObject')));
|
||
|
TBB::Crash::crash8 "populate_bnode : I now require a TBB::Navigator!\n"
|
||
|
unless (
|
||
|
(ref $navigator eq 'TBB::Navigator')
|
||
|
||
|
||
|
(ref $navigator eq 'Test::MockObject' && $opts{test})
|
||
|
);
|
||
|
|
||
|
my $this_id_user = $navigator->get_this_id_user() || $user_data->current_client_id();
|
||
|
my $context_id_user = $navigator->get_context_id_user();
|
||
|
|
||
|
TBB::LogManager::write('debug', "CONTEXT_ID_USER: \"" . ($context_id_user || "") . "\"");
|
||
|
# Now detect whether we need to handle and ordinal, if so which ordinal to use, and set
|
||
|
# an outgoing ordinal for (potential) use by a subsequent page.
|
||
|
# The "context_instance" refers to ANOTHER ordinal which is not this one but rather
|
||
|
# some other ordinal which this ordinal is intended to establish a relationship with.
|
||
|
my ($this_instance, $context_instance) = $self->__set_instance_fields($user_data, $this_id_user, %opts);
|
||
|
|
||
|
my %subroutine_opts = (
|
||
|
user_data => $user_data,
|
||
|
resource_manager => $resource_manager,
|
||
|
this_id_user => $this_id_user,
|
||
|
this_instance => $this_instance,
|
||
|
);
|
||
|
$subroutine_opts{context_instance} = $context_instance if ($context_instance);
|
||
|
$subroutine_opts{context_id_user} = $context_id_user if ($context_id_user);
|
||
|
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: finished init");
|
||
|
|
||
|
###########################################################################
|
||
|
#
|
||
|
# Now begins a series of method calls, each of which performs a particular
|
||
|
# operation on the XML tree for our bnode.
|
||
|
#
|
||
|
# It's not immediately clear what order these operations should be
|
||
|
# performed in. Some have time dependencies on others of them, but
|
||
|
# in large part they are autonomous.
|
||
|
#
|
||
|
###########################################################################
|
||
|
|
||
|
$self->__populate_display_instancesets(
|
||
|
$user_data,
|
||
|
$resource_manager,
|
||
|
$this_id_user,
|
||
|
%subroutine_opts
|
||
|
);
|
||
|
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: display instancesets");
|
||
|
|
||
|
# Evaluate conditional blocks and drop them from the xml tree if their conditions are
|
||
|
# not true.
|
||
|
##?NOTE: The placement of this method call at this point means that ALL conditional_blocks
|
||
|
# on a page are evaluated for whomever is the page user (this_id_user). So a
|
||
|
# conditional_block within a question within a gq_group tag will *NOT* be evaluated
|
||
|
# differently for group members; everyone will get the evaluation for the page user!
|
||
|
# This is a feature, but it may also be a bug.
|
||
|
$self->__evaluate_conditional_blocks(
|
||
|
$user_data,
|
||
|
$resource_manager,
|
||
|
%subroutine_opts
|
||
|
);
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: eval conditional blocks");
|
||
|
|
||
|
# Insert variables set within the BNode by its processes.
|
||
|
$self->__insert_dynamic_variable_values ($user_data);
|
||
|
|
||
|
##?TODO: Move these actions to live with the rest of the hidden field stuff.
|
||
|
$self->__integrate_form_action( $action );
|
||
|
$self->__set_system_hidden_field('bnode_id', $self->get_bnode()->get_id());
|
||
|
$self->__set_system_hidden_field('set_bmod_id', $self->{bmod_id});
|
||
|
$self->__integrate_language_preference($primary_lang, $secondary_lang);
|
||
|
|
||
|
# Now handle any <hidden> tags which wrap questions. We don't actually *evaluate* them
|
||
|
# at this point. Instead, we push the "hidden"ness down into the individual MQs and
|
||
|
# leave them to be evaluated by the __populate_*_gqs methods.
|
||
|
$self->__set_udid_hidden_fields();
|
||
|
|
||
|
# Drop sets are a special kind of dealio: Instead of having a set interface to use,
|
||
|
# they allow you to pick members of a Set (FilterSet or InstanceSet) from a list
|
||
|
# and store their label (id_user or instance) as a GQ:MQ value, or set it as a
|
||
|
# BDS navigation token.
|
||
|
##?REFACTOR: Note that again the placement at this level means that these sets can't
|
||
|
# effectively live inside a gq_group tag. They should probably be moved.
|
||
|
$self->__populate_drop_filtersets($user_data, $resource_manager, %subroutine_opts);
|
||
|
$self->__populate_drop_instancesets(
|
||
|
$user_data,
|
||
|
$resource_manager,
|
||
|
$this_id_user,
|
||
|
%subroutine_opts
|
||
|
);
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: block drop_*sets");
|
||
|
|
||
|
|
||
|
# Set hidden fields for BDS navigation.
|
||
|
my $form_id = $self->__set_hidden_form_id();
|
||
|
$self->__set_system_hidden_field('set_id_user', $this_id_user)
|
||
|
unless ($this_id_user == $user_data->current_client_id());
|
||
|
$self->__set_system_hidden_field('set_context_user', $context_id_user)
|
||
|
if ($context_id_user);
|
||
|
$self->__debug_mode_on() if $opts{'debug_mode'};
|
||
|
|
||
|
# Handle summary fields and display tables.
|
||
|
$self->__populate_summary_fields( %subroutine_opts, 'form_id' => $form_id );
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: hidden fields and summary fields");
|
||
|
|
||
|
# Newer, sexier, leaner summary_tables code.
|
||
|
$self->__populate_summary_tables( %subroutine_opts, 'form_id' => $form_id );
|
||
|
|
||
|
# Now go through and actually integrate the question tags -- first for single users...
|
||
|
$self->__populate_single_user_gqs($user_data, $this_id_user, $this_instance, %subroutine_opts);
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: populate single user gqs");
|
||
|
|
||
|
# ... and then for gq_groups.
|
||
|
$self->__populate_group_gqs($user_data, $resource_manager, $this_instance, %subroutine_opts);
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: populate group gqs");
|
||
|
|
||
|
# Check instances are an ugly old technology which has been superceded by the
|
||
|
# <gg_group instanceset="ISXXX"> type. We only support them for legacy purposes.
|
||
|
##?REFACTOR: Can we hassle the PA tax team to get rid of them for us so we can make
|
||
|
# them go away forever?
|
||
|
$self->__populate_check_instancesets(
|
||
|
$user_data,
|
||
|
$resource_manager,
|
||
|
$this_id_user,
|
||
|
%subroutine_opts
|
||
|
);
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: check instancesets");
|
||
|
|
||
|
# Now make all the glossary words on the page do the right thing.
|
||
|
$self->__populate_glossary();
|
||
|
|
||
|
# Moved the call to this (the most global) here so we don't overwrite any text in questions accidentally.
|
||
|
$self->__populate_page_text($user_data, $this_id_user, $this_instance, %subroutine_opts);
|
||
|
$subtime = TBB::LogManager::log_elapsed_time($subtime, "POPULATE: glossary and page text.");
|
||
|
|
||
|
##?REFACTOR: Find out the usage of this and use a better name if it's used.
|
||
|
# such as: set_bnode_attribute
|
||
|
$self->__set_current_id_user($user_data)
|
||
|
if ($self->get_bnode()->is_current_id_user_set());
|
||
|
|
||
|
###print STDERR 'THE BIG ONE: ' . $self->get_bnode()->to_string();
|
||
|
TBB::LogManager::write('debug','THE BIG ONE: ' . $self->get_bnode()->to_string());
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
=item __set_current_id_user
|
||
|
|
||
|
Sets the BNode attribute 'current_id_user' to the self's id_user
|
||
|
This mainly tells xslt to prepend this self id_user to some form elements in order to
|
||
|
proceed successfully. One example used is in instance summary pages
|
||
|
|
||
|
=cut
|
||
|
sub __set_current_id_user
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $user_data_obj = shift;
|
||
|
|
||
|
my $self_id_user = $user_data_obj->current_client_id();
|
||
|
my $bnode_tree = $self->get_bnode()->get_xml_resource();
|
||
|
$bnode_tree->remove_attribute($bnode_tree->get_root(), "current_id_user");
|
||
|
$bnode_tree->add_attributes($bnode_tree->get_root(), {'current_id_user' => $self_id_user});
|
||
|
}
|
||
|
|
||
|
=item __debug_mode_on
|
||
|
|
||
|
Sets the BNode attribute 'debug' = 1.
|
||
|
This tells the XSLT to display GQIDs and do various other tricks.
|
||
|
|
||
|
=cut
|
||
|
sub __debug_mode_on
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $tree = $self->get_bnode()->get_xml_resource();
|
||
|
$tree->add_attributes($tree->get_root(), {'debug' => "1"});
|
||
|
}
|
||
|
|
||
|
=item __set_instance_fields($user_data_obj, $id_user, %opts)
|
||
|
|
||
|
This subroutine handles the behaviour of ordinal bnodes.
|
||
|
|
||
|
If a bnode is ordinal then we need to get an ordinal value for it -- either passed in from
|
||
|
the form from the last bnode (telling us that we're still working with "this ordinal")
|
||
|
or else we need to ask UserData to give us a brand shiny new ordinal because we're creating
|
||
|
a brand new instance.
|
||
|
|
||
|
It's also possible to get a "context ordinal" from the form data. That means that we'll
|
||
|
create a new instance, but that we'll associate it with some previous instance. For example,
|
||
|
we might create a new Box 12 but associate it with a given W-2 instance. Or we might create
|
||
|
a new instance of monies paid for child-care and associate it with an instance of a childcare
|
||
|
provider, etc.
|
||
|
|
||
|
Finally, we'll need to pass on an ordinal value to the next bnode. We do this by setting
|
||
|
a system_hidden_field. The default behaviour is to pass on "this ordinal" context so
|
||
|
the next bnode can continue to work with the ordinal we're working with now. However,
|
||
|
if the current bnode has the attribute set_context_ordinal="1" set then instead we'll set
|
||
|
our ordinal as the "context ordinal" for the next bnode to use. In this case, we don't
|
||
|
pass on any "this ordinal" value, so the next bnode will create its own new instance and
|
||
|
associate it with the one we were using in this bnode.
|
||
|
|
||
|
=cut
|
||
|
sub __set_instance_fields
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $id_user, %opts) = @_;
|
||
|
my ($this_instance, $context_instance);
|
||
|
|
||
|
my $navigator = $self->{navigator};
|
||
|
TBB::Crash::crash9 "I really actually need a navigator now.\n" unless $navigator;
|
||
|
|
||
|
my $is_ordinal_bnode = $self->get_bnode()->is_ordinal();
|
||
|
|
||
|
if ($is_ordinal_bnode)
|
||
|
{
|
||
|
if ($navigator->get_this_instance()) {
|
||
|
$this_instance = $navigator->get_this_instance()
|
||
|
} else {
|
||
|
$this_instance = $user_data_obj->get_next_instance();
|
||
|
}
|
||
|
|
||
|
|
||
|
### If we create a new instance, we inform the navigator and update the current move
|
||
|
my $current_instance = $navigator->get_this_instance();
|
||
|
if (!defined $current_instance || $this_instance ne $current_instance)
|
||
|
{
|
||
|
$navigator->set_this_instance( $this_instance, update_current_move => 1 );
|
||
|
}
|
||
|
$context_instance = $navigator->get_context_instance();
|
||
|
|
||
|
# Set the ordinal property of the tree to "_$ordinal" so that it can be
|
||
|
# used by the XSLT transform.
|
||
|
|
||
|
##DEBUG:
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
$self->get_bnode()->get_id()
|
||
|
. " : is_ordinal='"
|
||
|
. $self->get_bnode()->is_ordinal()
|
||
|
. "' set ordinal '"
|
||
|
. $this_instance || '(none)'
|
||
|
. "' and context ordinal '"
|
||
|
. $context_instance || ''
|
||
|
. "'\n"
|
||
|
) if TBB::LogManager::writes_at('debug');
|
||
|
|
||
|
# Just pass on the ordinal as this_ordinal and
|
||
|
# pass on the context ordinal as the context ordinal. Special nodes will handle
|
||
|
# changes between them.
|
||
|
$self->__set_system_hidden_field('set_ordinal', $this_instance);
|
||
|
$self->__set_system_hidden_field('set_context_ordinal', $context_instance)
|
||
|
if ($context_instance);
|
||
|
}
|
||
|
|
||
|
return ($this_instance, $context_instance);
|
||
|
}
|
||
|
|
||
|
=item __populate_group_gqs($user_data_obj, $resource_manager, $ordinal)
|
||
|
|
||
|
Creates and populates all the instances of the group gqs in the bnode.
|
||
|
Returns 0 on success. If a filterset filters out all the members, returns
|
||
|
the filterset id.
|
||
|
|
||
|
$user_data_obj is a reference to a TBB::UserData object
|
||
|
|
||
|
$resource_manager is a reference to a TBB::BenefitDelivery::ResourceManager object.
|
||
|
if $resource_manager is not provided, it uses the global
|
||
|
$TBB::BenefitDelivery::ResourceManager object
|
||
|
|
||
|
$ordinal is the ID of an ordinal which may have been set on this page. We DO NOT
|
||
|
currently process ordinals for group questions, but this function is the only place
|
||
|
where we know whether we process group_gqs or not. So we pass ordinal in just so
|
||
|
we can TBB::Crash::crash10 if it's been erroneously set. Of course, if we one day upgrade to
|
||
|
handle ordinals for groups of users then we need to pass ordinal in so that we
|
||
|
can actually make use of it.
|
||
|
|
||
|
=cut
|
||
|
sub __populate_group_gqs
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $resource_manager, $ordinal, %opts) = @_;
|
||
|
|
||
|
##?TEST:
|
||
|
TBB::Crash::crash11 "__populate_group_gqs : Given a resource_manager object which is a '"
|
||
|
. (ref $resource_manager)
|
||
|
. "' not a TBB::BenefitDelivery::ResourceManager!\n"
|
||
|
unless ((ref $resource_manager) eq 'TBB::BenefitDelivery::ResourceManager');
|
||
|
|
||
|
my $bnode_tree = $self->get_bnode()->get_xml_resource();
|
||
|
my $gq_groups = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::gq_group");
|
||
|
|
||
|
# Now TBB::Crash::crash12 if we have an ordinal set.
|
||
|
#TBB::Crash::crash13 "DataIntegrator is not equipped to handle ordinals for group questions!\n"
|
||
|
# if ((scalar @$gq_groups) && $ordinal);
|
||
|
|
||
|
my $default_order = $self->{gq_question_default_order};
|
||
|
TBB::Crash::crash14 "No gq_group question default order set!\n"
|
||
|
unless ($default_order);
|
||
|
|
||
|
# We now iterate through each of the gq_group tags found in the BNode.
|
||
|
# Within each gq_group tags, the order in which we list questions and users
|
||
|
# depends on the order_by attribute:
|
||
|
# ORDER BY USER: list users, listing all questions under each user
|
||
|
# ORDER BY QUESTION: list questions, listing all users under each question
|
||
|
#
|
||
|
# Note that expanding this out is NOT done explicitly by this module. Instead, it's done by
|
||
|
# the XSL Transformation the "finished" BNode goes through. The job of DataIntegrator is just
|
||
|
# to add relevant userdata nodes to each gq node in the group, one for each user. These
|
||
|
# contain the appropriate data for that user and are there to facilitate the XSLT in producing
|
||
|
# both OBU and OBQ output pages.
|
||
|
#
|
||
|
# If this attribute is not explicitly set in a given gq_group tag then we use the $default_order
|
||
|
# that we dereferenced above. (And which was originally specified in tbb_bds.conf.)
|
||
|
foreach my $gq_group (@$gq_groups)
|
||
|
{
|
||
|
# Figure out the order_by attr to use for this gq_group
|
||
|
my $order_by = $bnode_tree->get_attribute($gq_group, "order_by");
|
||
|
unless ($order_by)
|
||
|
{
|
||
|
$order_by = $default_order;
|
||
|
$bnode_tree->add_attributes($gq_group, {'order_by' => $order_by});
|
||
|
}
|
||
|
|
||
|
# Get the other attributes of this gq_group tag.
|
||
|
my $is_root = $bnode_tree->get_attribute($gq_group, "root");
|
||
|
my $gqs = $bnode_tree->get_nodes_by_xpath($gq_group, "descendant::gq");
|
||
|
my $fs_id = $bnode_tree->get_attribute($gq_group, "filterset");
|
||
|
my $this_page_id_user = $bnode_tree->get_attribute($gq_group, "this_page_id_user");
|
||
|
my $instanceset_id = $bnode_tree->get_attribute($gq_group, "instanceset");
|
||
|
if ($instanceset_id)
|
||
|
{
|
||
|
TBB::Crash::crash15 "Ill-formed gq_group on "
|
||
|
. $self->get_bnode()->get_id()
|
||
|
. " : Can't have both a FilterSet ($fs_id) and an InstanceSet ($instanceset_id).\n"
|
||
|
if ($fs_id);
|
||
|
$self->__populate_instanceset_gq_group(
|
||
|
$user_data_obj,
|
||
|
$opts{this_id_user},
|
||
|
$opts{this_instance},
|
||
|
$instanceset_id,
|
||
|
$bnode_tree,
|
||
|
$gq_group
|
||
|
);
|
||
|
next;
|
||
|
}
|
||
|
|
||
|
#FilterSet::filter_data returns a sorted list of id_users
|
||
|
#if we need to change the sort order, do it in FilterSet
|
||
|
my $id_users = [];
|
||
|
unless ($this_page_id_user)
|
||
|
{
|
||
|
##?REFACTOR: more comments! (delete)
|
||
|
#unless ($self->{navigator} && $self->{navigator}->get_this_id_user())
|
||
|
#{
|
||
|
TBB::Crash::crash16 "no filterset id given to group_gq!" unless $fs_id;
|
||
|
$id_users = $resource_manager->get_filterset($fs_id)
|
||
|
->filter_data($user_data_obj, 'context_user' => $opts{context_id_user});
|
||
|
#}
|
||
|
#print STDERR "#####id users are: " . Dumper (@$id_users);
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
if ($self->{navigator} && $self->{navigator}->get_this_id_user())
|
||
|
{
|
||
|
##?TODO: In this case, we should pre-select the only user in the select box.
|
||
|
$id_users = [ $self->{navigator}->get_this_id_user() ];
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
$self->__add_dummy_ids($id_users, 1);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
TBB::Crash::crash17 "$order_by is not a valid way to order questions!\n"
|
||
|
unless ($order_by eq 'user' || $order_by eq 'question');
|
||
|
|
||
|
# "Root" questions are those which allow us to gather data about *new users*. Obviously,
|
||
|
# these users don't exist in user_data yet, nor do they have id_users. Instead, we set
|
||
|
# a number of "dummy_id_users" (letters from A, B, ...) as their id_users. Magic in other
|
||
|
# modules will pick up these dummy id users and translate them into real id_users at an
|
||
|
# appropriate point, but we don't have to worry about that here.
|
||
|
# (If you're curious, it's currently done in TBB::FormData, but that may be subject to
|
||
|
# change....)
|
||
|
if ($is_root)
|
||
|
{
|
||
|
# Root questions HAVE to be order by user.
|
||
|
TBB::Crash::crash18 "Sorry, at this time ROOT questions MUST be ordered by USER!\n"
|
||
|
if ($order_by ne 'user');
|
||
|
|
||
|
# Get the default_count attr of the gq_group -- which tells us what size to pad the
|
||
|
# list of users to.
|
||
|
my $default_count = $bnode_tree->get_attribute($gq_group, "default_count");
|
||
|
my $id_user_count = scalar @$id_users;
|
||
|
my $dummy_id_count;
|
||
|
|
||
|
# We need a number of dummy ids to pad us up to the default count, or a minimum of
|
||
|
# one dummy even if we're at or over the default count.
|
||
|
if ($id_user_count < $default_count)
|
||
|
{
|
||
|
$dummy_id_count = $default_count - $id_user_count;
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
$dummy_id_count = 1;
|
||
|
}
|
||
|
|
||
|
# Call this method to add dummies to the list $id_users.
|
||
|
$self->__add_dummy_ids($id_users, $dummy_id_count);
|
||
|
}
|
||
|
|
||
|
# Now iterate through the gq (general question) tags inside the gq_group tag. For each
|
||
|
# of them we are going to add userdata blocks pertaining to each user in our id_users list.
|
||
|
foreach my $gq (@$gqs)
|
||
|
{
|
||
|
my $gq_id = $bnode_tree->get_attribute($gq, "id");
|
||
|
my $mqs = $bnode_tree->get_nodes_by_xpath($gq, 'descendant::mq');
|
||
|
|
||
|
foreach my $mq (@$mqs)
|
||
|
{
|
||
|
my $mq_id = $bnode_tree->get_attribute($mq, "id");
|
||
|
|
||
|
# Get the default value for this mq:
|
||
|
##?REFACTOR: do we need to use 'descendant::...' here? if default_value
|
||
|
##?REFACTOR: is always in the same relative position, we should put the exact path
|
||
|
##?REFACTOR: be careful about this, maybe wait until we have a DTD or some sort of
|
||
|
##?REFACTOR: xml validation script thingy
|
||
|
my $default_value_xpath = 'descendant::defaultvalue';
|
||
|
my $default_value_node = $bnode_tree->get_single_node_by_xpath(
|
||
|
$mq,
|
||
|
$default_value_xpath,
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
my ($default_value, $dynamic_vars, $force_default_value, $normalization);
|
||
|
if ( $default_value_node )
|
||
|
{
|
||
|
$default_value = $bnode_tree->get_node_value( $default_value_node );
|
||
|
$dynamic_vars = $bnode_tree->get_attribute( $default_value_node, 'dynamic' );
|
||
|
$normalization = $bnode_tree->get_attribute( $default_value_node, 'normalization' );
|
||
|
}
|
||
|
##?NOTE: We now have TWO ways to make this happen:
|
||
|
##?NOTE: 1) we can have an <mq id="MQ111" hidden="1" dynamic="1">
|
||
|
##?NOTE: <default_value>$SOME_EXPRESSION</default_value>
|
||
|
##?NOTE: <interface/>
|
||
|
##?NOTE: </mq>
|
||
|
##?NOTE:
|
||
|
##?NOTE: 2) or we can have
|
||
|
##?NOTE: <hidden_field dynamic="1" value="$SOME_EXPRESSION">
|
||
|
##?NOTE: <mq id="MQ111">
|
||
|
##?NOTE: <interface/>
|
||
|
##?NOTE: </mq>
|
||
|
##?NOTE: </hidden>
|
||
|
##?NOTE:
|
||
|
##?NOTE: We strictly need both of these methods!
|
||
|
##?NOTE: The 2nd is used to include external mqs in a locally hidden
|
||
|
##?NOTE: context. The 1st means the mq is *always* hidden.
|
||
|
##?NOTE: Note that (some method) translates #2 into #1 before
|
||
|
##?NOTE: we reach this stage.
|
||
|
if ($bnode_tree->get_attribute($mq, "hidden")) {
|
||
|
# Process hidden fields a bit differently.
|
||
|
# The key here is that the "default value" should override any value set in
|
||
|
# UserData for hidden fields, whereas it specifically shouldn't do this in all
|
||
|
# other cases. Additionally, this is where we evaluate "dynamic" hidden fields,
|
||
|
# ie. hidden fields whose value is set to the evaluant of some expression rather
|
||
|
# than just to a hardcoded value.
|
||
|
$force_default_value = 1;
|
||
|
}
|
||
|
|
||
|
# Process the label for this micro-question.
|
||
|
my $question_label_xpath = $order_by eq 'user'
|
||
|
? 'labelset/label[@context="user"]'
|
||
|
: 'labelset/label[@context="question"]';
|
||
|
|
||
|
my $question_label_txtopts = $bnode_tree->get_single_node_by_xpath(
|
||
|
$mq,
|
||
|
$question_label_xpath,
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
|
||
|
$self->__process_text_options(
|
||
|
$bnode_tree, $question_label_txtopts, $user_data_obj, $id_users->[0], $ordinal
|
||
|
);
|
||
|
|
||
|
# Get the 'member' label from this mq's labelset.
|
||
|
my $member_label_xpath = $order_by eq 'user'
|
||
|
? 'ancestor::gq_group/labelset/label[@context="user_member"]'
|
||
|
: 'labelset/label[@context = "question_member"]';
|
||
|
|
||
|
my $member_label_txtopts = $bnode_tree->get_single_node_by_xpath(
|
||
|
$mq,
|
||
|
$member_label_xpath,
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
|
||
|
foreach my $id_user (@$id_users) {
|
||
|
|
||
|
my $user_value = $dynamic_vars
|
||
|
? $self->__evaluate_dynamic_value(
|
||
|
$default_value,
|
||
|
$id_user,
|
||
|
$ordinal,
|
||
|
$user_data_obj,
|
||
|
%opts,
|
||
|
'normalization' => $normalization,
|
||
|
)
|
||
|
: $default_value;
|
||
|
|
||
|
$self->__add_question_userdata_node(
|
||
|
$id_user,
|
||
|
$gq_id,
|
||
|
$mq_id,
|
||
|
$ordinal,
|
||
|
$mq,
|
||
|
$user_data_obj,
|
||
|
$member_label_txtopts,
|
||
|
$user_value,
|
||
|
use_default_not_user_data => $force_default_value,
|
||
|
context => $order_by
|
||
|
);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
}
|
||
|
|
||
|
|
||
|
#create some auxiliary nodes in the tree to assist the xslt presentation
|
||
|
##?REFACTOR: refactor mq_groups so that this is no longer necessary, and then remove it
|
||
|
$self->__add_misc_data($gq_group, scalar @$id_users);
|
||
|
|
||
|
}
|
||
|
return 0;
|
||
|
}
|
||
|
|
||
|
##?REFACTOR: we need to actually do the POD
|
||
|
|
||
|
=item __populate_instanceset_gq_group( $user_data, $id_user, $this_instance, $instanceset_id, $bnode_xml_tree, $gq_group_node, %opts )
|
||
|
|
||
|
TODO: POD.
|
||
|
|
||
|
=cut
|
||
|
sub __populate_instanceset_gq_group
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data, $id_user, $context_instance, $instanceset_id, $bnode_xml_tree, $gq_group_node, %opts) = @_;
|
||
|
|
||
|
# Get other attributes of the gq_group node:
|
||
|
my $gq_node_list = $bnode_xml_tree->get_nodes_by_xpath($gq_group_node, 'descendant::gq');
|
||
|
my $this_page_id_user = $bnode_xml_tree->get_attribute($gq_group_node, 'this_page_id_user');
|
||
|
|
||
|
# Determine order by for this group.
|
||
|
my $default_order = $self->{gq_question_default_order};
|
||
|
my $order_by = $bnode_xml_tree->get_attribute($gq_group_node, "order_by");
|
||
|
if ($order_by)
|
||
|
{
|
||
|
TBB::Crash::crash19 "'$order_by' is not a valid way to order gq groups!\n"
|
||
|
unless ($order_by eq 'user' | $order_by eq 'question');
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
$order_by = $default_order;
|
||
|
$bnode_xml_tree->add_attributes($gq_group_node, {'order_by' => $order_by});
|
||
|
}
|
||
|
TBB::Crash::crash20 "Problem at " . $self->get_bnode()->get_id() . ". At this time we do not support order_by USER for instanceset gq groups. Sorry.\n"
|
||
|
if ($order_by eq 'user');
|
||
|
|
||
|
# Get the instanceset for this group.
|
||
|
my $resource_manager = $self->{resource_manager};
|
||
|
my $instanceset = $resource_manager->get_instanceset( $instanceset_id );
|
||
|
|
||
|
# Run the instanceset. It will internally cache the result, which we then ask for.
|
||
|
$instanceset->filter_data( $user_data, $id_user, $context_instance );
|
||
|
|
||
|
### We pass get_users a user_data object so we are given a sorted list of users
|
||
|
my @is_users_list = $instanceset->get_users(user_data => $user_data);
|
||
|
##?REFACTOR: This can go away now.
|
||
|
TBB::Crash::crash21 "Problem running '$instanceset_id' : cacheing did not occur.\n"
|
||
|
unless (ref \@is_users_list eq 'ARRAY');
|
||
|
|
||
|
foreach my $gq_node ( @$gq_node_list )
|
||
|
{
|
||
|
my $gq_id = $bnode_xml_tree->get_attribute($gq_node, 'id');
|
||
|
my $mq_node_list = $bnode_xml_tree->get_nodes_by_xpath($gq_node, 'descendant::mq');
|
||
|
|
||
|
foreach my $mq_node ( @$mq_node_list )
|
||
|
{
|
||
|
my $mq_id = $bnode_xml_tree->get_attribute($mq_node, 'id');
|
||
|
|
||
|
# Get the default value for this mq:
|
||
|
my $default_value_xpath = 'descendant::defaultvalue';
|
||
|
my $default_value_node = $bnode_xml_tree->get_single_node_by_xpath(
|
||
|
$mq_node,
|
||
|
$default_value_xpath,
|
||
|
ok_to_return_null => 1,
|
||
|
);
|
||
|
|
||
|
my ($default_value, $dynamic_vars, $force_default_value, $normalization);
|
||
|
if ( $default_value_node )
|
||
|
{
|
||
|
$default_value = $bnode_xml_tree->get_node_value( $default_value_node );
|
||
|
$dynamic_vars = $bnode_xml_tree->get_attribute( $default_value_node, 'dynamic' );
|
||
|
$normalization = $bnode_xml_tree->get_attribute( $default_value_node, 'normalization' );
|
||
|
}
|
||
|
|
||
|
##?TODO: Revise the following (and other methods as necessary) such that there is only
|
||
|
##?TODO: one call to __add_question_userdata_node, shared by hidden and non-hidden
|
||
|
##?TODO: fields alike. This is actually an iteration task as it will allow us to
|
||
|
##?TODO: pre-populate non-hidden fields with FM values (something Team:Analysis has
|
||
|
##?TODO: asked for.
|
||
|
##?TODO: Just to note, this change needs to be made in all three "main" methods of
|
||
|
##?TODO: DI -- this one, __populate_group_gqs and __populate_single_user_gqs.
|
||
|
if ($bnode_xml_tree->get_attribute($mq_node, "hidden"))
|
||
|
{
|
||
|
# If this MQ is hidden then we always want to prefer the default value over whatever
|
||
|
# is in user data.
|
||
|
$force_default_value = 1;
|
||
|
}
|
||
|
|
||
|
##?REFACTOR: The following block (till END_BLOCK) is pretty much verbatim from __populate_group_gqs
|
||
|
##?REFACTOR: Should we consider breaking this down into more stages, which can call each other?
|
||
|
# Process the label for this micro-question.
|
||
|
my $question_label_xpath = $order_by eq 'user'
|
||
|
? 'labelset/label/@context="user"'
|
||
|
: 'labelset/label/@context="question"';
|
||
|
my $question_label_txtopts = $bnode_xml_tree->get_single_node_by_xpath(
|
||
|
$mq_node,
|
||
|
$question_label_xpath,
|
||
|
ok_to_return_null => 1,
|
||
|
);
|
||
|
|
||
|
# Note that we DON'T pass an $id_user into process_text_options.
|
||
|
# This is deliberate. The question pertains to the whole household!
|
||
|
##?TODO: But is this correct here? I mean, this could be all children of <macro>current_user</macro>
|
||
|
##?TODO: or it could be all pets of <macro>current_user</macro> or something. What can it hurt to
|
||
|
##?TODO: pass the id_user in?
|
||
|
##?TODO: Examine above and try passing it in (consider %opts)
|
||
|
$self->__process_text_options(
|
||
|
$bnode_xml_tree, $question_label_txtopts, $user_data, undef, undef
|
||
|
);
|
||
|
|
||
|
# Get the 'member' label from this mq's labelset.
|
||
|
my $member_label_xpath = $order_by eq 'user'
|
||
|
? 'ancestor::gq_group/labelset/label[@context="user_member"]'
|
||
|
: 'labelset/label[@context="question_member"]';
|
||
|
my $member_label_txtopts = $bnode_xml_tree->get_single_node_by_xpath(
|
||
|
$mq_node,
|
||
|
$member_label_xpath,
|
||
|
ok_to_return_null => 1,
|
||
|
);
|
||
|
##?REFACTOR: END_BLOCK (see above to know what this means)
|
||
|
|
||
|
##?DEBUG: Dump out the cache of users/instances generated within $instanceset.
|
||
|
#TBB::LogManager::write(
|
||
|
# 'warn',
|
||
|
# "DI IS PROBLEM: IS "
|
||
|
# . $instanceset->get_id()
|
||
|
# . " with UserData: "
|
||
|
# . ($user_data->is_new() ? "NEW" : "OLD")
|
||
|
# . " has cache: "
|
||
|
# . Dumper( $instanceset->{instance_hash} )
|
||
|
#) if TBB::LogManager::writes_at("warn");
|
||
|
|
||
|
foreach my $this_id_user ( @is_users_list )
|
||
|
{
|
||
|
my @this_users_instances = $instanceset->get_instances_by_user( $this_id_user );
|
||
|
|
||
|
my %this_id_user_opts = %opts;
|
||
|
$opts{this_id_user} = $this_id_user;
|
||
|
##?DEBUG:
|
||
|
##TBB::LogManager::write('debug', "For id_user=$this_id_user found instances: " . join(", ", @this_users_instances));
|
||
|
foreach my $instance (@this_users_instances)
|
||
|
{
|
||
|
my $user_value = $dynamic_vars
|
||
|
? $self->__evaluate_dynamic_value(
|
||
|
$default_value, $this_id_user, $instance, $user_data, %this_id_user_opts, 'normalization' => $normalization
|
||
|
)
|
||
|
: $default_value;
|
||
|
#TBB::LogManager::write('debug',
|
||
|
# "DYNAMIC: Assigning default value for user \"" .
|
||
|
# ($this_id_user || "") .
|
||
|
# "\", instance \"" .
|
||
|
# ($instance || "") .
|
||
|
# "\": '" .
|
||
|
# ($user_value || "") .
|
||
|
# "'. [DYNAMIC_VARS = \"" .
|
||
|
# ($dynamic_vars || "") .
|
||
|
# "\"]\n") if TBB::LogManager::writes_at("debug");
|
||
|
$self->__add_question_userdata_node(
|
||
|
$this_id_user,
|
||
|
$gq_id,
|
||
|
$mq_id,
|
||
|
$instance,
|
||
|
$mq_node,
|
||
|
$user_data,
|
||
|
$member_label_txtopts,
|
||
|
$user_value,
|
||
|
use_default_not_user_data => $force_default_value,
|
||
|
context => $order_by,
|
||
|
);
|
||
|
}
|
||
|
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
=item __populate_single_user_gqs($user_data_obj, $id_user, $ordinal)
|
||
|
|
||
|
Populates all the non-group gqs in the bnode.
|
||
|
These questions are all assumed to be asked of one single user,
|
||
|
whose id_user is set = $id_user.
|
||
|
|
||
|
$user_data_obj is a reference to a TBB::UserData object
|
||
|
|
||
|
If $ordinal is defined, then $ordinal should be appended to the UDID to retrieve the
|
||
|
correct data; and the hidden field for ordinal should be set at the same time
|
||
|
|
||
|
=cut
|
||
|
sub __populate_single_user_gqs
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $id_user, $ordinal, %opts) = @_;
|
||
|
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
|
||
|
#the following two queries retrieve only the non-group gq nodes
|
||
|
#we assume there is only one <questions> block in the bnode
|
||
|
my $gqs = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::questions/gq");
|
||
|
|
||
|
##?REFACTOR: Find out if we can kill this line. There are no hidden_fields by this point.
|
||
|
my $hidden_gqs = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::questions/hidden_field/gq");
|
||
|
TBB::Crash::crash22 "Oops! We were wrong. There ARE still hidden_field tags in the XML. Why is that?\n"
|
||
|
if (@$hidden_gqs);
|
||
|
|
||
|
foreach my $gq (@$gqs)
|
||
|
{
|
||
|
my $gq_id = $bnode_tree->get_attribute($gq, 'id');
|
||
|
my $mqs = $bnode_tree->get_nodes_by_xpath($gq, "descendant::mq");
|
||
|
|
||
|
foreach my $mq (@$mqs)
|
||
|
{
|
||
|
my $mq_id = $bnode_tree->get_attribute($mq, 'id');
|
||
|
|
||
|
# Get the default value for this mq.
|
||
|
##?REFACTOR: again, reconsider using an explicit path rather than 'descendant::...' (be careful)
|
||
|
my $default_value_xpath = 'descendant::defaultvalue';
|
||
|
my $default_value_node = $bnode_tree->get_single_node_by_xpath(
|
||
|
$mq,
|
||
|
$default_value_xpath,
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
|
||
|
my ($default_value, $dynamic_vars, $force_default_value, $normalization);
|
||
|
if ( $default_value_node )
|
||
|
{
|
||
|
$default_value = $bnode_tree->get_node_value( $default_value_node );
|
||
|
$dynamic_vars = $bnode_tree->get_attribute( $default_value_node, 'dynamic' );
|
||
|
$normalization = $bnode_tree->get_attribute( $default_value_node, 'normalization' );
|
||
|
}
|
||
|
|
||
|
if ( $bnode_tree->get_attribute($mq, "hidden") )
|
||
|
{
|
||
|
# Process hidden fields a bit differently.
|
||
|
# The key here is that the "default value" should override any value set in
|
||
|
# UserData for hidden fields, whereas it specifically shouldn't do this in all
|
||
|
# other cases. Additionally, this is where we evaluate the sexy new "dynamic"
|
||
|
# hidden fields. Ooooooooooh.
|
||
|
|
||
|
$force_default_value = 1;
|
||
|
};
|
||
|
|
||
|
my $user_label_xpath = 'labelset/label[@context="user"]';
|
||
|
my $user_label_txtopts = $bnode_tree->get_single_node_by_xpath(
|
||
|
$mq,
|
||
|
$user_label_xpath,
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
|
||
|
##?TODO: The following line is objectively wrong. We should NOT be mucking with the original
|
||
|
##?TODO: labelset for this question. Instead, we should pass $user_label_txtopts on to the
|
||
|
##?TODO: __add_question_userdata method, which will process them directly.
|
||
|
##?TODO: The trouble is, the XLST for single user questions doesn't know to look in the "right
|
||
|
##?TODO: place" -- ie. in the <userdata> blocks -- to find labels, it still looks in the toplevel
|
||
|
##?TODO: labelset. Since we are v. close to the FLFS launch and messing with the XSLT might have
|
||
|
##?TODO: unexpected consequences, I am leaving this "wrong" in this method.
|
||
|
##?TODO: So the actual "TODO" is to change the XSLT to look only in <userdata> blocks for
|
||
|
##?TODO: labels and to use them, then to comment out the following two lines.
|
||
|
$self->__process_text_options($bnode_tree, $user_label_txtopts, $user_data_obj, $id_user, $ordinal, context => 'user');
|
||
|
undef $user_label_txtopts;
|
||
|
|
||
|
my $user_value = $dynamic_vars
|
||
|
? $self->__evaluate_dynamic_value(
|
||
|
$default_value, $id_user, $ordinal, $user_data_obj, %opts, 'normalization' => $normalization
|
||
|
)
|
||
|
: $default_value;
|
||
|
|
||
|
#TBB::LogManager::write('debug', "SINGLE USER QUESTION $gq_id:$mq_id with label: " . ( $user_label_txtopts ? $user_label_txtopts->toString() : "NONE") );
|
||
|
#TBB::LogManager::write('debug', "WHICH IS UNDERSTANDABLE given that:\n\n" . Dumper( $mq->toString() ) );
|
||
|
|
||
|
$self->__add_question_userdata_node(
|
||
|
$id_user,
|
||
|
$gq_id,
|
||
|
$mq_id,
|
||
|
$ordinal,
|
||
|
$mq,
|
||
|
$user_data_obj,
|
||
|
$user_label_txtopts,
|
||
|
$user_value,
|
||
|
use_default_not_user_data => $force_default_value,
|
||
|
context => 'user'
|
||
|
);
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item __insert_dynamic_variable_values
|
||
|
|
||
|
__insert_dynamic_variable_values ($user_data_obj, $resource_manager) -> $success
|
||
|
|
||
|
__insert_dynamic_variable_values inserts the values of dynamic variables set
|
||
|
by the bnode set_dynamic_variable() method (at the moment, just by TBB::Processes).
|
||
|
|
||
|
The values are inserted as CDATA text in the <insert_dynamic_variable> element.
|
||
|
|
||
|
=cut
|
||
|
sub __insert_dynamic_variable_values
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
my $dynamic_variable_elements = $bnode_tree->get_nodes_by_xpath(
|
||
|
$bnode_tree->get_root(),
|
||
|
"descendant::insert_dynamic_variable"
|
||
|
);
|
||
|
foreach my $dynamic_variable_element (@$dynamic_variable_elements)
|
||
|
{
|
||
|
my $dynamic_variable_name =
|
||
|
$bnode_tree->get_attribute ($dynamic_variable_element, "name");
|
||
|
unless ($dynamic_variable_name)
|
||
|
{
|
||
|
TBB::LogManager::write(
|
||
|
'warn',
|
||
|
"No dynamic variable name found in dynamic variable element."
|
||
|
);
|
||
|
next;
|
||
|
}
|
||
|
my ($dynamic_variable_value) =
|
||
|
$self->{bnode}->get_dynamic_variable($dynamic_variable_name);
|
||
|
$bnode_tree->set_node_value ( $dynamic_variable_element, $dynamic_variable_value );
|
||
|
}
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
|
||
|
=item __evaluate_conditional_blocks
|
||
|
|
||
|
__evaluate_conditional_blocks ($user_data_obj, $resource_manager) -> $success
|
||
|
|
||
|
__evaluate_conditional_blocks evaluates the condition in each <conditional_block>
|
||
|
and drops the block entirely if the condition does not evaluate true.
|
||
|
|
||
|
##?TODO: This should also evaluate dynamically set bnode variables when they
|
||
|
##?TODO: are specified as an attribute of the conditional_block
|
||
|
|
||
|
=cut
|
||
|
sub __evaluate_conditional_blocks
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $resource_manager, %opts) = @_;
|
||
|
|
||
|
my $ecbtime = TBB::LogManager::log_elapsed_time(undef, "ecb: starting __evaluate_conditional_blocks");
|
||
|
|
||
|
my $id_user = $opts{this_id_user} || $user_data_obj->current_client_id();
|
||
|
my $this_instance = $opts{this_instance};
|
||
|
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
my $conditional_blocks = $bnode_tree->get_nodes_by_xpath(
|
||
|
$bnode_tree->get_root(),
|
||
|
"descendant::conditional_block"
|
||
|
);
|
||
|
|
||
|
$ecbtime = TBB::LogManager::log_elapsed_time($ecbtime, "ecb: init complete");
|
||
|
|
||
|
my $looptime = TBB::LogManager::log_elapsed_time(undef, "starting loop");
|
||
|
## test condition
|
||
|
foreach my $conditional_block ( @$conditional_blocks )
|
||
|
{
|
||
|
TBB::LogManager::write("debug", "In a conditional block.");
|
||
|
my $dynamic_evaluation = $bnode_tree->get_attribute ($conditional_block, "dynamic_evaluation");
|
||
|
my $condition_string = $bnode_tree->get_attribute ($conditional_block, "condition");
|
||
|
TBB::LogManager::write("debug", "In a conditional block: $condition_string");
|
||
|
if ($condition_string || $dynamic_evaluation)
|
||
|
{
|
||
|
my $condition;
|
||
|
if ($condition_string && !$dynamic_evaluation)
|
||
|
{
|
||
|
$condition = TBB::Resource::Condition->new('ANONYMOUS', $condition_string, $resource_manager);
|
||
|
}
|
||
|
elsif ($dynamic_evaluation && !$condition_string)
|
||
|
{
|
||
|
my $dynamic_variable = $bnode_tree->get_attribute ($conditional_block, "dynamic_variable");
|
||
|
my $value = $bnode_tree->get_attribute ($conditional_block, "value");
|
||
|
my $dynamic_value = $self->{bnode}->get_dynamic_variable($dynamic_variable);
|
||
|
$condition = TBB::Resource::Condition->new(
|
||
|
'ANONYMOUS',
|
||
|
"'$dynamic_value' eq '$value'",
|
||
|
$resource_manager
|
||
|
);
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
TBB::Crash::crash23 "Conditional block can only take either condition or dynamic_evaluation, not both!";
|
||
|
}
|
||
|
my $condition_result = $condition->evaluate( $user_data_obj, $id_user, $this_instance, %opts );
|
||
|
|
||
|
TBB::LogManager::write("debug", "Condition ($condition_string) result is: $condition_result");
|
||
|
|
||
|
if ($condition_result) {
|
||
|
my $condition_parent = $bnode_tree->get_parent_node($conditional_block);
|
||
|
|
||
|
##?REFACTOR: change gq to node
|
||
|
my $gqs = $bnode_tree->get_nodes_by_xpath($conditional_block,
|
||
|
"child::node()");
|
||
|
foreach my $gq (@$gqs)
|
||
|
{
|
||
|
$bnode_tree->insert_before($condition_parent,
|
||
|
$gq, $conditional_block);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
$bnode_tree->remove_node( $conditional_block );
|
||
|
}
|
||
|
$looptime = TBB::LogManager::log_elapsed_time($looptime, "ecb: looping...");
|
||
|
}
|
||
|
$ecbtime = TBB::LogManager::log_elapsed_time($ecbtime, "ecb: loop complete");
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
=item __populate_summary_fields (%opts)
|
||
|
|
||
|
Function to do the proper pre-population for the summary pages.
|
||
|
$user_data_obj is a TBB::UserData object,
|
||
|
$resource_manager is a TBB::BenefitDelivery::ResourceManager object,
|
||
|
"form_id" and "id_user" can be passed to this funciton through %opts
|
||
|
|
||
|
=cut
|
||
|
sub __populate_summary_fields
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my %opts = @_;
|
||
|
|
||
|
##?REFACTOR: Use Method::named_argument here.
|
||
|
my $user_data = $opts{user_data} || TBB::Crash::crash24 "Need a UserData.\n";
|
||
|
my $resource_manager = named_argument( 'resource_manager', 'TBB::BenefitDelivery::ResourceManager', \%opts, required => 1 );
|
||
|
my $this_id_user = named_argument( 'this_id_user', 'SCALAR', \%opts, required => 1 );
|
||
|
my $form_id = named_argument( 'form_id', 'SCALAR', \%opts, required => 1 );
|
||
|
|
||
|
# Get a list of summary nodes on this page.
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
my $summary_nodes = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::summary");
|
||
|
|
||
|
# If there are no summary nodes on this page, do nothing.
|
||
|
return if ((scalar @$summary_nodes) == 0);
|
||
|
|
||
|
##?REFACTOR: Is this necessary? Couldn't we just move the thing that does this. It can go away
|
||
|
# earlier in popluate_bnode() and not worry about it here?
|
||
|
# Set form_id for the bnode so the micro fields can get it.
|
||
|
$self->get_bnode()->add_attribute_by_xpath("/bnode", form_id =>$form_id);
|
||
|
|
||
|
##?REFACTOR: gq_question_default_order should be a package global: $GQ_QUESTION_DEFAULT_ORDER.
|
||
|
# Check the default order for ordering questions (this is by user or by question, and right
|
||
|
# now I think it's set to by question.
|
||
|
my $default_order = $self->{gq_question_default_order} || TBB::Crash::crash25 "No default order set!\n";
|
||
|
|
||
|
# Process each summary node on the page.
|
||
|
foreach my $summary_node (@$summary_nodes)
|
||
|
{
|
||
|
##?REFACTOR: Write better comments to explain what the heck this does.
|
||
|
# Set this page's id_user as an attr of the summary page, in case it needs to
|
||
|
# use it to look up the id_user to set for the addeditdelete_id. In practice,
|
||
|
# only one BNode so far uses this - BN6087, the summary page for the HH mod.
|
||
|
$bnode_tree->add_attributes($summary_node, {'this_id_user' => $this_id_user});
|
||
|
|
||
|
# obtain the attributes for this summary node to decide the different behaviors
|
||
|
my $instanceset_id = $bnode_tree->get_attribute($summary_node, "instanceset");
|
||
|
my $order_by = $bnode_tree->get_attribute($summary_node, "order_by");
|
||
|
|
||
|
# If the summary field doesn't have an order_by attribute, just give it the
|
||
|
# default order_by value.
|
||
|
unless ($order_by)
|
||
|
{
|
||
|
$order_by = $default_order;
|
||
|
$bnode_tree->add_attributes($summary_node, {'order_by' => $order_by});
|
||
|
}
|
||
|
|
||
|
# If the BNode is an instance BNode then set this_instance as the context_instance
|
||
|
# for 'add' and 'edit' fields. This is explicitly for the case where we are showing
|
||
|
# eg. a summary page of "all box-12s on this (this_instance) W-2". Now if users
|
||
|
# want to 'add' box-12s they are adding them to *this* W-2, so when they click
|
||
|
# 'add' we will set the W-2's instance as context_instance so they can set it
|
||
|
# as a hidden field on the box-12 page at which they arrive. Whew.
|
||
|
##?REFACTOR: Should change to is_instance()
|
||
|
if ( $self->get_bnode()->is_ordinal() )
|
||
|
{
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"WARNING: this_instance not found for '"
|
||
|
. $self->get_bnode()->get_id()
|
||
|
. "' but we need to set it as a context_instance for 'add' fields."
|
||
|
) unless ($opts{this_instance});
|
||
|
$bnode_tree->add_attributes($summary_node, {'context_instance' => $opts{this_instance}});
|
||
|
}
|
||
|
|
||
|
# Now find @id_users -- the complete list of users to be considered for this summary page.
|
||
|
my @id_users;
|
||
|
##?REVIEW: Why is $fs_id defined outside the if block?
|
||
|
my $fs_id;
|
||
|
if ($bnode_tree->has_attribute($summary_node, "filterset"))
|
||
|
{
|
||
|
$fs_id = $bnode_tree->get_attribute($summary_node, "filterset");
|
||
|
@id_users = $user_data->retrieve_set_members(
|
||
|
base => $fs_id,
|
||
|
this_id_user => $opts{this_id_user},
|
||
|
this_instance => $opts{this_instance},
|
||
|
##?REFACTOR: we need to pass the context_* vars
|
||
|
);
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"$fs_id returned members: [" . join(",", @id_users) . "]"
|
||
|
);
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
##?REVIEW: Just use $this_id_user, which we already have.
|
||
|
@id_users = ( $opts{'this_id_user'} );
|
||
|
}
|
||
|
|
||
|
# Opts hash for adding <userdata> blocks to the summary field.
|
||
|
##?TODO: Pass the context_instance, context_id_user vars here.
|
||
|
# Figure it out so it makes sense.
|
||
|
my %add_ud_opts = (
|
||
|
'order_by' => $order_by,
|
||
|
'instanceset' => $instanceset_id,
|
||
|
'this_instance' => $opts{this_instance}
|
||
|
);
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"SF: populating field for '"
|
||
|
. ($fs_id || "")
|
||
|
. "', order_by='"
|
||
|
. ($order_by || "")
|
||
|
. "Found users: "
|
||
|
. join(", ", @id_users)
|
||
|
. "."
|
||
|
);
|
||
|
|
||
|
# Get the content node
|
||
|
my $content_nodes = $bnode_tree->get_nodes_by_xpath($summary_node, 'descendant::content');
|
||
|
|
||
|
##?BEGIN HERE:
|
||
|
|
||
|
##?TODO: Change this method to use absolute xpaths from summary node to labels, rather than
|
||
|
# descendant.
|
||
|
|
||
|
if ($order_by eq 'user')
|
||
|
{
|
||
|
#create the corresponding user_data node
|
||
|
# Process the label node for the question context
|
||
|
my $user_label_txtopts = $bnode_tree->get_single_node_by_xpath(
|
||
|
$summary_node,
|
||
|
'descendant::label[@context="user"]',
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
|
||
|
foreach my $id_user (@id_users)
|
||
|
{
|
||
|
$self->__add_summary_userdata_node(
|
||
|
this_id_user => $id_user,
|
||
|
user_data => $user_data,
|
||
|
member_label => $user_label_txtopts,
|
||
|
content_nodes => $content_nodes,
|
||
|
summary_node => $summary_node,
|
||
|
%add_ud_opts
|
||
|
);
|
||
|
}
|
||
|
}
|
||
|
elsif ($order_by eq 'question')
|
||
|
{
|
||
|
# Create the corresponding user_data node
|
||
|
# Process the label node for the question context
|
||
|
my $question_label_txtopts = $bnode_tree->get_single_node_by_xpath(
|
||
|
$summary_node,
|
||
|
'descendant::label[@context="question"]',
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
$self->__process_text_options($bnode_tree, $question_label_txtopts, $user_data, $id_users[0], $opts{this_instance}, context => $order_by);
|
||
|
|
||
|
# Get the 'member' label from this summary node's labelset.
|
||
|
my $member_label_txtopts = $bnode_tree->get_single_node_by_xpath(
|
||
|
$summary_node,
|
||
|
'descendant::label[@context="question_member"]',
|
||
|
ok_to_return_null => 1
|
||
|
);
|
||
|
|
||
|
# Process the label for this summary node
|
||
|
foreach my $id_user (@id_users)
|
||
|
{
|
||
|
$self->__add_summary_userdata_node(
|
||
|
this_id_user => $id_user,
|
||
|
user_data => $user_data,
|
||
|
member_label => $member_label_txtopts,
|
||
|
content_nodes => $content_nodes,
|
||
|
summary_node => $summary_node,
|
||
|
%add_ud_opts
|
||
|
);
|
||
|
}
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
TBB::Crash::crash26 "$order_by is not a valid way to order questions!\n";
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item __add_summary_userdata_node( %opts )
|
||
|
|
||
|
Private function called in the __populate_summary_fields to create the userdata nodes
|
||
|
for the summary fields.
|
||
|
|
||
|
=cut
|
||
|
sub __add_summary_userdata_node
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my %opts = @_;
|
||
|
|
||
|
# Dereference %opts.
|
||
|
my $id_user = named_argument( 'this_id_user', 'SCALAR', \%opts, 'required' => 1 );
|
||
|
##?TODO: Replace this with named_argument call once UserData::New goes away.
|
||
|
my $user_data = $opts{user_data};
|
||
|
unless (((ref $user_data) eq 'TBB::UserData') || ((ref $user_data) eq 'TBB::UserData::New'))
|
||
|
{
|
||
|
TBB::Crash::crash27 "Need a TBB::UserData or TBB::UserData::New object, not '" . (ref $user_data) . "\n";
|
||
|
}
|
||
|
my $label_textopts = named_argument( 'member_label', 'XML::LibXML::Element', \%opts );
|
||
|
my $content_nodes = named_argument( 'content_nodes', 'XML::LibXML::NodeList', \%opts, 'required' => 1 );
|
||
|
my $parent_node = named_argument( 'summary_node', 'XML::LibXML::Element', \%opts, 'required' => 1 );
|
||
|
my $this_instance = named_argument( 'this_instance', 'SCALAR', \%opts );
|
||
|
my $context_id_user = named_argument( 'context_id_user', 'SCALAR', \%opts );
|
||
|
my $context_instance = named_argument( 'context_instance', 'SCALAR', \%opts );
|
||
|
my $instanceset_id = named_argument( 'instanceset', 'SCALAR', \%opts );
|
||
|
my $order_by = named_argument( 'order_by', 'SCALAR', \%opts );
|
||
|
|
||
|
my $bnode_tree = $self->get_bnode()->get_xml_resource();
|
||
|
|
||
|
# Create the userdata node with id_user as attribute
|
||
|
my $userdata_node = $bnode_tree->create_node("userdata");
|
||
|
$bnode_tree->add_attributes($userdata_node, { 'id_user' => $id_user } );
|
||
|
|
||
|
# Process the textopts for this user's question_member label.
|
||
|
if (defined $label_textopts)
|
||
|
{
|
||
|
my $local_label = $bnode_tree->clone_node($label_textopts, 1);
|
||
|
$self->__process_text_options($bnode_tree, $local_label, $user_data, $id_user, $this_instance, context => $order_by);
|
||
|
$bnode_tree->append_child($userdata_node, $local_label);
|
||
|
}
|
||
|
|
||
|
# Process the content node
|
||
|
if (defined $content_nodes)
|
||
|
{
|
||
|
# If it's ordinal, we need to wrap the content nodes for each ordinal into the
|
||
|
# ordinal node...and append ordinal node to userdata node
|
||
|
if ($instanceset_id)
|
||
|
{
|
||
|
# Obtain all the ordinals for a specific id_user and udid
|
||
|
# Obtain the udid
|
||
|
my @instance_list = $user_data->retrieve_set_members(
|
||
|
base => $instanceset_id,
|
||
|
this_id_user => $id_user,
|
||
|
this_instance => $this_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance,
|
||
|
);
|
||
|
TBB::LogManager::write('debug', "SF: Using '$instanceset_id' found ordinals: " . join(", ", @instance_list) . " with this_id_user=$id_user AND this_instance=$this_instance AND context_id_user=$context_id_user AND context_instance=$context_instance");
|
||
|
|
||
|
# Now iterate through the ordinals.
|
||
|
foreach my $id_instance (@instance_list)
|
||
|
{
|
||
|
my $instance_node = $bnode_tree->create_node("ordinal");
|
||
|
$bnode_tree->add_attributes($instance_node, { id_ordinal => $id_instance } );
|
||
|
foreach my $content_node (@$content_nodes)
|
||
|
{
|
||
|
my $local_content = $bnode_tree->clone_node($content_node, 1);
|
||
|
$self->__process_content_node(
|
||
|
$bnode_tree, $local_content, $user_data, $id_user, $id_instance, $order_by
|
||
|
);
|
||
|
$bnode_tree->append_child($instance_node, $local_content);
|
||
|
}
|
||
|
|
||
|
$bnode_tree->append_child($userdata_node, $instance_node);
|
||
|
}
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
foreach my $content_node (@$content_nodes)
|
||
|
{
|
||
|
my $local_content = $bnode_tree->clone_node($content_node, 1);
|
||
|
$self->__process_content_node($bnode_tree, $local_content, $user_data, $id_user, undef, $order_by);
|
||
|
$bnode_tree->append_child($userdata_node, $local_content);
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# append the <userdata> node to mq node
|
||
|
$bnode_tree->append_child($parent_node, $userdata_node);
|
||
|
}
|
||
|
|
||
|
##?REFACTOR: Shall we use a different subroutine to process this variable substitution?
|
||
|
##?REFACTOR: Cannot reuse __process_text_options because it's xml structure specific
|
||
|
##?REFACTOR: Probably *all* the variable substitution in this module could be outsourced
|
||
|
# to a single private method. But that might have to be part of a well
|
||
|
# conceived large-scale REFACTOR of this whole module....
|
||
|
=item __process_content_node
|
||
|
|
||
|
This function is to do the variable substitution for the content node of the summary
|
||
|
page. Called by function __add_summary_userdata_node
|
||
|
|
||
|
=cut
|
||
|
sub __process_content_node
|
||
|
{
|
||
|
my $self = shift;
|
||
|
##?REFACTOR: This method should take in %opts and pass them on to the calls it initiates.
|
||
|
my ($bnode_tree, $node_to_process, $user_data_obj, $id_user, $this_instance, $order_by) = @_;
|
||
|
|
||
|
# Needed for language normalization.
|
||
|
my $normalizer = $self->{resource_manager}->get_normalizer();
|
||
|
my $current_language = $user_data_obj->get_current_language() || 'en-US';
|
||
|
|
||
|
TBB::LogManager::write('debug', "SF: Processing content node with args: " . join(", ", @_) . ".");
|
||
|
|
||
|
# If there isn't a node to process then we're all done.
|
||
|
unless ($node_to_process) {
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
$id_user ||= $user_data_obj->current_client_id();
|
||
|
|
||
|
my $value_nodes = $bnode_tree->get_nodes_by_xpath(
|
||
|
$node_to_process,
|
||
|
"descendant::summary_field_value"
|
||
|
);
|
||
|
|
||
|
TBB::LogManager::write("debug", "SF: before processing content nodes");
|
||
|
|
||
|
if (scalar @$value_nodes == 0) {
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
foreach my $value_node (@$value_nodes)
|
||
|
{
|
||
|
my $node_value = $bnode_tree->get_node_value($value_node);
|
||
|
|
||
|
TBB::LogManager::write("debug", "SF: in process content node: $node_value, id_user: $id_user");
|
||
|
|
||
|
my $no_instance = $bnode_tree->get_attribute($value_node, "no_ordinal");
|
||
|
|
||
|
if ($bnode_tree->get_attribute($value_node, 'dynamic')) {
|
||
|
|
||
|
my $value_expression = TBB::Expression->new(
|
||
|
$node_value,
|
||
|
$TBB::BenefitDelivery::ResourceManager
|
||
|
);
|
||
|
|
||
|
my $actual_value = $value_expression->evaluate(
|
||
|
$user_data_obj,
|
||
|
$id_user,
|
||
|
$this_instance
|
||
|
);
|
||
|
|
||
|
$node_value = $actual_value || '';
|
||
|
|
||
|
} else {
|
||
|
|
||
|
##?REFACTOR: outsource ALL cases of replacing IDs in strings
|
||
|
# to one internally consistent method, The
|
||
|
# following will break in lots of cases, including
|
||
|
# aliases, INSTANCE()s etc.
|
||
|
my @userdata_components_in_node = TBB::ID::find_ids_in_string(
|
||
|
$node_value,
|
||
|
['formula', 'question_with_mandatory_mq']
|
||
|
);
|
||
|
|
||
|
foreach my $udid (@userdata_components_in_node)
|
||
|
{
|
||
|
my $instance_to_pass = $this_instance unless($no_instance);
|
||
|
#TBB::LogManager::write(
|
||
|
# 'crit',
|
||
|
# "CALLING UD->retrieve_value with base='$udid' this_id_user='$id_user' this_instance='$instance_to_pass'"
|
||
|
#);
|
||
|
my $value = $user_data_obj->retrieve_value(
|
||
|
'base' => $udid,
|
||
|
'this_id_user' => $id_user,
|
||
|
'this_instance' => $instance_to_pass
|
||
|
);
|
||
|
#TBB::LogManager::write(
|
||
|
# 'crit',
|
||
|
# "PRE NORM: $value"
|
||
|
#);
|
||
|
$value = $normalizer->normalize_for_presentation(
|
||
|
$value,
|
||
|
$udid,
|
||
|
$current_language,
|
||
|
context => $order_by
|
||
|
);
|
||
|
#TBB::LogManager::write(
|
||
|
# 'crit',
|
||
|
# "POST NORM: $value"
|
||
|
#);
|
||
|
$node_value =~ s/$udid/$value/g;
|
||
|
}
|
||
|
}
|
||
|
$bnode_tree->set_node_value($value_node, $node_value);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item __populate_summary_tables()
|
||
|
|
||
|
A brand spankin' new method to handle the new summary_table to end all
|
||
|
summaries.
|
||
|
|
||
|
##?REFACTOR: POD. More specific comment...also, what's the interface for the <summary_table> xml
|
||
|
|
||
|
=cut
|
||
|
sub __populate_summary_tables
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my %opts = @_;
|
||
|
|
||
|
# Get args from opts.
|
||
|
my $page_id_user = named_argument( 'this_id_user', 'SCALAR', \%opts, 'required' => 1 );
|
||
|
my $page_instance = named_argument( 'this_instance', 'SCALAR', \%opts );
|
||
|
my $context_id_user = named_argument( 'context_id_user', 'SCALAR', \%opts );
|
||
|
my $context_instance = named_argument( 'context_instance', 'SCALAR', \%opts );
|
||
|
|
||
|
##?TODO: Migrate EVERYONE to new UserData so we can get out of this shit.
|
||
|
##?REFACTOR: please use named_argument to check the argument type
|
||
|
my $user_data = $opts{user_data};
|
||
|
TBB::Crash::crash28 "Bah! Need a UserData or UserData::New, not $user_data.\n"
|
||
|
unless (((ref $user_data) eq 'TBB::UserData') || ((ref $user_data) eq 'TBB::UserData::New'));
|
||
|
|
||
|
# Get the XML document for the
|
||
|
my $page_xml = $self->get_bnode()->get_xml_resource();
|
||
|
|
||
|
my $list_of_summary_tables = $page_xml->get_nodes_by_xpath(
|
||
|
$page_xml->get_root(),
|
||
|
'descendant::summary_table'
|
||
|
);
|
||
|
|
||
|
# Iterate over the summary_table nodes in this BNode.
|
||
|
foreach my $summary_table ( @$list_of_summary_tables )
|
||
|
{
|
||
|
my $populated_table_node = $page_xml->create_node( 'populated_table' );
|
||
|
# Set the page-wide id_user and instance values as attributes of the populated_table
|
||
|
# node. These are there for the purposes of the XSLT when it needs to build
|
||
|
# navigation buttons.
|
||
|
$page_xml->add_attributes($populated_table_node, {this_id_user => $page_id_user});
|
||
|
$page_xml->add_attributes($populated_table_node, {this_instance => $page_instance})
|
||
|
if $page_instance;
|
||
|
|
||
|
# Get all child nodes.
|
||
|
my $child_nodes_of_summary_table = $page_xml->get_non_empty_children( $summary_table );
|
||
|
|
||
|
foreach my $this_group_node (@$child_nodes_of_summary_table)
|
||
|
{
|
||
|
my $this_node_name = $page_xml->get_node_name( $this_group_node );
|
||
|
##?REFACTOR: Comments. what's label_group, what's record_group
|
||
|
if ($this_node_name eq 'label_group')
|
||
|
{
|
||
|
# Make a deep copy of the label_group.
|
||
|
my $label_node_to_populate = $page_xml->clone_node( $this_group_node, 1 );
|
||
|
|
||
|
# Attach it to the populated table
|
||
|
$page_xml->append_child( $populated_table_node, $label_node_to_populate );
|
||
|
|
||
|
# Process its contents.
|
||
|
##?NOTE: Due to the way it's written, __process_text_options will
|
||
|
# process ALL text descendants of its 2nd argument.
|
||
|
$self->__process_text_options(
|
||
|
$page_xml,
|
||
|
$label_node_to_populate,
|
||
|
$user_data,
|
||
|
$page_id_user,
|
||
|
$page_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance
|
||
|
);
|
||
|
}
|
||
|
elsif ($this_node_name eq 'record_group')
|
||
|
{
|
||
|
my $rg_filterset = $page_xml->get_attribute( $this_group_node, 'filterset' );
|
||
|
my $rg_instanceset = $page_xml->get_attribute( $this_group_node, 'instanceset' );
|
||
|
my $record_element_list = $page_xml->get_nodes_by_xpath( $this_group_node, 'record_element' );
|
||
|
|
||
|
if ($rg_filterset && $rg_instanceset)
|
||
|
{
|
||
|
TBB::Crash::crash29 "Don't support BOTH instanceset AND filterset attributes for record_groups.";
|
||
|
}
|
||
|
elsif ($rg_instanceset)
|
||
|
{
|
||
|
my @instances_in_rg = $user_data->retrieve_set_members(
|
||
|
base => $rg_instanceset,
|
||
|
this_id_user => $page_id_user,
|
||
|
this_instance => $page_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance
|
||
|
);
|
||
|
|
||
|
foreach my $this_instance (@instances_in_rg)
|
||
|
{
|
||
|
# Ask UserData which user owns $this_instance.
|
||
|
my $this_id_user = $user_data->get_id_user_for_instance( $this_instance );
|
||
|
|
||
|
$self->__process_record_element(
|
||
|
record_element_node_list => $record_element_list,
|
||
|
user_data => $user_data,
|
||
|
this_id_user => $this_id_user,
|
||
|
this_instance => $this_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance,
|
||
|
summary_table_node => $populated_table_node,
|
||
|
page_xml => $page_xml,
|
||
|
);
|
||
|
}
|
||
|
|
||
|
}
|
||
|
elsif ($rg_filterset)
|
||
|
{
|
||
|
my @users_in_rg = $user_data->retrieve_set_members(
|
||
|
base => $rg_filterset,
|
||
|
this_id_user => $page_id_user,
|
||
|
this_instance => $page_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance
|
||
|
);
|
||
|
|
||
|
foreach my $this_id_user (@users_in_rg)
|
||
|
{
|
||
|
$self->__add_record_to_summary_table(
|
||
|
record_element_node_list => $record_element_list,
|
||
|
user_data => $user_data,
|
||
|
this_id_user => $this_id_user,
|
||
|
this_instance => $page_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance,
|
||
|
summary_table_node => $populated_table_node,
|
||
|
page_xml => $page_xml,
|
||
|
);
|
||
|
}
|
||
|
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
TBB::Crash::crash30 "Need to have EITHER an instanceset OR a filterset to work with!";
|
||
|
}
|
||
|
|
||
|
}
|
||
|
elsif( ($this_node_name eq 'text') and ($page_xml->get_node_value( $this_group_node ) eq ''))
|
||
|
{
|
||
|
##?TODO: Please make this go away.
|
||
|
TBB::LogManager::write( 'debug', "Skipping stupid empty text node." );
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"Found '$this_node_name' with value '"
|
||
|
. $page_xml->get_node_value( $this_group_node )
|
||
|
. "'"
|
||
|
);
|
||
|
TBB::Crash::crash31 "$this_node_name is not a legal child of a summary_table node!";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# If we have been told to "diagonally flip" the table, ie. to make
|
||
|
# records be columns, not rows, then regenerate the $populated_table_node
|
||
|
# in this wise.
|
||
|
if ($page_xml->get_attribute( $summary_table, 'diagonal_flip' ))
|
||
|
{
|
||
|
$populated_table_node = $self->__diagonally_flip_populated_table(
|
||
|
page_xml => $page_xml,
|
||
|
populated_table_node => $populated_table_node,
|
||
|
);
|
||
|
}
|
||
|
|
||
|
# Append the populated_table node to the parent summary_table.
|
||
|
$page_xml->append_child( $summary_table, $populated_table_node );
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
=item __add_record_to_summary_table( %opts )
|
||
|
|
||
|
This method adds a <record_group> node to the <populated_table> node of
|
||
|
a summary_table. It does this by processing the data for
|
||
|
|
||
|
=cut
|
||
|
sub __add_record_to_summary_table
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my %opts = @_;
|
||
|
|
||
|
# Parse %opts.
|
||
|
my $record_element_node_list = named_argument( 'record_element_node_list', 'XML::LibXML::NodeList', \%opts, required => 1 );
|
||
|
##?TODO: Use named_argument as soon as its type changes OR we get rid of
|
||
|
# UserData::New.
|
||
|
my $user_data = $opts{'user_data'} || TBB::Crash::crash32 "D'oh! Need UserData.";
|
||
|
my $this_id_user = named_argument( 'this_id_user', 'SCALAR', \%opts, required => 1 );
|
||
|
my $this_instance = named_argument( 'page_instance', 'SCALAR', \%opts );
|
||
|
my $context_id_user = named_argument( 'context_id_user', 'SCALAR', \%opts );
|
||
|
my $context_instance = named_argument( 'context_instance', 'SCALAR', \%opts );
|
||
|
my $summary_table_node = named_argument( 'summary_table_node', 'XML::LibXML::Element', \%opts, required => 1 );
|
||
|
my $page_xml = named_argument( 'page_xml', 'TBB::XML', \%opts, required => 1 );
|
||
|
|
||
|
# Create the new record_group node. Give it attributes describing the
|
||
|
# id_user and (if appropriate) instance to which it belongs.
|
||
|
my $record_group_node = $page_xml->create_node( 'record_group' );
|
||
|
$page_xml->add_attributes( $record_group_node, { this_id_user => $this_id_user } );
|
||
|
$page_xml->add_attributes( $record_group_node, { this_instance => $this_id_user } )
|
||
|
if ($this_instance);
|
||
|
|
||
|
# Now process each record_element within the group and attach the
|
||
|
# record_data nodes to the record_group.
|
||
|
foreach my $record_element_node (@$record_element_node_list)
|
||
|
{
|
||
|
$self->__process_record_element(
|
||
|
record_element_node => $record_element_node,
|
||
|
user_data => $user_data,
|
||
|
this_id_user => $this_id_user,
|
||
|
this_instance => $this_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance,
|
||
|
record_node => $record_group_node,
|
||
|
page_xml => $page_xml,
|
||
|
);
|
||
|
}
|
||
|
|
||
|
# Attach the whole record_group node to the populated_table parent node.
|
||
|
return $page_xml->append_child( $summary_table_node, $record_group_node );
|
||
|
}
|
||
|
|
||
|
=item __process_record_element( %opts )
|
||
|
|
||
|
This subroutine processes a single <record_element> tag within a summary_table.
|
||
|
The contents of a record_element should be processed as a TBB::Expression.
|
||
|
This means that we should correctly handle GQ:MQs, quoted strings, FMs
|
||
|
and INSTANCE(GQ:MQ).
|
||
|
|
||
|
When the record_element is processed correctly we attach a record_element_data
|
||
|
node containing the result to the parent record_node.
|
||
|
|
||
|
Required %opts for this method:
|
||
|
|
||
|
user_data : A TBB::UserData (or UserData::New) object.
|
||
|
this_id_user : The id_user for whom to process this record_element.
|
||
|
|
||
|
|
||
|
Optional %opts for this method:
|
||
|
|
||
|
this_instance : The instance for which to process this record_element.
|
||
|
context_id_user : The context_id_user " " " " "
|
||
|
context_instance : The context_instance " " " " "
|
||
|
|
||
|
=cut
|
||
|
sub __process_record_element
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my %opts = @_;
|
||
|
|
||
|
# Parse opts.
|
||
|
my $record_element_node = named_argument( 'record_element_node', 'XML::LibXML::Element', \%opts, required => 1 );
|
||
|
my $user_data = $opts{'user_data'} || TBB::Crash::crash33 "D'oh! Need UserData.";
|
||
|
my $this_id_user = named_argument( 'this_id_user', 'SCALAR', \%opts, required => 1 );
|
||
|
my $this_instance = named_argument( 'page_instance', 'SCALAR', \%opts );
|
||
|
my $context_id_user = named_argument( 'context_id_user', 'SCALAR', \%opts );
|
||
|
my $context_instance = named_argument( 'context_instance', 'SCALAR', \%opts );
|
||
|
my $record_node = named_argument( 'record_node', 'XML::LibXML::Element', \%opts, required => 1 );
|
||
|
my $page_xml = named_argument( 'page_xml', 'TBB::XML', \%opts, required => 1 );
|
||
|
|
||
|
# Get the value of the $record_element_node.
|
||
|
my $rf_node_value = $page_xml->get_node_value( $record_element_node );
|
||
|
|
||
|
my $tbb_expression = TBB::Expression->new( $rf_node_value );
|
||
|
my $specific_value = $tbb_expression->evaluate(
|
||
|
$user_data,
|
||
|
$this_id_user,
|
||
|
$this_instance,
|
||
|
context_id_user => $context_id_user,
|
||
|
context_instance => $context_instance
|
||
|
);
|
||
|
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"Setting value "
|
||
|
. TBB::ID::implode( id_user => $this_id_user, base => $rf_node_value, instance => $this_instance )
|
||
|
. " to "
|
||
|
. $specific_value
|
||
|
);
|
||
|
|
||
|
my $rg_element_node = $page_xml->create_node( 'record_data', $specific_value );
|
||
|
|
||
|
return $page_xml->append_child( $record_node, $rg_element_node );
|
||
|
}
|
||
|
|
||
|
=item __diagonally_flip_populated_table( %opts )
|
||
|
|
||
|
##?REFACTOR: POD
|
||
|
=cut
|
||
|
sub __diagonally_flip_populated_table
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my %opts = @_;
|
||
|
|
||
|
# Parse %opts.
|
||
|
my $populated_table_node = named_argument( 'populated_table_node', 'XML::LibXML::Element', \%opts, required => 1 );
|
||
|
my $page_xml = named_argument( 'page_xml', 'TBB::XML', \%opts, required => 1 );
|
||
|
|
||
|
# Make a "flipped" node.
|
||
|
# We do so by "cloning" ie. copying the $populated_table_node. Note that for once
|
||
|
# we DON'T want a "deep" copy (ie. all children) since we just want to replicate
|
||
|
# the attributes of the original, not its structure.
|
||
|
my $flipped_pt_node = $page_xml->clone_node( $populated_table_node, 0 );
|
||
|
|
||
|
# Work out the number of cross-section nodes to make.
|
||
|
my $first_child = $page_xml->get_first_child( $populated_table_node );
|
||
|
my $children_of_first_child_node = $page_xml->get_non_empty_children( $first_child );
|
||
|
my $number_of_cross_sections = scalar @$children_of_first_child_node;
|
||
|
|
||
|
for (my $cross_section = 1; $cross_section <= $number_of_cross_sections; $cross_section ++)
|
||
|
{
|
||
|
my $cross_section_node = $page_xml->create_node( 'record_cross_section' );
|
||
|
|
||
|
# Get the Nth child (matching the cross section) of all children of the pop tab.
|
||
|
my $list_of_cross_section_elements = $page_xml->get_nodes_by_xpath(
|
||
|
$populated_table_node,
|
||
|
"child::*/child::*[$cross_section]"
|
||
|
);
|
||
|
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"In CROSS SECTION $cross_section, found " . (scalar @$list_of_cross_section_elements)
|
||
|
. " nodes to migrate."
|
||
|
);
|
||
|
|
||
|
# Attach our list of children to the record_cross_section element.
|
||
|
foreach my $this_child (@$list_of_cross_section_elements)
|
||
|
{
|
||
|
# Take a copy of the child and append it to the record cross section.
|
||
|
my $copy_of_this_child = $page_xml->clone_node( $this_child, 1 );
|
||
|
$page_xml->append_child( $cross_section_node, $copy_of_this_child );
|
||
|
}
|
||
|
|
||
|
$page_xml->append_child( $flipped_pt_node, $cross_section_node );
|
||
|
}
|
||
|
|
||
|
# Return the "flipped" pop tab.
|
||
|
return $flipped_pt_node;
|
||
|
}
|
||
|
|
||
|
=item __set_udid_hidden_fields()
|
||
|
|
||
|
This finds every hidden_field node in $bnode_tree. For each hidden_field,
|
||
|
it adds a hidden="1" attribute to the child mq, sets the default value for
|
||
|
the child mq, and removes the hidden_field tag.
|
||
|
|
||
|
We now also find mqs which have the <interface><hidden/></interface> child
|
||
|
and process them similarly.
|
||
|
|
||
|
=cut
|
||
|
sub __set_udid_hidden_fields
|
||
|
{
|
||
|
my $self = shift;
|
||
|
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
|
||
|
my $hidden_field_nodes =
|
||
|
$bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::hidden_field");
|
||
|
|
||
|
foreach my $hidden_field (@$hidden_field_nodes)
|
||
|
{
|
||
|
#there is exactly one mq per hidden_field node
|
||
|
my $mq_node = $bnode_tree->get_single_node_by_xpath($hidden_field, "descendant::mq");
|
||
|
|
||
|
my %attributes = ("hidden" => "1");
|
||
|
#$attributes{dynamic} = 1 if ($bnode_tree->get_attribute($hidden_field, "dynamic"));
|
||
|
$bnode_tree->add_attributes($mq_node, \%attributes);
|
||
|
|
||
|
my $is_dynamic = $bnode_tree->get_attribute( $hidden_field, "dynamic" );
|
||
|
my $value = $bnode_tree->get_attribute($hidden_field, "value");
|
||
|
$self->__set_default_value($bnode_tree, $mq_node, $value, dynamic => $is_dynamic);
|
||
|
|
||
|
# We now remove the hidden field tag from the tree, attaching whatever its children are to its parents.
|
||
|
my $hf_children = $bnode_tree->get_children($hidden_field);
|
||
|
my $parent_node = $bnode_tree->get_parent_node($hidden_field);
|
||
|
##?REFACTOR: Moan (ie. TBB::Crash::crash34()) if there is not one and only one child of
|
||
|
##?REFACTOR: this hidden_field.
|
||
|
foreach my $child_node (@$hf_children)
|
||
|
{
|
||
|
# Clone the child node. The '1' means a deep copy, ie. the whole structure
|
||
|
# beneath the child node is copied.
|
||
|
my $child_clone = $bnode_tree->clone_node($child_node, 1);
|
||
|
|
||
|
# Attach the child node to the hidden_field's parent node.
|
||
|
$bnode_tree->append_child($parent_node, $child_node);
|
||
|
}
|
||
|
|
||
|
# Now remove the hidden_field node and all of its original descendants (who, by now, have
|
||
|
# been safely copied to the same position the hidden_field was originally in.
|
||
|
$bnode_tree->remove_node($hidden_field);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item __set_default_value($bnode_tree, $mq, $default_value, %opts)
|
||
|
|
||
|
Sets the default value of the MQ node to $default_value
|
||
|
|
||
|
$bnode_tree is the TBB::XML object representing the BNode
|
||
|
|
||
|
$mq is a XML::LibXML::Element object representing an MQ node
|
||
|
|
||
|
$default_value is the value that we want to set for $mq
|
||
|
|
||
|
Valid opts include:
|
||
|
|
||
|
dynamic => Mark the hidden field with the "dynamic" attribute,
|
||
|
indicating that it should be evaluated as an expression
|
||
|
for each user when adding userdata nodes.
|
||
|
|
||
|
##?REFACTOR: We don't call this anywhere, and I think we're right not to; it's
|
||
|
##?REFACTOR: out-of-paradigm in that this doesn't get called globally. Probably
|
||
|
##?REFACTOR: this opt and its functionality should just go away.
|
||
|
##?REFACTOR: Check this is true then remove this.
|
||
|
ignore_hidden_fields => If true, this function will not set the default
|
||
|
value for hidden fields. This should be set to 1
|
||
|
when being called by __populate_group_questions and
|
||
|
__populate_non_group_questions.
|
||
|
|
||
|
=cut
|
||
|
sub __set_default_value
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($bnode_tree, $mq, $default_value, %opts) = @_;
|
||
|
my $dynamic = $opts{dynamic};
|
||
|
my $ignore_hidden_fields = $opts{ignore_hidden_fields};
|
||
|
|
||
|
##?REFACTOR: Should the following two lines should go away?
|
||
|
##?REFACTOR: Should this whole method go away?
|
||
|
my $is_hidden_field = $bnode_tree->get_attribute($mq, "hidden");
|
||
|
return if ($ignore_hidden_fields && $is_hidden_field);
|
||
|
|
||
|
if ($default_value)
|
||
|
{
|
||
|
my $default_value_node = $bnode_tree->get_single_node_by_xpath($mq, 'defaultvalue', ok_to_return_null => 1);
|
||
|
unless ( $default_value_node )
|
||
|
{
|
||
|
$default_value_node = $bnode_tree->create_node("defaultvalue");
|
||
|
$bnode_tree->append_child($mq, $default_value_node);
|
||
|
}
|
||
|
$bnode_tree->set_node_value($default_value_node, $default_value);
|
||
|
if ( $dynamic )
|
||
|
{
|
||
|
$bnode_tree->add_attributes( $default_value_node, {dynamic => 1} );
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item __populate_drop_filtersets( $user_data, $resource_manager, %opts ) --> 1
|
||
|
|
||
|
Populate the dynamic drop-down box with the household member based on the
|
||
|
specified filterset. Pass in the TBB::UserData object and
|
||
|
TBB::BenefitDelivery::ResourceManager object
|
||
|
|
||
|
=cut
|
||
|
sub __populate_drop_filtersets
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $resource_manager, %opts) = @_;
|
||
|
|
||
|
$resource_manager = $TBB::BenefitDelivery::ResourceManager
|
||
|
if (not defined $resource_manager);
|
||
|
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
my $root_node = $bnode_tree->get_root();
|
||
|
my $drop_filtersets = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::drop_fs");
|
||
|
|
||
|
# If there is no filterset based dynamic drop-down, no need to preceed, return
|
||
|
return if (scalar @$drop_filtersets == 0);
|
||
|
#TBB::LogManager::write('debug', 'found drop_filterset');
|
||
|
foreach my $drop_filterset (@$drop_filtersets)
|
||
|
{
|
||
|
my ( $udid_label_nodes, $udid_label_node, $udid_label_string, @label_udids);
|
||
|
my $filtered_data = {};
|
||
|
my $fs_id = $bnode_tree->get_attribute($drop_filterset, "filterset");
|
||
|
### check to see if the trigger_user attribute is set
|
||
|
# A trigger_user drop filter sets the "id_user" form variable
|
||
|
# to a particular id_user value to indicate to the following page
|
||
|
# that all questions on that page are being asked about a particular id_user
|
||
|
# (the id_user will be prepended to all partial UDIDs)
|
||
|
my $is_trigger_user_dropfs =
|
||
|
$bnode_tree->get_attribute($drop_filterset, "trigger_user");
|
||
|
my $is_set_this_page_id_user =
|
||
|
$bnode_tree->get_attribute($drop_filterset, "this_page_id_user");
|
||
|
#TBB::LogManager::write('debug', "value of is_trigger_user_dropfs: $is_trigger_user_dropfs");
|
||
|
my $id_users;
|
||
|
|
||
|
### if this is a this_page_id_user and an id user has been set,
|
||
|
### we assume that we are coming off of an edit transition from a summary page,
|
||
|
### and because changing the "this_page_id_user" will not delete the old data,
|
||
|
### we do not allow the this_page_id_user to be changed.
|
||
|
if ( $is_set_this_page_id_user and $self->{navigator}->get_this_id_user() )
|
||
|
{
|
||
|
##?TODO: In this case, we should pre-select the only user in the select box.
|
||
|
$id_users = [ $self->{navigator}->get_this_id_user() ];
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
my $filterset = $resource_manager->get_filterset($fs_id);
|
||
|
$id_users = $filterset->filter_data($user_data_obj, resource_manager => $resource_manager, this_id_user => $opts{this_id_user});
|
||
|
}
|
||
|
|
||
|
#TBB::LogManager::write('debug', "**NOW: id_user is: ".Dumper($id_users)) if TBB::LogManager::writes_at('debug');
|
||
|
$udid_label_nodes = $bnode_tree->get_nodes_by_xpath($drop_filterset,
|
||
|
"descendant::text");
|
||
|
### we are not checking for language for now (the label is probably ##fullname##)
|
||
|
$udid_label_node = shift ( @{ $udid_label_nodes } );
|
||
|
$udid_label_string =
|
||
|
&TBB::Utils::trim_whitespace($bnode_tree->get_node_value($udid_label_node));
|
||
|
|
||
|
##?REFACTOR: come up with a better way to assemble display_text
|
||
|
|
||
|
# obtain the name for each of the related UDID
|
||
|
@label_udids = split (/ /, $udid_label_string);
|
||
|
|
||
|
# build option display text (e.g. full name)
|
||
|
foreach my $id_user (@$id_users)
|
||
|
{
|
||
|
my ($display_text);
|
||
|
foreach my $udid (@label_udids)
|
||
|
{
|
||
|
##?REFACTOR: Do we need to search label udids for aliases and pass them
|
||
|
# in to the retrieve call? We don't need to yet, but one
|
||
|
# day we might.
|
||
|
##?REFACTOR: normalization_for_presentation and also write the normalization method for this case
|
||
|
##?REFACTOR: use join.
|
||
|
$display_text .= $user_data_obj->retrieve_value(
|
||
|
base => $udid,
|
||
|
this_id_user => $id_user
|
||
|
)
|
||
|
. " ";
|
||
|
}
|
||
|
chop($display_text);
|
||
|
$filtered_data->{$id_user} = $display_text;
|
||
|
}
|
||
|
|
||
|
### Add a node with the drop_filterset data
|
||
|
# For the time being, we are directly building a select node
|
||
|
|
||
|
my $select_node = $bnode_tree->create_node ("select");
|
||
|
|
||
|
if ($is_trigger_user_dropfs)
|
||
|
{
|
||
|
##?TODO We should be setting "set_user_id" by
|
||
|
##?TODO $TBB::config{form_paramaters}{set_id_user_id}
|
||
|
#TBB::LogManager::write('debug', "determined dropfs is a is_trigger_user_dropfs");
|
||
|
$bnode_tree->add_attributes (
|
||
|
$select_node,
|
||
|
{
|
||
|
name => "set_id_user"
|
||
|
}
|
||
|
);
|
||
|
}
|
||
|
if ($is_set_this_page_id_user)
|
||
|
{
|
||
|
$bnode_tree->add_attributes (
|
||
|
$select_node,
|
||
|
{
|
||
|
name => "this_page_id_user"
|
||
|
}
|
||
|
)
|
||
|
}
|
||
|
|
||
|
## Note: We use $id_users as it's a pre-sorted list, rather than
|
||
|
## just iterating over the keys of %$filtered_data.
|
||
|
foreach my $id_user ( @$id_users )
|
||
|
{
|
||
|
my $option_node = $bnode_tree->create_node (
|
||
|
"option",
|
||
|
$filtered_data->{$id_user}
|
||
|
);
|
||
|
$bnode_tree->add_attributes ( $option_node,
|
||
|
{
|
||
|
value => $id_user
|
||
|
}
|
||
|
);
|
||
|
if (scalar (@$id_users) == 1)
|
||
|
{
|
||
|
$bnode_tree->add_attributes ( $option_node,
|
||
|
{
|
||
|
selected => 1
|
||
|
}
|
||
|
);
|
||
|
|
||
|
}
|
||
|
$bnode_tree->append_child ( $select_node, $option_node);
|
||
|
}
|
||
|
$bnode_tree->replace_child ( $root_node, $select_node, $drop_filterset );
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
=item __populate_display_instancesets($user_data_obj, $resource_manager, $id_user[, %opts])
|
||
|
|
||
|
Function to list the labels specified in the <display_is> tag based on the instances
|
||
|
for the users specified in the filterset.
|
||
|
|
||
|
$user_data_obj is TBB::UserData object
|
||
|
$resource_manager is TBB::BenefitDelivery::ResourceManager object
|
||
|
$id_user is the whatever the user id passed in, but it would be overritten if the filterset
|
||
|
is specified.
|
||
|
|
||
|
Interface in the xml is:
|
||
|
<display_is instanceset="IS000-000-113" filterset="FS000-000-355" label="'INSTANCE(GQ000-000-244:MQ000-000-350)'"/>
|
||
|
|
||
|
Interface should go to BNode level and within a conditional block.
|
||
|
|
||
|
=cut
|
||
|
##?REFACTOR: this needs SEVERE refactoring
|
||
|
sub __populate_display_instancesets
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $resource_manager, $id_user, %opts) = @_;
|
||
|
|
||
|
$id_user ||= $user_data_obj->current_client_id();
|
||
|
my $this_instance = $opts{this_instance};
|
||
|
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
my $root_node = $bnode_tree->get_root();
|
||
|
|
||
|
my $conditional_blocks = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::conditional_block");
|
||
|
foreach my $conditional_block (@$conditional_blocks)
|
||
|
{
|
||
|
my $display_instancesets = $bnode_tree->get_nodes_by_xpath($conditional_block,
|
||
|
"display_is");
|
||
|
|
||
|
next unless (scalar @$display_instancesets);
|
||
|
|
||
|
my $paragraph_text_nodes = $bnode_tree->get_nodes_by_xpath($conditional_block,
|
||
|
"descendant::text");
|
||
|
foreach my $text_node (@$paragraph_text_nodes)
|
||
|
{
|
||
|
my $text = $bnode_tree->get_node_value($text_node);
|
||
|
my $label_hash;
|
||
|
foreach my $display_is (@$display_instancesets)
|
||
|
{
|
||
|
my $is_id = $bnode_tree->get_attribute($display_is, 'instanceset');
|
||
|
my $fs_id = $bnode_tree->get_attribute($display_is, 'filterset');
|
||
|
my $label_expression_string = $bnode_tree->get_attribute($display_is, 'label');
|
||
|
my $instanceset = $resource_manager->get_instanceset( $is_id );
|
||
|
my $filterset = $resource_manager->get_filterset( $fs_id );
|
||
|
my $label_expression = TBB::Expression->new(
|
||
|
$label_expression_string,
|
||
|
$resource_manager
|
||
|
);
|
||
|
##?TODO: Figure out how to set a CONTEXT_INSTANCE() for this is.
|
||
|
#Should it be based on $this_instance or $context_instance or either or neither? #OK. Passing the new %opts in should do it.
|
||
|
my $id_users = $filterset->filter_data(
|
||
|
$user_data_obj,
|
||
|
%opts,
|
||
|
);
|
||
|
next unless (scalar @$id_users);
|
||
|
|
||
|
foreach my $id_user (@$id_users)
|
||
|
{
|
||
|
my $instance_list = $instanceset->filter_data(
|
||
|
$user_data_obj,
|
||
|
$id_user,
|
||
|
%opts
|
||
|
);
|
||
|
|
||
|
next unless (scalar @$instance_list);
|
||
|
|
||
|
foreach my $this_instance ( @$instance_list )
|
||
|
{
|
||
|
my $this_label = $label_expression->evaluate(
|
||
|
$user_data_obj,
|
||
|
$id_user,
|
||
|
$this_instance
|
||
|
);
|
||
|
$label_hash->{$id_user . "_" . $this_label} = $this_label;
|
||
|
}
|
||
|
}
|
||
|
$bnode_tree->remove_node($display_is);
|
||
|
|
||
|
}
|
||
|
$text .= ": " . join(", ", (values %$label_hash));
|
||
|
$bnode_tree->set_node_value($text_node, $text);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
##?TODO: Get rid of this when we refactor taxes. It is now subsumed by
|
||
|
##?TODO: instanceset gq_groups and should go away. Make sure it's not in
|
||
|
##?TODO: production BMods though before we do away with it.
|
||
|
=item __populate_check_instancesets($user_data_obj, $resource_manager, $id_user[, %opts])
|
||
|
|
||
|
Function to list the checkboxes for all the instances specified by instanceset in the
|
||
|
<check_is>'s attribute for the users specified in the filterset. The gq with <check_is>
|
||
|
has to be grouped gq with the filterset specified in the <group_gq>
|
||
|
|
||
|
$user_data_obj is TBB::UserData object
|
||
|
$resource_manager is TBB::BenefitDelivery::ResourceManager object
|
||
|
$id_user is the whatever the user id passed in, but it would be overritten if the filterset
|
||
|
is specified.
|
||
|
|
||
|
Interface in the xml is:
|
||
|
<interface>
|
||
|
<check_is instanceset="IS000-000-141" label="'INSTANCE(GQ000-000-233:MQ000-000-255)' . ' : ' . 'INSTANCE(GQ000-000-233:MQ000-000-269)'"/>
|
||
|
</interface>
|
||
|
|
||
|
=cut
|
||
|
sub __populate_check_instancesets
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $resource_manager, $id_user, %opts) = @_;
|
||
|
|
||
|
$id_user ||= $user_data_obj->current_client_id();
|
||
|
my $this_instance = $opts{this_instance};
|
||
|
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
my $root_node = $bnode_tree->get_root();
|
||
|
my $mqs = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::mq");
|
||
|
|
||
|
# Now go through the check_instanceset nodes and create fake mqs in their place.
|
||
|
### Our strategy:
|
||
|
### For each instance in the instance set (for which we want to make a checkbox)
|
||
|
### we will make a fake MQ where the MQ id ends with an underscore and the
|
||
|
### instance id. We'll set the label of that MQ to the calculated label from
|
||
|
### instance data. And then we'll let the XSL present it as if it was any MQ.
|
||
|
foreach my $mq_ancestor (@$mqs)
|
||
|
{
|
||
|
my $check_instancesets = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::check_is");
|
||
|
TBB::LogManager::write('debug', "CHECKIS: in populate_check_is");
|
||
|
next unless (scalar @$check_instancesets);
|
||
|
|
||
|
foreach my $check_is (@$check_instancesets)
|
||
|
{
|
||
|
TBB::LogManager::write('debug', "CHECK IS: in populate_check_is, found one");
|
||
|
my $is_id = $bnode_tree->get_attribute($check_is, 'instanceset');
|
||
|
my $gq_group = $bnode_tree->get_single_node_by_xpath($check_is,
|
||
|
"ancestor::gq_group");
|
||
|
my $fs_id = $bnode_tree->get_attribute($gq_group, 'filterset');
|
||
|
my $label_expression_string = $bnode_tree->get_attribute($check_is, 'label');
|
||
|
my $instanceset = $resource_manager->get_instanceset( $is_id );
|
||
|
my $filterset = $resource_manager->get_filterset( $fs_id );
|
||
|
my $label_expression = TBB::Expression->new(
|
||
|
$label_expression_string,
|
||
|
$resource_manager
|
||
|
);
|
||
|
my $gq_ancestor = $bnode_tree->get_single_node_by_xpath($check_is, 'ancestor::gq');
|
||
|
my $mq_id = $bnode_tree->get_attribute( $mq_ancestor, 'id' );
|
||
|
##?TODO: Figure out how to set a CONTEXT_INSTANCE() for this is.
|
||
|
#Should it be based on $this_instance or $context_instance or either or neither?
|
||
|
|
||
|
my $id_users = $filterset->filter_data($user_data_obj, %opts);
|
||
|
next unless (scalar @$id_users);
|
||
|
|
||
|
foreach my $id_user (@$id_users)
|
||
|
{
|
||
|
my $instance_list = $instanceset->filter_data(
|
||
|
$user_data_obj,
|
||
|
$id_user,
|
||
|
%opts
|
||
|
);
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"CHECK IS: '$is_id' returned "
|
||
|
. (scalar @$instance_list)
|
||
|
. " members: "
|
||
|
. join(", ", @$instance_list)
|
||
|
) if TBB::LogManager::writes_at('debug');
|
||
|
next unless (scalar @$instance_list);
|
||
|
|
||
|
foreach my $this_instance ( @$instance_list )
|
||
|
{
|
||
|
TBB::LogManager::write('debug', "CHECK IS: generating mq for $this_instance");
|
||
|
my $mq_clone = $bnode_tree->clone_node($mq_ancestor, 1);
|
||
|
my $this_label = $label_expression->evaluate(
|
||
|
$user_data_obj,
|
||
|
$id_user,
|
||
|
$this_instance,
|
||
|
%opts
|
||
|
);
|
||
|
|
||
|
### Set labelset to individual instance label
|
||
|
# This is a little too aggressive -- too many value changes
|
||
|
my $text_nodes = $bnode_tree->get_nodes_by_xpath($mq_clone, 'descendant::label/textoptions/text');
|
||
|
foreach my $text_node ( @$text_nodes )
|
||
|
{
|
||
|
$bnode_tree->set_node_value( $text_node, $this_label );
|
||
|
}
|
||
|
my $clarifying_question_nodes = $bnode_tree->get_nodes_by_xpath($mq_clone, 'descendant::clarifying_questions');
|
||
|
foreach my $clarifying_question_node ( @$clarifying_question_nodes )
|
||
|
{
|
||
|
$bnode_tree->remove_node($clarifying_question_node);
|
||
|
}
|
||
|
|
||
|
### update mq
|
||
|
$bnode_tree->add_attributes (
|
||
|
$mq_clone,
|
||
|
{
|
||
|
id => $mq_id ."_$this_instance"
|
||
|
}
|
||
|
);
|
||
|
|
||
|
### update interface
|
||
|
my $clone_check_is = $bnode_tree->get_nodes_by_xpath($mq_clone, 'descendant::check_is');
|
||
|
my $interface_node = $bnode_tree->get_single_node_by_xpath($mq_clone, 'descendant::interface');
|
||
|
foreach my $clone_single_check_is (@$clone_check_is)
|
||
|
{
|
||
|
$bnode_tree->remove_node($clone_single_check_is);
|
||
|
}
|
||
|
my $checkbox_node = $bnode_tree->create_node ("checkbox");
|
||
|
$bnode_tree->append_child ( $interface_node, $checkbox_node );
|
||
|
|
||
|
### append clone to gq
|
||
|
$bnode_tree->append_child( $gq_ancestor, $mq_clone );
|
||
|
|
||
|
## modify the <userdata> tag based on the id_user for this instance
|
||
|
my $userdata = $bnode_tree->get_nodes_by_xpath($mq_clone, "userdata");
|
||
|
foreach my $userdata_node (@$userdata)
|
||
|
{
|
||
|
if ($bnode_tree->get_attribute($userdata_node, "id_user") ne $id_user)
|
||
|
{
|
||
|
$bnode_tree->remove_node($userdata_node);
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
$bnode_tree->remove_node($bnode_tree->get_single_node_by_xpath($userdata_node, "label"));
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
# remove the unnecessary <user_data> tag from the mq_ancestor for the presentation purpose
|
||
|
my $userdata = $bnode_tree->get_nodes_by_xpath($mq_ancestor, "userdata");
|
||
|
foreach my $userdata_node (@$userdata)
|
||
|
{
|
||
|
$bnode_tree->remove_node($userdata_node);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
##?REFACTOR: POD.
|
||
|
sub __populate_drop_instancesets
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data, $resource_manager, $id_user, %opts) = @_;
|
||
|
|
||
|
$id_user ||= $user_data->current_client_id();
|
||
|
my $this_instance = $opts{this_instance};
|
||
|
|
||
|
my $bnode_tree = $self->{bnode}->get_xml_resource();
|
||
|
my $root_node = $bnode_tree->get_root();
|
||
|
my $drop_instancesets = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::drop_is");
|
||
|
|
||
|
# If there is no filterset based dynamic drop-down, no need to preceed, return
|
||
|
return unless (scalar @$drop_instancesets);
|
||
|
|
||
|
# Now go through the drop_id nodes and give them a working over.
|
||
|
foreach my $drop_is (@$drop_instancesets)
|
||
|
{
|
||
|
my $is_id = $bnode_tree->get_attribute($drop_is, 'instanceset');
|
||
|
my $label_expression_string = $bnode_tree->get_attribute($drop_is, 'label');
|
||
|
my $trigger_instance = $bnode_tree->get_attribute($drop_is, 'trigger_instance');
|
||
|
my $instanceset = $resource_manager->get_instanceset( $is_id );
|
||
|
my $label_expression = TBB::Expression->new(
|
||
|
$label_expression_string,
|
||
|
$resource_manager
|
||
|
);
|
||
|
##?TODO: Figure out how to set a CONTEXT_INSTANCE() for this is. Should it be based on $this_instance or $context_instance or either or neither?
|
||
|
my $instance_list = $instanceset->filter_data(
|
||
|
$user_data,
|
||
|
$id_user,
|
||
|
context_instance => $this_instance
|
||
|
);
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"DROP IS: '$is_id' returned "
|
||
|
. (scalar @$instance_list)
|
||
|
. " members: "
|
||
|
. join(", ", @$instance_list)
|
||
|
) if TBB::LogManager::writes_at('debug');
|
||
|
|
||
|
next unless (scalar @$instance_list);
|
||
|
|
||
|
my $select_node = $bnode_tree->create_node ("select");
|
||
|
|
||
|
my $select_name;
|
||
|
if ($trigger_instance)
|
||
|
{
|
||
|
##?TODO We should be setting "set_user_id" by
|
||
|
##?TODO $TBB::config{form_paramaters}{set_id_user_id}
|
||
|
#TBB::LogManager::write('debug', "determined dropfs is a is_trigger_user_dropfs");
|
||
|
$select_name = 'set_ordinal';
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
my $gq_ancestor = $bnode_tree->get_single_node_by_xpath($drop_is, 'ancestor::gq');
|
||
|
my $mq_ancestor = $bnode_tree->get_single_node_by_xpath($drop_is, 'ancestor::mq');
|
||
|
$select_name = $id_user
|
||
|
. ":"
|
||
|
. $bnode_tree->get_attribute( $gq_ancestor, 'id' )
|
||
|
. ":"
|
||
|
. $bnode_tree->get_attribute( $mq_ancestor, 'id' );
|
||
|
$select_name .= "_$this_instance" if $this_instance;
|
||
|
|
||
|
}
|
||
|
$bnode_tree->add_attributes (
|
||
|
$select_node,
|
||
|
{ name => $select_name }
|
||
|
);
|
||
|
|
||
|
|
||
|
foreach my $this_instance ( @$instance_list )
|
||
|
{
|
||
|
my $this_id_user = $user_data->get_id_user_for_instance( $this_instance );
|
||
|
my $this_label = $label_expression->evaluate(
|
||
|
$user_data,
|
||
|
$this_id_user,
|
||
|
$this_instance
|
||
|
);
|
||
|
|
||
|
my $option_node = $bnode_tree->create_node (
|
||
|
"option",
|
||
|
$this_label
|
||
|
);
|
||
|
$bnode_tree->add_attributes (
|
||
|
$option_node,
|
||
|
{ value => $this_instance }
|
||
|
);
|
||
|
$bnode_tree->append_child ( $select_node, $option_node);
|
||
|
}
|
||
|
my $drop_is_parent_mq = $bnode_tree->get_single_node_by_xpath( $drop_is, 'ancestor::interface' );
|
||
|
$bnode_tree->append_child($drop_is_parent_mq, $select_node);
|
||
|
$bnode_tree->remove_node( $drop_is );
|
||
|
}
|
||
|
|
||
|
}
|
||
|
|
||
|
|
||
|
=item __add_dummy_ids($id_users, $dummy_id_count)
|
||
|
|
||
|
Adds $dummy_id_count dummy IDs to $id_users. A dummy ID is a single letter,
|
||
|
so if $dummy_id_count is 3, for example, this function will push the letters
|
||
|
A, B and C to the end of the array referenced by $id_users
|
||
|
|
||
|
$id_users is an array reference
|
||
|
|
||
|
$dummy_id_count is an integer
|
||
|
|
||
|
=cut
|
||
|
sub __add_dummy_ids
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($id_users, $dummy_id_count) = @_;
|
||
|
|
||
|
for (my $i = 1; $i <= $dummy_id_count; $i++)
|
||
|
{
|
||
|
## chr($i + 64) returns 'A' if $i == 1, 'B' if $i == 2, etc.
|
||
|
push @$id_users, chr($i + 64);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item __integrate_form_action($action)
|
||
|
|
||
|
Populates the bnode with the action specified in $action.
|
||
|
|
||
|
=cut
|
||
|
sub __integrate_form_action
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($action) = @_;
|
||
|
|
||
|
my $bnode = $self->{bnode};
|
||
|
|
||
|
$bnode->add_attribute_by_xpath("/bnode",
|
||
|
'action' => $action);
|
||
|
}
|
||
|
|
||
|
=item __integrate_language_preference($primary_lang, $secondary_lang)
|
||
|
|
||
|
Populates the bnode with the primary and secondary languages specified
|
||
|
in the parameters.
|
||
|
|
||
|
=cut
|
||
|
sub __integrate_language_preference
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($primary_lang, $secondary_lang) = @_;
|
||
|
|
||
|
my $bnode = $self->{bnode};
|
||
|
|
||
|
$bnode->add_attribute_by_xpath("/bnode",
|
||
|
'lang_primary' => $primary_lang,
|
||
|
'lang_secondary' => $secondary_lang
|
||
|
);
|
||
|
}
|
||
|
|
||
|
=item __set_system_hidden_field ($field_name, $value)
|
||
|
|
||
|
System feilds are non-UDID fields containing pieces of (typically navigational)
|
||
|
data which are set in the BNode and set as hidden form fields
|
||
|
on the resultant page. They all live in the XML node
|
||
|
|
||
|
##TODO: Finish this POD.
|
||
|
|
||
|
=cut
|
||
|
sub __set_system_hidden_field
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($field_name, $value) = @_;
|
||
|
|
||
|
# Set some local variables for ease of reference.
|
||
|
my $bnode_tree = $self->get_bnode()->get_xml_resource();
|
||
|
my $shf_xpath = $self->{system_hidden_field_xpath};
|
||
|
|
||
|
# Get the node to append hidden fields to.
|
||
|
my $shf_parent_nodelist = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(), $shf_xpath);
|
||
|
TBB::Crash::crash35 "Expected one (1) System Hidden Field node found with xpath '$shf_xpath'. Found "
|
||
|
. (scalar @$shf_parent_nodelist || "0") . "!\n"
|
||
|
unless ((scalar @$shf_parent_nodelist) == 1);
|
||
|
my $shf_parent_node = $shf_parent_nodelist->[0];
|
||
|
|
||
|
# Create a new System Hidden Field node with attribute name="$field_name"
|
||
|
# and value="$value".
|
||
|
my $new_shf_node = $bnode_tree->create_node( $self->{system_hidden_field_node_name} );
|
||
|
$bnode_tree->add_attributes( $new_shf_node, {name => $field_name} );
|
||
|
$bnode_tree->add_value( $new_shf_node, $value );
|
||
|
|
||
|
# Append the new node to the appropriate place in the BNode's XML tree.
|
||
|
$bnode_tree->append_child($shf_parent_node, $new_shf_node);
|
||
|
}
|
||
|
|
||
|
=item __set_hidden_form_id ()
|
||
|
|
||
|
##?REFACTOR: POD !!
|
||
|
|
||
|
=cut
|
||
|
sub __set_hidden_form_id
|
||
|
{
|
||
|
use Digest::MD5;
|
||
|
my $self = shift;
|
||
|
|
||
|
my $form_id_html_field_name = $TBB::Config->get_config_parameters('form_id'=>'form_parameters/form_id');
|
||
|
|
||
|
srand( int( rand(time()) ) );
|
||
|
my $form_id = Digest::MD5::md5_hex( rand(time()) );
|
||
|
|
||
|
# In the test environment, fake $form_id so that we can have explicit matching
|
||
|
# against a pre-canned XML output:
|
||
|
my $force_MD5 = $TBB::Config->get_config_parameters('md5'=>'test/force_MD5_sum_id');
|
||
|
$form_id = $force_MD5
|
||
|
if ($force_MD5);
|
||
|
|
||
|
#TBB::LogManager::write('debug', "Adding hidden form id [$form_id_html_field_name => $form_id]");
|
||
|
|
||
|
$self->__set_system_hidden_field($form_id_html_field_name, $form_id);
|
||
|
return $form_id;
|
||
|
}
|
||
|
|
||
|
=item __populate_page_text($user_data_obj, $id_user, $ordinal, %subroutine_opts)
|
||
|
|
||
|
Fills GQ:MQ and FM strings in all textopts nodes on the page NOT associated with
|
||
|
questions.
|
||
|
|
||
|
=cut
|
||
|
sub __populate_page_text
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($user_data_obj, $id_user, $ordinal, %subroutine_opts) = @_;
|
||
|
|
||
|
my $bnode_tree = $self->get_bnode()->get_xml_resource();
|
||
|
my @page_text_nodes = ('head', 'paragraph', 'title', 'subtitle', 'description', 'interface');
|
||
|
|
||
|
foreach my $node_type (@page_text_nodes)
|
||
|
{
|
||
|
my $xpath = 'descendant::' . $node_type;
|
||
|
my $text_container_nodes = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(), $xpath);
|
||
|
|
||
|
foreach my $container (@$text_container_nodes)
|
||
|
{
|
||
|
$self->__process_text_options($bnode_tree, $container, $user_data_obj, $id_user, $ordinal);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
=item __process_text_options($bnode_tree, $node_to_process, $user_data_obj, $id_user])
|
||
|
|
||
|
Finds all of the textoptions nodes that are children of $node_to_process,
|
||
|
and replaces all UDIDs contained in those text nodes with their value in
|
||
|
$user_data. If $id_user is provided, it uses the value of $id_user as
|
||
|
the id_user, otherwise it uses $user_data->current_client_id()
|
||
|
|
||
|
$bnode_tree is the XML tree containing the bnode that we're populating
|
||
|
|
||
|
$node_to_process is the node whose descendants will be considered
|
||
|
for processing
|
||
|
|
||
|
$user_data_obj is a reference to a TBB::UserData object
|
||
|
|
||
|
$id_user is the id_user of the user whose data will be integrated
|
||
|
into the text nodes (optional)
|
||
|
|
||
|
Note that as of this check-in (use bonsai to see which one I mean) we
|
||
|
really actually parse text() nodes (in an xml sense) not just nodes
|
||
|
that we have been calling <text>.... This means we can do inline crazy
|
||
|
shit like
|
||
|
|
||
|
<paragraph>
|
||
|
<textoptions>
|
||
|
<text>I am some <macro>blah</macro> text and I contain another <paragraph/>
|
||
|
right in the FM000-002-311 middle and <glos>glossary words</glos> and
|
||
|
all sorts of craziness.</text>
|
||
|
</textoptions>
|
||
|
</paragraph>
|
||
|
|
||
|
=cut
|
||
|
sub __process_text_options
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($bnode_tree, $node_to_process, $user_data_obj, $this_id_user, $this_instance, %opts) = @_;
|
||
|
my $context = $opts{context};
|
||
|
|
||
|
# If there isn't a node to process then we're all done.
|
||
|
return 0
|
||
|
unless ($node_to_process);
|
||
|
|
||
|
my $questions_nodes =
|
||
|
$bnode_tree->get_nodes_by_xpath($node_to_process,
|
||
|
"descendant::questions");
|
||
|
TBB::Crash::crash36 "__process_text_options called on a parent of a 'questions' node"
|
||
|
if (scalar @$questions_nodes > 0);
|
||
|
|
||
|
$this_id_user ||= $user_data_obj->current_client_id();
|
||
|
|
||
|
my $text_nodes = $bnode_tree->get_nodes_by_xpath(
|
||
|
$node_to_process,
|
||
|
'descendant::text'
|
||
|
);
|
||
|
return if (scalar @$text_nodes == 0);
|
||
|
|
||
|
##?REFACTOR: Use TBB::ID.
|
||
|
my $question_regex = TBB::ID_old::QUESTION_REGEX();
|
||
|
my $formula_regex = TBB::ID_old::FORMULA_REGEX();
|
||
|
|
||
|
##?TODO: Note that the following strategy is a bit expensive: We iterate over
|
||
|
# *all* text nodes, rather than just focusing on the ones we know are
|
||
|
# needed for the current page. A better strategy would be to *only*
|
||
|
# address the nodes of the language we are displaying on the page.
|
||
|
# This, however would require that either:
|
||
|
# (1) every call to __process_text_options would pass in a
|
||
|
# current_language => 'whatever' opt, or
|
||
|
# (2) we set $self->{current_language} in a meaningful way and
|
||
|
# then used that.
|
||
|
# Finally, it's worth mentioning that both of these strategies are
|
||
|
# brittle as we *always* want to process the en-US version of a node:
|
||
|
# It is needed for "failover" if a translated version of the node is
|
||
|
# not available.
|
||
|
|
||
|
foreach my $text_node (@$text_nodes)
|
||
|
{
|
||
|
##?REFACTOR: Create a central string process method
|
||
|
##?NOTE: The attribute is coded as 'xml:lang' but, for reasons which I
|
||
|
# must confess not to understand, the xpath which finds it is
|
||
|
# just to search for 'lang'. Beats me why....
|
||
|
my $node_language = $bnode_tree->get_attribute( $text_node, 'lang' ) || 'en-US';
|
||
|
|
||
|
# Now iterate over all the individual textnodes (not <text> nodes, but the
|
||
|
# actual blobs of text) within this <text> node.
|
||
|
# eg. "<text>Your <glos>household</glos> needs help.</text>
|
||
|
#
|
||
|
# has 3 textnodes:
|
||
|
# 1) "Your "
|
||
|
# 2) "household"
|
||
|
# 3) " needs help."
|
||
|
#
|
||
|
# Right now, we handle each of these separately.
|
||
|
##?TODO: We HAVE to handle them separately because TBB::XML::set_node_value
|
||
|
# doesn't know how to set multi-node values correctly. Once it is
|
||
|
# REFACTORED to do so then we can replace a lot of this strategy with
|
||
|
# just processing at the <text> node level instead.
|
||
|
|
||
|
##?NOTE: 'descendant::text' returns xml nodes of type 'text', ie, the <text> node
|
||
|
# in our example above. 'descendant::text()' returns xml textnodes,
|
||
|
# ie the text fragments like "Your " in the example above.
|
||
|
my $text_fragments = $bnode_tree->get_nodes_by_xpath( $text_node, 'descendant::text()' );
|
||
|
|
||
|
foreach my $text_fragment (@$text_fragments)
|
||
|
{
|
||
|
##?TODO: Try to pull all this native LibXML stuff out of this method.
|
||
|
my $text_node_value = $text_fragment->data();
|
||
|
|
||
|
# Iterate over any GQ:MQ, FM, INSTANCE(GQ:MQ) and the now deprecated INSTANCE(FM)
|
||
|
# matches in the text. For each one, get its value from UserData (for the current
|
||
|
# user, instance, etc), normalize it for presentation and then substitute it into
|
||
|
# the string in place of the original.
|
||
|
# Note that the 'g' flag means we will iterate over matches.
|
||
|
##?REVIEW: IS the 'g' flag still necessary given that we now *always* substitute
|
||
|
# even if we can't find a match?
|
||
|
while ($text_node_value =~ /((INSTANCE\()?(\S+:)?($question_regex|$formula_regex)\)?)/mg)
|
||
|
{
|
||
|
# This is the complete text of the text_node_value, including INSTANCE
|
||
|
my $token = $1;
|
||
|
# The instance wrapped expression
|
||
|
my $instance_function = $2;
|
||
|
# The aliasing on the front of the item, or nothing
|
||
|
my $alias = $3 || '';
|
||
|
# The question or formula ID
|
||
|
my $query_stem = $4;
|
||
|
|
||
|
# Strip the : off the end of the alias
|
||
|
$alias =~ s/:$//;
|
||
|
|
||
|
if (TBB::LogManager::writes_at('debug')) {
|
||
|
TBB::LogManager::write_log(
|
||
|
'debug',
|
||
|
"PROCESS TEXT OPTIONS:\n" .
|
||
|
"token = \"" . ($token || '') . "\"\n" .
|
||
|
"instance function = \"" . ($instance_function || '') . "\"\n" .
|
||
|
"alias = \"" . ($alias || '') . "\"\n" .
|
||
|
"query stem = \"" . ($query_stem || '') . "\"\n"
|
||
|
);
|
||
|
}
|
||
|
|
||
|
# we only want to pass an instance if it really is an instance, and not if the
|
||
|
# last one was an instance
|
||
|
##?NOTE: Use a separate variable so we don't clobber the global $this_instance
|
||
|
# in any one case.
|
||
|
my $instance_to_pass = $this_instance;
|
||
|
|
||
|
##?REVIEW: there are cases in the wild where $query_stem is undef!
|
||
|
# I don't understand why and cannot deal with the issue right
|
||
|
# now, so instead am adding the following hack:
|
||
|
if (defined($query_stem)) {
|
||
|
|
||
|
##?NOTE: Instance masking should only be for questions.
|
||
|
if (TBB::ID::is_a( $query_stem, 'question'))
|
||
|
{
|
||
|
if ($instance_function)
|
||
|
{
|
||
|
# There is an INSTANCE() block round this GQ:MQ, so there better
|
||
|
# should be an instance to pass.
|
||
|
TBB::Crash::crash37 "Cannot evaluate \"$text_node_value\" on "
|
||
|
. $self->get_bnode()->get_id()
|
||
|
. " : No instance given to $0->__process_text_options()\n"
|
||
|
unless ($instance_to_pass);
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
undef $instance_to_pass;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
} else {
|
||
|
TBB::LogManager::write("debug", "JDM: query stem is undefined!");
|
||
|
}
|
||
|
|
||
|
##?REVIEW: Could we make normalize => 'for_presentation' an
|
||
|
# opt to UD->retrieve_value? Might save repeating
|
||
|
# a chunk of coding in the various places we use it....
|
||
|
my $value = $user_data_obj->retrieve_value(
|
||
|
base => $query_stem,
|
||
|
alias => $alias,
|
||
|
this_id_user => $this_id_user,
|
||
|
this_instance => $instance_to_pass,
|
||
|
);
|
||
|
|
||
|
### Normalize the value for the current language.
|
||
|
my $normalizer = $self->{resource_manager}->get_normalizer();
|
||
|
$value = $normalizer->normalize_for_presentation(
|
||
|
$value,
|
||
|
$query_stem,
|
||
|
$node_language,
|
||
|
context => $context
|
||
|
);
|
||
|
|
||
|
# If for some reason we have an undef value then just use null string.
|
||
|
unless (defined $value)
|
||
|
{
|
||
|
# Get rid of the embarassing TBB::ID so it doesn't appear on the page.
|
||
|
$value = '';
|
||
|
|
||
|
# But also log this error as it's not cool.
|
||
|
TBB::LogManager::write(
|
||
|
'warn',
|
||
|
"Unable to get a defined value for $token from UserData."
|
||
|
);
|
||
|
}
|
||
|
|
||
|
unless ($text_node_value =~ s/\Q$token\E/$value/g)
|
||
|
{
|
||
|
TBB::Crash::crash38 "Messed up the token and now can't find \"$token\" in the string \"$text_node_value\".\n";
|
||
|
}
|
||
|
}
|
||
|
|
||
|
# Set the final text string in the text node.
|
||
|
##?REVIEW: Again, we should use TBB::XML, not LibXML.
|
||
|
$text_fragment->setData( $text_node_value );
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
|
||
|
=item __add_question_userdata_node ($id_user, $gq_id, $mq_id, $this_instance, $parent_node, $user_data, $label_textopts, $default_value, %opts)
|
||
|
|
||
|
Adds a <userdata> node to the XML tree as a child of $parent_node.
|
||
|
|
||
|
$gq_id and $mq_id have to be valid General Question and Micro Question ids.
|
||
|
$label_textopts is a <label> node whose text we wish to use as the instance label for this userdata node.
|
||
|
$default_value is the value to set the user-data to if the given "$id_user:$gq_id:$mq_id" combination
|
||
|
is not found in $user_data_obj.
|
||
|
$user_data_obj is a TBB::UserData object.
|
||
|
|
||
|
Valid %opts:
|
||
|
use_default_not_user_data => $bool : If this is true then the <value/> node is set to contain
|
||
|
$default_value irregardless of the presence or absence of
|
||
|
the GQMQ value in UserData.
|
||
|
add_instance_attr_to_node => $bool : If this is true, the <userdata/> node is given the
|
||
|
attribute instance="$this_instance". This will provoke
|
||
|
a TBB::Crash::crash39() if $this_instance is not set.
|
||
|
|
||
|
The added node has the following structure:
|
||
|
|
||
|
<userdata id_user="$id_user">
|
||
|
<label>
|
||
|
<textopts>
|
||
|
RESULTS of processing $label_textopts
|
||
|
</textopts>
|
||
|
</label>
|
||
|
<value>LOOKUP VALUE of "$id_user:$gq_id:$mq_id" in $user_data_obj OR $default_value</value>
|
||
|
</userdata>
|
||
|
|
||
|
=cut
|
||
|
sub __add_question_userdata_node
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($id_user, $gq_id, $mq_id, $this_instance, $parent_node, $user_data, $label_textopts, $default_value, %opts) = @_;
|
||
|
my $context = $opts{context} || 'question';
|
||
|
|
||
|
##?TODO: Hard code here. Modify later when the current language selection functionality
|
||
|
##?TODO: is available.
|
||
|
my $lang_selection = $self->{'primary_lang'};
|
||
|
|
||
|
my $bnode_tree = $self->get_bnode()->get_xml_resource();
|
||
|
# Get the values for the node from userdata and set them.
|
||
|
unless (TBB::ID::is_a($gq_id, 'general_question') && TBB::ID::is_a($mq_id, 'micro_question')) {
|
||
|
TBB::Crash::crash40 "invalid GQ or MQ ID: GQ = \"$gq_id\", MQ = \"$mq_id\"";
|
||
|
}
|
||
|
|
||
|
my $base = $gq_id . ':' . $mq_id;
|
||
|
|
||
|
my $udid = TBB::ID::implode(
|
||
|
'id_user' => $id_user,
|
||
|
'base' => $base,
|
||
|
'instance' => $this_instance
|
||
|
);
|
||
|
|
||
|
my $value;
|
||
|
if ($opts{use_default_not_user_data})
|
||
|
{
|
||
|
# We are being told to override the ud_hash and just use the default value.
|
||
|
# This typically only happens in the case of hidden_udid fields.
|
||
|
TBB::LogManager::write('debug', "HIDDEN FIELD: '" . "$id_user:$gq_id:$mq_id" . ($this_instance ? "_$this_instance" : "") . " setting value : '" . $default_value . "'");
|
||
|
$value = $default_value;
|
||
|
}
|
||
|
elsif(TBB::ID::is_real_id_user($id_user)) #get real data, otherwise its fake data
|
||
|
{
|
||
|
my $userdata_value = $user_data->retrieve_value(
|
||
|
base => $base,
|
||
|
this_id_user => $id_user,
|
||
|
this_instance => $this_instance,
|
||
|
);
|
||
|
##?NOTE: The last argument should be the current language
|
||
|
##?REFACTOR: Audit the behavior here.
|
||
|
if ($self->{navigator}) #((not $userdata_value) && $self->{navigator} )
|
||
|
{
|
||
|
my $redo_value = $self->{navigator}->get_redo_value($udid);
|
||
|
TBB::LogManager::write(
|
||
|
'debug',
|
||
|
"NAVIGATOR REDO VALUE : '$udid' ==> '"
|
||
|
. ($redo_value || 'undef')
|
||
|
. "'"
|
||
|
);
|
||
|
$userdata_value = $redo_value if defined $redo_value;
|
||
|
}
|
||
|
|
||
|
# Normalize the $userdata_value for presentation to the user.
|
||
|
my $normalized_value;
|
||
|
my $normalizer = $self->{resource_manager}->{normalizer};
|
||
|
my $normalization_type_mq = $normalizer->{normalization_type}->{$mq_id};
|
||
|
$normalized_value = $normalizer->normalize_for_presentation(
|
||
|
$userdata_value,
|
||
|
$udid,
|
||
|
$lang_selection,
|
||
|
context => $context
|
||
|
) unless (defined($normalization_type_mq) && $normalization_type_mq =~ m/^LANG_NORMALIZE/);
|
||
|
##?REVIEW: For the love of God, please do this...
|
||
|
##?HACK: The above matches LANG_NORMALIZE and LANG_NORMALIZE_RADIO but will suck for all other types later defined unless they adhere to this nowhere-else-mentioned style.
|
||
|
# Please fix this to be more flexible as soon as the world is not on fire.
|
||
|
TBB::LogManager::write('debug',
|
||
|
"NORMALIZED VALUE FROM '" .
|
||
|
($userdata_value || "") .
|
||
|
"' TO '" .
|
||
|
($normalized_value || "") .
|
||
|
"'");
|
||
|
$value = $normalized_value || $userdata_value || $default_value;
|
||
|
|
||
|
}
|
||
|
else #we have a dummy user, and therfore no user data
|
||
|
{
|
||
|
$value = $default_value;
|
||
|
}
|
||
|
my $userdata_node = $bnode_tree->create_node("userdata");
|
||
|
my $ud_node_attributes = { "id_user" => $id_user };
|
||
|
|
||
|
$ud_node_attributes->{this_instance} = "_$this_instance" if $this_instance;
|
||
|
$bnode_tree->add_attributes($userdata_node, $ud_node_attributes);
|
||
|
# Create and populate the value node.
|
||
|
my $value_node = $bnode_tree->create_node("value");
|
||
|
$bnode_tree->add_value($value_node, $value)
|
||
|
if defined ($value);
|
||
|
$bnode_tree->append_child($userdata_node, $value_node);
|
||
|
|
||
|
# Process the textopts for this user's question_member label.
|
||
|
TBB::LogManager::write('debug', "ABOUT TO TRY AND ATTACH LABEL: " . ($label_textopts ? $label_textopts->toString() : "MISSING") ) if TBB::LogManager::writes_at('debug');
|
||
|
if (defined $label_textopts && !($id_user =~ m/[A-Z]/))#don't write label for dummy ids
|
||
|
{
|
||
|
#TBB::LogManager::write('debug', "\n\$label_textopts set to " . $bnode_tree->to_string($label_textopts) . "\n\n");
|
||
|
my $local_label = $bnode_tree->clone_node($label_textopts, 1);
|
||
|
##?DEBUG:
|
||
|
#TBB::LogManager::write('debug', "\n\$local_label set to " . $bnode_tree->to_string($local_label) . "\n\n");
|
||
|
$self->__process_text_options($bnode_tree, $local_label, $user_data, $id_user, $this_instance);
|
||
|
#TBB::LogManager::write('debug', "\nAfter process_text_options \$local_label set to " . $bnode_tree->to_string($local_label) . "\n\n");
|
||
|
$bnode_tree->append_child($userdata_node, $local_label);
|
||
|
}
|
||
|
else
|
||
|
{
|
||
|
TBB::LogManager::write('debug', "SKIPPING LABEL: " . ($label_textopts ? $label_textopts->toString() : "MISSING")) if TBB::LogManager::writes_at('debug');
|
||
|
}
|
||
|
|
||
|
# append the <userdata> node to mq node
|
||
|
$bnode_tree->append_child($parent_node, $userdata_node);
|
||
|
}
|
||
|
|
||
|
=item __populate_glossary
|
||
|
|
||
|
check whether the glossary term surrounded by the <glos> tag exists in the current
|
||
|
bnode xml, if it's not, search in the bmod this bnode is in. If found, copy that
|
||
|
glossary node to this bnode.
|
||
|
|
||
|
=cut
|
||
|
sub __populate_glossary
|
||
|
{
|
||
|
my $self = shift;
|
||
|
|
||
|
##?TODO: Hard code here. Modify later when the current language selection functionality
|
||
|
##?TODO: is available.
|
||
|
my $lang_selection = $self->{'primary_lang'};
|
||
|
|
||
|
my $bnode_glos = {};
|
||
|
|
||
|
my $bnode_tree = $self->get_bnode()->get_xml_resource();
|
||
|
|
||
|
my $text_gloses = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::glos[ancestor::text/\@xml:lang='$lang_selection']");
|
||
|
|
||
|
# return if there is no glossary terms on this bnode
|
||
|
return if ((scalar @$text_gloses) == 0);
|
||
|
|
||
|
##?REFACTOR: here and throughout the module, it's best to not use 'descendant::...' unless it's
|
||
|
##?REFACTOR: totally necessary. descendant is a very slow process, or so i read in a book somewhere.
|
||
|
##?REFACTOR: in this case, i think we know the exact location of the glossary_words
|
||
|
##?REFACTOR: tag in the xml tree. so, we can provide the exact path with no problem.
|
||
|
|
||
|
# obtain the glossary words for this bnode, save them to a hash
|
||
|
my $glos_collection = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::glossary_words");
|
||
|
unless (scalar @$glos_collection)
|
||
|
{
|
||
|
my $created_glos_collection = $bnode_tree->create_node("glossary_words");
|
||
|
# add to the bnode
|
||
|
$bnode_tree->append_child($bnode_tree->get_root(), $created_glos_collection);
|
||
|
}
|
||
|
|
||
|
my $single_glos_collection = $bnode_tree->get_single_node_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::glossary_words");
|
||
|
|
||
|
|
||
|
|
||
|
foreach my $text_glos (@$text_gloses)
|
||
|
{
|
||
|
my $text_glos_value = lc $bnode_tree->get_node_value($text_glos);
|
||
|
|
||
|
my $glos_nodes = $bnode_tree->get_nodes_by_xpath($bnode_tree->get_root(),
|
||
|
"descendant::glossary_word");
|
||
|
|
||
|
foreach my $glos_node (@$glos_nodes)
|
||
|
{
|
||
|
my $glos_term = $bnode_tree->get_single_node_by_xpath($glos_node, "term/textoptions/text[\@xml:lang='$lang_selection']");
|
||
|
my $glos_word = $bnode_tree->get_node_value($glos_term);
|
||
|
$bnode_glos->{lc $glos_word} = lc $glos_word;
|
||
|
}
|
||
|
|
||
|
unless (exists $bnode_glos->{$text_glos_value})
|
||
|
{
|
||
|
# no such glossary word in the current bnode, then look for it in the bmod
|
||
|
my $bmod_obj = $self->{resource_manager}->get_bmod($self->{bmod_id});
|
||
|
my $bmod = $bmod_obj->get_xml_resource();
|
||
|
my $bmod_glos_words = $bnode_tree->get_nodes_by_xpath($bmod->get_root(),
|
||
|
"descendant::glossary_word");
|
||
|
|
||
|
INNER: foreach my $bmod_glos_word (@$bmod_glos_words)
|
||
|
{
|
||
|
my $bmod_glos_node = $bnode_tree->get_nodes_by_xpath($bmod_glos_word,
|
||
|
"term/textoptions/text[\@xml:lang='$lang_selection']");
|
||
|
if ( lc $bnode_tree->get_node_value($bmod_glos_node->[0]) eq $text_glos_value )
|
||
|
{
|
||
|
# find the glossary, add this glossary node to the bnode tree
|
||
|
my $glos_clone_node = $bmod->clone_node($bmod_glos_word, 1);
|
||
|
$bnode_tree->append_child($single_glos_collection, $glos_clone_node);
|
||
|
last INNER;
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
}
|
||
|
#TBB::LogManager::write('debug', "\n\bnode tree to " . $bnode_tree->to_string() . "\n\n");
|
||
|
}
|
||
|
|
||
|
=item __evaluate_dynamic_value($expression_strn, $id_user, $ordinal, %opts)
|
||
|
|
||
|
Creates, and evaluates, a new TBB::Expression object for $expression, then evaluates it,
|
||
|
passing in the values of $id_user, $ordinal and any %opts.
|
||
|
|
||
|
Returns the result of the evaluation.
|
||
|
|
||
|
=cut
|
||
|
sub __evaluate_dynamic_value
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($expression_strn, $this_id_user, $this_instance, $user_data_obj, %opts) = @_;
|
||
|
|
||
|
##?DEBUG:
|
||
|
if (TBB::LogManager::writes_at('debug')) {
|
||
|
my $log_strn = "Called by '"
|
||
|
. ((caller(1))[3] || "")
|
||
|
. "' with args: ("
|
||
|
. join(", ", (@_ || ()))
|
||
|
. ")\n";
|
||
|
TBB::LogManager::write('debug', $log_strn);
|
||
|
}
|
||
|
# Get the ResourceManager.
|
||
|
my $resource_manager = $opts{resource_manager} || $TBB::BenefitDelivery::ResourceManager;
|
||
|
|
||
|
TBB::Crash::crash41 "Problem: ResourceManager is a '" . (ref $resource_manager) . "'\n"
|
||
|
unless (((ref $resource_manager) eq 'TBB::BenefitDelivery::ResourceManager')
|
||
|
|| ((ref $resource_manager) eq 'Test::MockObject'));
|
||
|
|
||
|
# Create the new expression.
|
||
|
my $expression_obj = TBB::Expression->new($expression_strn, $resource_manager);
|
||
|
|
||
|
my $value = $expression_obj->evaluate($user_data_obj, $this_id_user, $this_instance, %opts, this_id_user => $this_id_user);
|
||
|
|
||
|
if ($opts{'normalization'}) {
|
||
|
my $normalizer = $resource_manager->{'normalizer'};
|
||
|
$value = $normalizer->apply_normalization_to_string($opts{'normalization'}, $value, 'type' => 'presentation');
|
||
|
}
|
||
|
|
||
|
return $value;
|
||
|
}
|
||
|
|
||
|
=item __add_misc_data($gq_group, $max_user, %opts)
|
||
|
|
||
|
Creates a misc data node under each of the gq_group node. The misc data node contains
|
||
|
the following children, the first is the <max> node which contains the number of the
|
||
|
users in this gq_group, the rest of it are the userdata nodes from the first gq, first
|
||
|
mq.
|
||
|
|
||
|
This function mainsly is for the purpose of the xslt rendering. Currently, due to the
|
||
|
inflexibility of the xslt variable usage, we compose the above node based on the different
|
||
|
structure (mq or mq_group) of the gq.
|
||
|
|
||
|
##?TODO: Maybe there is a better way to bypass this xslt rendering issue. Leave to
|
||
|
##?TODO: future discussion
|
||
|
|
||
|
=cut
|
||
|
sub __add_misc_data
|
||
|
{
|
||
|
my $self = shift;
|
||
|
my ($gq_group, $max_user, %opts) = @_;
|
||
|
my ($xpath, $first_gq_child);
|
||
|
|
||
|
my $bnode_obj = $self->get_bnode() || TBB::Crash::crash42 "Couldn't get bnode!\n";
|
||
|
my $bnode_tree = $bnode_obj->get_xml_resource() || TBB::Crash::crash43 "Couldn't get XML resource from bnode!\n";
|
||
|
|
||
|
#get the first userdata node of the first gq/mq
|
||
|
my $first_gq = $bnode_tree->get_nodes_by_xpath($gq_group, "gq")->[0];
|
||
|
|
||
|
my $gq_children = $bnode_tree->get_children($first_gq);
|
||
|
foreach my $gq_child (@$gq_children)
|
||
|
{
|
||
|
my $gq_child_name = $bnode_tree->get_node_name($gq_child);
|
||
|
if ($gq_child_name eq "mq")
|
||
|
{
|
||
|
$first_gq_child = $gq_child;
|
||
|
$xpath = "userdata";
|
||
|
last;
|
||
|
}
|
||
|
if ($gq_child_name eq "mq_group")
|
||
|
{
|
||
|
$first_gq_child = $gq_child;
|
||
|
$xpath = "mq[1]/userdata";
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
|
||
|
unless ($first_gq_child && $xpath)
|
||
|
{
|
||
|
my $first_gq_id = $bnode_tree->get_attribute($first_gq, 'id');
|
||
|
TBB::Crash::crash44 "GQ \"$first_gq_id\" is missing a grandchild of type \"mq\" or \"mq_group\"\n";
|
||
|
}
|
||
|
my $userdata_nodes = $bnode_tree->get_nodes_by_xpath($first_gq_child, $xpath);
|
||
|
|
||
|
#create the max and misc_data nodes
|
||
|
my $misc_data = $bnode_tree->create_node("misc_data");
|
||
|
my $max = $bnode_tree->create_node("max");
|
||
|
$bnode_tree->add_value($max, $max_user) if defined ($max_user);
|
||
|
$bnode_tree->append_child($misc_data, $max);
|
||
|
foreach my $userdata (@$userdata_nodes)
|
||
|
{
|
||
|
my $cloned_userdata = $bnode_tree->clone_node($userdata, 1);
|
||
|
$bnode_tree->append_child($misc_data, $cloned_userdata);
|
||
|
}
|
||
|
$bnode_tree->append_child($gq_group, $misc_data);
|
||
|
}
|
||
|
|
||
|
1;
|
||
|
|