Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Maresia's scratchpad

by Maresia (Beadle)
on Aug 26, 2015 at 14:20 UTC ( #1140034=scratchpad: print w/replies, xml ) Need Help??

This is the simplified version of the code that I am trying to rename a file before FTPing it to a server.

#!/usr/bin/perl use strict; use warnings; use CGI; use HTML::Template; use Time::Piece; use CGI::Session; use Data::Dumper; use Net::FTP; # File date string my $date_ntime = localtime->strftime('%Y%m%d%H%M%S'); my $cgi = CGI->new(); # Create new session my $session = new CGI::Session("driver:File", $cgi, {Directory => "ses +h"}) or die CGI::Session->errstr;; my $sid = $session->id(); my $tmpl = HTML::Template->new(filename => 'templates/test_up.tmpl', d +ie_on_bad_params => 0, associate => $session); my ($msg_ok, $msg, $file_msg); # Check app access - if not authorized show admins my $user_name = "XYZ"; # This is the value of the name of the file benn uploaded. my $got_doc_name = $cgi->param( 'doc' ) || ''; # Store the file name been uploaded so we can use it to inform the use +r later. # Add the session parameter in here. Use .= to ensure a string and not + a file handle. my $got_file_name .= $cgi->param( 'doc_upload' ) || $session->param( ' +doc_uploaded' ) || ''; # Write the session to disk with flush $session->param("doc_uploaded", $got_file_name); $session->flush(); # Process file process_request($got_file_name, $user_name, $date_ntime, $got_doc_nam +e); # Load this value into the template $tmpl->param( USER_NAME => $user_name, ); my $cookie = $cgi->cookie(CGISESSID => $sid); print $cgi->header(-cookie=>$cookie ), $tmpl->output; exit; sub process_request { my ($file_name, $user_name, $date_ntime, $doc_name) = @_; #return unless $file_name; # File selected by the user. my @file_types = ( {filename => "Summary_${date_ntime}_x.csv", ext => 'csv', do +c => 'sum'}, {filename => "Results_${date_ntime}_y.txt", ext => 'txt', do +c => 'res'}, {filename => "History_${date_ntime}_z.xlsx", ext => 'xlsx', do +c => 'his'}, ); # Get the file extension only - normal win style extensions my ($file_ext_uploaded) = $file_name =~ /((\.[^.\s]+)+)$/; $file_ext_uploaded =~ s/^\.//; my ( $file_renamed, $ext ); # Get the number of items (hashes) in the array. my $items = scalar (@file_types); for (my $i=0; $i < $items; $i++) { if ($file_types[$i]{'doc'} eq $doc_name) { $file_renamed = $file_types[$i]{'filename'}; $ext = $file_types[$i]{'ext'}; last; } } warn " Original filename:$file_name | File renamed:$file_renamed^ \n" + if $file_renamed; if ( $file_ext_uploaded eq $ext) { $cgi->upload( 'doc_upload' ); my $tmp_file = $cgi->tmpFileName( $file_name ); warn " ^$tmp_file^ to ^$file_renamed^"; rename("$tmp_file", "$file_renamed") || die ( "Error in renaming" ) +; warn qq{rename ("$tmp_file", "$file_renamed");\n}; # The line above is printing an empty "$tmp_file" why? chmod 0664, "tmp/$file_renamed"; # FTP FILE. my $host = 'xxx'; my $user = 'yyy'; my $pwd = 'zzz'; my $ftp_dir = '/'; my $ftp = Net::FTP->new($host, Debug => 0, Passive => 0) or die "Could not connect to '$host': $@"; $ftp->login($user, $pwd) or die sprintf "Could not login: %s", $ftp->message; $ftp->cwd($ftp_dir) or die sprintf "Could not login: %s", $ftp->message; # Get a list of files in the FTP server my @retrived = $ftp->ls("file_types"); if (@retrived) { warn " File $file_renamed already exists in server."; }else{ warn " *$file_renamed*"; #The error: -> Cannot open Local file Summary_20180115102920_x. +csv: No such file or directory my $put_file = $ftp->put("$file_renamed") or die "Cannot put fi +le ", $ftp->message if $file_renamed; warn " FTP transaction was successful for file(s): $put_file"; } $ftp->quit; }else { warn "Wrong file type."; } }

Thisis the .tmpl code:







Trying to use the HTMLTemplateProRenderer plugin for Mojolicious::Lite so that I can use template files in the style of HTML::Template. The issue is that every example, even documentation, only shows the template file attached to the script. I need the template file to be in a different directory from the Perl code. Here is a sample of what I am trying to do. This works using __DATA__, but how could it work by using an external template file as this:
#!/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;

The template file is display/index.tmpl
<html> <head><title>Test Template</title> <body> <p>Value ONE = <TMPL_VAR NAME="one"> </p> <p>Value TWO = <TMPL_VAR NAME="two"> </p> </body> </html>

Thanks!


This one I don't have to search for the files, since in the text file now I have the path and the file name, going to see if this one runs with out getting "killed" by the system resources, what do you think?
#!/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 - To +tal 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; }; }



Here it is:
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




This is sample dump after adding the else:
{ "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", }




Here it is:
#!/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 numbe +r 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; }



It looks good but I can not find any files as you can see:

The file testa.pdf is in /doca/ but it cant be found
The file testb.pdf is in /docb/ but it cant be found
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";} }; ..

File testa.pdf not found in /doca/
File testa.pdf not found in /doca/2/
File testb.pdf not found in /docb/

0 files found in 0 seconds

Why it can see the files in their directories?




Here is what I have based in what you wrote, the question is efficiency, any more suggestions?
#!/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 f +ile $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; }



Hi, here is the file was mentioned:
#!/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 d +ocb 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; }
Thanks for taking a look!


Or I can just use the keys explicitly and not bother with any href at all.
Is that a way to have a hash look up in the "foreach loop" instead of all those IFs?
#!/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"; }
Thanks


This is how I have to do now, the files will be named different, knowing the file name I have to send the key according to the file name, I don't like the several "IF"s statements I have in the foreach:
#!/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"; }



See if you agree with how I did:
#!/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"; }



I posted in the foreach what I am trying to get from the hrefdata:
#!/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"; }



###################################

The code I posted below is the same but the href data structure I am trying to work with changed and I am getting no values from the $hrefdata{$name} variable, coudl you take a look if you can:
... 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;} ...
The complete sample code:
#!/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"; }


#################################

I guess I didn't ask the right question, loosing my mind, the issue is that the $data_href is my control data, and the files in @files will start with the values in the $data_href and a date, thats where I am having a hard time.
Yes using File::Basename is better than the regx I had. Look at this code now:
#!/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"; }

thanks! Here is the code I am asking about it, I am trying to call this sub routine based on the values matching in @files with the values from $data_href:
#!/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{$f +ilename}; } sub doresults { my ($filename, $recs ) = @_; print "\n $filename = $recs\n"; }
Thanks

###########################



Hi, here is another way to accomplish the same result, I like how you did as well, the question left is, which way gives you more flexibility in customizing the block of text, and I like reading the block of text from a file because I can use HTML::Template on it. What do you think?
#!/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 => 'au +to'); 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 moles +tie 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, c +onvallis Fusce ut <u>metus ut which may either exceed \$1,000.00 or OK. G. LAT, +</u> <u>semper nunc, in dictum magna.</u> Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra +ligula. Suspendisse efficitur imperdiet eros, <u>XXsed rhoncus sapien euismod cursus. Vest +ibulum a posuereYY</u> elit, eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, pos +uere lectus.", 400, 500); =code ### START OPTION my $new_lines = "Aliquam vitae ipsum id felis finibus congue. Ut moles +tie 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. <u>Mauris rutrum luctus rhoncus.</u> Quisque velit quam, convallis <u> +vel est at, tincidunt accumsan velit.</u> Fusce ut <u>metus ut which may either exceed \$1,000.00 or OK. G. LAT, +</u> <u>semper nunc, in dictum magna.</u> Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra +ligula. Suspendisse efficitur imperdiet eros, <u>XXsed rhoncus sapien euismod cursus. Vest +ibulum a posuereYY</u> elit, eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, pos +uere 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 un +derlined with <u>...</u> 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 =~ /<u>/ ) { # the capture brackets in split retain <u> and </u> # as an separate element in @parts my @parts = split /(<\/?u>)/,$rows; for (@parts) { if (/<u >/) { $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( );

####################



Hi, you can see how I am trinyg in the code comments
#!/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 moles +tie 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. <u>Mauris rutrum luctus rhoncus.</u> Quisque velit quam, convallis <u +>vel est at, tincidunt accumsan velit.</u> Fusce ut <u>metus ut which may either exceed \$1,000.00 or OK. G. LAT +,</u> <u>semper nunc, in dictum magna.</u> Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra + ligula. Suspendisse efficitur imperdiet eros, <u>XXsed rhoncus sapien euismod cursus. Ves +tibulum a posuereYY</u> elit, eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, po +suere 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 un +derlined with <u>...</u> for my $rows (@lines){ print "57 *$rows*\n"; $txt->font($fnt,11); $txt->translate( $left_margin,$y); if( $rows =~ /<u>(.*?)<\/u>/xms ){ # here I can get each section of text between the <u></u> my ($one, $two) = ($rows =~ /<u>(.*?)<\/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 underlin +ed 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 t +here. $rows =~ s/<u>(.*?)<\/u>/$one/; $rows =~ s/<u>(.*?)<\/u>/$two/; $txt->text("$rows"); }else{ $txt->text("$rows"); } $y-=17; } $txt->textend; $pdf->save; $pdf->end( );




Here a sample code , where you can see that I set up the "<u>...</u> as a flag to look for where I what I want to be underlined:
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 a +t, tincidunt accumsan velit. Fusce ut <u>metus ut which may either exceed \$1,000.00 or OK. G. LAT +, semper nunc, in dictum magna.</u> Aliquam ac vestibulum dolor. Praesent in magna nisi. Cras nec viverra + ligula. Suspendisse efficitur imperdiet eros, <u>XXsed rhoncus sapien euismod cursus. Ves +tibulum a posuereYY</u> elit, eget tristique eros. Etiam et lectus venenatis, aliquet dui vitae, po +suere lectus."; ; my $y = $top - 162; for my $rows (@lines){ $txt->font($fnt,11); $txt->translate( $left_margin,$y); if( $rows =~ /<u>(.*?)<\/u>/xms ){ my $change = $rows; $change =~ s/<u>(.*?)<\/u>/$1/; $txt->text("$change",-underline => 'auto'); }else{ $txt->text("$rows"); } $y-=17; }




Hi here it is, somehow I am getting an error:
Date::Calc::PP::Monday_of_Week(): Date::Calc::Monday_of_Week(): week o +ut of range at splice_pie_3a.pl line 73
Here is the code:
#!/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 = <DATA>){ if ($file =~ /(20\d{6})_($match)/){ my $date = $1; my $veh = $2; #open IN,'<',$file or die "Could not open $file : $!"; #my @lines = <IN>; #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 e +tc $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_we +ek\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




Hi, I added this to better understand the week:
#!/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_we +ek\n------------\n"; .... }

I tried with Time::Piece but could get to work than one more module Date::Calc.



Hi, consider a directory with files like this:
/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


Now, notice week 2016-53:
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

Its the first date in January.



Hi, I am trying reading all the files in this directory, open each file, count how many lines in each and build a report, these files are created daily with todays date as in:

20160316_car.txt
20160316_bike.txt


20160315_car.txt
20160315_bike.txt


The content of the files are not important, just generating a report based on how many lines on each file by each day and the sum for the week. In summary I would like to see something like this:

The sum of lines in the car and bike files (I have that in my code).

Daily:

A list of each file name with its number of lines:
Cars
20160316_car.txt = 50 lines

Bikes
20160316_bike.txt = 60 lines

Total Daily = 110 Lines


Total by week:
A list of each file name with its number of lines:

Cars
20160316_car.txt = 50 lines
20160315_car.txt = 45 lines
Total: = 90 Lines

Bikess
20160316_bike.txt = 60 lines
20160315_bike.txt = 35 lines
Total: = 95 Lines
Total Daily = 185 Lines


Having issues on the weekly, could you take a look and give me a suggestion, I might be over complicating it and the code is getting too long. If I need to add more specifics for the report later it can be hard to implement in the future.

Here is what a have:
#!/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( <FA> ) { $count_cars_wkly{$_}++ if ( defined( $_ ) ); } close( FA ); } # Daily if ( $a_file) { open( FA, "$dir/$file" ) || die "Unable to open $file - $!\n +"; while( <FA> ) { $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( <FH> ) { $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( <FH> ) { $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_car +s_wkly; print "\n Weekly number of bike processed: " . scalar keys %count_bik +e_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
Thanks again!



Did this way, also fine correct?
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 }; }



I am having duplicated records and trying to get rid of it, I am complicating the code trying to find the dups before this "for" loop, I wondering if right in this "for" loop I could use something like this to prevent any duplicate rows of 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], } if $ar->[0] ne $ar->[0]; # <<<<<< prevent dups here } push @data, { ID => $id, LINE => \@lines }; }



This is a sample code of how I am using HTML::Template and since the "param()" list can get too big I am separating it into a external module, what do you think?
####### .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_ba +d_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.t +mpl', 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 ;
Thanks again!!!


Read the post below this one, but here is what I had to do to get where your code helped, but may be there is a way where I could go direct into the "$data" with out needing this:
my $final_data; for my $id ( keys %{$data} ) { my $data = $data->{ $id }->{accounts}; push @{$final_data->{$id}}, $data if $data; }

but here is what I have so far to work with what you suggested:
#!/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_ba +d_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. Bo +x 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;



This is a small sample of the raw data, I need to do is get the IDs and then the "accounts" data and do what you just did.
Thats my nightmare:
Raw data ample:
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. Bo +x 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",], ], }, };



This is the sample code I am trying to, my issue is mainly on the data structure. Having issue on how to structure the data I have to display correct into the HTML:Template format.
#!/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 <table> <TMPL_LOOP NAME="DATA"> <tr> <td>ID: <TMPL_VAR NAME="ID"></td> </tr> <tr> <td>Account</td> <td>Name</td> <td>Date</td> </tr> <tr> <td><TMPL_VAR NAME="ACCOUNT"></td> <td><TMPL_VAR NAME="NAME"></td> <td><TMPL_VAR NAME="DATE"></td> </tr> </TMPL_LOOP> </table>



This is what you are talking about
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 <!DOCTYPE html> <html> <head> <title>TMPL</title> </head> <body> <br><br> <TMPL_VAR NAME="TITLE"> <br><br> <b><TMPL_INCLUDE NAME="test_include.tmpl"></b><br> </body> </html> ############################## test_include.pmpl <br><TMPL_VAR NAME="INFO"><br> <TMPL_LOOP NAME="DATA"> Name: <TMPL_VAR NAME=F_NAME> <br> Last: <TMPL_VAR NAME=L_NAME> <br> </TMPL_LOOP>

Yes?


See this modified sample code. After all my concern is that the only way if I need to add another tmpl to the main tmpl file I have to make a new call to "HTML::Template->new(".
It seems redundant because I will end up with so many of them, let me know what do you think:
Some like this, every time I have a new tmpl I would add to the list as this as an sample:
# New template object my $template = HTML::Template->new(filename => 'main.tmpl', filename => 'form_one.tmpl', filename => 'another.tmpl', filename => 'city.tmpl', filename => 'location.tmpl', );


The sample main code:

#!/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.t +mpl'); $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; }





I am updating this code to use HTML::Template and my question is that is has multiple parts that I want/need to convert into its own template. Question, every time I need to call another template to insert into the main template, do I need to make another call to the "HTML::Template->new"? or there is a better way to do this?

Here is a sample code to show you want I am trying to say/do.
#!/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.tmp +l', 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; }

Thank you!



I am trying to get rid of the dups after the data gets processed, see the code, but I cant get rid of the dups. I am dumping the data below:
<code> ... # Print 3 tables for each block for my $key (sort keys %block) { # start new page if block start near bottom if ($y < $layout{block_limit}) { $page = new_page( pdf => $pdf, account_number => $account_number, account_name => $account_name, ); $y = $layout{top}; } # Principal ($page,undef,$y) = make_table( pdf => $pdf, page => $page, data => $head3,@{$block{$key}{principal}}, title => $principal_title, x => $layout{border_left}, y => $y, w => $layout{width}, account_number => $account_number, account_name => $account_name, bg_row_color => $bg_row_color, ); ($page,$y) = table_space( pdf => $pdf, page => $page, y => $y, space => $layout{table_spacing}/2, account_number => $account_number, account_name => $account_name, ); # Clear Principal Title after created once. $princi
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2021-12-05 15:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    R or B?



    Results (31 votes). Check out past polls.

    Notices?