ckj has asked for the wisdom of the Perl Monks concerning the following question:

Hi all, Below is my code to read a text file from a specified location and then create a tabular representation of that data. But after running the script it is giving report with a line difference between every column. 
#!/usr/lib/perl
use DBI;
use strict;
use Text::Table;

my ($dir,@files,$file,$output_file,$line,%hash);
$dir="D:/ckj/dummy";
chomp($dir);
$output_file="D:/ckj/dummy/rep.txt";
opendir(DIR,"$dir") or die $!;
@files=readdir(DIR)  or die $!;  
close DIR;
my $tb = Text::Table->new("NAME\n-------------------------", "Age\n---
+----------------------", "Department\n-------------------------");
open(FH1,">$output_file")  or die $!;  
foreach $file (@files){
    open(FH, "<$dir/$file") or die $! if($file=~/\.txt$/);
    while($line=<FH>){
        %hash=();
         while($line=~/employee name is/g){
             my @name = split(" ",$');
             $hash{"Name"}=$name[1];
         }
         while($line=~/Age/g){
             my @age = split(" ",$');
             $hash{"Age"}=$age[1];
         }
         while($line=~/Department/g){
             my @dept = split(" ",$');
             $hash{"Dept"}=$dept[1];
         }
         $tb->load([$hash{"Name"},$hash{"Age"},$hash{"Dept"}]);
    }
    close FH;
}
print FH1 $tb;
close FH1;
print "Congratulations, report file has been saved as $output_file";

[download]
my Text file: 
The employee name is  : Ram
Age: 25 years
Department: HR

The employee name is  : Ravi
Age: 28 years
Department: HR

The employee name is  : Raju
Age: 27 years
Department: IT

The employee name is  : Ajay
Age: 26 years
Department: IT

The employee name is  : Rani
Age: 25 years
Department: IT

[download]

Replies are listed 'Best First'.
Re: Need help in Text::Table
by Anonymous Monk on Jun 14, 2012 at 07:51 UTC

    Basically your data contains extra newlines, if you employ the Basic debugging checklist, perhaps like this 

    use Data::Dump qw/ dd /;
dd [ $hash{"Name"},$hash{"Age"},$hash{"Dept"} ];

    [download]

    You should be able to see where the extra newlines are. Here is an example 

    #!/usr/bin/perl --
use strict; use warnings;
use Text::Table;
my $tb = Text::Table->new(
 "NAME\n-------------------------",
 "Age\n-------------------------",
 "Department\n-------------------------"
);
$tb->load( [ qw/ Ro Sham Bo / ]);
$tb->load( [ "\nRo", "\nSham", "\nBo" ]);
$tb->load( [ qw/ Ro Sham Bo / ]);
print $tb;
__END__
NAME                      Age                       Department        
+       
------------------------- ------------------------- ------------------
+-------
Ro                        Sham                      Bo                
+       
                                                                      
+       
Ro                        Sham                      Bo                
+       
Ro                        Sham                      Bo

    [download]

    More importantly, you should read perlvar#$' and stop using $';

    Review perlintro and perlrequick and start using http://perldoc.perl.org/perlintro.html#Parentheses-for-capturing 

    $Employee{Name}       = $1 if /^The employee name is  : (\S+)$/mgsi;
$Employee{Age}        = $1 if /^Age: (\d+) years$/mgsi;
$Employee{Department} = $1 if /^Department: (.+?)\s*$/mgsi;

if( /^\s*$/ ){
    $tb->load ...;
    undef %Employee;
}

    [download]
[reply]
[d/l]
[select]

      Actually, there are no extra newlines :) but you did solve the problem implicitly -- load-ing the data only once %Employee is complete (when you encounter a blank line), not as soon as one attribute was found

      If the files don't end with a blank line, you should load %Employee one last time, if its not empty of course :)

[reply]
      I followed your links too but this problem is still unsolved. UPDATE: here is the modified code which is also not working 
      #!/usr/lib/perl
use DBI;
use strict;
use Text::Table;

my ($dir,@files,$file,$output_file,$line,%Employee);
$dir="D:/ckj/dummy";
chomp($dir);
$output_file="D:/ckj/dummy/rep.txt";
opendir(DIR,"$dir") or die $!;
@files=readdir(DIR)  or die $!;  
close DIR;
my $tb = Text::Table->new("NAME\n-------", "Age\n-------", "Department
+\n-------");
open(FH1,">$output_file")  or die $!;  
foreach $file (@files){
    open(FH, "<$dir/$file") or die $! if($file=~/\.txt$/);
    while($line=<FH>){
         while($line=~/employee name is  \: (.*?)\n/g){
             $Employee{"Name"}=$1;
         }
         while($line=~/Age\: (.*?)\n/g){
             $Employee{"Age"}=$1;
         }
         while($line=~/Department\: (.*?)\n/g){
             $Employee{"Dept"}=$1;
         }
         #$tb->load([$Employee{"Name"},$Employee{"Age"},$Employee{"Dep
+t"}]);
         if( /^\s*$/ ){
             $tb->load([$Employee{"Name"},$Employee{"Age"},$Employee{"
+Dept"}]);
             undef %Employee;
         }
    }
    close FH;
}
print FH1 $tb;
close FH1;
print "Congratulations, report file has been saved as $output_file";

      [download]
      O/p is like this: 
      NAME    Age      Department
------- -------  -------   
                           
                           
Ram                        
        25 years           
                 HR        
                           
Ravi                       
        28 years           
                 HR

      [download]
      UPDATE: It's done by using : 
      if($Employee{"Name"} && $Employee{"Age"} && $Employee{"Dept"}){
             $tb->load([$Employee{"Name"},$Employee{"Age"},$Employee{"
+Dept"}]);
             undef %Employee;
         }

      [download]
[reply]
[d/l]
[select]

        Still confused and couldn't solve this one. Any whelp will be appreciated. I foolowed your links too but this problem is still unsolved.

        What is is that you're confused about?

        I told you how to diagnose the problem (code ready for you to copy/paste and examine the output)

        I told you how to solve it (that %Employee hash stuff), I even posted code for you to copy/paste, all you have to do is finish the missing portion, the ... stuff

        what is the problem?

[reply]

        UPDATE: here is the modified code which is also not working

        Those be forbidden words :) you need to describe how its not working

        O/p is like this

        You should also put that in code tags, or better yet, put the output of  dd \%Employee; (from before undef) and/or  dd $tb; (from before print FH1 ), in code tags

[reply]
[d/l]
[select]

        Have you made any more changes, or are you just waiting?

[reply]
Re: Need help in Text::Table
by Khen1950fx (Canon) on Jun 14, 2012 at 13:17 UTC
    FWIW, I think that what works works, but what doesn't work doesn't work. Your script isn't working because you're working too hard at it. There's only five names on the list, so why not hardcode them? I'd suggest taking a break, then go back to the beginning. I took your script and reduced it to a bare minimum that works. You could start with this skeleton and gradually, incrementally build upon it. Keep on trying! 
    #!/usr/lib/perl 

use strict;
use warnings;
use Text::Table;


my $tb = Text::Table->new(
    "NAME----------",
    "Age----------",
    "Department-----------");

$tb->load(
    ["Ram",  25, "HR"],
    ["Ravi", 28, "HR"],
    ["Raju", 27, "IT"],
    ["Ajay", 26, "IT"],
    ["Rani", 25, "IT"],
);

my $o = '';
$o .= $tb->rule( q{_} );
$o .= $tb->body();
$o .= $tb->rule( q{_} );

open STDOUT, '>-' or die $!;
print my @lines = $tb->table;
close STDOUT;

__END__

The employee name is  : Ram
Age: 25 years
Department: HR

The employee name is  : Ravi
Age: 28 years
Department: HR

The employee name is  : Raju
Age: 27 years
Department: IT

The employee name is  : Ajay
Age: 26 years
Department: IT

The employee name is  : Rani
Age: 25 years
Department: IT

    [download]
[reply]
[d/l]
      LOL
[reply]
Re: Need help in Text::Table
by Anonymous Monk on Jun 15, 2012 at 12:42 UTC
    how you will print his kind of data in table format using text::table 
    NAME          CLASS          SUBJECT        EXAM              Marks   
+     AGGREGATE
----------------------------------------------------------------------
+---------------
ABC            1st year       Maths      Half-yearly          50      
+     
                                         Full-Yearly          49      
+        49.5

                              Science    Quarterly            50
                                         Half-Yearly          48
                                         Full-Yearly          49      
+        49

                              English    Quarterly            50
                                         Half-Yearly          50 
                                         Full-Yearly          50      
+        50

                              Computer   Quarterly            50
                                         Half-Yearly          50
                                         Full-Yearly          50      
+        50

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom