Please tell me if any modules are available in CPAN to log error messages and do the log rotate as single module.

Background:

I need to generate a report with pivoted data. My current process selects data from an Oracle query via the DBI module and loads that data into excel. I normally use the Spreadsheet::WriteExcel module however, it does not have pivot capabilities. So, John M. suggested that I use Win32-OLE.

i.e.

my $connection = DBI->connect('dbi:Oracle:xxxxx','xxxxx','xxxxx',{
    AutoCommit => 0,
    RaiseError => 1,
    PrintError => 1,
    }) 
|| die "Database connection not made: $DBI::errstr";
[download]

#select statement

my $stmt1 = "select *
from final_data_set_blu_ray
order by weekend_date"; 
[download]

#prepare statement

$query1 = $connection->prepare($stmt1);
[download]

#execute

$query1->execute() or die $connection->errstr; 
[download]

#load data into an array reference.

my $a_row = $query1->fetchall_arrayref();
[download]

Once I have the data in an array reference, I can assign the data to an array or whatever to load it to excel. At this point, I can’t find any Win32::OLE logic / syntax that provides a clear example of taking queried data with an unknown range and creating a pivot table in excel. All of the examples I find have a pre-determined range for the spreadsheet like the example below:

i.e.

# Write all the data at once...

$rng = $xlBook->ActiveSheet->Range("A1:C7");
$rng->{Value} = $mydata;
[download]

# Create a PivotTable for the data...

$tbl = $xlBook->ActiveSheet->PivotTableWizard(1, $rng, "", "MyPivotTab
+le");
[download]

Using the above logic, is there a way to take the data from my query / DBI and assign it to a value like so “$rng->{Value} = $mydata;” to create a pivot table? With my queried data, my range will change each time. Can you give any tips to get around this?

I have worked on this for several days and I cannot find a solution. I wished that Spreadsheet::Write Excel had a pivot solution. Any help or direction will be greatly appreciated.

Is there some little known trick when you wan't to use PostgreSQL's advisory locks from Perl?

I first created a function that does:
1. get a lock (exclusive)
2. get some stuff from a table that's not marked as taken, update those rows as taken, and with info what pid took them, with a couple of other things for which I can't lock the rows or their id's and need basically a semaphore
3. unlock

And when I realized that more than one process is ending up with same table row as taken by them (writing to their output table was failing with duplicate key error) - I though, doup, the lock is released (and next process in queue gets the lock) before the transaction is commit-ed and there you go a racing condition.

So I changed it to something like (in reality function call is wrapped in eval, and there is a if($@) ...rollback/commit after that):

my $prepared_lock = $db->prepare("SELECT pg_advisory_lock(?)");
my $prepared_unlock = $db->prepare("SELECT pg_advisory_unlock(?)");

....
$prepared_lock->execute(123);
$db->{AutoCommit} = 1;
$db->begin_work();
$prepared_function_call->execute(....);
$db->commit();
$prepared_unlock->execute(123);
[download]

print Dumper \%test;
[download]

#!/usr/bin/perl

use strict;
use Data::Dumper;

tie( my %test, 'Sample_Tie_Class' );

$test{'hello'} = 'hi';
print "$test{'hello'}\n";

print Dumper \%test;


package Sample_Tie_Class;

use strict;

sub TIEHASH {
    my $class = shift;
    bless { 'value' => {}, }, $class;
}

sub STORE {
    my ($self, $key, $value) = @_;
    $self->{'value'}->{$key} = $value;
}

sub FETCH {
    my ($self, $key) = @_;
    return $self->{'value'}->{$key};
}

sub FIRSTKEY {
}
[download]

Scenario 1

my $comment="<Comment>These are the wild characters value @#$%^&*<\Com
+ment>";

if ($comment !~ /\<Comment\>*[^|<|^>|^\/]*\<\/Comment\>/) {

   print "Passed the test as there were no > < / in the comment \n";
}

Scenario 2

my $comment="<Comment>These are the wild characters value @#$%^&*   > 
+< / <\Comment>";

if ($comment !~ /\<Comment\>*[^|<|^>|^\/]*\<\/Comment\>/) {

   print "Passed the test as there were no > < / in the comment \n";
}
else {
   print "Failed the test as there were > < / characters in the commen
+t \n";
}


User will input the following as a comment. 

And the regular expression should negate any < > / character entered a
+s sentence in the USERSTORY .

<Comment>USERSTORY<\Comment>

[download]

Hi

I need to negate XML tags(< > and /) in a sentence(basically a comment entered)

which is entered in between xml tags .

Here is what i am doing .Please let me know if the regular expression that i have is doing the right thing.

I am having two scenarios where the first one should pass and second one should fail

User will input the following as a comment.

And the regular expression should negate any < > / character entered as sentence in the USERSTORY .

<Comment>USERSTORY<\Comment>

I cant seem to get GD::Graph::lines3d to hide undef value from it's graph, however GD::Graph::lines does work. Does anyone have any suggestions as to what I may be doing wrong?

use CGI;
use GD::Graph::lines3d;
my $cgi = new CGI;
  my @data = ( 
            ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "
+Sep", "Oct", "Nov", "Dec"],
            [undef,undef,undef,undef,undef,undef,undef,undef,undef,und
+ef,undef,undef],
            [undef, undef, undef, undef, 13,  0,  undef,  200,  200,  
+180,  160,  260],
            [undef, undef, 22, 15, 7,  -10,  undef,  undef,  400,  600
+,  100,  -260]
        );
  my $graph = new GD::Graph::lines3d( 700, 400 );
  $graph->set(skip_undef => 1);
  my $gd = $graph->plot( \@data );
  
  print $cgi->header(-type => "image/png", -expires => "-1d");
  print $gd->png;
[download]

use CGI;
use GD::Graph::lines;
my $cgi = new CGI;
  my @data = ( 
            ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "
+Sep", "Oct", "Nov", "Dec"],
            [undef,undef,undef,undef,undef,undef,undef,undef,undef,und
+ef,undef,undef],
            [undef, undef, undef, undef, 13,  0,  undef,  200,  200,  
+180,  160,  260],
            [undef, undef, 22, 15, 7,  -10,  undef,  undef,  400,  600
+,  100,  -260]
        );
  my $graph = new GD::Graph::lines( 700, 400 );
  $graph->set(skip_undef => 1);
  my $gd = $graph->plot( \@data );
  
  print $cgi->header(-type => "image/png", -expires => "-1d");
  print $gd->png;
[download]

I've written a script to read in a list of nursing homes that was copied and pasted off the web. I pull this file in and write an output file that removes empty lines. I then pull the output file back in, and now I want to step through it and write certain elements to a database. There are three lines that contain information that I want to skip, as shown by the matches. I've been doing a lot of troubleshooting and can't seem to figure out where I've gone wrong. When I run the code, I get no errors, but no data in the database either.

#!c:/xampp/perl/bin/perl
 
use strict;
use warnings;
use DBI;
use dbConnect_nursing;

sub printVariables(@_)
{
    foreach my $variable (@_)
    {
        print $variable . "\n";
    }
    print "###############################################\n";
}

sub processLine
{
    my @temp;
    chomp($_[0]);
    unshift(@temp, $_[0]);
    my $var = shift(@temp);
    return $var;
}
################################### connect to the database ##########
+##################################
# data source name
my $dsn = "DBI:$dbConnect::db_platform:$dbConnect::db_database:$dbConn
+ect::db_host:$dbConnect::db_port";

# perl DBI connect
my $connect = DBI->connect($dsn, $dbConnect::db_user, $dbConnect::db_p
+w, {'RaiseError' => 1});
################################### connect to the database ##########
+##################################
my @file_array;
my $in_file = "c:\\nursing_homes.txt";
my $out_file = "c:\\nursing_homes_out.txt";
if (-e $out_file)
{
    unlink $out_file;
}
open INPUT,'<',$in_file or die "Can't open file " . $in_file . "\n$!\n
+"; #Open for read
open OUTPUT,'>',$out_file or die "Can't open file " . $out_file . "\n$
+!\n"; #Open for write
    while (<INPUT>)
    {
        chomp ($_);
        next if $_ =~ /^\s*$/;  # skip over blank lines
        print OUTPUT $_ . "\n";
    }
    close INPUT;
    close OUTPUT;
    
open INPUT,'<',$out_file or die "Can't open file " . $out_file . "\n$!
+\n"; #Open for read
    while (<INPUT>)
    {
        my $name = $connect->quote($_);
        next;
        my $address1 = $connect->quote($_);
        next;
        my $address2 = $connect->quote($_);
        next;
        my $phone = $connect->quote($_);
        next;
        next if (($_ =~ /^.*Council.*$/) || ($_ =~ /^Continuing.*$/) |
+| ($_ =~ /^Mapping.*$/));
        next if (($_ =~ /^.*Council.*$/) || ($_ =~ /^Continuing.*$/) |
+| ($_ =~ /^Mapping.*$/));
        next if (($_ =~ /^.*Council.*$/) || ($_ =~ /^Continuing.*$/) |
+| ($_ =~ /^Mapping.*$/));
        my $overall = $connect->quote($_);
        next;
        my $inspections = $connect->quote($_);
        next;
        my $staffing = $connect->quote($_);
        next;
        my $quality = $connect->quote($_);
        next;
        my $programs = $connect->quote($_);
        next;
        my $beds = $connect->quote($_);
        next;
        my $ownership = $connect->quote($_);
        next;
        my $query_string = "INSERT INTO nursing_homes (name, address1,
+ address2, phone, overall, inspections, staffing, quality, programs, 
+beds, ownership) VALUES ($name, $address1, $address2, $phone, $overal
+l, $inspections, $staffing, $quality, $programs, $beds, $ownership)";
        #printVariables($name, $address1, $address2, $phone, $overall,
+ $inspections, $staffing, $quality, $programs, $beds, $ownership, $qu
+ery_string);
        my $query_handle = $connect->prepare("INSERT INTO nursing_home
+s (name, address1, address2, phone, overall, inspections, staffing, q
+uality, programs, beds, ownership) VALUES ($name, $address1, $address
+2, $phone, $overall, $inspections, $staffing, $quality, $programs, $b
+eds, $ownership)");
        $query_handle->execute();
    }

close INPUT;
$connect->disconnect();
__END__
[download]

Sample data is below:

AARON MANOR REHABILITATION & NURSING CENTER
100 ST CAMILLUS WAY
FAIRPORT, NY 14450
(585) 377-4000
Resident Council
Mapping & Directions
4 out of 5 stars
4 out of 5 stars
3 out of 5 stars
4 out of 5 stars
Medicare and Medicaid
140
For profit - Corporation
ABSOLUT CTR FOR NURSING & REHAB ALLEGANY LLC
2178 NORTH FIFTH STREET
ALLEGANY, NY 14706
(716) 373-2238
Resident & Family Councils
Mapping & Directions
3 out of 5 stars
4 out of 5 stars
1 out of 5 stars
4 out of 5 stars
Medicare and Medicaid
37
For profit - Corporation
ABSOLUT CTR FOR NURSING & REHAB AURORA PARK LLC
292 MAIN STREET
EAST AURORA, NY 14052
(716) 652-1560
Resident Council
Mapping & Directions
1 out of 5 stars
1 out of 5 stars
2 out of 5 stars
4 out of 5 stars
Medicare and Medicaid
320
For profit - Corporation
ABSOLUT CTR FOR NURSING & REHAB DUNKIRK LLC
447 449 LAKE SHORE DRIVE WEST
DUNKIRK, NY 14048
(716) 366-6710
Resident Council
Mapping & Directions
1 out of 5 stars
2 out of 5 stars
1 out of 5 stars
2 out of 5 stars
Medicare and Medicaid
40
For profit - Corporation
[download]

Hello ye Monks!

This isn't strictly a perl question, but it's a pod question so be merciful..

I like writing my docs in pod and I write bash scripts from time to time. I want to keep the pod in the same file as the script 'cause bad things happen when they get separated (at least in my hands bad things happen...) I figured I could put my pod after an exit call in bash and I'd be fine, but it didn't work.

Anyway, the real question isn't a bash question it is: does pod have any magic syntax to fit inside of something like the comments of another language. EG, is there a way to write pod like this...

#! /bin/bash

echo "stupid bash user!  Write perl!"
exit

#=head1 NAME
# 
#Foo
#
#=head1 SYNOPSIS
# 
#Eat 100 pounds of bannanas
[download]

Or like this

#include stdio.h

void main () {
     printf("all that just to say this?  Use perl!\n");
}

/*
=head1 NAME

Foo

=head1 SYNOPSIS

Eat 100 pounds of bannanas
*/
[download]

...er... okay that works out of the box... but anyway, you get my point...

UPDATE: my original bash problem was just me being stupid. You can put pod after the exit in bash. Duh. However! I'm still curious if pod can operate inside another languages arbitrary line-based comments.

Another Update!: Yes. I suck and I waste your time. I admit it freely and accept any punishment you desire to inflict. Achem...

You can put the pod inside a string that does nothing in nearly any language. EG in bash:

#! /bin/bash

echo "Pileofrogs is a jerk!"

FOO=<<ENDOFPOD

=head1 NAME

i_suck

=head1 SYNOPSIS

To increase your overall suckage, simply introduce Pilofrogs into the 
+environment

=cut

ENDOFPOD
[download]

Trying in vain to extract click events made from Win32::GUI::MonthCal in a popup window, so when a date is selected in the monthcal object, it can be fetched and used to populate the date field in the parent window

I'm not sure which element to target to catch the event.

Has anyone used this GUI object before and faced the same issue?

Very little example code around, apart from the bare bones at

http://perl-win32-gui.sourceforge.net/cgi-bin/docs.cgi?doc=monthcal

TIA