Re: Removing out new lines

2011-12-07 Thread C.DeRykus
On Dec 1, 6:43 am, whereismel...@gmail.com (Melvin) wrote:
> Hi I have a file in the following format
>
> 111
> 222
> 333
>
> Now I need to print the following output from the given input file as
> 111 222 333
>

The versatile File::Slurp can be a handy shortcut:

# File::Slurp will croak if there's a read error
  my @lines = File::Slurp::read_file( $ARGV[0] );
  chomp @lines;
  print "@lines\n";

--
Charles DeRykus


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




Re: Safely updating a file

2011-11-25 Thread C.DeRykus
On Nov 22, 1:39 pm, shawnhco...@gmail.com (Shawn H Corey) wrote:
> On 11-11-22 04:27 PM, Mark Wagner wrote:
>
> > I want to update a status file, similar to this:
>
> > open OUTFILE, ">", "status.txt";
> > print OUTFILE "$last_date\n";
> > close OUTFILE;
>
> > However, if something goes wrong (e.g. the disk is full), this code
> > will replace "status.txt" with an empty file.  How can I update the
> > file while preserving the previous contents if something goes wrong?
>
> use two files:
>
> open OUTFILE, ">", "status.new" or die "could not open status.new: $!\n";
> print OUTFILE "$last_date\n";
> close OUTFILE;
   ^  or  die "close error: $!";

Good solution but  the close call should be checked
for errors as well since a disk may have filled or an
outage could have interrupted access.

>
> use File::Copy;
> move( "status.new", "status.txt" ) or die "could not move status.new to
> status.txt: $!\n";
>

--
Charles DeRykus


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




Re: How to put an AND in a regex?

2011-10-13 Thread C.DeRykus
On Oct 13, 3:33 am, ham...@nhn.leidenuniv.nl ("Hamann, T.D. (Thomas)")
wrote:

>
> I am trying to write a regex that should only match when certain patterns are 
> not present, e.g. when a line does not start with either a digit or ALL-CAPS 
> text. I figured I could use negative look-aheads for this.
>
> I can write it as:
>
> if (/^(?![[:upper:]][[:upper:]])/) {
>     if (/^(?!\d)/) {
>     s/^//;
>     }
>     else {
>     }
>
> }
> else {
> }
>
> However, I was wondering whether there was a way of writing this as a single 
> if loop, because there are much more than two situations that should not be 
> matched.
>
> I tried to write it as:
>
> if (/^(?![[:upper:]][[:upper:]])|^(?!\d)/) {
> s/^//;
>
> }
> else {
> }
>
> but this means if one option is not matched the other one is matched, which 
> is not what I want. So I need something that does the equivalent of "Don't 
> match this AND don't match this". Is this possible in a if loop, or should I 
> use something else?

Yet another way:

unless (  /^  (?: [[:upper:]]{2} | \d ) /x  ) {
  ...
}

--
Charles DeRykus


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




Re: loop break condition

2011-08-27 Thread C.DeRykus
On Aug 26, 12:25 pm, shlo...@shlomifish.org (Shlomi Fish) wrote:
> ...
> The problem starts to happen when you try to declare $a and $b using my. This
> program:
>
> [CODE]
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> my $a = 5;
> my $b = 6;
>
> print map { "$_\n" } sort { $a <=> $b } (9,100,5,6,70,3,4,98,28,27);
> [/CODE]
>
> Yields this error:
>
> [CODE]
> Can't use "my $a" in sort comparison at test.pl line 9.
> [/CODE]
>
> This is perl-5.14.1 - previous versions of Perl may behave more
> erratically when executing this. $a and $b are built-ins plain and simple, and
> should be treated as such, due to their use by perldoc -f sort and other
> functions from List::Util, List::MoreUtils, etc.

The use of $a,$b elsewhere should definitely ring an
alarm.  Remembering: "use diagnostics qw/-verbose/
though makes the problem/solution very clear:

   (F) The global variables $a and $b are reserved for sort
   comparisons. You mentioned $a or $b in the same
   line as the <=> or cmp operator, and the variable had
   earlier been declared as a lexical variable. Either
   qualify the sort variable with the package name, or
   rename the lexical variable.

Rob's follow-on remarks:
--
 > > Overly-careful warnings can have the opposite of the
  desired effect,
 > > especially on beginner programmers, and make it seem
  like the language
 > > is rife with pitfalls and gotchas, especially when these
  apply to
> > ubiquitous core concepts like $_. I hope people will think
  twice about
> > the ideas that they are conveying.

I tend to agree here that a  cautionary -- rather
than dogmatic -- tone is the better choice.

--
Charles DeRykus


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




Re: loop break condition

2011-08-27 Thread C.DeRykus
On Aug 26, 12:25 pm, shlo...@shlomifish.org (Shlomi Fish) wrote:
> On Fri, 26 Aug 2011 20:08:31 +0100
>
> ...
>
> The problem starts to happen when you try to declare $a and $b using my. This
> program:
>
> [CODE]
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> my $a = 5;
> my $b = 6;
>
> print map { "$_\n" } sort { $a <=> $b } (9,100,5,6,70,3,4,98,28,27);
> [/CODE]
>
> Yields this error:
>
> [CODE]
> Can't use "my $a" in sort comparison at test.pl line 9.
> [/CODE]
>
> This is perl-5.14.1 - previous versions of Perl may behave more
> erratically when executing this. $a and $b are built-ins plain and simple, and
> should be treated as such, due to their use by perldoc -f sort and other
> functions from List::Util, List::MoreUtils, etc.
>
> Another reason not to use them except for those cases is because "a" and "b"
> are not very meaningful and indicative identifiers.
>

Their use elsewhere should definitely ring a cautionary
bell.  Here  'use diagnostics qw/-verbose/  explains the
problem well:

   erbose diagnostic



> > Overly-careful warnings can have the opposite of the desired effect,
> > especially on beginner programmers, and make it seem like the language
> > is rife with pitfalls and gotchas, especially when these apply to
> > ubiquitous core concepts like $_. I hope people will think twice about
> > the ideas that they are conveying.
>
> > Cheers all,
>
> > Rob
>
> --
> -
> Shlomi Fish      http://www.shlomifish.org/
> Why I Love Perl -http://shlom.in/joy-of-perl
>
> Sophie: Let’s suppose you have a table with 2^n cups…
> Jack: Wait a second! Is ‘n’ a natural number?
>
> Please reply to list if it's a mailing list post -http://shlom.in/reply.


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




Re: PCRE: Use backreference in pattern repetition bracket

2011-08-25 Thread C.DeRykus
On Aug 25, 7:01 am, jwkr...@shaw.ca ("John W. Krahn") wrote:
> Honza Mach wrote:
> > Hi everybody,
>
> Hello,
>
>
>
>
>
>
>
>
>
> > I was wondering, if it is possible to use backreferences in the pattern
> > repetition bracket operator.
>
> > Consider the following string:
>
> > my $string = "5 abcdefghijklmn";
>
> > The number five at the beginning of the string means, that I want to
> > extract first five characters from the latter part of the string. I
> > tried the following code, but it doesn`t work:
>
> > $string =~ s/(\d+)\s+(.{\g1})//;
> > print "extracted: $1 $2\n";
>
> > The desired output would be:
>
> > extracted: 5 abcde
>
> > It seems, that it is not possible to use backreferences within the
> > bracket operator (or am I doing something wrong?).
>
> > Is there other solution to my problem.
>
> If it always involves a single digit followed by a single space you
> could use unpack()
>
> $ perl -le'
> my $string = "5 abcdefghijklmn";
> my ( $num, $extract ) = unpack "A2 X2 A2/a*", $string;
> print "$num $extract";
> '
> 5 abcde
>

Or, eliminating the single digit requirement
with split/substr:

( $num, $ss ) = split " ", $string;
print  "$num  ",  substr $ss, 0 , $num;

--
Charles DeRykus



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




Re: Find and Replace in Textfile

2011-08-22 Thread C.DeRykus
On Aug 21, 4:33 am, xecro...@yahoo.com (Ron Weidner) wrote:
> Recently, I was asked to find the first occurrence of a word in a text file 
> and replace it with an alternate word.  This was my solution.  As a new Perl 
> programmer, I feel like this solution was too C like and not enough Perl 
> like.  So, my question is what would have been the Perl like solution to this 
> problem? 
>
> In this example there is little risk of running out of memory reading the 
> file.  But had this been a production environment or an unknown file size, I 
> would have had to consider that.  
>
> #!/usr/bin/perl
> use strict;
> use warnings;
>
> #program finds the first occurrence of the word Dood and
> #replaces it with the word Dude in the file data.txt.
>
> open FP, "+<", "data.txt" || die "Cant open data.txt " . $!;
>
> my @buffer = ;
> seek FP,0,0;
> my $do_replace = 1; #used to control replacing in multiline files.
> my $line;
> my $data;
> foreach $data (@buffer)
> {
>     if ($do_replace == 1)
>     {   
>         $line = $data;
>         $data =~ s/Dood/Dude/;
>         if ($line ne $data)
>         {
>             $do_replace = 0; #we did a substitution so do no more.
>         }
>     }
>     print FP $data;}
>
> close FP;
>
> #Test data
> #Dude! Where's my car?
> #Dood! Where's my car?
> #Dood! Where's my car?
>
>  

If you're permitted a one-liner:

perl -pi.bak -e  '$c=s/Dood\/Dude/ if !$c++'   file

--
Charles DeRykus


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




Re: Spidering

2011-08-03 Thread C.DeRykus
On Aug 1, 10:51 am, rob.di...@gmx.com (Rob Dixon) wrote:
> On 01/08/2011 11:03, VinoRex.E wrote:
>
>
>
> > Hi everyone i am a  beginer for Perl can you give me a psedocode and a
> > sample code for a spider program.It will be helpful in understanding web
> > interfaces.Thank you
>
> If you can't write your own pseudocode for a web spider then check
> Bharathiar University for a more appropriate course. One version goes
>
>    function fetchall(URL)
>      content = get(URL)
>      loop for it over findlinks(content)
>        content = content + fetchall(it)
>      return content
>    end
>
> Since the purpose of your efforts is to learn Perl, I think a module
> like WWW::Mechanize is the wrong choice. To write a program that
> accesses the internet, you should install and study the LWP library.

 LWP::RobotUA can be used in conjunction with other modules
 in the LWP library suite too. It'll provide methods to ensure
appropriate spidering behavior, ie, not hitting sites too fast and
heeding a site's 'robots.txt' guidelines. This is very important for
any spidering programs you write.

--
Charles DeRykus


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




Re: Wanted: Example of asynchronous bidirectional socket client (a socket chat program)

2011-07-29 Thread C.DeRykus
On Jul 27, 10:07 am, siegfr...@heintze.com wrote:
> Sorry if this appears twice. Since it bounced back to me -- probably
> because of the HTML format -- I'm sending it again.
>
> I did some google searching and I could not find an example of a
> bidirectional asynchronous socket client. A telnet client is an example
> of a bidirectional asynchronous socket client.
>
> I don't specifically want source to a telnet client -- that would be
> much fancier than what I require and would not be helpful if the perl
> only called C++. I just want an example in pure perl (or ruby or
> python).
>
> By asynchronous I mean that reads and writes can occur at any time in
> any order with no warning.
>
> Asynchronous could also mean that we don't block while the  write is in
> progress. Blocking while the write is in progress is fine.
>
> I hope it is possible to write such a beast in perl.
>
> Let's suppose I spawn two threads, one to block on a read socket and the
> other to block on the keyboard with $inp= (so it can print to the
> write socket when it receives input form the keyboard). Can the first
> thread print to the console if the second thread is blocking on
> $inp=?
>
> Surely, someone has posted source to such a beast somewhere on the
> internet!


Although I don't have experience with it.,  POE  ( http://poe.perl.org)
offers extensive resources for this type of application including
tutorials, sample cookbook programs, etc.:

>From the POE page above:
POE is a Perl framework for writing reactive programs.
   Cooperatively multitasked programs and networking programs
   are overlapping subsets of reactive programs.

   POE implements a single API and bridges from it to other event
   loops. A program using POE can run under any event loop that
   POE supports, with little or no modification.

--
Charles DeRykus


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




Re: Exit subroutine on filehandle error

2011-07-27 Thread C.DeRykus
On Jul 27, 9:30 am, rob.di...@gmx.com (Rob Dixon) wrote:
> ...
> > Well, one thing I dislike about it is that it is using "or do {...}" 
> > instead of
> > an "if ( ) { ... }". And I did mention something similar.
>
> What exactly is wrong with "or do {...}"?
>
> I believe it is the best option simply because is is comparable to the
> common "open ... or die $!" idiom. The do is there only so that a
> warning can be issued as well as the return, and
>

I like do{...} as well but an even simpler alternative in
this case:

  open( ... )  or warn "..." and return;

--
Charles DeRykus


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




Re: s/// and \n question

2011-07-22 Thread C.DeRykus
On Jul 21, 6:06 pm, shawnhco...@gmail.com (Shawn H Corey) wrote:
> On 11-07-21 08:54 PM, Rob Dixon wrote:
> ...
> I think part of the confusion is also in what does $ match?  According
> to perlre, under "Regular Expressions",
>
>     $        Match the end of the line (or before newline at the end)
>
> That means it can match the end of the string or a newline at the end of
> the string.
>
> Try this and see what it prints:
>
> #!/usr/bin/env perl
>
> use strict;
> use warnings;
>
> while( <> ){
>    print if /(\w+)$/}
>
> __END__
>

Just entering a 'return' which will put a newline in
$_  won't print if the target regex is  /(\w+)+$/.
Only [a-zA-Z_0-9]  --or potentially more  with
certain locale settings-- will.  But not a newline
in any case.

Even /(.+)$/ won't match a single newline at the
end  unless the  regex '/s' modifier is used:

perl -E "$_ = qq{\n}; say qq{matched\n} if /(.)$/"  <-- no

perl -E "$_ = qq{\n}; say qq{matched\n} if /(.)$/s"  <---yes

--
Charles DeRykus


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




Re: Arrow Notation vs. Colon Notation

2011-07-21 Thread C.DeRykus
On Jul 20, 6:09 pm, shawnhco...@gmail.com (Shawn H Corey) wrote:
> On 11-07-20 07:03 PM, Uri Guttman wrote:
>
> > the other is a class method call. it has two major differences. first it
> > will pass its class (or object, the arg before ->) as the first arg in
> > the call. the second thing is that it will search the class hierarchy
> > (using the package global's @ISA) to find that method if it isn't in the
> > Lib class.
>
> ...
>
> The difference here is that `Foo:bar()` gives a run-time error; where
> `Foo->bar()` gives a compile-time error.
>  ...

 An INIT{} which executes just after compilation can help
pinpoint  when runtime starts:

 
 INIT { print "runtime starting...\n"; }
 __END__

runtime starting...
foo
foo
Undefined subroutine &Foo::bar called 

--
Charles DeRykus


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




Re: redirect system command STDER

2011-07-20 Thread C.DeRykus
On Jul 20, 12:45 am, walde.christ...@googlemail.com ("Christian
Walde") wrote:
> On Tue, 19 Jul 2011 21:14:10 +0200, Tessio Fechine  wrote:
> > Hello,
> > I have a subroutine that uses useradd to create accounts
>
> > --
> > @cmd = ('useradd', '-m', $account);
> > my $result = system @cmd;
> > --
>
> > but when useradd fails, I need to stop it from sending the error message to
> > STDER.
> > Is it possible with system?
>
> > Thanks!
>
> For an easy and cross-platform solution you can use Capture::Tiny to capture 
> both STDERR and STDOUT separately and then have your perl code decide what to 
> do with each.
>

Neat solution.  (I wonder why the name 'Tiny' rather than...
say,  IPC::Capture  for instance..)

Another possibility would IPC::Run :

  use IPC::Run qw( run timeout );

  run \@cmd, \$in, \$out, \$err, timeout( 10 )
or die "cmd err: $?";

--
Charles DeRykus




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




Re: Help Parsing a Tab delimited file

2011-07-14 Thread C.DeRykus
On Jul 13, 11:17 pm, jwkr...@shaw.ca ("John W. Krahn") wrote:
> C.DeRykus wrote:
>
>...
>
> That won't work as the shell will interpolate away the backslash:

Not necessarily...   it works on Win32's idea of a
"shell"  for instance :)

But it doesn't hurt even there and is a good habit.

>
> $ echo "one  two     three   four" | perl -F\t -lane'print "$_: $F[$_]"
> for 0 .. $#F'
> 0: one
> 1: wo
> 2: hree four
>
> You have to quote it:
>

Yes, particularly on Unix.

--
Charles DeRykus


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




Re: Help Parsing a Tab delimited file

2011-07-13 Thread C.DeRykus
On Jul 13, 5:42 pm, tiago.h...@gmail.com (Tiago Hori) wrote:
> ...
> >  C.DeRykus wrote:
> > There's already been a very good recommendation. But, if
> > you know your file has no irregularities, is surprise-free as
> > far as formatting,  you may be tempted to just try a 1-liner
> > since Perl does make "easy things easy...":
>
> > perl -lane 'if ($F[1] ne $old ) {open($fh,'>',$F[1]) or die $!};
> >                   print $fh $_;$old = $F[1]'   file

> I am trying to learn the CSV mode for the future, but this software will
> always spit the same file format at me, so your solution may be the way
> to go for now. Would you mi d giving me a quick explanation on what that
>  one liner does? It be useful for me to learn it in more depth and be to
> adapt it to future problems.

You're welcome.  As Jim says though, you're better off running a
multi-line program to learn basics if you're just beginning  and only
then trying a simpler solution.  Or, if you want to jump ahead, see
the doc (perldoc perlrun) to see what the switches mean.

Basically, the one-liner reads  the tab-delimited file line by line
(-n);  autosplits fields the line into fields based on whitespace (-
a)
and populates @F with those fields. If the 2nd column $F[1] ,
hasn't been seen or differs with the previous line's 2nd col.,
then a new output file is opened with a name matching $F[1].
The entire current line $_ is then written to the file. Lastly, $F[0]
is saved to $old so when the next line is read,  $F[0] can be
compared with $old to see if  a new file should be opened.

Note on switches:   -l  * unnecessary so can be omitted
 -F\t   * could be added to split on
tab instead
of whitespace

--
Charles DeRykus


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




Re: Help Parsing a Tab delimited file

2011-07-13 Thread C.DeRykus
On Jul 13, 9:59 am, tiago.h...@gmail.com (Tiago Hori) wrote:
> Hi All,
>
> I work with microarrays and get huge tab delimited files as outputs from the
> software that analysis these microarrays. The result is a tab-delimted Excel
> type of file that has 16 rows and about 20 columns.
>
> Every 44K rows make one unit within the data. These units are identified by
> the Second data column, called meta arrow. So the first 44K rows have the
> value 1 on Meta row, the next 44K have the value 2 and so for.
>
> I would like to be able to separate these files into 4 different files, each
> one containing each unit of data. So all the rows that have meta row 1 would
> go to one file, and the ones with meta row 2 would go to another file and so
> forth.
>
> I have been reading beginning perl to tried to figure this out, but I
> haven't be able to come up with anything.
>
> I have many questions: I know I can use a filhandle to connect to the file,
> but how would I store the data to begin with?
>
> Is there a way to iteratively read through the rows and then copy them to a
> variable as long as their metarow column read let's say 1? and then out put
> that as a new file?
>

There's already been a very good recommendation. But, if
you know your file has no irregularities, is surprise-free as
far as formatting,  you may be tempted to just try a 1-liner
since Perl does make "easy things easy...":

perl -lane 'if ($F[1] ne $old ) {open($fh,'>',$F[1]) or die $!};
   print $fh $_;$old = $F[1]'   file

--
Charles DeRykus


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




Re: @{$var1{$var2}}

2011-06-23 Thread C.DeRykus
On Jun 22, 12:49 pm, rco...@gmail.com (Rob Coops) wrote:
> On Wed, Jun 22, 2011 at 6:44 PM, josanabr  wrote:
> ...
> Lets dissect this a little:
>
> Lets take the inner most thing ($var2) this is obviously a scalar (or a
> reference to another variable (I'll explain why I am betting it is a scalar
> in a bit))
> Then we see the following: $var1{...} this is the way one accesses a
> variable in a hash based on the key (the thing that goes between those
> brackets). Usually the keys used in a has are scalars of course there is
> nothing stopping anyone from using complex data structures as a key but it
> is performance wise not the smartest thing to do.

> The last bit then @{...} basically says treat what is in side the brackets
> as an array (which is what one would do if one is expecting an array
> reference to be returned from $var1's value associated with key $var2.
>
> So what would the data structure look like?
> {
>  "Hash key 1" => \[
>                    'Array value 1',
>                    'Array value 2',
>                    ...
>                   ],
>  "Hash key 2" => \[
>                    'Array value 1',
>                    'Array value 2',
>                    ...
>                   ],
>  ...
>
> }

Hm, I think it's worth noting though if you really want to
"treat what is in side the brackets as an array", you'd
likely be using a simpler data structure such as:

 "Hash key 2" = [ "Array value 1", "Array value 2", ...  ]

rather than:

 "Hash key 2" = \[ "Array value 1", "Array value 2", ...  ]

since the latter actually creates  a ref to an anonymous
array.  And, if it is a "ref to a ref",  you'd need to deref
the original  like this:

  @{ ${$var1{$var2}} }

rather than just:   @{ $var1{$var2} }

See: perldoc perlref

>
> Or in text form: $var1 is an hash containing keys associated with values
> which are references to arrays.
>

--
Charles DeRykus


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




Re: Reliably restarting "sleep"

2011-06-18 Thread C.DeRykus
On Jun 18, 6:50 am, rvtol+use...@isolution.nl ("Dr.Ruud") wrote:
> On 2011-06-17 05:34, C.DeRykus wrote:
>
>
> > Ruud:
> >> C.DeRykus:
> >>> Ruud:
> >>>> C.DeRykus:
> >>>>> Another solution, not necessarily more elegant, but
> >>>>> more familiar to most  is an eval {} and alarm pair:
>
> >>>>> EVAL: {
> >>>>>        eval {
> >>>>>             local $SIG{ ALRM } = sub { die "alarm"; };
> >>>>>             local $SIG{ USR1 } = sub { die "usr1" };
> >>>>>             alarm $sleeptime;
> >>>>>             ... some long running operation here 
> >>>>>             alarm 0;
> >>>>>             1;
> >>>>>         } or do {
>
> >>>> Insert:
> >>>>                 my $eval_error = $@ || "Zombie error!";
>
> >>> Huh?   If you insert that statement before doing 'alarm 0',
> >>> then, there's a potential have a race condition with the
> >>> alarm going off and terminating the entire program with
> >>> "alarm clock" before you can even check $@.
>
> >> Realize that the alarm is then already reset (to the earlier setting)
> >> because the localization gets out of scope.
>
> > No, that's not true. The localized signal handler gets
> > reset but  any alarm that is started in that scope will
> > still be delivered to the current signal handler unless
> > turned  off.
>
> Right, but the word "alarm" in my sentence stood for "alarm signal
> handler", so please re-read.
>
>

I'm sorry to have mis-read your response. With
just a signal name, I always tend to interpret it
narrowly as the  signal itself and not the handler.


> >>>          eval {  ...  ; "foo" happens and sets $@='bar';
> >>>                    ...
> >>>                 };
> >>>                 my $eval_error = $@ || "Zombie error!";
> >>>                        #  alarm actually does go off now
> >>>                        #  and terminates program
> >>>                 alarm 0;      #  too late
> >>>                 
> >>> Therefore you wouldn't want to insert any statement
> >>> before turning off the alarm.
>
> >> Because the alarm signal is localized (to the eval{}), it is not active
> >> in the do{}.
>
> > No, it's still active. In the case below, the alarm
> > that was set inside the scope gets delivered to
> > the default alarm handler.
>
> And my "alarm signal" was short again for "alarm signal handler".
>
> > On freebsd 8.2 for
> > instance:
>
> > $ perl -e 'eval{ local $SIG{ALRM}=sub{die "foo"};
> >                 alarm 1};<>'
> > Alarm clock: 14
>
> > So the alarm that was launched in the eval {} scope
> > is still active and, even though the localized handler
> > goes out of scope,  the delivery still occurs later to
> > the default handler.
>
> Well, I hope I cleared up my bad phrasing.

Should have been clear to me in that context
what you were referring to. Turning off the
undelivered alarm is good practice but I'll
re-read the whole thread.

--
Charles DeRykus



.


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




Re: Timeout for user input

2011-06-17 Thread C.DeRykus
On Jun 17, 6:39 am, paragka...@gmail.com (Parag Kalra) wrote:
> Hi,
>
> I have a requirement where I want to wait for user to input the data.
>
> However if user doesn't input the data within certain period of time then it
> should timeout and move ahead.

There's an example in the docs. See:

  perldoc perlipc  #  look for keyword 'timeout'

--
Charles DeRykus


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




Re: Reliably restarting "sleep"

2011-06-16 Thread C.DeRykus
On Jun 16, 3:00 pm, rvtol+use...@isolution.nl ("Dr.Ruud") wrote:
> On 2011-06-16 19:16, C.DeRykus wrote:
>
>
>
> > Ruud:
> >> C.DeRykus:
> >>> Another solution, not necessarily more elegant, but
> >>> more familiar to most  is an eval {} and alarm pair:
>
> >>> EVAL: {
> >>>       eval {
> >>>            local $SIG{ ALRM } = sub { die "alarm"; };
> >>>            local $SIG{ USR1 } = sub { die "usr1" };
> >>>            alarm $sleeptime;
> >>>            ... some long running operation here 
> >>>            alarm 0;
> >>>            1;
> >>>        } or do {
>
> >> Insert:
> >>                my $eval_error = $@ || "Zombie error!";
>
> > Huh?   If you insert that statement before doing 'alarm 0',
> > then, there's a potential have a race condition with the
> > alarm going off and terminating the entire program with
> > "alarm clock" before you can even check $@.
>
> Realize that the alarm is then already reset (to the earlier setting)
> because the localization gets out of scope.

No, that's not true. The localized signal handler gets
reset but  any alarm that is started in that scope will
still be delivered to the current signal handler unless
turned  off.

>
> >         eval {  ...  ; "foo" happens and sets $@='bar';
> >                   ...
> >                };
> >                my $eval_error = $@ || "Zombie error!";
> >                       #  alarm actually does go off now
> >                       #  and terminates program
> >                alarm 0;      #  too late
> >                
> > Therefore you wouldn't want to insert any statement
> > before turning off the alarm.
>
> Because the alarm signal is localized (to the eval{}), it is not active
> in the do{}.


No, it's still active. In the case below, the alarm
that was set inside the scope gets delivered to
the default alarm handler. On freebsd 8.2 for
instance:

$ perl -e 'eval{ local $SIG{ALRM}=sub{die "foo"};
   alarm 1}; <>'
Alarm clock: 14

So the alarm that was launched in the eval {} scope
is still active and, even though the localized handler
goes out of scope,  the delivery still occurs later to
the default handler.

> ...

--
Charles DeRykus



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




Re: Reliably restarting "sleep"

2011-06-16 Thread C.DeRykus
On Jun 16, 1:54 am, rvtol+use...@isolution.nl ("Dr.Ruud") wrote:
> On 2011-06-15 14:18, C.DeRykus wrote:
>
> > [...]  mixing
> > alarm/sleep is a bad idea. See: perldoc -f alarm.
>
> > Another solution, not necessarily more elegant, but
> > more familiar to most  is an eval {} and alarm pair:
>
> > EVAL: {
> >      eval {
> >           local $SIG{ ALRM } = sub { die "alarm"; };
> >           local $SIG{ USR1 } = sub { die "usr1" };
> >           alarm $sleeptime;
> >           ... some long running operation here 
> >           alarm 0;
> >           1;
> >       } or do {
>
> Insert:
>               my $eval_error = $@ || "Zombie error!";

Huh?   If you insert that statement before doing 'alarm 0',
then, there's a potential have a race condition with the
alarm going off and terminating the entire program with
"alarm clock" before you can even check $@.


   eval {  ...  ; "foo" happens and sets $@='bar';
 ...
  };
  my $eval_error = $@ || "Zombie error!";
 #  alarm actually does go off now
 #  and terminates program
  alarm 0;  #  too late
  
Therefore you wouldn't want to insert any statement
before turning off the alarm.  Particularly if the
alarm handler is localized to the eval{} which is the
best idion.

>
> and use $eval_error in the code below.
>
> >            alarm 0;
> >            if ( $@ =~ /alarm/)     { warn "expired..." }
> >            } elsif ( $@ =~ /usr1/) { redo EVAL; }
> >            } elsif ($@)                { die "unexpected error: $@"; }
> >       }
> > }
>
> Realize that $@ is a global variable, so can get changed at a distance.

Yes,  but $@ was just set and the immediate danger is
an alarm race condition that needs to be addressed
first. The eval {} was just exited after all and nothing
intervenes except the  $@ condition if-elsif clauses
that needed to protected from an uncaught alarm.

>
> The last 'elsif' was particularly wrong: it would not die if $@ is
> false. Just make it an 'else'.
>

But what kind of scenario would do that?  If there's
an uncaught signal for instance, the program will
still terminate immediately with an "alarm clock".
Or if the program unexpectedly exits in some benign
way inside the eval {}, you'd never see that final 'else'
clause anyway. If the final statement '1' in the eval {}
gets short-circuited somehow, I'd think all bets are off.

--
Charles DeRykus


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




Re: perl process forking tutorial recommendation

2011-06-15 Thread C.DeRykus
On Jun 15, 11:21 am, noah-l...@enabled.com (Noah) wrote:
> Hi there,
>
> can somebody recommend a good tutorial web link and/or URL for learning
> perl forking please?
>

Presumably, you've already seen these docs:
perldoc perlipc
perldoc perlfork   # fork emulation for non-Unix

Not the best tutorial but good for later reference so
I'd recommend googling for more basic info. For
instance, using search string "perl fork tutorial",
the first hit was an actual tutorial. Then you may
want to try some  simple examples and see how it
goes.

--
Charles DeRykus




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




Re: Reliably restarting "sleep"

2011-06-15 Thread C.DeRykus
On Jun 14, 3:31 am, gator...@yahoo.de wrote:
> Hi,
>
> On 2011-06-14 09:23, gator...@yahoo.de wrote:
>
>
>
>
>
>
>
>
>
> > what I am trying to do is:
>
> > - run a little program, that just sleeps for a given time
> > - when it receives a signal, restarts sleeping again for the
> >   full time period until it receives another signal or the
> >   timer elapses. In the latter case it should just exit.
> >   Something like:
>
> > sub sleeper {
> >     warn strftime("%H:%M:%S sleep $sleeptime\n", localtime);
> >     $SIG{USR1}=\&sleeper;
> >     sleep $sleeptime;
> > };
>
> > warn $$;
> > sleeper;
>
> > It sounds very simple, but I can't get it to work as intended.
>
> ... meanwhile a found a solution; in case somebody with
> the same problem stumbles upon this, here's what I came up with:
>
> my $caught_signal=0;
>
> sub expired {
>     warn strftime("%H:%M:%S expired\n", localtime);
>     exit 0;
>
> }
>
> sub sleeper {
>     warn strftime("%H:%M:%S sleep $sleeptime\n", localtime);
>     alarm $sleeptime; pause;
>
> };
>
> sub usr1 { alarm 0; $caught_signal=1; }
>
> $SIG{USR1}=\&usr1;
> $SIG{ALRM}=\&expired;
> while(1) {
>     if($caught_signal) {
>         $caught_signal=0;
>     } else {
>         sleeper();
>     }
>
> }
>
> The problem obviously was, that I called "sleep" from within the
> USR1 signal handler and (generally not a bad idea ;) this signal
> had been blocked there.
> If somebody knows a more elegant solution, let me know ...
>

Not sure of your actual program detail  but  mixing
alarm/sleep is a bad idea. See: perldoc -f alarm.

Another solution, not necessarily more elegant, but
more familiar to most  is an eval {} and alarm pair:

EVAL: {
eval {
 local $SIG{ ALRM } = sub { die "alarm"; };
 local $SIG{ USR1 } = sub { die "usr1" };
 alarm $sleeptime;
 ... some long running operation here 
 alarm 0;
 1;
 } or do {
  alarm 0;
  if ( $@ =~ /alarm/) { warn "expired..." }
  } elsif ( $@ =~ /usr1/) { redo EVAL; }
  } elsif ($@){ die "unexpected error: $@"; }
 }
}

--
Charles DeRykus


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




Re: Howto conjoin information from two hash tables?

2011-06-05 Thread C.DeRykus
On Jun 5, 2:30 am, scottie...@gmail.com (Scottie) wrote:
> Hi!
> I'm stuck. Can you help me?
>
> After the backup by Oracle RMAN tool I parse the log file and create
> two hash tables:
>
> %channel =  #It collects information specific to channels
>  {ch1}
>     ->[0]   allocated channel: ch1
>         ->[1]   channel ch1: SID=596 device type=DISK
>         ->[2]   channel ch1: starting compressed full datafile backup set
>         ->[3]   channel ch1: specifying datafile(s) in backup set
>  {ch2}
>     ->[0]   allocated channel: ch2
>         ->[1]   channel ch2: SID=15 device type=DISK
>         ->[2]   channel ch2: starting compressed full datafile backup set
>         ->[3]   channel ch2: specifying datafile(s) in backup set
>
> %channel_files = #It collects information about files that are
> processed by the channel
>  {ch1}
>     ->[0]   input datafile file number=00014 name=/foo/oradata/foo/foo-
> data04.dbf
>     ->[1]   input datafile file number=00019 name=/foo/oradata/foo/foo-
> data05.dbf
>  {ch2}
>     ->[0]   input datafile file number=00013 name=/foo/oradata/foo/foo-
> index03.dbf
>     ->[1]   input datafile file number=00012 name=/foo/oradata/foo/foo-
> data03.dbf
>
> I would like to concatenate information from the above two hash tables
> into one line. Example result that I would get:
> 
>
> Files for channel 'ch1':
>   Channel name    Channel type   File Number      File Name
>   --- -- 
> ---
>   ch1             DISK           00014            /foo/oradata/foo/foo-
> data04.dbf
>   ch1             DISK           00019            /foo/oradata/foo/foo-
> data05.dbf
>
> Files for channel 'ch2':
>   Channel name    Channel type   File Number      File Name
>   --- -- 
> ---
>   ch2             DISK           00013            /foo/oradata/foo/foo-
> index03.dbf
>   ch2             DISK           00012            /foo/oradata/foo/foo-
> data03.dbf
>
> 
>

This shouldn't be too hard but what have you tried...
and what specific problems are you having with the
trial solution?   Seeing what's been done will make
it easier to suggest remedies or maybe provide a
doc reference that'll help.


--
Charles DeRykus



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




Re: Using $variable outside a foreach loop

2011-06-03 Thread C.DeRykus
On Jun 3, 8:37 am, sono...@fannullone.us wrote:
> ...
>         I want to use "$name" in another loop just after this one, but when I 
> do, I get "Global symbol $name requires explicit package".
>

One option is an outer enclosing block that'll
extend the scope of $name to that entire block:

{   # enclosing block
   my $name;
   for $name ( split //... ) { }   #  first loop
   for $name ( ... )  { }   #  next loop
}

--
Charles DeRykus


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




Re: How to avoid using the slow array subscripting operator?

2011-05-26 Thread C.DeRykus
On May 25, 10:05 pm, jason.li...@gmail.com (Xi Liu) wrote:
> Hi all:
> I translated a program from c to perl.but the perl program cost 15 seconds
> compare to the original c one cost only less than 1 second, I guess this
> might be the result of I literally translated the program, using a lot of
> array subscripts. After I profile the perl program, it turned out my guess
> was true.
> for($i = 0; $i < @lines; $i++)
> {
>     $sum += $lines[$_]->{foo_value} for ($i - $n + 1 .. $i);}
>
> sorry I can't post the whole code, but the lines above is the big framework,
> I also omit all the boundary check. "$sum += $lines[$_]->{foo_value} for ($i
> - $n2 + 1 .. $i)" this line consumes all the time.
> I got a array, for each element of the array I have to sum up the $n
> elements prior to the current one. I know I should use pop push shift
> unshift all the perl list operators instead of subscripting, but I just
> don't know how, would somebody tell me what is the perl way of doing this?


Another option, if Perl performance remains too slow after
your improvements, would be an XS extension interface
between Perl and C code.
See: perldoc perlxs

or, for a different approach and a much easier learning curve,
See: Inline::C and/or Inline::C-Cookbook.

--
Charles DeRykus


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




Re: Truncate Last few lines

2011-05-20 Thread C.DeRykus
On May 20, 4:37 am, cmksw...@gmail.com (Ambuli) wrote:
> Here i paste a perl script to delete last Two Lines. If you want
> delete more lines in a file you can specify it.
>
> use File::ReadBackwards;
>  my $filename = 'test.txt';
>  my $Lines_to_truncate = 2; # Here the line to truncate is mean Remove
> only Last Two Lines
>  my $bw = File::ReadBackwards->new( $filename )
> or die "Could not read backwards in [$filename]: $!";
> my $lines_from_end = 0;
>  until( $bw->eof or $lines_from_end == $Lines_to_truncate )
>  {
>         print "Got: ", $bw->readline;
>         $lines_from_end++;
>  }
> truncate( $filename, $bw->tell );

Although tie'ing is slow, the core module Tie::File provides
an easier way:

  use Tie::File;
  tie my @array, 'Tie::File', '/path/to/somefile'  or die ...;
  $#array -= 2;# chop two records off the end

--
Charles DeRykus


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




Re: How to convert to array? Why so many parens?

2011-05-11 Thread C.DeRykus
On May 11, 7:25 pm, siegfr...@heintze.com wrote:
> Darn -- I forgot to switch to plain text again. I hope this does not
> appear twice -- I apologize if it does!
>
> This works and produces the desired result (I've simplified it a bit):
>
> $default= `grep pat file-name`)[0])=~/[0-9]+/)[0]);
>
> Why does it take so many parentheses?
>
> I don't think it should work, however.
>
> (1) Why cannot I just index the results of the sub-process directly and
> say `grep pat file-name`[0]? If Perl is confused I would think I might
> need to explicitly convert it like this:
>   @{`grep pat file-name`}[0]
> but that does not work. I think it should.
>
> (2) I have the same question about the =~ operator -- it returns an
> array too. So why cannot I just type
> print @{$a=~/([0-9]+)/}[0] ?
>
> Instead I have to type
>  print (($a=~/([0-9]+/)[0]);
>
> Why are the extra outer parens required?

This requires a fair amount of background about
list vs array context. Here's a good introduction:

 perldoc -q array

See:  'What is the difference between a list and an array?'
in the above output.

This may answer some of the questions and/or
at least give you some background for a better
understanding of the issues.

HTH,
Charles DeRykus


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




Re: Regular Expression help!

2011-05-11 Thread C.DeRykus
On May 11, 8:38 am, speedj...@googlemail.com (jet speed) wrote:
> Hi All,
>
> I need help in matching the regular expression, the file is as below.
>
> I am trying to match number followed by Number ex 587, 128 in $1 and
> 60:06:01:60:42:40:21:00:3A:AA:55:37:91:8A:DF:11 in $2
>
> the $1 match works find with regulare expression  #if ($_=~
> /\w{7}\s\w{4}\s\w{6}\s(\d{1,4})/i) { #workts for 1st line
>
> However i am not sure how to get both $1 and $2 togather.
>
> Ideally i would like to have an output printed
>
> print "$1 wwn is $2 \n";
>
> Any help on this would be much appreciated.
>
> FILE
> ---
>
> LOGICAL UNIT NUMBER 587
> UID:                        60:06:01:60:42:40:21:00:3A:AA:55:37:91:8A:DF:11
>
> LOGICAL UNIT NUMBER 128
> UID:                        60:06:01:60:50:40:21:00:D0:23:D5:C2:BA:D9:DE:11
>
> LOGICAL UNIT NUMBER 763
> UID:                        60:06:01:60:50:40:21:00:25:C6:3F:A7:CA:2D:DF:11
>
> ---
>
> #!/usr/bin/perl
> open(FILE, "clrlist") || die "Can't open clrlist : $!\n";
>
> while () {
> #if ($_=~ /\w{7}\s\w{4}\s\w{6}\s(\d{1,4})/i) { #workts for 1st line
> ...

Also, you may want to consider the /x modifier to avoid
"regex blindness", [a visual Bermuda Triangle that will
cause anyone viewing it to avert their eyes and quickly
paddle the other way].

Even with an easy regex,  the view improves considerably
with /x :

if  (  /  \w{7}  \s \w{4} \s# insert comment here...
  \d{1,4}   # more comments...
  
   /ix  )

Or just:
  / \w{7} \s  \w{4}  \s   /ix;  # whitespace enhanced

--
Charles DeRykus


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




Re: rewriting a single column in an open file... more efficient IO

2011-05-10 Thread C.DeRykus
On May 10, 9:18 pm, u...@stemsystems.com ("Uri Guttman") wrote:
> > "CD" == C DeRykus  writes:
>
>   CD> On May 9, 1:29 pm, demianricca...@gmail.com (D) wrote:
>   >> Hello everyone,
>   >>
>   >> I would like to learn an efficient way to change a single column in a
>   >> file that is accessed by an external program after the column is
>
>   CD> the tie that you mentioned is actually a decent
>   CD> alternative if  speed's  not an overriding issue.
>
> but he did say speed is an issue. according to the OP this is done many
> times and he needs a faster version. i highly doubt any tied interface
> especially with another layer will do any good here.
>

But, he didn't say speed's the "only" issue - and later on mentioned
"efficiency". I suspect DB_File would be simpler and more
maintainable at least if not an improvement over  IO::All and
splitting/rejoining/rewriting the whole  file each time too.  That's
mainly what I wanted to demo.

Sometimes speed may be a seat-of-the pants perception that
really requires some profiling or a benchmark to shed further
light too. Of course, it may really be dog slow but, without
seeing all the code, the real culprit could be somewhere else.
Other  suspects  could be in the fray - a busy host, a network
component, locking,  etc...

--
Charles DeRykkus


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




Re: rewriting a single column in an open file... more efficient IO

2011-05-10 Thread C.DeRykus
On May 9, 1:29 pm, demianricca...@gmail.com (D) wrote:
> Hello everyone,
>
> I would like to learn an efficient way to change a single column in a
> file that is accessed by an external program after the column is
> changed each time.  open write close is what I have been using.  I
> thought that tieing could help speed it up.  While I didn't dig in too
> deeply, my split entry, change value and rejoin didn't seem to gain me
> much speed.  The test file and script are pasted below.  In practice
> the file will be about 100 lines long and the 3rd column will be
> rewritten thousands of times.  Is there a more efficient approach?
>
> example file:
>
> 'test'
> -
>   foo   ab     0
>  fooa    b     0
>  foob   cd     0
>   foo    e     0
>  fooc    f     0
>   foo   ab     0
>  fooa    b     0
>  foob   cd     0
>   foo    e     0
>  fooc    f     0
> -
>
> script:
> ---
> use IO::All;
> use warnings;
> use strict;
>
> my $lines = io('test')->new;
>
> print "$_ \n" foreach @$lines;
> print "\n\n\n\n\n";
>
> my @tmp;
> foreach (0 .. $#{$lines}){
>  $tmp[$_] = $_;
>
> }
>
> @$lines = map {
>                 my @sh = split /\s+/, $lines->[$_];
>                 join("   ",$sh[0],$sh[1],$tmp[$_]);
>               } 0 .. $#{$lines};
>
> --
>
> cat test:
>
> foo   ab   0
> fooa   b   1
> foob   cd   2
> foo   e   3
> fooc   f   4
> foo   ab   5
> fooa   b   6
> foob   cd   7
> foo   e   8
> fooc   f   9
> foo   ab   10

the tie that you mentioned is actually a decent
alternative if  speed's  not an overriding issue.
For example:

   use DB_File;;

   tie my %HASH, "DB_File", $file,
  O_CREAT|O_RDWR, 0666, $DB_HASH
  or die "error opening $file: $! ";

   my @valid_keys = ('foo ab', 'fooa b', ...  );  # valid keys

   foreach my $key (@some_keys) {
  $HASH{ $key } =  'new value'
if grep( $key eq $_, @valid_keys );
   }

--
Charles DeRykus





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




Re: read the content of a hidden folder in a list

2011-05-08 Thread C.DeRykus
On May 8, 6:29 am, g...@vi-anec.de ("g...@vi-anec.de") wrote:
> Hi,
>
> I want to read the content of a hidden folder like
>
> $path = '/home/user/.gnome2/folder/folder';
>
> in a list but with
>
> opendir(DIR, "$path") || die "folder not found" $!;
> ...  ^^^

There's a syntax error above so you would've seen an
error like this:

Scalar found where operator expected ...
   near "'folder not found' $!"
(Missing operator before  $!?)
syntax error at ..., near "'folder not found' $!"

'die' takes a list so you'll need a comma between
arguments or maybe just:  die "folder not found: $!";

--
Charles DeRykus


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




Re: Rounding Date/Time

2011-05-04 Thread C.DeRykus
On May 3, 4:12 pm, rob.di...@gmx.com (Rob Dixon) wrote:
> On 03/05/2011 19:49, C.DeRykus wrote:
>
>
>
>
>
>
>
>
>
> > On May 2, 9:46 am, lm7...@gmail.com (Matt) wrote:
> >> Have a date:
>
> >> 2011-05-02-16:40:51
>
> >> Using this to get it:
>
> >> $tm = gmtime;
> >> $time_stamp = sprintf "%04d-%02d-%02d-%02d:%02d:%02d",
> >>   $tm->year + 1900, $tm->mon + 1, $tm->mday, $tm->hour, $tm->min, $tm->sec;
> >> print "$time_stamp\n";
>
> >> I need to round it to nearest 5 minute point.
>
> >> 2011-05-02-16:40:51
>
> >> needs rounded like so.
>
> >> 2011-05-02-16:00:00
> >> 2011-05-02-16:45:00
> >> 2011-05-02-16:50:00
> >> 2011-05-02-16:55:00
>
> >> My thought is a bunch of if statements but that seems ugly.  Is there
> >> a better/easier way?
>
> > Yet another way using the core module List::Util:
>
> > use Time::localtime;
> > use List::Util qw/reduce/;
>
> > my @rounded_5mins = grep { not $_ % 5 } 0..60;
> > my $curr_min = localtime->min;
>
> > my $round_min =  reduce { $curr_min-$a<  $b-$curr_min ? $a : $b }
> >                                 @rounded_5mins;
>
> Both this and Uri's earlier suggestion ignore the seconds field. I would
> be surprised if it was acceptable to round 10:02:59
> to 10:00:00 rather than 10:05:00.
>

Depends on how precise the partition counts need to be...
maybe just determining the approx. spread of timestamps
in 5 min. increments suffices.  And of course, if there's
some other criteria, maybe, even a biasing that causes
10:02:30 to fall  into a 10:00:00 rather than a 10:05:00
slot,  won't be acceptable either.

--
Charles DeRykus


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




Re: Rounding Date/Time

2011-05-03 Thread C.DeRykus
On May 3, 11:54 am, shawnhco...@ncf.ca (Shawn H Corey) wrote:
> On 11-05-03 02:49 PM, C.DeRykus wrote:
>
> > my @rounded_5mins = grep { not $_ % 5 } 0..60;
>
> my @rounded_5mins = map { $_ * 5 } 0..12;
>
> # TIMTOWTDI
>

Make that:  TIMTOWTDI++   # a much better way to do it

--
Charles DeRykus


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




Re: Rounding Date/Time

2011-05-03 Thread C.DeRykus
On May 2, 9:46 am, lm7...@gmail.com (Matt) wrote:
> Have a date:
>
> 2011-05-02-16:40:51
>
> Using this to get it:
>
> $tm = gmtime;
> $time_stamp = sprintf "%04d-%02d-%02d-%02d:%02d:%02d",
>  $tm->year + 1900, $tm->mon + 1, $tm->mday, $tm->hour, $tm->min, $tm->sec;
> print "$time_stamp\n";
>
> I need to round it to nearest 5 minute point.
>
> 2011-05-02-16:40:51
>
> needs rounded like so.
>
> 2011-05-02-16:00:00
> 2011-05-02-16:45:00
> 2011-05-02-16:50:00
> 2011-05-02-16:55:00
>
> My thought is a bunch of if statements but that seems ugly.  Is there
> a better/easier way?

Yet another way using the core module List::Util:

use Time::localtime;
use List::Util qw/reduce/;

my @rounded_5mins = grep { not $_ % 5 } 0..60;
my $curr_min = localtime->min;

my $round_min =  reduce { $curr_min-$a < $b-$curr_min ? $a : $b }
   @rounded_5mins;

etc...

--
Charles DeRykus


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




Re: better way of writing this script

2011-04-29 Thread C.DeRykus
On Apr 29, 2:39 am, u...@stemsystems.com ("Uri Guttman") wrote:
> > "RD" == Rob Dixon  writes:
>
>   RD> On 29/04/2011 10:27, Uri Guttman wrote:
>
>   RD> Good call Brian. It's not at all obvious that all the elements of a hash
>   RD> slice will be created if they don't exist :)
>   >>
>   >> and they won't be anyhow. you need have lvalues to autovivify hash (or
>   >> array) elements.
>   >>
>   >> perl -le '@x = @y{ qw( a b )}; print keys %y'
>   >>
>   >> %y is empty as you can see.
>
>   RD> I meant in the specific case of the grep that was posted. There are no
>   RD> lvalues there, yet they are autovivified:
>
>   RD>   perl -le '@x = grep defined, @y{ qw( a b )}; print keys %y'
>
> that shouldn't happen IMO. it is only calling defined on the aliased
> values of %y. i would call it a bug but some could argue otherwise.
>

This happened in 5.10 ... at least after 5.8.

From: http://rt.perl.org/rt3/Ticket/Display.html?id=89024

Just like the argument list of sub calls, The list over which
foreach
iterates is evaluated in lvalue context as required by foreach's
aliasing property.

Ex:
perl -MData::Dumper -le '
 for ( @y{qw(a b)} ) {$_ = "foo" unless defined $_} ;
 print Dumper \%y'

$VAR1 = {
 'a' => 'foo',
 'b' => 'foo'
  };


grep's aliasing creates the same lvalue context:

   perl -MData::Dumper -le '
   @x = grep {$_ = "foo" unless defined $_} @y{ qw( a b )};
   print Dumper \%y'

   $VAR1 = {
'a' => 'foo',
'b' => 'foo'
  };

--
Charles DeRykus


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




Re: Net::SCP is saving a file name with a wild card

2011-04-28 Thread C.DeRykus
On Apr 28, 9:31 am, dthack...@gmail.com (Dave Thacker) wrote:
> Hi,
> I need to pull a file or files down every day that contain a specific
> string.   Here's my code.
>
> #!/usr/bin/perl
> use strict;
> use Net::SCP;
>
> my $scp=' ';
> open (LOG, ">>/home/wesaysopost/logs/retrieve-wesayso-results.log") or die
> "Can't open logfile";
> LOG-> autoflush(1);
>
> print LOG "Starting Retrieval Process";
> $scp = Net::SCP->new ( "theserver.wesayso.com", "mylogin");
> $scp->cwd("postingscript")  or die "Can't change directories";
> $scp->get ("acme_posting*") or die "Can't retrieve results";
> close LOG;
> exit;
>
> The file I'm retrieving is acme_posting20110415.txt   (date changes every
> day)
>
> The file is found, but it's being saved as acme_posting*
>
> I'm not specifying a local file name when I get the file, why is SCP saving
> it under a different name?

Because perl doesn't know what the actual wildcarded
transfer will return before the call returns. If fact,
several files might be returned.  How would perl know
which one was the target...  So, the basename of  the
remote file is used to generate the local file name. In
this case basename('acme_posting*') just becomes the
identical name "acme_posting*"

Any reason you can't just specify an exact filename each
day.. for instance:

($day, $mon, $yr ) = (localtime time())[3,4,5];
$file = sprintf( "acme_posting%d%02d%02d",
$yr+1900, $mon, $day );


--
Charles DeRykus


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




Re: Calling subroutines with the & sigil

2011-04-14 Thread C.DeRykus
On Apr 13, 4:07 pm, sono...@fannullone.us wrote:
> Hello,
>
>         I read somewhere that it's bad practice anymore to call a subroutine 
> like this:
>
> &subroutine();
>

Normally yes but  there are a few circumstances
where you need the sigil.  See: perldoc perlsub

>         I've also read where it's faster to call a sub like this:
> &subroutine;
>
> than it is to call like this:
> subroutine();

You may be thinking of recursive calls. From
perlsub :

 Subroutines may be called recursively.  If a
 subroutine is called using the "&" form, the
 argument list is optional, and if omitted, no @_
 array is set up for the subroutine: the @_ array
 at the time of the call is  visible to subroutine
 instead. This is an efficiency mechanism that
 new users may wish to avoid.



Also, for quick reference, see following section
in  perlfaq7:

  "What's the difference between calling a
   function as &foo and foo()?"

--
Charles DeRykus


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




Re: Regular expression to capitalize first letter of words in sentence

2011-04-13 Thread C.DeRykus
On Apr 12, 11:10 pm, shlomit.af...@weizmann.ac.il ("Shlomit Afgin")
wrote:
> Hi  
>
> I need to write regular expression that will capitalize the first letter of 
> each word in the string.  
> Word should be string with length that is greater or equal to 3 letters  
> exclude the words 'and' and 'the'.
>
> I tried:
> $string = lc($string);
> $string =~ s/\b(\w{3,}[(^the|^and)])\b/ucfirst($1)/ge;

A character class is the wrong strategy. For
more details about how character classes,
see: perldoc perlretut

Another possible solution:

 s/\b(\w{3,})/ucfirst( lc $1)/ge;

--
Charles DeRykus


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




Re: Regular Expressions Question

2011-04-12 Thread C.DeRykus
On Apr 11, 7:21 am, gklc...@googlemail.com (gkl) wrote:
> On Apr 10, 11:03 pm, jwkr...@shaw.ca ("John W. Krahn") wrote:
stion on regular expressions as my
> > > program is working fine but I was just curious.
>
> > > Say you have the following URLs:
>
> > >http://www.test.com/image.gif
> > >http://www.test.com/?src=image.gif?width=12
 
>
> OK. So if I understood you correctly, given the following (actual)
> URLs
>
> http://beta.images.theglobeandmail.com/archive/01258/election_heads__...http://storage.canoe.ca/v1/dynamic_resize/?src=http://www.torontosun
>
> the following pattern
>
> ^\s*.*\.([a-zA-z]{3})$ | ^\S*\?\S*\.([a-zA-z]{3})&.*$
>
> should match them both. Am I correct?
>

No, there is at least one problem. In your first
alternative, the '.*'  will  also match the literal '?'
which the second alternative is matching.

 See: 'perldoc perlretut' for a review.

[ The  URI module which was mentioned will
 be a quicker solution and will work work all
 cases. ]

--
Charles DeRykus


See: perldoc perlretut


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




Re: trouble matching words with parentheses using grep

2011-04-10 Thread C.DeRykus
On Apr 9, 1:04 pm, alanhag...@alanhaggai.org (Alan Haggai Alavi)
wrote:
> > ...
> > #!usr/bin/perl
>
> For increased portability, use the shebang #!/usr/bin/env perl
>

Hm,   portable only in limited situations, risky,
and always slower.

 From:
 http://www.webmasterkb.com/Uwe/Forum.aspx/perl/3968/env-perl-or-simply-perl

   Randal Schwartz's response from above thread:
   ...
   Seconded on the "reduced portability".  The shebang
   path has to be accurate.  Throwing "env" into the mix
   means that env has to exist at a known location.  Some
   systems don't have it, some system have it at /bin/env,
   and some systems have it at /usr/bin/env... so you're
   only portable within a subset of machines.

   Also, you're then also doing a double-launch.  First, the
   kernel launches env, then env has to wake up and figure
   out where Perl is, and then launch that.

  And, if that wasn't enough, you risk that your script will be
  run by a privately installed Perl when someone else runs
  it... which might not have the right version or the right
  installed modules.  An explicit #! path never depends on
  PATH, so that's not an issue.

  So, in general, avoid this strategy when you can.

--
Charles DeRykus





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




Re: @INC problem with ssh

2011-04-07 Thread C.DeRykus
On Apr 7, 2:07 am, paik...@gmail.com (Dermot) wrote:
> On 7 April 2011 00:24, C.DeRykus  wrote:
>
>
>
>
>
>
>
>
>
> > On Apr 6, 7:45 am, paik...@gmail.com (Dermot) wrote:
> >> Hello All,
>
> >> I have a issue when I attempt to run a script on one host (B) that is
> >> called by ssh from other host (A).
>
> >> On host B, I have the script in /usr/local/bin/stuff.pl. The script
> >> has the following near the top:
>
> >> use strict;
> >> use warnings;
> >> use lib qw(/etc/perl);
>
> >> use MyApp::Image;
> >> use MyApp::Schema;   # Schema will attempt to dbi:SQLite connect to a
> >> local db file.
> >> ...
> >> ...
> >> ...
>
> >> On host A I run a script that does:
>
> >> use FindBin qw($Bin);
> >> use lib qq($Bin/../lib);
> >> ...
> >> ...
> >> ...
> >> my $cmd = qq(ssh -i $Bin/../lib/.ssh/someuser_id.rsa someuser\@) .
> >>             $self->config('imageing_server') .
> >>             qq( "/usr/local/bin/stuff.pl ");
> >> my $res = qx($cmd);
>
> >> When I run the script, I get:
> >> Can't locate MyApp/Schema.pm in @INC (@INC contains:
> >> /usr/local/bin/../../ /etc/perl
> >> /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
> >> /usr/lib/perl5/site_perl/5.8.8 /usr/lib/perl5/site_perl
> >> /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
> >> /usr/lib/perl5/vendor_perl/5.8.8 /usr/lib/perl5/vendor_perl
> >> /usr/lib/perl5/5.8.8/i386-linux-thread-multi /usr/lib/perl5/5.8.8 .)
> >> at /usr/local/bin/stuff.pl line 15.
>
> >> The @INC mentioned in the error looks like the @INC on host A, or at
> >> least perl is looking for the files locally. I fear that, worse than
> >> simply having problem with @INC, other paths, including the path to
> >> local files will try and reference stuff on host A and not host B.
> >> There may be some very good security reasons for this (perldoc
> >> perlsec) but I hoping there is a way to make this work.
>
> >> Does anyone know if or how I can make the script on host B execute
> >> it's commands and look locally for files?
>
> > How's the script on host B invoked... standalone via
> > shebang line or externally as in  'perl stuff.pl'?
> > If the latter, is the invoking perl distro identical with
> > that on the shebang line?
>
> Hi,
> Yes it does.
>
> #!/usr/bin/perl
>
> use Digest::SHA2;
> use DateTime::Format::Strptime;
> use DateTime::Format::SQLite;
> use Getopt::Long;
>
> use strict;
> use warnings;
> use lib qw(/etc/perl);
>
> use MyApp::Image;
> use MyApp::Schema;
>
> The script on host B uses a shebang (!#/usr/bin/perl), the version on
> that host is perl, v5.8.8 built for i386-linux-thread-multi
>
> The perl on host A, the caller, is perl, v5.8.6 built for
> i386-linux-thread-multi.
>
> When I attempt to invoke the script from the command line of host A, I
> get the same error:
>
> [dermot@hosta]$ ssh -i lib/.ssh/someuser_id.rsa someuser@hostb
> "/usr/local/bin/stuff.pl record_number=651500447"
> Can't locate MyApp/Schema.pm in @INC (@INC contains:
> /usr/local/bin/../../ /etc/perl
> /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
> /usr/lib/perl5/site_perl/5.8.8 /usr/lib/perl5/site_perl
> /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
> /usr/lib/perl5/vendor_perl/5.8.8 /usr/lib/perl5/vendor_perl
> /usr/lib/perl5/5.8.8/i386-linux-thread-multi /usr/lib/perl5/5.8.8 .)
> at /usr/local/bin/stuff.pl line 15.
> BEGIN failed--compilation aborted at /usr/local/bin/stuff.pl line 15
>
> user@hostb is not the same user that invokes the script on host A
>
> The big mystery for me is that I have other scripts, albeit that do
> not use MyApp::Schema, that work fine between the two hosts. EG:
>
> ssh -i lib/.ssh/someuser_id.rsa someuser@hostb
> "/usr/local/bin/make_thumbnail.pl --record_number=651500447"
> Can't set owner to 48 on
> /var/media/images/65/15/00/447/651500447-thumb.jpg: Operation not
> permitted
>
> Ok, it has it's issues too but it works locally. So I added the `use
> MyApp::Schema` to the above script and.dam got the same error:
>

> /usr/local/bin/../../ /etc/perl
> /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
> /usr/lib/perl5/site_perl/5.8.8 /usr/lib/perl5/site_perl
> /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
> /usr/lib/perl5/vendor_perl/5.8.8 /usr/lib/perl5/vendor_perl
> /usr/lib/perl5/5.8.8/i386-linux-

Re: @INC problem with ssh

2011-04-06 Thread C.DeRykus
On Apr 6, 7:45 am, paik...@gmail.com (Dermot) wrote:
> Hello All,
>
> I have a issue when I attempt to run a script on one host (B) that is
> called by ssh from other host (A).
>
> On host B, I have the script in /usr/local/bin/stuff.pl. The script
> has the following near the top:
>
> use strict;
> use warnings;
> use lib qw(/etc/perl);
>
> use MyApp::Image;
> use MyApp::Schema;   # Schema will attempt to dbi:SQLite connect to a
> local db file.
> ...
> ...
> ...
>
> On host A I run a script that does:
>
> use FindBin qw($Bin);
> use lib qq($Bin/../lib);
> ...
> ...
> ...
> my $cmd = qq(ssh -i $Bin/../lib/.ssh/someuser_id.rsa someuser\@) .
>             $self->config('imageing_server') .
>             qq( "/usr/local/bin/stuff.pl ");
> my $res = qx($cmd);
>
> When I run the script, I get:
> Can't locate MyApp/Schema.pm in @INC (@INC contains:
> /usr/local/bin/../../ /etc/perl
> /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
> /usr/lib/perl5/site_perl/5.8.8 /usr/lib/perl5/site_perl
> /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
> /usr/lib/perl5/vendor_perl/5.8.8 /usr/lib/perl5/vendor_perl
> /usr/lib/perl5/5.8.8/i386-linux-thread-multi /usr/lib/perl5/5.8.8 .)
> at /usr/local/bin/stuff.pl line 15.
>
> The @INC mentioned in the error looks like the @INC on host A, or at
> least perl is looking for the files locally. I fear that, worse than
> simply having problem with @INC, other paths, including the path to
> local files will try and reference stuff on host A and not host B.
> There may be some very good security reasons for this (perldoc
> perlsec) but I hoping there is a way to make this work.
>
> Does anyone know if or how I can make the script on host B execute
> it's commands and look locally for files?

How's the script on host B invoked... standalone via
shebang line or externally as in  'perl stuff.pl'?
If the latter, is the invoking perl distro identical with
that on the shebang line?

--
Charles DeRykus


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




Re: Parse Key=Val parameters with s///eg

2011-03-18 Thread C.DeRykus
On Mar 17, 3:44 pm, c...@pobox.com (Chap Harrison) wrote:
> On Mar 17, 2011, at 5:21 PM, Rob Dixon wrote:
>
> > A s///g is 'successful' if it performs at least one substitution, in which 
> > case it will return the number of substitutions made. In your code, it will 
> > find as many key=value substrings as possible and replace them with just 
> > the value string.
>
> > The \G pattern is documented only in the case of m//g, which
> > makes sense as it is defined in terms of a character position
> > (pos) within the string where the last match ended.

Um,  the substitution operator  uses  m/// to pattern match
as well so you'll sometimes see \G in s///.

> > If a substitution is being made then it will also affect character
> > positions, and so is similar to adding to or deleting from an array
> > while iterating over it.

No, I don't think so.  Or, am I missing something obvious?
For instance, the char. positions within the original string
being pattern matched are unaffected by s/// replacements:

perl -wle "$_= '123abc4'; s/\G(\d)(?{print pos()})/$1 . 'foo'/
eg;print"
1
2
3
1foo2foo3fooabc4

> ...
>
> > I believe a while loop is the proper way to go, but if you want to 
> > experiment with m//g I suggest something like this
>
> >  my %matches = $line =~ /\G\s*(\w+)(?:\s*=\s*(\w+))?\s*/gc;
>
> > which will pass all the 'key' and 'key=value' pairs to %matches. An invalid 
> > input will cause the match to terminate before the end of the string, so
>
> >  if (pos $line < length $line) {
> >    # code to handle bad input
> >  }
>

Neat solution.  IMO, though, it's much clearer and simpler
(particularly for subsequent maintainers), to identify errors
up front if you can and save the time and complexity to
review \G and pos() and the implication of a  s/// return
count (unless of course you're using them all the time).

   -->  "bad char: $1" if $line =~ / ([^\w=\s]) /x;

> > If a key has no corresponding value in the string it will appear in the 
> > hash with a value of undef, which should be defaulted to 1 like this
>
> >  foreach (values %matches) {
> >    $_ = 1 if not defined;
> >  }
>

You can also use the defined-or operator.

$_ //= 1 foreach (values %matches)

--
Charles DeRykus


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




Re: Parse Key=Val parameters with s///eg

2011-03-17 Thread C.DeRykus
On Mar 17, 1:27 pm, c...@pobox.com (Chap Harrison) wrote:
> On Mar 17, 2011, at 1:49 PM, C.DeRykus wrote:
>
>
>
> > On Mar 16, 9:58 am, c...@pobox.com (Chap Harrison) wrote:
>
> >> #!/usr/bin/perl
>
> >> use warnings;
> >> use strict;
> >> use feature ":5.10";
>
> >> #
> >> # $line, unless empty, should contain one or more white-space-separated
> >> # expressions of the form
> >> #       FOO
> >> # or    BAZ = BAR
> >> #
> >> # We need to parse them and set
> >> # $param{FOO} = 1       # default if value is omitted
> >> # $param{BAZ} = 'BAR'
> >> #
> >> # Valid input example:
> >> #   MIN=2 MAX = 12  WEIGHTED TOTAL= 20
> >> # $param{MIN} = '2'
> >> # $param{MAX} = '12'
> >> # $param{WEIGHTED} = 1
> >> # $param{TOTAL} = '20'
> >> #
>
> >> my $line = 'min=2 max = 12 weighted total= 20';
> >> $line = 'min=2 max, = 12 weighted total= 20';
> >> say $line;
> >> my %param;
>
> >> if ( $line and
> >>      ($line !~
> >>            s/
> >>                 \G            # Begin where prev. left off
> >>                 (?:           # Either a parameter...
> >>                     (?:            # Keyword clause:
> >>                         (\w+)      # KEYWORD (captured $1)
> >>                         (?:        # Value clause:
> >>                             \s*    #
> >>                             =      # equal sign
> >>                             \s*    #
> >>                             (\w+)  # VALUE (captured $2)
> >>                         )?         # Value clause is optional
> >>                     )
> >>                     \s*            # eat up any trailing ws
> >>                 )             ### <-- moved
> >>                 |             # ... or ...
> >>                     $         # End of line.
> >>             /                 # use captured to set %param
> >>                 $param{uc $1} = ( $2 ? $2 : 1 ) if defined $1;
> >>        /xeg
> >>    ) ) {
> >>     say "Syntax error: '$line'";
> >>     while (my ($x, $y) = each %param) {say "$x='$y'";}
> >>     exit;}
>
> >> while (my ($x, $y) = each %param) {say "$x='$y'";}
>
> > I believe the problem is the "?   # Value clause is optional"
> > since, in the case of your badline with a ",", the regex will
> > consume 'max' and then ignore the , since ? means 0 or 1
> > instance.  Therefore the regex will still succeed and $2 will
> > be undefined. So the VALUE gets set to 1.
>
> I agree - encountering the ',' causes the regex to think it's encountered a 
> keyword without a value.  But why doesn't the *next* iteration of the global 
> substitution (which would begin at the ',') fail, causing the if-statement to 
> succeed and print "Syntax error"?
>
> Perhaps I don't fully understand how the /g option works  I thought it 
> would continue to "iterate" until either it reached the end of the string (in 
> which case the s/// would be considered to have succeeded) or it could not 
> match anything further (in which case it would be considered to have failed).

It does iterates through the string until match failure or
end of string. The regex returns the count of successful
matches but, due to the !~ , the count  is negated and
returned.  So, only  if there had been no matches at all,
would the negated return have returned true and taken
the syntax  error branch.

For instance, this fails to match immediately since 'a' doesn't
match \d and the negated return of false causes "true" to print:

   perl -wle "my $x='abc123'; print 'true' if  $x and $x !~ s/\G\d}//
g"

But, this matches once before failing and the negated return of
that count  causes the statement qualifier to fail so nothing gets
printed:

   perl -wle "my $x='1abc23'; print 'true' if $x and $x !~ s/\G\d//g"


See: perldoc perlop   for details about the substitution
operator and the \G assertion.

--
Charles DeRykus


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




Re: Parse Key=Val parameters with s///eg

2011-03-17 Thread C.DeRykus
On Mar 16, 9:58 am, c...@pobox.com (Chap Harrison) wrote:
> Oops, I misplaced the final closing parenthesis in the regex.  But it doesn't 
> seem to matter.
>
> - - - - -
>
> #!/usr/bin/perl
>
> use warnings;
> use strict;
> use feature ":5.10";
>
> #
> # $line, unless empty, should contain one or more white-space-separated
> # expressions of the form
> #       FOO
> # or    BAZ = BAR
> #
> # We need to parse them and set
> # $param{FOO} = 1       # default if value is omitted
> # $param{BAZ} = 'BAR'
> #
> # Valid input example:
> #   MIN=2 MAX = 12  WEIGHTED TOTAL= 20
> # $param{MIN} = '2'
> # $param{MAX} = '12'
> # $param{WEIGHTED} = 1
> # $param{TOTAL} = '20'
> #
>
> my $line = 'min=2 max = 12 weighted total= 20';
> $line = 'min=2 max, = 12 weighted total= 20';
> say $line;
> my %param;
>
> if ( $line and
>      ($line !~
>            s/
>                 \G            # Begin where prev. left off
>                 (?:           # Either a parameter...
>                     (?:            # Keyword clause:
>                         (\w+)      # KEYWORD (captured $1)
>                         (?:        # Value clause:
>                             \s*    #
>                             =      # equal sign
>                             \s*    #
>                             (\w+)  # VALUE (captured $2)
>                         )?         # Value clause is optional
>                     )
>                     \s*            # eat up any trailing ws
>                 )             ### <-- moved
>                 |             # ... or ...
>                     $         # End of line.
>             /                 # use captured to set %param
>                 $param{uc $1} = ( $2 ? $2 : 1 ) if defined $1;
>        /xeg
>    ) ) {
>     say "Syntax error: '$line'";
>     while (my ($x, $y) = each %param) {say "$x='$y'";}
>     exit;}
>
> while (my ($x, $y) = each %param) {say "$x='$y'";}

I believe the problem is the "?   # Value clause is optional"
since, in the case of your badline with a ",", the regex will
consume 'max' and then ignore the , since ? means 0 or 1
instance.  Therefore the regex will still succeed and $2 will
be undefined. So the VALUE gets set to 1.

Rather than crafting a still more complicated regex, a
quick fix might be a pre-check  to see if the line has any
character that's not a \w, =, or whitespace:

# disallow anything but equal, word, or whitespace

die "Syntax error: found disallowed char:$1"
if  $line =~ /([^=\w\s])/);

#  continue to process line...
if ( $line and  $line !~  

--
Charles DeRykus


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




Re: Testing File Contents

2011-03-03 Thread C.DeRykus
On Mar 2, 9:55 am, lm7...@gmail.com (Matt) wrote:
> I am looking for a simple way to test if a file does not contain a
> string.  This is on a linux box.
>
> if myfile does not contain mystring {
>   #do_something;
>   }
>
> The file is basically a list of names and I want to test that a
> certain name is not in there.  Is there an easy way to do that?

Yet another way:

perl -0777 -nlE ' say /mystring/ ? "yes" : "no" '  file

See: perldoc perlrun for explanation of -0777

--
Charles DeRykus


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




Re: about return

2011-02-09 Thread C.DeRykus
On Feb 9, 10:07 pm, terry.p...@mail.ru (terry peng) wrote:
> hello,
>
> when in the case "return undef" I prefer just "return" coz in list context it 
> will return an empty list.
>
> my $exist = ...
> if ($exist) {
>     return 1;
>
> } else {
>     return;
> }
>
> the code above can work, but having many lines.
> So I want:
>
> return $exist ? 1 : (...);
>
> what should be put in (...) to get the same effect as just "return" (not 
> return undef)?
>

return $exist ? 1 : ();

--
Charles DeRykus




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




Re: Text Manipulation

2011-02-06 Thread C.DeRykus
On Feb 5, 7:11 am, zavi...@gmail.com (zavierz) wrote:
> Hi, I am trying to modify a LaTex file which is plain text.
> The file contains lines similar to the following, but each line is
> followed by text, so that:
>
> Article 1  Cats
> Article 2  Dogs
> Article 3  Fish
> Article 4  Ferrets
>
> etc.
>
> I would like to modify the file so that each referenced line is
> changed as follows:
>
> \subsection*{Article 1 Cats}
> \subsection*{Article 2 Dogs}
> \subsection*{Article 3 Fish}
> \subsection*{Article 4 Ferrets}
>
> Here's code which was suggested to me, but when I execute it I'm
> returned to the command line and nothing happens:
>
> #!/usr/bin/perl
> s/^(Article\s+[0-9]+\s+\N*\S)/\\subsection*{$1}/gm
 ^^^
s/^(Article\s+[0-9]+\s+\N*)/\\subsection*{$1}/gm"


I believe the problem is the extraneous \S. The regex
should be:

either:  ^(Article\s+[0-9]+\s+\N*)

or:^(Article\s+[0-9]+\s+\S*)

BTW,   \N is a newer regex experimental escape.
>From perldoc perlre:

\N   Any character but \n (experimental)

>  ...

--
Charles DeRykus


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




Re: Win32::Job, wait until timeout, but capture all output

2011-02-04 Thread C.DeRykus
On Feb 3, 7:36 am, filip.sne...@gmail.com (Filip Sneppe) wrote:
> Hi,
>
> I am writing a script that executes external command that may hang.
> I want to capture all output produced by the external command and
> continue with my perl code after a certain execution timeout for the
> external program.
> Since I am running the script on Windows, I cannot use any ALARM
> mechanism.
>
> The best alternative I could come up with is the use of Win32::Job, eg.
>
> use win32::Job;
>
> my $timeout = 10;
> my $job = Win32::Job->new;
> $job->spawn(undef, "iscsicli.exe", (), );
> $job->run($timeout);
>
> print "ok\n";
>
> This particular test hangs for 10 seconds (because the iscsicli.exe
> command without any arguments doesn't return) and then continues.
>
> However, in my final script, I need to capture any output returned
> by the external command, up to the point where the job gets killed,
> and this has proven harder than it initially looked.
>
> What I've tried so far:
>
> - written to a temporary file by using this spawn syntax:
>
> $job->spawn(undef, "iscsicli.exe", (), { stdout => "$$.output.txt" } );
>
> but this creates an empty file, I think because of a lack of
> autoflushing
>
> - tried to redirect STDOUT to a variable before calling the
> spawn() funtion, and enabling autoflush. Doesn't do the trick either,
> and I don't know how to reset STDOUT to the default afterwards.
>
> Could anyone please provide a working piece of code that
> can execute an external command, wait for it to finish yet kill
> the command if it takes too long, and still capture all the output
> (STDOUT and STDERR) up to the last line before it got killed.
> Ideally I would even like to do this without creating any temporary
> files. Thanks in advance!

Not particularly elegant since output is sent  to a file
via backticks but I succeeded in getting test program
output that occurs prior  to a 3 second timeout, eg:

use strict;
use warnings;
use Win32::Job;

my $job = Win32::Job->new;
my $timeout = 3;

   $job->spawn( $ENV{PERL},
   'perl.exe -e "system q{c:/temp/test.pl>out.tmp 2>&1}"'
 );
   $job->run($timeout);
   __END__

-
test.pl:
#!perl
print "line1\n";
sleep 1;
warn "line1 to stderr\n";
sleep 5;
print "lastline\n";

-
The output file contains:
   line1
   line1 to stderr

--
Charles DeRykus



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




Re: Out of memory, HTML::TableExtract

2011-01-27 Thread C.DeRykus
On Jan 27, 3:29 am, jinstho...@gmail.com (Jins Thomas) wrote:
> On Thu, Jan 27, 2011 at 4:44 PM, C.DeRykus  wrote:
> > On Jan 26, 11:28 pm, jinstho...@gmail.com (Jins Thomas) wrote:
>
> > > Hi DeRykus
>
> > > Sorry for replying late.
>
> > > I was able to  test DB_File with your example, thanks. But i'm facing
> > > a problem. I'm not able to access multi dimensional array with this
> > > DB_File. Address is being stored just a string.
>
> > > Do we have some options where we can access multi dimensional arrays
> > > (like two dimensional array from html tables)
> > > 
>
> > MLDBM or MLDBM::Easy are options.   Also DBM::Deep.
>
> > --
> > Charles DeRykkus
>
> But MLDBM documentation talks only about hashes, no examples for arrays. So
> got confused.
>
>

DBM::Deep enables array DBM's.  See docs.
For ex:

  use DBM::Deep;
  my $db = DBM::Deep->new(
  file => "foo-array.db",
  type => DBM::Deep->TYPE_ARRAY
  );
  $db->[0] = "foo";
  ...

--
Charles DeRykus




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




Re: Redeclaration of variable [different scope]

2011-01-27 Thread C.DeRykus
On Jan 27, 1:51 am, r@aist.go.jp (Raymond Wan) wrote:
> Hi all,
>
> I was wondering if there is a way for Perl to give me a warning if I
> redeclare a variable in a different scope (and thus masking the outer
> one).  Just spent some time debugging this (which was obviously not my
> intention to give two variables the same name)...and I guess it is a
> silly mistake that I would do again and again.  :-)
>
> i.e.,  This gives a warning:
>
> my $foo = 0;
> my $foo = 1;
>
> But this works:
>
> my $foo = 0;
> {
>   my $foo = 1;
>
> }


Not that I'm aware of but you could use B::Xref  to
generate a cross reference.

perl -MO=Xref -wle 'my $foo=0; { my $foo = 1; }'
...
  $foo  i1, i1  < 2 instances of '$foo'

--
Charles DeRykus


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




Re: Out of memory, HTML::TableExtract

2011-01-27 Thread C.DeRykus
On Jan 26, 11:28 pm, jinstho...@gmail.com (Jins Thomas) wrote:
> Hi DeRykus
>
> Sorry for replying late.
>
> I was able to  test DB_File with your example, thanks. But i'm facing
> a problem. I'm not able to access multi dimensional array with this
> DB_File. Address is being stored just a string.
>
> Do we have some options where we can access multi dimensional arrays
> (like two dimensional array from html tables)
> 

MLDBM or MLDBM::Easy are options.   Also DBM::Deep.

--
Charles DeRykkus



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




Re: Lighttpd + FCGI = Socket not closing?

2011-01-24 Thread C.DeRykus
On Jan 21, 9:03 am, perl-l...@christophfriedrich.de wrote:
> Hi there,
>
> I'm using the FCGI module (version 0.67) and a lighttpd
> to create an imageserver.
>
> But currently I have the problem that if I
> shutdown the lighttpd server, the perl processes are still there with an
> open file descriptor to the socket.
>
> There are not a child process
> anymore and are only killable.
>
> Here some code:
>
> #!/usr/bin/perl
>
> use
> strict;
> use warnings;
>
> use FCGI;
>
> my $handling_request = 0;
> my
> $exit_requested = 0;
>
> my $request = FCGI::Request();
>
> sub sig_handler {
>
> $exit_requested = 1;
>  if ( !$handling_request ) {
>  $request->Flush();
>
> $request->Finish();
>  exit( 0 );
>  }
>
> }
>
> $SIG{USR1} =
> &sig_handler;
> $SIG{TERM} = &sig_handler;
> $SIG{PIPE} = 'IGNORE';
>
> # Main
> function
> sub do_request {
>  $request->Flush();
>
> $request->Finish();
>
> }
>
> while ( $handling_request = ( $request->Accept()>= 0 ) ) {
>
>  &do_request;
>
>  $handling_request = 0;
>  last if
> $exit_requested;
>
> }
>
> $request->Flush();
> $request->Finish();
>
> exit( 0
> );
>
> Here is the lighttpd config (only fastcgi section):
>
> fastcgi.server = ( "" =>
>  ((
>  "max-procs" => 1,
>  "socket" =>
> "/tmp/img.promobil.de.fcgi.socket",
>  "bin-path" =>
> "/home/friedrich/public_html/promobil/trunk/imageserver/imageserver.pl",
>
> "check-local" => "disable",
>  "allow-x-send-file" => "enable",
>  ))
>  )
>
> I
> don't know why the perl processes hung there and do not exit...
>
> Here
> also some output of lsof (from such a process):
 [ snip ]

Just a shot in the dark but what is the reason for ignoring
SIGPIPE...?

--
Charles DeRykus


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




Re: Lines per page $= varible

2011-01-20 Thread C.DeRykus
On Jan 20, 9:40 am, cstinem...@cricketcommunications.com (Chris
Stinemetz) wrote:
> I am having difficulty using $= correctly to change the number of lines per 
> page. I would like to set it to 600 but can't seem to get $= =600 to work 
> correctly.
>
> Any insight is greatly appreciated.
>
> Thank you,
>
> Chris Stinemetz
>
>     1 #!/usr/bin/perl
>     2
>     3  Smart Phone Perl Script for parsing EVDOPCMD data  
>     4  
>     5  Always room for improvement 1/17/2011              
>     6
>     7 use warnings;
>     8 #use strict;
>     9 use FileHandle;
>    10
>    11
>    12 format RAW_TOP =
>    13 @
>    14  "##--> Smart Phone report.  <--##",
>    15  Market      ESN/MIN          Mobile         Cell    Sector    Bytes
>    16 ==
>    17 .
>   18
>    19
>    20 format RAW =
>    21 @ @|| @|| @ @ @|||
>    22 $mkt,$mtype,$smartPhone,$cell,$sector,$rlptxat
>    23 .
>    24
>    25 # SmartPhone type Hash based on ESN or MEID HEX number
>    26 my %smartPhone = (
>    27    "CURVE850" => { start => "a01ca64E38",
>    28                    end   => "a0255c29c0", },
>    29    "KYOM6000" => { start => "a012b71b00",
>    30                    end   => "a012fef1a0", },
>    31    "CURVE850" => { start => "001388",
>    32                    end   => "001770", },
>    33    "Huawei"   => { start => "a0130fa7d0",
>    34                    end   => "001770", },
>    35 );
>    36
>    37  Market assignment Hash based on cell number
>    38 my %marketInfo = (
>    39     MCI => { start => 1,
>    40              end   => 299, },
>    41     STL => { start => 300,
>    42              end   => 599, },
>    43     ICT => { start => 800,
>    44              end   => 850, },
>    45 );
>    46
>    47 sub getSmartPhone {
>    48
>    49    my $val = shift;
>    50    foreach my $k (keys %smartPhone) {
>    51       my ($start, $end) = @{$smartPhone{$k}}{qw/start end/};
>    52       return $k if $start ge $val and $val le $end;
>    53    }
>    54
>    55    return "";
>    56 }
>    57
>    58
>    59 sub getMarket {
>    60
>    61    my $val = shift;
>    62    foreach my $k (keys %marketInfo) {
>    63      my ($start, $end) = @{$marketInfo{$k}}{qw/start end/};
>    64      return $k if $start <= $val and $val <= $end;
>    65    }
>    66
>    67    return "";
>    68 }
>    69 open(RAW, ">test.rpt");
>    70 while (<>) {
>    71    chomp;
>    72    if (/;/) {
>    73       @data = split /;/;
>    74    if ($data[31] =~ m/^-?\d+$/) {   regular expression for real 
> numerical value
>    75       $mkt = getMarket($data[31]);
>    76    }
>    77    else
>    78    {
>    79       $mkt = "";
>    80    }
>    81
>    82    if ( length($data[5]) > 12) {
>    83       $smartPhone = getSmartPhone(substr($data[5],2,14));
>    84    }
>    85    else
>    86    {
>    87       $smartPhone = "";
>    88    }
>    89
>    90
>    91      ($mtype,$cell,$sector,$rlptxat) = 
> ($data[5],$data[31],$data[32],$data[44]);
>    92 #     print "$mkt\t  $mtype\t $smartPhone\t  $cell\t  $sector\t  
> $rlptxat\n";
>    93    write(RAW);
>    94    }
>    95 }
>    96
>    97 select(RAW);
>    98 close(RAW);

perlform is a distant memory but are you setting per
the example in perlvar:

HANDLE->format_lines_per_page(EXPR)
$FORMAT_LINES_PER_PAGE
$=  The current page length (printable lines) of the currently
selected output channel. Default is 60. Used with formats.
(Mnemonic: = has horizontal lines.)

See: perldoc perlvar

In your case:

 use IO::Handle;
 ...
 RAW->format_lines_per_page(600);


--
Charles DeRykus


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




Re: how to trap print() errors?

2011-01-18 Thread C.DeRykus
On Jan 17, 3:45 pm, dpchr...@holgerdanske.com (David Christensen)
wrote:
> Ron Bergin wrote:
> > It's interesting that you found the warning message to be meaningless,
> > but the exact same message was helpful when you told the pragma to
> > raise the level of warnings to be fatal.
> > I should have said nearly the same message.  Both messages told you where
> > the problem was located and with that info it should have been easy to
> > find/fix the problem.  In my mind that's not meaningless.
>
> The root cause problem is that "perldoc -f print" does not describe what
> happens on error.  I've filed a perlbug report to this effect.
>

Actually it does this... as you discovered in the doc:

Prints a string or a list of strings. Returns true if
successful...

In this case, $! is EBADF or "Bad file descriptor" which might
be due to some obscure OS error unknown to perl. So perl
can't necessarily pinpoint the exact cause with a meaningful
message at this stage but at least first warns you about the
unopened  filehandle. (and that unopened filehandle warning,
as it turns out,  is certainly a cause of  EBADF).

And I'd agree that the docs should mention $! as perl does
here:

unlink  Deletes a list of files. On success, it returns the
  number of files it successfully deleted. On failure,
  it returns false and sets $! (errno):

And  many other perl i/o docs omit mention that  $! gets
set and  if there's failure such as truncate, stat, link, ...

However,  $! may be generic and dying on an earlier warning
may not always be particularly meaningful in explaining what's
really happening as it did in your case.


--
Charles DeRykus


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




Re: doubt in substring

2011-01-12 Thread C.DeRykus
On Jan 12, 8:27 pm, sunita.prad...@altair.com ("Sunita Rani Pradhan")
wrote:
> Hi All
>
>             I have a string as; $str =  "the cat sat on the mat" .
>
> How the following command works substr($str , 4, -4)  on the string ?
> What should be the output?
>

See: perldoc -f substr

Check the docs first  for explanations and examples of any
Perl builtin function.

--
Charles DeRykus


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




Re: Out of memory, HTML::TableExtract

2011-01-07 Thread C.DeRykus
On Jan 5, 10:56 pm, jinstho...@gmail.com (Jins Thomas) wrote:
> Hi experts,
>
> Have you ever experienced Out of memory problem while using
> HTML::TableExtract. I'm having little large html files, still i didn't
> expect this to happen
>
> Would you be able to suggest some workarounds for this. I'm using this
> subroutine in another for loop.
>
   [snip]

Using a DBM may help as you grow arrays. The DBM
will trade memory for disk. A very simple example:

   use DB_File;
   ...
   tie @ldata, 'DB_File', 'ldata.dbm'
  or die " tie failed: $!"


If HTML::TableExtract itself is using too much memory,
you may be able to replace it with a lighter regex that
you devise on your own to pull out the table data.  But
this will be reliable only if the HTML is known to be
generated  programmatically for instance so there's no
variance.

--
Charles DeRykus






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




Re: Out of memory, HTML::TableExtract

2011-01-06 Thread C.DeRykus
On Jan 5, 10:56 pm, jinstho...@gmail.com (Jins Thomas) wrote:
> Hi experts,
>
> Have you ever experienced Out of memory problem while using
> HTML::TableExtract. I'm having little large html files, still i didn't
> expect this to happen
>

If the html files are really big, HTML::TableExtract might be
filling memory. If that's the problem and  the html output
is being generated by a program in fixed format, you may
need to parse the html  yourself with a regex.

Another possible strategy, if your own arrays are filling
memory, is to use a DBM to offload memory to disk.
For an example:  perldoc DB_File

--
Charles DeRykus

--





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




Re: automation frameworks

2011-01-05 Thread C.DeRykus
On Jan 5, 5:44 am, sunita.prad...@altair.com ("Sunita Rani Pradhan")
wrote:
> Hi All
>
> Could you please let me know , if anybody using any automation framework
> for their automation testing or any types information about automation
> framework ?
>
> Note: Perl scripting should be used in that framework .
>

You might want to take a look at Selenium. There's a
Client interface from CPAN. See:  WWW::Selenium.

--
Charles DeRykus


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




Re: Behavior of Regex modifier /x

2010-12-27 Thread C.DeRykus
On Dec 27, 2:34 pm, paragka...@gmail.com (Parag Kalra) wrote:
> Hi,
>
> I was under the impression that regex modifier '/x' ignores the white
> space. So in following script both the if-else blocks should print
> "Match" since the strings differ only in white space and '/x' should
> ignore the white space.
>
> But looks like my understanding of '/x' is wrong. Could someone please
> correct me and explain the below behavior.
>
> #!/usr/bin/perl
> use strict;
> use warnings;
> my $str = "Hello World";
> my $str2 = "Hello World";
> my $str3 = "Hello    World";
>
> if($str =~/$str2/x){
>     print "Match\n";} else {
>
>     print "No Match\n";
>
> }
>
> if($str =~/$str3/x){
>     print "Match\n";} else {
>
>     print "No Match\n";
>
> }

There's a twist that may be confusing though.  Double
quote interpolation occurs first before further regex
parsing proceeds.

So, for instance,  /$str2/x  gets interpolated and  the
regex parser now sees  'Hello World'. After stripping
whitespace because of /x, that becomes  'HelloWorld'.

Therefore 'Hello World' doesn't match 'HelloWorld' and
'No Match' is the result.

--
Charles DeRykus


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




Re: Fwd: Re: Writing 3D games with Perl... How's the Performance?

2010-12-27 Thread C.DeRykus
On Dec 25, 2:21 am, shlo...@iglu.org.il (Shlomi Fish) wrote:
> --  Forwarded Message  --
>
> Subject: Re: Writing 3D games with Perl...  How's the Performance?
> Date: Friday 24 December 2010, 12:43:11
> From: Shlomi Fish 
> To: beginn...@perl.org
> CC: "U.N." 
>
>   [snip]
>
> > I realize that comparing Java and Perl is like comparing Apples and
> > Oranges, but since they are both interpreted I would guess that they
> > both share a similar performance handicap.
>
> Jave is also not interpreted. Like Perl it is compiled to bytecode, but unlike
> Perl, this bytecode can be executed directly from the disk (e.g: its .class
> files), and, furthermore, many Java implementation contain an additional
> optimisation step called Just-in-time compilation (JIT):
>
> http://en.wikipedia.org/wiki/Just-in-time_compilation
>
> This improves the performance considerably, and as a result, Java code tends
> to run much faster than the equivalent Perl one. (Though many people feel Java
> has other performance issues such as being "sluggish", where Perl fares
> better.).

I don't doubt that Java - especially with JIT -  can be
faster than Perl for some tasks... but "much faster"...?
Do you have a citation?

And I seem to recall Perl being faster than Java in many
areas, particularly, if there's heavy text processing and
performing equivalently if there's lots of I/O.  Perhaps
that's no longer the case (or maybe bias has warped my
memory).

--
Charles DeRykus





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




Re: about glob

2010-12-16 Thread C.DeRykus
On Dec 16, 2:56 am, practicalp...@gmail.com (practicalperl) wrote:
> This has been confused me:
>
> [an...@localhost tmp]$ ls
> [an...@localhost tmp]$ perl -le'print glob("foo.3")'
> foo.3
>
> there is nothing in the tmp directory.
> but why glob("foo.3") returns the string?
>
> $ perl -v
>
> This is perl, v5.8.8 built for i686-linux
>

There weren't any  matches with files and no wildcards
in the glob pattern so the pattern itself is returned *.  If
there had been a wildcard in the pattern, then nothing
would have been returned.

perl -E "say glob('foo.3')"   <--- returns foo.3 *
perl -E "say glob('foo?3)"   <--- doesn't return anything

   *  You'd have to use bsd_glob in order to  not return
   the pattern if no files match, eg:
  use File::Glob ':glob';
  say bsd_glob('foo.3',GLOB_ERR);

  Otherwise, if there had been a file "foo.3" with an
  actual '.' in the filename, glob('foo.3') would also
  return that filename.

Perl uses File::Glob for globbing since 5.6.1 and  only
these metacharacters are recognized:

  \   Quote the next metacharacter
  []  Character class
  {}  Multiple pattern
  *   Match any string of characters
  ?   Match any single character
  ~   User name home directory

For more detail: perldoc File::Glob

Perhaps, you were thinking '.' was also a glob wildcard
as it  would be in a regex pattern...

--
Charles DeRykus


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




Re: Echo perl one-liner intact

2010-12-15 Thread C.DeRykus
On Dec 15, 8:05 am, redt...@gmail.com (Mike Martin) wrote:
> Hi
>
> I am trying pass a perl one-liner to at intact eg:
>
> echo 'perl -mLinux::DVB::DVBT -e 'my
> $dvb=Linux::DVB::DVBT->new(O_NONBLOCK,'O_RDONLY');$dvb->set_frontend('frequency'
> => '497167000','tsid' => '4222');my $file="/storage/burn/testol";my
> $ref={pmt=>'10'};$dvb->set_demux(101,102);$dvb->record($file,"00:10",$ref);
> '
>
> The aim is to run the one-liner from at
>
> However echo strips the quotes so the command fails to run
>
> any ideas or alternative approaches

Are you sure about the constructor args...?

   --> $dvb=Linux::DVB::DVBT->new(O_NONBLOCK,'O_RDONLY')

Isn't  Fcntl missing?  Why a quoted O_RDONLY?

--
Charles DeRykus


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




Re: web::scraper xpath

2010-12-13 Thread C.DeRykus
On Dec 9, 10:00 am, ag4ve...@gmail.com (shawn wilson) wrote:
> i decided to use another module to get my data but, i'm having a bit
> of an issue with xpath.
>
> the data i want looks like this:
>
> 
>  
>   
>    name
>    attribute
>
>    name2
>    attribute2
>
>    possible name3
>    possible attribute3
>
>    
> 
>    
> more of the same format
>
> with this code, i'm only getting the first line of data (ie,  ...
> ). i realize that i'm only getting the first and second td which
> is fine, but how do i get multiple rows? i'm also grabbing the html
> from a file so that i don't needlessly keep hitting up their web
> server.
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> use LWP::UserAgent;
> use LWP::Simple;
> use Web::Scraper;
> use Data::Dumper::Simple;
>
> my( $infile ) = $ARGV[ 0 ] =~ m/^([\ A-Z0-9_.-]+)$/ig;
>
> my $pagedata = scraper {
>    process '//*/tab...@class="someclass"]', 'table[]' => scraper {
>       process '//tr/td[1]', 'name' => 'TEXT';
>       process '//tr/td[2]', 'attr' => 'TEXT';
>    };
>
> };
>
> open( FILE, "< $infile" );
>
> my $content = do { local $/;  };
>
>    my $res = $pagedata->scrape( $content )
>       or die "Can't define content to parser $!";
>
> print Dumper( $res );

I don't get XML::Scraper but, alternatively with XML::LibXML,
a possible way:

use XML::XPath;
use XML::LibXML;

my $parser = XML::LibXML->new;
my $content = $parser->parse_file( $infile);

my @nodes =
   $content->findnodes("//tabl...@class='someclass']/tbody/tr" );

foreach my $node ( @nodes ) {
 print XML::XPath::XMLParser::as_string($node);
}

output:

 
 name
 attribute

 name2
 attribute2

 possible name3
 possible attribute3

 

--
Charles DeRykus


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




Re: Regexp delimiters

2010-12-08 Thread C.DeRykus
On Dec 7, 9:38 am, p...@utilika.org (Jonathan Pool) wrote:
> > Well, I have no idea why it does what it does, but I can tell you how to 
> > make it work:
> > s¶3(456)7¶¶$1¶x;
> > s§3(456)7§§$1§x;
>

Oops, sorry, yes there is:

c:\>perl -Mutf8 -wE
"say $^V,$^O;$_='123456789';s§3(456)7§$1§;say"
Malformed UTF-8 character (unexpected continuation byte 0xa7,
   with no preceding start byte) at -e line 1.
Malformed UTF-8 character (unexpected continuation byte 0xa7,
   with no preceding start byte) at -e line 1.

v5.12.1MSWin32
1245689

--
Charles DeRykus



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




Re: Regexp delimiters

2010-12-08 Thread C.DeRykus
On Dec 7, 9:38 am, p...@utilika.org (Jonathan Pool) wrote:
> > Well, I have no idea why it does what it does, but I can tell you how to 
> > make it work:
> > s¶3(456)7¶¶$1¶x;
> > s§3(456)7§§$1§x;

Oops. yes there is:

c:\>perl -Mutf8 -wE
"say $^V,$^O;$_='123456789';  s§3(456)7§$1§;say"
Malformed UTF-8 character (unexpected continuation byte 0xa7, with no
preceding
start byte) at -e line 1.
Malformed UTF-8 character (unexpected continuation byte 0xa7, with no
preceding
start byte) at -e line 1.
v5.12.1MSWin32
1245689

--
Charles DeRykus


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




Re: Regexp delimiters

2010-12-08 Thread C.DeRykus
On Dec 7, 9:38 am, p...@utilika.org (Jonathan Pool) wrote:
> > Well, I have no idea why it does what it does, but I can tell you how to 
> > make it work:
> > s¶3(456)7¶¶$1¶x;
> > s§3(456)7§§$1§x;
>

Hm, what  platform and perl version?

No errors here:

  c:\>perl  -wE "say $^V,$^O;$_='123456789';s§3(456)7§$1§;say"
  v5.12.1MSWin32
  1245689

[...]

--
Charles DeRykus


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




Re: Why can't print accept a comma between arguments ?

2010-11-29 Thread C.DeRykus
On Nov 29, 4:33 am, bourne.ident...@hotmail.com (Manish Jain) wrote:
> [...]
>     print(hndw, $nextline);                  #problem here
>
> }
>
> But perl refuses to take a comma between hndw and $nextline, and consequently 
> I have to rewrite it as : print hndw $nextline;
>

That's because 'print' is a list operator and will gobble up all
items in parenthesis as list items.  Perl  disambiguates  the
optional filehandle by insisting that no comma follow it.

Otherwise, there's a conflation of the filehandle with the
list that follows it. Perl doesn't know if you intend a string
'STDERR' or the the STDERR filehandle and so dies with
with the fatal, but helpful, error:

   perl -wle "print(STDERR,'this is an error')"
   No comma allowed after filehandle at -e line 1.

But, perl will still do the right thing if there really
is a list:

   perl -wle "$str='string';print($str, ' bar baz')"
   string bar baz

And the following is  ok because you omitted that pesky
comma and perl :

   perl -wle "print(STDOUT  'this is not an error')"
   this is not an error


> But this is much less intuitive to me as a C programmer. Perl's syntactical 
> rules in general leave a lot to be desired : the syntax actually is overly 
> flexible and can confound people familiar with structured code. This 
> particular case of print is an example of something that should work by logic 
> but does not.  

Not if you understand what perl's list operator does. For
further info, see:  perldoc perlop and read about the list
operator.

--
Charles DeRykus                                        


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




Re: Monitoring ssh connectivity to a server using perl !

2010-11-23 Thread C.DeRykus
On Nov 23, 8:29 am, learn.tech...@gmail.com (Amit Saxena) wrote:
> Hi all,
>
> What's the best way to monitor ssh connectivity, and not just ssh port
> availability, to a server using perl assuming following constraints ?
>
> I tried for Net::SSH but public private key is not allowed.
>
> I tried for Net::SSH::Perl etc but these are not built in perl distribution
> (active perl on windows or part of perl distribution of linux / solaris).
>
> Can we do it via "IO::Socket::INET" ?
>

You may want to consider Net::SSH2 which, although
only SSH2 is supported, is much easier to build.

I notice there's a  Win32  perl-5.12 Net::SSH2 pre-
built available from:

   http://cpan.uwinnipeg.ca/PPMPackages/12xx/

You just have to add the additional repository to your
Activestate distro as I recall before doing the ppm
install.

I've built Net::SSH2 on both Linux and Solaris in the
past too. Net::SSH::Perl is another possibity  but
quite challenging and I wouldn't recommend it unless
you've got lots of time and tenacity.

--
Charles DeRykus


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




Re: How to filter out { } block in text file

2010-11-16 Thread C.DeRykus
On Nov 16, 1:54 pm, vincent.mc...@gmail.com (Vincent Li) wrote:
> On Tue, Nov 16, 2010 at 1:11 PM, Shawn H Corey  wrote:
>
> > On 10-11-16 04:07 PM, Vincent Li wrote:
>
> >> My aim is to remove specific profile.*{} block from that file
>
> > Yes, but if the {} blocks are nestable, then you can't do it with regular
> > expressions alone.
>
> right, I only have one level nested {}, any tips? when file is slurped
> to file mode, the nested {} will look like 'profile foo  { foo  { foo} foo  
> }profile bar  { bar  { bar } bar  }profile goo { goo } ', I
>
> tried regex:
>
> {.*?(?:{.*?})?.*?}
>
> but it is not working.


If the file is strictly formatted and there's no interior
nesting, you could even avoid slurping. Example:

  perl -nle 'print unless /^vlan vlan10 {$/ .. /^}$/'
   infile  > file_with_no_vlan10

See: perldoc perlop (range operator  "flip-flop")

--
Charles DeRykus


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




Re: Bit testing

2010-11-14 Thread C.DeRykus
On Nov 14, 1:11 am, shlo...@iglu.org.il (Shlomi Fish) wrote:
> Hi Charles,
>
> On Sunday 14 November 2010 01:47:36 C.DeRykus wrote:
>
> > On Nov 11, 11:27 pm, c...@pobox.com (Chap Harrison) wrote:
> > Not lots shorter but you could use a closure to hide
> > the calculation:
>
> > my $mask;
> > for my $flags ( ... ) {
> >      $mask = sub { return ($flags & $_[0]) == $_[0] }
> >             unless $mask;
> >      given( $flags ) {
> >             when ( $mask->($one_and_three)  ) { ... }
> >             when ( $mask->($zero_and_four)   ) { ... }
> >             ...
> >      }
> > }
>
> This won't work properly because the closure traps the initial value of
> "$flags". For example:
>
> [code]
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> my $closure;
>
> foreach my $name (qw(Sophie Jack Charles Dan Rachel))
> {
>     $closure = sub { print "Hello $name!\n" ; } unless $closure;
>
>     $closure->();}
>
> [/code]
>
> This prints "Hello Sophie!" five times. Either redeclare the closure on every
> iteration, or declare it once while using a more outer lexical variable.

Right... or simply get rid of the statement qualifier
'unless $closure' which'll work too and is what you'll
have to do in any case.
(technically, you could declare 'my $closure' both
in/outside the loop leaving the statement qualifier
as is but that's horrible )

You could just 'my $closure' solely inside the loop
too.

Declaring once outside the loop with an outer lexical
seems  less satisfactory since it loosens the 'tightest
lexical scope' best practice.

--
Charles DeRykus


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




Re: Bit testing

2010-11-14 Thread C.DeRykus
On Nov 13, 3:47 pm, dery...@gmail.com ("C.DeRykus") wrote:
> On Nov 11, 11:27 pm, c...@pobox.com (Chap Harrison) wrote:
>
>
>
> > I'm almost embarrassed to ask this, but I can't figure out a simple way to 
> > construct a switch ('given') statement where the 'when' clauses involve 
> > bit-testing.
>
> > Here's the only way I've figured out to build a switch statement that does 
> > the trick.  It seems unusually wordy, which makes me think there must be a 
> > simpler way to test for certain bit combinations.  Any suggestions?
>
> > Thanks,
> > Chap
>
> > #!/usr/bin/perl                                                             
> >                                                                             
> >                                                  
>
> > use strict;
> > use warnings;
> > use feature ":5.10";
>
> > # Here are masks for various bit combos of interest:                        
> >                                                                             
> >                                                   
>
> > my $one_three        = 0b1010; # bits 1 and 3 (counting from 0, right 
> > to left)                                                                    
> >                                                     
> > my $zero_four        = 0b00010001; # bits 0 and 4                           
> >                                                                             
> >                                                  
> > my $five             = 0b0010; # bit 5                                  
> >                                                                             
> >                                                   
>
> > # Here we will test several bit fields for bit combos of interest:          
> >                                                                             
> >                                                   
>
> > for my $flags ( 0b10111010, 0b10111000, 0b10010010) {
>
> >     my $asbits = sprintf("0b%08b", $flags); # prepare bits for 
> > pretty-printing                                                             
> >                                                                
>
> >     given ( $flags ) {
> >         when ( ($_ & $one_three) == $one_three ) {  # bits one and three 
> > are on                                                                      
> >                                                     
> >             say "$asbits has bits 1 and 3";
> >         }
> >         when ( ($_ & $zero_four) == $zero_four ) { # bits zero and four are 
> > on                                                                          
> >                                                   
> >             say "$asbits has bits 0 and 4";
> >         }
> >         when ( ($_ & $five) == $five ) { # bit five is on                   
> >                                                                             
> >                                                  
> >             say "$asbits has bit 5";
> >         }
> >         default {
> >             say "$asbits has no interesting bit patterns.";
> >         }
> >     }
>
> > }
>
> Not lots shorter but you could use a closure to hide
> the calculation:
>
> my $mask;
> for my $flags ( ... ) {
>      $mask = sub { return ($flags & $_[0]) == $_[0] }
>             unless $mask;
>      given( $flags ) {
>             when ( $mask->($one_and_three)  ) { ... }
>             when ( $mask->($zero_and_four)   ) { ... }
>             ...
>      }
>
> }

Oops,  right.

The closure could've/should've been declared w/o
a statement qualifier.  And now it seems a little bit
inelegant to redefine the closure each time through
the loop.


 for my $flags ( ... ) {
  my $mask = sub { return ($flags & $_[0]) == $_[0] };
  given( $flags ) {
   when ( $mask->($one_and_three)  ) { ... }
   when ( $mask->($zero_and_four)   ) { ... }
   ...
  }
...

 --
Charles DeRykus

Re: Bit testing

2010-11-13 Thread C.DeRykus
On Nov 11, 11:27 pm, c...@pobox.com (Chap Harrison) wrote:
> I'm almost embarrassed to ask this, but I can't figure out a simple way to 
> construct a switch ('given') statement where the 'when' clauses involve 
> bit-testing.
>
> Here's the only way I've figured out to build a switch statement that does 
> the trick.  It seems unusually wordy, which makes me think there must be a 
> simpler way to test for certain bit combinations.  Any suggestions?
>
> Thanks,
> Chap
>
> #!/usr/bin/perl                                                               
>                                                                               
>                                              
>
> use strict;
> use warnings;
> use feature ":5.10";
>
> # Here are masks for various bit combos of interest:                          
>                                                                               
>                                               
>
> my $one_three        = 0b1010; # bits 1 and 3 (counting from 0, right to 
> left)                                                                         
>                                                
> my $zero_four        = 0b00010001; # bits 0 and 4                             
>                                                                               
>                                              
> my $five             = 0b0010; # bit 5                                    
>                                                                               
>                                               
>
> # Here we will test several bit fields for bit combos of interest:            
>                                                                               
>                                               
>
> for my $flags ( 0b10111010, 0b10111000, 0b10010010) {
>
>     my $asbits = sprintf("0b%08b", $flags); # prepare bits for 
> pretty-printing                                                               
>                                                              
>
>     given ( $flags ) {
>         when ( ($_ & $one_three) == $one_three ) {  # bits one and three are 
> on                                                                            
>                                               
>             say "$asbits has bits 1 and 3";
>         }
>         when ( ($_ & $zero_four) == $zero_four ) { # bits zero and four are 
> on                                                                            
>                                                 
>             say "$asbits has bits 0 and 4";
>         }
>         when ( ($_ & $five) == $five ) { # bit five is on                     
>                                                                               
>                                              
>             say "$asbits has bit 5";
>         }
>         default {
>             say "$asbits has no interesting bit patterns.";
>         }
>     }
>
> }

Not lots shorter but you could use a closure to hide
the calculation:

my $mask;
for my $flags ( ... ) {
 $mask = sub { return ($flags & $_[0]) == $_[0] }
unless $mask;
 given( $flags ) {
when ( $mask->($one_and_three)  ) { ... }
when ( $mask->($zero_and_four)   ) { ... }
...
 }
}

--
Charles DeRykus


Re: reference of an array into an array

2010-11-04 Thread C.DeRykus
On Nov 4, 2:16 am, christian1...@gmx.net ("Christian Stalp") wrote:
> Hello together,
> I try to write some arrays into arrays using references.
>
> my ($a, $b, $c, @mytemp, $myref, @my_globael_array)
>
> while(<$myfile>)
> {
>    ($a, $b $c ) = getparameter();
>   �...@mytemp = ($a, $b, $c);
>    $myref = \...@mytemp;
>    push(@my_global_array, $myref);
>
> }
>
> But if I dismantle @my_global_array I get only the last entry, the last array.
>
> Where is the problem?

You're pushing a hard ref  to @mytemp into the global
array each time. But \...@mytemp is at the same memory
address during the loop and consists of individual ref's --
\$a,\$b,$\c -- whose underlying values $a,$b,$c change
with  each iteration  of the loop.   So, when the loop ends,
you just  have ref's to the final loop values.

One solution: declare @mytemp within -- rather than outside --
the loop. This allocates new memory for @mytemp during
each loop iteration to prevent overwriting.

 while(<$myfile>)
   {
   ($a, $b $c ) = getparameter();
   my @mytemp = ($a, $b, $c);
   ...


--
Charles DeRykus


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




Re: redirect STDERR

2010-11-02 Thread C.DeRykus
On Nov 2, 5:06 pm, bryan_r_har...@raytheon.com (Bryan R Harris) wrote:
> I have these lines in my script:
>
> **
> for my $handle (*STDIN, *STDERR) {
>     open($handle, "+ /dev/null: $!.  Exiting.\n";
>
> }
>
> # open outfile for further recording
> open(STDOUT,">$outfile") or die "$me:  Couldn't open $outfile:  $!\n";
> $| = 1;         # and don't buffer it
> **
>
> I decided I want STDERR to also be redirected to the same outfile as STDOUT
> instead of sending it to /dev/null.  Is that possible?
>

perldoc perlopentut   and look for:Re-Opening Files (dups)

--
Charles DeRykus


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




Re: Regular expression: Search a pattern but starting from the end of a string?

2010-11-02 Thread C.DeRykus
On Nov 2, 3:50 am, h...@risoe.dtu.dk ("Larsen, Henning Engelbrecht")
wrote:
> I want to search a string for patterns but starting the search from the
> _end_ instead of from the beginning, using a regular expression.
>
> For instance I want to find the last 'E' in the string
>
> ...looong string possibly with many E's...E.no capital e'
> here...3456
>
> The regular expression E$ will match an 'E' but only if it is at the
> very end. That's not the (only) match I want - also the E in '...E123'
> should match.
>
> One obvious solution is to reverse the string and use normal methods to
> find the first 'E', but there must be smarter ways, as this appears to
> be a relatively common problem to solve. Isn't it?
>

There's no way to force the regular expression engine to
shift into reverse. Even reversing the string  isn't likely to
be a win unless match(es) are near the end and the
operand is big.

One possibility though, if you're matching globally and
know the match is near the end is to set pos() to skip
over the initial postions:

pos($string) = 38;
print "found at ",pos($string) while $string =~ m/E/g;

Depending on what you're trying to do, the  'rindex'
solution that was mentioned is probably faster and
easier.

--
Charles DeRykus


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




Re: Object introspection + adding method - SOLVED

2010-10-26 Thread C.DeRykus
On Oct 23, 2:37 pm, da...@davidfavor.com (David Favor) wrote:

 [omitted]


> > Just be sure you know what you are doing.  Adding a method to somone else's
> > class can be considered rude.  See the NOTE in perldoc perlmodlib.
>
> sub add_class_method {
>      my($class,$name,$code) = @_;
>      no strict 'refs';
>      ${$class . '::'}{$name} = $code;
>
> }
>
> sub somewhere_in_da_code {
>
> ... ... ...
>
>      my $class = 'Qpsmtpd::Transaction';
>      my $name  = 'test_method';
>      my $code  = \&test_method;
>
>      add_class_method($class,$name,$code);
>
>      # all three of these invocations works correctly
>      test_method($self);
>      &$code($self);
>      $self->test_method;
^^^

Hm,  beware however that 5.12.1 (Strawberry perl)  fails
on the last  invocation:
 
 no strict 'refs';
 # ${$class . '::'}{$name} = $code;# fails
 *{"${class}::$name"} = $code;# succeeds
   }

Here's the error I saw:

Cannot convert a reference to CODE to typeglob at ...

'use diagnostics' explanation:

(F) You manipulated Perl's symbol table directly, stored
a reference in it, then tried to access that symbol via
conventional Perl syntax. The access triggers Perl to
autovivify that typeglob, but it there is no legal conversion
from that type of reference to a typeglob.

The direct typeglob assignment works but  P.Johnson's
solution  is preferable to avoid the symbolic ref.

--
Charles DeRykus


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




Re: perl code help

2010-10-25 Thread C.DeRykus
On Oct 25, 9:21 am, simssa...@gmail.com (saran) wrote:
> i am new to perl. please help me with this piece of code below.
> answer wat it prints is correct but the format has to adjusted...!
> program to convert Celsius to Fahrenheit
> **
> #!/usr/bin/perl
> use warnings;
> use strict;
>
> print "Celsius to Fahrenheit Conversion\n";
> print "Enter the value of Celsius to be converted:";
>
> my $c = ;
> my $f = ($c*1.8) + 32;
> print "$c"."C is equal to ", "$f","F","\n"
>
> ***
> Output
>
> Celsius to Fahrenheit Conversion
> Enter the value of Celsius to be converted:40
> 40
> C is equal to 104F
> *
>
> why does "C is equal to 104F" prints on a new line rather than "40 C
> is equal to 104F"
> on a single line...
> please help

See:  perldoc -f chomp

my $c = ;  # or chomp( my $c = )
chomp $c;
...


--
Charles DeRykus


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




Re: Object introspection + adding method - SOLVED

2010-10-24 Thread C.DeRykus
On Oct 23, 2:37 pm, da...@davidfavor.com (David Favor) wrote:
> Paul Johnson wrote:

  [snip]

>      add_class_method($class,$name,$code);
>
>      # all three of these invocations works correctly
>      test_method($self);
>      &$code($self);
>      $self->test_method;
>
> }

Hm,  strawberry perl 5.12.1 generates a fatal error
with the last however:   $self->test_method

Cannot convert a reference to CODE to typeglob at ...
   (F) You manipulated Perl's symbol table directly, stored
  a reference in it, then tried to access that symbol
  via conventional Perl syntax. The access triggers
  Perl to autovivify that typeglob, but it there is no
  legal conversion from that type of reference to a
  typeglob.

 Uncaught exception from user code:
Cannot convert a reference to CODE to typeglob at ...

However, the more direct assignment to the typeglob
works:
  
 # ${$class . '::'}{$name} = $code;   #  error
 *{"${class}::$name"} = $code;#  works

--
Charles DeRykus


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




Re: map HoAoA

2010-10-13 Thread C.DeRykus
On Oct 13, 9:40 am, mike.j...@nethere.com (Mike McClain) wrote:
> On Wed, Oct 13, 2010 at 08:33:57AM +0200, Shlomi Fish wrote:
>
> 
>
> > On Wednesday 13 October 2010 06:39:03 Mike McClain wrote:
> > > Why do @arrays and @seconds not have the same number of elements?
> > >     my @arrays =
> > >         map
> > >         { @{ $HoAoA{$_} } [ 0..$#{ $HoAoA{$_} } ] }
> > >         keys %HoAoA ;
>
> > This is equivalent to:
> > map { @{$HoAoA{$_} } } keys(%HoAoA);
>
> > Which flattens all the arrays into one big list. It can be written better 
> > as:
> > map { @$_ } values(%HoAoA);
>
> Thanks I hadn't seen that.
>
> > >     my @seconds =
> > >         map  { @{ $HoAoA{$_} } [ 0..$#{ $HoAoA{$_} } ]->[1] }
> > >         keys %HoAoA ;
>
> > That's wrong. What it does is create an array, evaluate it in scalar context
> > and then trying to use it as an array refand extract the second element. 
> > Doing
> > @{$array_re...@indices]->[$idx] is a strange construct which makes no sense.
>
> It's right because it complies and executes with no errors.
> It's only wrong because it doesn't give me what I wanted.
> What I still don't understand is why it gives me what it does.
>

It's easier to understand what went wrong by reviewing
the arrow operator (see: perlref)
...
$arrayref->[0] = "January";   # Array element
$hashref->{"KEY"} = "VALUE";  # Hash element
$coderef->(1,2,3);# Subroutine call

The left side of the arrow can be any expression
returning  a reference, including a previous deref...
  ^^

and the comma operator (see: perlop)

Binary "," is the comma operator. In scalar context it
evaluates its left argument, throws that value away,
then evaluates its right argument and returns that value.
...

In your case,  the left side is an array slice which
generates  a list of values. Because the context is
scalar, the comma operator reduces the expanded
slice list down to [ qw/bc1 bc2/] for the 2nd key for
instance. That just  happens to be a reference so
the arrow operator is happy.  Ditto for the first key
too:

 1st key: [qw/ab1 ab2/]->[1]---> ab2
 2nd key:[qw/bc1 bc2/ ]->[1]--->  bc2



A simpler pair of examples might help:

 # ok because the comma op reduces the slice to a ref
 perl -Mstrict -wle "my @a=([1,2],[3,4]);print @a[0..$#a]->[1]"
 4

 # fails because the last element isn't a ref
perl -Mstrict -wle "my @a=([1,2],'foo');print @a[0..$#a]->[1]"
Can't use string ("foo") as an ARRAY ref while "strict refs" ...
.

--
Charles DeRykus


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




Re: Trap syntax error inside eval?

2010-10-01 Thread C.DeRykus
On Sep 30, 9:07 pm, jon.herman...@gmail.com (Jon Hermansen) wrote:
rg/>
>
> ...
>
>  Thanks for the help. I was able to find a few workarounds with your
> examples. I found something interesting in my testing-- at the end of my
> sub, if instead of:
>
> return 1 unless ($@);
>
>
> I use:
>
> if (not $@) {return 1;}
>
>
>
> OR
>
> return 1 if (not $@);
>
>
>
> the syntax error does not get printed out. I assumed that these statements
> were logically equal, so, what gives?

I'm not sure. As Ruud mentioned,  the return value of
the eval -- rather than $@ -- is the key.  If, for instance,
you still are using a __DIE__ handler and aren't careful,
it could potentially wipe out the original $@ message:

  $ret =  eval {
  local $SIG{__DIE__} = sub { ... ; die;};

   ...  # parse error  here and $@ gets set
  1;
};

Now, however,  $@ could be empty even though the eval {}
failed with a parse error. See: perldoc -f eval for more
explanation.

So, you'd need to post some more code to determine what
went wrong.

--
Charles DeRykus


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




Re: perl net::ssh module

2010-09-30 Thread C.DeRykus
On Sep 30, 5:19 am, irfan_sayed2...@yahoo.com (Irfan Sayed) wrote:
> Hi,
>
> I am using net::ssh module of Perl to connect to remote machine and execute 
> some
> remote commands
> i can connect using user-name and password hard coded in the script like 
> below:
>
> #!/usr/local/bin/perl
>
> use strict;
> use Net::SSH::Perl;
> my $host="dna-ci2.data.corp.sp1.xxx.com";
> my $cmd="ls";
> my $user="abc";
> my $pass="123";
> my $ssh = Net::SSH::Perl->new($host);
>     $ssh->login($user,$pass);
>     my($stdout, $stderr, $exit) = $ssh->cmd($cmd);
> #print "$stdout\n";
> #print "$stderr\n";
> print "$exit\n";
>
> but now i need to use the "identity file" instead of simply putting plan text
> password in the script due to security issue
> can someone please point me how to achieve this
>

Doesn't the 'identity_files' parameter handle this...

[ See the named parameters options of the %params
  hash which gets passed to new() ]

--
Charles DeRykus


--
Charles


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




Re: Trap syntax error inside eval?

2010-09-30 Thread C.DeRykus
On Sep 30, 7:37 pm, jon.herman...@gmail.com (Jon Hermansen) wrote:
> Hey all,
> I have this block of code:
>
> sub is_valid_xml {
>
> >     my ($content) = @_;
>
> >     eval {
> >         my $xs = XML::Simple->new();
> >         my $ref = $xs->parse_string($content);
> >     };
>
> >     return 1 unless ($@);
> > }
>

block eval will already trap fatal errors and set
$@ and return the undefined value or an empty
list depending on context. If there's no error,
then the value of the last expression evaluated
is returned.  See: perldoc -f eval

So, one possibility:

 sub is_valid_xml {

 my ($content) = @_;

 my $ret =  eval {
  my $xs = XML::Simple->new();
  my $ref = $xs->parse_string($content);
  1;   # ensure true value if no fatalities
 };
 return $ret;
 }

then just call the sub in scalar context and
check for an error:

is_valid_xml( "blah")  or die "invalid: $@";

> and when I pass in 'blahblahblah' as an argument, I get:
>
> syntax error at line 1, column 0, byte 0 at /usr/lib/perl5/XML/Parser.pm
>
> > line 187
>
> I would like to trap this syntax error, but don't know how. I've tried each
> of these statements individually:
>
> local $SIG{'__DIE__'};
>
> > local $SIG{'__WARN__'};
> > no warnings 'all';

check 'perldoc -f eval' for additional info if you're trying to
trap warnings too.

--
Charles DeRykus


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




Re: Returing exit status in perl

2010-09-24 Thread C.DeRykus
On Sep 23, 9:42 am, soorajspadmanab...@gmail.com (Sooraj S) wrote:
> Hi,
>
> In my perl script p1 i am calling another script p2 which logs into a
> remote machine and executes a script p3. The $file defined in p3 does
> not exist. So copy operation in p3 will error out with error code 256
> and p3 stops execution with exit staus 256. But p2 is not able to
> recieve this value. I need the value 256 in p2. Could any one help me
> to sove this..
>
> p1
> ===
> 
> 
> system(p2 $opt);
> if ($? == 0) { print "success"; }
> elsif ($? == 1) { print "failure"; }
> else { print "Undefined exit status"; }
> 
> 
>
> p2
> ===
> use Net::Telnet;
>
> $t = new Net::Telnet();
> $t->open("machine");
> $t->login("user","paswd");
> $t->cmd("p3 $flag");
> $t->close();
>
> print "Check : $?";                            // prints $? value as
> 0;
> if ($? == 0) { exit(0); }
> elsif ($? == 1) { exit(1); }
> else { exit($?); }
>
> p3
> ===
> my $file  = "/hom/user/file";
> .
> ..
> system(cp -rf $file $backup);
>
>
> .
> 

Couldn't you capture/parse Net::Telnet output:

p3
==
system( ... );
unless($? ==0) {
print "Failed to create the back up with exit_status $? ..."
...
} else {
print "success...";
}

p2
==
...
$output = $t->cmd("p3 $flag");
unless ( $output =~ /^success/ ) {
 ...
 exit 1;
}


--
Charles DeRykus


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




Re: Interrupt Handling

2010-09-22 Thread C.DeRykus
On Sep 22, 11:04 am, gk.kalipuray...@gmail.com (Gopal Karunakar)
wrote:
> Hi,
>
>    Here's the code pasted below. The sub basically executed an anonymous
> pl/sql block (which is executing fine). I want to make sure that the user
> will not be able to a ctrl-c and exit at the stage where the sql statements
> are getting executed.
>
>    I tried declaring it as local but even then its hanging when i give the
> interrupt.
>  ...

Sorry, I'm not sure where the problem is then.  Did you
try googling in case it's an sqlplus/Oracle related bug or
quirk..?

If nothing turns up, you might try timing out the query.
See 'perldoc -q timeout'.

--
Charles DeRykus


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




Re: Interrupt Handling

2010-09-22 Thread C.DeRykus
On Sep 22, 6:53 am, gk.kalipuray...@gmail.com (Gopal Karunakar) wrote:

>         I used the $SIG{'INT'} = 'IGNORE'; in a sub in my script so that the
> script while executing the particular sub will ignore the ctrl-c. And I gave
> $SIG{'INT'} = 'DEFAULT'; at the end of the sub to reset the behavior back to
> normal.

Presuming your signal setting is the default on entry to
the sub,  you can just use local to temporarily set the
interrupt:

   sub foo { local $SIG{INT} = 'IGNORE'; ... }

The interrupt signal will be ignored for the scope of
the sub. When the sub ends, the interrupt setting
returns to its prior value.

> But when i give the ctrl-c the process seems to be hanging and I
> have to kill the process from the prompt. Is there any way to avoid getting
> this behavior?? When i give the ctrl-C the script should just ignore it and
> continue the process. I am on Sun Solaris box and using Perl version 5.8.7.
>

Are you sure there's only one exit point from the sub... ?
That's a possible scenario which could bypass your
$SIG{'INT'} = 'DEFAULT' reset at the end of the sub.
(BTW, that's another advantage to using 'local')

Show of the code too.  You can just pull out some of
the relevant lines to give everyone a better view of the
crime scene.  It's much easier to spot what might be
happening.

--
Charles DeRykus


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




Re: Incorrect handling of very small doubles?

2010-09-21 Thread C.DeRykus
On Sep 21, 3:16 am, shlo...@iglu.org.il (Shlomi Fish) wrote:
> A few comments about this code (which is derived from the old code):
>
> On Tuesday 21 September 2010 08:40:41 Jon Hermansen wrote:
>
> > Hi Abu,
> >  This code works for me:
>
> > #!/usr/bin/perl
>
> Add strict and warnings:
>
> http://perl-begin.org/tutorials/bad-elements/
>
> > my $d1, $d2, $sum;
>
> If you did, you know you would have to do:
>
> my ($d1, $d2, $sum);
>
> Although doing my $d1 = ...; my $d2 = ... is better.
>
>
>
> > $d1 = 6.892964 * 10 ** -309;
> > $d2 = 1.102874 * 10 ** -307;
>
> Generally, the m * 10 ** e notation is not needed, but it seems to be a bug in
> perl 5. I'll consult the perl5-porters about it.
>

Looks like there's a fix in place - works fine here:

osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
uname='Win32 strawberryperl 5.12.1.0 #1 Thu Jul 29 10:08:11 2010
i386'

--
Charles DeRykus


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




Re: Interrupts handling in perl

2010-09-14 Thread C.DeRykus
On Sep 14, 2:52 am, soorajspadmanab...@gmail.com (Sooraj S) wrote:
> Hi,
>
> My perl script internally calls some other scripts. The execution time
> of the script is 5 min. I dont want any user to stop or suspend the
> execution. ie I want my script to ignore the (ctrl+z) and (Ctlr+c)
>
> By adding the following line to my script i was able to prevent user
> from stopping my script using (Ctlr+c)
> $SIG{INT} = 'IGNORE';
>
> Is there any way to handle Ctlr+z ?

Ctrl+z normally generates a  SIGTSTP on Unix so
if $^O is Unix based, you should be able to use:

{
# code block you don't want to be interrupted
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   ...
}
# resume code that is ok to interrupt

[ You could also set both signals at once:
   local @SIG{INT,TSTP} = ('IGNORE') x 2;  ]

On the other hand if $^O is Win32 based, you
probably want to take a look at Win32::API.

--
Charles DeRykus


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




Re: script to connect windows box from linux

2010-09-02 Thread C.DeRykus
On Sep 2, 10:11 am, lel...@claimspages.com ("Lonnie Ellis") wrote:
> You can also turn on the telnet service within Windows rather than using
> SSH.  If you want to use SSH, openSSH is a good alternative for Windows,
> but you'll have to install Cygwin on the Windows box.  Google it, you
> should find what you need.  Another option would be to install Perl on
> the Windows box, the script would run on the Windows box, redirect
> output to a text file, and then copy it to the Linux machine with script
> via SMB or NFS share.

Alternatively for the Win32-to-Linux file copy:

PuTTy is a good tool  and  includes pscp to enable
scripted scp ("secure copy").

--
Charles DeRykus






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




Re: How to test Output when using IPC::Open3

2010-08-31 Thread C.DeRykus
On Aug 29, 10:46 pm, ole...@gmail.com (marcos rebelo) wrote:
> We are out of contest in here.
>
> I know how to run open3, but I don't know how to test it. Repeating
>

Hm,  I just wanted to warn you that Open3 may
easily require more paranoia than you've shown...
your sample is simple enough to escape problems
but deadlock often lurks, especially if lots of data is
sent down the pipe. IO::Select can help with this.

Meanwhile,  I made a few tweaks to your program
which now works for me (at least on FreeBSD).

* Take a look at the Test::Trap reviews on CPAN,
   for useful info on the the 'use Test::Trap ...' import
   list,  especially Shlomi's.

--
Charles DeRykus

use strict;
use warnings;

use IPC::Open3;
use IO::Handle;
use Test::More;
use Test::Trap qw(
   trap $trap
   :flow
   :stderr(systemsafe)
   :stdout(systemsafe)
   :warn
);

$| = 1;

sub shell_run {
my ($stdin, $stdout, $stderr) = map {IO::Handle->new} (0..2);

print  "";

open3($stdin, $stdout, $stderr, @_);

close( $stdin ) or die "close: $! $@";

foreach my $line ( ( defined $stderr ? <$stderr> : () ),
   ( defined $stdout ? <$stdout> : () )  )
{
print $line;
}

print  "";

close ( $stderr ) if defined $stderr;
close ( $stdout ) if defined $stdout;

}

trap {shell_run('perl', '-e', 'print "TEXT IN"')};

is( $trap->stdout, "TEXT IN");

done_testing();
__END__

-> ok 1
 1..1


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




Re: How to test Output when using IPC::Open3

2010-08-29 Thread C.DeRykus
On Aug 28, 10:42 pm, ole...@gmail.com (marcos rebelo) wrote:
> the idea is to process the STDOUT ad the STDERR.
>
> open don't do it
>

I was afraid you'd say that...

open3 is very liable to deadlock since you're trying to read from
both stderr and stdout.  You'll very likely want to use IO::Select
to marshal when the read's occur and search for some sample
code.

>
> On Sun, Aug 29, 2010 at 6:08 AM, John W. Krahn  wrote:
>
>
>
> > C.DeRykus wrote:
>
> >> Since you mention simplifying the code, do you actually
> >> need IPC::Open3 ?  In your sample code, you're only
> >> reading process output.
>
> >> If you don't need IPC::Open3 complexity, you could just
> >> use magic open to read output :
>
> >> sub shell_run
> >> {
> >>     print "";
> >>     my $pid = open( my $fh, qq{ @_ | } )  or die "open: $!";
>
> > Probably better as:
>
> >      my $pid = open my $fh, '-|', @_ or die "open: $!";


In general yes but here I don't think there's a benefit.
I believe perl will bypass  the shell in both cases since
a list is passed. And, IIRC,  perl launches a shell only
after parsing to see if it's absolutely required.


>
> > And you don't use $pid anywhere so why create it?

Agreed, I was trying to guage the OP's intention more
than cleaning up all the code.

>
> >>     print for<$fh>;
>
> > Probably better as:
>
> >      print while <$fh>;

Hm, I'd prefer 'while' as well but, though it may look odd, I
don't think there's been the  penalty of 'for <$fh>' creating
and then iterating  through a potentially large list  for some
time.

>
> >>     close $fh  or die "close: ", $? || $!;
>
> > Probably better as:
>
> >      close $fh or die $! ? "Error closing pipe: $!"
> >                          : "Exit status $? from $_[0]";

Definitely better. A child error might mask an
error for a full disk.

--
Charles DeRykus


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




Re: How to test Output when using IPC::Open3

2010-08-28 Thread C.DeRykus
On Aug 28, 12:45 am, ole...@gmail.com (marcos rebelo) wrote:
> I'm having a more or less complicated code, that was simplified to this.
>
> use strict;
> use warnings;
> use IPC::Open3;
> use IO::Handle;
> use Test::More;
> use Test::Trap;
>
> sub shell_run {
>     my ($stdin, $stdout, $stderr) = map {IO::Handle->new} (0..2);
>
>     print "";
>
>     open3($stdin, $stdout, $stderr, @_);
>
>     foreach my $line (<$stdout>, <$stderr>) {
>         print "read: $line";
>     }
>
>     print "";
>
> }
>
> trap {shell_run('perl', '-E', 'print "TEXT IN"')};
>
> #is( $trap->stdout, "");
> is( $trap->stdout, "TEXT IN");
>
> done_testing();
>
> I would expect to have the test 'is( $trap->stdout, "TEXT
> IN");' executing ok, instead of that I have the test 'is(
> $trap->stdout, "");'.
>
> I need to test the output inside the loop in there, I have tried allot
> of solution but I just don't get it

Since you mention simplifying the code, do you actually
need IPC::Open3 ?  In your sample code, you're only
reading process output.

If you don't need IPC::Open3 complexity, you could just
use magic open to read output :

sub shell_run
{
print "";
my $pid = open( my $fh, qq{ @_ | } )  or die "open: $!";
print for <$fh>;
close $fh  or die "close: ", $? || $!;
print "";
}
trap { shell_run( 'perl', '-E', '"print \'TEXT IN\'"' ) };
is( $trap->stdout, "TEXT IN");
done_testing();

-->   ok 1
   1..1

--
Charles DeRykus


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




Re: How can I open a remote ssh session with perl

2010-08-25 Thread C.DeRykus
On Aug 24, 12:28 pm, frase...@gmail.com (Brian Fraser) wrote:
> On Tue, Aug 24, 2010 at 11:08 AM, Peter Scott  wrote:
> > CPAN: Net::SSH::Perl .
>
> I had a similar issue not too long ago; Spent a couple of days attempting to
> get Net::SSH::Perl to compile properly, gave up, went to CPAN, found
> [Net::SSH::Expect][0]; So far so good, so here's a recommendation.
>
> [0]http://search.cpan.org/~bnegrao/Net-SSH-Expect-1.09/lib/Net/SSH/Expec...


Another option is Net::SSH2 which, although it supports only SSH2,
is much easier to build than Net::SSH::Perl.

--
Charles DeRykus


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




Re: Env::Sourced - false error

2010-08-17 Thread C.DeRykus
On Aug 17, 1:35 am, nora.hac...@stgkk.at ("HACKER Nora") wrote:
> Hi,
>
> Sorry for the late answer, I was kept busy at work and had no time to
> dig in ...
>
> > IIUC, couldn't you just set oraenv directly at runtime:
>
> >     $oraenv = "$w_conf/ora$orapat.env"; # coalesce path + filename
> >      ^
> >     $ENV{ oraenv } =  "$w_conf/ora$orapat.env";
>
> Charles, thanks for your answer - maybe I understood something wrong in
> the documentation for Env::Sourced?
> IIUC, with your above syntax I would set an environment variable with
> the name "oraenv" and the value of "$w_conf/ora$orapat.env" - but not
> read/set all the contents from my env-file.
>
> The docu says, the reading in of a file is done by "use Env::Sourced (qw
> /first/file/to/include.sh /second/file/to/include.sh);". Since I do not
> know the database version (and with it the version of the env-file I
> need) until sometime during the execution of my Perl programme, I can
> only "require Env::Sourced;" at the beginning and set (import) the
> environment later.
>

Hm, If you can't set oraenv directly at runtime,  delaying the
import will still work.

   require Env::Sourced;

...   # determine version, etc.

   Env::Sourced->import( qw{first/file/to/include.sh /second/file/to/
include.sh} );


The Env::Sourced import() does all the sourcing.  Here're the
relevant lines from the module source itself:

sub import
   {
   my $class = shift;
   ...

   #--> Loop through all of the files passed to the module and:
   #-->   1) Source the file, returning it's output as a hash
   #-->   2) Include the sourced files environment into the
current
   #-->  environment.  Any unchanged environment variables
should
   #-->  just be passed back to us as-is.
  my @envs;
  while(my $file = shift)
  {
carp("$file does not exist") unless(-e $file);



--
Charles DeRykus


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




Re: Regular expression question

2010-08-14 Thread C.DeRykus
On Aug 14, 6:28 am, dery...@gmail.com ("C.DeRykus") wrote:
> On Aug 13, 1:47 pm, tobias.wage...@googlemail.com (irata) wrote:
>
>
>
>
>
> > I want to replace in a javscript structure like the one below every
> > occurence of "{#...}", "{?...}", "{+...}" and "{=...}" through
> > something different (also nested):
> >    function() {
> >       test1 = "{#Caption}";
> >       test2 = "{#Te{?st}}";
> >       test3 = "{+date.{0}}";
> >    }
>
> > with this regular expression
> >   my( $open )   = qr/{[=+#?]/;
> >   my( $close )  = qr/}/;
> >   my( $not )    = qr/[^{}]++/;
> >   do {
> >      $found = $text =~ s/
> >       (
> >         $open
> >         (?: $not | (?1) )
> >         $close
> >       )
> >      /replace($1)/esxg;
> >   } while ( $found );
> > I can handle case "test1" and "test2" but the case "test3" won't work.
> > Could some help me how I can change the expression that it match
> > "{+date.{0}}" without bothering about the "{0}" (this could also be
> > "{foo}").
>
> > I try it with:
> >   my( $not ) = qr/(?>(?:(?!$open)|(?!$close))+)/;
> > but that won't work.
>
> [Your question would probably be better posted in
>     comp.lang.perl.misc]
>
> One good debugging technique to track what the regex
> engine is doing:   use re 'debug'
>
> I believe the problem is that once the inner {0} is found
> the recursion pattern fails because $open is  {[=+#?] and
> {0} won't match.
>
> You could perhaps make it work by checking whether
> you're recursing to alter the pattern accordingly:
>
> untested tweak:
>
> my( $open )   = qr/ (? (R) [=+#?] | [=+#?]? ) /x;
>

Good thing I wrote "untested".

Make that tweak:

my( $open )   = qr/{(? (R) [=+#?] | [=+#?]?)/;

--
Charles DeRykus


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




Re: Regular expression question

2010-08-14 Thread C.DeRykus
On Aug 13, 1:47 pm, tobias.wage...@googlemail.com (irata) wrote:

>
> I want to replace in a javscript structure like the one below every
> occurence of "{#...}", "{?...}", "{+...}" and "{=...}" through
> something different (also nested):
>    function() {
>       test1 = "{#Caption}";
>       test2 = "{#Te{?st}}";
>       test3 = "{+date.{0}}";
>    }
>
> with this regular expression
>   my( $open )   = qr/{[=+#?]/;
>   my( $close )  = qr/}/;
>   my( $not )    = qr/[^{}]++/;
>   do {
>      $found = $text =~ s/
>       (
>         $open
>         (?: $not | (?1) )
>         $close
>       )
>      /replace($1)/esxg;
>   } while ( $found );
> I can handle case "test1" and "test2" but the case "test3" won't work.
> Could some help me how I can change the expression that it match
> "{+date.{0}}" without bothering about the "{0}" (this could also be
> "{foo}").
>
> I try it with:
>   my( $not ) = qr/(?>(?:(?!$open)|(?!$close))+)/;
> but that won't work.
>

[Your question would probably be better posted in
comp.lang.perl.misc]

One good debugging technique to track what the regex
engine is doing:   use re 'debug'

I believe the problem is that once the inner {0} is found
the recursion pattern fails because $open is  {[=+#?] and
{0} won't match.

You could perhaps make it work by checking whether
you're recursing to alter the pattern accordingly:

untested tweak:

my( $open )   = qr/ (? (R) [=+#?] | [=+#?]? ) /x;


clear as mud?

--
Charles DeRykus


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




Re: Opposite benchmark results between Linux and Windows

2010-08-11 Thread C.DeRykus
On Aug 10, 8:43 am, r...@i.frys.com (Ron Bergin) wrote:
> While doing some benchmark testing on both Windows and Linux, the
> results of the exact same code was reversed.  A slight difference in
> the percentages is understandable, but I fail to see why the results
> would be reversed.  Could someone shed some light on this issue?
>
> First the benchmark results:
>
> C:\TEMP>timestamp.pl
>          Rate Matt  Ron
> Matt 162840/s   -- -37%
> Ron  257003/s  58%   --
>
> [r...@099vicidial101 ~]# ./timestamp.pl
>          Rate  Ron Matt
> Ron  110132/s   -- -29%
> Matt 155763/s  41%   --
>
> The code:
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
> use POSIX qw(strftime);
> use Benchmark qw(:all);
>
> my $count = 1_000_000;
>
> cmpthese($count, {
>     Matt => \&matt,
>     Ron  => \&ron,
>
> });
>
> sub matt {
>     my $now_date_epoch = time();
>     my $BDtarget = ($now_date_epoch - 5);
>     my ($Bsec,$Bmin,$Bhour,$Bmday,$Bmon,$Byear,$Bwday,$Byday,$Bisdst)
> = localtime($BDtarget);
>     $Byear = ($Byear + 1900);
>     $Bmon++;
>     if ($Bmon < 10) {$Bmon = "0$Bmon";}
>     if ($Bmday < 10) {$Bmday = "0$Bmday";}
>     if ($Bhour < 10) {$Bhour = "0$Bhour";}
>     if ($Bmin < 10) {$Bmin = "0$Bmin";}
>     if ($Bsec < 10) {$Bsec = "0$Bsec";}
>     my $BDtsSQLdate = "$Byear$Bmon$Bmday$Bhour$Bmin$Bsec";
>
> }
>
> sub ron {
>     my $BDtsSQLdate = strftime("%Y%m%d%H%M%S", localtime(time() -
> 5) );
>
> }

I think there was also a thread about string concatenation
being horrifically slow on comp.lang.perl.misc.

sprintf provides a substantial speedup...maybe less
malloc'ing on Win32. Fewer perl op's probably help
too:

  sub matt {
my $now_date_epoch = time();
my $BDtarget = ($now_date_epoch - 5);
my ($Bsec,$Bmin,$Bhour,$Bmday,$Bmon,$Byear) =
localtime($BDtarget);
$Byear = ($Byear + 1900);
$Bmon++;

my $BDtsSQLdate = sprintf "%4d%02d%02d%02d%02d%02d",
$Byear,$Bmon,$Bmday, $Bhour,$Bmin, $Bsec;
  }

 Rate Matt  Ron
Matt 323729/s   -- -13%
Ron  372717/s  15%   --

Matt 323834/s   -- -13%
Ron  370508/s  14%   --

Matt 323834/s   -- -13%
Ron  370508/s  14%   --

Matt 328731/s   -- -11%
Ron  370645/s  13%   --

--
Charles DeRykus


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




Re: file::fild with awk?

2010-08-08 Thread C.DeRykus
On Aug 8, 5:40 pm, student.northwest...@gmail.com (Jim Green) wrote:
> Hi,
> I used to use find, a for loop and awk to extract data from a list of
> files returned by find.
>
> Now I want to use file::find  and perl to this.
>
>  use vars qw/*name *dir *prune/;
>  *name   = *File::Find::name;
>  *dir    = *File::Find::dir;
>  *prune  = *File::Find::prune;
>
>  my $directories_to_seach="/home/jim";
>
>   sub wanted;
>
>   # Traverse desired filesystems
>   File::Find::find({wanted => \&wanted}, $directories_to_seach);
>   exit;
>
>   sub wanted {
>   /regex/s
>      && print("$name\n");
>   }
>
> my question is how to do in a native, elegant perl way for my bash
> script?
>
> for file in `find . -name "*pattern*"`
> do
>     zcat $file|awk '$2 == "BP" {print $17 $18}'|\
>     echo
> done

If you just need a quick look via the command line:

perl -MFile::Find -le 'find sub{print $File::Find::name if /
pattern/},"/my/dir" '  \
  | xargs zcat  | perl -lane 'print @F[16,17] if $F[1] eq "BP" '

--
Charles DeRykus


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




Re: add newline

2010-08-03 Thread C.DeRykus
On Aug 3, 7:10 am, chas.ow...@gmail.com ("Chas. Owens") wrote:
> On Tue, Aug 3, 2010 at 09:47, Chas. Owens  wrote:
> > On Tue, Aug 3, 2010 at 08:44, Shawn H Corey  wrote:
> >> On 10-08-03 06:43 AM, Rob Coops wrote:
>
> >>> Third you could of course when you are printing the values from the array
> >>> add the linefeeds:
> >>>  print join("\n", @myarray);
> >>> or
> >>>  foreach my $value ( @myarray ) {
> >>>   print $value . "\n";
>
> >> When printing, use a list; it's faster.
>
> >>    print $value, "\n";
> > snip
>
> > I hate it when some makes a blanket statement of "it's faster" without
> > providing a benchmark or a reason.  In the simple case, the comma is
> > slower than the period and interpolation is slower still.
>
> Whoops, accidentally sent too early.  My point was that even though
> concatenation is faster than pass a list or an interpolated string
> (contrary to the claim made earlier), it isn't really that much
> faster.  Especially once you factor in the cost of writing to disk
> (which the benchmark avoids to prevent noise).  Now, you might make
> the argument that the comma is clearer than the concatenation, but
> that point is debatable.  For one thing, these two statements are not
> identical:
>
> print "foo", "\n";
> print "foo" . "\n";
>
> The first will be affected by the value of $, and the second won't.
> The second will also benefit from compile time constant folding:
>
> perl -MO=Deparse -e 'print "foo" . "\n"'
> print "foo\n";
>
> perl -MO=Deparse -e 'print "foo", "\n"'
> print 'foo', "\n";
>
> Personally, I use string interpolation even though it is the slowest
> of the three methods.  I find string interpolation to be superior to
> passing a list because it is not affected by $, and more readable than
> having tiny periods floating around.  It also requires fewer
> characters on average (you usually have at least one set of double
> quotes in the expression already).

I agree totally.

>
> To sum up: if you are looking for something like this to speed up your
> program than you are well and truly hosed.  Choose a method that looks
> right to your team and has the right behavior.  Profile your code to
> find spots were you are slow and optimize those spots by changing the
> algorithm or moving code down a level to C (via XS or Inline::C), not
> by relying on folk-wisdom micro-optimizations.
>
> One item:
>             Rate string  comma period
> string 3588672/s     --    -3%   -11%
> comma  3714590/s     4%     --    -7%
> period 4014817/s    12%     8%     --
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> use Benchmark;
>
> open my $bit_bucket, ">", "/dev/null"
>        or die "$!";
>
> my $s = "foo";
>
> my %subs = (
>        string => sub { print $bit_bucket "$s\n"    },
>        comma  => sub { print $bit_bucket $s, "\n"  },
>        period => sub { print $bit_bucket $s . "\n" },
> );
>
> for my $sub (keys %subs) {
>        print "$sub: ", $subs{$sub}(), "\n";
>
> }
>
> Benchmark::cmpthese -1, \%subs;
>
> Ten items:
>             Rate string  comma period
> string 1052183/s     --    -1%    -2%
> comma  1061926/s     1%     --    -1%
> period 1071850/s     2%     1%     --
> ...

There was a recent thread about the slowness of
concatenation on Win32 (can't remember, maybe
a perl issue though).

Adding a couple of small tweaks for Win32 and
re-running  seems to confirm:

use File::Spec qw(devnull);

open my $bit_bucket, ">", File::Spec->devnull()
or die "$!";
...

Result:

   Rate   period string  comma
period453142/s --  -4%-6%
string 469903/s 4%--  -2%
comma  481771/s 6%3%--

--
Charles DeRykus


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




  1   2   >