[30611] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 1854 Volume: 11

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Sep 14 06:09:42 2008

Date: Sun, 14 Sep 2008 03:09:05 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Sun, 14 Sep 2008     Volume: 11 Number: 1854

Today's topics:
        check columns /tabs between two patterns <mstep@podiuminternational.org>
    Re: How to get Perlscript in ASP / IIS to execute comma <nospam@somewhere.com>
    Re: Minimal path <rvtol+news@isolution.nl>
    Re: Minimal path <jurgenex@hotmail.com>
    Re: Minimal path <jurgenex@hotmail.com>
    Re: Minimal path <rvtol+news@isolution.nl>
    Re: Minimal path <pilcrow6@gmail.com>
    Re: Minimal path <pilcrow6@gmail.com>
    Re: Minimal path <someone@example.com>
    Re: Minimal path <jurgenex@hotmail.com>
    Re: Minimal path (fidokomik\)
    Re: Requiring Lexical $_ / Obliterating Global $_? <m@rtij.nl.invlalid>
    Re: simple regex not working <john@castleamber.com>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Sun, 14 Sep 2008 02:20:45 -0700 (PDT)
From: Marek <mstep@podiuminternational.org>
Subject: check columns /tabs between two patterns
Message-Id: <72b4950d-d49c-43da-a6cc-1d7b9ce1ddfb@l43g2000hsh.googlegroups.com>



Hello all!


I have a tab separated text file. I want to check, whether the
contents are in the right fields. I have constructed here a little
example. Question is, how to check for right number of tabs between
"pattern" and "number" ... In my example, there is checked only one
wrong example. To be clear I take this example:

(pattern3)\t{4,}(number3)

this is checking 4 or more tabs between pattern3 and number3, which is
wrong. Only 3 tabs are right! So I have to check also for 2 tabs or 1
tab, which would be wrong too ...


Hope this was clear


best greetings marek


#! /usr/local/bin/perl

use warnings;
use strict;

while (<DATA>) {

    s/\s+#.+//;
    next if /^\s*$/;

    if (/(pattern1)\t{2,}(number1)\s*/i) {
        print
"Wrong number of tabs between \"$1\" and the number \"$2\" in the line:
\n\t$_\n\n";

    }
    elsif (/(pattern2)\t{3,}(number2)\s*/i) {
        print
"Wrong number of tabs between \"$1\" and the number \"$2\" in the line:
\n\t$_\n\n";

    }
    elsif (/(pattern3)\t{4,}(number3)\s*/i) {
        print
"Wrong number of tabs between \"$1\" and the number \"$2\" in the line:
\n\t$_\n\n";

    }
    else {

        print "\nno match!\n\n";

    }
}

__DATA__

pattern1	number1
pattern2		number2
pattern3			number3
pattern1		number1			 # wrong number of tabs (2tabs)
pattern2			number2		 # wrong number of tabs	(3tabs)
pattern3				number3	 # wrong number of tabs	(4tabs)
pattern2	number2		 		 # wrong number of tabs (1tab)
pattern3		number3	                 # wrong number of tabs	(2tabs)






------------------------------

Date: Sat, 13 Sep 2008 21:25:54 -0400
From: "Thrill5" <nospam@somewhere.com>
Subject: Re: How to get Perlscript in ASP / IIS to execute command line system calls
Message-Id: <pZCdncHQlp2_9VHVnZ2dnUVZ_r_inZ2d@comcast.com>

"Jürgen Exner" <jurgenex@hotmail.com> wrote in message 
news:p8bnc41g9gubailn0s2daa0okvfaegtseb@4ax.com...
> Michael Vilain <vilain@NOspamcop.net> wrote:
>> Jack <jack_posemsky@yahoo.com> wrote:
>>> These system calls work find in the .pl world, but in IIS when
>>> Perlscript is running inside of an ASP webpage, nothing happens.  I
>>> changed the folder properties under IIS to give "script source access"
>>> and added "write" permissions, but still it doesnt seem to work.. any
>>> ideas out there ?
>>>
>>>                 $syscall0 = "move e:\\tmp\\file1.jpg e:\\file1.jpg ";
>>> system("$syscall0");
>>
>>Is there a "shell" environment on XP?  I don't count the DOS "shell".
>
> That is of course your choice. Perl however doesn't let prejudices get
> in the way and works with the DOS command interpreter without problems.
>
>>You might want to try a UNIX-compatible environment like Cygwin.  But my
>>guess is you're out of luck.  You'll have to rethink this code for the
>>XP environment.
>
> BS. As the OP said himself explicitely:
> "These system calls work find in the .pl world"
> Obviously there is no problem with perl calling DOS commands via
> system().
>
> He should rethink this code because there is no good reason to shell out
> an action for which there is a perfectly fine Perl command. Why not use
> rename() in the first place?
>
> However I have a hunch that that won't help him either because the
> problem seems to be related to IIS/ASP rather then to Perl on XP. As the
> mantra says:
> <quote from  "My CGI script runs from the command line but not the
> browser.">
>            If you can demonstrate that you've read the following FAQs
> and
>            that your problem isn't something simple that can be easily
>            answered, you'll probably receive a courteous and useful
> reply
>            to your question if you post it on
>            comp.infosystems.www.authoring.cgi (if it's something to do
> with
>            HTTP, HTML, or the CGI protocols). Questions that appear to
> be
>            Perl questions but are really CGI ones that are posted to
>            comp.lang.perl.misc may not be so well received.
> </quote>
>
> jue

ASP (and IIS) are "locked down" for security purposes.  ASP under IIS is 
usually run using the security context "ASPNET" and does not have access to 
your "system32" directory where "cmd.exe" is located.  Perl programs run 
under ASP therefore can't execute any "shell" commands because it can't 
locate or load a command processor.   As previous poster said, you should 
direct your question to an IIS newsgroup and 
"microsoft.public.inetserver.iis" would be a good place to start. 




------------------------------

Date: Sat, 13 Sep 2008 19:47:29 +0200
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: Minimal path
Message-Id: <gah5qg.1i8.1@news.isolution.nl>

Petr Vileta (fidokomik) schreef:
> Dr.Ruud:
>> Petr Vileta:

>>> I have array of paths an I need to extract minimal path commont to
>>> all of these. Exple
>>> my @paths=('/vra/test/aaa/', '/var/test/bbb', '/var/test/ccc');
>>> my $minpaths = minpath@paths);
>>> print $minpath;
>>> 
>>> The result shouu be '/var/test/'
>> 
>> Use each part as a key in a H(oH)+, then traverse the datastructure
>> until keys > 1;
>> 
>> A quick+ugly way to build it:
>> 
>> perl -MData::Dumper -wle'
>>  my %h;
>>  for (@ARGV) { s~^/~\$h{~; s~/?$~}~; s~/~}{~g;
>>                print; eval "$_=1 unless exists $_" }
>>  print Dumper \%h;
>> ' /var/test/aaa/ /var/test/bbb /var/test/ccc/ddd /var/test
>> [...]
> 
> Well, but how to get string '/var/test/' as result of this function?

As I described: traverse the datastructure until keys > 1

$ perl -MData::Dumper -wle'
  my %h;
  s~^/~\$h{~,
  s~/?$~}~,
  s~/~}{~g,
  eval "$_=1 unless exists $_",
      for @ARGV;
  my ($k, @p, @k) = (\%h, "");
  push(@p, $k[0]), $k = $k->{$k[0]} while 1 == (@k = keys %{$k} );
  { local $" = "/"; print "@p" }
' /var/test/aaa/ /var/test/bbb /var/test/ccc/ddd /var/test

/var/test

-- 
Affijn, Ruud

"Gewoon is een tijger."


------------------------------

Date: Sat, 13 Sep 2008 11:08:45 -0700
From: Jürgen Exner <jurgenex@hotmail.com>
Subject: Re: Minimal path
Message-Id: <450oc4hobnlpm79k25ad097vunaopskj9o@4ax.com>

"Dr.Ruud" <rvtol+news@isolution.nl> wrote:
>Petr Vileta (fidokomik) schreef:
>
>> I have array of paths an I need to extract minimal path commont to
>> all of these. Exple
>> my @paths=('/vra/test/aaa/', '/var/test/bbb', '/var/test/ccc');
>> my $minpaths = minpath@paths);
>> print $minpath;
>>
>> The result shouu be '/var/test/'
>
>Use each part as a key in a H(oH)+, then traverse the datastructure
>until keys > 1;

Nice idea, takes advantages of Perl's powerful hashes.

However for a large data set you are creating a large data structure
which is expensive in time and memory. This is not necessary.

If you think about the underlying algebra then you will notice that
"GetLongestSubPath" is associative and therefore you can compute the
result incrementally. You only have to keep a single "best candidate" at
all times, just like when searching for the maximum value in a list.

jue


------------------------------

Date: Sat, 13 Sep 2008 11:44:42 -0700
From: Jürgen Exner <jurgenex@hotmail.com>
Subject: Re: Minimal path
Message-Id: <a42oc45566jie6733s1roivhg2vn9t72di@4ax.com>

"Petr Vileta \(fidokomik\)" <stoupa@practisoft.cz> wrote:
>> Petr Vileta (fidokomik) schreef:
>>> I have array of paths an I need to extract minimal path commont to
>>> all of these. Exple
>Well, but how to get string '/var/test/' as result of this function? Please take
>a look to next examples to see what I need to be returned from my hypotetical
>function minpath().
>
>Example1:
>my @paths=('/var/test/aaa/', '/var/test/bbb', '/var/test/ccc', '/var/test');
>print minpath( @paths );
>$> /var/test/
>
>Example2:
>my @paths=('/var/test/aaa/', '/var/test/bbb', '/var/test', '/var/other');
>print minpath( @paths );
>$> /var/
>
>Example3:
>my @paths=('/var/test/aaa/', '/var/test/bbb', '/home/test');
>print minpath( @paths );
>$> /
>
>I thinked up this code:


Ok, I didn't benchmark it but based on the algorithm design I doubt that
any other solution will be substantially faster let alone uses less
memory:

my $best = shift @paths;       #init current best with first path
my @best = split('/', $best); 

for (@paths) {
    next if (/^\Q$best\E/); #path does start with current best, keep it
    #otherwise path does not start with current best 
    #need to compute new current best
    my @this = split('/');
    for (my $i = 0; $i <= $#best; $i++) {#loop through dir names
top-down
	if ($best[$i] ne $this[$i]) { #difference in dir name found
	    $#best = $i -1;           #shorten @best as needed
	    $best = join '/', @best;  #rebuild shortened $best
	    last;                     #continue with next path
	}
    }
}
print "Longest common subpath = $best/\n";

jue


------------------------------

Date: Sun, 14 Sep 2008 00:14:20 +0200
From: "Dr.Ruud" <rvtol+news@isolution.nl>
Subject: Re: Minimal path
Message-Id: <gahl3n.1ks.1@news.isolution.nl>

Jürgen Exner schreef:

> Ok, I didn't benchmark it but based on the algorithm design I doubt
> that any other solution will be substantially faster let alone uses
> less memory:

Yes, nice approach.


> for (@paths) {
>     next if (/^\Q$best\E/); #path does start with current best, keep

There is a problem if $best doesn't end in a slash.
For example "/usr/local" and "/usr/locale".
So it needs a C<s#(?<!/)$#/# for @paths;> at the start.

An alternative for "/^\Q$best\E/" is "index($_, $best) == 0".

-- 
Affijn, Ruud

"Gewoon is een tijger."



------------------------------

Date: Sat, 13 Sep 2008 15:26:55 -0700
From: Pilcrow <pilcrow6@gmail.com>
Subject: Re: Minimal path
Message-Id: <mdfoc4hsik4lghgpk66jae21q2duo4fiha@4ax.com>

On Fri, 12 Sep 2008 00:40:33 -0700, Jürgen Exner <jurgenex@hotmail.com>
wrote:

>"Petr Vileta \(fidokomik\)" <stoupa@practisoft.cz> wrote:
>>I have array of paths an I need to extract minimal path commont to all of these.
>
>I bet you are not looking for the minimal (that would be just /) but the
>longest common path.
>If you consider that paths are just strings with special properties,
>then CPAN has a couple of modules to search for the longest common
>substring of two strings,
>http://search.cpan.org/search?query=common+substring&mode=all.
>You may need to adapt the found substring somewhat to accomodate e.g.
>/foo/bar1 and foo/bar2 where the desired result would be /foo and not
>/foo/bar as for a simple string.
>
>Longest common substring is one of the classic algorithmic problems (I
>am too lazy to search the usual suspects like Knuth, Sedgewick or Cormen
>et.al.), but your problem is much simpler anyway because your substring
>is always anchored to the beginning of the string.
>
>>Exple
>>my @paths=('/vra/test/aaa/', '/var/test/bbb', '/var/test/ccc');
>>my $minpaths = minpath@paths);
>>print $minpath;
>>
>>The result shouu be '/var/test/'
>>
>>I wrote some fuction to scan 1st, 2nd ... etc char of all array lines and 
>>collect to resutl string if all single chars are sthe same, but this is very 
>>slow. In extreme case @path array can contain thousands of values.
>
>Well, the algorithm should be linear, because for any two given paths
>you can determine the longest subset. The final result cannot be longer
>than that piece, so you just loop through all paths and shorten the
>smallest common denominator step by step.
>
>
>
>A totally different approach would be to not treat the paths as strings
>but to split() a path into a sequence of directory names and then
>compare those fragments using 'eq()', something along the line of 
>
>@best = split(+/+, $paths[0]); #initialization,
>		# first element is as good as any
>for (@paths) {
>	@this = split(+/+);
>	for ($i = 0; $i < $#best; $i++) {
>		if ($best[$i] ne $this[$i]) {#difference found
>			$#best = $i -1; #shorten @best as needed
>			last; #bail out and continue with next path
>		}
>	}
>}
>
>I'm sure there some edge cases and some off-by-one errors in that
>sketch, but I think the idea is sound.
>
>jue

Try this:

------------------------------------------------------------------------
use strict; use warnings;
my @least = ();
while(my $line=<DATA>) {
    chomp $line;
    my @line = split /\//,$line;
    shift @line;
    unless (@least) {
        @least = @line;
        next;
    }
    LOOP:{
            my $i = $#line; my $j = $#least;
            if($i == $j) { 
                for my $k(0 .. $i) {
                    unless ($line[$k] eq $least[$k]) {
                        for($k-1 .. $i-1){pop @line;}
                        for($k-1 .. $j-1){pop @least;}
                        last LOOP;
                    }
                }
                last LOOP;
            }elsif($i < $j) { 
                for($i .. $j-1){pop @least}
            }else{                       
                for($j .. $i-1){pop @line}
            }
            redo LOOP;
         }
}
my $res = "/".join "/", @least; 
print "$res\n"

__DATA__
/foo/data/sane/common/insane
/foo/data/sane/common
/foo/data/sane/common
/foo/data/sane/common/common/common
/foo/data/common/insane
------------------------------------------------------------------------

----
An MD will think either that the patient knows all about his 
condition, or that he's too stupid to understand the explanation.  
Either way, no communication results.


------------------------------

Date: Sat, 13 Sep 2008 16:10:54 -0700
From: Pilcrow <pilcrow6@gmail.com>
Subject: Re: Minimal path
Message-Id: <40ioc41d0ih5qcv2td49l884n5prl7tnab@4ax.com>

On Sat, 13 Sep 2008 11:44:42 -0700, Jürgen Exner <jurgenex@hotmail.com>
wrote:

>"Petr Vileta \(fidokomik\)" <stoupa@practisoft.cz> wrote:
>>> Petr Vileta (fidokomik) schreef:
>>>> I have array of paths an I need to extract minimal path commont to
>>>> all of these. Exple
>>Well, but how to get string '/var/test/' as result of this function? Please take
>>a look to next examples to see what I need to be returned from my hypotetical
>>function minpath().
>>
>>Example1:
>>my @paths=('/var/test/aaa/', '/var/test/bbb', '/var/test/ccc', '/var/test');
>>print minpath( @paths );
>>$> /var/test/
>>
>>Example2:
>>my @paths=('/var/test/aaa/', '/var/test/bbb', '/var/test', '/var/other');
>>print minpath( @paths );
>>$> /var/
>>
>>Example3:
>>my @paths=('/var/test/aaa/', '/var/test/bbb', '/home/test');
>>print minpath( @paths );
>>$> /
>>
>>I thinked up this code:
>
>
>Ok, I didn't benchmark it but based on the algorithm design I doubt that
>any other solution will be substantially faster let alone uses less
>memory:
>
>my $best = shift @paths;       #init current best with first path
>my @best = split('/', $best); 
>
>for (@paths) {
>    next if (/^\Q$best\E/); #path does start with current best, keep it
>    #otherwise path does not start with current best 
>    #need to compute new current best
>    my @this = split('/');
>    for (my $i = 0; $i <= $#best; $i++) {#loop through dir names
>top-down
>	if ($best[$i] ne $this[$i]) { #difference in dir name found
>	    $#best = $i -1;           #shorten @best as needed
>	    $best = join '/', @best;  #rebuild shortened $best
>	    last;                     #continue with next path
>	}
>    }
>}
>print "Longest common subpath = $best/\n";
>
>jue

I bow my head in embarassment.
----
An MD will think either that the patient knows all about his 
condition, or that he's too stupid to understand the explanation.  
Either way, no communication results.


------------------------------

Date: Sat, 13 Sep 2008 17:34:20 -0700
From: "John W. Krahn" <someone@example.com>
Subject: Re: Minimal path
Message-Id: <c_Yyk.3539$Dj1.1632@newsfe01.iad>

Pilcrow wrote:
> 
> Try this:
> 
> use strict; use warnings;
> my @least = ();
> while(my $line=<DATA>) {
>     chomp $line;
>     my @line = split /\//,$line;
>     shift @line;
>     unless (@least) {
>         @least = @line;
>         next;
>     }
>     LOOP:{
>             my $i = $#line; my $j = $#least;
>             if($i == $j) { 
>                 for my $k(0 .. $i) {
>                     unless ($line[$k] eq $least[$k]) {
>                         for($k-1 .. $i-1){pop @line;}
>                         for($k-1 .. $j-1){pop @least;}
>                         last LOOP;
>                     }
>                 }
>                 last LOOP;
>             }elsif($i < $j) { 
>                 for($i .. $j-1){pop @least}
>             }else{                       
>                 for($j .. $i-1){pop @line}
>             }
>             redo LOOP;
>          }
> }
> my $res = "/".join "/", @least; 
> print "$res\n"
> 
> __DATA__
> /foo/data/sane/common/insane
> /foo/data/sane/common
> /foo/data/sane/common
> /foo/data/sane/common/common/common
> /foo/data/common/insane


my @least;
while ( <DATA> ) {
     chomp;
     my ( undef, @line ) = split /\//;
     @least or @least = @line and next;

LOOP:
     {   my ( $i, $j ) = ( $#line, $#least );
         if ( $i == $j ) {
             for my $k ( 0 .. $i ) {
                 unless ( $line[ $k ] eq $least[ $k ] ) {
                     splice @line,  $k - 1 - $i;
                     splice @least, $k - 1 - $j;
                     last LOOP;
                     }
                 }
             last LOOP;
             }
         else {
             splice @{ $i < $j ? \@least : \@line }, -abs $i - $j;
             }
         redo LOOP;
         }
     }

print join( '/', '', @least ), "\n"

__DATA__
/foo/data/sane/common/insane
/foo/data/sane/common
/foo/data/sane/common
/foo/data/sane/common/common/common
/foo/data/common/insane




John
-- 
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order.                            -- Larry Wall


------------------------------

Date: Sat, 13 Sep 2008 18:06:46 -0700
From: Jürgen Exner <jurgenex@hotmail.com>
Subject: Re: Minimal path
Message-Id: <5rooc4t3als4i6j0f2v2okqi1otp2pd9br@4ax.com>

"Dr.Ruud" <rvtol+news@isolution.nl> wrote:
>Jürgen Exner schreef:
>
>> Ok, I didn't benchmark it but based on the algorithm design I doubt
>> that any other solution will be substantially faster let alone uses
>> less memory:
>
>Yes, nice approach.
>
>
>> for (@paths) {
>>     next if (/^\Q$best\E/); #path does start with current best, keep
>
>There is a problem if $best doesn't end in a slash.
>For example "/usr/local" and "/usr/locale".

Good catch, didn't think of that.

>So it needs a C<s#(?<!/)$#/# for @paths;> at the start.
>
>An alternative for "/^\Q$best\E/" is "index($_, $best) == 0".

Wonder which one is faster....

jue


------------------------------

Date: Sun, 14 Sep 2008 03:57:14 +0200
From: "Petr Vileta \(fidokomik\)" <stoupa@practisoft.cz>
Subject: Re: Minimal path
Message-Id: <gahrdc$170h$1@adenine.netfront.net>

Thanks to everybody.

-- 
Petr Vileta, Czech republic
(My server rejects all messages from Yahoo and Hotmail. 
Send me your mail from another non-spammer site please.)
Please reply to <petr AT practisoft DOT cz>


-- Posted on news://freenews.netfront.net - Complaints to news@netfront.net --


------------------------------

Date: Sun, 14 Sep 2008 10:46:23 +0200
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: Requiring Lexical $_ / Obliterating Global $_?
Message-Id: <pan.2008.09.14.08.46.23@rtij.nl.invlalid>

On Sat, 13 Sep 2008 13:46:08 +0200, Peter J. Holzer wrote:

> I don't think so. In that case, if he forgets to declare $_ in a sub,
> the globally defined lexical $_ will be used, which isn't much of an
> improvement over using the predefined $_. In both cases the omission
> will not be noticed and two subs may inadvertently change the same $_.

You are right.

But then, where draw the line? Every block? Every sub? I can see the 
advantage of implicitly my-ing $_ in every sub, but it's not very logical 
in my eyes.

The question by the OP, forbidding to use global $_, is a definite 
improvement, still leaves room for errors, but would be worthwhile none 
the less.

M4


------------------------------

Date: 13 Sep 2008 23:51:29 GMT
From: John Bokma <john@castleamber.com>
Subject: Re: simple regex not working
Message-Id: <Xns9B18BFD5885CBcastleamber@130.133.1.4>

"John" <john1949@yahoo.com> wrote:

> I'm trying to match a string beginning a letter A to R followed by any 
> letter (from S to Z) or any digit.
> 
>  if ($x =~ /([A-Ra-r][S-Zs-z0-9]+)/) {$error=""; return}

   if ($x =~ /^[A-R][S-Z\d]/i ) {

       $error = "";
       return;
   }

-- 
John    http://johnbokma.com/ - Hacking & Hiking in Mexico

Perl help in exchange for a gift:
http://johnbokma.com/perl/help-in-exchange-for-a-gift.html


------------------------------

Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>


Administrivia:

#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc.  For subscription or unsubscription requests, send
#the single line:
#
#	subscribe perl-users
#or:
#	unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.  

NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice. 

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.

#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V11 Issue 1854
***************************************


home help back first fref pref prev next nref lref last post