#!/usr/bin/perl -w
use strict;
use CGI;
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use DBI;
use autodie;
#Total hack to use a module surrepetitiously installed on a GoDaddy account
use lib 'SOMEDIR';
use Text::CSV;
use lib 'SOMEOTHERDIR';
use Regexp::Common;
#use Data::Table;
$\="\n";
my $db="SOMEDB";
my $dbun="SOMEUN";
my $dbpw = 'SOMEPW';
my $dbhost="SOMEHOST.hostedresource.com";
my $res_tbl="resource_list";
my $loc_tbl="matrix_locations";
my $drh = DBI->install_driver("mysql") || print "install_driver failed: $DBI::errstr
";
my $dsn = "DBI:mysql:database=$db;host=$dbhost";
my $dbh = DBI->connect($dsn,$dbun,$dbpw) || print "DB connect failed: $DBI::errstr
";
my $res_select_stmt = "Select * from $res_tbl order by id";
my $loc_select_stmt = "Select location from $loc_tbl where resource_id = ?";
my @data_elements = ('id','name','link','availability','locations');
my @avail_options = ('Free','Free w/Membership','Available for Purchase');
my $q = CGI->new; # create new CGI object
print $q->header;
print $q->start_html(-dtd=>'html',-title=>'Procedural Harm Affinity Group Resource Data Base Display and Edit'); # start the HTML
#Here we are going to have two steps:
#1. UPDATE the master resource table with the new data
#2. Delete everything out of the locations table, and re-insert the new values.
#Note: I know this isn't very efficient (we should check if anything changed before doing either)
#But this is to limit my coding time, which is at a premium.
#we'll also be using this as a flag
my $id_to_update=0;
my %params = $q->Vars;
#Have to be careful here, there should only ever be one param that matches this.
foreach my $param (keys %params){
if ($param =~ /^Submit(\d+)/){
$id_to_update=$1;
}
}
#OK I totally forgot that I didn't just concatenate the ID to the end of the field name, I put an underscore in there.
if ($id_to_update){
#first, update the resources table
my $update_res_stmt = "UPDATE $res_tbl SET name=?, link=?, availability=? WHERE id=?";
my $updated_name = $params{"name_$id_to_update"};
my $updated_link = $params{"link_$id_to_update"};
my $updated_avail = $params{"availability_$id_to_update"};
if ($updated_link =~ $RE{URI}){
print $q->p("Updating resource list item with name=$updated_name, link=$updated_link, availability=$updated_avail for id=$id_to_update");
my $sth = $dbh->prepare($update_res_stmt) or warn "prepare UPDATE statement failed: $dbh->errstr";
my $rv = $sth->execute($updated_name,$updated_link,$updated_avail,$id_to_update) || warn "Execute update failed: $dbh->errstr";
$sth->finish;
print $q->p("Resources table updated with return value '$rv'.");
}else{
print $q->p("Error: Please make sure resource_link is a valid URL. This includes the http:// part as well as the domain and path.");
}
#next, insert the locations
#oh man, I forgot the id for this param. BAD CODER
print $q->p("Locations param is '",$params{"locations_$id_to_update"},"'");
my @locations = split /,/ , $params{"locations_$id_to_update"};
my $locs_legit_flag=1;
my $offending_loc;
foreach my $loc (@locations){
#print "Checking matrix location $loc";
if ($loc !~ m/^([A-Za-z])(\d+)$/){
$locs_legit_flag = 0;
$offending_loc = $loc;
}
}
if (! scalar @locations){
print $q->p("Somehow, the list of matrix locations has no locations in it. Please try again.");
}elsif ($locs_legit_flag){
#clear out the locations related to that resource ID from the locations table
my $delete_loc_stmt = "DELETE from $loc_tbl where resource_id=?";
print $q->p("Clearing out location table records with resource_id=$id_to_update");
my $sth = $dbh->prepare($delete_loc_stmt) or warn "prepare DELETE statement failed: $dbh->errstr";
$sth->execute($id_to_update) || warn "Execute DELETE failed: $dbh->errstr";
print $q->p("Locations table cleared.");
$sth->finish;
#OK time to insert now
my $loc_insert_stmt = "insert into $loc_tbl (resource_id, location) values (?,?)";
$sth = $dbh->prepare($loc_insert_stmt) or warn "prepare INSERT statement failed: $dbh->errstr";
@locations = map( uc($_), @locations );
#trying to use a hash to remove duplicates
#this one liner is from Effective Perl Programming via PerlMonks
@locations = sort keys %{ { map { $_, 1 } @locations } };
foreach my $loc (@locations){
$sth->execute($id_to_update,$loc) || print "execute statement failed: $DBI::errstr
";
}
$sth->finish;
}else{
#This means that $locs_legit_flag was cleared
#We did this whole escapeHTML thing in data_entry.pl so re-doing it here
#try to build the string ahead of time rather than interpolating, so that the default call by CGI on escapeHTML runs properly
my $msg = "One of the matrix locations you entered, namely '$offending_loc', is invalid. All matrix locations must be
a letter plus a 1-2 digit number, e.g. N9 or B19.";
#well, maybe it's not default and has to be called explicitly.
$msg = CGI::escapeHTML($msg);
print $q->p($msg);
}
}
print $q->start_form;
print $q->h3("Aggregate view of Procedural Harm database edit");
my $select_sth = $dbh->prepare($res_select_stmt) || print "prepare statement failed: $DBI::errstr
";
$select_sth->execute() || print "execute statement failed: $DBI::errstr
";
my $results = $select_sth->fetchall_arrayref();
$select_sth->finish();
my $tblstring= join '
$tblstring | |||
---|---|---|---|
'; foreach my $row (@$results){ print ' | |||
'; my $id = $row->[0]; #set baseline so we get the ID my @newrow = @$row; my $i; if ( $q->param("Edit$id") ){ #start at 1 so as to skip the ID field taken care of properly for ($i = 1; $i < ((scalar @data_elements) - 1); $i++ ){ #if it's availability, let's keep it a radio group if ($data_elements[$i] eq 'availability'){ $newrow[$i] = $q->radio_group(-name=>"$data_elements[$i]_$id", -values=>\@avail_options, -default=>$avail_options[0], -linebreak=>'true', #-labels=>\%labels, #-attributes=>\%attributes ); }else{ $newrow[$i] = $q->textarea(-name=>"$data_elements[$i]_$id", -default=>$row->[$i], -rows=>5, -columns=>50); } } #whoops, was modifying $row when I needed the original values later. #BAD Coder! BAD! #@$row = @newrow; print join ' | ' , @newrow; }else{ print join ' | ' , @$row; } print ' | ';
$select_sth = $dbh->prepare($loc_select_stmt) || print "prepare statement failed: $DBI::errstr "; $select_sth->execute($id) || print "execute statement failed: $DBI::errstr "; my @locs; while (my $ref = $select_sth->fetchrow_arrayref()){ push @locs , $ref->[0]; } $select_sth->finish(); my $locs_for_cell = join ',' , @locs; if ( $q->param("Edit$id") ){ #dafuq was I thinking here? This is clearly the locations textarea #I had it as $data_elements[$i+1 but I guess $i got incremented one last time to fail the conditional in the loop #I guess I'll leave it in case I add fields to the table/data elements to the array? print $q->textarea(-name=>"$data_elements[$i]_$id", -default=>$locs_for_cell); print $q->submit(-name=>"Submit$id",-value=>"Submit edits for record $id"); }else{ print $locs_for_cell; print $q->submit(-name=>"Edit$id",-value=>"Edit row $id"); } print ' |