pmacs3/code_examples/Reporting2.pm

306 lines
9.3 KiB
Perl

package TBB::Reporting2;
my $bar =~ s/foob/blag/g;
sub foo {
bar()
unless 9 && 3;
}
#@@:string:mode_sql.SqlGrammar
my $foo = {
'drop table ',
'bar',
};
foo();
my $cat = "cat";
$cat =~ s/cat/dog/g;
use strict;
use warnings;
use DBI;
use Carp;
use TBB::ID;
use TBB::ClientSystemData;
use TBB::UserData;
use TBB::DataManager::Relational;
use TBB::UserManager;
use TBB::LogManager "write_log";
use Apache::Session::Postgres;
use Config::General;
use Data::Dumper;
use Config::General;
use DBI;
=head1 NAME
TBB::Reporting
=head1 SYNOPSIS
use TBB::UserData
my $reporting = TBB::Reporting->();
...
$reporting->populate();
=head1 DESCRIPTION
This class populates a data_by_user table, which aliases some
userdata IDs (in particular questions, formulas and conditions) to
names given to them by site-relations in the "user_data_alias"
table.
After instantiating this method, run populate to create the table.
What happens, in order, is this:
1. grab the user_data_alias data
2. verify (via the RM) that each resource exists; if so add it to our aliases
3. drop the old data_by_user table
4. create a new one using the aliases
5. get a list of all sessions
6. for each session:
a. figure out which client it is, and create a userdata
b. get values for all aliases (default value: "")
c. insert a row into data_by_user for this client
7. done
TODO: populate should dump out the old data_by_user first as a
backup, and maybe even automatically restore it if something fails
(but probably not).
TODO: less stuff should probably be hardcoded, even though our
setup here kind of sucks and is kind of temporary.
=cut
sub new {
my $class = shift;
my %opts = @_;
my $self = {};
bless($self, $class);
$self->connect_to_userdata_db();
$self->build_resource_manager();
$self->get_reporting_aliases();
return $self;
}
# this creates a connection to the userdata db and stores it as $self->{dmr}
# currently the settings are hardcoded cause i want it to work
sub connect_to_userdata_db {
my $self = shift;
my $host = "date.tbb";
my $port = 5432;
my $db = "tbb_tbbv2db_main";
my $user = "postgres";
my $password = "";
my $options = "";
write_log('debug', "DB params:");
write_log('debug', "\tHost: $host");
write_log('debug', "\tPort: $port");
write_log('debug', "\tDB: $db");
write_log('debug', "\tUser: $user");
write_log('debug', "\tPassword: $password");
write_log('debug', "\tOptions: $options");
$self->{dmr} = TBB::DataManager::Relational->new(
host => $host,
port => $port,
db => $db,
user => $user,
password => $password,
);
}
# this builds a resource manager if one doesn't already exist
sub build_resource_manager {
my $self = shift;
unless(defined($TBB::BenefitDelivery::ResourceManager)) {
my $rm = TBB::BenefitDelivery::ResourceManager->new('resource_dir' => 'resources');
$TBB::BenefitDelivery::ResourceManager = $rm;
}
}
sub blah {
foo()
unless(1);
}
print 'hi\n';
# this gets an array of hash references, each of which represents a userdata alias
# it stores the result in $self->{aliases}
#
# currently it hits a seperate database from the userdata db. eventually, we'd like
# the restore DB and the reporting DB to be the same. sigh.
sub get_reporting_aliases {
my $self = shift;
my $rdmr = TBB::DataManager::Relational->new(
host => "reports.v2.tbb",
port => 5432,
db => "reporting",
user => "tbbv2db",
password => "reports",
);
my $aliases_aref = $rdmr->select(select => "alias, question, type",
from => "user_data_alias");
$self->{aliases} = [];
# make sure each alias is valid; undefined formulas or conditions will give
# us problems down the road
foreach my $alias (@$aliases_aref) {
eval {
my $id = TBB::ID::normalize($alias->{question});
$alias->{question} = $id;
if(TBB::ID::is_a($id, "question")) {
push(@{$self->{aliases}}, $alias);
} elsif($TBB::BenefitDelivery::ResourceManager->get_component($id)) {
push(@{$self->{aliases}}, $alias);
} else {
write_log("error", "Alias \"$alias->{question}\" does not exist");
}
};
if($@) {
write_log("error", "There was a problem with \"$alias->{question}\": $@");
}
}
# this will help to make sure that the exports for each user are proceeding
# correctly
write_log("notice", "We are reporting on " . scalar(@{$self->{aliases}}) . " aliases.");
}
# this returns an sql string which will create the appropriate data_by_user table
# we do this seperately because we're not always sure where to create the table
# (date.tbb? reports.v2.tbb? who knows?) so hopefully this will make the code
# cleaner
sub data_by_user_sql {
my $self = shift;
my $sql = "CREATE TABLE data_by_user (id_user integer PRIMARY KEY, ";
$sql .= join(", ", map { "$_->{alias} $_->{type}" } @{$self->{aliases}});
$sql .= ");";
return $sql;
}
# the big one!
sub populate {
my $self = shift;
my %opts = @_;
write_log('notice', "Starting populate");
# connect to reporting db, and drop the old data_by_user
my $rdbh = DBI->connect('dbi:Pg:dbname=tbb_tbbv2db_main;host=date.tbb;port=5432',
'postgres',
'',
{RaiseError => 1});
eval { $rdbh->do("DROP TABLE data_by_user;"); };
# build new data_by_user table
my $sql = $self->data_by_user_sql();
print STDERR "FFF: $sql\n";
$rdbh->do($sql);
print STDERR "GGG: we are ok\n";
#exit(1);
my @report_fields = map {$_->{alias}} @{$self->{aliases}};
push(@report_fields, "id_user");
@report_fields = sort(@report_fields);
my @dummy_fields = map { "?" } @report_fields;
$sql = "INSERT INTO data_by_user (" . join(", ", @report_fields) . ") VALUES (" . join(", ", @dummy_fields) . ");";
#print STDERR "JJJ: $sql\n";
my $sth = $rdbh->prepare($sql);
#exit(1);
# for each client user, grab their system_data_id (which is
# a session ID); we get an array of session_id references.
my $fields = "id_user, system_data_id";
my $table = "tbb_user";
my $where = "id_user_type = 'CL' and system_data_id is not NULL";
my $session_ids = $self->{dmr}->select(select => $fields,
from => $table,
where => $where);
# for each hash in the array we made (each session ID)
my $processed = 0;
my $total = scalar(@$session_ids);
foreach my $session_id (@$session_ids) {
$processed++;
my $system_id = $session_id->{system_data_id};
my $client_id = $session_id->{id_user};
write_log('info', "Exporting $system_id (user: $client_id) ($processed/$total)");
# we need to see if there is a session ID or not in the
# sessions table. there almost certainly won't be more
# than one but we test anyway. unless there is exactly
# one we will skip this session.
my $check = $self->{dmr}->select(select => "id",
from => "sessions",
where => "id = '$system_id'");
my $count = scalar(@$check);
if($count == 0) {
write_log('warn', "Session $system_id does not exist");
next;
} elsif($count > 1) {
write_log('warn', "Session $system_id is not unique ($count found)");
next;
}
my $csd = TBB::ClientSystemData->new($system_id, "reporter");
my $dms = $csd->retrieve_data_manager_session();
my $user_data = TBB::UserData::New->new(data_manager_relational => $self->{dmr},
data_manager_session => $dms,
client_system_data => $csd,
current_client_id => $client_id);
my $user_data_obj = {'id_user' => $client_id};
foreach my $alias_href (@{$self->{aliases}}) {
my $alias = $alias_href->{alias};
my $id = $alias_href->{question};
my $type = $alias_href->{type};
my $value = $user_data->retrieve_value(base => $id,
this_id_user => $client_id);
$value ||= "";
$user_data_obj->{$alias} = $value;
}
my @values = ();
foreach my $name (@report_fields) {
push(@values, $user_data_obj->{$name});
}
$sth->execute(@values);
write_log('debug', " Saving " . scalar(keys(%$user_data_obj)) . " components") if TBB::LogManager::writes_at('debug');
#write_log('debug', " User Data Obj: " . Dumper($user_data_obj)) if TBB::LogManager::writes_at('debug');
}
write_log('notice', "Populate completed");
return 1;
}
1;