Maresia's scratchpad


There's more than one way to do things
	PerlMonks

Maresia's scratchpad

by Maresia (Beadle)

on Aug 26, 2015 at 14:20 UTC ( [id://1140034]=scratchpad: print w/replies, xml )

Need Help??

Public Scratchpad

Download, Select Code To D/L

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.";

 }
 
}
[download]

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;
[download]

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>
[download]

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;
  };


}
[download]

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
[download]

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",
}
[download]

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;
}
[download]

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";}
  
};
..
[download]

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;

}
[download]

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;
  
}
[download]

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";
}
[download]

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";
}
[download]

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";
}
[download]

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";
}
[download]

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

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;}

...
[download]

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";
}
[download]

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

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";
}
[download]

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";

}
[download]

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( );
[download]

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

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( );
[download]

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;
 }
[download]

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
[download]

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
[download]

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";

....

}
[download]

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
[download]

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
[download]

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
[download]

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
    };
  }
[download]

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
    };
  }
[download]

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 ;
[download]

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;

 }
[download]

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;
[download]

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",],
                     ],
        },

};
[download]

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>
[download]

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>
[download]

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',
                     );
[download]

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;
 
}
[download]

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;
 
}
[download]

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

Domain Nodelet^?

www.com | www.net | www.org

Chatterbox^?

How do I use this? • Last hour • Other CB clients

Other Users^?

Others having an uproarious good time at the Monastery: (2)

As of 2024-04-26 02:28 GMT

Sections^?

Information^?

Find Nodes^?

Leftovers^?

Today I Learned

Voting Booth^?

No recent polls found