cpan YAML Data::Dumper Spreadsheet::WriteExcel Tie::IxHash Encode Scalar::Util DBI DBD::mysql JSON MongoDB File::Basename Excel::Writer::XLSX IO::File MIME::Base64 Encode::Encoding
Note:
# MySQL database information
#
use strict;
use DBI;
package myConnectDB;
# Assign a variable, as the body must do something in lue of a proper constructor.
our $someVarName="myConnectDB";
return 1; # True
#-------------------------------------------------------------------------------
# Return a connection to database
#-------------------------------------------------------------------------------
sub db_connect {
# Default - Localhost
my $db="testDatabase";
my $host="127.0.0.1";
my $port="3306";
my $userid="someUser";
my $passwd="somePassword";
#
my $connectionInfo="DBI:mysql:database=$db;$host:$port";
#
if ( @_ == 3 ) {
($connectionInfo,$userid,$passwd) = @_;
}
# database information
my $dbh = DBI->connect($connectionInfo,$userid,$passwd)
or die "Couldn't connect to database: " . DBI->errstr;
return $dbh;
}
# #### END ####
#
# Purpose: Assorted Excel related functions
#
use strict;
use Spreadsheet::WriteExcel;
use Excel::Writer::XLSX;
use Tie::IxHash;
use Scalar::Util 'reftype';
use JSON;
use File::Basename;
use Data::Dumper;
use IO::File;
package myExcelLib;
sub getValue;
my $myExcelLib = 1;
return 1; # True
# --------------------------------------------
sub base64_encode_file {
# see: http://perl.find-info.ru/perl/003/base64.htm (have been using this)
# alternatively: http://perldoc.perl.org/Encode/Encoder.html#Example%3a-base64-transcoder
# Or: http://perldoc.perl.org/MIME/Base64.html
}
# --------------------------------------------
sub getValue{
my ($sKey, $rhDoc,$bReturnRef)=@_;
my ($sKeyPt1,$sKeyPt2,$sKeyPt3,$refType);
$refType="";
if ( ($sKey =~ /^[^.]*[.]/) ){
($sKeyPt1, $sKeyPt2) = ($sKey =~ /^([^.]+)\.(.+)$/ );
$refType = reftype($rhDoc->{$sKeyPt1});
if ( $refType && $refType eq 'HASH' ) {
return getValue($sKeyPt2, $rhDoc->{$sKeyPt1});
}
elsif ( $refType && $refType eq 'ARRAY' ) {
if ( ($sKeyPt2 =~ /^[0-9]+$/) ){
return ($rhDoc->{$sKeyPt1}[$sKeyPt2]) if ( isNotARef($rhDoc->{$sKeyPt1}[$sKeyPt2]));
} else {
if ( ($sKeyPt2 =~ /^[0-9]+[.]/) ){
($sKeyPt2, $sKeyPt3) = ($sKeyPt2 =~ /^([^.]+)\.(.+)$/ );
return getValue($sKeyPt3, $rhDoc->{$sKeyPt1}[$sKeyPt2]);
} else { #Default to first element of ARRAY, if no index given
return getValue($sKeyPt2, $rhDoc->{$sKeyPt1}[0]);
}
}
}
} else {
if ( ref($rhDoc->{$sKey}) eq "DateTime") {
my $dt = $rhDoc->{$sKey};
$dt->set_time_zone('UTC');
return ($dt->datetime);
}
return $rhDoc->{$sKey} if ( $bReturnRef || isNotARef($rhDoc->{$sKey}));
}
return ("");
} ## End sub
# --------------------------------------------
sub isNotARef($){
my ($refToTest)=@_;
if( ! ref($refToTest) || ref($refToTest) eq 'boolean'){
return 1;
}
return 0;
}
# --------------------------------------------
sub convertToExcel($$$$){
my ($sFilename, $oJsonData, $raOutFields, $sFileFormat)=@_;
my ($iRow,$iCol,$rhDoc,$oTitleFormat,$oTotalFormat,$oTotalPCTFormat,$oPCTFormat,$sKey,$workbook,$sVal,$oFormat);
# Create a new workbook and add a worksheet.
$sFileFormat = 'xls' if ( ! $sFileFormat );
if ( $sFileFormat =~ /^xlsx$/i ){
$workbook = Excel::Writer::XLSX->new("$sFilename") || die ("Couldn't create: $sFilename");
}
elsif ( $sFileFormat =~ /^xls$/i ){
$workbook = Spreadsheet::WriteExcel->new("$sFilename") || die ("Couldn't create: $sFilename");
}
else {
die ("Error: Unknown file format");
}
my $worksheet = $workbook->add_worksheet();
# Define a few commonly used pre-set Formats /Styles that can be applied by NAME
# Title format
$oTitleFormat = $workbook->add_format(
bg_color => 12,
color => 22,
pattern => 1,
border => 1,
bold => 1
);
$oTotalFormat = $workbook->add_format(
bold => 1,
top => 1,
num_format => '#,##0'
);
$oTotalPCTFormat = $workbook->add_format(
bold => 1,
top => 1,
num_format => 10
);
$oPCTFormat = $workbook->add_format(
num_format => 10
);
#Write the Column headings
$iCol=0;
$iRow=0;
foreach $sKey ( @{$raOutFields} ) {
$worksheet->write($iRow, $iCol++, $sKey, $oTitleFormat);
}
#Freeze the first Row
$worksheet->freeze_panes(1, 0);
#Write any passed JSON Data
if ($oJsonData){
foreach $rhDoc ( @{$oJsonData} ) {
$iRow++;
$iCol=0;
foreach $sKey ( @{$raOutFields} ) {
$sVal = getValue($sKey, $rhDoc, 'true');
if ( ref($sVal) eq 'HASH' ) {
$oFormat = undef;
if ( $sVal->{ 'format' } ) {
if ( ref($sVal->{ 'format' }) eq 'HASH') {
$oFormat = $workbook->add_format($sVal->{ 'format' });
} elsif ( $sVal->{ 'format' } eq 'Total' ) {
$oFormat = $oTotalFormat;
} elsif ( $sVal->{ 'format' } eq 'TotalPCT' ) {
$oFormat = $oTotalPCTFormat;
} elsif ( $sVal->{ 'format' } eq 'PCT' ) {
$oFormat = $oPCTFormat;
}
}
$worksheet->write($iRow, $iCol, $sVal->{ 'value' }, $oFormat );
} else {
$worksheet->write($iRow, $iCol, $sVal);
}
$iCol++;
} # End - foreach $sKey
} #End Foreach row (JSON object)
}
return $iRow;
} ## End sub
Note: The above code has been cannibalised / butchered from a larger package I created some time ago, it's not complete, but the links will point you at a code snippet you can use to complete the Base64 encode logic / re-write. I have also cut out a load of other named Styles I personally use for my own purposes (left just enough to provide a few ideas). If you want to add you own names styles the
spreadsheet::WriteExcel page provides plenty of info and examples. I have also omitted a few lines of code that walk the passed JSON style object, for all keys when $raOutFields is null.
#!/usr/bin/perl -w
# Purpose: Example - Query a Database, play with then output, write to an Excel sheet, encode and email
use strict;
use DBI;
use myConnectDB;
use myExcelLib;
sub mail_monthly_report($);
# make a connection to the database DB
my $dbh = myConnectDB::db_connect();
print mail_report($dbh)."\n\n";
# disconnect from database
$dbh->disconnect;
exit;
# -------------------------------------------
# Retrieve the data for the report
# -------------------------------------------
sub get_report_info($) {
my ($dbh) = @_;
my ($sQuery, $sth, @aResults, $rhDoc, $iRow);
my ($dbSummary_seller, $dbSummary_producttype, $dbSummary_completed, $dbSummary_suspended, $dbSummary_cancelled, $dbSummary_count);
#
# PSEUDO SQL - Replace with something sensible
#
# prepare and execute query
$sQuery = "SELECT l.name as 'Seller',
l.productType,
IF((s.cancelled <> 0), 'N', s.completed) as Completed,
s.suspended,
IF((s.cancelled <> 0), 'Y', 'N') as Cancelled,
count(5)
FROM sales s,
login l
WHERE s.Seller = l.id
GROUP BY Seller,
s.productType,
Completed,
Cancelled,
s.suspended
ORDER BY Seller,
s.productType,
Completed,
Cancelled,
s.suspended";
$sth = $dbh->prepare($sQuery)
or die "Couldn't prepare statement: " . $dbh->errstr;
$sth->execute()
or die "Couldn't execute statement: " . $sth->errstr;
# assign fields to variables
$sth->bind_columns(undef,
\$dbSummary_seller,
\$dbSummary_producttype,
\$dbSummary_completed,
\$dbSummary_suspended,
\$dbSummary_cancelled,
\$dbSummary_count
);
#Make sure we have a a few numbers.
if ($sth->rows > 0) {
$iRow=1;
# output member list to browser as drop-down listings
while($sth->fetch()) {
$iRow++;
$rhDoc = undef;
$rhDoc->{ 'Seller' } = $dbSummary_seller;
$rhDoc->{ 'Product Type' } = $dbSummary_producttype;
$rhDoc->{ 'Completed' } = $dbSummary_completed;
$rhDoc->{ 'Suspended' } = $dbSummary_suspended;
$rhDoc->{ 'Cancelled' } = $dbSummary_cancelled;
$rhDoc->{ 'Product Count' } = $dbSummary_count;
#
# Add a formula to calculate the Percentage of the total
#
$rhDoc->{ 'Percentage Of All' }->{ 'value' } = "=(F$iRow/F".($sth->rows + 2).")";
$rhDoc->{ 'Percentage Of All' }->{ 'format' } = 'PCT';
push(@aResults,$rhDoc);
}
$sth->finish();
#
# Add a Styles Column Summary / Total Row to the Doc
#
$rhDoc = undef;
$rhDoc->{ 'Product Count' }->{ 'value' } = "=SUM(F2:F$iRow)";
$rhDoc->{ 'Product Count' }->{ 'format' } = 'Total';
$rhDoc->{ 'Percentage Of All' }->{ 'value' } = "=SUM(G2:G$iRow)";
$rhDoc->{ 'Percentage Of All' }->{ 'format' } = 'TotalPCT';
push(@aResults,$rhDoc);
return \@aResults;
}
return undef
}
# -------------------------------------------
# Extract and Email a file
# -------------------------------------------
sub mail_report($) {
my $raResults = get_report_info($_[0]);
if ($raResults) {
#
my $sFileName = "Some_Report.xls";
my $sTmpDir = '/tmp/';
my $sOriginator = "doNotReply\@some.host.com";
my $sRecipient = "some.user\@some.host.com";
my $sMessage = "\n\nSome report detailing some random statistics:\n\n";
#
my $sBoundary = "====" . time() . "====";
my $sendmail = "/usr/sbin/sendmail -t";
my $reply_to = "Reply-to: $sOriginator\n";
my $subject = "Subject: $sMessage\n";
my $send_to = "To: $sRecipient\n";
my $cc = "Cc: $sOriginator\n";
my $raOutFields = ['Seller', 'Product Type', 'Completed', 'Suspended', 'Cancelled', 'Product Count','Percentage Of All'];
my $iRowsWritten = myExcelLib::convertToExcel ("$sTmpDir$sFileName", undef, $raResults, $raOutFields, 'xls');
open(DLFILE, "<$sTmpDir$sFileName") || Error('open', 'file');
my @fileholder = <DLFILE>;
close (DLFILE) || Error ('close', 'file');
open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!";
print SENDMAIL $reply_to;
print SENDMAIL $send_to;
print SENDMAIL $cc;
print SENDMAIL $subject;
print SENDMAIL "Mime-Version: 1.0\n";
print SENDMAIL "Content-Type: multipart/mixed; boundary=\"$sBoundary\"\n";
print SENDMAIL "Content-Disposition: inline\n\n";
print SENDMAIL "--$sBoundary\n";
print SENDMAIL "Content-type: text/plain\n\n";
print SENDMAIL $sMessage;
print SENDMAIL "--$sBoundary\n";
print SENDMAIL "Content-Type: application/octet-stream; name=\"$sFileName\"\n";
print SENDMAIL "Content-Disposition: attachment; filename=\"$sFileName\"\n";
print SENDMAIL "Content-Transfer-Encoding: base64\n\n";
print SENDMAIL myExcelLib::base64_encode_file("$sTmpDir$sFileName")."\n";
print SENDMAIL "\n--$sBoundary--\n";
close(SENDMAIL);
# Delete the local copy of the Excel sheet
unlink("$sTmpDir$sFileName");
#
return "$sMessage - has been emailed\n";
}
return 'Error: Unable to send email report';
}
## End ###
Note: You'll obviously need to alter the: SQL query, email recipients, email originator, email subject, and message. You may also need to alter the location of the sendmail binary and the instantiation of $sTmpDir
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (0)