Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Help with HoAoA

by OfficeLinebacker (Chaplain)
on Jun 20, 2013 at 13:14 UTC ( [id://1039974]=perlquestion: print w/replies, xml ) Need Help??

OfficeLinebacker has asked for the wisdom of the Perl Monks concerning the following question:

Greetings, esteemed monks!

This is a script that's designed to run in cron that sends an automatic email notifying of help desk tickets that have been open for too long.

I decided to keep the info for the tickets in a hash of arrays of arrays. The top level is by priority, (High/Low/Medium) and each contains an array of help tickets, and each help ticket is itself an array.

When I "push" an help ticket into an array of help tickets in each hash key, for some reason, this array reference is randomly showing up in the other hash keys. There is only one ticket that's been open too long, but the output of Data::Dumper shows the same array reference four times. The code:

#!/usr/bin/perl -w use strict; use warnings; use DBI; use Net::SMTP; use POSIX qw(strftime); use Date::Calc qw(Delta_DHMS); use Text::CSV; use Data::Dumper; $\ = "\n"; ################# ############################################# #ticket_notifier.pl #Purpose: Check Database for open tickets and notify #Help Desk staff of tickets that have been open too long ############################################### #Variables ############### #Captcha variables #Bunch of variable specifying email addresses, database login info, et +c redacted here #these are the thresholds, in hours, for alerts. my %thresholds = ( High => 6, Medium => 24, Low => 48 ); my $now_string = strftime "%Y-%m-%d %H:%M:%S", localtime; my @now_time = split /:|\s|-/, $now_string; #Ha ha! Time for Hash of Arrays! (of arrays) my %notify = ( High => [], Medium => [], Low => [] ); my $ts = strftime "%Y%m%d%H%M%S", localtime; my $backup_dir = '/var/chroot/home/content/12/11107612/html/_db_backup +s'; my $backup_filename = "$backup_dir/HDDBBU_$ts.csv"; my @data_elements = ('request id', 'time_received','name', 'email', 'p +rimary_number', 'alt_number', 'facility_name', 'facility_addr', 'urgency','problem_type','message', 'status', 'cl +osed_note', 'last_update_timestamp'); my $select_stmt = "SELECT * from $dbtbl order by ticket_id"; my $select_sth = $dbh->prepare($select_stmt) || warn "prepare statemen +t failed: $DBI::errstr <br/>"; $select_sth->execute() || warn "execute statement failed: $DBI::errstr + <br/>"; while (my $ref = $select_sth->fetchrow_arrayref()) { #split on colon,space,or dash my @ticket_time = split /:|\s|-/, $ref->[1]; my ($Dd,$Dh,$Dm,$Ds) = Delta_DHMS($ticket_time[0],$ticket_time[1],$ticket_time[2],$ti +cket_time[3],$ticket_time[4],0, $now_time[0],$now_time[1],$now_time[2],$now_time[3] +,$now_time[4],0); #my ($Dd,$Dh,$Dm,$Ds) = Delta_DHMS(@ticket_time,0,@now_time,0); my $delta_hrs = $Dd * 24 + $Dh; if ( $ref->[8] eq 'High' && $delta_hrs >= $thresholds{'High'}){ push @{$notify{'High'}}, $ref; }elsif ( $ref->[8] eq 'Medium' && $delta_hrs >= $thresholds{'Mediu +m'}){ push @{$notify{'Medium'}}, $ref; }elsif( $ref->[8] eq 'Low' && $delta_hrs >= $thresholds{'Low'}){ push @{$notify{'Low'}}, $ref; } #debug/testing statement here. warn "Time elapsed for ticket $ref->[0] of priority $ref->[8] is $ +delta_hrs."; } $select_sth->finish(); foreach my $k (sort keys %notify){ warn "Expired $k priority tickets:\n\r"; $email_text .= "Expired $k priority tickets:\n\r"; foreach my $ticket_ref (@{$notify{$k}}){ my $line = join " -- ", @$ticket_ref; $line = "$line \n\r"; warn $line; $email_text .= "$line\n\r"; } } warn Dumper(%notify); my $smtp = Net::SMTP->new($email_server) || die "Couldn't create new +SMTP object: $!"; $smtp->mail($email_from_address) || die "Couldn't set from address us +ing send: $!"; $smtp->to(@email_to_addresses)|| die "Couldn't set to address: $!"; $smtp->data(); $smtp->datasend("To:",join ';',@email_to_addresses, "\n"); $smtp->datasend("From: $email_from_address\n"); $smtp->datasend("Subject: $email_subject\n"); $smtp->datasend("\n"); # done with header $smtp->datasend("$email_intro\n"); #warn $q->p($html_text); $smtp->datasend($email_text) || die "Couldn't call datasend(): $!"; $smtp->dataend() || die "Couldn't call dataend(): $!"; #warn $q->p("called dataend"); $smtp->quit || die "Couldn't call quit()"; #part where we back up the db: my $csv = Text::CSV->new( { binary => 1, eol => "\015\012" } ); #re-use $select_sth $select_sth = $dbh->prepare($select_stmt) || warn "prepare statement f +ailed: $DBI::errstr <br/>"; $select_sth->execute() || warn "execute statement failed: $DBI::errstr + <br/>"; open (my $fh, ">", $backup_filename); #warn a header row to the CSV-- $csv->print($fh, \@data_elements) || warn "Can't print: $!"; while ( my $ref = $select_sth->fetchrow_arrayref() ) { #the csv print function needs a filehandle soo....STDOUT? $csv->print($fh, $ref) || warn "Can't print: $!"; } $select_sth->finish();
Output from Data::Dumper:
$VAR1 = 'Low'; $VAR2 = [ [ '4', '2013-06-15 05:09:16', 'All That Jibber Jabber', 'Jabba@thehut.com', '501-239-0234', '%04 is the ar', 'Tatooine Salvage and Title', '0', 'High', 'training_registratio', 'Hi I\'d like to register for the July 19th webinar', 'closed', 'This fat guy just wants a pretty young thing to be his pr +ey. We\'re not going to give it to him.', '2013-06-15 05:10:39' ] ]; $VAR3 = 'High'; $VAR4 = [ $VAR2->[0], $VAR2->[0] ]; $VAR5 = 'Medium'; $VAR6 = [ $VAR2->[0] ];
Can anyone offer any insight? Thanks.

Replies are listed 'Best First'.
Re: Help with HoAoA (fetchrow_arrayref reuse)
by Anonymous Monk on Jun 20, 2013 at 13:26 UTC

    fetchrow_arrayref lists a caveat, its that it reuses the reference, so all your array refs are pointing to the same one, its common pitfall, see http://search.cpan.org/perldoc/DBI#fetchrow_arrayref

    You want to use fetchrow_array and push ...\@array or store a copy with  push ... [ @$ref ]

      Thank you. Very helpful.

      For the record, I fixed it with

      :
      while (my @row = $select_sth->fetchrow_array()) { #split on colon,space,or dash my @ticket_time = split /:|\s|-/, $row[1]; my ($Dd,$Dh,$Dm,$Ds) = Delta_DHMS($ticket_time[0],$ticket_time[1],$ticket_time[2],$ti +cket_time[3],$ticket_time[4],0, $now_time[0],$now_time[1],$now_time[2],$now_time[3] +,$now_time[4],0); #my ($Dd,$Dh,$Dm,$Ds) = Delta_DHMS(@ticket_time,0,@now_time,0); my $delta_hrs = $Dd * 24 + $Dh; if ( $row[8] eq 'High' && $delta_hrs >= $thresholds{'High'}){ push @{$notify{'High'}}, \@row; }elsif ( $row[8] eq 'Medium' && $delta_hrs >= $thresholds{'Medium' +}){ push @{$notify{'Medium'}}, \@row; }elsif( $row[8] eq 'Low' && $delta_hrs >= $thresholds{'Low'}){ push @{$notify{'Low'}}, \@row; } #debug/testing statement here. warn "Time elapsed for ticket $row[0] of priority $row[8] is $delt +a_hrs."; }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1039974]
Approved by frozenwithjoy
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (6)
As of 2024-03-19 02:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found