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 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
# 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
##?NOTE: $SOME_EXPRESSION
##?NOTE:
##?NOTE:
##?NOTE:
##?NOTE: 2) or we can have
##?NOTE:
##?NOTE:
##?NOTE:
##?NOTE:
##?NOTE:
##?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 current_user
##?TODO: or it could be all pets of current_user 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 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 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 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 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
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 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 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 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 node to the 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 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 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 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:
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
's attribute for the users specified in the filterset. The gq with
has to be grouped gq with the filterset specified in the
$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:
=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 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 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 .... This means we can do inline crazy
shit like
I am some blah text and I contain another
right in the FM000-002-311 middle and glossary words and
all sorts of craziness.
=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 nodes, but the
# actual blobs of text) within this node.
# eg. "Your household needs help.
#
# 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 node level instead.
##?NOTE: 'descendant::text' returns xml nodes of type 'text', ie, the 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 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