Re: escape character in regex
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
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
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
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
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
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
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"
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"
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
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
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
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
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
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
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
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
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=>\&wanted1,preprocess=>\&preprocess1},$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
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
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
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
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
Re: Suddenly.... Part 2
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 () { 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?
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?
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
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
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 "[dir] $dir/$file - .htaccess installed\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 "color=\"33\">[dir] $dir/$file - .htaccess installed\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
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
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
Re: Problem rewinding the __DATA__ filehandle
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 the 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(); 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?)
Ronald F. Guilmette wrote: In message<5268663c.4040...@stemsystems.com>, Uri Guttmanwrote: 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: Quizzing students with Perl
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 finishe
Re: Not following the action here.
Harry Putnam wrote: "John W. Krahn" 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: Not following the action here.
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: Need help with a programming problem
Shawn H Corey wrote: On Wed, 02 Oct 2013 13:57:36 -0400 Peter Holsberg wrote: 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: Need help with a programming problem
Peter Holsberg wrote: 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: Sleep
Shawn H Corey wrote: On Sun, 15 Sep 2013 13:00:36 -0700 Unknown User 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
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
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: negate, !!$a, $a!!, flip-flop
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: Filtering Characters
Matt wrote: I have this: while () { 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
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
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
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: grab pattern from start and end block
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: Perl file and STDERR
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=; 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: Tips or Tricks to print out tab-separated data?
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: last
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: last
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: Tips or Tricks to print out tab-separated data?
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?
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?
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
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: Fwd: Question regarding while loops for reading files
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: obfuscating code
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 () { 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 () { 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: matching certain lines
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 = ) { 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 ( ) { 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 ( ) { 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
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
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 ( ) { 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
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
*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: Array vs List output
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 = qw; +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: grouping in regex
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 !
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?
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!
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 () { 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 () { 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
Shlomi Fish wrote: thanks for your answer. See below for my response. On Wed, 5 Sep 2012 09:54:11 -0400 Shawn H Corey wrote: On Wed, 5 Sep 2012 14:33:13 +0100 jet speed 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: regx substitution question
Shlomi Fish wrote: Replying to myself, I have a correction which Shawn inspired. On Wed, 5 Sep 2012 16:49:42 +0300 Shlomi Fish wrote: On Wed, 5 Sep 2012 14:33:13 +0100 jet speed 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
Shlomi Fish wrote: On Wed, 5 Sep 2012 14:33:13 +0100 jet speed 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: how to handle two input files
timothy adigun wrote: On 8/29/12, John W. Krahn wrote: timothy adigun wrote: On 8/29/12, timothy adigun<2teezp...@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: how to handle two input files
timothy adigun wrote: Hi, Hello, On 8/29/12, timothy adigun<2teezp...@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: close file if it's open
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
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
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 $0\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 (){ 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 \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 ( ) { 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
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
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 ?
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
Paul Anderson wrote: [ snip ] #!/usr/bin/myperl -w # euler8.pl --- Euler Problem 8 # Author: Paul Anderson # 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
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: case statement in perl
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: updating variable in Parent using Parallel::ForkManager
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 ?
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?
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
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
lina wrote: On Thu, Jun 28, 2012 at 4:44 PM, John W. Krahn 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
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
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 () { 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 ( ) { 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 () { chomp; if ($_=~/\n/){ The readline () 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?
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
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
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 "$name\n"; } I get an error for the line<> 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: lexical scope
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 = ) { 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 ( ) { @array = split; } But if you want to save all the lines and still split them then: while ( ) { 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
[ 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: subroutine returning data
Shlomi Fish wrote: On Mon, 04 Jun 2012 14:19:27 -0700 "John W. Krahn" 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
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
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
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
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 Dixon" 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
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?
Shlomi Fish wrote: On Sat, 19 May 2012 12:04:16 -0500 Xi Chen 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
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
timothy adigun wrote: On Mon, May 7, 2012 at 8:36 AM, lina 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
Вячеслав Агапов 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/