Re: escape character in regex

[John W. Krahn]

On 2022-10-10 18:12, Henrik Park wrote:


I know "/" is a special character for regex, which should be escaped.

But if I put "/" in a variable and use the variable in regex, then it 
doesn't need the explicit escape. Like this one:


$ perl -le '$delimiter="/"; $str="hello/world/buddy"; 
@list=split/$delimiter/,$str;print "@list"'

hello world buddy


Am I right? thank you.




"/" is NOT a special charater in a regular expression.  It is just that 
in Perl the default delimiter for some operators is "/" (i.e. m//, s///, 
tr///, etc.).


John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Benchmark for Scala, Ruby and Perl

[John W. Krahn]

On 2022-01-15 00:04, Jon Smart wrote:


Hello Paul

Do you mean by undef $/ and with <$fh> we can read the file into memory 
at one time?


$/ is the input record separator, newline by default.
If undefined that means that the whole file is treated as one single record.


Yes that would be faster b/c we don't need to read file by each line, 
which increases the disk IO.


Another questions:
1. what's the "truss" command?


truss is a "unix" command.  Search for "truss unix".



2. what's the syntax "<:mmap"?


mmap enables a memory mapped file.  I treats the file as if it were a 
chunk of memory instead of a file.


Depending on the size of the file and the amount of memory available it 
may not make a difference.  Benchmark to confirm.




On 15.01.2022 15:45, Paul Procacci wrote:


-
use strict;

$/ = undef;


That is usually written as:

local $/;

because $/ is a global variable and you want to limit the scope of any 
change.




my %stopwords = do {
    open my $fh, '<:mmap', 'stopwords.txt' or die $!;
    map { $_ => 1; } split /\n/, <$fh>;
};

my %count = do {
    my %res;
    open my $fh, '<:mmap', 'words.txt' or die $!;
    map { $res{$_}++ unless $stopwords{$_}; } split /\n/, <$fh>;
    %res;
};

my $i=0;
for (sort {$count{$b} <=> $count{$a}} keys %count) {
    if ($i < 20) {
    print "$_ -> $count{$_}\n"
    } else {
   last;
    }
    $i ++;
}




John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: memory mapped file example

[John W. Krahn]

On 2020-10-03 5:41 a.m., stefano cerbioni wrote:

hi guys i try to read a memory mapped file created with c++ , this is a c++
code that i have
[code]


[snip code]



[/code]

how can read a  memory mapped created ?
thankz at all



A memory mapped file should be just like any other file.  Just find out 
what the file name is and determine what format the data is stored in 
that file.


John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: question about perl script

[John W. Krahn]

On 2019-10-29 7:48 p.m., 刘东 wrote:

Dear every one:


Hello.


I try to write a perl script to delet the content of file carp01_1_both.txt as 
same as from another file carp-carp01_TKD181002053-1_1_sg.txt, so to get a new 
file from file carp-carp01_TKD181002053-1_1_sg.txt but excluding file 
carp01_1_both.txt. However, when I run this scrip, it does not work, and 
display the information as follows:
...

Semicolon seems to be missing at carp01_1_both.txt line 44993.




syntax error at carp01_1_both.txt line 1, near "979:"


These messages say that perl is trying to interpret your data file as if 
it were a Perl program.




perl script:
#!/usr/bin/perl -w
open(NAME,"<$ARGV[0]")|| die;
open(SECON,"<$ARGV[1]")|| die;
open(SELEC,">$ARGV[2]")|| die;
$name = "";
%pair = ();

while(){
  chomp;
  my @line = split("\t",$_);
 $name = $line[0];
 $pair{$name} = 1;
}

while(my $li = ){
 chomp($li);
 my  @line = split("\t",$li);
 $name = $line[0];
 my  $cont = $li;
if (exists $hash{$name}) { # if current read appeared before
 next;
 } else { # if it haven't been read before
 print SELEC "$cont\n";
  }
}

close NAME;
close SECON;
close SELEC;


#!/usr/bin/perl
use warnings;
use strict;

open my $NAME, '<', $ARGV[ 0 ] or die "Cannot open '$ARGV[0]' because: $!";
open my $SECON, '<', $ARGV[ 1 ] or die "Cannot open '$ARGV[1]' because: $!";
open my $SELEC, '>', $ARGV[ 2 ] or die "Cannot open '$ARGV[2]' because: $!";

my %pair;

while ( <$NAME> ) {
my ( $name ) = split /\t/;
$pair{ $name }++;
}

while ( <$SECON> ) {
my ( $name ) = split /\t/;
print { $SELEC } $_ unless exists $pair{ $name };
}

close $NAME;
close $SECON;
close $SELEC;

__END__


John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Help me with a regex problem

[John W. Krahn]

On 2019-10-25 3:23 a.m., Maggie Q Roth wrote:

  Hello


Hello.


There are two primary types of lines in the log:


What are those two types?  How do you define them?



60.191.38.xx/
42.120.161.xx   /archives/1005


From my point of view those two lines have two fields, the first looks 
like an IP address and the second looks like a file path.  In other 
words I can't distinguish the difference between these two "types".




I know how to write regex to match each line, but don't get the good result
with one regex to match both lines.

Can you help?


Perhaps if you could describe the problem better?


John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: perl script question

[John W. Krahn]

On 2019-10-09 7:21 p.m., 刘东 wrote:

hellow:
I have written a script, but it does not work, can you tell me what wrong with 
me?


#! /usr/bin/perl

use strict;
use warnings;
use Getopt::Long;

my ($dir, $files, $file_name, $file_format, $file_dir, $file_main);

GetOptions ('dr=s'  =>\$dir);

open INF,"<",'sine.fa' or die "can't read open sine";

foreach $files (glob("$dir/*.fa")) {
open FASEQ, "<", $files or die "can not read open $!";
   ($file_dir, $file_main) = split (/\/\//,$files);
   ($file_name,$file_format) =split(/\./,$file_main);
open OUTFILE, '>', $file_name.".txt";
`./usearch -ublast FASEQ -db INF -evalue 1e-5 -userout OUTFILE -strand both 
-userfields query+qlo+qhi+ql+qs+qstrand+target+tlo+thi+tl`;
}

close FASEQ;
close OUTFILE;
close INF;


(Sorry, correction added.)
Perhaps it may work better like this:

#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Long;

GetOptions( 'dr=s' => \my $dir );

opendir my $DH, $dir or die "Cannot open '$dir' because: $!";

while ( my $file = readdir $DH ) {

my $file_name = $file =~ s/\.fa\z/.txt/r or next;

0 == system './usearch',
'-ublast', "$dir/$file",
'-db', 'sine.fa',
'-evalue', '1e-5',
'-userout', $file_name,
'-strand', 'both',
'-userfields', 'query+qlo+qhi+ql+qs+qstrand+target+tlo+thi+tl'
or die "system ./usearch failed: $?";
}


John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: perl script question

[John W. Krahn]

On 2019-10-09 7:21 p.m., 刘东 wrote:

hellow:
I have written a script, but it does not work, can you tell me what wrong with 
me?


#! /usr/bin/perl

use strict;
use warnings;
use Getopt::Long;

my ($dir, $files, $file_name, $file_format, $file_dir, $file_main);

GetOptions ('dr=s'  =>\$dir);

open INF,"<",'sine.fa' or die "can't read open sine";

foreach $files (glob("$dir/*.fa")) {
open FASEQ, "<", $files or die "can not read open $!";
   ($file_dir, $file_main) = split (/\/\//,$files);
   ($file_name,$file_format) =split(/\./,$file_main);
open OUTFILE, '>', $file_name.".txt";
`./usearch -ublast FASEQ -db INF -evalue 1e-5 -userout OUTFILE -strand both 
-userfields query+qlo+qhi+ql+qs+qstrand+target+tlo+thi+tl`;
}

close FASEQ;
close OUTFILE;
close INF;



Perhaps it may work better like this:

#!/usr/bin/perl

use strict;
use warnings;
use Getopt::Long;

GetOptions( 'dr=s' => \my $dir );

opendir my $DH, $dir or "Cannot open '$dir' because: $!";

while ( my $file = readdir $DH ) {

my $file_name = $file =~ s/\.fa\z/.txt/r or next;

0 == system './usearch',
'-ublast', "$dir/$file",
'-db', 'sine.fa',
'-evalue', '1e-5',
'-userout', $file_name,
'-strand', 'both',
'-userfields', 'query+qlo+qhi+ql+qs+qstrand+target+tlo+thi+tl'
or die "system ./usearch failed: $?";
}


John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: symlink to "pack"

[John W. Krahn]

On 2019-09-08 12:20 p.m., Jorge Almeida wrote:

On Sun, Sep 8, 2019 at 8:08 PM John W. Krahn  wrote:


On 2019-09-07 1:25 p.m., Jorge Almeida wrote:

On Unix/Linux a character in a file name can be any character except a
slash '/' character because that is used to separate path elements, or a
null "\0" character because that is what the C language uses to signify
the end of a string.


Yes, but does a symlink target counts as a "file name"? Probably, but
it's not very clear. (I didn't want to dereference the symlink, only
readlink() it...)

Jorge


So your Perl string "\0\f" is read by C as a zero length string.



The operating system is written in C.  The symlink(2) function is part 
of the operating system and is written in C.  Therefore, when perl calls 
symlink(2) it has to send a valid C type string.  Because your string 
starts with a NULL character it is a C string with zero characters.



John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: symlink to "pack"

[John W. Krahn]

On 2019-09-07 1:25 p.m., Jorge Almeida wrote:

Sorry about the title, it's the best I can do...

#!/usr/bin/perl
use strict;
use warnings;
my $num=12;
my $target=pack('n', $num);
symlink($target, "foo") || die $!;

It dies with "No such file or directory"
No symlink is created. What I want is a symlink named "foo" pointing
to a 2-byte string. Yes, it would be a broken symlink. (Yes, this is
how I want it).

Symlink() can create broken links, the problem is the target. What to
do? (And why doesn't it work?)



$ perl -le'
use warnings;
use strict;
use Data::Dumper;
$Data::Dumper::Useqq = 1;

my $num = 12;
my $target = pack "n", $num;
print Dumper $target;
'
$VAR1 = "\0\f";


On Unix/Linux a character in a file name can be any character except a 
slash '/' character because that is used to separate path elements, or a 
null "\0" character because that is what the C language uses to signify 
the end of a string.


So your Perl string "\0\f" is read by C as a zero length string.


John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Syntax "||" before sub

[John W. Krahn]

On 2018-11-22 8:08 a.m., David Precious wrote:



You'll often see these operators used to provide default values.

e.g.

   sub hello {
   my $name = shift;
   $name ||= 'Anonymous Person';


Which is usually written as:

   sub hello {
   my $name = shift || 'Anonymous Person';



I do notice that there isn't actually a very useful section on ||=
and //= - I may try to raise a pull requests to add more documentation
on them.


$var ||= 'VALUE';

Is just shorthand for:

$var = $var || 'VALUE';

The syntax is borrowed from the C programming language and it is 
slightly more efficient when compiled to machine code.




John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Code Assistance Pls

[John W. Krahn]

On 2018-11-21 3:08 a.m., Amanda Paziuk wrote:


I'm hoping someone can assist as I'm having difficulty with parsing a
section of the following configuration:

This is the code I have:

 push @list, $datum; # should only contain '1', and '3'

>
> ...
>

 foreach my $i (@list){ # loops through dynamically-learned file IDs
 open (IN, $file);
 while () {
 chomp;
 if (/^file-id $i/) {


If $i contains 1 then this will match "file-id 10" or "file-id 1234" or 
any number whose first digit is 1.

You need to either use anchors:

 if ( /^file-id \b$i\b/ ) {

Or capture the number and do numerical comparison:

 if ( /^file-id (\d+)/ && $1 == $i ) {




John

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: help with a stat script

[John W. Krahn]

On Thu, 2018-07-12 at 19:35 +0800, Lauren C. wrote:
> 
> My web is powered by Apache and PHP,its access log seems as blow,
> 
> xx.xx.xx.xx - - [12/Jul/2018:19:29:43 +0800] "GET 
> /2018/07/06/antique-internet/ HTTP/1.1" 200 5489 "https://miscnote.ne
> t/" 
> "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_12_6) AppleWebKit/537.36 
> (KHTML, like Gecko) Chrome/67.0.3396.99 Safari/537.36"
> 
> A perl script for stat purpose of this log:
> 
> tail -f /var/log/apache2/access.log|perl -nle 'next unless m{^(\S+) -
> - 
> \[(\S+).*\] \"GET (.*?/)\s+}; printf "%-20s%-40s%-40s\n",$1,$3,$2'
> 
> I was totally confused about it.
>   what does m{...} and its content stand for?



m{^

Start with the (^) beginning of line anchor, the following pattern must
match at the beginning of the line.

(\S+)

Match one or more non-whitespace characters and store the match in the
$1 variable.  This matches the "xx.xx.xx.xx" portion of your string.

' - - \['

Match the literal characters SPACE HYPHEN SPACE HYPHEN SPACE LEFT-
BRACKET.

(\S+)

Match one or more non-whitespace characters and store the match in the
$2 variable.  This matches the "12/Jul/2018:19:29:43" portion of your
string.

'.*\] \"GET '

Match zero or more non-newline characters followed by the literal
string '] "GET '.

(.*?/)

Match as few as possible non-newline characters followed by a '/'
character and store the match in the $3 variable.  This matches the
"/2018/07/06/antique-internet/" portion of your string.

\s+}

And finally, match one or more whitespace characters so that the
previous non-greedy pattern will match correctly.  The modifier is
redundant so it could simply be:

\s}



John

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Removing a Pattern using a Regular Expression

[John W. Krahn]

On Wed, 2018-06-13 at 21:21 -0500, Martin McCormick wrote:
> I wrote a small perl program to more quickly read all the
> subjects in an email list.  One of the things the script does is
> to remove the mailing list name which repeats for every message
> and consists of a [, some English text and finally a ].
> 
>   I was able to write a RE that identifies that text and
> cause the script to save that string in a variable called
> $remove.  That part works and looks like:
> 
> foreach my $field (@fields) {#Assemble the new subject.
> if($field =~ m/\[(.*?)\]/) 

if you want to remove this string then why not just remove it here:

if ( $field =~ s/\[(.*?)\]// )


> { #$field is the blocked field.
> $remove = $field;
> } #field is the blocked field.
> else
> { #$field is not the blocked string.
> $newest = $newest . $field;
> } #$field is not the blocked string.
> }#Assemble the new subject.
> 
> if ( $newest eq $previous ) {#Skip this iteration.
> $newest = "";
> next;
> }#Skip this iteration.
> else
> { #they are different.
> 
>   This is where things don't quite work yet.  At this
> point, I have $remove which contains that bracketted list name
> such as
> 
> [BLIND-HAMS] or any number of other names enclosed in brackets.
> So, the next thing I do is to attempt to remove just that part of
> the subject line, keeping everything else that was there.
> 
>    $subject =~ s/'$remove'//;

After string interpolation you have:

$subject =~  s/'[BLIND-HAMS]'//;

Which is a string of three characters consisting of the "'" character
followed by a character class followed by the "'" character.

The character class says to match one character that is either 'A' or
'B' or 'D' or 'E' or 'F' or 'G' or 'H' or 'I' or 'L' or 'M' or 'N' or
'S'.

You probably need to use quotemeta:

$subject =~  s/'\Q$remove\E'//;



John

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: project euler #8

[John W. Krahn]

On Tue, 2017-05-16 at 14:01 +0800, derr...@thecopes.me wrote:


I am working on problem #8 of the euler project. see below.
> 
> 
> 
> The four adjacent digits in the 1000-digit number that have the
> greatest product are 9 × 9 × 8 × 9 = 5832.
> 
> 73167176531330624919225119674426574742355349194934
> 96983520312774506326239578318016984801869478851843
> 85861560789112949495459501737958331952853208805511
> 12540698747158523863050715693290963295227443043557
> 66896648950445244523161731856403098711121722383113
> 6222989342338030813533627661428280686645238749
> 30358907296290491560440772390713810515859307960866
> 70172427121883998797908792274921901699720888093776
> 65727333001053367881220235421809751254540594752243
> 52584907711670556013604839586446706324415722155397
> 53697817977846174064955149290862569321978468622482
> 83972241375657056057490261407972968652414535100474
> 82166370484403199890008895243450658541227588666881
> 16427171479924442928230863465674813919123162824586
> 17866458359124566529476545682848912883142607690042
> 2421902267105562632109370544217506941658960408
> 07198403850962455444362981230987879927244284909188
> 84580156166097919133875499200524063689912560717606
> 05886116467109405077541002256983155200055935729725
> 71636269561882670428252483600823257530420752963450
> 
> Find the thirteen adjacent digits in the 1000-digit number that have
> the greatest product. What is the value of this product?



#!/usr/bin/perl
use warnings;
use strict;

( my $x = 

Re: regex with HEX ascii chars

[John W. Krahn]

On Thu, 2018-04-12 at 17:26 +0100, Gary Stainburn wrote:
> I have a text file (created by  pdftotext) that I've imported into my
> script.
> 
> It contains ASCII characters 251 for crosses and 252 for ticks.

ASCII defines 128 characters so those characters are not ASCII.


John

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: compute depth of word in line

[John W. Krahn]

On Sat, 2018-03-10 at 00:14 +0100, hw wrote:
> 
> Not really, the words I get from the ReadLine functions are not
> organized in an array.
> 
> I´ve come up with this function to compute the "depth" of a word:
> 
> 
> sub get_depth {
>   my $string = shift;
> 
>   $string =~ s/\s/ /g;
>   $string =~ s/\s+/ /g;
>   $string =~ s/^\s*//;
>   $string =~ s/\s*$//;
> 
>   my $depth = 0;
>   my $position = 0;
>   while((my $start = index($string, ' ', $position)) != -1) {
> $position = $start + 1;
> $depth++;
>   }
> 
>   return $depth;
> }

That function could be simplified to:

sub get_depth {
my $string = shift;

$string =~ s/^\s+//;
$string =~ s/\s+$//;
my $depth = $string =~ s/\s+/ /g;

return $depth;
}


John

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Find::Perl find not returning

[John W. Krahn]

On Wed, 2017-12-13 at 11:28 +, Mike Martin wrote:
> Hi
> I have the following code
> 
> use strict;
> use File::Find;
> my @vsbe;
> my $top='P:\PT-6\PT-60\PT-603\Shared\Data Store\Files Dump Folder';
> my $max_depth=9;
> my $cnt1=0;
> 
> find({wanted=>\,preprocess=>\},$top) ;
> 
> sub wanted1 {
> 
> if ($cnt1 <=1000){
> my $file = $File::Find::name;
> if (grep {/vsb$/} $file){

grep works on lists so you don't need grep there:

if ( $file =~ /vsb$/ ) {


> push @vsbe, $file if $cnt1 <=1000 ;
> $cnt1++;
> print $cnt1,"\n" ;
> }
> else {return}
> 
> return if $cnt1 >=1000
> }
> return
> 
> }
> sub preprocess1 {
> my $depth = $File::Find::dir =~ tr[\\][];
> #print 'depth',"\t",$depth,"\t",$File::Find::dir,"\n";
> return  @_ if $depth < $max_depth;
> return grep { not -d } @_ if $depth == $max_depth;
> return;
> }
> 
> Unfortunately the wanted function never returns, it (at best) stays
> stuck
> on print the last value of $cnt1 (1000)
> 
> Any ideas what is happening here

The wanted function does return, but it does not return to your
process.  It is called inside a loop in the File::Find code and when it
returns the loop continues until all the files are found.


John

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Using Pack and Unpack

[John W. Krahn]

On Wed, 2017-12-06 at 21:53 -0600, Martin McCormick wrote:
> A perl program needs to send binary data to an external device
> such that 0xff looks like 


$ perl -le'my $x = sprintf q/%b/, 0xff; print $x'




>   I have a line in the program as follows:
> 
> my $txstart = pack("h*","fefe5a95");
> 
> Are those 4 bytes usable as the binary data 
> 
> fe fe 5a 95?
> 
>   Is there a good way when running perl -d to view the
> contents of the string to make sure it is what it should be?


use Data::Dumper;
$Data::Dumper::Useqq = 1;

my $txstart = pack 'h*', 'fefe5a95';

print Dumper $txstart;



John

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Use of uninitialized value for perl

[John W. Krahn]

On Sun, 2017-11-05 at 00:43 +, Dong Liu wrote:
> I try used perl script to get characters from data:
> 
> #!/usr/bin/perl -w
> use v5.14;
> while (){
> chomp;
> my $line = '';
> $line = (split //,@_)[5];

At no point in your script do you or perl assign a value to the array
@_ so the array will have 0 elements, and an array in scalar context
will return the number of elements in the array, so that statement is
the same as:

$line = ( split //, '0' )[ 5 ];

Which will create the list ( '0' ).  So every element other than zero
(the first element) will be undef.  So that statement is the same as:

$line = undef;


> print "it is $line.\n";
> }
> 
> __DATA__
> Danio rerio strain Tuebingen chromosome 1 GRCz11 Primary Assembly
> Danio rerio strain Tuebingen chromosome 2 GRCz11 Primary Assembly
> 
> the results is :
> Use of uninitialized value $line in concatenation (.) or string at
> foundins.pl line 9,  line 1.
> it is .
> Use of uninitialized value $line in concatenation (.) or string at
> foundins.pl line 9,  line 2.
> it is .
> 
> the aim for the work is to get the number for each line such as:
> 1 for first line and
> 2 for second lin

When using a while ( <> ) loop the current line number can be found in
the $. variable:

$ perldoc -v $.




John

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Perl invocations

[John W. Krahn]

On Sun, 2017-07-02 at 11:16 -0400, Shawn H Corey wrote:
> On Sun, 2 Jul 2017 14:29:25 +0200
> Eric de Hont  wrote:
> 
> > What it boils down to: use warnings as well as -w works, but -w is 
> > considered old fashioned.
> 
> The problem with -w is that it can't be turned off.

$ perl -le'
use warnings;
my $x;
{   no warnings;
print $x;
}
print $x;
'

Use of uninitialized value $x in print at -e line 7.

$ perl -wle'
my $x;
{   local $^W = 0;
print $x;
}
print $x;
'

Use of uninitialized value $x in print at -e line 6.

-- 
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: [ANN] SurfShop 1.6.1 Shopping Cart Released

[John W. Krahn]

SSC_perl wrote:


Again, let us know what you think!  Your feedback, as always, is 
appreciated.

Regards,
Frank Jance


Hello Frank,

It looks like you still have some of the same problems I pointed out 
last year in November.
To begin, these files do not have a terminating newline, so they are 
technically NOT text files:


admin.cgi
autoconfig.cgi
forceorder.cgi
shop.cgi
useradmin.cgi
log_notification.pl
ss_files/Multipart.pm
ss_files/SSLib.pm
ss_files/Surf.pm
ss_files/Validator.pm

The following was pointed out last year:

shop.cgi:739:  my $states = 
'AL|AK|AZ|AR|CA|CO|CT|DE|FL|GA|HI|ID|IL|IN|IA|KS|KY|LA|ME|MD|MA|MI|MN|MS|MO|MT|NE|NV|NH|NJ|NM|NY|NC|ND|OH|OK|OR|PA|RI|SC|SD|TN|TX|UT|VT|VA|WA|DC|WV|WI|WY';
shop.cgi-740-  $main::global-{'form'}-{'bprovince'} = 
$main::global-{'form'}-{'Ecom_BillTo_Postal_StateProv'} unless 
($main::global-{'form'}-{'Ecom_BillTo_Postal_StateProv'} =~ /^$states$/i);
shop.cgi-741-  $main::global-{'form'}-{'sprovince'} = 
$main::global-{'form'}-{'Ecom_ShipTo_Postal_StateProv'} unless 
($main::global-{'form'}-{'Ecom_ShipTo_Postal_StateProv'} =~ 
/^$states$/i);  # for use with processors that use separate field for 
province.


Your regular expression says: /^AL|AK|AZ|AR|...|DC|WV|WI|WY$/i.  Which 
means that you want to match 'AL' only at the beginning of the line or 
match 'WY' only at the end of the line or match the other strings 
anywhere in the line.  It looks like you probably want to have something 
like this:


my $states = 
qr/\A(?:A[KLRZ]|C[AOT]|D[CE]|FL|GA|HI|I[ADLN]|K[SY]|LA|M[ADEINOST]|N[CDEHJMVY]|O[HKR]|PA|RI|S[CD]|T[NX]|UT|V[AT]|W[AIVY])\z/i;
$::global-{form}{bprovince} = 
$::global-{form}{Ecom_BillTo_Postal_StateProv} if 
$::global-{form}{Ecom_BillTo_Postal_StateProv} !~ /$states/;
$::global-{form}{sprovince} = 
$::global-{form}{Ecom_ShipTo_Postal_StateProv} if 
$::global-{form}{Ecom_ShipTo_Postal_StateProv} !~ /$states/;  # for use 
with processors that use separate field for province.



Also from last year:

ss_files/Validator.pm:123:  my $address_count = 0;
ss_files/Validator.pm:124: $address_count++ while 
($test_data =~ 
m/bPO\s?BOX\b|\bPOB\b|\bBOX\b|\bSTREET\b|\bST\b|\bAVENUE\b|\bAVE\b|\bAV\b|\bBLVD\b|\bPARKWAY\b|\bPKWY\b|\bCT\b|\bPLACE\b|\bPL\b|\bLANE\b|\bROAD\b|\bRD\b|\bCIRCLE\b|\bDRIVE\b|\bDR\b/gi);


The first string /bPO\s?BOX\b/ does not have a word boundary at the 
beginning, unlike the rest of the strings.  It would probably be better as:


my $address_count = () = $test_data =~ 
/\b(?:PO\s?BOX|POB|BOX|STREET|ST|AVENUE|AVE?|BLVD|PARKWAY|PKWY|CT|PLACE|PL|LANE|ROAD|RD|CIRCLE|DRIVE|DR)\b/gi;



And, another one:

ss_files/Validator.pm:130: my $billto_digits = 
($test_data =~ m/[0-9]/g);  # count the number of digits


That does not actually count the number of digits.  You want something 
like this:


my $billto_digits = $test_data =~ tr/0-9//;  # count the number of digits



autoconfig.cgi:1292:my $letters = 
'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ';


You are missing the letter O from your list.



forceorder.cgi:412:opendir(CARTS, $path);
forceorder.cgi-413-while (my $cartfile = readdir(CARTS)) {
forceorder.cgi-414-next if (-d $cartfile || $cartfile =~ 
/^(\.|index)/);


-d $cartfile tries to stat() the file in the current directory but it 
should be: -d $path/$cartfile


shop.cgi:1151: opendir (my $dh, $payloads);
shop.cgi-1152- my @files = readdir($dh);
shop.cgi-1153- closedir ($dh);
shop.cgi-1154- foreach my $file (@files) {
shop.cgi-1155-#next if ($file eq '.' || $file eq '..');
shop.cgi-1156- next if ($payloads/$file eq '.' || 
$payloads/$file eq '..');


$payloads/$file will NEVER be equal to either '.' or '..'.  The 
commented out line is the correct way to do it.


shop.cgi:1304: opendir(my $carts, $path);
shop.cgi-1305- while (my $cart = readdir($carts)) {
shop.cgi-1306-#next if (-d $cart || $cart =~ /^(\.|index)/);
shop.cgi-1307- next if (-d $path/$cart || $path/$cart =~ 
/^(\.|index)/);


$path/$cart =~ /^(\.|index)/ should be: $cart =~ /^(\.|index)/

autoconfig.cgi:1207:   opendir(my $datadir_dh, $datadir/data) || 
SSLib::error(Error opening: $datadir);

autoconfig.cgi-1208-   my @files = readdir($datadir_dh);
autoconfig.cgi-1209-   close $datadir_dh;

You need to use closedir() on a handle opened with opendir().

ss_files/SSLib.pm:1428:opendir (my $DIR, $directory) || 
error(make_directory_popup: $directory);

ss_files/SSLib.pm-1429-my @files = readdir($DIR);
ss_files/SSLib.pm-1430-closedir ($DIR);
ss_files/SSLib.pm-1431-foreach my $file (@files) {
ss_files/SSLib.pm-1432-#   next if (-d $file || 
$file eq '.' || $file eq '..');
ss_files/SSLib.pm-1433-next if (-d 
$directory/$file || $directory/$file eq '.' || $directory/$file eq 
'..');


$directory/$file will NEVER be 

Re: Suddenly.... Part 2

[John W. Krahn]

Peter Holsberg wrote:

I think I've isolated the section that is not doing what I want.

open (FHIN, $recapfile) or die $!;


That would be better as:

open my $FHIN, '', $recapfile or die Cannot open '$recapfile' because: 
$!;




my $indexb; ## for the recapfile array
my $ofile;


You never use this variable, it should be:

my @ofile;



# Create new array containing all the lines of recapfile up to
# the string RESULTS OF BOARD 1

XYZZY:
while (FHIN)
{
last XYZZY if  / RESULTS OF BOARD 1/;
chomp;
$ofile[$indexb++] .= $_;


That would be better as:

push @ofile, $_;



 }
close FHIN;

To see what was put into ofile, a line at a time, I used

foreach (@ofile) {
   print $_\n;
}

Is that correct?


That is correct.


John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Where's this documented?

[John W. Krahn]

shawn wilson wrote:


Oh, I guess I was thinking that using the file name repeats the stat
(which it does). Since I was complaining about the ugliness of '_'.
However, you're right - that works as well as (-f _)-- that doesn't
look weird as shit? I've got issues moving my fingers into typing
that Whatever, y'all answered my question and I learned something
(though damn them for not just making another perlvar or something
else to do this) - I appreciate the help/info.


_ is a perlvar.  It is part of the typeglob that includes $_, @_, %_ and _.

perldoc perldata
perldoc perlmod
perldoc perlref



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Where's this documented?

[John W. Krahn]

Shaji Kalidasan wrote:


You can use more than one file test on the same file to create a
complex logical condition.
Suppose you only want to operate on files that are both readable and
writable; you check each attribute and combine them with and:

if (-r $file and -w $file) {
...
}

Each time you perform a file test


or use stat() or lstat()


, Perl asks the filesystem for all of
the information about the file (Perl’s actually doing a stat each time,
which we talk about in the next section). Although you already got that
information when you tested -r, Perl asks for the same information
again so it can test -w. What a waste! This can be a significant
performance problem if you’re testing many attributes on many files.

The virtual filehandle _ (just the underscore) uses the information
from the last file lookup that a file test operator


or stat() or lstat()


performed. Perl
only has to look up the file information once now:




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Turn part of a string into a single newline

[John W. Krahn]

Parysatis Sachs wrote:

Hi everyone!


Hello,



I'm new to this mailing list as well as to programming and Perl in general.
So there is a chance I might ask relatively stupid questions with very
obvious answers... Please bear with me!

So, here it goes:

I have a very long string with lots of Ns in it, like this:
agctagccgagctaNNatggctaNNNatgtgaNNatg

So, I want to get rid of the Ns and get ONE SINGLE newline for each group
of Ns

So far I've managed to do this:

if ($joinedDNA =~ s/N+/\n/g) {

$joinedDNA =~ s/\R//g;

}


That should be just:

$joinedDNA =~ s/N+/\n/g;

Or just:

$joinedDNA =~ tr/N/\n/s;


The statement:

$joinedDNA =~ s/\R//g;

removes all newlines.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: [OT] SurfShopPRO Perl shopping cart system is now open source

[John W. Krahn]

SSC_perl wrote:

Hi John,


Hello,



Thanks for getting back to me with your findings.  I really
appreciate it.  I've gone through everything, made the changes that I
could, and I have some questions to some of your remarks.


You are using the value from readdir() without prepending the path to
the file name.


Unless I'm mistaken, I believe the full paths are being set in
the variables, before being used by opendir.


Yes, the full path of a directory.


 Am I misunderstanding  something?


readdir() returns just the file names, without the path.



autoconfig.cgi:883:   print font color=\33\[dir] $dir/$file/font  - .htaccess 
installedbr\n;
The variable $file is not assigned a value.


I'm not seeing this.  I thought it was set earlier in the
security sub, but maybe I've just been staring at it for too long.


All instances of $file in the subroutine Security():

745 my (@dirs, @files, $dir, $file) = ();

$file is created at the beginning of the subroutine.

832 foreach $file (@datfiles) {
833 Surf::cl($path/$file) 
=~ /(.*)/;


$file is used in a foreach loop and therefore:

perldoc perlsyn
the variable is implicitly local to the loop and regains its former
value upon exiting the loop.

Where its former value is undef.

874 foreach $file (@files) {
875 push @dirs, 
$dir/$file if (-d $dir/$file  $file !~ /^\./);


Same as above.

883 print font 
color=\33\[dir] $dir/$file/font - .htaccess installedbr\n;


At this point $file has no value.



I also ran perl -c, as well as PerlCritic, on all the files and
have uploaded a cleaned up version (1.5.1) to our site.  Here's a
direct link:

http://www.surfshopcart.com/download-zip.php


I started looking through it and found this mistake.  In the old version 
you had:


Email.pm:97:   open (my $mail_fh, |$path -t -oi -oem) || 
error(Can't open $main::global-{form}-{'mailprog'}!\n);


And:

ipn.pl:90:open (MAIL, |$main::global-{config}-{'mailprog'} -t -oi 
-oem) || error(IPNemail: Can't open 
$main::global-{config}-{'mailprog'}!\n);


Which you changed to:

Email.pm:91:open (my $mail_fh, '', |$path -t -oi -oem) || 
error(Can't open $main::global-{'form'}-{'mailprog'}!\n);


And:

ipn.pl:90:open (my $mail, '', 
|$main::global-{config}-{'mailprog'} -t -oi -oem) || 
error(ipn_email: Can't open $main::global-{config}-{'mailprog'}!\n);



You've changed them from opening an OUTPUT pipe to a mail program to 
opening a file named |$path -t -oi -oem for INPUT!


They were correct in the first place.

Or maybe better as:

Email.pm:91:open my $mail_fh, '|-', $path, '-t', '-oi', 
'-oem' or error( Can't open $path!\n );


And:

ipn.pl:90:open my $mail, '|-', $::global-{ config }{ mailprog }, 
'-t', '-oi', '-oem' or error( ipn_email: Can't open 
$::global-{config}{mailprog}!\n );




Antway, I found some mistakes in your code; to wit:


You were being kind. ;)  Thank you again!

Can I reference your name as a contributor,


Sure, if you would like to.


or would you prefer
to keep your name off the project?  Also, would you consider joining us?


I'll think about it.



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Need explanation of expression

[John W. Krahn]

Angela Barone wrote:

Hello,


Hello,



Could someone explain the format of the following line and how to read 
it?

$name  = $fieldname  =~ /\[(.*?)\]/ ? $main::global-{'form'}-{$1} : $out;


Do the contents of $fieldname match the pattern /\[(.*?)\]/?  If they do 
then assign $main::global-{'form'}-{$1} to $name.  If they do not then 
assign $out to $name.




Also, is there something in the perl man pages about it?


Yes.  You probably want perlop?



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: [OT] SurfShopPRO Perl shopping cart system is now open source

[John W. Krahn]

SSC_perl wrote:


Hello,


Hello,



This is a one-time post to announce that the SurfShopPRO Perl
shopping cart system is going open source.  Our site hasn't been fully
updated yet, but you can download the cart and check it our for
yourself.  We are looking for developers, designers, and testers.

http://www.surfshopcart.com/pages/pro.php

By doing this, we hope to generate enough interest in this
project so that we can bring SurfShop up-to-date and turn it into a
powerful example as to why someone should use Perl for e-commerce
again.  In my searches on the web, I've found that there are very few,
if any, good open source Perl carts out there that will work on shared
servers.  Hopefully we can turn that around.

SurfShop has been around since 1999 and is still used by quite a
few companies around the world.  As is, it's a very good cart to use -
it's stable and it's fast.  However, it's lacking some features that
more modern carts have, the default template really needs a face lift,
and the Perl code could use some updating, as well.

If anyone is interested in joining this project, please download
the script and join our forum.  There you'll find the official listing
of fixes needed and new features planned (we're always open to
suggestions).  We will also be implementing a plugin/module system and
will let developers and designers sell their modules and templates
though our online store.

Pros:
- full featured, rock solid, Perl based e-commerce system
- simple to install with autoconfig script
- powerful calculation engine
- full listing available on our site --
http://www.surfshopcart.com/pages/pro2.php

Cons:
- old code -- needs to be updated to modern Perl
- HTML templates are looking a bit stale, too -- needs an HTML5
makeover
- there are a few fixes that are needed -- see the list in our
forum **
- lacks some features to compete with the big boys -- see the
list in our forum **

I'm new to the open source community, so any help that anyone
would be willing to give me will be greatly appreciated.  Feel free to
contact me off-list.

Thank you,
Frank Jance
SurfShopCART


Sorry for taking so long to reply, but you had a lot of code to read
through.

Antway, I found some mistakes in your code; to wit:

$ perl -Mwarnings -Mstrict -c ss.lib
Useless use of private variable in void context at ss.lib line 381.

For the line:

381 $replace_tag;

Perhaps you meant that to be:

381 return $replace_tag;

The next is:

admin.cgi:388: $replace-{'history'} += Returned 
$out-{authamt}  . localtime() . \r;


You are using a string with addition which means it is the same as
saying:

admin.cgi:388: $replace-{'history'} += 0;

The next is:

shop.cgi:763:   my $states = 
'AL|AK|AZ|AR|CA|CO|CT|DE|FL|GA|HI|ID|IL|IN|IA|KS|KY|LA|ME|MD|MA|MI|MN|MS|MO|MT|NE|NV|NH|NJ|NM|NY|NC|ND|OH|OK|OR|PA|RI|SC|SD|TN|TX|UT|VT|VA|WA|DC|WV|WI|WY';
shop.cgi:764:   $main::global-{'form'}-{bprovince} = 
$main::global-{'form'}-{Ecom_BillTo_Postal_StateProv} unless 
($main::global-{'form'}-{Ecom_BillTo_Postal_StateProv} =~ /^$states$/i);
shop.cgi:765:   $main::global-{'form'}-{sprovince} = 
$main::global-{'form'}-{Ecom_ShipTo_Postal_StateProv} unless 
($main::global-{'form'}-{Ecom_ShipTo_Postal_StateProv} =~ 
/^$states$/i);  # for use with processors that use separate field for 
province.


Which means that 'AL' will only match at the beginning of the line and
'WY' will only match at the end of the line and all the other
alternatives will match anywhere in the line.

Perhaps you meant: /^(?:$states)$/i

The next is:

shop.cgi:1408:  $address_count++ while ($test_data =~ 
m/bPO\s?BOX\b|\bPOB\b|\bBOX\b|\bSTREET\b|\bST\b|\bAVENUE\b|\bAVE\b|\bAV\b|\bBLVD\b|\bPLACE\b|\bLANE\b|\bCIRCLE\b|\bDRIVE\b/gi);


It looks like the first alternative should be '\bPO\s?BOX\b', you are
missing a back-slash in front of the 'b'.

The next is:

shop.cgi:1414:  my $billto_digits = ($test_data =~ 
m/[0-9]/g);  # count the number of digits


This does not count the number of digits.  It just assigns true or
false to $billto_digits.

The next is:

autoconfig.cgi:1187:opendir (DIR, $main::global-{ddir}/data);
autoconfig.cgi-1188-my @files = readdir (DIR);
autoconfig.cgi-1189-closedir (DIR);
autoconfig.cgi-1190-foreach my $file (@files) {
autoconfig.cgi-1191-$file = $1 if 
(Surf::cl($main::global-{ddir}/data/$file) =~ /(.+)/);

autoconfig.cgi-1192-next unless (-f $file);
autoconfig.cgi-1193-chmod 0666, $file;

forceorder.cgi:409:opendir(CARTS, $path);
forceorder.cgi-410-while (my $cartfile = readdir(CARTS)) {
forceorder.cgi-411-next if (-d $cartfile || $cartfile =~ 
/^(\.|index)/);


shop.cgi:1767:  opendir(CARTS, $path);
shop.cgi-1768-  while ($cart = readdir(CARTS)) {
shop.cgi-1769-  next if 

Re: Problem rewinding the __DATA__ filehandle

[John W. Krahn]

Jim Gibson wrote:


On Oct 25, 2013, at 4:46 PM, Shaji Kalidasan wrote:


Dear Perlers,

I am trying to print the matching lines using __DATA__ filehandle and

for the very first time it prints the desired lines, but as soon as I
rewind it using seek, it is printing lines from the very beginning
which is not the desired result (as it prints from the start). I want
to rewind only the __DATA__ part.

As you have discovered, the special file handle DATA is opened to the
source file for your program. When the compiler encounters either of
the following lines in your source file:

__END__
__DATA__


it stops reading the source file and leaves the file handle open at
that point. The first time you read theDATA  file handle, you get
the line after the '__DATA__' line. But when you rewind the file
handle, it is positioned at the beginning of the file, and you get to
read your program.

You have two choices (at least):

1. Save the position of the file handle when you enter the program:

   my $data_pos = tell(DATA);


DATA is the same as readline( DATA ) which will not work with tell().

It should be just:

   my $data_pos = tell DATA;



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Help needed with here documents (security?)

[John W. Krahn]

Ronald F. Guilmette wrote:

In message5268663c.4040...@stemsystems.com,
Uri Guttmanu...@stemsystems.comwrote:


i think a blank line with . will end input to smtp servers. try that too
in the line after the from field.


DING DING DING!!!

Give that man a cupie doll, because he's the winner of today's
perplexing puzzle test!

In short, yes, when I first read the above sentence, I said to myself
No way!  I know that when input is coming in ``over the wire'' to a
normal SMTP server *and* when it is already in ``DATA'' (input message
collection) SMTP protocol mode, *then* a period alone on a line ends
input, *however* in this case Postfix is reading the message from STDIN,
and so there is really no need for that period-alone-on-a-line bit of
SMTP protocol to apply in this case, because EOF in this case can be
signalled by... well... an actual EOF, of course!


stdin (and stdout) are part of a stream protocol and as such are not 
about files and do not signal End-Of-File which is part of why emails 
use the single period to signal the end of the message.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Not following the action here.

[John W. Krahn]

Harry Putnam wrote:

John W. Krahnjwkr...@shaw.ca  writes:

First, thanks for the input.

[...]


my $exe = 33261;


Or:

my $exe = 0100755;


Where does that come from?  And it appears some kind of conversion
must take place.  If you print $exe right after assigning it 0100755,
it still shows 33261.



0100755 is the octal representation of the digital number 33261.  I used 
octal because stat(2) describes the mode bits as octal numbers:


$ man 2 stat
[snip]
 The following flags are defined for the st_mode field:

 S_IFMT 017   bit mask for the file type bit fields
 S_IFSOCK   014   socket
 S_IFLNK012   symbolic link
 S_IFREG010   regular file
 S_IFBLK006   block device
 S_IFDIR004   directory
 S_IFCHR002   character device
 S_IFIFO001   FIFO
 S_ISUID0004000   set UID bit
 S_ISGID0002000   set-group-ID bit (see below)
 S_ISVTX0001000   sticky bit (see below)
 S_IRWXU00700 mask for file owner permissions
 S_IRUSR00400 owner has read permission
 S_IWUSR00200 owner has write permission
 S_IXUSR00100 owner has execute permission
 S_IRWXG00070 mask for group permissions
 S_IRGRP00040 group has read permission
 S_IWGRP00020 group has write permission
 S_IXGRP00010 group has execute permission
 S_IRWXO7 mask for permissions for others (not in group)
 S_IROTH4 others have read permission
 S_IWOTH2 others have write permission
 S_IXOTH1 others have execute permission


Where the first three octal digits (100) define the file type and the 
last three octal digits (755) define the read/write/execute permissions.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Quizzing students with Perl

[John W. Krahn]

Rick T wrote:


The code below (server addresses Xed out for security) has been used
on my website for years, but it does seem to misbehave on rare
occasions, so I have a few questions on how I might improve it. I
apologize in advance for my amateurish coding; I’m a high school
teacher who cannot afford hiring help, so I bought a bunch of O’Reilly
books and plunged in bravely. The heavy commenting is because I don’t
often work on the code and need the reminders of why I am doing things!

This code serves multiple choice questions to students, stores their
answer and other statistics, and emails me when the test is completed.
It almost always works well, but there are exceptions which puzzle me.

First: Sometimes a test will exit early, sending me the result
although the student did not make it through all the questions. Once
this happened to the same student twice. I don’t think students are
hacking my code because this has happened only to relatively
unsophisticated individuals.

Second: In one case, although I cannot verify this, the student
claimed that she had answered a lot of questions that got lost.
Perhaps I need to save multiple copies of their score results and
delete the old ones only after a successful completion? Perhaps I need
to save data in text files and only append them? General strategies
for structuring and securing data are way above my skill level, I’m
afraid. My host offers mySQL, but when I bought a book on it I
discovered that it had a steep and scary learning curve!

Third: On one occasion my sever emailed me a student’s result twice in
quick succession (one second apart according to Header values). One of
the Received headers contained “by mx13.futurequest.net” and the other
had “mx14” instead of “13”. This is not actually a problem for me like
the anomaly above, but I am curious about it.

And of course I welcome any and all suggestions, however small, on how
to improve my code and even the strategies I am struggling to use, and
I don’t mind you being blunt about it. You folks are a treasure of
useful feedback and I am grateful for whatever you offer!





[ SNIP ]


my %progress_hash;
my $progfile = /xxx//xxx/data/students/$student_id/p_$course_file;
die There is no file called $progfile: $!\n unless -e $progfile;
my $db = tie %progress_hash, 'DB_File', $progfile or die Can't tie 
progress_hash to $progfile: $!\n;
my $fd = $db-fd(); # get a file descriptor
open PROGFILE, +=$fd or die Can't safely open $progfile : $!\n;
flock ( PROGFILE, LOCK_EX ) or die Unable to acquire exclusive lock on 
$progfile: $!\n;
undef $db;


[ SNIP ]


my %course_hash;
my $coursefile = /xxx//xxx/data/courses/$course_file;
die There is no file called $coursefile: $!\n unless -e $coursefile;
my $db2 = tie %course_hash, 'DB_File', $coursefile, O_RDONLY or die Can't 
tie course_hash to $coursefile: $!\n;
my $fd2 = $db2-fd(); # get a file descriptor
open COURSEFILE, =$fd2 or die Can't safely open $coursefile for 
reading: $!\n;
flock ( COURSEFILE, LOCK_SH ) or die Can't acquire a shared lock on 
$coursefile: $!;
undef $db2;


[ SNIP ]


untie %progress_hash; close PROGFILE;
untie %course_hash; close COURSEFILE;


This could be your problem.  According to my copy of DB_File:

HINTS AND TIPS
   Locking: The Trouble with fd
   Until version 1.72 of this module, the recommended technique for
   locking DB_File databases was to flock the filehandle returned
   from the fd function. Unfortunately this technique has been
   shown to be fundamentally flawed (Kudos to David Harris for
   tracking this down). Use it at your own peril!

   The locking technique went like this.

   $db = tie(%db, 'DB_File', 'foo.db', O_CREAT|O_RDWR, 0644)
   || die dbcreat foo.db $!;
   $fd = $db-fd;
   open(DB_FH, +=$fd) || die dup $!;
   flock (DB_FH, LOCK_EX) || die flock: $!;
   ...
   $db{Tom} = Jerry ;
   ...
   flock(DB_FH, LOCK_UN);
   undef $db;
   untie %db;
   close(DB_FH);

   In simple terms, this is what happens:

   1.   Use tie to open the database.

   2.   Lock the database with fd  flock.

   3.   Read  Write to the database.

   4.   Unlock and close the database.

   Here is the crux of the problem. A side-effect of opening the
   DB_File database in step 2 is that an initial block from the
   database will get read from disk and cached in memory.

   To see why this is a problem, consider what can happen when two
   processes, say A and B, both want to update the same DB_File
   database using the locking steps outlined above. Assume process
   A has already opened the database and has a write lock, but it
   hasn't actually updated the database yet (it has finished step
   2, but not started step 3 yet). Now 

Re: Need help with a programming problem

[John W. Krahn]

Peter Holsberg wrote:

sigh  Let me start over.

The file I want to modify has a 6-digit filename and an extension htm.
For example, 131002.htm

I'm working in Windows, with Strawberry perl, with Randall L. Schwartz's


Randal L. Schwartz



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Need help with a programming problem

[John W. Krahn]

Shawn H Corey wrote:

On Wed, 02 Oct 2013 13:57:36 -0400
Peter Holsbergpjh42atpobox@gmail.com  wrote:


blushing  I was so upset that I deleted it all! It seems to me that
it should be fairly straightforward, but at 79, the old synapses
aren't firing quite as well as they used to.

Can you get me started?


Sure:

my @files = grep { /^\d{6}\.htm$/i } glob( '*.htm' );



my @files = glob '[0-9][0-9][0-9][0-9][0-9][0-9].[Hh][Tt][Mm]';



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Not following the action here.

[John W. Krahn]

Harry Putnam wrote:

Why is this script showing uninitialized variable warnings?

- -----=----- -
#!/usr/local/bin/perl

use strict;
use warnings;
use File::Find;

my $exe = 33261;


Or:

my $exe = 0100755;



my $eperm;


You don't really need this variable at file scope.



my $f = shift;

find( sub {
 return unless -f;


Your $exe value includes the file type so this test is redundant.



 $eperm = (stat($File::Find::name))[2];


That should be:

  $eperm = (stat)[2];

Or if you still want to include the -f test but don't want to stat the 
same file twice:


  $eperm = (stat _)[2];



 if ($eperm eq $exe){


You are comparing numerical values so that should be:

  if ($eperm == $exe){



   print $File::Find::name . \n;
 }
},
$f
);





John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Sleep

[John W. Krahn]

Shawn H Corey wrote:

On Sun, 15 Sep 2013 13:00:36 -0700
Unknown Userknowsuperunkn...@gmail.com  wrote:


If my perl script has a sleep for say 300 seconds, when the sleep is
being run is there any way i can find the time remaining in the sleep
say by sending a signal?

Thanks,


Not directly. You have to record the time before the sleep and then you
can measure how long the sleep lasted.

 my $started_sleep = time;
 sleep 300;
 my $time_asleep = time - $started_sleep;


Or just:

my $time_asleep = sleep 300;



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: negate, !!$a, $a!!, flip-flop

[John W. Krahn]

Hans Ginzel wrote:

Hello!


Hello,


Is there a shorter way to write $a = ! $a, please?

Something analogous to ++ and -- operators like $a !! or !! $a would negate
the variable $a and return its previous or new value respectively.


You can do that if you use a reference to a scalar like this:

$ perl -le'my $x = do { \vec my $y, 0, 1 }; for ( 1 .. 6 ) { print ++$$x }'
1
0
1
0
1
0
$ perl -le'my $x = do { \vec my $y, 0, 1 }; for ( 1 .. 6 ) { print --$$x }'
1
0
1
0
1
0
$ perl -le'my $x = do { \vec my $y, 0, 1 }; for ( 1 .. 6 ) { print $$x++ }'
0
1
0
1
0
1
$ perl -le'my $x = do { \vec my $y, 0, 1 }; for ( 1 .. 6 ) { print $$x-- }'
0
1
0
1
0
1

I used the do {} block so that $y doesn't leak out into the rest of the 
program, but you can omit it if you want.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: negate, !!$a, $a!!, flip-flop

[John W. Krahn]

Hans Ginzel wrote:

Hello!


Hello,


Is there a shorter way to write $a = ! $a, please?


No.


John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: negate, !!$a, $a!!, flip-flop

[John W. Krahn]

David Christensen wrote:

September 10, 2013 06:15 Hans Ginzel wrote:
  Is there a shorter way to write $a = ! $a, please?
  Something analogous to ++ and -- operators like $a !! or !! $a would
  negate the variable $a and return its previous or new value
  respectively.

I don't believe Perl has boolean pre-invert or post-invert unary
operators. You might be able to build something with objects and
operator overloading, but that would mean overloading existing
operators. Adding entirely new operators could require hacking the Perl
source code (?).


On 09/10/13 04:14, Dr.Ruud wrote:

$a^=1


The bitwise xor-equals binary operator is an interesting suggestion.
Yes, it inverts the boolean sense of variables containing canonical
boolean values (undef, empty string, numerical zero, and numerical one).
But, thinking in boolean and applying this operator to other kinds of
values may be confusing (see script and output, below).


Assuming canonical boolean values, post-invert semantics (save the new
value into another variable) can be can be obtained with assignment:

$new = ($var ^= 1)

It appears that xor-equals has higher precedence than assignment, so the
parentheses are not required:

$new = $var ^= 1


xor-equals IS assignment and has the same precedence as assignment:

perldoc perlop
[SNIP]
   Assignment Operators
   = is the ordinary assignment operator.

   Assignment operators work as in C.  That is,

   $a += 2;

   is equivalent to

   $a = $a + 2;

   although without duplicating any side effects that dereferencing
   the lvalue might trigger, such as from tie().  Other assignment
   operators work similarly.  The following are recognized:

   **=+=*====
  -=/=|==||=
  .=%=^=   //=
x=

   Although these are grouped by family, they all have the
   precedence of assignment.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Filtering Characters

[John W. Krahn]

Matt wrote:

I have this:

while (IN) {
 chomp;
 next if /^#/;
 # do stuff
 }


It skips to the next item in the while loop of the string begins with
# and works fine.  I would also like to skip to the next item in the
loop if the string contains anything other then lowercase,
underscores, numbers, dashes, periods, and spaces.  I do not want
uppercase characters and any sort of other special characters.  How
would I do that?


next if /[^[:lower:]_\d\-. ]/;



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Print to several logs

[John W. Krahn]

Rob Dixon wrote:


On 27/08/2013 23:06, John W. Krahn wrote:


my %logs = (
'one.log' = undef,
'two.log' = undef,
);

for my $name ( keys %logs ) {
open my $FH, '', $name or die Cannot open '$name' because: $!;
$logs{ $name } = $FH;
}

for my $log_FH ( values %logs ) {
print $log_FH kdkdkdkd Output from:\n$rsync cmdflgs;
}


Nice John

It compacts neatly to

use strict;
use warnings;
use autodie;

my $rsync = 'rsync';
my $tmplog = 'one.log';
my $tmplog2 = 'two.log';

my %logs = map {
open my $FH, '', $_;


What if open fails?!


($_ = $FH);
} $tmplog, $tmplog2;


Or a bit more compact:

my %logs = map {
open my $FH, '', $_ or die Cannot open '$name' because: $!;
( $_ = $FH );
} my ( $tmplog, $tmplog2 ) = qw( one.log two.log );



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Print to several logs

[John W. Krahn]

Harry Putnam wrote:


I happen to be scripting something that needs to have two logs written
to and was sort of taken by how awkward this construction looked:

(Simplified for discussion, from a longer script)

   my $rsync = 'rsync';
   my $tmplog = 'one.log';
   my $tmplog2 = 'two.log';
   open(LOG,$tmplog)or die Can't open $tmplog : $!;
   open(LOG2,$tmplog2)or die Can't open $tmplog2: $!;
   print LOG  kdkdkdkd Output from:\n$rsync cmdflgs;
   print LOG2 kdkdkdkd Output from:\n$rsync cmdflgs
   close(LOG);
   close(LOG2);

Is there some smooth way to write to more than one log?


my %logs = (
'one.log' = undef,
'two.log' = undef,
);

for my $name ( keys %logs ) {
open my $FH, '', $name or die Cannot open '$name' because: $!;
$logs{ $name } = $FH;
}

for my $log_FH ( values %logs ) {
print $log_FH kdkdkdkd Output from:\n$rsync cmdflgs;
}




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: grab pattern from start and end block

[John W. Krahn]

Agnello George wrote:

hi


Hello,


i have raw data that is like this in a flat file .

start
name:agnello
dob:2 april
address:123 street
end
start
name:babit
dob:13 april
address:3 street
end
start
name:ganesh
dob:1 april
address:23 street
end


i need to get the data in the following format

name:agnello, dob:23 april ,address:123 street
name:babit,dob:13 april,address:3 street
name:ganesh,dob:1 april,address:23 street

i came up with this , is there a better way to do this :
===
#!/usr/bin/perl

use strict;
use warnings;

open my $FH , 'data.txt' or die cannot open file $!;
read $FH, my $string, -s $FH;
close($FH);


my @string = split ( /start/ , $string ) ;

my %data;

foreach  ( @string ) {
chomp;
next if /^$/ ;
s/^ $//g;
s/end//;

my @data = split(/\n/, $_);
   foreach my $i (@data) {
print $i,;

  }
print \n;
}



$ echo start
name:agnello
dob:2 april
address:123 street
end
start
name:babit
dob:13 april
address:3 street
end
start
name:ganesh
dob:1 april
address:23 street
end | perl -e'
use warnings;
use strict;

my @data = [];
while (  ) {
chomp;
push @{ $data[ -1 ] }, $_ if /:/;
push @data, [] if /^end/;
}

for my $record ( @data ) {
print join( ,, @$record ), \n;
}
'
name:agnello,dob:2 april,address:123 street
name:babit,dob:13 april,address:3 street
name:ganesh,dob:1 april,address:23 street




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: grab pattern from start and end block

[John W. Krahn]

Dr.Ruud wrote:

On 12/07/2013 13:44, Agnello George wrote:

hi

i have raw data that is like this in a flat file .

start
name:agnello
dob:2 april
address:123 street
end
start
name:babit
dob:13 april
address:3 street
end
start
name:ganesh
dob:1 april
address:23 street
end


i need to get the data in the following format

name:agnello, dob:23 april ,address:123 street
name:babit,dob:13 april,address:3 street
name:ganesh,dob:1 april,address:23 street


perl -0 -wple 's/^start\n(.*?)\nend\n/$_=$1;y{\n}{ };$_\n/emgs'


That should probably be:

perl -0777ple's/^start\n(.*?)\nend/($x=$1)=~y{\n}{,};$x/emgs'





John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Perl file and STDERR

[John W. Krahn]

jitendra B wrote:

Hi All,


Hello,


Can you please let me know the following snippset? why it is used for?


select( STDERR );


Select STDERR as the default filehandle.



$| = 1;


Turn on autoflush for the current default filehandle.
(Redundant because STDERR autoflushes by default.)



select( STDOUT );


Select STDOUT as the default filehandle.



$| = 1;


Turn on autoflush for the current default filehandle.



print STDERR \nThis is india\n\n;
  print STDERR Usage: This is build;
  print STDERR where: base PL label\n;


Print some stuff.



and second question

  second question:- I want to open a file read+write mode and change the
some content in same file without creating another file and copy to it.

MY SCRIPT(Not working as i wish to )

#!/usr/bin/perl


The next two lines should be:

use warnings;
use strict;



open(FILE,test.txt) or die Could not open the file: $!;


You are opening test.txt in write mode which means that the file will 
be truncated to zero length first, effectively erasing all the data.




@file=FILE;

foreach (@file)
{
   $_=~s/BLR/bangalore/g;

   print $_;
}
close(FILE);



#!/usr/bin/perl
use warnings;
use strict;

use Tie::File;

tie my @file, 'Tie::File', 'test.txt' or die Cannot open 'test.txt' 
because: $!;


s/BLR/bangalore/g for @file;

untie @file;




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: last

[John W. Krahn]

Dr.Ruud wrote:

On 24/06/2013 07:36, lee wrote:


It would be like:

if ( $color eq blue ) {
print test\n;
last;
}


Alternative:

print( test\n ), last
if $color eq blue;


I also see:

print( test\n ) and last
if $color eq blue;

but always question that, because: what if print() fails?
(even if it can't fail,


Yes it CAN fail!  For example:

select FH;

...

  print( test\n ) and last
if $color eq blue;

And somewhere between the select and the print the device that FH points 
to becomes unavailable or full.




it is hard to read such ambiguous code, every
time again)



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: last

[John W. Krahn]

Brandon McCaig wrote:

On Sun, Jun 23, 2013 at 12:02:38PM +0300, Shlomi Fish wrote:

last is not a function (a.k.a subroutine) - it cannot be.
It is a special statement which is handled in a special way by
the Perl interpreter. redo and next are not functions
either for a similar reason.


I think we can all agree that last is not a function/subroutine,
but at the same time it does behave like one in several ways. :)


No, it doesn't.



For example, you can follow it with parenthesis if you want
(albeit, there's no good reason to do that).

#!/usr/bin/perl

use strict;
use warnings;

while(1) {
 last();
}


The parentheses in this case do nothing, and they certainly don't imply 
that last is a function.


$ perl -le'
use warnings;
use strict;
for (1..2) {
();
}
'
$



__END__

Similarly, you can even wrap it up in a subroutine and it still
works as intended (so obviously it understands just how to find
the right enclosing block even through subroutine calls).

#!/usr/bin/perl

use strict;
use warnings;

while(1) {
 my_last;
}

sub my_last {
 last;
}


That won't work:

$ perl -le'
use warnings;
use strict;
while () {
my_last;
}
sub my_last {
last;
}
'
Bareword my_last not allowed while strict subs in use at -e line 5.
Execution of -e aborted due to compilation errors.


And even if you fix that bareword you still get a warning:

$ perl -le'
use warnings;
use strict;
while () {
my_last();
}
sub my_last {
last;
}
'
Exiting subroutine via last at -e line 8.



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Tips or Tricks to print out tab-separated data?

[John W. Krahn]

Brandon McCaig wrote:

On Fri, Jun 21, 2013 at 02:15:39PM +0100, Gary Stainburn wrote:

What your code did was to tag the \n onto the end of the
array then pass the whole thing to join.


Gary is basically correct, but he worded it wrongly. When Perl
calls subroutines it basically flattens arguments into a list.

Earlier, Mark Perry wrote:

my @array = ( boris, natasha, rocky, bullwinkle);
print join \t, @array, \n;


In this case, you're calling two subroutines: print and join.


Actually, two list operators: print and join

perldoc perlop



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Tips or Tricks to print out tab-separated data?

[John W. Krahn]

Marc Perry wrote:

Hi,


Hello,


I routinely generate rows of tab-separated data like this;

my @array = ( boris, natasha, rocky, bullwinkle);
print join \t, @array, \n;

However this code inserts an extra tab between bullwinkle and the newline
character.

So when it is important I do this instead:
print join \t, @array;
print \n;

I suppose you could put both statements on a single line.  Is there a
simpler/faster way to generate this output:
boris\tnatasha\trocky\tbullwinkle\n?


print join( \t, @array ), \n;



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: sha-2 sum of files?

[John W. Krahn]

Jim Gibson wrote:


On Jun 13, 2013, at 10:51 AM, lee wrote:


+ Is print and printf pretty much the same thing implementation
  wise?  I'm wondering if printf might involve more overhead so it
  might be less efficient, depending on what you're doing.


They are pretty much the same. print will use its default formats for
converting numerical data to strings. printf will use the format
specifiers you provide. There can't be much difference in execution
speed, probably not even enough to measure.


print and printf both use filehandles the same:

$ perl -Mwarnings -Mstrict -e'
print  STDERR Hello print\n;
printf STDERR q/%s/, Hello printf\n;
'
Hello print
Hello printf


Perl allows interpolation in double quoted strings so you shouldn't use 
it in printf's format string:


$ perl -Mwarnings -Mstrict -e'
my ( $x, $y, $z ) = ( 10%, 15%, 26% );
print  Hello $x, $y, $z\n;
printf Hello $x, $y, $z\n;
'
Hello 10%, 15%, 26%
Invalid conversion in printf: %, at -e line 4.
Invalid conversion in printf: %, at -e line 4.
Invalid conversion in printf: %\012 at -e line 4.
Hello 10%, 15%, 26%


print is affected by the variables $, and $\ but printf isn't:

$ perl -Mwarnings -Mstrict -e'
my ( $x, $y, $z ) = ( 10%, 15%, 26% );
( $,, $\ ) = ( *MIDDLE*, *THE END* );
print  Hello, $x, $y, $z, \n;
printf Hello %s, %s, %s\n, $x, $y, $z;
'
Hello*MIDDLE*10%*MIDDLE*15%*MIDDLE*26%*MIDDLE*
*THE END*Hello 10%, 15%, 26%




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Return values more than 256?

[John W. Krahn]

Brandon McCaig wrote:

On Thu, Mar 07, 2013 at 10:21:40AM +0100, WFB wrote:

Hi, List,


Hello,


To test our software I use perl to start it several times. My
perl script gather some information and start then the program
with different parameters.

It works very well, but I have a problem with the return values
of our program. This return codes are all in an area from 55000
to 6. I use open to invoke our program and print the
output. Finally I use the $? variable and print the error code
in case of an error.

sub start_test_runner {
my ($tr = shift, $tr_params) = @_;


I don't see a need for shift here. You can just assign the
arguments array to your list of parameters.

   my ($tr, $tr_params) = @_;


  my $pid = open(my $trexe, $tr \$tr_params\ |) or die Could not start
TestRunner. $!\n;


Instead of escaping the double-quotes consider using the qq//
operator instead. You should also prefer the 3-argument open.

   my $pid = open(my $trexe, '-|', qq($tr $tr_params) or
   die Could not start TestRunner. $!;


Or, instead of the three argument open, use the list option and you 
won't need quotes:


my $pid = open my $trexe, '-|', $tr, $tr_params
or die Could not start TestRunner. $!;

Also, be sure to close the pipe correctly:

close $trexe or warn $! ? Error closing $tr pipe: $!
: Exit status $? from $tr;




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: nested subroutines

[John W. Krahn]

Chris Stinemetz wrote:

Thanks in advance.

I have a subroutine inside another subroutine in a module I am tyring to
put together.

I would like to pass the value assigned to $srt in the while loop as the
parameter for the session_attempts subroutine called withing the
processPegs subroutine.

The error I am getting is:

Use of uninitialized value $_srt in numeric ne (!=) at ...


The code provided does not use the ne operator nor does it use the 
variable $_srt




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: obfuscating code

[John W. Krahn]

Kevin Walzer wrote:


I'm an experienced developer in several other languages (Python, Tcl,
AppleScript, JavaScript, C/Objective C), so I'm quite familiar with
structuring a program--but as I work on learning Perl, I find it
somewhat obscure, if not downright obfuscated. None of the other
languages I've worked with have the equivalent of the $_ implicit var,
for instance. Looking at some sample code online, I had to spend a
considerable amount of time looking up the various bits with sigils and
annotating them, cf:

open (INPUT,  $_); ##input from default $_ var


It is very bad to use a system function like open() without determining 
if it succeeded or failed.  Also, most modern Perl programmers use the 
three argument version of open() and lexical filehandles.


open my $INPUT, '', $_ or die Cannot open '$_' because: $!;

Also, the File::Find::find() function callback function, which this code 
is part of, only allows you to access the current file name through the 
$_ variable, while in other contexts a lexical variable can be used 
instead of $_.




foreach (INPUT) {


A foreach loop operates on a list so perl has to read the entire file 
into a list in memory.  This is usually written with a while loop which 
only reads one line at a time.


while (INPUT) {



if(/$searchstring/i) { ##case-insenstive regex for $searchstring


Case-insenstive regex for the contents of $searchstring.  A match 
operator does interpolation basically the same as a double quoted 
string.  A better way would be to create $searchstring using the qr// 
operator with the /i option.




$_ = substr($_, 0, 60); ##trim string to 60 chars


That is an inefficient way to truncate a string.  A better way would be:

substr( $_, 60 ) = ''; ##trim string to 60 chars

Or perhaps better:

substr( $_, 60, length(), '' ); ##trim string to 60 chars

As this modifies the string in-place.



s/^\s*//; #trim leading space


That modifies every string, whether it contains leading whitespace or 
not.  It should be written to only modify strings that actually contain 
whitespace:


s/^\s+//; #trim leading space



print $File::Find::name\:$.\:\t$_\n; #print filename followed by line
number followed by tab followed by matching line


The $. (current line number) variable only contains useful information 
from inside a while loop but does nothing useful from inside a foreach loop.




}
}
close INPUT;

Perhaps this is idiomatic to you,


No, it is not.  It looks like someone who doesn't understand Perl wrote 
this.  You should be careful what you download off the internet.  ;)




but it's very dense to me. And I have
a decade of development experience.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Fwd: Question regarding while loops for reading files

[John W. Krahn]

Tiago Hori wrote:

Hey Guys,


Hello,



I am still at the same place. I am writing these little pieces of code to
try to learn the language better, so any advice would be useful. I am again
parsing through tab delimited files and now trying to find fish from on id
(in these case families AS5 and AS9), retrieve the weights and average
them. When I started I did it for one family and it worked (instead of the
@families I had a scalar $family set to AS5). But really it is more useful
to look at more than one family at time (I should mention that are 2 types
of fish per family one ends in PS , the other doesn't). So I tried to use a
foreach loop to go through the file twice, once with a the search value set
to AS5 and a second time to AS9. It works for AS5, but for some reason, the
foreach loop sets $test to AS9 the second time, but it doesn't go through
the while loop. What am I doing wrong?

here is the code:

#! /usr/bin/perl
use strict;
use warnings;

my $file = $ARGV[0];
my @family = ('AS5','AS9');
my $i;
my $ii;
my $test;

open (my $fh, , $file) or die (Can't open $file: $!);

foreach (@family){
 $test = $_;
 my @data_weight_2N = ();
 my @data_weight_3N = ();
 while ($fh){
 chomp;
 my $line = $_;
 my @data  = split (\t, $line);
 if ($data[0] !~ /[0-9]*/){


That won't work because there are zero [0-9] characters in EVERY string:

$ perl -le'
my @x = qw/ 0ne 234 five67 ___ /;
for my $x ( @x ) {
next if $x !~ /[0-9]*/;
print $x;
}
'
0ne
234
five67
___


You need to test for at least one character:

 if ($data[0] !~ /[0-9]/){





John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: matching certain lines

[John W. Krahn]

Chris Stinemetz wrote:


I would like to only work with the data that has a line with |68| in it
print that line and then print each subsequent lines in that match
/\|7\|\d+\|\d+/ until #END is reached and then repeat for the rest of the
input data.

Below is what I have attempted.

Thanks in advance.

Chris


#!/usr/bin/perl

use warnings;
use strict;

my ( $col1, $col2, $col3 );

while( my $line =DATA  ) {
chomp($line);
if ( $line =~ /(.*\|68\|.*)/ ) {
my $OM = $1;
print $OM, \n;
}
  if ( $line =~ /(\|\d)\|(\d+)\|(\d+)/ ) {
$col1 = $1;
$col2 = $2;
$col3 = $3;
print join(\t, $col1, $col2, $col3 ), \n;
}
}


Let's re-factor that down to its essence:

while ( DATA ) {
print if /\|68\|/;
print $1\t$2\t$3\n if /(\|\d)\|(\d+)\|(\d+)/;
}

Now we need to add something that starts at |68| and stops at #END:

while ( DATA ) {
if ( /\|68\|/ .. /^#END/ ) {
print if /\|68\|/;
print $1\t$2\t$3\n if /(\|\d)\|(\d+)\|(\d+)/;
}
}



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: converting dates to epoch seconds and back

[John W. Krahn]

Bill Stephenson wrote:

When converting DMYHMS to Epoch Seconds and back I get cheated out of a day. 
Why?

Bill

--

#!/usr/bin/perl

use strict;
use warnings;
use Time::Local;

my ($time, $month, $day, $year, $seconds, $minutes, $hours, $wday, $yday, 
$isdst);

my $start_date = '11/30/2012';

print $start_date \n;

($month, $day, $year) = split(/\//, $start_date);

print $time = timegm($seconds, $minutes, $hours, $day, $month-1, $year-1900);

^^
**



print \n;

($seconds, $minutes, $hours, $day, $month, $year, $wday, $yday, $isdst) = 
localtime($time);


 ^

 *




$month++;

$year = ($year+1900);

print $month/$day/$year \n;

# output:
# 11/30/2012
# 1354233600
# 11/29/2012


You are using GMT for one conversion and local time for the other.  Best 
to use GMT for both conversions:


$ perl -le'
use strict;
use warnings;
use Time::Local;

my ( $time, $month, $day, $year, $seconds, $minutes, $hours );
my $start_date = q[11/30/2012];
print $start_date;
( $month, $day, $year ) = split /\//, $start_date;
print $time = timegm( $seconds, $minutes, $hours, $day, $month - 1, 
$year - 1900 );

( $seconds, $minutes, $hours, $day, $month, $year ) = gmtime $time;
$month++;
$year += 1900;
print $month/$day/$year;
'
11/30/2012
1354233600
11/30/2012




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: File:: Find help

[John W. Krahn]

punit jain wrote:

Hi,


Hello,



I have a requirement where I have directory structure like : -

test --  test/user1/files/, test/user2/files/, test/user3/files/ etc.
under sub-directories with usernames I have file with name usersettings.

So the final structure as : -

test / user1 / usersettings
   /files/
  user2 / usersettings
/files/
  user3 / usersettings
   /files/
  user4 / usersettings

etc

I need to get all the subdirectories of test and then read the file
usersettings under that later on to do some processing.


That is easy enough to do:

for my $file ( test/*/usersettings ) {
open my $FH, '', $file or die Cannot open '$file' because: $!;
# process $file contents here
}



I wrote code below
:-
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename qw(basename dirname);
use File::Find qw(find);
use File::Find::Rule;
my $indir = shift;
my $Users = {};


Why not just use a hash instead of a reference to a hash?



my @userdirs=File::Find::Rule-maxdepth(1)-directory-in($indir);

# this will give me user directories which I want only to depth 1.

 foreach my $dir(@userdirs){
 next if($dir eq $indir);


perldoc -q quoting

  next if $dir eq $indir;



# I need to skip parent directory

 my $user = basename($dir);
 print $user.\n;


perldoc -q quoting

  print $user\n;
OR:
  print $user . \n;
OR:
  print $user, \n;



 find( sub {
 print $File::Find::name;
 if ($File::Find::name =~ /Contacts/  -s $File::Find::name  0
) {
 print $File::Find::name;

   # do some processing
   }
  }, $dir);

 }

However I get :-

Use of uninitialized value in print at new.pl line 21.
Use of uninitialized value in pattern match (m//) at new.pl line 22.


Which lines above are 21 and 22?



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Substituting letters for numbers

[John W. Krahn]

Hamann, T.D. wrote:

Hello,


Hello,



Given a string:

i994

where I want to replace the 'i' by a '1' the following regex
succesfully replaces the letter by a number:

s/(i)(\d\d\d)/1$2/;


tr/i/1/;



However, given a string:

i99o

where I want to replace the 'i' by a '1' and the 'o' by a '0' (zero),
the following regex fails:

s/(i)(\d\d)(o)/1$20/;


tr/io/10/;



for the obvious reason that perl looks for a pattern match at bracket
set #20, which doesn't exist.

I can fix this by inserting a space in front of the zero, like this:

s/(i)(\d\d)(o)/1$2 0/;

and then using a second regular expression to remove the space, but
that somehow seems silly. Surely there is a quicker way to do this?


s/(i)(\d\d)(o)/1${2}0/;



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Array vs List output

[John W. Krahn]

Neeraj wrote:

Hi,

I am new to Perl and perplexed with output of printing entire Array vs
printing each element

 +4  ## check Array vis-a-vis List
 +5
 +6  @arr = qwhello happy new year 2013;
 +7  print my array is : @arr \n;
 +8
 +9  ## lets print in a loop
+10  my $i = 0;
+11  while ($i= $#arr)
+12  {
+13   print $arr[$i];
+14   $i += 1;
+15  };
+16  print \n;


In Perl that is usually written as:

## lets print in a loop
for my $i ( 0 .. $#arr )
{
 print $arr[$i];
}

Or as:

## lets print in a loop
for my $i ( @arr )
{
 print $i;
}

Or simply:

## lets print an array
print @arr;




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Array vs List output

[John W. Krahn]

*Shaji Kalidasan* wrote:

Neeraj,

If you print an array inside double quotes, each item of the array is
separated by the value specified in Perl special variable $ which is
the Output list separator. (interpolated lists)


It is just the _List Separator_ , it has nothing to do with output.



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: grouping in regex

[John W. Krahn]

Danny Gratzer wrote:

Shouldn't that *.** be *.*? *to avoid having it consume everything?



It is not clear exactly which *.** you are referring to however a 
non-greedy match does not necessarily consume less than a greedy match.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: data extract - Help !

[John W. Krahn]

jet speed wrote:


I have a file with similar data, around 10,000 entries with similar format.

i need to extract the output in below format. I can match the WWN and push
into an arrray, however i am not sure how to reference the WWN   to its
corresponding device displayDevNum as in the below format.
Any help would be much appreciated.

I am using test data here due to system restrictions.


required output

10:79 10.00.00.00.00.C0.43.33.AB
10:79 10.00.00.00.00.C0.43.33.A2
10:99 10.00.00.00.00.C0.22.33.56
10:99 10.00.00.00.00.C0.34.33.A0
10:99 10.00.00.00.00.C0.22:49:33
10.55 10.00.00.00.00.C9.43.42.B6
10.55 10.00.00.00.00.C0.43.23.C9

DATA - file.txt

devNum=4,177
displayDevNum=10:79
LUN=121
WWN=10.00.00.00.00.C0.43.33.AB
nickname=a5
WWN=10.00.00.00.00.C0.43.33.A2
nickname=wacke22
devNum=4,177
displayDevNum=10:99
LUN=121
WWN=10.00.00.00.00.C0.22.33.56
nickname=a2
WWN=10.00.00.00.00.C0.34.33.A0
nickname=ajx
WWN=10.00.00.00.00.C0.22:49:33
nickname=yah1
devNum=4,177
displayDevNum=10:55
LUN=121
WWN=10.00.00.00.00.C9.43.42.B6
nickname=a52
WWN=10.00.00.00.00.C0.43.23.C9
nickname=wack1



$ echo 'devNum=4,177
displayDevNum=10:79
LUN=121
WWN=10.00.00.00.00.C0.43.33.AB
nickname=a5
WWN=10.00.00.00.00.C0.43.33.A2
nickname=wacke22
devNum=4,177
displayDevNum=10:99
LUN=121
WWN=10.00.00.00.00.C0.22.33.56
nickname=a2
WWN=10.00.00.00.00.C0.34.33.A0
nickname=ajx
WWN=10.00.00.00.00.C0.22:49:33
nickname=yah1
devNum=4,177
displayDevNum=10:55
LUN=121
WWN=10.00.00.00.00.C9.43.42.B6
nickname=a52
WWN=10.00.00.00.00.C0.43.23.C9
nickname=wack1'  |  perl -e'

my $displayDevNum;
while (  ) {
$displayDevNum = $1 if /^displayDevNum=(\d\d:\d\d)/;
print $displayDevNum $1\n if /^WWN=([0-9a-f.:;]+)/i;
}
'
10:79 10.00.00.00.00.C0.43.33.AB
10:79 10.00.00.00.00.C0.43.33.A2
10:99 10.00.00.00.00.C0.22.33.56
10:99 10.00.00.00.00.C0.34.33.A0
10:99 10.00.00.00.00.C0.22:49:33
10:55 10.00.00.00.00.C9.43.42.B6
10:55 10.00.00.00.00.C0.43.23.C9





John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Is comp.lang.perl dead?

[John W. Krahn]

Danny Gratzer wrote:

I'm looking at comp.lang.perl and it doesn't seem like it's had new posts
in well, years. Is it dead?


It died in 1995.



If so are there any other good perl groups you'd recommend?


comp.lang.perl.misc



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: My script is OUT OF CONTROL!

[John W. Krahn]

jmrhide-p...@yahoo.com wrote:

Hi, and thanks for volunteering to help!


I installed the following script last year and it seemed to be working fine.
Yesterday, however, my hosting service took down my site because the script was
tying up so much of their server resources that it was a threat to their
business. One of the folks I talked to there said he thought it was starting
multiple copies of itself that were never terminated. The logs didn't show the
script being accessed more than a few times a day on average.

I would appreciate help debugging this thing:


[ snip ]



# LOAD DATA
open FH, /home1/theinfp0/public_html/psychdef/tutorial.fil or die $!;
while  (FH) {
 if ($topic eq REVIEW) { $termnum[$ops++] = $_; }
 elsif (/$topic/) { $termnum[$ops++] = $_; }
 }
close FH;

$defnum = $ops; # NUMBER OF TERMS IN DATA SET

# PARSE $_ TO GET $term(32) $cat(16) $def(64) $story(128) via @data:
$ops = 0;
foreach (@termnum) {
 @data = /(.{16})/g;
 $cat[$ops] = $data[0];
 $term[$ops] = $data[1].$data[2];
 $def[$ops] = $data[3].$data[4].$data[5].$data[6];
 $story[$ops] =
$data[7].$data[8].$data[9].$data[10].$data[11].$data[12].$data[13].$data[14];

 # RIGHT TRIM STRINGS
 $cat[$ops] =~ s/\s+$//;
 $term[$ops] =~ s/\s+$//;
 $def[$ops] =~ s/\s+$//;
 $story[$ops++] =~ s/\s+$//;
  }


A Perl programmer might write that like:

# LOAD DATA
open FH, /home1/theinfp0/public_html/psychdef/tutorial.fil or die $!;
while  (FH) {
if ($topic eq REVIEW) { push @termnum, $_; }
elsif (/$topic/) { push @termnum, $_; }
}
close FH;

$defnum = @termnum; # NUMBER OF TERMS IN DATA SET

# PARSE $_ TO GET $term(32) $cat(16) $def(64) $story(128) via @data:

foreach (@termnum) {
my @data = unpack 'A16 A32 A64 A128', $_;
push @cat,   $data[ 0 ];
push @term,  $data[ 1 ];
push @def,   $data[ 2 ];
push @story, $data[ 3 ];
}



# EVALUATE RESPONSE AND PROVIDE FEEDBACK, ADJUSTING SCORES

if ($answer and ($answer ne $goodans)) { $answer = 0; }

if ($answer) {
 $smarts++;
 $score = ++$score + $playlevel;


Using auto-increment or auto-decrement on a variable that appears more 
than ONCE in an expression will result in UNDEFINED behavior.


What did you expect the value of $score to be after this expression?




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: regx substitution question

[John W. Krahn]

Shlomi Fish wrote:


On Wed, 5 Sep 2012 14:33:13 +0100
jet speedspeedj...@googlemail.com  wrote:


i have an regx question. i have the array contents, now i want to
remove the first 2 characters (fc) of each element in the array and
store it in a second array ex: @array2

@array =fc20/1, fc30/22, fc40/3, fc20/1;

output

@array2 =20/1, 30/22, 40/3, 20/1;


You are using invalid syntax for arrays again. This is getting annoying.

In any case, either of those should do the trick:

my @new = (map { substr($_, 2) } @old);


Or:

my @new = map substr( $_, 2 ), @old;



Or:

my @new = (map { s/\A..//r } @old); # If your perl is recent enough.


Or:

my @new = map s/\A..//r, @old;



If your Perl is too old you can do:

my @new = (map { my $x = $_; $x =~ s/\A..//; $x; } @old);


Or:

s/\A..// for my @new = @old;



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: regx substitution question

[John W. Krahn]

Shlomi Fish wrote:

Replying to myself, I have a correction which Shawn inspired.

On Wed, 5 Sep 2012 16:49:42 +0300
Shlomi Fishshlo...@shlomifish.org  wrote:


On Wed, 5 Sep 2012 14:33:13 +0100
jet speedspeedj...@googlemail.com  wrote:


i have an regx question. i have the array contents, now i want to
remove the first 2 characters (fc) of each element in the array and
store it in a second array ex: @array2

@array =fc20/1, fc30/22, fc40/3, fc20/1;

output

@array2 =20/1, 30/22, 40/3, 20/1;



You are using invalid syntax for arrays again. This is getting
annoying.

In any case, either of those should do the trick:

my @new = (map { substr($_, 2) } @old);

Or:

my @new = (map { s/\A..//r } @old); # If your perl is recent
enough.


You should add the /m and /s flags to the regular expression here.



If your Perl is too old you can do:

my @new = (map { my $x = $_; $x =~ s/\A..//; $x; } @old);


And here.


There is no good reason why you should do that.



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: regx substitution question

[John W. Krahn]

Shlomi Fish wrote:


thanks for your answer. See below for my response.

On Wed, 5 Sep 2012 09:54:11 -0400
Shawn H Coreyshawnhco...@gmail.com  wrote:


On Wed, 5 Sep 2012 14:33:13 +0100
jet speedspeedj...@googlemail.com  wrote:


i have an regx question. i have the array contents, now i want to
remove the first 2 characters (fc) of each element in the array and
store it in a second array ex: @array2

@array =fc20/1, fc30/22, fc40/3, fc20/1;

output

@array2 =20/1, 30/22, 40/3, 20/1;

please advice.


It would be helpful if you posted actual Perl code.

Try:

 # remove the first 2 characters from every element of the array
 my @array2 = map { s/^..//msx } @array1;


This code is wrong in two respects:

1. the map clause will return the return value of the s/// subtitution and will 
modify
the original array in place:


Correct.


2. A minor problem of semantics is that under /m ^ matches any start of line,


Only if the /g option is also used AND the strings have embedded newlines.


so \A is preferable.


Without the /g option ^ and \A do exactly the same thing.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: how to handle two input files

[John W. Krahn]

timothy adigun wrote:

Hi,


Hello,


On 8/29/12, timothy adigun2teezp...@gmail.com  wrote:


for(my $i=0; $i= length(@startSite)-1; $i++) {


   The above could be:
 for(my $i=0; $i= scalar (@startSite); $i++) {
   ...


for(my $i=0; $i= scalar (@startSite); $i++) {  ## Oops

for(my $i=0; $i= scalar (@startSite)-1; $i++) {  ## working


First, length(@startSite) is WRONG so s/could/should/ and second, that 
is usually written as:


for my $i ( 0.. $#startSite ) {




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: how to handle two input files

[John W. Krahn]

timothy adigun wrote:


On 8/29/12, John W. Krahnjwkr...@shaw.ca  wrote:

timothy adigun wrote:


On 8/29/12, timothy adigun2teezp...@gmail.com   wrote:


for(my $i=0; $i= length(@startSite)-1; $i++) {


The above could be:
  for(my $i=0; $i= scalar (@startSite); $i++) {
...


for(my $i=0; $i= scalar (@startSite); $i++) {  ## Oops

for(my $i=0; $i= scalar (@startSite)-1; $i++) {  ## working


First, length(@startSite) is WRONG so s/could/should/ and second, that
is usually written as:



Agreed that  length(@startSite) is WRONG and I didn't say otherwise,


You also didn't explain to the beginners on this list as to why it is 
wrong.  (Because an array in scalar context evaluates to the number of 
elements in the array, and the length of a number has nothing to do with 
the contents of an array or the index of an array element.)




but not scalar (@startSite).


That COULD be wrong, depending on the value of $[.  It is more correct 
to use $#startSite which is there for the express purpose of defining 
the last index of the array @startSite.




If the OP decides to use C style of for loop, this is CORRECT:

for( my $i=1; $i= scalar (@startSite); $i++ ){ ...


Arrays usually start at 0, not 1 (see $[ in perldoc perlvar) and the use 
of scalar() in scalar context is redundant.




for my $i ( 0.. $#startSite ) {


The foreach keyword is actually a synonym for the for keyword, so one
can use either.
Please check this: http://perldoc.perl.org/perlsyn.html


You should have the documentation installed on your computer along with 
perl.  See:


perldoc perlsyn



Note: foreach my $i (@startSite){...} will also do the same,


No, there $i will be aliased to each element of @startSite in turn while 
in the previous examples $i contains the index of each element in turn.



except
that in the context of the OP script, the array index is needed.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: close file if it's open

[John W. Krahn]

lina wrote:

Thanks Jim and John.

btw, what does the fileno mean? mean file-not-open?


It means file number.  For example, STDIN is file number 0, STDOUT is 
file number 1, STDERR is file number 2 and the next file opened is file 
number 3, etc.



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: close file if it's open

[John W. Krahn]

lina wrote:

Hi,


Hello,


I don't know which is the best way to check whether this file is open
or not,

Here it what I came out so far,


#!/usr/bin/env perl

use strict;
use warnings;
use autodie qw(open close);
use 5.012;

my $fn = new_30.pdb;

open my $fh, '', $fn;

my $ofh;

while(my $line =$fh){
if($line =~ /MODEL \s+(3|5|80|89|459)$/){
my $model = $1;
open $ofh, '', extracted_$model.pdb;
print $ofh $_;
}
if($line =~ /ENDMDL/){
close($ofh) if ; ### here I wish to check whether it's 
okay,


close $ofh if fileno $ofh;



if it's open, then close, if it's closed, then do nothing.
}


}





John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: a condition

[John W. Krahn]

Wang, Li wrote:

Dear All



Hello,


Thanks very much for your help!
I tried the script with my real data and found out that the situation gets more 
complicate.
The following is part of my data:
scaffold_1_13528T/T C/T T/T C/T T/T C/T T/T 
T/T N/N T/T C/T T/T C/C C/T C/T T/T T/T 
T/T T/T T/T T/T C/T C/T C/T C/T T/T T/T 
T/T N/N T/T (keep)
scaffold_1_13531G/G G/G G/G G/G G/G G/C G/G 
G/G N/N G/G G/C G/G G/G G/G G/G G/G G/G 
G/G G/G G/G G/G G/G G/G G/G G/G G/G G/G 
G/G N/N G/G  (keep)
scaffold_1_13546A/A A/A A/A A/A A/A C/A A/A 
A/A N/N A/A C/A N/N A/A A/A N/N N/N A/A 
N/N A/A N/N A/A A/A A/A C/A C/A A/A A/A 
N/N N/N A/A  (keep)
scaffold_1_2N/N C/C N/N C/C N/N N/N C/C 
C/C N/N N/N C/C C/C N/N C/C C/C C/C N/N 
N/N C/C N/N C/C N/N C/C N/N C/C C/C C/C 
N/N N/N C/C (delete)
scaffold_1_113139   C/C C/C N/N C/C N/N C/C C/C 
C/G N/N C/C N/N C/C N/N C/C C/C N/N N/N 
C/C N/N C/G C/G N/N C/C C/C N/N C/C C/C 
N/N C/C C/C  (keep)
scaffold_1_113140   G/G G/G N/N G/G N/N G/G G/G 
G/G N/N G/G G/G G/G N/N G/G G/G N/N N/N 
G/G N/N G/G G/G N/N G/G G/G N/N G/G G/A 
N/N G/A G/G  (keep)
scaffold_1_113207   A/A A/A N/N A/A N/N A/A A/A 
A/A N/N A/A A/A A/A N/N A/A A/A N/N N/N 
A/A N/N A/A A/A N/N A/A A/A N/N A/A A/A 
N/N A/A A/A (delete)
scaffold_1_114021   C/C C/C N/N C/C N/N C/C C/C 
C/T C/C C/C C/C N/N N/N C/C C/C C/T N/N 
C/C N/N C/T C/C N/N C/C C/C C/C C/C C/C 
N/N C/C C/C  (keep)
scaffold_1_114213   A/C C/C A/A C/C N/N A/C A/A 
A/A A/A A/C A/C A/C N/N A/A A/A A/A N/N 
A/A A/A A/A A/A N/N A/A C/C A/A A/A A/A 
N/N A/A A/A  (keep)

If in each line, without count of N/N, all the other SNPs are the same, delete this 
line. The scaffold indicates the position of the SNP.

My code is as follows:
#! /usr/bin/perl
use strict;
use warnings;

my $usage=perl $0infile\n;

my $in=shift or die $usage;
open (IN,$in) or die Error: not found the $in\n;

my $outfile = SNPFilterSeg.txt;
open (OUT, $outfile);

my $i;


while (IN){
 next if /^#/;
 $_=~s/\n//;
$_=~s/\r//;
my @tmp=split(\t,$_);
my @arr;
for ($i=1; $i=30; $i++){
next if $tmp[$i] =~ m/N\/N/; #filter out all N/N
@arr = split(\t,$tmp[$i]); #assign the filtered data to a new array 
@arr
}
 if (@arr == grep $arr[0] eq $_, @arr) {
print OUT here\n;
   }
  else{
print OUT @tmp\n;
}
 }

close IN;
close OUT;



#!/usr/bin/perl
use strict;
use warnings;

my $usage = perl $0 infile\n;

my $in = shift or die $usage;
open IN, '', $in or die Cannot open '$in' because: $!;

my $outfile = SNPFilterSeg.txt;
open OUT, '', $outfile or die Cannot open '$outfile' because: $!;


while ( IN ) {
next if /^#/;
my ( undef, @tmp ) = grep $_ ne 'N/N', split;
print OUT $_ if @tmp != grep $tmp[ 0 ] eq $_, @tmp;
}

close IN;
close OUT;




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: a condition

[John W. Krahn]

Wang, Li wrote:

Dear All


Hello,


I have an array of a series of strinngs. I want to set up a
condition in which all the scalers in the array are not the same.

For example

AB AB AB AB AB (delete the array)
AB AC AB AB AB (Keep the array)
AB AC AD AB AB (keep)


$ perl -le'
for ( [ AB, AB, AB, AB, AB ], [ AB, AC, AB, AB, AB 
], [ AB, AC, AD, AB, AB ] ) {

my @array = @$_;
if ( @array == grep $array[ 0 ] eq $_, @array ) {
print delete @array;
}
else {
print keep @array;
}
}
'
delete AB AB AB AB AB
keep AB AC AB AB AB
keep AB AC AD AB AB




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: grep array of arrays

[John W. Krahn]

Chris Stinemetz wrote:

Hello List,


Hello,


I'm trying to grep an array of arrays, but I am getting the following error:

Can't use string (1) as an ARRAY ref while strict refs in use at
form.pl line 121,$COORDS  line 1281.
Press any key to continue . . .



Below is the grep statement:

print grep { $_-[0][0]= 0 } @coords;
Any idea what I am doing wrong?


If @coords is just an Array of Arrays then that should be:

print grep { $_-[0] = 0 } @coords;


Your example thinks @coords is an Array of Arrays of Arrays.


John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: matching array elements from hash ?

[John W. Krahn]

jet speed wrote:

Hi All,


Hello,


Is there a way to find  matching array elements from hash.

ex:

@names = ( abc. def. ghi, jky; );

%stud  = (
 abc = 34,
nba =99,
def =24,
ghi=  33);

How can i go throught each elements of has %stud and print the matching
array value in this case

abc =34
def=24


$ perl -e'
my @names = qw( abc def ghi jky );
my %stud  = (
abc = 34,
nba = 99,
def = 24,
ghi = 33,
);
print map exists $stud{ $_ } ? $_ = $stud{ $_ }\n : (), @names;
'
abc = 34
def = 24
ghi = 33




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Unable to change pos in regex match

[John W. Krahn]

Paul Anderson wrote:


[ snip ]


#!/usr/bin/myperl -w
# euler8.pl --- Euler Problem 8
# Author: Paul Andersonwackyvorlon@paul-andersons-macbook-pro-3.local
# Created: 14 Aug 2012
# Version: 0.01

use warnings;
use diagnostics;
use 5.16.0;

#use strict;
no strict;


# The number.

$numb=731671765313306249192251196744265747423553491949349698352031277
45063262395783180169848018694788518438586156078911294949545950173795833
19528532088055111254069874715852386305071569329096329522744304355766896
64895044524452316173185640309871112172238311362229893423380308135336276
6142828068664523874930358907296290491560440772390713810515859307960
86670172427121883998797908792274921901699720888093776657273330010533678
81220235421809751254540594752243525849077116705560136048395864467063244
15722155397536978179778461740649551492908625693219784686224828397224137
56570560574902614079729686524145351004748216637048440319989000889524345
06585412275886668811642717147992444292823086346567481391912316282458617
8664583591245665294765456828489128831426076900422421902267105562632
10937054421750694165896040807198403850962455444362981230987879927244284
90918884580156166097919133875499200524063689912560717606058861164671094
05077541002256983155200055935729725716362695618826704282524836008232575
30420752963450;

$result=0;


for ($numb=~/(\d)(\d)(\d)(\d)(\d)/gi) {
 $cur = $1*$2*$3*$4*$5;  # Put the product in a variable.
 pos $numb=(pos $numb) - 4;   # Reset position where 
matching will begin.
  # pos $num defaults to the 
position just
  # after the *last* character in 
our match.
  # We want our second match to 
begin after
  # the *first* character.
 if ( $cur  $result) {
 $result=$cur;

 }

}


That should be:

while ( $numb =~ /(?=(\d)(\d)(\d)(\d)(\d))/g ) {
$cur = $1 * $2 * $3 * $4 * $5;
$result = $cur if $result  $cur;
}



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: case statement in perl

[John W. Krahn]

Paul.G wrote:

Below is an extract from the perl script, the switch/case statement seemed like 
a simple solution.



# Mail Program #

operation_CHECKFREEPVS();
print $numPV \n;
# print $FreePV[1] $FreePV[0] $numPV\n;
if ($numPV ne 0 ) {
switch ($numPV) {
   case 1 { print $FreePV[0] \n; }
   case 2 { print $FreePV[0] $FreePV[1] \n; }
   case 3 { print $FreePV[0] $FreePV[1] $FreePV[2] \n; }
}
  }


Couldn't you just do that like this:

if ( @FreePV  @FreePV = 3 ) {
print join( ' ', @FreePV ), \n;
}



  else {
print No PV's available \n;
  }




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: case statement in perl

[John W. Krahn]

Paul.G wrote:

The example below is just a test, I need to be able to insert multiple values 
into a command, those values can be either 1, 2 or upto 5.

Below is closer to the working example, but I will read that document and to 
help make a final decision.

# Check Free PV's
operation_CHECKFREEPVS();

$NEWMIRROR = $MIRROR + $numPV;

if ($numPV ne 0  $MIRROR le 5) {


You are using string comparisons on numerical values which may not work 
out the way you intended:


$ perl -le'
for my $MIRROR ( 0, 1, 4, 5, 6, 10, 4000 ) {
print $MIRROR le 5 is , $MIRROR le 5 ? TRUE : FALSE;
}
'
0 le 5 is TRUE
1 le 5 is TRUE
4 le 5 is TRUE
5 le 5 is TRUE
6 le 5 is FALSE
10 le 5 is TRUE
4000 le 5 is TRUE



# lvextend
print $numPV $NEWMIRROR $MIRROR\n;
 switch ($numPV) {
 case 1 { run(/usr/sbin/lvextend -m $NEWMIRROR -s $sourcelv 
$FreePV[0]); }
 case 2 { run(/usr/sbin/lvextend -m $NEWMIRROR -s $sourcelv $FreePV[0] 
$FreePV[1]); }
 case 3 { run(/usr/sbin/lvextend -m $NEWMIRROR -s $sourcelv $FreePV[0] 
$FreePV[1] $FreePV[2]); }
 case 4 { run(/usr/sbin/lvextend -m $NEWMIRROR -s $sourcelv $FreePV[0] 
$FreePV[1] $FreePV[2] $FreePV[3]); }
 case 5 { run(/usr/sbin/lvextend -m $NEWMIRROR -s $sourcelv $FreePV[0] 
$FreePV[1] $FreePV[2] $FreePV[3] $FreePV[4]);
  }


You could do that like this:

if ( @FreePV  @FreePV = 5 ) {
run( /usr/sbin/lvextend -m $NEWMIRROR -s $sourcelv @FreePV );
}



}
# lvsync
run(/usr/sbin/lvsync -T $sourcelv);
logprint Successful $NEWMIRROR mirrors \t\t synced;
}
else {
cleanexit (10, FAIL \t\t No Free PV's Available);
}

return 0;
}




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: updating variable in Parent using Parallel::ForkManager

[John W. Krahn]

punit jain wrote:

Hi,


Hello,


I am facing an issue. Below is code snippet : -

my $pm = new Parallel::ForkManager(10);

  my $count=0;

foreach my $user (@users) {

$pm-start($user) and next;

my $result;

  --- do some processing ---

$pm-finish(0, \$result);

}



$pm-wait_all_children;


However the final value of count is not correct. Is there some race
condition on same variable updation by the processes ?

Regards,
Punit



pm -  run_on_finish (

sub {

my $result = @;

if (defined($result)) {

my $count += $result;


Here you are creating a variable named $count which is only visible 
inside the scope of this subroutine, so your other $count variable is 
not affected.




}

}




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: How to zip all files which are value from awk command ?

[John W. Krahn]

Jack Vo wrote:

Hi all,


Hello,


I need to compress many files in a directory on server. I use awk and
zip command to compress these files.

By awk command, I filter theses file :

*# ls -latr | grep iMAP.med0 | awk '{print $9}'*


You are doing way too much just to get the correct file names.  The 
shell's globbing function should suffice:


echo iMAP.med0*



iMAP.med0101_agent.trace.20120726153046.tar.gz
iMAP.med0101_agent.trace.20120726152942.tar.gz
iMAP.med0107_agent.trace.20120726154526.tar.gz
iMAP.med0101_agent.trace.20120726154741.tar.gz
iMAP.med0101_agent.trace.20120726154616.tar.gz
iMAP.med0101_agent.trace.20120726154436.tar.gz
iMAP.med0105_agent.trace.20120726154555.tar.gz
iMAP.med0101_agent.trace.20120726154532.tar.gz
iMAP.med0101_agent.trace.20120726154700.tar.gz
iMAP.med0101_agent.trace.20120726154720.tar.gz


How many files are in each tar archive?



I want to compress them to trace_file.zip, and I use the command, but
can not zip these files. Which parameters or syntax did I wrong ?

*# ls -latr | grep iMAP.med0 | awk '{ system(zip /tmp/trace_file $9)}'*
# ls -latr /tmp/ | grep trace_file


You could un-tar them first and then zip the reulting files:

tar -xzf iMAP.med0*
zip trace_file.zip *

Or perhaps something like this would work.

tar -xzf iMAP.med0* | zip trace_file.zip -



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: How to set as record separator in a Perl one liner?

[John W. Krahn]

Michael Brader wrote:

On 07/16/2012 04:05 PM, De-Jian Zhao wrote:


I want to change the record separator in a Perl one liner with  as
the separator. However, I tried without success.

The perlrun document
(http://perldoc.perl.org/perlrun.html#Command-Switches) says that*
***-0*[/octal/hexadecimal/] * specifies the input record separator
(|$/| ) as an octal or hexadecimal number. *
*When I tried to get the octal/hexadecimal code of  with oct()
and hex(), I got 0. I used this number and it did not work the
way I wanted (perl -00 -ne 'print if //' test.seq ).



 From 'perldoc -f oct'

...
oct Interprets EXPR as an octal string and returns the corresponding
value.
...
To go the other way (produce a
number in octal), use sprintf() or printf():

$perms = (stat(filename))[2]  0;
$oct_perms = sprintf %lo, $perms;

So it is used for converting a string into an octal value. But we can go
the other way with printf and ord:

perl -e 'printf %lo\n, ord(q{})'
76

Now perl will leave the input record separator on the string, but we can
take that off with chop:

echo '' | perl -0076 -nE 'chop,say if //'



Better to use chomp (the -l switch) instead of chop:

echo '' | perl -0076nlE 'say if //'



TIMTOWTDI of course, and you could also do it like this:

echo '' | perl -nE 'for (split //) { say if // }'



echo '' | perl -F -naE '//  say for @F'

:-)



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: printing anonymous array

[John W. Krahn]

timothy adigun wrote:

[snip]


my %new_hash = ();
foreach my $data1 ( keys %$hash1 ) {
 while ( my ( $key, $value ) = each %$hash2 ) {
 my ($new_value) = keys %$value;
 $new_hash{$key} = $new_value if $data1 == $key;
 }
}


No need for the nested llops:

my %new_hash;
for my $key ( keys %hash1 ) {
$new_hash{ $key } = each %{ $hash2{ $key } } if exists $hash2{ $key };
}


John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: how to transform xyz into matrix

[John W. Krahn]

lina wrote:

On Thu, Jun 28, 2012 at 4:44 PM, John W. Krahnjwkr...@shaw.ca  wrote:

lina wrote:


I have some data like:

0.35 3.41 1
0.35 4.24 1
0.35 4.35 2
0.36 0.36 1
0.36 1.32 1
0.36 1.45 1
0.36 1.46 1


wish the output look like

0.36 1.32 1.45 1.46  3.41 4.24 4.35
0.35  0  0   0 0   11  2
0.36  1  1   1 1   00  0


$ echo 0.35 3.41 1

0.35 4.24 1
0.35 4.35 2
0.36 0.36 1
0.36 1.32 1
0.36 1.45 1
0.36 1.46 1 | perl -e'

my ( @columns, %data );
while (  ) {
my ( $row, $col, $val ) = split;
$data{ $row }{ $col } = $val;
push @columns, $col;
}

@columns = sort { $a=  $b } @columns;


suppose there are duplications in the @columns, the data much more like:

0.35 1.32 3
0.35 4.35 2
0.36 0.36 1
0.36 1.32 1
0.36 1.45 1
0.36 1.46 1

How can I remove the duplications, uniq them?



$ echo 0.35 1.32 3
0.35 4.35 2
0.36 0.36 1
0.36 1.32 1
0.36 1.45 1
0.36 1.46 1 | perl -e'

my ( %columns, %data );
while (  ) {
my ( $row, $col, $val ) = split;
$data{ $row }{ $col } = $val;
$columns{ $col } = 1;
}

my @columns = sort { $a = $b } keys %columns;

print  @columns\n;
for my $row ( sort { $a = $b } keys %data ) {
print join(  , $row, map $_ ?$_ :0, @{ $data{ $row } 
}{ @columns } ), \n;

}
'
 0.36 1.32 1.45 1.46 4.35
0.3503002
0.3611110



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: how to transform xyz into matrix

[John W. Krahn]

lina wrote:

Hi,


Hello,


I have some data like:

0.35 3.41 1
0.35 4.24 1
0.35 4.35 2
0.36 0.36 1
0.36 1.32 1
0.36 1.45 1
0.36 1.46 1


wish the output look like

0.36 1.32 1.45 1.46  3.41 4.24 4.35
0.35  0  0   0 0   11  2
0.36  1  1   1 1   00  0



$ echo 0.35 3.41 1
0.35 4.24 1
0.35 4.35 2
0.36 0.36 1
0.36 1.32 1
0.36 1.45 1
0.36 1.46 1 | perl -e'

my ( @columns, %data );
while (  ) {
my ( $row, $col, $val ) = split;
$data{ $row }{ $col } = $val;
push @columns, $col;
}

@columns = sort { $a = $b } @columns;

print  @columns\n;
for my $row ( sort { $a = $b } keys %data ) {
print join(  , $row, map $_ ?$_ :0, @{ $data{ $row } 
}{ @columns } ), \n;

}
'
 0.36 1.32 1.45 1.46 3.41 4.24 4.35
0.350000112
0.361111000



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: search scalers of an array in another file

[John W. Krahn]

Wang, Li wrote:

Dear list members


Hello,



I am a very beginner of perl programming.


Welcome to the Perl beginners mailing list.



I am trying to write a script to search all scalers of one array
(geneIDFile) in another file (annotationFile). If it is found and
matched, output the whole line of the annotation file.
My script is as follows. It turns out not woking, and I cannot spot
out the error. Could anyone help me?

#!/usr/bin/perl -w

# This script assigns gene function from specific poplar Gene IDs using  
populus tricocarpa annotation
# USAGE:
# unix command line:
# ./assignGOpoplar.pl candidateGenes.name annotationFile.name
# e.g. ./assignGOpoplar.pl top4018tags.xls Ptrichocarpa_156_annotation_info.txt


You say that you want two file names on the command line but your code 
only uses one of those file names.




# the script takes the genes number from the first file and finds the 
annotation in the second file
# then outputs a third file with the geneID and annotation


You also don't specify an output file in your code?



use strict;
use warnings;

my $geneIDfile = shift @ARGV;
my @geneID=();
my @logFC=();
my @logCPM=();
my @LR=();
my @Pvalue=();
my @FDR=();

my $i=-1;
open (GENEIDFILE, $geneIDfile) || die GENEID File not found\n;


You shouldn't quote scalar variables, Perl is not the shell.

perldoc -q quoting

You should probably also include the $! variable in your error message 
so you know why open failed.


open GENEIDFILE, '', $geneIDfile or die Cannot open '$geneIDfile' 
because: $!;




  while (GENEIDFILE) {
chomp;
$i++;
next if ($i==0);
($geneID[$i], $logFC[$i], $logCPM[$i], $LR[$i], $Pvalue[$i], $FDR[$i]) 
= split(/\t/, $_);


You never use the arrays @logFC, @logCPM, @LR, @Pvalue and @FDR so you 
don't really need them.  Your loop would probably be better as:


while ( GENEIDFILE ) {
next if $. == 1;
push @geneID, ( split /\t/ )[ 0 ];



  }
close(GENEIDFILE);


my $j= 1;
my $annotationFile = 
/Users/olsonmatthew/Desktop/Perl/Ptrichocarpa_156_annotation_info.txt;


Aren't you supposed to get this file name from the command line (@ARGV)?



open (ANNOTFILE, $annotationFile) || die ANNOTFILE File not found\n;


open ANNOTFILE, '', $annotationFile or die Cannot open 
'$annotationFile' because: $!;




  while (ANNOTFILE) {
chomp;

if ($_=~/\n/){


The readline (ANNOTFILE) reads one line from the file, where a line is 
defined as zero or more characters ending in newline, and then chomp 
removes that newline, so there is no newline for your regular expression 
to match.




if ($_=~/$geneID[$j]/){


You are only comparing one element from @geneID to the line instead of 
all elements which you stated at the beginning is what you wanted to do.




print $_\n;
}
++$j;
}
}
close(ANNOTFILE);
exit;


If you could provide some sample data from your two files it would be 
easier to come up with a solution.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Save contents of double-quotes to a variable?

[John W. Krahn]

Grant wrote:

Can anyone show me how to save to a variable the contents of a set of
double-quotes in a string?  The string could look like any of these:

phrase1 phrase2 phrase3
phrase2 phrase3
phrase1 phrase3 phrase4

In all of these examples, phrase2 would be saved to the variable.
Many thanks to anyone who can show me how to do this.


$ perl -le'
my @strings = (
q/phrase1 phrase2 phrase3/,
q/phrase2 phrase3/,
q/phrase1 phrase3 phrase4/,
);

for my $string ( @strings ) {
my ( $phrase ) = $string =~ /([^]+)/;
print $phrase if $phrase;
}
'
phrase2
phrase2




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Sluggish code

[John W. Krahn]

venkates wrote:

Hi all,


Hello,


I am trying to filter files from a directory (code provided below) by
comparing the contents of each file with a hash ref (a parsed id map
file provided as an argument). The code is working however, is extremely
slow. The .csv files (81 files) that I am reading are not very large
(largest file is 183,258 bytes). I would appreciate if you could suggest
improvements to the code.

sub filter {
my ( $pazar_dir_path, $up_map, $output ) = @_;
croak Not enough arguments!  if ( @_  3 );

my $accepted = 0;
my $rejected = 0;

opendir DH, $pazar_dir_path or croak (Error in opening directory
'$pazar_dir_path': $!);
open my $OUT, '', $output or croak (Cannot open file for writing
'$output': $!);
while ( my @data_files = grep(/\.csv$/,readdir(DH)) ) {
my @records;
foreach my $file ( @data_files ) {
open my $FH, '', $pazar_dir_path/$file or croak (Cannot open 
file
'$file': $!);
while ( my $data = $FH ) {
chomp $data;
my $record_output;
@records = split /\t/, $data;
foreach my $up_acs ( keys %{$up_map} ) {
foreach my $ensemble_id ( 
@{$up_map-{$up_acs}{'Ensembl_TRS'}} ){
if ( $records[1] eq $ensemble_id ) {
$record_output = join( \t, @records );
print $OUT $record_output\n;
$accepted++;
}
else {
$rejected++;
next;
}
}
}
}
close $FH;
}
}
close $OUT;
closedir (DH);
print accepted records: $accepted\n, rejected records: $rejected\n;
return $output;
}


$output doesn't change inside the sub so why are you returning it?

I couldn't see any way to improve the basic algorithm but I did remove 
some unnecessary code and shortened some stuff:


sub filter {
 croak Not enough arguments!  if @_  3;
 my ( $pazar_dir_path, $up_map, $output ) = @_;

 my $accepted = 0;
 my $rejected = 0;

 opendir my $DH, $pazar_dir_path or croak Error in opening 
directory '$pazar_dir_path': $!;
 open my $OUT, '', $output or croak Cannot open file for writing 
'$output': $!;


 foreach my $file ( grep /\.csv$/, readdir $DH ) {
 open my $FH, '', $pazar_dir_path/$file or croak Cannot 
open file '$file': $!;

 while ( my $data = $FH ) {
 my $key = ( split /\t/, $data )[ 1 ];
 foreach my $up_acs ( values %$up_map ) {
 foreach my $ensemble_id ( @{ $up_acs-{ Ensembl_TRS } 
} ) {

 if ( $key eq $ensemble_id ) {
 print $OUT $data;
 $accepted++;
 }
 else {
 $rejected++;
 }
 }
 }
 }
 }
 print accepted records: $accepted\n, rejected records: $rejected\n;
}



HTH.

John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Argument isn't numeric

[John W. Krahn]

jmrhide-p...@yahoo.com wrote:

Hello and thanks for volunteering your time!


Hello.  (And it's Perl, not PERL.  :-)



I'm returning to PERL after about a year and am struggling to remaster  some
syntax:


#!/usr/local/bin/perl
use warnings;
use strict;
use diagnostics;

# Converts current directory to a list of links

my @dir;
my $name;
my $i = 0;

opendir DH, . or die \nCouldn't open current directory: $!\n;

while ($_ = readdir(DH)) {
next if $_ eq . or $_ eq .. or -d $_ or $_ eq zlinks.pl or $_ eq
zout.txt;


The entries . and .. are directories so you could simplify that to:

next if -d $_ || $_ eq zlinks.pl || $_ eq zout.txt;



$dir[$i++] = $_;


That is usually written as:

push @dir, $_;



}

open FH,   zout.txt or die $!;

foreach $i (@dir) {


That is usually written as:

foreach my $i (@dir) {

What you are doing here is iterating through the contents of @dir and 
putting each element, in turn, into the $i variable.  So for example if 
@dir contains ( dir1, dir2, dir3 ) then the first time through the 
loop $i will contain dir1 and the second time through the loop $i will 
contain dir2, etc.




my @title = split /\./, $dir[$i];


Here (and below) you are using the text value (name of the directory) as 
a numerical index into the array @dir, and a text value in numerical 
context will be 0 so you are always accessing $dir[0], the first element 
of the array.  What you want is:


my @title = split /\./, $i;



$name = $title[0];


Or simpy:

my $name = ( split /\./, $i )[ 0 ];



print FH P ALIGN=CENTERA HREF=\$dir[$i]\
TARGET=\_blank\$name/A/P\n;

}

I get an error for the linemy @title = split /\./, $dir[$i];
Argument filename.ext isn't numeric in array element

Well, I wasn't expecting it to be, but apparently I implied it and can't  figure
out how.


Interestingly, the program executes with the error but only considers  the first
file it finds in the directory. If there are N files, it will  print N links,
but all using the first file name.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: subroutine returning data

[John W. Krahn]

Shlomi Fish wrote:


On Mon, 04 Jun 2012 14:19:27 -0700
John W. Krahnjwkr...@shaw.ca  wrote:


Chris Stinemetz wrote:

I have a subroutine that I want to return 1 only if the value of
%{$href-{$_[0]}} is equal to 'ND' for the whole 24 occurences.


One way to do it:

sub site_offAir {
  return values %{ $href-{ $_[ 0 ] } } == grep( $_ eq 'ND', values
%{ $href-{ $_[ 0 ] } } ) ? 1 : '';
  }



I see several problems with your code:


You are entitled to your opinion.


1. It's quite hard to understand the logic of it.


No it isn't.  (IMHO)


2. It won't stop when it encounter the first ND value.


That is true.  And your point?


3. You have the values % { $href-{ $_[0] } } gob twice (a duplicate
expression).


Yes.  And...


4. You've used $_[0] which is a positional parameter,


So?


see:
http://perl-begin.org/tutorials/bad-elements/#subroutine-arguments


Your argument on your web page does not appear to apply to this situation.


5. The grep does not uses braces for its predicate/block which is harder to
read.


In your opinion.  I prefer to not use braces unless I have to.


6. You will return a true value (a list of length 1) when the function is
called in list context.


Yes, just as the OP's code.



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: subroutine returning data

[John W. Krahn]

[ Please do not top-post your replies.  Please remove non-relevant text 
from your reply before posting.  TIA ]



Jack Maney wrote:


ProTip:


The top two results from Google state:

PROTIP | Know Your Meme
About PROTIP is a term often used in forums and comments to preface snarky,
obvious, counterintuitive, or sometimes genuine advice for the novice. 
Its usage.

knowyourmeme.com/memes/protip - Cached
#
Urban Dictionary: protip
Obvious advice sarcastically presented as sage wisdom.
www.urbandictionary.com/define.php?term=protip - Cached - Similar



If you are trying to imply that you are a professional then snarky or 
sarcastic comments do not bode well.




If you're going to ask for help,


I was providing code to Chris Stinemetz who *was* asking for help.



don't insult and dismiss out of hand the findings of those who take the time to 
help you.


If I insulted Shlomi then I apologize.  But he was also just trying to 
help Chris Stinemetz.




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: lexical scope

[John W. Krahn]

Chris Stinemetz wrote:

Why does this short program only seem to capture the last line of
input in the @array, but when I put the for loop inside the while loop
all lines of input are available in @array.

I thought by declaring the @array outside the while loop would make
all of its contents available once all the lines are read in the while
loop.

#!/usr/bin/perl
use warnings;
use strict;

my @array;

while ( my $line =DATA  ) {
   chomp $line;
   @array = split(/\s+/, $line,-1);


You are assigning (=) to the array and every time you assign new values 
the old values are replaced so only the last file line is in @array when 
the loop ends.


The use of chomp is redundant because the pattern /\s+/ removes newlines 
as well.


The use of -1 as the third argument is superfluous in this case

To sum up, your loop would be better as:

while ( DATA ) {
@array = split;
}

But if you want to save all the lines and still split them then:

while ( DATA ) {
push @array, [ split ];
}

Which will save the fields in an array of arrays.

perldoc perllol
perldoc perldsc



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: subroutine returning data

[John W. Krahn]

Chris Stinemetz wrote:

I have a subroutine that I want to return 1 only if the value of
%{$href-{$_[0]}} is equal to 'ND' for the whole 24 occurences.



One way to do it:

sub site_offAir {
return values %{ $href-{ $_[ 0 ] } } == grep( $_ eq 'ND', values 
%{ $href-{ $_[ 0 ] } } ) ? 1 : '';

}




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: parsing script help please

[John W. Krahn]

nathalie wrote:



Hi


Hello,


I have this format of file: (see attached example)
1 3206102-3207048 3411782-3411981 3660632-3661428
2 4481796-4482748 4483180-4483486


and I would like to change it to this
1 3206102-3207048
1 3411782-3411981
1 3660632-3661428
2 4481796-4482748
2 4483180-4483486 .


I have tried with this script to create an array for each line, and to
print the first element (1 or 2) with the rest of the line but the
output don't seem to be right, could you please advise?
#!/software/bin/perl
use warnings;
use strict;
my $file=example.txt;
my $in;
open( $in , '' , $file ) or die( $! );
#open( $out, txtout);


while ($in){
next if /^#/;
my @lines=split(/\t/);
chomp;
for (@lines) { print $lines[0],\t,$_,\n; };



You want something like this:

#!/software/bin/perl
use warnings;
use strict;

my $file = example.txt;

open my $in, '', $file or die Cannot open '$file' because: $!;

while ( $in ) {
next if /^#/;
chomp;
my ( $key, @fields ) = split /\t/;
print map $key\t$_\n, @fields;
}

__END__



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Perl HTTP Get

[John W. Krahn]

Chris Nehren wrote:

On Wed, May 30, 2012 at 16:22:29 -0500 , Matt wrote:

I did this. Snippet from larger code:

 eval {
 $rststr = ;
 local $SIG{ALRM} = sub { die get timeout };
 alarm(30);
 $rststr = get(http://; . $dst . /request.htm ); # try to get my data
 alarm(0);
 } ;

It 'appears' to work.  Does it look right?


I would write it a little differently:

my $rststr;
eval {
   # rest of the code here, except $rststr = ;
};

The difference here is that I'm declaring $rststr as a lexical rather
than a global. See http://perl.plover.com/FAQs/Namespaces.html for an
explanation about the different ways to declare variables in Perl.
Declaring $rststr with my keeps the program strict-compliant. strict is
perl's typo and mistake finder; learn it, love it, live it.


One error I did receive.  If I did this 'eval { ... }' instead of this
'eval { ... } ;' I would get error about missing semicolon.  Does eval
expect more arguments or something that it requires a semicolon?  Or
is it because eval returns a result?


eval is a function, not a block construct like for/while/if.


eval is an operator/function, not a keyword like for/while/if/etc.

Braces {} define a code block in most circumstances, whether they are 
used with operators, functions or keywords, or all on their own.




This means that you need the semicolon after. See also
https://metacpan.org/module/Try::Tiny#BACKGROUND for things you need to
know when using eval. You don't *have* to use Try::Tiny*, but knowing
what its docs tell you is important.

* though I would strongly recommend at least considering using it




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Help required to extract multiple text fields from a text string

[John W. Krahn]

Michael Rasmussen wrote:

On Sat, May 26, 2012 at 05:52:19PM +0100, Rob Dixon wrote:

On 26/05/2012 14:07, pa...@fsmail.net wrote:

From: Rob Dixonrob.di...@gmx.com

On 26/05/2012 13:51, pa...@fsmail.net wrote:


  split is slower than the correct regex matching.


That is complete nonsense. Can you show a benchmark that supports your
claim?

I do know, and it is nonsense.

The benchmark below shows that split is better than twice as fast as a
regex for the application I have chosen.

If you can rewrite the program to show a diffferent use of regexes where
they are faster than an equivalent split then I will take it back.

Please stop deliberately spreading misinformation.
cmpthese(-5, {
   split =  sub {
 my @array = split ' ', $str;
   },
   regex =  sub {
 my @array = $str =~ /\S+/g;
   },
})


Curious, splitting on single char - what split has been optimized for, the awk 
behavior,
but the regex comparsion is splitting on non-whitespace,


The regular expression is not splitting!  It is capturing.

split removes whitespace.

The regular expression captures non-whitespace.

So the two expressions posted above are equivalent.



the inverse of what split is doing.
Correcting \S to \s returns similar results.


Did you actually examine the results produced?



But that raises the question of what happens when not splitting on the highly 
optimized space scenario.
First, let's see what happens when both split and the regex act on \S:
cmpthese(-5, {
   split =  sub {
 my @array = split /\S+/, $str;


Remove non-whitespace and return whitespace.



   },
   regex =  sub {
 my @array = $str =~ /\S+/g;


Capture and return non-whitespace.



   },
})




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: To quote variables or not

[John W. Krahn]

sono...@fannullone.us wrote:


Subject: To quote variables or not


Your question is not about quoting variables, which is bad, but about 
quoting hash keys.  See:


perldoc -q quoting



A script that I'm refactoring has global variables in two different
styles, e.g.:

$main::global-{form}-{'mailprog'}

$main::global-{form}-{mailprog}

The quote marks don't seem to make a difference, so what would be the
advantage of using them?  What are they and what do they do?  I don't
recall seeing anything like this before.


In your example the quotes do not make a difference.  If you are not 
sure about why you should need quotes then you should probably always 
use them.





John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Why not match?

[John W. Krahn]

Shlomi Fish wrote:


On Sat, 19 May 2012 12:04:16 -0500
Xi Chencxde...@gmail.com  wrote:


I have a simple code, but it doesn't work and don't know why. Please see it
below:

Input file: 1.txt which including number and letter o in one line.
10o10o10

Wanted output file: 2.txt in which 10 represent 10 dots and o is replaced
by letter x.
..x..x..x
The perl code I wrote is below:

#!/usr/bin/perl
use strict;
use warnings;

while(){
 chomp;
  if(/^10o|o10o|o10\z/){
s/10/.………/g;


This contains some Unicode stuff instead of ASCII dots.


If you examine the email closely you will see it is not Unicode:

Content-Type: text/plain; charset=windows-1252
Content-Transfer-Encoding: quoted-printable

   s/10/.=85=85=85/g;



If you replace it with:

s/10/('.' x 10)/ge;

It should work.


Or just:

s/10/../g;




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: Use of uninitialized value in length

[John W. Krahn]

Chris Stinemetz wrote:

Hello List,


Hello,


I'm stumped on this one.

I'm getting this error:

Use of uninitialized value in length at ./DBSR.pl line 21,  line 6.
Use of uninitialized value in length at ./DBSR.pl line 21,  line 8.
Use of uninitialized value in length at ./DBSR.pl line 21,  line 10.
Use of uninitialized value in length at ./DBSR.pl line 21,  line 13.
Use of uninitialized value in length at ./DBSR.pl line 21,  line 16.
Use of uninitialized value in length at ./DBSR.pl line 21,  line 23.
Use of uninitialized value in length at ./DBSR.pl line 21,  line 25.

  I just want to skip to the next line of input data if any of the
array elements have no value (0 in length).

#!/usr/bin/perl
use warnings;
use strict;
use POSIX;
use Data::Dumper;

my $fileOut = testOut.txt;

open my $fin, '', $fileIn or die ERROR opening $fileIn: $!;
open my $out, '', $fileOut or die ERROR opening $fileOut: $!;

my @fields;

while(  ) {
   next unless /;/;
   chomp;
   my @data = split /;/;


If your data has empty fields at the end of the record then using split 
like that will not process those fields correctly.  What you need is:


my @data = split /;/, $_, -1;



   my($Icell,$Isect,$Ichan,$cfc,$cfcq,$rtd) = @data[9,10,27,36,37,40];
 next if(length($Icell) == 0);
 next if(length($Isect) == 0);
 next if(length($cfc) == 0);
 next if(length($cfcq) == 0);
 next if(length($rtd) == 0);
 $rtd = sprintf %.2f, $rtd/8/6.6/2;
 push(@fields, $Icell,$Isect,$Ichan,$cfc,$cfcq,$rtd);
}
print Dumper \@fields;




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: insert

[John W. Krahn]

timothy adigun wrote:


On Mon, May 7, 2012 at 8:36 AM, linalina.lastn...@gmail.com  wrote:


I have two files, one with

3
2
1

another is:

3 1
3 2
6 3

How can I insert the first file into the middle of the second file,


This is one way to do it:

#!/usr/bin/perl
use warnings;
use strict;

my $part1 = get_data( $ARGV[0] );# get f1.txt from CLI
my $part2 = get_data( $ARGV[1] );# get f2.txt from CLI

my $cot = () = @{$part1};


There is no need to copy the array to a list in order to get the number 
of elements in the array because an array in scalar context will return 
the number of elements.




foreach ( 0 .. ( $cot - 1 ) ) {


But you don't need the $cot variable anyways because you can just do this:

foreach ( 0 .. $#$part1 ) {



 my @rec = split /\s+/, $part2-[$_];
 print $rec[0],   , $part1-[$_],   , $rec[1], $/;
}




John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/

Re: sort and count match in file

[John W. Krahn]

Вячеслав Агапов wrote:

Hello all.


Hello,



I have a file with logs
2012-04-13 17:06:10,881 test:dom1 CRIT home
2012-04-13 17:06:10,882 work:dom1 CRIT home
2012-04-13 17:06:10,882 my:dom1 CRIT home
2012-04-13 17:06:10,881 test:dom2 CRIT home
2012-04-13 17:06:10,882 work:dom2 CRIT home
2012-04-13 17:06:10,882 my:dom2 CRIT home
2012-04-13 17:06:10,881 test:dom1 CRIT home
2012-04-13 17:06:10,882 work:dom2 CRIT home
2012-04-13 17:06:10,882 my:dom2 CRIT home


So this is what your actual data looks like?



I need print result
test:dom1 - count of CRIT(2)
test:dom2 - count of CRIT(5)
work:dom1 - count of CRIT(6)


File in .gz format

my code

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;
use 5.010;

use IO::Compress::Gzip;
use IO::Uncompress::Gunzip;

my $file = log.gz;
my $ungzip = new IO::Uncompress::Gunzip($file);
@arr = grep /work/,$ungzip;


With 'strict' enabled your program would have ended here because of the 
@arr variable.


At this point @arr will only contain lines that have the pattern 'work' 
in them.




foreach my $text (@arr) {
 @arr1 = split / /,$text;
 @sort = ($arr1[3],$arr1[4]);


With 'strict' enabled your program would have ended here because of the 
@arr1 and @sort variables.




 say $sort[0] =  $sort[1];
}

result
test:dom1 =  CRIT
test:dom2 =  CRIT
work:dom1 =  CRIT
test:dom1 =  CRIT
test:dom2 =  CRIT
work:dom1 =  CRIT


According to your data and program the result should have been:

CRIT =  home
CRIT =  home
CRIT =  home
CRIT =  home
CRIT =  home
CRIT =  home

And how did 'test:dom1' get into your output if you used grep to filter 
out those lines?




But, I need count of CRIT.

I try

$hash{$_}++ for @sort;
print $_ =  $hash{$_}\n for sort keys %hash;
}

But this print
test:dom1 =  7
test:dom2 =  63
test:dom1 =  8
test:dom2 =  64


Please try to explain more clearly and post actual code and data.



John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction.   -- Albert Einstein

--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/