How to read excel sheet using perl script with simple check condition - perl

Im new bee to perl trying to read excel sheet with simple condition..
problem is reading all records and checking whether b columns has "Always null" string if yes then display output from Column "C"
Example : For Always Null condtion
Expected output : a,b,c,f,g

#!/usr/bin/perl
use strict;
use warnings;
use v5.14;
use Spreadsheet::ParseExcel;
use Data::Dumper;
my $ws = Spreadsheet::ParseExcel
->new()
->parse('yourfile.xls')
->worksheet(0);
my ($i, $r_max) = $ws->row_range;
my ($cell_B, $cell_C);
while ($i <= $r_max) {
$cell_B = $ws->get_cell($i,1);
$cell_C = $ws->get_cell($i,2);
say $cell_C->value
if $cell_B
and $cell_C
and $cell_B->value eq 'Always null';
} continue { $i++ }

Related

How to check if an array has an element that is not integer?

Firstly, I have a hash:
$hWriteHash{'Identifier'}{'number'} that contains = 1#2#12#A24#48
Then I split this by "#" and then put it in the #arr_of_tenors variable.
Here's the code:
use strict;
use warnings;
use Scalar::Util qw(looks_like_number);
use Data::Dumper;
$nums = $hWriteHash{'Identifier'}{'number'};
my #arr_of_tenors = split("#", $nums);
print("#arr_of_tenors\n");
The output is 1 2 12 A24 48
Now, my goal is if the array has an element that's not an integer which is A24, it will go to die function.
Here's what I've tried.
if(not looks_like_number(#arr_of_tenors)){
die "ERROR: Array has an element that's not an integer.";
}else{
print("All good");
}
Obviously, the only acceptable format should be integers only.
I've tried to use looks_like_number but it didn't work. It always goes to else statement.
I know that there is another option which is grep + regex. But as much as possible, I don't want to use regular expressions on this one if there is a function that does the same job. Also, as much as possible, I don't want to iterate each element.
How does looks_like_number works?
Am I missing something?
Here's yet another way:
use Types::Common qw( Int );
if ( Int->all( #arr_of_tenors ) ) {
# all integers
}
else {
# at least one non-integer
}
And another, because why not?
use Types::Common qw( ArrayRef Int );
if ( ArrayRef->of( Int )->check( \#arr_of_tenors ) ) {
# all integers
}
else {
# at least one non-integer
}
How does looks_like_number works? Am I missing something?
It checks one thing at a time, you fed many things (an array). You need to traverse those many things and make a decision.
You want to error out if not all of the elements look like an integer, right? Then you can use notall from the core module List::Util:
use strict;
use warnings;
use List::Util qw(notall);
my $nums = "1#2#12#A24#48"; # $hWriteHash{"Identifier"}{"number"};
my #arr_of_tenors = split("#", $nums);
if (notall { /^-?\d+\z/ } #arr_of_tenors) {
die "ERROR: Array has an element that doesn't look like an integer.";
}
else {
print "All good\n";
}
which dies with
ERROR: Array has an element that doesn't look like an integer.
The notall function performs the mentioned traversal for you and subjects the predicate (the block above) to each element of the list in turn. Returns true if not all of the elements satisfies the condition; false otherwise. It also shortcircuits, i.e., immediately returns true if it sees a noncomplying element.
Noting that i changed looks_like_number to an integer check with a regex as the former accepts more, e.g., 48.7 etc. But if you are sure the incoming values are integer-like, you can replace the regex with looks_like_number($_) in the block above.
You can use List::Util::any to check if any element of the array does not look like a number:
use warnings;
use strict;
use Scalar::Util qw(looks_like_number);
use Data::Dumper;
use List::Util qw(any);
my $sKey = 'abc';
my %hWriteHash;
$hWriteHash{$sKey}{'number'} = '1#2#12#A24#48';
my $nums = $hWriteHash{$sKey}{'number'};
my #arr_of_tenors = split("#", $nums);
print("#arr_of_tenors\n");
if (any { not looks_like_number($_) } #arr_of_tenors) {
die "ERROR: Array has an element that's not an integer.";
}else{
print("All good");
}
print "\n";
From the docs:
Many cases of using grep in a conditional can be written using any
instead, as it can short-circuit after the first true result.
This works with the input you provided. However, looks_like_number will also be true for numbers like 5.37.

Introduction to perl input and output

I have a Perl script which I am trying to understand. I am quoting first few lines of the script (abc.pl)
#!/usr/bin/perl
use strict;
use DateTime;
use File::Temp;
use Math::Complex;
use Getopt::Long;
use TauP::Time;
use Seed::Response;
use lib '/usr/lib/perl5';
use Seismogram::SAC;
my(#input,$output);
GetOptions('input=s{,}' => \#input, 'output=s' => \$output);
open my $out_fp,">$output";
foreach my $file (<#input>)
{
my $phase = 'S';
if ( $file =~ /BHZ/ ) { $phase = 'P';}
my $decData = File::Temp->new();
decimateData($file,$decData);
my($sac) = readSAC($decData);
my($resp) = readResponse($sac);
}
I have a few files which I have listed in "list".
Can anyone please let me understand how should I input "list" and output filenames to the perl script.
my(#input,$output);
This line declares variables used on next line (#input is an array of input files, $output is scalar for output filename)
GetOptions('input=s{,}' => \#input, 'output=s' => \$output);
GetOptions is a function from module Getopt::Long and this line parses commandline options and fills previously declared variables. You should read module documentation

Why doesn't Text::Balanced::extract_bracketed extract the text inside a LaTeX tag?

I am trying to parse balanced text (actually, text written in LaTeX) using extract_bracketed from Text::Balanced. However, I did not get a correct match with the following code:
use Text::Balanced qw(extract_bracketed);
my $data = 'xxx \footnote{...} yyy';
(my $ext, my $rem, my $pre) = extract_bracketed($data, '{}', '\footnote');
print "\$ext = $ext\n";
print "\$rem = $rem\n";
print "\$pre = $pre\n";
This prints:
$ext =
$rem = xxx \footnote{...} yyy
$pre =
According to the documentation, this output means that a failure occurred, but I do not understand why.
What I actually want to extract is ..., i.e. the contents of the \footnote command.
Why is this happening and how can I fix it?
Text::Balanced sets $# on failure so you can get details about the cause:
use strict;
use warnings 'all';
use 5.010;
use Text::Balanced qw(extract_bracketed);
my $text = 'xxx \footnote{...} yyy';
my ($substring, $remainder, $prefix) = extract_bracketed($text, '{}', '\footnote');
warn $# if $#;
Output:
Did not find prefix: /\footnote/, detected at offset 0 at balanced line 12.
The prefix didn't match because:
it has to match from the beginning of the string all the way to the first occurrence of the delimiter
\f matches a form feed, not a literal backslash followed by the letter f
The following prefix matches everything up to the first curly brace:
use strict;
use warnings 'all';
use 5.010;
use Text::Balanced qw(extract_bracketed);
my $text = 'xxx \footnote{...} yyy';
my ($substring, $remainder, $prefix) = extract_bracketed($text, '{}', '[^{}]*');
say "<$_>" for $prefix, $substring, $remainder;
Output:
<xxx \footnote>
<{...}>
< yyy>
To actually remove a nested footnote tag from the text, leaving its contents, you need to use extract_tagged:
use strict;
use warnings 'all';
use 5.010;
use Text::Balanced qw(extract_tagged);
my $text = '\footnote{abc \footnote{...} def \emph{!!!} ghi}';
my #pieces = extract_tagged(
$text,
'\\\footnote{',
'}',
'(?s).*\\\footnote{.*(?=\\\footnote{)'
);
my ($remainder, $prefix, $contents) = #pieces[1, 2, 4];
say $prefix . $contents . $remainder;
Output:
\footnote{abc ... def \emph{!!!} ghi}
Note that this approach works for the simple input you gave, but won't work as a general-purpose LaTeX parser. There are a couple of LaTeX parsers on CPAN, but LaTeX::TOM looks fairly limited and LaTeX::Parser hasn't been updated since 2000.
If you need to do more complex parsing, you may need to write your own parser.

Saving a range of Cells in Excel as HTML using Win32::OLE Perl module

I want to save a range of cells in XLS sheet as a HTML file, using a Perl script. I have googled for solutions to this problem. But haven't found any.
However there is a solution similar to this using Excel VBA:
With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
"C:\Documents and Settings\Tim\Desktop\Page.htm", _
Selection.Parent.Name, _
Selection.Address(), _
xlHtmlStatic, "divExcelExport", _
"TestTitle")
.Publish (True)
.AutoRepublish = False
End With
So, I tried converting this to Perl code, but it gives me the following errors:
H:\test_code\data>perl a.pl
Win32::OLE(0.1702) error 0x800a03ec
in METHOD/PROPERTYGET "Add"
H:\test_code\data>
use strict;
use warnings "all";
use Win32::OLE;
my $Excel = Win32::OLE->GetActiveObject('Excel.Application') ||
Win32::OLE->new('Excel.Application','Quit');
my $Book = $Excel->Workbooks->Open("H:\\test_code\\data\\test.xls");
my $Sheet = $Book->Worksheets(1);
$Book->PublishObjects->Add({SourceType=>5, # int value for xlSourceRange
FileName => "H:\\test_code\\data\\test2.html",
Source => $Sheet->Range("A1:B2")->Address,
HtmlType => 0, # xlHtmlStatic s int value.
});
print Win32::OLE->LastError();
$Book->Close(0);
exit();
Can some one please suggest a solution for this problem.
Note, that I want to preserve all the formatting of the columns, (Decimal, number of digits, $ Sign, color etc..). Any solution which doesn't involve usage of a commercial library is appreciated.
Thanks,
Rizwan.
This works for me, at least the HTML file is being generated:
use strict; use warnings;
use Win32::OLE;
use Win32::OLE::Const 'Microsoft Excel';
my $Excel = Win32::OLE->new('Excel.Application','Quit');
my $Book = $Excel->Workbooks->Open("C:\\test.xls");
$Book->PublishObjects->Add(xlSourceRange,
"C:\\output_file.htm", 'Sheet1', '$C$3:$C$10', xlHtmlStatic
)->Publish(1);
$Book->Close(0);
$Excel->Quit;

Extract zip Files on cmd with progress indicator

I am looking for a program, which is able to extract zip archives via the windows commandline and that is able to display a progressbar or a percentage indicator on the cmd. I want to use this from within a Perl script and so give the user a hint how long the progress will take. I tried 7zip(http://www.7-zip.org/) and Unzip(from InfoZIP) so far, but was not able to produce the behaviour described above. Does somebody know how to solve this?
Update:
Currently i'm trying it with this approach:
#!/usr/bin/perl
use strict; $|++;
use warnings;
use Archive::Zip;
my $zip = Archive::Zip->new('file.zip');
my $total_bytes = 0;
my $bytes_already_unzipped = 0;
foreach my $member ($zip->members()) {
$total_bytes += $member->uncompressedSize();
}
foreach my $member ($zip->members()) {
$zip->extractMember($member);
$bytes_already_unzipped += $member->uncompressedSize();
print progress_bar($bytes_already_unzipped, $total_bytes, 25, '=' );
}
#routine by tachyon at http://tachyon.perlmonk.org/
#also have a look at http://oreilly.com/pub/h/943
sub progress_bar {
my ( $got, $total, $width, $char ) = #_;
$width ||= 25; $char ||= '=';
my $num_width = length $total;
sprintf "|%-${width}s| Got %${num_width}s bytes of %s (%.2f%%)\r",
$char x (($width-1)*$got/$total). '>',
$got, $total, 100*$got/+$total;
}
However i have two problems:
this approach seems to be very slow
i do not have a periodic update in the progress bar, but only when a file is finished beeing extracted. As i have some large files, the system seems to not respond while extracting them
Do the extraction from within your program instead of delegating to a different one. Use Archive::Zip and Term::ProgressBar. Extract files one by one. Update the progress after each.