pmacs3/code_examples/Reporting2.pm

322 lines
9.9 KiB
Perl
Raw Normal View History

2007-03-06 10:05:38 -05:00
package TBB::Reporting2;
2007-07-14 10:21:22 -04:00
my $bar =~ s/foob/blag/g;
2007-07-15 10:30:41 -04:00
sub foo {
bar()
unless 9 && 3;
2007-07-15 10:30:41 -04:00
}
#@@:heredoc:sql
2008-04-06 22:31:13 -04:00
#@@:heredoc.string:xml
2007-07-16 18:43:11 -04:00
my $s = <<EOT;
2008-04-06 22:31:13 -04:00
select '<foo attr="3">bar bar</foo>';
2007-07-16 18:43:11 -04:00
drop table foog;
insert into mytable (col1, col2, "col3") values (99, 33, 1234);
select cast(plunk as timestamp) from blarg join plarg using(id_what) where x = 3;
2007-07-16 18:43:11 -04:00
EOT
2007-08-22 12:32:32 -04:00
# gwiejgwe gwe gwe gwejig weig weig wegji weg weig wegi wegjiwe gjweig weig
# wejig wejgi wejgiwe jgiwe gjiwej gwei gweig jweig jweig wig wejgiewj ge giwej
# gweijg weigj weigjwe giwej gwe
# 1. gewj gweig weigweigewiiiiiiiiiiiiiiiiiiiii iiiiiiiiiiiii iiiigewigweigwi
# iweigiwigigewigewgweigi
# 2. gweii XXXXX a e gwejgiwe jiaw jhw
# gwe gjiwegij wegiwe jgiwe giwej gweigj wiegjwei gjweig weigj weig jwegi
# wejgiwe jgiweg jweigewgj we gwee e e e ee e
2007-06-19 14:45:51 -04:00
my $foo = {
#@@:perl_string:sql
'drop table foogy;',
2007-06-19 14:45:51 -04:00
'bar',
};
foo();
2007-06-12 18:05:09 -04:00
my $cat = "cat";
$cat =~ s/cat/dog/g;
2007-03-06 10:05:38 -05:00
use strict;
use warnings;
use DBI;
use Carp;
2007-03-06 10:05:38 -05:00
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
2007-08-23 10:51:05 -04:00
TBB::Reporting
2007-03-06 10:05:38 -05:00
=head1 SYNOPSIS
use TBB::UserData
my $reporting = TBB::Reporting->();
...
$reporting->populate();
=head1 DESCRIPTION
2007-08-23 10:51:05 -04:00
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.
2007-03-06 10:05:38 -05:00
2007-08-23 10:51:05 -04:00
After instantiating this method, run populate to create the table.
2007-03-06 10:05:38 -05:00
2007-08-23 10:51:05 -04:00
What happens, in order, is this:
2007-03-06 10:05:38 -05:00
2007-08-23 10:51:05 -04:00
1. grab the user_data_alias data
2. verify (via the RM) that each resource exists; if so add it to aliases
2007-03-06 10:05:38 -05:00
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
2007-08-23 10:51:05 -04:00
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).
2007-03-06 10:05:38 -05:00
2007-08-23 10:51:05 -04:00
TODO: less stuff should probably be hardcoded, even though our setup here kind
of sucks and is kind of temporary.
2007-03-06 10:05:38 -05:00
=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()
2007-07-15 10:30:41 -04:00
unless(1);
}
2007-03-06 10:05:38 -05:00
print 'hi\n';
2007-03-06 10:05:38 -05:00
# 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(
2007-03-29 18:37:34 -04:00
host => "reports.v2.tbb",
port => 5432,
db => "reporting",
user => "tbbv2db",
2007-03-06 10:05:38 -05:00
password => "reports",
);
my $aliases_aref = $rdmr->select(select => "alias, question, type",
2007-03-29 18:37:34 -04:00
from => "user_data_alias");
2007-03-06 10:05:38 -05:00
$self->{aliases} = [];
# make sure each alias is valid; undefined formulas or conditions will give
# us problems down the road
foreach my $alias (@$aliases_aref) {
2007-03-29 18:37:34 -04:00
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}\": $@");
2007-03-06 10:05:38 -05:00
}
}
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
# 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;
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
my $sql = "CREATE TABLE data_by_user (id_user integer PRIMARY KEY, ";
$sql .= join(", ", map { "$_->{alias} $_->{type}" } @{$self->{aliases}});
$sql .= ");";
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
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;"); };
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
# 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);
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
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);
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
# 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);
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
# 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++;
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
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)");
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
# 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;
}
2007-03-29 18:37:34 -04:00
2007-03-06 10:05:38 -05:00
my $csd = TBB::ClientSystemData->new($system_id, "reporter");
2007-03-29 18:37:34 -04:00
my $dms = $csd->retrieve_data_manager_session();
2007-03-06 10:05:38 -05:00
my $user_data = TBB::UserData::New->new(data_manager_relational => $self->{dmr},
2007-03-29 18:37:34 -04:00
data_manager_session => $dms,
client_system_data => $csd,
current_client_id => $client_id);
2007-03-06 10:05:38 -05:00
my $user_data_obj = {'id_user' => $client_id};
2007-03-29 18:37:34 -04:00
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;
2007-03-06 10:05:38 -05:00
}
2007-03-29 18:37:34 -04:00
my @values = ();
foreach my $name (@report_fields) {
push(@values, $user_data_obj->{$name});
}
$sth->execute(@values);
2007-03-06 10:05:38 -05:00
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;