I have a code in Perl:
sub PrintVariables {
local (%in) = #_;
local ($old, $out, $output);
$old = $*; $* =1;
$output .= "<DL COMPACT>";
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/<BR>/g;
$output .= "<B> $key = </B>$out <BR>";
}
}
$output .= "</DL>";
$* = $old;
return $output;
}
in which $old = $*; $* =1; and $* = $old; gives error that $* is no longer supported. What should be the replacement for those two lines. I don't know the perl.
Man, that's some ancient code. It appears to predate lexical variables, which means it's Perl 4 code.
In this case, $* isn't actually doing anything. Just remove it.
sub PrintVariables {
local (%in) = #_;
local ($out, $output);
$output .= "<DL COMPACT>";
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/<BR>/g;
$output .= "<B> $key = </B>$out <BR>";
}
}
$output .= "</DL>";
return $output;
}
It's supposed to globally turn on the /m regex flag. But the only regex used by that code doesn't contain anything that's affected by /m.
To get a more verbose explanation of the warning message, use diagnostics;
(D deprecated, syntax) The special variable $* , deprecated in older
perls, has been removed as of 5.9.0 and is no longer supported. In
previous versions of perl the use of $* enabled or disabled multi-line
matching within a string.
Instead of using $* you should use the /m (and maybe /s) regexp
modifiers. You can enable /m for a lexical scope (even a whole file)
with use re '/m' . (In older versions: when $* was set to a true value
then all regular expressions behaved as if they were written using
/m.)
From perlvar:
$* was a variable that you could use to enable multiline matching. After a deprecation cycle, its magic was removed in Perl v5.10.0. Using it now triggers a warning: "$* is no longer supported". You should use the "/s" and "/m" regexp modifiers instead.
Deprecated in Perl 5.
In other words, that script is ancient, full of bad practices (even for the time), and – worst of all – there is no need for multiline matching at all.
Just remove all lines referring to $*, and it should still work. Otherwise, add the /m modifiers to all regexes in that region.
Related
I am trying to get "loginuser" value from this line. Please suggest
my $ln = CN=xuser\\,user(loginuser),OU=Site-Omg,OU=Accounts_User,OU
if (/ln: (\S.*\S)\s*$/)
{ print $1; }
This will work
use strict;
use warnings;
my $ln = qq{CN=xuser\\,user(loginuser),OU=Site-Omg,OU=Accounts_User,OU};
print $1 . "\n" if $ln =~ /\(([^)]*)/
Things to note
I have used strict and warnings to show any errors in the script( would have been very useful for your original)
I have used qq{...} to quote the original string
I have ended the line with ;
I have performed the regex match on $ln instead of $_ using $ln =~ ...
I have written correct regex to get the match.
I have some files in a directory like:
A.txt
B.txt
C.txt
I want to print them with new suffix:
#!/user/bin/perl
my #dir_list_initial = `ls *.txt | sed 's/.txt//g' `;
my $suffix = ".dat";
for (my $i=0; $i<=$#dir_list_initial; $i++){
print $dir_list_initial[$i] . $suffix;
}
I expect to print
A.dat
B.dat
C.dat
but it prints
.datA
.datB
.datC
You might try,
chomp(#dir_list_initial);
and later
print $dir_list_initial[$i] . "$suffix\n";
as every element of #dir_list_initial array has newline at the end of string.
Even better it would be to skip shell altogether, and use only perl,
my #dir_list_initial = map { s|\.txt||; $_ } glob("*.txt");
You're doing half of your program by running ls. Don't shell out when you can use builtin Perl mechanisms to do the same job The glob can do everything you're doing with ls and you don't have to depend upon the ls command (what if this is Windows?).
Also, always use strict; and use warnings; in your program, it can save you a ton of grief by picking up common mistakes.
#! /usr/bin/env perl
#
use strict;
use warnings;
use feature qw(say);
for my $file ( glob "*.txt" ) {
chomp $file;
$file =~ s/\.txt$/.dat/;
say $file;
}
Note I'm using s/.../.../ to substitute one suffix with another. You need to learn regular expressions. Your s/.txt// is not correct. The . can stand for any character, and you don't specify that .txt has to be on the end of the string. If my file was called ftxtback.txt, you'd change the file name to .datback.txt which is not what you want.
there's no need for calling sed here, perl can handle that well:
my #dir_list_initial = `ls *.txt`;
chomp #dir_list_initial;
my $suffix = ".dat";
foreach (#dir_list_inital){
s/\.txt$/$suffix/; # this alters #dir_list_initial
print "$_\n";
}
if you have a perl more recent than 5.14, you also can do this:
use 5.014;
my #dir_list_initial = `ls *.txt`;
chomp #dir_list_initial;
my $suffix = ".dat";
say s/\.txt$/$suffix/r foreach #dir_list_initial; # this doesn't alter the array.
and, as mpapec already has pointed out, it would be better to not involve the shell at all:
say s/\.txt$/.dat/r foreach <*txt>
my $pointer = 0;
foreach (#new1)
{
my $test = $_;
foreach (#chk)
{
my $check = $_;
chomp $check;
delete($new1[$pointer]) if ($test =~ /^$check/i);
}
$pointer++;
}
The if statement never matches the fact that many entries in the #new1 array do contain $check at the start of the array element (88 at least).
I am not sure it is the nested loop that is causing the problem because if i try this it also fails to match:
foreach (#chk)
{
#final = (grep /^$_/, #new1);
}
#final is empty but I know at least 88 entires for $_ are in #new1.
I wrote this code on a machine running Windows ActivePerl 5.14.2 and the top code works. I then (using a copy of #new1) compare the two and remove any duplicates (also works on 5.14.2). I did try to negate the if match but that seemed to wipe out the #new1 array (so that I didn't need to do a hash compare).
When I try to run this code on a Linux RedHat box with Perl 5.8.0 it seems to struggle with the variable matching in the REGEX. If I hard code the REGEX with an example I know is in #new1 the match works and in the first code the entry is deleted (in the second one value is inserted in #final).
The #chk array is a listing file on the web server and the #new1 array is created by opening two log files on the web server and then pushing one into the other.
I had even gone to the trouble of printing out $test and $check in each loop iteration and manually checking to see if any of the the values did match and some of them do.
It has had me baffled for days now and I have had to throw the towel in and ask for help, any ideas?
As tested by user1568538, the solution was to replace
chomp $check;
with
$check =~ s/\r\n//g;
to remove Windows-style line endings from the variable.
Since chomp removes the contents of the input record separator $/ from the end of its argument, you could also change its value:
my $pointer = 0;
foreach (#new1)
{
my $test = $_;
foreach (#chk)
{
local $/="\r\n";
my $check = $_;
chomp $check;
delete($new1[$pointer]) if ($test =~ /^$_/i);
}
$pointer++;
}
However, since $/ also affects other operations (such as reading from a file handle), perhaps it is safest to avoid changing $/ unless you are sure if it is safe. Here I limit the change to the foreach loop where the chomp occurs.
No knowing what your input data looks like, using \Q might help:
if ($test =~ /^\Q$check/i);
See quotemeta.
It is not clear what you are trying to do. However, you may be trying to only get those elements for which there is no match or vice versa. Adapt the code below for your needs
#!/usr/bin/perl
use strict; use warnings;
my #item = qw(...); # your #new?
my #check = qw(...); # your #chk?
my #match;
my #nomatch;
ITEM:
foreach my $item (#item) {
CHECK:
foreach my $check (#check) {
# uncomment this if $check should not be interpreted as a pattern,
# but as literal characters:
# $item = '\Q' . $item;
if ($item =~ /^$check/) {
push #match, $item;
next ITEM; # there was a match, so this $item is burnt
# we don't need to test against other $checks.
}
}
# there was no match, so lets store it:
push #nomatch, $item.
}
print "matched $_\n" for #matched;
print "didn't match $_" for #nomatch;
Your code is somewhat difficult to read. Let me tell you what this
foreach (#chk) {
#final = (grep /^$_/, #new1);
}
does: It is roughly equivalent to
my #final = ();
foreach my $check (#chk) {
#final = grep /^$check/, #new1;
}
which is equivalent to
my #final = ();
foreach my $check (#chk) {
# #final = grep /^$check/, #new1;
#final = ();
foreach (#new) {
if (/^$check/) {
push #final, $_;
last;
}
}
}
So your #final array gets reset, possibly emptied.
This script works on localhost with the -w switch but not without. It also works when use strict and use warning are active.
apache2/error.log:
without switch (aborted script):
(2)No such file or directory: exec of ... failed
with the switch I get:
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
On the live web server neither one works. Perl is new to me, but I know some BASH and PHP.
I run Debian Lenny, Apache2, Perl 5.10.
#!/usr/bin/perl -w
$| = 1;
my $mailprog = '/usr/sbin/sendmail'; # where the mail program lives
my $to = "not\#for.you"; # where the mail is sent
my ($command,$email,#pairs,$buffer,$pair,$email_flag) ;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#pairs = split(/&/, $buffer);
foreach $pair (#pairs) {
# Split the pair up into individual variables. #
my($name, $value) = split(/=/, $pair);
# Decode the form encoding on the name and value variables. #
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# If they try to include server side includes, erase them, so they
# aren't a security risk if the html gets returned. Another
# security hole plugged up.
$value =~ s/<!--(.|\n)*-->//g;
## print "Name of form element is $name with value of $value \n";
if ($name eq 'email') {
$email = $value;
}
if ($name eq 'command') {
$command = $value;
}
}
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/ ) {
$email_flag = "ERROR";
}
my $urlcommand = $command;
if ($command eq 'Subscribe') {
$command = "SUBSCRIBE rpc-news";
}
if ($command eq 'Unsubscribe') {
$command = "UNSUBSCRIBE rpc-news";
}
if ($command eq 'Suspend') {
$command = "SET rpc-news NOMAIL";
}
if ($command eq 'Resume') {
$command = "SET rpc-news MAIL";
}
my $getInfo = '';
print "Content-Type: text/html\n";
if ($email_flag ne "ERROR") {
open(MAIL,"|$mailprog -t");
print MAIL "To: $to\n";
print MAIL "From: $email\n";
print MAIL "Subject: [rpc-news] $command \n";
print MAIL "Reply-to: $email \n";
print MAIL "$command \n";
print MAIL "EXIT \n";
close (MAIL);
$getInfo = "?result=good";
}
if ($email_flag eq "ERROR") {
$getInfo = "?result=bad";
}
my $rootURL= $ENV{'SERVER_NAME'};
my $url = "http://${rootURL}/thank_you.html${getInfo}&action=${urlcommand}";
print "Location: $url\n\n";
Did you create your script on a Windows machine and upload it to a Linux server without fixing the line endings? Without the -w switch, the shebang line may look like "#!/usr/bin/perl\r", so the system goes looking for a program named "perl\r" (or however the line ending looks). With the -w switch, "#!/usr/bin/perl" doesn't have an indecipherable line ending stuck to it. Instead, that gets stuck to -w where it doesn't cause failure.
I thought there was a perlfaq about this, but I can't seem to find it in the docs at the moment.
Update: I found it over on PerlMonks, in a really old Q&A topic that seems unrelated until you read the body of the message: Answer: How to get rid of premature end of script headers. Yeah, I know, if you were just browsing threads you wouldn't even stop on that one. But here's the text of the post:
If you developed this script on
Windows, it's possible that the script
file has non-UNIX line endings. (The
perl interpreter can handle them, but
the shebang line is interpreted by the
shell, and is not tolerant of
incorrect line endings.) If this is
the problem, the script may terminate
with an error right at the shebang
line.
Use of uninitialized value $email_flag in string ne ...
which looks initialised to me.
if ($email =~ /(#.*#)|(\.\.)|(#\.)|(\.#)|(^\.)/ ||
$email !~ /^.+\#(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/
) {
$email_flag = "ERROR";
}
$email_flag only gets initialized here if the pattern matches - otherwise it's left undefined. You could add an else clause to ensure it gets initialized no matter what.
I would not use that code, it doesn't use CGI.pm (or CGI::Simple ...)
Get "TFMail -- Improved Form Mail" from "nms - web programs written by experts"
Its simple to install, and its written well ( it uses CGI ...)
Usually to get the output of a command I run from perl I use back tick
my $value = `pwd`;
How do I do it though if I need to insert a variable within the back ticks ``?
Text inside backticks is interpolated before it is passed to the operating system in the same way as text inside double quotes. So these statements all do what they look like they do:
$value = `$command`;
$value = `$someCommand $arg`;
$value = `$someOtherCommand #list`;
qx() is another way of running an external command and returning the output. If for some reason you don't want Perl to interpolate your command, you can run qx with the single-quote delimiter.
$value = qx'echo $PATH'; # shell's $PATH, not Perl's $PATH
You can just insert it. E.g.
my $dir = "/home"
my $text = `ls -l $dir`;
print $text;
my $hello = "world";
my $value = ` echo $hello `;
print $value;
Use qx() instead of backticks. Eg. my ($used, $dir); ($used) = qx(du -k $dir);