mvhub-dev team mailing list archive
-
mvhub-dev team
-
Mailing list archive
-
Message #00088
[Merge] lp:~omacneil/mvhub/remove_ded_code into lp:mvhub
Dan MacNeil has proposed merging lp:~omacneil/mvhub/remove_ded_code into lp:mvhub.
Requested reviews:
mvhub-dev (mvhub-dev)
removed dead code, stuff that isn't being called
--
https://code.launchpad.net/~omacneil/mvhub/remove_ded_code/+merge/23556
Your team mvhub-dev is subscribed to branch lp:mvhub.
=== removed file 'app-mvhub/bin/generate_agency_usage_reports.pl'
--- app-mvhub/bin/generate_agency_usage_reports.pl 2009-12-18 18:09:42 +0000
+++ app-mvhub/bin/generate_agency_usage_reports.pl 1970-01-01 00:00:00 +0000
@@ -1,423 +0,0 @@
-#!/usr/bin/perl -w
-
-# $Revision: 1467 $
-
-# generate_agency_usage_reports.pl
-#
-# This script, called via cron, generates
-# per-agency usage reports in both
-# HTML and text formats and puts them
-# into the location listed in$MVHub::Common::AGENCY_USAGE_REPORTS_PATH.
-#
-# The duration of the reports is currently fixed at 1 and 6 months,
-# but could potentially be configured if there's a demand for it.
-
-use strict;
-use warnings;
-
-# Is DateTime generating warnings at compile time?
-# In particular, warnings from Set::Array?
-use DateTime;
-use HTML::Template;
-
-use MVHub::Common;
-
-my $HTML_REPORT_TEMPLATE = "agency_usage_report_html.tmpl";
-my $TEXT_REPORT_TEMPLATE = "agency_usage_report_text.tmpl";
-
-my $HTML_SUMMARY_TEMPLATE = "usage_summary_report_html.tmpl";
-my $TEXT_SUMMARY_TEMPLATE = "usage_summary_report_text.tmpl";
-
-my $HTML_REPORT_PATH = "FIXME/reports/agency_usage_reports/html/";
-my $TEXT_REPORT_PATH = "FIXME/reports/agency_usage_reports/text/";
-
-my $HTML_FILE_EXT = ".inc";
-my $TEXT_FILE_EXT = ".txt";
-
-# Get date information and put it into a Postgres-friendly format.
-my $dt = DateTime->now();
-my $today = join( '-', $dt->year(), $dt->month(), $dt->day() );
-
-$dt = $dt->subtract( months => 1 );
-my $one_month_ago = join( '-', $dt->year(), $dt->month(), $dt->day() );
-
-$dt = $dt->subtract( months => 5 );
-my $six_months_ago = join( '-', $dt->year(), $dt->month(), $dt->day() );
-
-my $dbh = MVHub::Utils::DB::get_dbh();
-
-# Since the relationship between programs and categories isn't even close to being
-# one-to-one, it makes sense to compile usage stats for the categories independent
-# of anything else. This way we only make an SQL query once for a given category
-# rather than once for each program that uses the category.
-my $sql
- = "SELECT category_id, category_name FROM category ORDER BY category_name";
-my $categories_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-
-# This is the big performance bottleneck--takes 30+ minutes to run.
-my $categories_usage_href = {};
-foreach my $category_href (@$categories_aref) {
- my $category_id = $category_href->{category_id};
- my $category_name = $category_href->{category_name};
- $sql
- = "SELECT "
- . $dbh->quote($category_name)
- . " as category_name, * FROM "
- . "(SELECT COUNT(*) as one_month FROM web_requests WHERE file ~* 'rm=show_program_results' AND file ~* 'category_id=$category_id' AND date >= "
- . $dbh->quote($one_month_ago)
- . " ) as subq1, "
- . "(SELECT COUNT(*) as six_months FROM web_requests WHERE file ~* 'rm=show_program_results' AND file ~* 'category_id=$category_id' AND date >= "
- . $dbh->quote($six_months_ago)
- . " ) as subq2 ";
- my $category_usage_href = $dbh->selectrow_hashref($sql);
- $categories_usage_href->{$category_id} = $category_usage_href;
-}
-
-my %agencies = MVHub::Utils::DB::get_hash_of_agencies();
-foreach my $agency_id ( keys %agencies ) {
- my $agency_name = $agencies{$agency_id};
- my $agency_href = MVHub::Utils::DB::select_agency_record($agency_id);
- my $programs_aref
- = MVHub::Utils::DB::select_agency_programs( agency_id => $agency_id );
-
- # Agency usage stats
- my $or_conditions = generate_or_conditions($programs_aref);
- $sql
- = "SELECT 'Visits to detailed agency page:' as report_type, * FROM "
- . "(SELECT COUNT(*) as one_month FROM web_requests WHERE file ~* 'rm=show_agency' AND file ~* 'agency_id=$agency_id' AND date >= "
- . $dbh->quote($one_month_ago)
- . " ) as subq1, "
- . "(SELECT COUNT(*) as six_months FROM web_requests WHERE file ~* 'rm=show_agency' AND file ~* 'agency_id=$agency_id' AND date >= "
- . $dbh->quote($six_months_ago)
- . " ) as subq2 ";
-
-# $sql is split into two pieces to avoid errors if the agency doesn't have a website listed.
- $sql
- .= "UNION "
- . "SELECT 'Clicks from MVHub to agency website:' as report_type, * FROM \n"
- . "(SELECT COUNT(*) as one_month FROM web_requests WHERE file ~* 'rm=redirect' AND \n"
- . "(file ~* 'agency_id=$agency_id' \n"
- . $or_conditions . " ) \n"
- . " AND date >= "
- . $dbh->quote($one_month_ago)
- . " ) as subq3,\n"
- . "(SELECT COUNT(*) as six_months FROM web_requests WHERE file ~* 'rm=redirect' AND \n"
- . "(file ~* 'agency_id=$agency_id' \n"
- . $or_conditions . " ) \n"
- . "AND date >= "
- . $dbh->quote($six_months_ago)
- . " ) as subq4"
- if defined $agency_href->{website};
-
- my $agency_usage_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-
- # So the stats appear in a different order.
- @$agency_usage_aref = reverse @$agency_usage_aref;
-
- # Per-program usage stats
- my $programs_usage_aref = [];
- foreach my $program_href (@$programs_aref) {
- my $program_id = $program_href->{program_id};
- my $program_name = $program_href->{program_name};
- $sql
- = "SELECT 'Visits to detailed program page:' as report_type, * FROM "
- . "(SELECT COUNT(*) as one_month FROM web_requests WHERE file ~* 'rm=show_program' AND file ~* 'program_id=$program_id' AND date >= "
- . $dbh->quote($one_month_ago)
- . " ) as subq1, "
- . "(SELECT COUNT(*) as six_months FROM web_requests WHERE file ~* 'rm=show_program' AND file ~* 'program_id=$program_id' AND date >= "
- . $dbh->quote($six_months_ago)
- . " ) as subq2 ";
-
- my $program_usage_href = $dbh->selectrow_hashref($sql);
- $program_usage_href->{program_id} = $program_id;
- $program_usage_href->{program_name} = $program_name;
-
- # Get the program's categories
- $sql = "SELECT pc.category_id FROM program_category pc "
- . "WHERE pc.program_id = $program_id";
- my $program_categories_aref = $dbh->selectcol_arrayref($sql);
-
- my $category_stats_aref = [];
- foreach my $category_id (@$program_categories_aref) {
- push @$category_stats_aref,
- $categories_usage_href->{$category_id};
- }
- $category_stats_aref
- = [ sort { "\L$a->{category_name}" cmp "\L$b->{category_name}" }
- @$category_stats_aref ];
- $program_usage_href->{category_stats} = $category_stats_aref;
-
- push @$programs_usage_aref, $program_usage_href;
- }
-
- # Generate output
- # Not dying on bad params because in certain cases I want only some of a
- # loop's variables.
- my $html_tmpl = HTML::Template->new(
- filename => $HTML_REPORT_TEMPLATE,
- die_on_bad_params => 0,
- );
-
- my $text_tmpl = HTML::Template->new(
- filename => $TEXT_REPORT_TEMPLATE,
- die_on_bad_params => 0,
- );
-
- # Need to create a template variable for dates....
-
- foreach ( $html_tmpl, $text_tmpl ) {
- $_->param(
- agency_name => $agency_name,
- agency_id => $agency_id,
- agency_usage_stats => $agency_usage_aref,
- programs_usage_stats => $programs_usage_aref
- );
- }
-
- open HTML_REPORT, ">$HTML_REPORT_PATH$agency_id$HTML_FILE_EXT"
- or warn
- "Couldn't open HTML template file for agency_id $agency_id: $!";
- print HTML_REPORT $html_tmpl->output();
- close HTML_REPORT;
-
- open TEXT_REPORT, ">$TEXT_REPORT_PATH$agency_id$TEXT_FILE_EXT"
- or warn
- "Couldn't open text template file for agency_id $agency_id: $!";
- print TEXT_REPORT $text_tmpl->output();
- close TEXT_REPORT;
-
-}
-
-#
-# Summary reports
-#
-
-# Stats for youth categories. Since we've already compiled stats for
-# all the categories, getting these is just a matter of putting the
-# existing info into an arrayref.
-$sql
- = "SELECT c.category_name, hc.category_id FROM category c, heading_category hc WHERE hc.heading_name = 'Youth' AND c.category_id = hc.category_id ORDER BY c.category_name";
-my $youth_categories_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-my $youth_categories_usage_aref = [];
-foreach my $youth_category_href (@$youth_categories_aref) {
- my $category_id = $youth_category_href->{category_id};
- push @$youth_categories_usage_aref,
- $categories_usage_href->{$category_id};
-}
-
-# Most-viewed programs
-#
-# This will be a bit more difficult since the reports aren't really indexed by agency,
-# program, or category id. Still doable, however.
-# TODO: normalize database so that report generation is scalable to many more agencies.
-
-# The big problem here is that I've kept the search phrases around, so a request for:
-#
-# /cgi-bin/guide/guide.pl?rm=show_agency&agency_id=111111&search_phrase=abcdefg
-#
-# is different (to the database, at least) than:
-#
-# /cgi-bin/guide/guide.pl?rm=show_agency&agency_id=111111
-#
-# I suppose a way around this is to grab all the info, then sum the counts as
-# necessary, ignoring the search phrase. So basically I'll want a hash of the form
-# $agency_hits{$agency_id} = $num_hits,
-# and increment $num_hits as necessary. It might require a bit of pattern matching, but
-# that's ok.
-#
-# Since I'm going to be doing this process four times, it makes sense to write a subroutine
-# to return a hashref, after first handling the initial arrayref returned from the database.
-
-# Three most-viewed agencies, one month
-$sql
- = "SELECT file, COUNT(*) FROM web_requests "
- . "WHERE file ~* 'rm=show_agency' AND date >= "
- . $dbh->quote($one_month_ago)
- . " GROUP BY file ORDER BY count DESC";
-my $most_viewed_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-my $agencies_one_month_href = sum_like_web_requests($most_viewed_aref);
-my @agencies_one_month
- = ( sort { $b->{hits} <=> $a->{hits} } values %$agencies_one_month_href )
- [ 0 .. 2 ];
-
-# Three most-viewed agencies, six months
-$sql
- = "SELECT file, COUNT(*) FROM web_requests "
- . "WHERE file ~* 'rm=show_agency' AND date >= "
- . $dbh->quote($six_months_ago)
- . " GROUP BY file ORDER BY count DESC";
-$most_viewed_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-my $agencies_six_months_href = sum_like_web_requests($most_viewed_aref);
-my @agencies_six_months
- = ( sort { $b->{hits} <=> $a->{hits} } values %$agencies_six_months_href )
- [ 0 .. 2 ];
-
-# Five most-viewed programs, one month
-$sql
- = "SELECT file, COUNT(*) FROM web_requests "
- . "WHERE file ~* 'rm=show_program' AND date >= "
- . $dbh->quote($one_month_ago)
- . " GROUP BY file ORDER BY count DESC";
-$most_viewed_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-my $programs_one_month_href = sum_like_web_requests($most_viewed_aref);
-my @programs_one_month
- = ( sort { $b->{hits} <=> $a->{hits} } values %$programs_one_month_href )
- [ 0 .. 4 ];
-
-# Five most-viewed programs, six months
-$sql
- = "SELECT file, COUNT(*) FROM web_requests "
- . "WHERE file ~* 'rm=show_program' AND date >= "
- . $dbh->quote($six_months_ago)
- . " GROUP BY file ORDER BY count DESC";
-$most_viewed_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-my $programs_six_months_href = sum_like_web_requests($most_viewed_aref);
-my @programs_six_months
- = ( sort { $b->{hits} <=> $a->{hits} } values %$programs_six_months_href )
- [ 0 .. 4 ];
-
-# Get a list of all programs so we can compare it against the list of viewed programs
-$sql = "SELECT program_id FROM program ORDER BY program_id";
-my $full_programs_list_aref = $dbh->selectcol_arrayref($sql);
-
-# Programs with no views, one month
-my $unvisited_programs_one_month_aref
- = find_unvisited_programs( $programs_one_month_href,
- $full_programs_list_aref );
-
-# Programs with no views, six months
-my $unvisited_programs_six_months_aref
- = find_unvisited_programs( $programs_six_months_href,
- $full_programs_list_aref );
-
-# Generate actual output
-my $html_summary_tmpl = HTML::Template->new(
- filename => $HTML_SUMMARY_TEMPLATE,
- global_vars => 0,
- die_on_bad_params => 0
-);
-my $text_summary_tmpl = HTML::Template->new(
- filename => $TEXT_SUMMARY_TEMPLATE,
- global_vars => 0,
- die_on_bad_params => 0
-);
-
-foreach ( $html_summary_tmpl, $text_summary_tmpl ) {
- $_->param(
- youth_categories => $youth_categories_usage_aref,
- agencies_one_month => \@agencies_one_month,
- agencies_six_months => \@agencies_six_months,
- programs_one_month => \@programs_one_month,
- programs_six_months => \@programs_six_months,
- unvisited_one_month => $unvisited_programs_one_month_aref,
- unvisited_six_months => $unvisited_programs_six_months_aref
- );
-}
-
-open HTML_SUMMARY, ">${HTML_REPORT_PATH}summary$HTML_FILE_EXT";
-print HTML_SUMMARY $html_summary_tmpl->output();
-close HTML_SUMMARY;
-
-open TEXT_SUMMARY, ">${TEXT_REPORT_PATH}summary$TEXT_FILE_EXT";
-print TEXT_SUMMARY $text_summary_tmpl->output();
-close TEXT_SUMMARY;
-
-#
-# Subroutines
-#
-
-sub find_unvisited_programs {
- my $visited_programs_href = shift;
- my $full_programs_list_aref = shift;
- my @unvisited_programs;
-
- foreach my $program_id (@$full_programs_list_aref) {
- my $program_name = MVHub::Utils::DB::get_program_name($program_id);
- $program_name = $program_id unless defined $program_name;
- push(
- @unvisited_programs,
- { program_name => $program_name,
- agency_name => program_id_to_agency_name($program_id)
- }
- ) unless defined $visited_programs_href->{$program_id};
- }
-
- @unvisited_programs = sort { $a->{program_name} cmp $b->{program_name} }
- @unvisited_programs;
- return \@unvisited_programs;
-}
-
-# Generates a whole slew of SQL OR conditions for the agency usage reports,
-# in particular, for tracking clicks from MVHub to an agency's website.
-sub generate_or_conditions {
- my $programs_aref = shift;
- my $or_conditions;
- foreach my $program_href (@$programs_aref) {
- $or_conditions .= " OR file ~* 'program_id="
- . $program_href->{program_id} . "' ";
- }
-
-# In case an agency doesn't have any programs, this prevents the script from generating
-# string error/concatenation warnings.
- if ( defined $or_conditions ) { return $or_conditions; }
- else { return ""; }
-}
-
-# Takes a program id, returns an agency name
-sub program_id_to_agency_name {
- my $program_id = shift;
- my $dbh = MVHub::Utils::DB::get_dbh();
- my $sql = "SELECT agency_id FROM program WHERE program_id = "
- . $dbh->quote($program_id);
- my @agency_id_array = $dbh->selectrow_array($sql);
- my $agency_id = $agency_id_array[0];
- my $agency_name = MVHub::Utils::DB::get_full_name($agency_id)
- if $agency_id;
-
-# Return an agency id if there's no matching agency name (as would be the case for
-# a deleted agency)
- if ( defined $agency_name ) { return $agency_name; }
- else { return $program_id; }
-}
-
-# Takes similar URLs (perhaps just with different search phrases)
-# and sums their hits, returning a hashref of the form
-# $hashref->{id} = num_hits
-sub sum_like_web_requests {
- my $requests_aref = shift;
- my %requests;
- foreach my $request_href (@$requests_aref) {
- my $id;
- if ( $request_href->{file} =~ /rm=show_agency/
- && $request_href->{file} =~ /agency_id=(\d+)/ )
- {
- $id = $1;
- }
- elsif ($request_href->{file} =~ /rm=show_program/
- && $request_href->{file} =~ /program_id=(\d+)/ )
- {
- $id = $1;
- }
- else {
- next;
- }
-
- $requests{$id} = {} unless defined $requests{$id};
- $requests{$id}->{hits} = 0 unless defined $requests{$id}->{hits};
- $requests{$id}->{hits} += $request_href->{count};
- if ( $request_href->{file} =~ /show_agency/ ) {
- $requests{$id}->{name} = MVHub::Utils::DB::get_full_name($id);
- }
- elsif ( $request_href->{file} =~ /show_program/ ) {
- $requests{$id}->{name} = MVHub::Utils::DB::get_program_name($id);
- }
- $requests{$id}->{name} = $id
- unless defined $requests{$id}->{name}
- && $requests{$id}->{name} !~ /^\s*$/;
- $requests{$id}->{agency_name} = program_id_to_agency_name($id)
- if $request_href->{file} =~ /show_program/;
- }
-
- return \%requests;
-}
-
=== removed file 'app-mvhub/bin/snailmail_welcome.pl'
--- app-mvhub/bin/snailmail_welcome.pl 2009-12-07 20:00:37 +0000
+++ app-mvhub/bin/snailmail_welcome.pl 1970-01-01 00:00:00 +0000
@@ -1,198 +0,0 @@
-#!/usr/bin/perl
-
-# $Revision: 1467 $
-
-use strict;
-use warnings;
-use DBI;
-use HTML::Template;
-
-use lib '../../cgi-bin/guide';
-use MVHub::Common;
-
-my $AGENCY_MAIL_TEMPLATE = './snailmail_agency_welcome.tmpl';
-my $PROGRAM_MAIL_TEMPLATE = './snailmail_program_welcome.tmpl';
-
-# Definitions:
-#
-# We assert that a contact is uniquely identified by its first name, last name,
-# email address and agency_id.
-#
-# ac = agency contact (who may also be the contact for one or more program(s)
-# pc = program contact (who is NOT also the agency contact)
-
-#TESTING: at least:
-# 1 agency with 1 program - sharing 1 contact
-# 1 agency with multiple programs - sharing 1 contact
-# 1 agency with 1 program - 2 contacts
-# 1 agency with multiple programs - multiple contacts, including ac
-# 1 agency with multiple programs - multiple contacts, excluding ac
-# 1 agency with no programs - make sure this doesn't break anything
-
-# Use above descriptions as the agency name.
-
-#TODO:
-#Exclude unknowns. First, we probably want to standardize markers for unknowns in current data.
-
-{
- print("<html><body>");
- my $dbh = MVHub::Utils::DB::get_dbh();
-
- # Fetch all agencies.
- my $sql = "SELECT * from agency";
- my $agencies_aref = $dbh->selectall_arrayref( $sql, { Slice => {} } );
-
- # For each agency:
- # - extract identifying contact info (i.e. contact_first_name,
- # contact_last_name, and contact_email)
- # - Fetch all its programs into 2 distinct groups:
- # - (group 1): those with same contact as agency
- # - (group 2): those with different contact than agency contact
-
- foreach my $agency_href (@$agencies_aref) {
- my $agency_id = $agency_href->{agency_id};
- my $password = $agency_href->{password};
- my $agency_name = $agency_href->{agency_name};
- my $ac_first_name = $agency_href->{contact_first_name};
- my $ac_last_name = $agency_href->{contact_last_name};
- my $ac_email = $agency_href->{contact_email};
-
- # GET THE DATA FOR THE AGENCY CONTACT MAIL
- # Get the program names for this agency that ARE owned by the agency contact
- my $sql
- = "SELECT program_name FROM program WHERE agency_id = ? AND contact_first_name = ? AND contact_last_name = ? AND contact_email = ?";
- my @names_of_programs_owned_by_ac = @{
- $dbh->selectcol_arrayref(
- $sql, undef, $agency_id,
- $ac_first_name, $ac_last_name, $ac_email
- )
- };
-
- # Get the programs for this agency that are NOT owned by the agency contact
- $sql
- = 'SELECT program_name, contact_first_name, contact_last_name, contact_email FROM program WHERE agency_id = ? AND NOT (contact_first_name = ? AND contact_last_name = ? AND contact_email = ?) ORDER BY contact_last_name, contact_first_name, program_name';
- my @programs_owned_by_pcs = @{
- $dbh->selectall_arrayref(
- $sql, { Slice => {} }, $agency_id,
- $ac_first_name, $ac_last_name, $ac_email
- )
- };
-
- add_welcome_to_ac( $ac_first_name, $ac_last_name, $agency_name,
- $password, \@names_of_programs_owned_by_ac,
- \@programs_owned_by_pcs, $ac_email );
-
- if ( !@names_of_programs_owned_by_ac && !@programs_owned_by_pcs ) {
-
- #TODO: whom should we be warning: ourselves or the agency contact?!
- warn("The [$agency_name] agency has no programs!");
- }
-
- # MAIL THE PROGRAM CONTACT(S), if any
- next if !@programs_owned_by_pcs;
-
-# Get the program contacts (who are not also the agency contact) for our agency
- $sql
- = 'SELECT DISTINCT contact_first_name, contact_last_name, contact_email FROM program WHERE agency_id = ? AND NOT (contact_first_name = ? AND contact_last_name = ? AND contact_email = ?)';
- my $pcs_aref = $dbh->selectall_arrayref( $sql, { Slice => {} },
- $agency_id, $ac_first_name, $ac_last_name, $ac_email );
-
- # Get the program name(s) owned by this program contact
- foreach my $pc_href (@$pcs_aref) {
- $sql
- = 'SELECT program_name FROM program WHERE agency_id = ? AND contact_first_name = ? AND contact_last_name = ? AND contact_email = ?';
- my $program_names_aref = $dbh->selectall_arrayref(
- $sql,
- { Slice => {} },
- $agency_id,
- $pc_href->{contact_first_name},
- $pc_href->{contact_last_name},
- $pc_href->{contact_email}
- );
-
- add_welcome_to_pc( $agency_name, $password, $pc_href,
- $program_names_aref );
- }
-
- } # end of: for each agency
- print("</body></html>");
-}
-
-# Either of the program arefs could be empty. If both are empty, we have an
-# agency without a program. Issue a warning.
-sub add_welcome_to_ac {
- my ($ac_first_name, $ac_last_name,
- $agency_name, $password,
- $names_of_programs_owned_by_ac_aref, $programs_owned_by_pcs_aref,
- $ac_email_address
- ) = @_;
-
- my $subject
- = "$ac_first_name, please update your $agency_name information";
- my $names_of_programs_owned_by_ac;
- if ( @$names_of_programs_owned_by_ac_aref == 1 ) {
- $names_of_programs_owned_by_ac
- = "($$names_of_programs_owned_by_ac_aref[0])";
- }
- elsif ( @$names_of_programs_owned_by_ac_aref > 1 ) {
- $names_of_programs_owned_by_ac
- = ":<br>\n\t - "
- . join( "<br>\n\t - ",
- @$names_of_programs_owned_by_ac_aref )
- . "<br>\n";
- }
-
- my $tmpl = HTML::Template->new( filename => $AGENCY_MAIL_TEMPLATE )
- or die "Failed to open $AGENCY_MAIL_TEMPLATE template";
- $tmpl->param(
- first_name => $ac_first_name,
- last_name => $ac_last_name,
- agency_name => $agency_name,
- agency_contacts_programs => $names_of_programs_owned_by_ac,
- other_programs_loop => $programs_owned_by_pcs_aref,
- password => $password,
- contact_us_email => $MVHub::Common::HUB_EMAIL,
- contact_us_phone => $MVHub::Common::HUB_PHONE,
- signer => $MVHub::Common::HUB_ADMIN_NAME,
- team_name => $MVHub::Common::HUB_TEAM_NAME,
- );
- my $body = $tmpl->output();
- remove_excess_blank_lines( \$body );
- add_mail($body);
-}
-
-sub add_welcome_to_pc {
- my ( $agency_name, $password, $pc_href, $program_names_aref ) = @_;
- my $pc_first_name = $pc_href->{contact_first_name};
- my $pc_last_name = $pc_href->{contact_last_name};
- my $subject
- = "$pc_first_name, please update your $agency_name information";
- my $tmpl = HTML::Template->new( filename => $PROGRAM_MAIL_TEMPLATE )
- or die "Failed to open $PROGRAM_MAIL_TEMPLATE template";
-
- $tmpl->param(
- first_name => $pc_first_name,
- last_name => $pc_last_name,
- agency_name => $agency_name,
- programs_loop => $program_names_aref,
- password => $password,
- contact_us_email => $MVHub::Common::HUB_EMAIL,
- contact_us_phone => $MVHub::Common::HUB_PHONE,
- signer => $MVHub::Common::HUB_ADMIN_NAME,
- team_name => $MVHub::Common::HUB_TEAM_NAME,
- );
- my $body = $tmpl->output();
- remove_excess_blank_lines( \$body );
- add_mail($body);
-}
-
-sub remove_excess_blank_lines {
- my $body_ref = shift;
- $$body_ref =~ s/\n\s*\n\s*\n/\n\n/;
-}
-
-sub add_mail {
- my $body = shift;
- print $body;
- return;
-}
=== removed file 'app-mvhub/bin/weblogslurp.pl'
--- app-mvhub/bin/weblogslurp.pl 2009-12-07 20:00:37 +0000
+++ app-mvhub/bin/weblogslurp.pl 1970-01-01 00:00:00 +0000
@@ -1,257 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-
-# Revision: 1.1
-
-# weblogslurp.pl
-#
-# This program takes a web server log file (defaults to file
-# below, but customizable via command line) in CLF/ELF format,
-# reads it line by line using File::ReadBackwards, parses each
-# line using Parse::AccessLogEntry, storing
-# the log information into a hash, and finally puts this information into
-# the database of your choice (configured via MVHub::Common.pm). The amount of data to parse is
-# configurable via the command line, but the default is to add all entries newer than
-# the newest record already in the db.
-
-# Modules
-use Getopt::Long;
-use File::ReadBackwards;
-use DateTime;
-use Data::Dumper;
-use Parse::AccessLogEntry;
-use FindBin;
-
-use lib "$FindBin::Bin/../../cgi-bin/guide/";
-use MVHub::Common;
-
-# Config
-
-# Default logfile location
-#my $LOGFILE = "/var/log/apache/combined.log";
-my $LOGFILE = "/var/log/apache/sites/mvhub2/combined.log.resolved";
-
-# Ignore requests for these file extensions when parsing logs:
-my $FILE_SKIP_REGEX
- = qr/\.(gif|jpg|jpeg|css|ico|js|png|svg|txt|pdf|swf|mpeg|mp3)/i;
-
-# Ignore requests for these IP addresses/hostnames
-my $HOST_SKIP_REGEX
- = qr/(129\.63\.|10\.0\.0\.|\.inside|uml\.edu|mvwib\.org|thecsl\.org|communitysoftwarelab\.org)/i;
-
-# Default age of records to put into database.
-# Probably won't get used, but we have to have a default for when no
-# records are in the db.
-my $RECORD_AGE = 1;
-
-# Main
-
-my $cli_args_href = parse_command_line_info();
-usage() if $cli_args_href->{'help'};
-delete ${$cli_args_href}{'help'};
-
-my $settings_href = populate_settings($cli_args_href);
-
-# Remove old log entries from database (they can always be added later via
-# proper cli arguments)
-my $dbh = MVHub::Utils::DB::get_dbh();
-
-# Keep everything seven months and newer, just to be safe
-my $dt = DateTime->now();
-$dt->subtract( months => 7 );
-my $seven_months_ago = join( '-', $dt->year(), $dt->month(), $dt->day() );
-my $sql = "DELETE FROM web_requests WHERE date < "
- . $dbh->quote($seven_months_ago);
-$dbh->do($sql);
-
-# Begin reading through log file (set up loop)
-# Parse log entry with appropriate module, put into hash (via loop or map?)
-# End loop on proper date condition.
-my $logfile_obj = File::ReadBackwards->new( $settings_href->{'logfile'} )
- or die "Can't read log file $settings_href->{'logfile'}: $!";
-my $entry_parser = Parse::AccessLogEntry::new();
-$sql = "SELECT date FROM web_requests ORDER BY date DESC";
-my @newest_record_date_array = $dbh->selectrow_array($sql);
-my $newest_record_date = $newest_record_date_array[0];
-
-my $num_entries_added = 0;
-
-# Was getting some funny string errors from $entry_parser->parse, so trapping with eval.
-# Errors always came after the end of the log entries.
-while ( defined( my $log_entry = $logfile_obj->readline() ) ) {
-
- my $log_entry_href = $entry_parser->parse("$log_entry");
-
-# Don't bother logging files with specified extensions (mainly images and stylesheets)
- next
- if ( !defined $log_entry_href->{file}
- || $log_entry_href->{file} =~ $FILE_SKIP_REGEX );
-
- # Don't bother logging requests from specified IP addresses/hosts
- next
- if ( !defined $log_entry_href->{host}
- || $log_entry_href->{host} =~ $HOST_SKIP_REGEX );
-
- # Exit loop if log entry is too old
-
- # Surely there's a module for this or a DateTime function....
- my %month_conversions = (
- 'January' => '01',
- 'February' => '02',
- 'March' => '03',
- 'April' => '04',
- 'May' => '05',
- 'June' => '06',
- 'July' => '07',
- 'August' => '08',
- 'September' => '09',
- 'October' => 10,
- 'November' => 11,
- 'December' => 12
- );
-
- my ( $request_day, $request_month, $request_year ) = split "/",
- $log_entry_href->{'date'};
- foreach ( keys %month_conversions ) {
- my $month_name = $_;
- my $month_abbr = substr( $month_name, 0, 3 );
- if ( $request_month =~ /$month_abbr/i ) {
- $request_month = $month_conversions{$month_name};
- last;
- }
- }
- my ( $request_hour, $request_minute, $request_second ) = split ":",
- $log_entry_href->{'time'};
- my $request_time = DateTime->new(
- year => $request_year,
- month => $request_month,
- day => $request_day,
- hour => $request_hour,
- minute => $request_minute,
- second => $request_second,
- time_zone => $log_entry_href->{'diffgmt'}
- );
- my $request_cutoff_time;
-
-# You would think that Getopt::Long would parse the 'age' option correctly....
-# Since that isn't happening, checking @ARGV for it.
- if ( grep /^(-a|--age)$/i, @ARGV ) {
- print "hello";
- $request_cutoff_time = DateTime->now();
- $request_cutoff_time->subtract(
- DateTime::Duration->new( days => $settings_href->{'age'} ) );
- }
- else {
- if ( defined $newest_record_date ) {
- $request_cutoff_time = DateTime->new(
- year => substr( $newest_record_date, 0, 4 ),
- month => substr( $newest_record_date, 5, 2 ),
- day => substr( $newest_record_date, 8, 2 ),
- hour => substr( $newest_record_date, 11, 2 ),
- minute => substr( $newest_record_date, 14, 2 ),
- second => substr( $newest_record_date, 17, 2 ),
- );
- }
- else {
- $request_cutoff_time = DateTime->now();
- $request_cutoff_time->subtract(
- DateTime::Duration->new( days => $settings_href->{'age'} ) );
- }
- }
-
- # Had to do the == 1 business since -1 evaluates as true
- last if ( DateTime->compare( $request_cutoff_time, $request_time ) == 1 );
-
- # Combine separate date, time, and diffgmt hash pairs into one 'date' field
- $log_entry_href->{date}
- = "$request_year-$request_month-$request_day $log_entry_href->{time} $log_entry_href->{diffgmt}";
- delete $log_entry_href->{time};
- delete $log_entry_href->{diffgmt};
-
- # To match 'username' db column (Postgres didn't like a column named 'user')
- $log_entry_href->{username} = delete $log_entry_href->{user};
-
- # Code verbosity is a useful feature.
- if ( $settings_href->{verbose} ) {
- print $_ . ", " foreach values %$log_entry_href;
- print "\n";
- }
-
- my @fields = sort keys %$log_entry_href;
- my @bind_values;
- foreach (@fields) {
- my $db_value = $log_entry_href->{$_};
- unless (/^(bytes|code)$/) { $db_value = $dbh->quote($db_value); }
-
- # make sure integer values are really integers (no dashes)
- if (/^(bytes|code)$/) { $db_value =~ s/-/0/; }
- push @bind_values, $db_value;
- }
- my $qmarks = "?," x @fields;
- chop($qmarks);
- my $fields = join( ",", @fields );
- $sql = "INSERT INTO web_requests ($fields) VALUES ($qmarks)";
- $dbh->do( $sql, undef, @bind_values ) or warn $dbh->errstr;
- $num_entries_added++;
-}
-print "\n$num_entries_added entries added to database\n\n"
- if $settings_href->{verbose};
-
-# End Main
-
-# Subs
-sub parse_command_line_info {
- my %cli_args;
- my $help;
- my $age;
- my $logfile;
- my $verbose;
- GetOptions( \%cli_args, 'help', 'age=i', 'logfile=s', 'verbose' )
- or usage();
-
-# It's insane that GetOptions doesn't process the age parameter correctly, but
-# that's what appears to be happening... Go figure.
- return \%cli_args;
-}
-
-sub usage {
- print <<USAGE;
-
-weblogslurp.pl \[-a | --age\] <age in days> \[-l | --logfile\] <path to logfile> \[-v | --verbose\] \[-h | --help\]
-
-Summary
--------
-weblogslurp.pl takes a web server\'s logfile and puts each entry
-into a database of your choosing. You may choose as many records
-as you like, provided your database has enough room.
-
-The default logfile is specified in the script, as is the default
-record age (either newest db record or \$RECORD_AGE constant).
-
-Options
--------
--a, --age <age in days>
- Specifies how many days of logfile entries to process.
-
--l, --logfile <path to logfile>
- Specify the location of your web server\'s logfile.
-
--v, --verbose
- Print each log entry to stdout as it is being written to the database.
- There are only two levels of verbosity: off and on.
- A warning here--don\'t use this option from within a cron job unless
- you wish to receive a monster e-mail!
-
-USAGE
- exit(0);
-}
-
-sub populate_settings {
- my $args_href = shift;
- $args_href->{'age'} = $RECORD_AGE unless defined $cli_args_href->{'age'};
- $args_href->{'logfile'} = $LOGFILE
- unless defined $cli_args_href->{'logfile'};
- return $args_href;
-}
=== removed file 'app-mvhub/conf/templates/html/usage_summary_report_html.tmpl'
--- app-mvhub/conf/templates/html/usage_summary_report_html.tmpl 2009-07-01 15:37:11 +0000
+++ app-mvhub/conf/templates/html/usage_summary_report_html.tmpl 1970-01-01 00:00:00 +0000
@@ -1,111 +0,0 @@
-
-<!-- start usage_summary_report_html.tmpl -->
-
-<h2>Traffic Summary</h2>
-
-<h3>Youth Categories: Number of Hits</h3>
-<table class="usage_reports" cellspacing="0" cellpadding="0"><tbody>
-<tr class="headings">
-<th>Category</th>
-<th>Past Month</th>
-<th>Past Six Months</th>
-</tr>
-<!--tmpl_loop name='youth_categories'-->
-<tr>
-<td class="name"><!--tmpl_var name='category_name'--></td>
-<td class="hits"><!--tmpl_var name='one_month'--></td>
-<td class="hits"><!--tmpl_var name='six_months'--></td>
-</tr>
-<!--/tmpl_loop-->
-</tbody></table>
-
-<h3>Programs with most hits--previous month</h3>
-<table class="usage_reports" cellspacing="0" cellpadding="0"><tbody>
-<tr class="headings">
-<th>Program</th>
-<th>Agency</th>
-<th>Past Month</th>
-</tr>
-<!--tmpl_loop name='programs_one_month'-->
-<tr>
-<td class="name"><!--tmpl_var name='name'--></td>
-<td><!--tmpl_var name='agency_name'--></td>
-<td class="hits"><!--tmpl_var name='hits'--></td>
-</tr>
-<!--/tmpl_loop-->
-</tbody></table>
-
-<h3>Programs with most hits--previous six months</h3>
-<table class="usage_reports" cellspacing="0" cellpadding="0"><tbody>
-<tr class="headings">
-<th>Program</th>
-<th>Agency</th>
-<th>Past Six Months</th>
-</tr>
-<!--tmpl_loop name='programs_six_months'-->
-<tr>
-<td class="name"><!--tmpl_var name='name'--></td>
-<td><!--tmpl_var name='agency_name'--></td>
-<td class="hits"><!--tmpl_var name='hits'--></td>
-</tr>
-<!--/tmpl_loop-->
-</tbody></table>
-
-<h3>Agencies with most hits--previous month</h3>
-<table class="usage_reports" cellspacing="0" cellpadding="0"><tbody>
-<tr class="headings">
-<th>Agency</th>
-<th>Past Month</th>
-</tr>
-<!--tmpl_loop name='agencies_one_month'-->
-<tr>
-<td class="name"><!--tmpl_var name='name'--></td>
-<td class="hits"><!--tmpl_var name='hits'--></td>
-</tr>
-<!--/tmpl_loop-->
-</tbody></table>
-
-<h3>Agencies with most hits--previous six months</h3>
-<table class="usage_reports" cellspacing="0" cellpadding="0"><tbody>
-<tr class="headings">
-<th>Agency</th>
-<th>Past Six Months</th>
-</tr>
-<!--tmpl_loop name='agencies_six_months'-->
-<tr>
-<td class="name"><!--tmpl_var name='name'--></td>
-<td class="hits"><!--tmpl_var name='hits'--></td>
-</tr>
-<!--/tmpl_loop-->
-</tbody></table>
-
-<h3>Programs with no hits--previous month</h3>
-<table class="usage_reports" cellspacing="0" cellpadding="0"><tbody>
-<tr class="headings">
-<th>Program</th>
-<th>Agency</th>
-</tr>
-<!--tmpl_loop name='unvisited_one_month'-->
-<tr>
-<td class="name"><!--tmpl_var name='program_name'--></td>
-<td><!--tmpl_var name='agency_name'--></td>
-</tr>
-<!--/tmpl_loop-->
-</tbody></table>
-
-<h3>Programs with no hits--previous six months</h3>
-<table class="usage_reports" cellspacing="0" cellpadding="0"><tbody>
-<tr class="headings">
-<th>Program</th>
-<th>Agency</th>
-</tr>
-<!--tmpl_loop name='unvisited_six_months'-->
-<tr>
-<td class="name"><!--tmpl_var name='program_name'--></td>
-<td><!--tmpl_var name='agency_name'--></td>
-</tr>
-<!--/tmpl_loop-->
-</tbody></table>
-
-<!-- stop usage_summary_report_html.tmpl -->
-
=== removed file 'app-mvhub/conf/templates/text/usage_summary_report_text.tmpl'
--- app-mvhub/conf/templates/text/usage_summary_report_text.tmpl 2009-07-01 16:01:13 +0000
+++ app-mvhub/conf/templates/text/usage_summary_report_text.tmpl 1970-01-01 00:00:00 +0000
@@ -1,47 +0,0 @@
- ---------------------------
-| Traffic Summary |
- ---------------------------
-
-Youth Categories: Number of Hits
---------------------------------
-<!--tmpl_loop name='youth_categories'-->
-*<!--tmpl_var name='category_name'-->*
-Past Month: <!--tmpl_var name='one_month'--> Past Six Months: <!--tmpl_var name='six_months'-->
-<!--/tmpl_loop-->
-
-
-Programs with Most Hits: Past Month
------------------------------------
-<!--tmpl_loop name='programs_one_month'-->
-<!--tmpl_var name='name'--> (<!--tmpl_var name='agency_name'-->): <!--tmpl_var name='hits'--><!--/tmpl_loop-->
-
-
-Programs with Most Hits: Past Six Months
-----------------------------------------
-<!--tmpl_loop name='programs_six_months'-->
-<!--tmpl_var name='name'--> (<!--tmpl_var name='agency_name'-->): <!--tmpl_var name='hits'--><!--/tmpl_loop-->
-
-
-Agencies with Most Hits: Past Month
------------------------------------
-<!--tmpl_loop name='agencies_one_month'-->
-<!--tmpl_var name='name'-->: <!--tmpl_var name='hits'--><!--/tmpl_loop-->
-
-
-Agencies with Most Hits: Past Six Months
-----------------------------------------
-<!--tmpl_loop name='agencies_six_months'-->
-<!--tmpl_var name='name'-->: <!--tmpl_var name='hits'--><!--/tmpl_loop-->
-
-
-Unvisited Programs: Past Month
-------------------------------
-<!--tmpl_loop name='unvisited_one_month'-->
-<!--tmpl_var name='program_name'--> ( <!--tmpl_var name='agency_name'-->)<!--/tmpl_loop-->
-
-
-Unvisited Programs: Past Six Months
------------------------------------
-<!--tmpl_loop name='unvisited_six_months'-->
-<!--tmpl_var name='program_name'--> ( <!--tmpl_var name='agency_name'-->)<!--/tmpl_loop-->
-
=== removed file 'app-mvhub/project-tools/bin/passwords.pl'
--- app-mvhub/project-tools/bin/passwords.pl 2009-12-07 20:00:37 +0000
+++ app-mvhub/project-tools/bin/passwords.pl 1970-01-01 00:00:00 +0000
@@ -1,60 +0,0 @@
-#!/usr/bin/perl
-
-# A one-time script to change all numeric-only passwords (which we generated
-# earlier) in the agency table to passwords easy for humans to remember. (Any
-# non-numeric-only passwords are left alone.
-
-# $Revision: 1467 $
-use strict;
-use warnings;
-
-use MVHub::Common;
-
-my $COUNT = 0;
-
-open( FILE, '/usr/share/dict/words' )
- or die "Could not open file for reading: $!";
-
-my @WORDS = <FILE>;
-close FILE;
-{
- my $dbh = MVHub::Utils::DB::get_dbh();
- my $sql1
- = 'SELECT agency_id FROM agency where password ~ \'^[[:digit:]]+$\'';
- my $ids_aref = $dbh->selectcol_arrayref($sql1);
-
- my $sql2 = 'UPDATE agency SET password = ? WHERE agency_id = ?';
- $dbh->{AutoCommit} = 0;
- my $sth = $dbh->prepare($sql2);
-
- foreach my $id (@$ids_aref) {
- my $password = generate_random_password();
-
- $sth->execute( $password, $id );
- print "$password\n";
- }
-
- # TODO: uncomment this.
- # $dbh->commit();
- print "This was a dry run; Must uncomment commit to effect changes\n";
- print "Attempted passwords: $COUNT\n";
- if ( scalar @$ids_aref ) {
- print "Attempts/Passwords = " . $COUNT / ( scalar @$ids_aref ) . "\n";
- }
-
-}
-
-sub generate_random_password {
- my $password;
- do {
- my $word1 = $WORDS[ int( rand( ( scalar @WORDS ) - 1 ) ) ];
- chomp($word1);
- my $word2 = $WORDS[ int( rand( ( scalar @WORDS ) - 1 ) ) ];
- chomp($word2);
- my $num = int( rand(8) ) + 2;
- $password = "$word1$num$word2";
- $COUNT++;
- } while ( length($password) >= 12 );
- return lc($password);
-}
-
=== removed file 'app-mvhub/project-tools/bin/quick_url.pl'
--- app-mvhub/project-tools/bin/quick_url.pl 2009-09-01 14:49:59 +0000
+++ app-mvhub/project-tools/bin/quick_url.pl 1970-01-01 00:00:00 +0000
@@ -1,27 +0,0 @@
-#!/usr/bin/perl
-
-use warnings;
-use strict;
-
-my $USAGE = 'quick_url.pl <filename>';
-
-sub encode_quick_login_id {
- my $agency_id = shift;
- return $agency_id**2 + 12345;
-}
-
-{
- die $USAGE if scalar @ARGV != 1;
-
- open IN, $ARGV[0] or die "$! failed to open input file";
-
- while ( my $line = <IN> ) {
- next if $line !~ /\|/;
- my ( $agency, $id ) = split qr(\s+\|\s+), $line;
- my $ql = encode_quick_login_id($id);
- my $url = "http://mvhub.com/cgi-bin/guide/agency.pl?rm=ql&id=$ql";;
- print "$agency\n$url\n\n";
-
- }
-}
-
=== removed file 'app-mvhub/setup/update/create_zip_distances.pl'
--- app-mvhub/setup/update/create_zip_distances.pl 2009-12-07 20:00:37 +0000
+++ app-mvhub/setup/update/create_zip_distances.pl 1970-01-01 00:00:00 +0000
@@ -1,124 +0,0 @@
-#!/usr/bin/perl
-
-# $Revision: 1466 $
-
-# create_zip_distances.pl
-#
-# This program populates the zip_distances database table
-# based on the list of zip codes, latitudes, and longitudes
-# contained in the zip_latlong table.
-#
-
-use strict;
-use warnings;
-
-use DBI;
-use Geo::Distance;
-
-use MVHub::Common;
-
-# Main
-
-usage() unless $ARGV[0];
-
-# Get latitude and longitude information from CSV file specified on command line.
-# Note that we have to give an explicit end-of-line termination of \n, as the default is \r\n.
-# Same is true of the quote character (no quote character).
-my $data_file = $ARGV[0];
-my $csv_dbh = DBI->connect("dbi:CSV:csv_eol=\n;csv_quote_char=")
- or die "Couldn't get zip code -> lat/long data: $DBI::errstr";
-$csv_dbh->{'csv_tables'}->{'zip_latlong'} = {
- 'file' => $data_file,
- 'col_names' => [ 'zip', 'latitude', 'longitude' ]
-};
-my $sql = "SELECT * FROM zip_latlong";
-my $latlong_href = $csv_dbh->selectall_hashref( $sql, 'zip' );
-$csv_dbh->disconnect()
- or die "Couldn't disconnect from CSV file: $DBI::errstr";
-
-# Create CSV file to populate DB.
-# This is _much_ faster than executing a million INSERT statements....
-my @zip_codes = sort keys %$latlong_href;
-my $zip_file = "zip_distances.csv"
- ; # This way we keep a copy of the data--no need to do nightly SQL dump on this table.
-open ZIPDATA, ">$zip_file"
- or die "Couldn't create temporary file for zip distances: $!";
-foreach my $start_zip (@zip_codes) {
- foreach my $end_zip (@zip_codes) {
- my $distance = ( $start_zip eq $end_zip ) ? 0 : calc_zip_distance(
- start_zip => $start_zip,
- end_zip => $end_zip,
- coordinates_href => $latlong_href
- );
- print ZIPDATA "$start_zip,$end_zip,$distance\n";
- }
-}
-close ZIPDATA;
-
-# Drop index on db table
-my $dbh = MVHub::Utils::DB::get_dbh();
-$sql = "DROP INDEX start_zip_index_on_zip_distances";
-$dbh->do($sql) or warn "Couldn't drop index on zip_distances table: $!";
-
-# Delete rows from db table
-$sql = "DELETE FROM zip_distances";
-$dbh->do($sql) or die "Couldn't delete old rows from zip_distances table: $!";
-
-# Add info in CSV file to database
-my $dbname = MVHub::Common::get_config('database_name');
-my $uname = MVHub::Common::get_config('database_user');
-my $db_command
- = "/usr/bin/psql -d $dbname -U $uname -c \"\\copy zip_distances from $zip_file using delimiters ','\"";
-
-system($db_command) == 0
- or die "Unable to copy zip code distances into zip_distances table: $!";
-
-# Create index on start_zip column (Improves lookup time by a factor of 1000!)
-$sql
- = "CREATE UNIQUE INDEX start_zip_index_on_zip_distances ON zip_distances(start_zip, end_zip)";
-$dbh->do($sql) or die "Unable to create index on zip_distances table: $!";
-
-# End Main
-
-# Subs
-sub usage {
- print <<HERE;
-
-create_zip_distances.pl <data_file>
-
-Populates Hub\'s zip_distances database table using the data
-contained in <data_file>.
-
-<data_file> should be a CSV file with the field layout
-
- "zip","latitude","longitude"
-
-
-HERE
-
- exit(0);
-}
-
-sub calc_zip_distance {
- my %args = @_;
- my $start_zip = delete $args{start_zip};
- my $end_zip = delete $args{end_zip};
- my $coordinates_href = delete $args{coordinates_href};
-
- my $start_lat = $coordinates_href->{$start_zip}->{latitude};
- my $start_long = $coordinates_href->{$start_zip}->{longitude};
- my $end_lat = $coordinates_href->{$end_zip}->{latitude};
- my $end_long = $coordinates_href->{$end_zip}->{longitude};
-
- my $geo_dist = new Geo::Distance;
-
-# Two-decimal-place accuracy; feel free to change format string if more accuracy is needed
- return sprintf(
- "%.2f",
- $geo_dist->distance(
- 'mile', $start_long,
- $start_lat => $end_long,
- $end_lat
- )
- );
-}
=== removed directory 'app-mvhub/tmp'
=== modified file 'lib-mvhub/Build.PL'
--- lib-mvhub/Build.PL 2010-01-08 22:22:42 +0000
+++ lib-mvhub/Build.PL 2010-04-16 15:23:17 +0000
@@ -16,9 +16,7 @@
},
requires_ => {
'DBIx::XHTML_Table' => '> 0',
- 'Geo::Distance' => '> 0',
'HTML::Strip' => '> 0',
- 'Parse::AccessLogEntry' => '> 0',
'Set::Array' => '> 0',
'SQL::Library' => '> 0',
'Test::WWW:Mechanize' => '> 0',
=== modified file 'lib-mvhub/MANIFEST'
--- lib-mvhub/MANIFEST 2009-12-18 18:09:42 +0000
+++ lib-mvhub/MANIFEST 2010-04-16 15:23:17 +0000
@@ -4,7 +4,6 @@
lib/MVHub.pm
lib/MVHub/AgencyAccount.pm
lib/MVHub/AgencyFieldDefs.pm
-lib/MVHub/AgencyRecord.pm
lib/MVHub/ArgChecker.pm
lib/MVHub/AuthAccount.pm
lib/MVHub/CGIAppBase.pm
@@ -23,7 +22,6 @@
lib/MVHub/ProgramFieldDefs.pm
lib/MVHub/Synonyms.pm
lib/MVHub/Utils.pm
-lib/Parse/AccessLogEntry.pm
MANIFEST This list of files
new
README
@@ -31,8 +29,6 @@
t/01-load.t
t/03-run_test_class.t
t/AgencyAccount/new.t
-t/AgencyRecord/data_entry_show_blank_agency_form.t
-t/AgencyRecord/new.t
t/boilerplate.t
t/conf/guide.conf
t/conf/perltidyrc
=== removed file 'lib-mvhub/lib/MVHub/AgencyRecord.pm'
--- lib-mvhub/lib/MVHub/AgencyRecord.pm 2009-03-04 18:11:56 +0000
+++ lib-mvhub/lib/MVHub/AgencyRecord.pm 1970-01-01 00:00:00 +0000
@@ -1,160 +0,0 @@
-our ($VERSION) = '$Revision: 1550 $' =~ /([.\d]+)/;
-
-# This code is not being used yet
-
-package MVHub::AgencyRecord;
-
-use strict;
-use warnings;
-
-use base 'MVHub::CGIAppBase';
-use MVHub::AuthAccount;
-use CGI::Application::Plugin::Redirect;
-
-my @RUN_MODES = qw(
- data_entry_insert_agency
- data_entry_remove_agency
- data_entry_show_blank_agency_form
- data_entry_show_agency
- data_entry_update_agency
-);
-
-sub setup {
- my $self = shift;
- $self->run_modes( \@RUN_MODES );
-}
-
-sub cgiapp_prerun {
- my $self = shift;
- my $cgi = $self->query();
-
- my ( $is_admin, $is_agency, $is_data_entry_operator, $error_message )
- = MVHub::AuthAccount::authenticate_session($cgi);
-
- $self->param( 'is_data_entry_operator' => $is_data_entry_operator );
-
- my $current_run_mode = $self->get_current_runmode();
- die "bad run mode: $current_run_mode\n"
- if !scalar grep { $current_run_mode eq $_ } @RUN_MODES;
-
- $self->redirect("/cgi-bin/mvhub/dataentry.pl?rm=show_login_page")
- if not $is_data_entry_operator;
-
-}
-
-sub data_entry_insert_agency {
- my $self = shift;
- return $self->get_current_runmode();
-}
-
-sub data_entry_remove_agency {
- my $self = shift;
- return $self->get_current_runmode();
-}
-
-sub data_entry_show_agency {
- my $self = shift;
- return $self->get_current_runmode();
-}
-
-sub data_entry_show_blank_agency_form {
- my $self = shift;
- return
- q(<input type="hidden" name="rm" value="data_entry_insert_agency">);
-}
-
-sub data_entry_update_agency {
- my $self = shift;
- return $self->get_current_runmode();
-}
-
-############## POD Below ###################
-
-=head1 NAME
-AgencyRecord - CGI::Application run modes for creating, updating, deleting agency and data_entry_agency tables.
-
-=head1 SYNOPSIS
-
- use base MVHub::AgencyRecord;
- # man CGI::Application
-
-=head1 DESCRIPTION
-
- There are no public methods.
-
-=head1 SEE ALSO
-
- man CGI::Application
-
-=head1 LAST MODIFIED
-
-Last modified on $Date: 2009-01-26 13:23:30 -0500 (Mon, 26 Jan 2009) $ by $Author: omacneil $
-
-=head1 BUGS
-
-CGIAppBase is not used by AgencyAccount.pm, DataEntryAccount.pm, Guide.pm so these modules all have duplicate code
-
-=head1 LICENSE
-
-The GNU Affero General Public License, version 3.0 or later
-
-=head1 COPYRIGHT
-
-Community Software Lab, Inc ( http://thecsl.org )
-
-=cut
-
-=head1 NOTES
-
-Agency record
-
-Actions:
- Create
- Save (data entry op)
- Read
- Update
- Delete
- Hide
- Send (confirmation email) to Agency
-
-Actors
- data entry operator
- admin
- agency
- new agency
-
-states
- not logged in
- is_data_entry_operator
- is_admin
- is_agency
-
-possible run modes
- admin_update_agency
- date_entry_update_agency
- admin_create_agency
- data_entry_create_agency
-
- # exists in AgencyAccount.pm
- remove_agency
-
-
-templates / forms that use agency_form.pl
-
-agency_form.tmpl
-agency_home.tmpl
-data_entry_main.tmpl
-program_form.tmpl
-
-
-refactoring plan:
-
- write tests to verify operation of current agency_form.pl
- create test cgi object pass it in
- override MVHub::Common
-
-tests:
-
-=cut
-
-1;
=== removed file 'lib-mvhub/lib/MVHub/HubSQL.pm'
--- lib-mvhub/lib/MVHub/HubSQL.pm 2010-02-01 03:31:49 +0000
+++ lib-mvhub/lib/MVHub/HubSQL.pm 1970-01-01 00:00:00 +0000
@@ -1,101 +0,0 @@
-package MVHub::HubSQL;
-
-# $Revision: 1215 $
-
-use strict;
-use warnings;
-
-# This package serves as a place where we can put all of Hub's SQL queries.
-# Right now, SQL is strewn all over the place. If you find yourself
-# modifying some piece of Hub, and you notice some hard-coded SQL,
-# please try to move it over here.
-
-require Exporter;
-
-our @ISA = qw(Exporter);
-
-# I don't think we'll need to export any functions, but putting this here just to be safe.
-our @EXPORT = qw();
-
-#
-# Main
-#
-
-# Variables to be exported:
-our $ALL_AGENCIES = "SELECT * FROM agency WHERE NOT agency.hidden;";
-our $HEADINGS = "SELECT heading_name FROM heading ORDER BY heading_name";
-our $PROGRAMS_OF_AGENCIES_WITH_MULTIPLE_PROGRAMS = <<END_SQL;
- SELECT program.*, agency_name
- FROM program JOIN agency USING (agency_id)
- WHERE agency_id IN (
- SELECT agency_id
- FROM agency JOIN program USING (agency_id)
- GROUP BY agency_id HAVING sum(1) > 1
- ) AND program_id IN (
- SELECT program_id
- FROM program_category NATURAL JOIN heading_category
- WHERE heading_name = ?
- )
- AND program.hidden_reason IS NOT NULL
- AND NOT agency.hidden;
-END_SQL
-
-our $AGENCIES_WITH_MULTIPLE_PROGRAMS = <<END_SQL;
- SELECT agency.* FROM agency
- WHERE agency_id IN (
- SELECT agency_id
- FROM agency JOIN program USING (agency_id)
- GROUP BY agency_id HAVING sum(1) > 1
- ) AND agency_id IN (
- SELECT agency_id
- FROM agency JOIN program USING (agency_id)
- JOIN program_category USING (program_id)
- JOIN heading_category USING (category_id)
- WHERE heading_name = ?
- )
- AND NOT agency.hidden;
-END_SQL
-
-our $AGENCIES_WITH_ONE_PROGRAM = <<END_SQL;
- SELECT agency.* FROM agency
- WHERE agency_id IN (
- SELECT agency_id
- FROM agency JOIN program USING (agency_id)
- GROUP BY agency_id HAVING sum(1) = 1
- ) AND agency_id IN (
- SELECT agency_id
- FROM agency JOIN program USING (agency_id)
- JOIN program_category USING (program_id)
- JOIN heading_category USING (category_id)
- WHERE heading_name = ?
- )
- AND NOT agency.hidden;
-END_SQL
-
-our $AGENCIES_WITH_NO_PROGRAMS = <<END_SQL;
- SELECT agency.* FROM agency
- WHERE agency_id NOT IN (
- SELECT agency_id FROM program
- ) AND agency_id IN (
- SELECT agency_id
- FROM agency JOIN program USING (agency_id)
- JOIN program_category USING (program_id)
- JOIN heading_category USING (category_id)
- WHERE heading_name = ?
- )
- AND NOT agency.hidden;
-END_SQL
-
-our $PROGRAM_CATEGORIES = <<END_SQL;
- SELECT category_name
- FROM category JOIN program_category USING (category_id)
- WHERE program_id = ?
-END_SQL
-
-# Subs to be exported
-
-#
-# Non-exported subs
-#
-
-1;
=== removed directory 'lib-mvhub/lib/Parse'
=== removed file 'lib-mvhub/lib/Parse/AccessLogEntry.pm'
--- lib-mvhub/lib/Parse/AccessLogEntry.pm 2009-03-04 18:11:56 +0000
+++ lib-mvhub/lib/Parse/AccessLogEntry.pm 1970-01-01 00:00:00 +0000
@@ -1,113 +0,0 @@
-package Parse::AccessLogEntry;
-
-# For some odd reason, this package doesn't go to the proper location when installed via
-# perl -MCPAN -e 'install Parse::AccessLogEntry'
-# so I'm just putting it into CVS.
-#
-# $Revision: 1124 $
-
-use strict;
-use warnings;
-
-require Exporter;
-our $VERSION = '0.06';
-
-sub new {
- my $Proto = shift;
- my $Class = ref($Proto) || $Proto;
- my $Self = {};
- bless $Self;
- return $Self;
-}
-
-sub parse {
- my $Self = shift;
- my $Line = shift;
- my $Ref;
- my $Rest;
- my $R2;
- ( $Ref->{host}, $Ref->{user}, $Ref->{date}, $Rest )
- = $Line =~ m,^([^\s]+)\s+-\s+([^ ]+)\s+\[(.*?)\]\s+(.*),;
- my @Dsplit = split( /\s+/, $Ref->{date} );
- $Ref->{diffgmt} = $Dsplit[1];
- my @Ds2 = split( /\:/, $Dsplit[0], 2 );
- $Ref->{date} = $Ds2[0];
- $Ref->{time} = $Ds2[1];
-
- if ($Rest) {
- ( $Ref->{rtype}, $Ref->{file}, $Ref->{proto},
- $Ref->{code}, $Ref->{bytes}, $R2
- ) = split( /\s/, $Rest, 6 );
- $Ref->{rtype} =~ tr/\"//d;
- $Ref->{proto} =~ tr/\"//d;
- if ($R2) {
- my @Split = split( /\"/, $R2 );
- $Ref->{refer} = $Split[1];
- $Ref->{agent} = $Split[3];
- }
- }
- return $Ref;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Parse::AccessLogEntry - Parse one line of an Apache access log
-
-=head1 SYNOPSIS
-
- use Parse::AccessLogEntry;
- my $P=Parse::AccessLogEntry::new();
-
- # $Line is a string containing one line of an access log
- my $Hashref=$P->parse("$Line");
-
-=head1 DESCRIPTION
-
-There are several modules that focus on generating web reports,
-like Apache::ParseLog. There are also several places on the
-web where you can find the regex required to parse the lines
-on your own. This is simply for users who dont want to mess
-with any of that, and just want to have a quick way to implement
-this functionality in their code.
-
-This module handles the standard Apache access_log formats,
-including the combined log file format that includes the
-referrer and user-agent. The return form the parse() call
-is a hashref with key names being the fields in the line just
-parsed.
-
- $Hashref->{host} client ip of the request
- $Hashref->{user} user logged in ("-" for none)
- $Hashref->{date} date of the request
- $Hashref->{time} server time of the request
- $Hashref->{diffgmt} server offset from GMT
- $Hashref->{rtype} type of request (GET, POST, etc)
- $Hashref->{file} file requested
- $Hashref->{proto} protocol used (HTTP/1.1, etc)
- $Hashref->{code} code returned by apache (200, 304, etc)
- $Hashref->{bytes} number of bytes returned to the client
- $Hashref->{refer} referrer
- $Hashref->{agent} user-agent
-
-If you noticed that the RFC1413 field is missing, you're right.
-I don't plan on including this anytime soon, since hardly anyone
-uses it.
-
-This is a pretty early release. But since much of this code is
-lifted from other sources it should be pretty reliable. If
-anybody has any ideas on how to make it more robust then let me
-know.
-
-=head1 AUTHOR
-
-Marc Slagle - marc.slagle@xxxxxxxxxxxxxxxxxx
-
-=head1 SEE ALSO
-
-L<perl>.
-
-=cut
-
=== removed directory 'lib-mvhub/t/AgencyRecord'
=== removed file 'lib-mvhub/t/AgencyRecord/data_entry_show_blank_agency_form.t'
--- lib-mvhub/t/AgencyRecord/data_entry_show_blank_agency_form.t 2009-09-15 01:12:17 +0000
+++ lib-mvhub/t/AgencyRecord/data_entry_show_blank_agency_form.t 1970-01-01 00:00:00 +0000
@@ -1,59 +0,0 @@
-#!/usr/bin/perl -w
-
-# $Source$
-# $Revision: 1514 $
-
-use strict;
-use Test::More tests => 3;
-use CGI;
-
-BEGIN {
- use FindBin qw($Bin);
- chdir $Bin;
-
- use_ok('MVHub::AgencyRecord') or die "couldn't use AgencyRecord";
-}
-
-# return ->run() output instead of sending to stdout
-$ENV{CGI_APP_RETURN_ONLY} = 1;
-
-my ( $test_cgi, $test_name, $agency_record, $test_regex );
-
-###
-$test_name
- = "new MVHub::AgencyRecord with run mode: data_entry_show_blank_agency_form";
-
-$test_cgi = CGI->new();
-$test_cgi->param(
- -name => 'rm',
- -value => 'data_entry_show_blank_agency_form'
-);
-$test_cgi->param( agency_id => '99' );
-$agency_record = MVHub::AgencyRecord->new( QUERY => $test_cgi );
-isa_ok( $agency_record, 'MVHub::AgencyRecord', $test_name );
-
-###
-
-SKIP: {
- $test_name = 'Get right run mode out';
- skip 'test not implimented', 1 unless 0;
-
- $test_cgi = CGI->new();
- $test_cgi->param( -name => 'rm', -value => 'data_entry_insert_agency' );
- $test_cgi->param( agency_id => '99' );
- $agency_record = MVHub::AgencyRecord->new( QUERY => $test_cgi );
- my $output = $agency_record->run();
-
- my $expected_run_mode = '';
- $test_regex = qr/
- \s+type\s*="hidden"
- \s+name\s*="rm"
- \s+value\s*=\s*"$expected_run_mode"
- /xms;
-
- like( $output, $test_regex, $test_name );
-
- # request mode when we aren't authenticated ?
- # have all elements of form
-}
-
=== removed file 'lib-mvhub/t/AgencyRecord/new.t'
--- lib-mvhub/t/AgencyRecord/new.t 2009-09-15 01:12:17 +0000
+++ lib-mvhub/t/AgencyRecord/new.t 1970-01-01 00:00:00 +0000
@@ -1,77 +0,0 @@
-#!/usr/bin/perl -w
-
-# $Source$
-# $Revision: 1625 $
-
-use strict;
-use warnings;
-
-use Test::More tests => 6;
-use CGI;
-
-my ($agency_record, $test_cgi, $test_message,
- $test_name, $test_output, $test_regex,
-);
-
-BEGIN {
- use FindBin qw($Bin);
- chdir $Bin;
-
- # needed by MVHub::Common
- use_ok('MVHub::AgencyRecord') or die "couldn't use MVHub::AgencyRecord";
-}
-use MVHub::Common;
-
-# return ->run() output instead of sending to stdout
-$ENV{CGI_APP_RETURN_ONLY} = 1;
-
-my @methods = qw/
- data_entry_insert_agency
- data_entry_show_blank_agency_form
- data_entry_show_agency
- data_entry_update_agency
- data_entry_remove_agency
- /;
-
-can_ok( 'MVHub::AgencyRecord', @methods );
-
-###
-$test_message = 'Create an AgencyRecord object';
-###
-$agency_record = MVHub::AgencyRecord->new();
-isa_ok( $agency_record, 'MVHub::AgencyRecord', $test_name );
-
-###
-$test_name = 'Die on create a bogus run mode';
-###
-$test_cgi = CGI->new();
-$test_cgi->param( agency_id => '99' );
-$test_cgi->param( -name => 'rm', -value => 'BOGUS_RUN_MODE' );
-$agency_record = MVHub::AgencyRecord->new( QUERY => $test_cgi );
-eval { my $test_output = $agency_record->run(); };
-print "";
-like( $@, qr/bad run mode/, $test_name );
-
-###
-$test_name = 'Redirected when not authenticated';
-###
-$test_cgi = CGI->new();
-$test_cgi->param( -name => 'rm', -value => 'data_entry_insert_agency' );
-$test_cgi->param( agency_id => '99' );
-$agency_record = MVHub::AgencyRecord->new( QUERY => $test_cgi );
-$test_output = $agency_record->run();
-my $regex = qr|Location:\s+/cgi-bin/mvhub/dataentry.pl\?rm=show_login_page|;
-
-like( $test_output, $regex, $test_name );
-
-###
-$test_name = 'Die on new() MVHub::AgencyRecord without an $agency_id';
-###
-$test_cgi = CGI->new();
-$test_cgi->param(
- -name => 'rm',
- -value => 'data_entry_show_blank_agency_form'
-);
-eval { my $agency_record = MVHub::AgencyRecord->new( QUERY => $test_cgi ) };
-ok( defined $@, $test_name );
-
Follow ups
