perl text::iconv unsupported conversion - perl

In perl I read html pages and I make conversion to utf8 by text::iconv. But when some page has defined wrong code set for example: charset="blabla", then perl program died an printout "unsupported conversion".
I tried to set Text::Iconv->raise_error to 0 or 1 but without success, the program always died.
How to avoid program crash ?
OR how to check supported code set before conversion?
(I know read it in OS by "iconv --list", but must exist better solution (hope))

How to avoid program crash ?
perl uses eval for trapping errors:
use strict;
use warnings;
use 5.016;
use Text::Iconv;
my $source_encoding = 'blabla';
my $result_encoding = 'utf-8';
my $converter = eval {
Text::Iconv->new(
$source_encoding,
$result_encoding
);
}; #Error message gets inserted into $#
if (not $converter and $# =~ /invalid argument/i) {
say "Either the '$source_encoding' encoding or the ",
"'$result_encoding' encoding\nis not available on this system.";
}
if ($converter) { #Can new() fail in other ways?
my $result = $converter->convert('€');
if (not $result) {
say "Some characters in '$source_encoding'\n",
"are invalid in '$result_encoding'.";
}
else {
say $result;
}
}
In the [block] form, the code within the BLOCK is parsed only once--at the same time the code surrounding the eval itself was parsed--and executed within the context of the current Perl program. This form is typically used to trap exceptions more efficiently than the first (see below), while also providing the benefit of checking the code within BLOCK at compile time.
http://perldoc.perl.org/functions/eval.html
OR how to check supported code set before conversion? (I know read it
in OS by "iconv --list", but must exist better solution (hope))
What's so bad about iconv --list?
use strict;
use warnings;
use 5.016;
use Text::Iconv;
my $source_encoding = 'blabla';
my $result_encoding = 'utf-8';
my $available_encodings = `iconv --list`; #Backticks return a string.
my #encodings_arr = split /\s+/, $available_encodings;
my %encodings_set = map {lc $_ => undef} #encodings_arr;
my $source_encoding_available = exists $encodings_set{$source_encoding};
my $result_encoding_available = exists $encodings_set{$result_encoding};
if($source_encoding_available
and $result_encoding_available) {
say "Ready to convert";
}
else {
if (not $source_encoding_available) {
say "'$source_encoding' encoding not available.";
}
if (not $result_encoding_available) {
say "'$result_encoding' encoding not available.";
}
}

Related

perl - system command arguments give error

Tried hard to find a solution for this. But I probably need some help. I am trying to pass a bunch of arguments in system command in perl. But I get an irrelevant error. I have my variables correctly declared with the right scope and still get this error below. Here is my code.
#!/usr/bin/perl
use warnings;
use strict;
my $mi = 0;
my $mj = 0;
my #regbyte;
my #databyte;
my $filename;
my #args;
#regbyte = ("00","01","02","03","04","05","06","07","08","09","0A","0B","0C","0D","0E","0F","10","11","12");
#databyte = ("00","01","02","03","04","05","06","07","08","09", "0A", "0B");
for($mi=0; $mi<13; $mi++)
{
for($mj=0; $mj<256; $mj++)
{
$filename = "write_" . $regbyte[$mi] . "_" . $databyte[$mj] . ".atp";
system("perl perl_2_ver2.5.pl", $filename, $regbyte[$mi], $databyte[$mj], "n");
}
}
This is the error message I get.
Global symbol "$databyte" requires explicit package name at perl_2_ver2.8.pl line 20.
Execution of perl_2_ver2.8.pl aborted due to compilation errors.
I'm puzzled about a few things, in particular the trailing "n" you have in your system call. Is that supposed to be "\n"? Because it's unnecessary and wrong in that context.
The main problem is that you have
for ( $mj = 0; $mj < 256; $mj++ ) { .. }
and then access $databyte[$mj] when #databyte has only twelve elements. It's hard to know what you might mean.
Here's how I would write something that works, but may not be your intention.
use strict;
use warnings 'FATAL';
for my $regbyte (0 .. 0x12) {
for my $databyte (0 .. 0x0B) {
my $filename = sprintf "write_%02X_%02X.atp", $regbyte, $databyte;
system("perl perl_2_ver2.5.pl $filename $regbyte $databyte");
}
}
It looks like you want to run your script perl_2_ver2.5.pl with input consisting of all files that look like write_*_*.atp. Is that right?
Unless the directory contains atp files that you don't want to process, you are probably better off using just
while (my $filename = glob 'write*.atp') {
next unless /\Awrite_(\p{hex}{2})_(\p{hex}{2}).atp\z/;
system("perl perl_2_ver2.5.pl $filename $1 $2");
}
which just processes all the files that do exist and match the pattern.
I copy/pasted your code and only replaced the program parameter for the system call and I do not get the error you are reporting. However there are many array elements accessed, that don't exist.
You can limit your loops using the arraysizes like this:
for($mi=0; $mi<$#regbyte; $mi++)
And I believe you have two alternatives for your system call, either perl_2_ver2.5.pl is executable, then you can say (supposed, same directory):
system("./perl_2_ver2.5.pl", $filename, $regbyte[$mi], $databyte[$mj], "n");
Or you have to call:
system("perl" , "./perl_2_ver2.5.pl", $filename, $regbyte[$mi], $databyte[$mj], "n");

Beginner - Subroutine confusion

I'm a beginner and confused about what's happening inside this Perl subroutine.
I'm using only global variables to simplify things, but it's still not working.
I'm simply trying to print a file's read, write and executable attributes using the file test operators with IF statements.
Can anyone point out the problem for me?
Louie
sub getfileattributes {
if (-r $file) {
$attributes[0] = "readable";
} else { $attributes[0] = "not readable"; }
if (-w _) {
$attributes[1] = "writable";
} else { $attributes[1] = "not writable"; }
if (-x _) {
$attributes[2] = "executable";
} else { $attributes[2] = "not executable"; }
}
my #attributes;
my $file;
foreach $file (#ARGV) {
&getfileattributes;
printf "The file $file is %s, %s and %s\n", #attributes;
}
Using global variables is usually quite bad and points to a design error. In this case, the error seems to be that you don't know how to pass arguments to a sub.
Here is the pattern in Perl:
sub I_take_arguments {
# all my arguments are in #_ array
my ($firstarg, $secondarg, #rest) = #_;
say "1st argument: $firstarg";
say "2nd argument: " .($firstarg+1). " (incremented)";
say "The rest is: [#rest]";
}
Subs are invoked like
I_take_arguments(1, 2, "three", 4);
(Do not invoke them as &nameOfTheSub, this makes use of very special behaviour you don't usually want.)
This would print
1st argument: 1
2nd argument: 3
The rest is: [three 4]
Subroutines can return values, either with the return statement or as the value of the last statement that is executed. These subs are equivalent:
sub foo {return "return value"}
sub bar {"return value"}
I would write your getfileattributes as
sub getFileAttributes {
my ($name) = #_;
return
-r $name ? "readable" : "not readable",
-w $name ? "writable" : "not writable",
-x $name ? "executable" : "not executable";
}
What is happening here? I take an argument $name and then return a list of values. The return keyword could be omitted. The return takes a list of values and does not require parens, so I leave them out. The TEST ? TRUE-STATEMENT : FALSE-STATEMENT operator is known from other languages.
Then, in your loop, the sub would be invoked like
for my $filename (#ARGV) {
my ($r, $w, $x) = getFileAttributes($filename);
say "The file $filename is $r, $w and $x";
}
or
foreach my $file (#ARGV) {
my #attributes = getFileAttributes($file);
printf "The file $file is %s, %s and %s\n", #attributes;
}
Notes:
say is like print, but adds a newline at the end. To use it, you have to have a Perl > 5.10 and you should use 5.010 or whatever version or use feature qw(say).
always use strict; use warnings; unless you know better for sure.
Often, you can write programs without assigning to a variable twice (Single assignment form). This can make reasoning about control flow much easier. This is why global variables (but not global constants) are bad.
You are not actually using global varaibles. My scopes the variables them local to the main routine, so when you call the subroutine, $file and #attributes are scoped to the subroutine, not to the main routine.
Change my to our for $file and #attributes to make the variables global and available to the subroutine.
You can check this for yourself by using the -d argument for perl to run it in the debugger and check the values of the items.

How to return a scalar value from a Perl subroutine

I want to return the proper value of $message_all, but it's coming back blank in the given scenario. Any suggestions?
processing()
print "message_all = $message_all";
sub processing
{
log ( " Some message");
}
sub log
{
my $text = shift;
my $message_all .= $text;
return "$message_all";
}
Of course it's blank - you've declared $message_all inside the log() function, so it's not available outside of it.
Always do this in your Perl code:
use strict;
use warnings;
it would have told you that $message_all is undeclared.
First of all you must always use strict and use warnings at the start of your program, especially when you are asking for help with it.
Please post code that displays the problems you are having. Your program won't even compile, and won't run properly while your log subroutine clashes with a core function. It never gets as far as displaying the problem behaviour you describe.
You need to collect the return value from the subroutine to be able to print it. Something like this perhaps
use strict;
use warnings;
my $message = processing();
print "message = $message";
sub processing {
mylog ( " Some message");
}
sub mylog {
my $text = shift;
my $message_all .= $text;
return $message_all;
}

Perl: Checking for the Existence of socket options

This is a continuation of my previous question:
In Perl, how can I check for the existence of Socket options without generating warnings?
If I run the following code I get the result I expect:
#!/usr/bin/perl -w
use strict;
use diagnostics;
use Socket qw(:all);
my %opts;
if ( defined( eval { SO_REUSEPORT } ) ) {
$opts{'SO_REUSEPORT'}
= {opt_level =>SOL_SOCKET,opt_name=>SO_REUSEPORT,opt_print=>\&sock_str_flag};
} else {
print "SO_REUSEPORT undefined\n";
$opts{'SO_REUSEPORT'}
= {opt_level =>0,opt_name=>0,opt_print=>undef};
}
=head
# IPV6 options
if ( defined( eval { IPV6_DONTFRAG } ) ) {
$opts{'IPV6_DONTFRAG'}
= {opt_level =>IPPROTO_IPV6,opt_name=>IPV6_DONTFRAG,opt_print=>\&sock_str_flag};
} else {
print "IPV6_DONTFRAG undefined\n";
$opts{'IPV6_DONTFRAG'}
= {opt_level =>0,opt_name=>0,opt_print=>undef};
}
=cut
It outputs:
anon#perl$ ./test.pl
SO_REUSEPORT undefined
But if I uncomment the block for IPV6_DONTFRAG I get:
Bareword "IPV6_DONTFRAG" not allowed while "strict subs" in use at ./test.pl line 17.
Bareword "IPV6_DONTFRAG" not allowed while "strict subs" in use at ./test.pl line 17.
Why is one undefined bareword causing it to barf and the other not? And how can the error be propagating out of the eval { } block?
Edit
Apparently, SO_REUSEPORT is exported by Socket.pm in some manner as it's in the #EXPORT array. So apparently it's defined but using it throws an error which the eval catches.
That still doesn't explain what's going on with IPV6_DONTFRAG. I suppose I would need to define it myself and then just call getsockopt to check if it's supported...
I recommend writing it this way:
if ( defined( &IPV6_DONTFRAG ) ) {
$opts{'IPV6_DONTFRAG'}
= {opt_level =>IPPROTO_IPV6,opt_name=>&IPV6_DONTFRAG,opt_print=>\&sock_str_flag};
} else {
print "IPV6_DONTFRAG undefined\n";
$opts{'IPV6_DONTFRAG'}
= {opt_level =>0,opt_name=>0,opt_print=>undef};
}
Note the added ampersand in the value for opt_name, which evades constraints due to strict 'subs'.
The documentation for defined explains:
You may also use defined(&func) to check whether subroutine &func has ever been defined. The return value is unaffected by any forward declarations of &func. Note that a subroutine which is not defined may still be callable: its package may have an AUTOLOAD method that makes it spring into existence the first time that it is called—see perlsub.
For example, with SO_BROADCAST
if (defined &SO_BROADCAST) {
print "SO_BROADCAST = ", SO_BROADCAST, "\n";
}
the output on my machine is
SO_BROADCAST = 6
With regards to the IPV6_DONTFRAG bareword issue, it looks like Perl checks for barewords at compile time, not run time, as documented here. Eval is a construct to swallow runtime errors, so it won't help you here. It's like trying to handle a syntax error in C++ by sticking the offending code in a try/catch block.

Do I need to trap errors in my calls to Win32::OLE->LastError?

[EDIT] - with the benefit of hindsight, this question was misdirected. I have not deleted it because it is a good example of the incorrect use of eval and correct criticism by Perl::Critic.
Perl Critic raises the following criticism for the code below:
Return value of eval not tested. You can't depend upon the value of $#/$EVAL_ERROR to tell whether an eval failed
my $Jet = Win32::OLE->CreateObject('DAO.DBEngine.36')
or croak "Can't create Jet database engine.";
my $DB = $Jet->OpenDatabase($DBFile)
# code omitted for the sake of brevity
# perl script writes results to Access db via an append query
$DB->Execute( $SQLquery, 128 ); #128=DBFailOnError
eval {$err = Win32::OLE->LastError()} ; #<<<< PROBLEM LINE SEE FEEDBACK BELOW
if ( $err){
print $ERROR "WIN32::OLE raised an exception: $err\n";
Win32::OLE->LastError(0); # this clears your error
}
My thinking is that I am using eval to detect the existence of the error object and on the Win32:OLE module to detects the error and reports it.
Am I safe to ignore the criticism?
Leaving aside the perl-critic issuse, your code does not make much sense.
The Win32::OLE docs explain when exceptions will be thrown (and how you can automatically catch them).
LastError just gives you information about an error after it has occurred assuming your program has not died. Wrapping it in eval is pointless.
Update: I would have written something along the following lines (untested because I am on Linux with no access to Windows right now):
use strict;
use warnings;
use Carp;
use Win32;
use Win32::OLE;
$Win32::OLE::Warn = 3;
# No need for this eval if you are OK with the default error message
my $Jet = eval {
Win32::OLE->CreateObject('DAO.DBEngine.36')
} or croak sprintf(
"Can't create Jet database engine: %s",
win32_error_message(Win32::OLE->LastError)
);
# No need for this eval if you are OK with the default error message
my $DB = eval {
$Jet->OpenDatabase($DBFile)
} or croak sprintf(
"Can't open database '$DBFile': %s",
win32_error_message(Win32::OLE->LastError)
);
my $result = eval {
$DB->Execute( $SQLquery, 128 )
};
unless (defined $result) {
print $ERROR win32_error_message(Win32::OLE->LastError);
Win32::OLE->LastError(0);
}
The meaning of that message is detailed in the documentation. In short, it tells you to not rely on $# alone after an eval, but to also check the return value of eval.
However, in your case, the problem is that you aren't checking either the return value of eval nor are you checking $# and moreover it seems that your use of eval is completely superfluous because the method you are calling shouldn't be throwing any exceptions.