##
####
#!/usr/bin/env perl
use Mojolicious::Lite;
plugin 'HTMLTemplateProRenderer';
# Route leading to an action that renders a template
get '/test' => sub {
my $c = shift;
$c->stash( one => 'This is result one' );
$c->render(
template => 'display/index',
two => 'this is the second',
handler => 'tmpl'
);
};
app->start;
####
Test Template
Value ONE =
Value TWO =
####
#!/usr/bin/perl
use strict;
use warnings;
use DBI;
use File::Find::Rule;
use PDF::API2;
use File::Basename;
#use Data::Dumper;
#use Data::Dump 'pp';
my $t0 = time();
my ($got_count, $got_timed, $got_total_pages) = get_pdfs();
print "\n\n Result: $got_count files found in $got_timed seconds - Total number of pages: $got_total_pages\n\n\n";
exit;
sub get_pdfs {
my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
f_ext => ".txt/r",
#f_dir => "",
f_enc => "utf-8",
RaiseError => 1 }
) or die "Cannot connect: $DBI::errstr";
$dbh->{csv_tables}{prod_pdf_files} = {
f_file => "data.txt", # list of file names to search
col_names => [qw( file_name location acc_nbr )],
};
my $sth = $dbh->prepare ("
SELECT DISTINCT file_name, location
FROM prod_pdf_files
--WHERE file_name LIKE ?
");
#$sth->execute('%.pdf');
$sth->execute();
my $pdfs = $sth->fetchall_arrayref();
#pp @$pdfs;
my $count = 0;
my $totalpages = 0;
my $other_path = '/alldocs';
foreach my $files ( @{$pdfs} ) {
next unless ($files->[0] =~ m/\.pdf$/i);
my $filename_loc = $other_path.$files->[1].$files->[0];
my $pages = pdf_pagecount( $filename_loc );
$totalpages += $pages;
$count++;
}
my $dur = time()-$t0;
return $count, $dur, $totalpages;
} # End get_pdfs Sub
sub pdf_pagecount {
my $doc = shift;
my $pages;
eval { my $pdf = PDF::API2->open($doc);
$pages = $pdf->pages;
};
if ($@){
warn "$doc | Error captured : $@\n";
} else {
return $pages;
};
}
####
SV = PV(0x2af86f0) at 0x3474b90
REFCNT = 1
FLAGS = (PADMY,POK,pPOK)
PV = 0x3f642a0 "testa.pdf"\0
CUR = 34
LEN = 40
SV = PV(0x2af86f0) at 0x3474b90
REFCNT = 1
FLAGS = (PADMY,POK,pPOK)
PV = 0x3f62a20 "testb.pdf"\0
CUR = 34
LEN = 40
####
{
"abc.pdf" => "no match",
"testa.pdf" => 0,
"some.pdf" => "no match",
"interior.pdf" => "no match",
"onec.pdf" => "no match",
"macx.pdf" => "no match",
"testb.pdf" => 0,
"conts.pdf" => "no match",
}
####
#!/usr/bin/perl
use strict;
use warnings;
use DBI;
use PDF::API2;
use Data::Dump 'pp';
use File::Basename;
use File::Find::Rule;
my $t0 = time();
#my $pdfs = get_pdfs();
my $pdfs = ();
%{$pdfs} = (
"testa.pdf" => 0,
"testb.pdf" => 0,
);
#pp $pdfs;
my @search_dirs = ('/doca', '/docb');
my $rule = File::Find::Rule->new;
$rule->file;
$rule->name( '*.pdf' );
my $count = 0;
my $totalpages = 0;
for my $file ($rule->in(@search_dirs)){
my ($filename, $path) = fileparse($file);
#print " *$filename* ^$pdfs->{$filename}^\n";
if (exists $pdfs->{$filename}){
my $pages = get_pagecount($file);
$totalpages += $pages;
print " $filename | $pages | $path\n"; # print to file
++$count;
}#else { print " File $filename not found in $path\n";}
};
my $dur = time()-$t0;
print "\n\n Results: $count files found in $dur seconds - Total number of pages: $totalpages\n\n\n";
sub get_pagecount {
my $doc = shift;
my $pages;
eval { my $pdf = PDF::API2->open($doc);
$pages = $pdf->pages;
};
if ($@){
warn "$doc | Error captured : $@\n";
} else {
return $pages;
};
}
sub get_pdfs {
my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
f_ext => ".txt/r",
#f_dir => "db",
f_enc => "utf-8",
RaiseError => 1 }
) or die "Cannot connect: $DBI::errstr";
$dbh->{csv_tables}{prod_pdf_files} = {
f_file => "prod_pdf_test.txt", # list of file names to search - test file = prod_pdf_test.txt
col_names => [qw( doc_name file_name acc_nbr )],
};
my $sth = $dbh->prepare ("
SELECT DISTINCT file_name
FROM prod_pdf_files
WHERE LOWER(file_name) LIKE ?
");
$sth->execute('%.pdf');
my $pdfs = $sth->fetchall_arrayref();
my %pdfs = map{lc($_->[0]) => 0} @$pdfs;
#pp \%pdfs;
return \%pdfs;
}
####
my $pdfs = get_pdfs();
pp $pdfs;
# pp sample from data in text file
{
"testa.pdf" => 0,
"testb.pdf" => 0,
}
...
for my $file ($rule->in(@search_dirs)){
my ($filename, $path) = fileparse($file);
if (exists $pdfs->{$filename}){
my $pages = get_pagecount($file);
print " $filename,$pages,$path\n"; # print to file
++$count;
}else { print " File $filename not found in $path\n";}
};
..
####
#!/usr/bin/perl
use strict;
use warnings;
use DBI;
use File::Find::Rule;
use PDF::API2;
use File::Basename;
use Data::Dumper;
my $t0 = time();
# Get PDFs from file:
my $pdfs = get_pdfs();
#print Dumper $pdfs;
# Search for these pdf files:
my $got_pdf = search_pdf( $pdfs );
#print Dumper $got_pdfs;
# Process these pdf files:
my $results = process_data($got_pdf);
#print Dumper $results;
# Display time to process files
my $dur = time()-$t0;
print "$results doc processed in $dur seconds\n";
sub get_pdfs {
my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
f_ext => ".txt/r",
#f_dir => "",
f_enc => "utf-8",
RaiseError => 1 }
) or die "Cannot connect: $DBI::errstr";
$dbh->{csv_tables}{prod_pdf_files} = {
f_file => "pdfs.txt", # list of file names to search
col_names => [qw( doc_name file_name acc_nbr )],
};
my $sth = $dbh->prepare ("
SELECT DISTINCT file_name
FROM prod_pdf_files
--WHERE file_name LIKE ?
");
#$sth->execute('%.pdf'); # removed cause it could be .PDF or .pdf
$sth->execute();
my $pdfs = $sth->fetchall_arrayref();
my %pdfs = map{$_->[0]=> 0} @$pdfs;
#print Dumper \%pdfs;
return \%pdfs;
} # End get_pdfs Sub
sub search_pdf {
my $pdf_ref = shift;
my %pdf = %$pdf_ref;
my @pdfs = keys %pdf;
my @search_dirs = ( '/doca', '/docb');
my $rule = File::Find::Rule->new;
$rule->file;
my @found_pdf;
foreach my $pdf_file (@pdfs) {
$rule->name( $pdf_file );
for my $files ($rule->in(@search_dirs)){
#print $files,"\n";
push @found_pdf, $files;
};
}
return \@found_pdf;
} # End search pdfs Sub
sub process_data {
my $pdfs_file = shift;
my $totalpages = 0;
# To log results in a file.
#my $page_count = 'count_pdf_pages.txt';
#open my $fh, '>>', $page_count or die "Unable to create file: $!";
#print $fh "filename,path,full_path,pages\n";
foreach my $doc (@{$pdfs_file}) {
next unless ($doc =~ m/\.pdf$/i);
my ($filename, $path) = fileparse($doc);
eval { my $pdf = PDF::API2->open($doc); # or die "Can't open PDF file $doc: $!";
my $pages = $pdf->pages;
$totalpages += $pages;
# log results into a file
#print $fh "$filename,$path,$doc,$pages\n";
print " File name: $filename - Number of pages: $pages\n";
};
print "$doc | Error captured : $@\n" if $@;
}
#close $fh;
return $totalpages;
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use File::Find qw(finddepth);
use File::Find qw(find);
use PDF::API2;
use Time::Progress;
use List::MoreUtils qw( natatime );
use Time::Piece;
use File::Basename;
use DBI;
BEGIN {
# Set up log file
my $log_file = "log.txt";
use CGI::Carp qw(carpout);
open(LOG, ">>$log_file") or print "Unable to append to log: $!";
carpout(*LOG);
$| = 1; # Disable buffering
}
# Where to search
my @search_dirs = ( "/doca", "/docb" ); # dir doca size is 1.6TB and docb size is 3.1TB
my $stime = Time::Piece->new;
my $started_time = $stime->hms;
my $start_time = Time::Piece->strptime( $started_time, '%H:%M:%S' );
my @pdf_files;
# call list_dirs sub
my $data = list_dirs(\@search_dirs);
if ($data eq "NoData") {
print "\n No SQL data available.\n\n";
exit;
}
my $count_data = scalar @$data;
# Start progress bar
$| = 1;
my $p = new Time::Progress;
print "\n Starting Counting Process: \n\n";
my $total_pages = process_data($data);
print "\n\n Total Number of pages: $total_pages\n";
warn " Total Number of pages: $total_pages\n";
my $etime = Time::Piece->new;
my $end_t = $etime->hms;
my $end_time = Time::Piece->strptime( $end_t, '%H:%M:%S' );
my $done_time = $end_time - $start_time;
my $converted_time = convert_time($done_time);
print " \n\n Started at: $started_time \n";
print " \n Ended at: $end_t \n";
print "\n Processing time: $converted_time \n\n\n";
warn " Started at: $started_time | Ended at: $end_t | Processing time: $converted_time\n";
exit;
sub process_data {
my $dirs = shift;
my $c = 0;
my $totalpages = 0;
foreach my $doc (@{$dirs}) {
$c++;
next unless ($doc =~ m/\.pdf$/i);
print $p->report(" %45b %p\r", $c);
my ($filename, $path) = fileparse($doc);
eval { my $pdf = PDF::API2->open($doc);
my $pages = $pdf->pages;
$totalpages += $pages;
#log results
warn" $doc | $filename: Pages: $pages\n";
};
warn "$doc | Error captured : $@\n" if $@;
}
print $p->report("\n Done %p elapsed: %L (%l sec)", $c);
return $totalpages;
}
sub list_dirs {
my ($dirs_ref ) = @_;
my @dirs = @{ $dirs_ref };
print "\n Searching in: @dirs \n\n";
my @files;
# call process sub
find( { wanted => \&process, follow => 0, no_chdir => 1 }, @dirs);
print "\n\n Found PDF docs in:\n\n";
foreach my $found_pdf_doc (@pdf_files) {
next unless ($found_pdf_doc =~ m/\.pdf$/i);
}
# I only want values with path and file names in it.
for ( my $index = $#pdf_files; $index >= 0; --$index ) {
splice @pdf_files, $index, 1 if $pdf_files[$index] !~ m/\.pdf$/i;
}
return \@pdf_files;
}
sub process{
my $dbh = DBI->connect ("dbi:CSV:", undef, undef, {
f_ext => ".txt/r",
f_enc => "utf-8",
});
$dbh->{csv_tables}{prod_pdf_files} = {
file => "pdfs.txt", # list of file names to search
col_names => [qw( doc_name file_name acc_nbr )],
};
my $sth = $dbh->prepare ("SELECT DISTINCT file_name FROM pdfs ");
$sth->execute;
my $sql_data = $sth->fetchrow_hashref;
my @filenames = ();
while (my $row = $sth->fetchrow_hashref) {
next unless ($row->{file_name} =~ m/\.pdf$/i);
push @filenames, $row->{file_name};
}
my $addfile = 0;
my $pdfs_iter = natatime( 50, @filenames );
my $c = 0;
while (my @files = $pdfs_iter->()) {
$c++;
for my $test_file (@files) {
if( index( $_,$test_file ) >-1 ) {
++$addfile;
last;
}
}
}
push @pdf_files, $File::Find::name;# if $addfile;
} # End process Sub
sub convert_time {
my $time = shift;
my $days = int($time / 86400);
$time -= ($days * 86400);
my $hours = int($time / 3600);
$time -= ($hours * 3600);
my $minutes = int($time / 60);
my $seconds = $time % 60;
$days = $days < 1 ? '' : $days .'d ';
$hours = $hours < 1 ? '' : $hours .'h ';
$minutes = $minutes < 1 ? '' : $minutes . 'm ';
$time = $days . $hours . $minutes . $seconds . 's';
return $time;
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use File::Basename;
#my @files = grep { -f } glob( 'data/*.txt' );
#=code
# content of @files
my @files = (
"dir/file1_2016-04-05.txt",
"dir/file2_2016-04-05.txt",
"dir/file3_2016-04-05.txt",
"dir/file4_2016-04-05.txt",
);
#=cut
foreach my $file (@files) {
my $filename = basename($file);
my ($name,$ymd) = split '_',$filename;
doresults( $filename, "account" ) if $filename =~ /^file1.*/ig;
doresults( $filename, "process" ) if $filename =~ /^file2.*/ig;
doresults( $filename, "numbers" ) if $filename =~ /^file3.*/ig;
doresults( $filename, "names" ) if $filename =~ /^file4.*/ig;
}
sub doresults {
my ($filename, $recs ) = @_;
print "\n $filename = $recs\n";
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use File::Basename;
my $data_href = {
'account' => '',
'process' => \&test_pro,
'numbers' => \&test_numb,
'names' => \&test_nam,
};
my @keys = keys %$data_href;
pp @keys;
sub test_pro { return 1;}
sub test_numb { return 1;}
sub test_nam { return 1;}
#my %hrefdata = reverse %$data_href;
#my @files = grep { -f } glob( 'data/*.txt' );
#=code
# content of @files
my @files = (
"dir/file1_2016-04-05.txt",
"dir/file2_2016-04-05.txt",
"dir/file3_2016-04-05.txt",
"dir/file4_2016-04-05.txt",
);
#=cut
foreach my $file (@files) {
my $filename = basename($file);
my ($name,$ymd) = split '_',$filename;
# The values of $hrefdata{$name} should be:
foreach my $match (@keys) {
if($filename =~ /^file1.*/ig) {
doresults( $filename, "account" );
}
if($filename =~ /^file2.*/ig) {
doresults( $filename, "process" );
}
if($filename =~ /^file3.*/ig) {
doresults( $filename, "numbers");
}
if($filename =~ /^file4.*/ig) {
doresults( $filename, "names" );
}
}
}
sub doresults {
my ($filename, $recs ) = @_;
print "\n $filename = $recs\n";
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use File::Basename;
my $data_href = {
'account' => '',
'process' => \&test_pro,
'numbers' => \&test_numb,
'names' => \&test_nam,
};
my @keys = keys %$data_href;
pp @keys;
sub test_pro { return 1;}
sub test_numb { return 1;}
sub test_nam { return 1;}
my %hrefdata = reverse %$data_href;
#my @files = grep { -f } glob( 'data/*.txt' );
#=code
# content of @files
my @files = (
"dir/names_2016-04-05.txt",
"dir/account_2016-04-05.txt",
"dir/numbers_2016-04-05.txt",
"dir/process_2016-04-05.txt",
);
#=cut
foreach my $file (@files) {
my $filename = basename($file);
my ($name,$ymd) = split '_',$filename;
# The values of @keys should be:
=code
names
account
process
numbers
=cut
foreach my $match (@keys) {
if($filename =~ /^$match.*/ig) {
doresults( $filename, $match );
}
}
}
sub doresults {
my ($filename, $recs ) = @_;
print "\n $filename = $recs\n";
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use File::Basename;
my $data_href = {
'account' => '',
'process' => \&test_pro',
'numbers' => \&test_numb,
'names' => \&test_nam,
};
sub test_pro { return 1;}
sub test_numb { return 1;}
sub test_nam { return 1;}
my %hrefdata = reverse %$data_href;
my @files = grep { -f } glob( 'data/*.txt' );
=code
# content of @files
(
"dir/names_2016-04-05.txt",
"dir/account_2016-04-05.txt",
"dir/numbers_2016-04-05.txt",
"dir/process_2016-04-05.txt",
)
=cut
foreach my $file (@files) {
my $filename = basename($file);
my ($name,$ymd) = split '_',$filename;
# The values of $hrefdata{$name} should be:
=code
names
account
process
numbers
=cut
# it should be called 4 times here
if (exists $hrefdata{$name}){
doresults( $filename, $hrefdata{$name} );
} else {
print "NOT EXISTS $name\n";
}
}
sub doresults {
my ($filename, $recs ) = @_;
print "\n $filename = $recs\n";
}
####
...
my $data_href = {
'account' => '',
'process' => \&test_pro',
'numbers' => \&test_numb,
'names' => \&test_nam,
};
sub test_pro { return 1;}
sub test_numb { return 1;}
sub test_nam { return 1;}
...
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use File::Basename;
my $data_href = {
'account' => '',
'process' => \&test_pro',
'numbers' => \&test_numb,
'names' => \&test_nam,
};
sub test_pro { return 1;}
sub test_numb { return 1;}
sub test_nam { return 1;}
my %hrefdata = reverse %$data_href;
my @files = grep { -f } glob( 'data/*.txt' );
=code
# content of @files
(
"dir/result_2016-04-05.txt",
"dir/data_2016-04-05.txt",
"dir/values_2016-04-05.txt",
"dir/circle_2016-04-05.txt",
)
=cut
foreach my $file (@files) {
my $filename = basename($file);
# it should be called 4 times here
if (exists $hrefdata{$filename}){
doresults( $filename, $hrefdata{$filename} );
} else {
print "NOT EXISTS $filename\n";
}
}
sub doresults {
my ($filename, $recs ) = @_;
print "\n $filename = $recs\n";
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use File::Basename;
my $data_href = {
'account' => 'result',
'process' => 'data',
'numbers' => 'values',
'names' => 'circle',
};
my %hrefdata = reverse %$data_href;
my @files = grep { -f } glob( 'data/*.txt' );
=code
# content of @files
(
"dir/result_2016-04-05.txt",
"dir/data_2016-04-05.txt",
"dir/values_2016-04-05.txt",
"dir/circle_2016-04-05.txt",
)
=cut
foreach my $file (@files) {
my $filename = basename($file);
# it should be called 4 times here
if (exists $hrefdata{$filename}){
doresults( $filename, $hrefdata{$filename} );
} else {
print "NOT EXISTS $filename\n";
}
}
sub doresults {
my ($filename, $recs ) = @_;
print "\n $filename = $recs\n";
}
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use Data::Dumper;
my $data_href = {
'account' => 'result.txt',
'process' => 'data.txt',
'numbers' => 'values.txt',
'names' => 'circle.txt',
};
my @files = grep { -f } glob( 'data/*.txt' );
=code
# content of @files
(
"dir/result.txt",
"dir/data.txt",
"dir/values.txt",
"dir/circle.txt",
)
=cut
my %hrefdata = reverse %$data_href;
my %fields = ();
foreach my $file (@files) {
my $filename = $file;
# get just the filename
$filename =~ s/(.*?)\/([^\/]+)$/$2/ig;
# it should be called 4 times here
doresults( $filename, $hrefdata{$filename} ) if exists $hrefdata{$filename};
}
sub doresults {
my ($filename, $recs ) = @_;
print "\n $filename = $recs\n";
}
####
#!/usr/bin/perl
use strict;
use warnings;
use PDF::API2;
use PDF::Table;
use Data::Dump 'pp';
# Start PDF Process
my $pdf = PDF::API2->new(-file => "test.pdf");
#A4 Landscap
$pdf->mediabox('Letter');
my $page = $pdf->page;
# font settings
my $font_size = 12;
my $fnt = $pdf->corefont('Helvetica',-encode => 'latin1');
my $boldfont = $pdf->corefont('Helvetica-Bold',-encode => 'latin1');
my $fnt_t = $pdf->corefont('Times-Roman',-encode => 'latin1');
my $boldfont_t = $pdf->corefont('Times-Bold',-encode => 'latin1');
my $txt = $page->text();
#my $txt_under = $page->text(-underline => 'auto');
my $top = 700;
my $left_margin = 50;
my $left_margin_a = 100;
$txt->textstart;
# First Underlined sentence
$txt->font($fnt,11);
$txt->translate( 50, $top-147 );
$txt->text( "Mauris rutrum luctus rhoncus.", -underline => 'auto');
# SEcond Underlined sentence
$txt->font($fnt,11);
$txt->translate( 345, $top-147 );
$txt->text( "vel est at, tincidunt accumsan velit.", -underline => 'auto');
my $block = $page->text();
$block->translate( 50, $top-100);
$block->font($fnt,11);
$block->lead(16);
$block->section("Aliquam vitae ipsum id felis finibus congue. Ut molestie scelerisque purus,
sit amet rhoncus leo aliquet ac. In eu lobortis quam. Maecenas auctor semper enim,
ut convallis sapien dictum eu. Sed arcu ex, ornare et porttitor vitae, interdum a mi.
Quisque velit quam, convallis
Fusce ut metus ut which may either exceed \$1,000.00 or OK. G. LAT,
semper nunc, in dictum magna.
Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra ligula. Suspendisse
efficitur imperdiet eros, XXsed rhoncus sapien euismod cursus. Vestibulum a posuereYY elit,
eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, posuere lectus.", 400, 500);
=code
### START OPTION
my $new_lines = "Aliquam vitae ipsum id felis finibus congue. Ut molestie scelerisque purus,
sit amet rhoncus leo aliquet ac. In eu lobortis quam. Maecenas auctor semper enim,
ut convallis sapien dictum eu. Sed arcu ex, ornare et porttitor vitae, interdum a mi.
Mauris rutrum luctus rhoncus. Quisque velit quam, convallis vel est at, tincidunt accumsan velit.
Fusce ut metus ut which may either exceed \$1,000.00 or OK. G. LAT,
semper nunc, in dictum magna.
Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra ligula. Suspendisse
efficitur imperdiet eros, XXsed rhoncus sapien euismod cursus. Vestibulum a posuereYY elit,
eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, posuere lectus.";
my @lines = split/\n/, $new_lines;
my $y = $top - 162;
# reading the text line by line, I am marking the text I need to be underlined with ...
my $ul_flag=0;
for my $rows (@lines) {
$txt->font($fnt,11);
$txt->translate( $left_margin,$y);
# only split into parts lines than have at least one tag
#
if ( $rows =~ // ) {
# the capture brackets in split retain and
# as an separate element in @parts
my @parts = split /(<\/?u>)/,$rows;
for (@parts) {
if (//) {
$ul_flag = 1;
next;
};
if (/<\/u>/){
$ul_flag = 0;
next;
};
if ($ul_flag){
$txt->text($_,-underline => 'auto');
} else {
$txt->text($_);
}
}
} else {
$txt->text($rows);
}
$y-=17;
}
#### END OPTION
=cut
$txt->textend;
$pdf->save;
$pdf->end( );
####
#!/usr/bin/perl
use strict;
use warnings;
use PDF::API2;
use PDF::Table;
use Data::Dump 'pp';
# Start PDF Process
my $pdf = PDF::API2->new(-file => "test.pdf");
#A4 Landscap
$pdf->mediabox('Letter');
my $page = $pdf->page;
# font settings
my $font_size = 12;
my $fnt = $pdf->corefont('Helvetica',-encode => 'latin1');
my $boldfont = $pdf->corefont('Helvetica-Bold',-encode => 'latin1');
my $fnt_t = $pdf->corefont('Times-Roman',-encode => 'latin1');
my $boldfont_t = $pdf->corefont('Times-Bold',-encode => 'latin1');
my $txt = $page->text();
#my $txt_under = $page->text(-underline => 'auto');
my $top = 700;
my $left_margin = 50;
my $left_margin_a = 100;
$txt->textstart;
my $new_lines = "Aliquam vitae ipsum id felis finibus congue. Ut molestie scelerisque purus,
sit amet rhoncus leo aliquet ac. In eu lobortis quam. Maecenas auctor semper enim,
ut convallis sapien dictum eu. Sed arcu ex, ornare et porttitor vitae, interdum a mi.
Mauris rutrum luctus rhoncus. Quisque velit quam, convallis vel est at, tincidunt accumsan velit.
Fusce ut metus ut which may either exceed \$1,000.00 or OK. G. LAT,
semper nunc, in dictum magna.
Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra ligula. Suspendisse
efficitur imperdiet eros, XXsed rhoncus sapien euismod cursus. Vestibulum a posuereYY elit,
eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, posuere lectus.";
;
my @lines = split/\n/, $new_lines;
print Dumper \@lines;
my $y = $top - 162;
# reading the text line by line, I am marking the text I need to be underlined with ...
for my $rows (@lines){
print "57 *$rows*\n";
$txt->font($fnt,11);
$txt->translate( $left_margin,$y);
if( $rows =~ /(.*?)<\/u>/xms ){
# here I can get each section of text between the
my ($one, $two) = ($rows =~ /(.*?)<\/u>/sg);
# now, underline each portion found
$txt->text("$one",-underline => 'auto');
$txt->text("$two",-underline => 'auto');
# and here is where I thought I could just put the newly underlined text
# back into the orinal text, by replacing it in the original,but instead
# it replaces all the rows with the underlined text, its almost there.
$rows =~ s/(.*?)<\/u>/$one/;
$rows =~ s/(.*?)<\/u>/$two/;
$txt->text("$rows");
}else{
$txt->text("$rows");
}
$y-=17;
}
$txt->textend;
$pdf->save;
$pdf->end( );
####
my @lines = "Aliquam vitae ipsum id felis finibus congue. Ut molestie scelerisque purus,
sit amet rhoncus leo aliquet ac. In eu lobortis quam. Maecenas auctor semper enim,
ut convallis sapien dictum eu. Sed arcu ex, ornare et porttitor vitae, interdum a mi.
Mauris rutrum luctus rhoncus. Quisque velit quam, convallis vel est at, tincidunt accumsan velit.
Fusce ut metus ut which may either exceed \$1,000.00 or OK. G. LAT,
semper nunc, in dictum magna.
Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra ligula. Suspendisse
efficitur imperdiet eros, XXsed rhoncus sapien euismod cursus. Vestibulum a posuereYY elit,
eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, posuere lectus.";
;
my $y = $top - 162;
for my $rows (@lines){
$txt->font($fnt,11);
$txt->translate( $left_margin,$y);
if( $rows =~ /(.*?)<\/u>/xms ){
my $change = $rows;
$change =~ s/(.*?)<\/u>/$1/;
$txt->text("$change",-underline => 'auto');
}else{
$txt->text("$rows");
}
$y-=17;
}
####
Date::Calc::PP::Monday_of_Week(): Date::Calc::Monday_of_Week(): week out of range at splice_pie_3a.pl line 73
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use Time::Piece;
use Date::Calc qw(:all);
my $DIR = 'c:/temp';
my @VEH = qw(car bike);
my $hr_count = get_count($DIR);
#pp $hr_count;
report($hr_count,'report.txt');
sub get_count {
my $dir = shift;
my %count = ();
my $match = join '|',@VEH;
my %WK_JAN1=();
# for my $file (glob "$dir/*.txt"){
while (my $file = ){
if ($file =~ /(20\d{6})_($match)/){
my $date = $1;
my $veh = $2;
#open IN,'<',$file or die "Could not open $file : $!";
#my @lines = ;
#my $count = scalar @lines;
#close IN;
my $count = rand(100);
my $t = Time::Piece->strptime($date,"%Y%m%d");
my $y = $t->year;
# do this only once
unless (exists $WK_JAN1{$y}){
$WK_JAN1{$y} = Time::Piece->strptime($y.'0101',"%Y%m%d")->week
}
my $wk = $t->week;
if ($t->mon == 1 && $wk > 5){
$wk = 1;
} elsif ($WK_JAN1{$y} > 1) {
$wk += 1;
}
my $week = sprintf "%4d-%2d",$t->year,$wk;
$count{$week}{$date}{'wday'} = $t->wdayname; # Mon Tue Wed etc
$count{$week}{$date}{$veh} = $count;
$count{$week}{$date}{'total'} += $count;
$count{$week}{'total'}{'wday'} = '';
$count{$week}{'total'}{$veh} += $count;
$count{$week}{'total'}{'total'} += $count;
}
}
return \%count;
}
sub report {
my ($count,$filename) = @_;
#open OUT,'>',$filename
# or die "Could not open $filename : $!";
my $fmt_s = '%8s %8s'.(' %10s' x @VEH)." %10s \n";
my $fmt_d = '%8s %8s'.(' %10d' x @VEH)." %10d \n";
for my $wk (sort keys %$count){
my ($get_year, $get_week) = split /-/,$wk;
my ($year2, $month2, $day2) = Monday_of_Week($get_week, $get_year);
my $format_date = "$year2-$month2-$day2";
my $get_time = Time::Piece->strptime($format_date, '%Y-%m-%d');
print "\n".$get_time->fullmonth." ".$get_time->year." Week $get_week\n------------\n";
#print "\nWeek $wk\n------------\n";
printf $fmt_s,('Date','Day',@VEH,'Total');
for my $date (sort keys %{$count->{$wk}}){
my $rec = $count->{$wk}{$date};
my @values = map{$rec->{$_} || 0 }(@VEH,'total');
printf $fmt_d,$date,$rec->{wday},@values
}
}
#close OUT
}
__DATA__
20151231_car.txt
20160102_car.txt
20160102_bike.txt
20160104_car.txt
20160104_bike.txt
20160208_car.txt
20160208_bike.txt
20160308_car.txt
20160308_bike.txt
20160309_car.txt
20160309_bike.txt
20160314_car.txt
20160314_bike.txt
20160315_car.txt
20160315_bike.txt
20160316_car.txt
20160316_bike.txt
20161221_car.txt
20161231_bike.txt
20180101_car.txt
20180101_bike.txt
## ##
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use Time::Piece;
use Date::Calc qw(:all);
.....
sub report{
....
my ($get_year, $get_week) = split /-/,$wk;
my ($year2, $month2, $day2) = Monday_of_Week($get_week, $get_year);
my $format_date = "$year2-$month2-$day2";
my $get_time = Time::Piece->strptime($format_date, '%Y-%m-%d');
print "\n".$get_time->fullmonth." ".$get_time->year." Week $get_week\n------------\n";
....
}
####
/data/
20160102_car.txt
20160102_bike.txt
20160104_car.txt
20160104_bike.txt
20160208_car.txt
20160208_bike.txt
20160308_car.txt
20160308_bike.txt
20160309_car.txt
20160309_bike.txt
20160314_car.txt
20160314_bike.txt
20160315_car.txt
20160315_bike.txt
20160316_car.txt
20160316_bike.txt
20160317_car.txt
20160317_bike.txt
####
Week 2016- 1
------------
Date Day car bike Total
20160104 Mon 27 23 50
total 27 23 50
Week 2016- 6
------------
Date Day car bike Total
20160208 Mon 303 15 318
total 303 15 318
Week 2016-10
------------
Date Day car bike Total
20160308 Tue 303 15 318
20160309 Wed 11 15 26
total 314 30 344
Week 2016-11
------------
Date Day car bike Total
20160314 Mon 27 15 42
20160315 Tue 14 1 15
20160316 Wed 17 2 19
20160317 Thu 9 23 32
total 67 41 108
Week 2016-53
------------
Date Day car bike Total
20160102 Sat 27 23 50
total 27 23 50
####
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dump 'pp';
use Data::Dumper;
# Create Time::Piece New Object
my $t = Time::Piece->new();
report();
exit;
sub report {
my %count_cars;
my %count_bike;
my %count_cars_wkly;
my %count_bike_wkly;
my $dir = '/data';
my $todays_date = $t->mdy("/");
# Set days ago
my $past = $t - (7 * ONE_DAY);
my $just_today = $t->strftime('%Y%m%d');
opendir( DIR, $dir ) || die "Unable to open directory - $!\n";
my @files = grep /\.txt/, readdir( DIR );
closedir( DIR );
foreach my $file (@files) { # Open all files
if ($file=~/(20\d{2}\d{2}\d{2})_cars/) {
my $a_file = $1;
my $file_date = Time::Piece->strptime($a_file, '%Y%m%d');
# Weekly
if ( $file_date > $past) {
open( FA, "$dir/$file" ) || die "Unable to open $file - $!\n";
while( ) {
$count_cars_wkly{$_}++ if ( defined( $_ ) );
}
close( FA );
}
# Daily
if ( $a_file) {
open( FA, "$dir/$file" ) || die "Unable to open $file - $!\n";
while( ) {
$count_cars{$_}++ if ( defined( $_ ) );
}
close( FA );
}
}elsif($file=~/(20\d{2}\d{2}\d{2})_bike/) {
my $h_file = $1;
my $file_date = Time::Piece->strptime($h_file, '%Y%m%d');
# Weekly
if ( $file_date > $past) {
open( FH, "$dir/$file" ) || die "Unable to open $file - $!\n";
while( ) {
$count_bike_wkly{$_}++ if ( defined( $_ ) );
}
close( FH );
}
# Daily
if ( $just_today eq $h_file) {
open( FH, "$dir/$file" ) || die "Unable to open $file - $!\n";
while( ) {
$count_bike{$_}++ if ( defined( $_ ) );
}
close( FH );
}
}
} # end open all files
print "\n Daily number of cars processed: " . scalar keys %count_cars;
print "\n Daily number of bike processed: " . scalar keys %count_bike;
my $cars_total = scalar keys %count_cars;
my $bike_total = scalar keys %count_bike;
my $total = $cars_total + $bike_total;
print "\n\n Total Daily Number processed as $todays_date: $total\n\n";
print "\n Weekly number of cars processed: " . scalar keys %count_cars_wkly;
print "\n Weekly number of bike processed: " . scalar keys %count_bike_wkly;
my $cars_wkly_total = scalar keys %count_cars_wkly;
my $bike_wkly_total = scalar keys %count_bike_wkly;
my $wkly_total = $cars_wkly_total + $bike_wkly_total;
print "\n\n Total Daily Number processed as $todays_date: $wkly_total\n\n";
}
=code
SAMPLE Files
FILE CARS: 20160316_car.txt
CARa
CARb
VEs
WEV
CARE5
TYR5
FILE BIKE: 20160316_bike.txt
KIR
OERl
wejg
WEDFH
WERF
20160315_car.txt
ASWWWa
ASDCARb
TITVEs
CCDWEV
CARE5
XTYR5
20160315_bike.txt
QAKIR
VBBOERl
OIIwejg
QWWEDFH
QWWWWERF
=cut
## ##
for my $id (keys %$final_data){
my $ar = $final_data->{$id}[0];
my @lines=();
my %seen=();
for my $ar (@$ar){
# did it here since I might have some more code
next unless $seen{$ar->[0]}++;
push @lines,{
ACCOUNT=>$ar->[0],
NAME =>$ar->[1],
DATE =>$ar->[2],
};
}
push @data, {
ID => $id,
LINE => \@lines
};
}
####
for my $id (keys %$final_data){
my $ar = $final_data->{$id}[0];
my @lines=();
for my $ar (@$ar){
push @lines,{
ACCOUNT=>$ar->[0],
NAME =>$ar->[1],
DATE =>$ar->[2],
} if $ar->[0] ne $ar->[0]; # <<<<<< prevent dups here
}
push @data, {
ID => $id,
LINE => \@lines
};
}
####
####### .pl file
#!/usr/bin/perl
use strict ;
use warnings ;
use CGI ;
use Data::Dump 'pp';
use HTML::Template;
use tmpl;
my $data;
...more code goes here
# Loading data from module -> tmpl.pm
my $table_tmpl_loaded = one_table( $data );
# Loading data from module -> tmpl.pm
my $main_out_tmpl = main( $data, $table_tmpl_loaded );
...more code goes here
##### .pm file
tmpl.pm
sub main {
my( $data, $table_data ) = @_;
# Load Main Template
my main_tmpl = HTML::Template->new(filename => 'main.tmpl', die_on_bad_params => 0,);
my $text = $page->{more}->{menu}->{options} || [];
my $account = $page->{more}->{account} || [];
my $hidden = $page->{more}->{hidden} || [];
$main_tmpl->param(
TITLE => 'PROTOTYPE',
TABLE => $table_data,
TEXT => $text,
ACC => $account,
HIDD => $hidden,
);
my $main_tmpl_loaded = $main_tmpl->output;
return $main_tmpl_loaded;
}
sub one_table {
my( $page_data ) = @_;
# Load new template to add to main template later
my $one_tmpl = HTML::Template->new(filename => 'templates/one_table.tmpl', die_on_bad_params => 0,);
# Load data into the summary_table.tmpl
$one_tmpl->param(
ONE => $page->{more}->{one_name} || [],
ONE_B => $page->{more}->{row} || [],
OTHERS => $page->{more}->{bulid}->{row} || [],
TOTAL => $page->{more}->{left_row}->{right}->{total} || '',
....many params here
);
my $one_tmpl_loaded = $one_tmpl->output();
return $one_tmpl_loaded;
}
1 ;
####
my $final_data;
for my $id ( keys %{$data} ) {
my $data = $data->{ $id }->{accounts};
push @{$final_data->{$id}}, $data if $data;
}
####
#!/usr/bin/perl
use strict;
#use HTML::Template;
use CGI;
use Data::Dumper;
my $q = CGI->new;
#my $template = HTML::Template->new(filename => 'temp.tmpl', die_on_bad_params => 1);
my $data = {
"26645222" => {
accounts => [
["2AS166", "RICHARD GYN", "03/20/2011", "-"],
["1X1327", "THELMA SJR", "02/02/2011", "-"],
["B998730", "NANCY RAI", "02/07/2011", "-"],
["2SSS8", "MARK JR", "02/10/2011", "-"],
["7NN5725", "SAMANTHA", "02/13/2011", "-"],
["22SSDX87B", "KIM BERLY", "02/25/2011", "-"],
["8BBG327", "THELMA SIR", "02/02/2011", "-"],
["9JNM30", "NANCY ECO", "02/07/2011", "-"],
["8JJHN34", "MARK JUNIOR", "02/10/2011", "-"],
["3XXC998", "SAMANTHA THREE", "02/13/2011", "-"],
["7GGG666", "KENNEY BRO", "02/25/2011", "-"],
],
names_info => [
["Ms. Ann","MAin Street","P. O. Box X",],
],
zips => [
["box","MAin Street","P. O. Box 1X",],
],
},
"1100999" => {
accounts => [
["2SS919", "SARA LEE", "03/12/2011", "-"],
["14X545", "MICHELLE DUO", "03/15/2011", "-"],
["1XX54c31", "MARIA ALCI", "03/30/2011", "-"],
["8NN443A7", "ROBERT FOGO", "02/01/2011", "-"],
["8BBK903", "MARVIN JACK", "02/22/2011", "-"],
["0AAS7060", "DEBORAH BLOCK", "02/30/2011", "-"],
["0KO977", "MATARAZZO ROBERT", "02/01/2011", "-"],
["1ZZXS0", "MARVIN MAY", "02/22/2011", "-"],
["&&8888", "DEBORAH ONE", "02/30/2011", "-"],
],
names_info => [
["Joe oe"," Cort Street","P. O. Box WW",],
],
zips => [
["box 3"," 333 MAin Street","P. O. Box 1X",],
],
},
"11299875" => {
accounts =>
[
["1AXXX98840", "ASHLEY ASH", "03/11/2011", "-"]
],
names_info => [
["Ms. Ann","MAin Street","P. O. Box X",],
],
zips => [
["house", "Cet Street","P. O. Box 3ty",],
],
},
};
my $final_data;
for my $id ( keys %{$data} ) {
my $data = $data->{ $id }->{accounts};
push @{$final_data->{$id}}, $data if $data;
}
my @data;
for my $id (keys %$final_data){
my $ar = $final_data->{$id}[0];
my @lines=();
for my $ar (@$ar){
push @lines,{
ACCOUNT=>$ar->[0],
NAME =>$ar->[1],
DATE =>$ar->[2],
}
}
push @data, {
ID => $id,
LINE => \@lines
};
}
print Dumper \@data;
####
my $data = {
"26645222" => {
accounts => [
["2AS166", "RICHARD GYN", "03/20/2011", "-"],
["1X1327", "THELMA SJR", "02/02/2011", "-"],
["B998730", "NANCY RAI", "02/07/2011", "-"],
["2SSS8", "MARK JR", "02/10/2011", "-"],
["7NN5725", "SAMANTHA", "02/13/2011", "-"],
["22SSDX87B", "KIM BERLY", "02/25/2011", "-"],
["8BBG327", "THELMA SIR", "02/02/2011", "-"],
["9JNM30", "NANCY ECO", "02/07/2011", "-"],
["8JJHN34", "MARK JUNIOR", "02/10/2011", "-"],
["3XXC998", "SAMANTHA THREE", "02/13/2011", "-"],
["7GGG666", "KENNEY BRO", "02/25/2011", "-"],
],
names_info => [
["Ms. Ann","MAin Street","P. O. Box X",],
],
zips => [
["box","MAin Street","P. O. Box 1X",],
],
},
"1100999" => {
accounts => [
["2SS919", "SARA LEE", "03/12/2011", "-"],
["14X545", "MICHELLE DUO", "03/15/2011", "-"],
["1XX54c31", "MARIA ALCI", "03/30/2011", "-"],
["8NN443A7", "ROBERT FOGO", "02/01/2011", "-"],
["8BBK903", "MARVIN JACK", "02/22/2011", "-"],
["0AAS7060", "DEBORAH BLOCK", "02/30/2011", "-"],
["0KO977", "MATARAZZO ROBERT", "02/01/2011", "-"],
["1ZZXS0", "MARVIN MAY", "02/22/2011", "-"],
["&&8888", "DEBORAH ONE", "02/30/2011", "-"],
],
names_info => [
["Joe oe"," Cort Street","P. O. Box WW",],
],
zips => [
["box 3"," 333 MAin Street","P. O. Box 1X",],
],
},
"11299875" => {
accounts =>
[
["1AXXX98840", "ASHLEY ASH", "03/11/2011", "-"]
],
names_info => [
["Ms. Ann","MAin Street","P. O. Box X",],
],
zips => [
["house", "Cet Street","P. O. Box 3ty",],
],
},
};
####
#!/usr/bin/perl
use strict;
use HTML::Template;
use CGI;
my $q = CGI->new;
my $template = HTML::Template->new(filename => 'temp.tmpl', die_on_bad_params => 1);
my $data = {
"26645222" => [
[
[2AS166, "RICHARD GYN", "03/20/2011", "-"],
[1X1327, "THELMA SJR", "02/02/2011", "-"],
[B998730, "NANCY RAI", "02/07/2011", "-"],
[2SSS8, "MARK JR", "02/10/2011", "-"],
[7NN5725, "SAMANTHA", "02/13/2011", "-"],
[22SSDX87B, "KIM BERLY", "02/25/2011", "-"],
[8BBG327, "THELMA SIR", "02/02/2011", "-"],
[9JNM30, "NANCY ECO", "02/07/2011", "-"],
[8JJHN34, "MARK JUNIOR", "02/10/2011", "-"],
[3XXC998, "SAMANTHA THREE", "02/13/2011", "-"],
[7GGG666, "KENNEY BRO", "02/25/2011", "-"],
],
],
"1100999" => [
[
[2SS919, "SARA LEE", "03/12/2011", "-"],
[14X545, "MICHELLE DUO", "03/15/2011", "-"],
[1XX54c31, "MARIA ALCI", "03/30/2011", "-"],
[8NN443A7, "ROBERT FOGO", "02/01/2011", "-"],
[8BBK903, "MARVIN JACK", "02/22/2011", "-"],
[0AAS7060, "DEBORAH BLOCK", "02/30/2011", "-"],
[0KO977, "MATARAZZO ROBERT", "02/01/2011", "-"],
[1ZZXS0, "MARVIN MAY", "02/22/2011", "-"],
[&&8888, "DEBORAH ONE", "02/30/2011", "-"],
],
],
"11299875" => [
[
[1AXXX98840, "ASHLEY ASH", "03/11/2011", "-"]
]
],
...
},
};
$template->param(
DATA => $data,
);
# Template output
print $q->header, $template->output;
__END__
temp.tmpl
ID:
Account
Name
Date
####
use strict;
use HTML::Template;
my $template = HTML::Template->new(filename => 'main.tmpl');
# Data to feed the _INCLUDE file
$template->param(
INFO => 'This is working now!',
DATA => [ { F_NAME => 'JOHN', L_NAME => 'DOE' },
{ F_NAME => 'MARY', L_NAME => 'ANN' },
],
);
# Fill in some more parameters into the main tmpl file
$template->param(
TITLE => 'Prototyping,
);
# Template output
print $q->header, $template->output;
###############################
main.tmpl
TMPL
##############################
test_include.pmpl
Name:
Last:
## ##
# New template object
my $template = HTML::Template->new(filename => 'main.tmpl',
filename => 'form_one.tmpl',
filename => 'another.tmpl',
filename => 'city.tmpl',
filename => 'location.tmpl',
);
####
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use HTML::Template;
my $q = CGI->new;
# New template object
my $template = HTML::Template->new(filename => 'main.tmpl');
# I could use _INCLUDE if the $template could read it here
# this way I could pass all the _VARs I have into the _INCLUDE file,
# but it does not work like that.
$template->param(
TEST_ONE => ( { F_NAME => 'JOHN', L_NAME => 'DOE' },
,),
);
#=cut
# load values into the main template
my $name = "Prototype";
my $return_val_from_extra = extra_more();
### Build First one(1)
#my $back_item_one = build_item_one();
# New template object for item one
my $form_one_tmpl = HTML::Template->new(filename => 'first.tmpl');
$form_one_tmpl->param(
CODE => 'Stuff for Item One',
NAME => 'FORM ONE TEST',
);
# Prepare to input into the main template
my $form_one_tmpl_loaded = $form_one_tmpl->output();
# The results will be into a VAR in main template main.tmpl
$template->param(
FIRST_THING=> $form_one_tmpl_loaded,
);
# End loading form one data into main template
### Build form two(2)
#my $back_form_two = build_form_two();
# New template object for form two
my $form_two_tmpl = HTML::Template->new(filename => 'cityinfo.tmpl');
$form_two_tmpl->param(
ZIP => '1123456',
ID => 'FORM 2 TEST',
);
# Prepare to input into the main template
my $form_two_tmpl_loaded = $form_two_tmpl->output();
# The results will be into a VAR in main template main.tmpl
$template->param(
CITY_INFO=> $form_two_tmpl_loaded,
);
# End loading form two data into main template
### Build form three(3)
#my $back_form_three = build_form_three();
# New template object for form three
my $form_three_tmpl = HTML::Template->new(filename => 'location_menu.tmpl');
$form_three_tmpl->param(
CITY => 'Planet Earth',
NAME => 'FORM 3 TEST Name 123',
);
# Prepare to input into the main template
my $form_three_tmpl_loaded = $form_three_tmpl->output();
# The results will be into a VAR in main template main.tmpl
$template->param(
LOCATION=> $form_three_tmpl_loaded,
);
# End loading form three data into main template
# Fill in some more parameters into the main tmpl file
$template->param(
NAME => $name,
STUFF_TEST => 'TEST',
MORE => $return_val_from_extra,
);
# Template output
print $q->header, $template->output;
sub extra_more {
my @data = (
#...
) ;
# Load new template to add to main template later
my $table_tmpl = HTML::Template->new(filename => 'more.tmpl', die_on_bad_params => 0,);
#Load these values into the template
$table_tmpl->param(
DATA => "More Data from here",
);
# Load this template into main template
my $table_load = $table_tmpl->output();
return $table_load;
}
####
#!/usr/bin/perl
use strict;
use warings;
use CGI;
use HTML::Template;
my $q = CGI->new;
# New template object
my $template = HTML::Template->new(filename => 'main.tmpl');
my $name = "Prototype";
my $return_val_from_tables = tables();
### Build form one(1)
my $back_form_one = build_form_one();
# New template object for form one
my $form_one_tmpl = HTML::Template->new(filename => 'form_one.tmpl');
$form_one_tmpl->param(
FORM_ONE => $back_form_one,
NAME => 'FORM ONE TEST',
);
# Prepare to input into the main template
my $form_one_tmpl_loaded = $form_one_tmpl->output();
# The results will be into a VAR in main template main.tmpl
$template->param(
ONE_DATA=> $form_one_tmpl_loaded,
);
# End loading form one data into main template
### Build form two(2)
my $back_form_two = build_form_two();
# New template object for form two
my $form_two_tmpl = HTML::Template->new(filename => 'form_two.tmpl');
$form_two_tmpl->param(
TWO_FORM => $back_form_two,
NAME => 'FORM 2 TEST',
);
# Prepare to input into the main template
my $form_two_tmpl_loaded = $form_two_tmpl->output();
# The results will be into a VAR in main template main.tmpl
$template->param(
TWO_DATA=> $form_two_tmpl_loaded,
);
# End loading form two data into main template
### Build form three(3)
my $back_form_three = build_form_three();
# New template object for form three
my $form_three_tmpl = HTML::Template->new(filename => 'form_three.tmpl');
$form_three_tmpl->param(
THREE_FORM => $back_form_three,
NAME => 'FORM 3 TEST',
);
# Prepare to input into the main template
my $form_three_tmpl_loaded = $form_three_tmpl->output();
# The results will be into a VAR in main template main.tmpl
$template->param(
THREE_DATA=> $form_three_tmpl_loaded,
);
# End loading form three data into main template
# Fill in some more parameters into the main tmpl file
$template->param(
NAME => $name,
STUFF => 'TEST',
LOAD => $return_val_from_tables,
);
# Template output
print $q->header, $template->output;
sub one {
my @data = (
...
) ;
# Load new template to add to main template later
my $table_tmpl = HTML::Template->new(filename => 'templates/table.tmpl', die_on_bad_params => 0,);
#Load these values into the template
$table_tmpl->param(
DATA => \@data,
);
# Load this template into main template
my $table_load = $table_tmpl->output();
return $table_load;
}