[19684] in Perl-Users-Digest

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

Perl-Users Digest, Issue: 1879 Volume: 10

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Oct 5 14:06:08 2001

Date: Fri, 5 Oct 2001 11:05:11 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1002305111-v10-i1879@ruby.oce.orst.edu>
Content-Type: text

Perl-Users Digest           Fri, 5 Oct 2001     Volume: 10 Number: 1879

Today's topics:
        Can't get $? to work... (Peter Elsner)
    Re: Can't get $? to work... <thomas@baetzler.de>
        DBI/SQL confusion... (martinblack)
    Re: DBI/SQL confusion... <thomas@baetzler.de>
    Re: Finding the difference between arrays... (Abigail)
    Re: Finding the difference between arrays... (Mark Jason Dominus)
    Re: Finding the difference between arrays... nobull@mail.com
    Re: Finding the difference between arrays... <JPFauvelle@Colt-Telecom.fr>
    Re: How to add date stamp to a log file (Venkatesh Babu Sira)
        HTTP Binary File Transfer <r1ckey@home.com>
    Re: Multiplexing strings - one line only - V2 <JPFauvelle@Colt-Telecom.fr>
    Re: Multiplexing strings - one line only V2 <JPFauvelle@Colt-Telecom.fr>
    Re: Multiplexing strings - one line only V2 <dtweed@acm.org>
    Re: Multiplexing strings - one line only V3 <JPFauvelle@Colt-Telecom.fr>
    Re: Multiplexing strings - one line only <dtweed@acm.org>
    Re: Multiplexing strings - one line only (Anno Siegel)
    Re: Multiplexing strings - one line only <dtweed@acm.org>
    Re: Multiplexing strings - one line only <JPFauvelle@Colt-Telecom.fr>
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

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

Date: 5 Oct 2001 09:17:27 -0700
From: peter@servplex.com (Peter Elsner)
Subject: Can't get $? to work...
Message-Id: <7bfd428c.0110050817.36e6b178@posting.google.com>

According to "The Camel" book [page 114] (and various webpages), $? is
supposed to return the error status (if any) from the last pipe close,
backtick command or system operator.

I'm trying to obtain the error condition of an FTP command to see if
the FTP was successful or not.

Here's a portion of the code:

`echo \"cd data\nascii\nput $FILENAME\nquit\n\" | ftp -i $SERVER`;

$ERR=$?;
print "\$ERR=$ERR\n";

exit;

I've also tried it like this:

system("echo 'cd data
ascii
put $FILENAME
quit
' | ftp -i $SERVER");

Note: Both FTP methods/commands work...  The $FILENAME is transferred
to $SERVER.  In that case the error condition is 0.

However, even if the FTP transfer fails, I get a return condition of
0.

The same script in sh works fine, it returns an error condition of 127
if the transfer fails, and 0 if it is successful.

Why does this not work in Perl?

Is there another way I should be doing this?

Thanks in advance.


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

Date: Fri, 05 Oct 2001 18:53:24 +0200
From: Thomas Bätzler <thomas@baetzler.de>
Subject: Re: Can't get $? to work...
Message-Id: <gaprrt46loqb8klcerr02vbf2aukrgmuk0@4ax.com>

On 5 Oct 2001 09:17:27 -0700, peter@servplex.com (Peter Elsner) wrote:
>I'm trying to obtain the error condition of an FTP command to see if
>the FTP was successful or not.
[...]
>`echo \"cd data\nascii\nput $FILENAME\nquit\n\" | ftp -i $SERVER`;
[...]
>Is there another way I should be doing this?

Yes. Use the Net::FTP module. 

HTH,
-- 
use strict;my($i,$t,@r)=(0,'5 -.@BHJPT4acd6e2hk2lmn2o4r2s3tuz',map{ord}
split//,unpack('u*','L#`T&)QD5#0`#!!`#%1D)#08`#P05!!(3``$$"``#"0L&``('.
'"`P<!`````0$`'));$t=~s/(\d)(.)/$2x$1/eg;map{$t.=substr$t,$i,1,''while
$_--;$i++}@r;print"$t\n";# Thomas@Baetzler.de - http://baetzler.de/perl


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

Date: 5 Oct 2001 10:36:43 -0700
From: martinblack26@yahoo.com (martinblack)
Subject: DBI/SQL confusion...
Message-Id: <c025943b.0110050936.4dc598ac@posting.google.com>

Hi, This is a revamped version of a script thats been bothering me for
awhile. It is not generating any error messages, I tried to mix up the
order of the "use" statements... No effect. The "if" statement in the
"kaboom" sub always seems to be evaluated weather it's an existing
item or a new one. Also, the variables $com, $pro, and $newid are not
showing up in the "hi \n Here's the key: $newid \n and here's
something else $com and $pro" print statement. Any help with this
would be appreciated. Thanks in advance.

Below is a copy of the script:


#!/usr/bin/perl

BEGIN {
open (STDERR, ">html/error.txt");
}

        use DBI;
	use CGI::Carp qw(fatalsToBrowser carpout);
	require "dbsubs.cgi";
	use CGI;
	$q=new CGI;

	# input..................................

	$io{'company_id'} = $company_id = $q->param(company_id);
	$io{'product_id'} = $product_id = $q->param(product_id);
	$io{'title'} = $title = $q->param(title);
	$io{'description'} = $description  = $q->param(description);
	$io{'spex'} = $spex  = $q->param(spex);
	$io{'price'} = $price  = $q->param(price);
	$io{'sex'} = $sex  = $q->param(sex);
	
	# mainline...............................

	print header;

	$DBname= "dbi:mysql:uname";
        $DBhost = "localhost";
        $DBusername = "username";
        $DBpassword = "blablabla";

	$dbh = DBI->connect("$DBname:$DBhost", $DBusername, $DBpassword) or  
die "DBI Connection problem: " . $DBI::errstr;
	$dbh->{'RaiseError'} = 1;
	
	&kaboom;

     &print_output || die "we've got a problem: ";


$dbh->disconnect || die "disconnection problem: ", $DBI::errstr;
exit;
 
	# the subs are coming!...................

sub print_output{
   print<<HTML;
    <HTML><BODY>   
    <CENTER><FONT SIZE=5>
     Record added to database
      <P>
     he he he ha ha
      </P>
    </FONT></CENTER>
   </BODY></HTML>
HTML

} 


sub kaboom() { 


	$sth = $dbh->prepare( q[
		SELECT company_id, product_id
		FROM product
		WHERE company_id = ? and 
		product_id= ?
	] ) || die "prep problem: ", $DBI::errstr;
	$sth->execute( $company_id, $product_id ) || die "execution problem:
", $DBI::errstr;

	&fetch_results;
	
		
	if ($newid) {


#print "Content-type: text/html\n\n";			
#print "hi \n Here's the key: $newid \n here's something else $com and
$pro";
#$dbh->disconnect || die "disconnection problem: ", $DBI::errstr;
#exit;


	$dbh->do(do { local $" = ", "; qq[
	  UPDATE product
	  SET @{[map "$_ = ?", keys %io]}
	  WHERE company_id = ? AND product_id = ?
	  ] }, undef,
	  values %io,
	  @io{qw(company_id product_id)} );


	} else {


$dbh->do(do { local $" = ", "; qq[
	INSERT INTO product (@{[ keys %io ]})
	VALUES (@{[ ('?') x values %io ]})
	] }, undef, values %io );
		   
	}	 
}


sub fetch_results {
  
    while ($x = $sth->fetchrow_hashref) {
     $com = $x->{'company_id'};
     $pro = $x->{'product_id'};
   }
	$newid = $com ."-".$pro;
}


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

Date: Fri, 05 Oct 2001 19:59:48 +0200
From: Thomas Bätzler <thomas@baetzler.de>
Subject: Re: DBI/SQL confusion...
Message-Id: <q2trrtgm9ahf4rv9f2ckm7ldab5g5b0gl5@4ax.com>

On 5 Oct 2001, martinblack26@yahoo.com (martinblack) wrote:
>Hi, This is a revamped version of a script thats been bothering me for
>awhile. It is not generating any error messages, I tried to mix up the
>order of the "use" statements... No effect. The "if" statement in the
>"kaboom" sub always seems to be evaluated weather it's an existing
>item or a new one. Also, the variables $com, $pro, and $newid are not
>showing up
[...]

No idea. Where did you define them? Not in the code you posted.

Without looking at dbsubs.cgi there's not much chance that anybody
could tell you what's going on.

HTH,
-- 
use strict;my($i,$t,@r)=(0,'5 -.@BHJPT4acd6e2hk2lmn2o4r2s3tuz',map{ord}
split//,unpack('u*','L#`T&)QD5#0`#!!`#%1D)#08`#P05!!(3``$$"``#"0L&``('.
'"`P<!`````0$`'));$t=~s/(\d)(.)/$2x$1/eg;map{$t.=substr$t,$i,1,''while
$_--;$i++}@r;print"$t\n";# Thomas@Baetzler.de - http://baetzler.de/perl


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

Date: 5 Oct 2001 15:46:25 GMT
From: abigail@foad.org (Abigail)
Subject: Re: Finding the difference between arrays...
Message-Id: <slrn9rrlbl.c4h.abigail@alexandra.xs4all.nl>

JR (tommyumuc@aol.com) wrote on MMCMLVII September MCMXCIII in
<URL:news:319333f5.0110050602.5c0c210e@posting.google.com>:
}} For the following array examples, how is it possible to determine the
}} difference?  I can't use hashes, because in the actual arrays there
}} would be many duplicate keys, which aren't allowed in hashes.  I can't
}} just split the fields and do something like "$arrayOne[$_] !=
}} $arrayTwo[$_]" because, as in the below example, that would return row
}} 0, 2, and 3.  The true difference between the two arrays is:
}} 
}} 01,001,000,0003 and 01,001,000,0002
}} 
}} because there are 3 (01,001,000,0003) in @arrayOne and 2 in @arrayTwo
}} and there is 1 (01,001,000,0002) in @arrayOne and 2 in @arrayTwo.
}} 
}} My guess is that I need to, in some way, pop, shift, or splice to
}} remove elements that are compared and found to be equal.  The problem
}} I'm having is how to loop through the arrays, and then delete elements
}} of those arrays after a match has been found (a runtime error occurs,
}} usually).
}} 
}} 
}} @arrayOne             @arrayTwo
}} ---------             ---------
}} 01,001,000,0002       01,001,000,0003
}} 01,001,000,0003       01,001,000,0003
}} 01,001,000,0003       01,001,000,0002
}} 01,001,000,0003       01,001,000,0002
}} ...                   ...
}} 
}} (DESIRED RESULT)
}} @fallOut
}} --------
}} 01,001,000,0003
}} 01,001,000,0002
}} 
}} I hope I've explained this problem reasonably well.  I would
}} appreciate any help anyone may have.


Actually, you didn't explain a single thing. You gave an example of two
arrays, each containing 4 elements. Just on one index, the elements are
the same, so we have 3 places where things differ. Yet, only 2 elements
are reported. To make thinks more complicated, many elements are repeated,
and there just 2 values in total.

What is in @fallOut? $arrayTwo [0] and $arrayOne [0]? $arrayTwo [0] and
$arrayTwo [2]? $arrayOne [3] and $arrayOne [0]?


It would help to actually *specify* your problem instead of giving one
unclear example.



Abigail
-- 
perl -wle 'print sub {} -> ("Just another Perl Hacker")'
#    A fly buzzing. A
#    swallow in a pear tree. A
#    cat walks. Two carp swim.


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

Date: Fri, 05 Oct 2001 15:57:42 GMT
From: mjd@plover.com (Mark Jason Dominus)
Subject: Re: Finding the difference between arrays...
Message-Id: <3bbdd875.558$28a@news.op.net>

In article <319333f5.0110050602.5c0c210e@posting.google.com>,
JR <tommyumuc@aol.com> wrote:
>For the following array examples, how is it possible to determine the
>difference?  I can't use hashes, because in the actual arrays there
>would be many duplicate keys, which aren't allowed in hashes.  

You can use the hashes to keep track of the number of times each item
appears:

        for (@arrayOne) {
          ++$diff{$_};
        }
        for (@arrayTwo) {
          --$diff{$_};
        }

        # %diff now contains
        #  ('01,001,000,0002' => 1,
        #   '01,001,000,0003' => 1,
        #  )
        
        for (sort keys %diff) {
          push @fallOut, ($_) x abs($diff{$_});
        } 

        # @fallOut now contains:
        #   ('01,001,000,0002', '01,001,000,0003'); 
        #
        # which is what you said you wanted
                  

If the arrays are both sorted, you can use the 'comm' procedure.
'comm' finds the lines in common and uses less memory than the hash
technique above:

        my ($a1, $a2) = (0, 0);
        my @fallOut;

        while ($a1 < @arrayOne and $a2 < @arrayTwo) {
          my ($line1, $line2) = ($arrayOne[$a1], $arrayTwo[$a2]);
          if ($line1 lt $line2) {
            push @fallOut, $line1;
            ++$a1;
          } elsif ($line1 gt $line2) {
            push @fallOut, $line2;
            ++$a2;
          } else {
            ++$a1; ++$a2;
          }
        }
        while ($a1 < @arrayOne) {
            push @fallOut, $arrayOne[$a1++];
        }  
        while ($a2 < @arrayTwo) {
            push @fallOut, $arrayTwo[$a2++];
        }  


Neither of these techniques destroys the original array.

>I hope I've explained this problem reasonably well.  I would
>appreciate any help anyone may have.

If you need more a more sophisticated view of the differences, you may
want to look at the Algorithm::Diff module from CPAN.




-- 
@P=split//,".URRUU\c8R";@d=split//,"\nrekcah xinU / lreP rehtona tsuJ";sub p{
@p{"r$p","u$p"}=(P,P);pipe"r$p","u$p";++$p;($q*=2)+=$f=!fork;map{$P=$P[$f^ord
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print


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

Date: 05 Oct 2001 17:13:20 +0100
From: nobull@mail.com
Subject: Re: Finding the difference between arrays...
Message-Id: <u91ykioyjj.fsf@wcl-l.bham.ac.uk>

tommyumuc@aol.com (JR) writes:

> For the following array examples, how is it possible to determine the
> difference?  I can't use hashes, because in the actual arrays there
> would be many duplicate keys, which aren't allowed in hashes.

> @arrayOne             @arrayTwo
> ---------             ---------
> 01,001,000,0002       01,001,000,0003
> 01,001,000,0003       01,001,000,0003
> 01,001,000,0003       01,001,000,0002
> 01,001,000,0003       01,001,000,0002
> ...                   ...
> 
> (DESIRED RESULT)
> @fallOut
> --------
> 01,001,000,0003
> 01,001,000,0002

So you are asking how to compare "bags" rather than sets?

my %diff;
$diff{$_}++ for @arrayTwo;
$diff{$_}-- for @arrayOne;

my @fallout;
while (my ($value,$count) = each %diff) {
  push @fallout => ($value) x abs $count;
}

-- 
     \\   ( )
  .  _\\__[oo
 .__/  \\ /\@
 .  l___\\
  # ll  l\\
 ###LL  LL\\


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

Date: Fri, 05 Oct 2001 19:59:12 +0200
From: Jean-Philippe Fauvelle <JPFauvelle@Colt-Telecom.fr>
Subject: Re: Finding the difference between arrays...
Message-Id: <berrrtk6i3svqhibuepnlud19bllgkkio6@4ax.com>

Le 5 Oct 2001 07:02:59 -0700, tommyumuc@aol.com (JR) écrit:

This solution works fine.

Regards.

Jean-Philippe Fauvelle


@arrayOne = (
	[01,001,000,0002],
	[01,001,000,0003],
	[01,001,000,0003],
	[01,001,000,0003]
);

@arrayTwo = (
	[01,001,000,0003],
	[01,001,000,0003],
	[01,001,000,0002],
	[01,001,000,0002]
);

my(%fallOut,@fallOut);

$fallOut{ join(':',map(int,@$_)) }++ for @arrayOne;
$fallOut{ join(':',map(int,@$_)) }-- for @arrayTwo;
while ( ($key,$count) = each( %fallOut ) ) {
	next unless $count;
	push @fallOut, [split ':', $key] for 1 .. abs($count);
}

use Data::Dumper;
print Dumper(\@fallOut);

================================
$VAR1 = [
          [
            '1',
            '1',
            '0',
            '2'
          ],
          [
            '1',
            '1',
            '0',
            '3'
          ]
        ];
================================



>For the following array examples, how is it possible to determine the
>difference?  I can't use hashes, because in the actual arrays there
>would be many duplicate keys, which aren't allowed in hashes.  I can't
>just split the fields and do something like "$arrayOne[$_] !=
>$arrayTwo[$_]" because, as in the below example, that would return row
>0, 2, and 3.  The true difference between the two arrays is:
>
>01,001,000,0003 and 01,001,000,0002
>
>because there are 3 (01,001,000,0003) in @arrayOne and 2 in @arrayTwo
>and there is 1 (01,001,000,0002) in @arrayOne and 2 in @arrayTwo.
>
>My guess is that I need to, in some way, pop, shift, or splice to
>remove elements that are compared and found to be equal.  The problem
>I'm having is how to loop through the arrays, and then delete elements
>of those arrays after a match has been found (a runtime error occurs,
>usually).
>
>
>@arrayOne             @arrayTwo
>---------             ---------
>01,001,000,0002       01,001,000,0003
>01,001,000,0003       01,001,000,0003
>01,001,000,0003       01,001,000,0002
>01,001,000,0003       01,001,000,0002
>...                   ...
>
>(DESIRED RESULT)
>@fallOut
>--------
>01,001,000,0003
>01,001,000,0002
>
>I hope I've explained this problem reasonably well.  I would
>appreciate any help anyone may have.



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

Date: 5 Oct 2001 10:32:35 -0700
From: vsira@hotmail.com (Venkatesh Babu Sira)
Subject: Re: How to add date stamp to a log file
Message-Id: <d5b8dfd2.0110050932.5cb0ea29@posting.google.com>

Michael Budash <mbudash@sonic.net> wrote in message news:<mbudash-23BBBB.16484704102001@news.sonic.net>...
> In article <d5b8dfd2.0110041522.4a958ff5@posting.google.com>, 
> vsira@hotmail.com (Venkatesh Babu Sira) wrote:
> 
> > Michael Budash <mbudash@sonic.net> wrote in message 
> > news:<mbudash-5266EF.12472303102001@news.sonic.net>...
> > > In article <d5b8dfd2.0110031103.2500563@posting.google.com>, 
> > > vsira@hotmail.com (Venkatesh Babu Sira) wrote:
> > > 
> > > > Michael Budash <mbudash@sonic.net> wrote in message 
> > > > news:<mbudash-CAB4B9.13105302102001@news.sonic.net>...
> > > > > In article <d5b8dfd2.0110021136.3c5c31e7@posting.google.com>, 
> > > > > vsira@hotmail.com (Venkatesh Babu Sira) wrote:
> > > > > 
> > > > > > I have code like,
> > > > > > $LOGFILENAME = "logfile.txt";
> > > > > > I want to add time stamp like
> > > > > > $LOGFILENAME = "logfile.txt.$time";
> > > > > > ex: that it may look like logfile.txt.2oct2001 .
> > > > > > Tx
> > > > > > -B
> > > > > 
> > > > > this does it with a format you probly _oughta_ use, if you ever 
> > > > > wanna 
> > > > > sort (or view a dir listing of) these files:
> > > > > 
> > > > > NOTE: beware of word wrap below!
> > > > >  
> > > > > use POSIX;
> > > > > $LOGFILENAME = 'logfile.txt.' . POSIX::strftime("%Y%m%d", 0, 0, 0, 
> > > > > (localtime)[3..5]);
> > > > >  
> > > > > the above (currently) yields;
> > > > > 
> > > > >    logfile.txt.20011002 
> > > > > 
> > > > > this version does it exactly as you requested:
> > > > > 
> > > > > use POSIX;
> > > > > my @t = localtime;
> > > > > $LOGFILENAME = 'logfile.txt.' . $t[3], lc(POSIX::strftime("%b%Y\n", 
> > > > > 0, 
> > > > > 0, 0, @t[3..5]));
> > > > >  
> > > > > the above (currently) yields;
> > > > > 
> > > > >    logfile.txt.2oct2001 
> > > > > 
> > > > > hth-
> > > > 
> > > > Tx a lot Michael,second one i had to remove $t[3],other wise it will
> > > > create logfile.txt.3 .
> > > > -B
> > > 
> > > that actually looks like a typo to me. replace the comma after $t[3] 
> > > with a space-dot. i.e., should be:
> > > 
> > > $LOGFILENAME = 'logfile.txt.' . $t[3] . lc(POSIX::strftime("%b%Y\n", 0, 
> > > 0, 0, @t[3..5]));
> > > 
> > > (tested)
> > >  
> > > hth-
> > 
> > Excellent,
> > It works,
>  
> good
>  
> >i have one more ? ,
> > What this means @t[3..5]
>  
> it's called an array slice:
> 
> http://www.perldoc.com/perl5.6/pod/perldata.html#Slices
> 
> > also how can add time stamp to the above 
> > ex 04oct2001:12:00:00
> > I am novice to perl :)
>  
> the documentation you need to read is on your unix box:
> 
> perldoc POSIX
> man strftime
>  
> > Tx in advance
> 
> no prob,

Tx Michael.


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

Date: Fri, 05 Oct 2001 18:03:41 GMT
From: r1ckey <r1ckey@home.com>
Subject: HTTP Binary File Transfer
Message-Id: <1Cmv7.5712$IY3.4583570@news1.rdc1.sfba.home.com>

Hello,
  I'm trying to download a binary file via HTTP and save locally.  The file is
of content type application/octet-stream.  Currently the code I have does not
save the file in its correct format, its always about 100 bytes too small.  Can
this be done?  Thanks in advance.

-------------------------
#!/usr/bin/perl -w

use strict;
use LWP::UserAgent;

my $ua = LWP::UserAgent->new;

my @bin_dirs = qw(Dir1 Dir2 Dir1);

foreach my $dir (@bin_dirs) {
  my $file = lc($bin) . ".bin";
  open(BIN, "> /home/test/$file") or die "Can't open file: $!";
  binmode(BIN); # fails with or without binmode
  my $req = HTTP::Request->new(GET => "http://my.url.com/$dir/$file");
  $req->authorization_basic('username','password');
  $req->content_type('application/octet-stream');
  print BIN $ua->request($req)->as_string;
  close(BIN);
  undef $req;
}


-- 
       ____        __                 
______/_   | ____ |  | __ ____ ___.__.
\_  __ \   |/ ___\|  |/ // __ <   |  |
 |  | \/   \  \___|    <\  ___/\___  |
 |__|  |___|\___  >__|_ \\___  > ____|
_________________\/_____\/____\/\/_____
---------------------------------------


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

Date: Fri, 05 Oct 2001 17:56:35 +0200
From: Jean-Philippe Fauvelle <JPFauvelle@Colt-Telecom.fr>
Subject: Re: Multiplexing strings - one line only - V2
Message-Id: <oslrrtga29bbck6bg7724tjet06nu8fbhs@4ax.com>

Le 4 Oct 2001 15:46:21 -0700, mauroid@csi.forth.gr (Dimitri) écrit:

@STR= ($str1,$str2,$str3);
$N = @STR;           # number of strings
$M = 2;              # chars per token
$S = length $STR[0]; # string length

$out = join '', 
  ( join('',@STR) =~ /(.{$M})/gos )[
    map { my($i)=$_; return map { $i + $_*$S/$M } 0..$N-1 }  0..($S/$M)-1
  ];

one line only ! 

Jean-Philippe Fauvelle

>I have N=3 strings of equal length, and I want to multiplex them by taking
>M=2 characters from each string (the length of each string is divisible by
>M). Example :
>
>Input:
>
>$str1 = "aabbccddeeff";
>$str2 = "AABBCCDDEEFF";
>$str3 = "001122334455";
>
>Output :
>
>$out = "aaAA00bbBB11ccCC22ddDD33eeEE44ffFF55";
>
>Besides the obvious for loop :
>
>$out = ""; $len = length($str1);
>
>for ($i = 0; $i < $len; $i += 2) {
> $out .= substr($str1, $i, 2) . substr($str2, $i, 2) . substr($str3, $i, 2);
>}
>
>Is there a more elegant (faster) way?
>
>Thanks!
>-Dimitri



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

Date: 5 Oct 2001 15:36:03 GMT
From: "Jean-Philippe Fauvelle" <JPFauvelle@Colt-Telecom.fr>
Subject: Re: Multiplexing strings - one line only V2
Message-Id: <Xns9131B4DB6B052JPFauvelleColtTeleco@195.68.86.8>

Dave Tweed <dtweed@acm.org> wrote in news:3BBDCE3D.B2B771F7@acm.org:

> Jean-Philippe Fauvelle wrote:
>> $out = join '',
>>         ( join('',@STR) =+AH4- /(.{$M})/gos )[ map { $_, $_+-$S/$M,
>>         $_+-2*$S/$M }  0 .. ($S/$M)-1 
>>         ];
>> 
>> one line only !
> 
> You have *got* to get different newsreading software. For some reason,
> '~' becomes '+AH4-' and '+' becomes '+-'. If Perl scripts weren't
> already hard enough to read, this makes it nearly impossible.
> 
> Also, you failed to make your solution work for numbers of strings
> other than three. You calculated $N, but then never made any use of
> it. I don't think you can do the fully general case as a one-liner.
> 
> -- Dave Tweed



You're right, for both the newsreader and the $N problem !

May be this version is correct ?


@STR= ($str1,$str2,$str3);
$N = @STR;           # number of strings 
$M = 2;              # chars per token
$S = length $STR[0]; # string length

$out = join '', 
  ( join('',@STR) =~ /(.{$M})/gos )[
      map { my($i)=$_; return map {$i + $_*$S/$M} 0..$N-1 }  0..($S/$M)-1
  ];


Still one line ! 

Jean-Philippe Fauvelle


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

Date: Fri, 05 Oct 2001 16:23:01 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: Multiplexing strings - one line only V2
Message-Id: <3BBDDD14.BE429BBA@acm.org>

Jean-Philippe Fauvelle wrote:
> May be this version is correct ?
> 
> @STR= ($str1,$str2,$str3);
> $N = @STR;           # number of strings
> $M = 2;              # chars per token
> $S = length $STR[0]; # string length
> 
> $out = join '',
>   ( join('',@STR) =~ /(.{$M})/gos )[
>       map { my($i)=$_; return map {$i + $_*$S/$M} 0..$N-1 }  0..($S/$M)-1
>   ];

Yes, I was trying things like that -- the key is that you need an
explicit iterator variable for the outer loop -- but the problem
is that the above code doesn't even compile. You can't have a return
not in a subroutine, eval, or do FILE.

-- Dave Tweed


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

Date: Fri, 05 Oct 2001 18:35:32 +0200
From: Jean-Philippe Fauvelle <JPFauvelle@Colt-Telecom.fr>
Subject: Re: Multiplexing strings - one line only V3
Message-Id: <k9orrtci27cp22qu2agcrccgkggt9gjk09@4ax.com>

Le Fri, 05 Oct 2001 16:23:01 GMT, Dave Tweed <dtweed@acm.org> écrit:

Hi Dave.

Can you add my version into your benchmark, please ?
I tested it and it works.
I'd like to know how fast is the probably most ugly version :-)
Thanks !

Jean-Philippe Fauvelle


$str1 = "aabbccddeeff";
$str2 = "AABBCCDDEEFF";
$str3 = "001122334455";

@STR= ($str1,$str2,$str3);
$N = @STR;           # number of strings
$M = 2;              # chars per token
$S = length $STR[0]; # string length

$out = join '', 
  ( join('',@STR) =~ /(.{$M})/gos )[
    map { my($i)=$_; map { $i + $_*$S/$M } 0..$N-1 }  0..($S/$M)-1
  ];



>Jean-Philippe Fauvelle wrote:
>> May be this version is correct ?
>> 
>> @STR= ($str1,$str2,$str3);
>> $N = @STR;           # number of strings
>> $M = 2;              # chars per token
>> $S = length $STR[0]; # string length
>> 
>> $out = join '',
>>   ( join('',@STR) =~ /(.{$M})/gos )[
>>       map { my($i)=$_; return map {$i + $_*$S/$M} 0..$N-1 }  0..($S/$M)-1
>>   ];
>
>Yes, I was trying things like that -- the key is that you need an
>explicit iterator variable for the outer loop -- but the problem
>is that the above code doesn't even compile. You can't have a return
>not in a subroutine, eval, or do FILE.
>
>-- Dave Tweed



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

Date: Fri, 05 Oct 2001 15:19:42 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: Multiplexing strings - one line only
Message-Id: <3BBDCE3D.B2B771F7@acm.org>

Jean-Philippe Fauvelle wrote:
> $out = join '',
>         ( join('',@STR) =+AH4- /(.{$M})/gos )[
>                 map { $_, $_+-$S/$M, $_+-2*$S/$M }  0 .. ($S/$M)-1
>         ];
> 
> one line only !

You have *got* to get different newsreading software. For some reason,
'~' becomes '+AH4-' and '+' becomes '+-'. If Perl scripts weren't
already hard enough to read, this makes it nearly impossible.

Also, you failed to make your solution work for numbers of strings
other than three. You calculated $N, but then never made any use of
it. I don't think you can do the fully general case as a one-liner.

-- Dave Tweed


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

Date: 5 Oct 2001 15:53:39 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Multiplexing strings - one line only
Message-Id: <9pkl23$onr$1@mamenchi.zrz.TU-Berlin.DE>

According to Dave Tweed  <dtweed@acm.org>:
> Jean-Philippe Fauvelle wrote:
> > $out = join '',
> >         ( join('',@STR) =+AH4- /(.{$M})/gos )[
> >                 map { $_, $_+-$S/$M, $_+-2*$S/$M }  0 .. ($S/$M)-1
> >         ];
> > 
> > one line only !
> 
> You have *got* to get different newsreading software. For some reason,
> '~' becomes '+AH4-' and '+' becomes '+-'. If Perl scripts weren't
> already hard enough to read, this makes it nearly impossible.
> 
> Also, you failed to make your solution work for numbers of strings
> other than three. You calculated $N, but then never made any use of
> it. I don't think you can do the fully general case as a one-liner.

Why not?  Given any number of strings in @strings, this interleaves
chunks of $n:

    $out .= substr( $strings[ 0], 0, $n, ''),
        push @strings, shift @strings while length $strings[ 0];

You can put most anything in a single Perl expression if you try hard
enough and don't mind the obfuscation.   "...it just requires will,
ver-bosity and time".

Anno


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

Date: Fri, 05 Oct 2001 16:40:09 GMT
From: Dave Tweed <dtweed@acm.org>
Subject: Re: Multiplexing strings - one line only
Message-Id: <3BBDE118.70E4C374@acm.org>

Anno Siegel wrote:
> According to Dave Tweed  <dtweed@acm.org>:
> > I don't think you can do the fully general case as a one-liner.
> 
> Why not?  Given any number of strings in @strings, this interleaves
> chunks of $n:
> 
>     $out .= substr( $strings[ 0], 0, $n, ''),
>         push @strings, shift @strings while length $strings[ 0];
> 
> You can put most anything in a single Perl expression if you try hard
> enough and don't mind the obfuscation.   "...it just requires will,
> ver-bosity and time".

Close, but this destroys @strings, so you need another line to either
restore it or create a temporary copy in the first place. It also needs
an initialization for $out.

I think to have a "proper" one-liner in this context, it needs to be an
expression that yields the output value without side-effects.
Jean-Philippe's first effort met these criteria, but wasn't fully general.

Otherwise, you can write *any* Perl script as a one-liner. Just remove
the newlines.

-- Dave Tweed


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

Date: Fri, 05 Oct 2001 18:54:27 +0200
From: Jean-Philippe Fauvelle <JPFauvelle@Colt-Telecom.fr>
Subject: Re: Multiplexing strings - one line only
Message-Id: <haprrtklp1o1ipfsjcvbcma9s5rvchr1ah@4ax.com>

Le Fri, 05 Oct 2001 16:40:09 GMT, Dave Tweed <dtweed@acm.org> écrit:

This version works and is fully general !
Can you benchmark it ?

Jean-Philippe Fauvelle


$str1 = "aabbccddeeff";
$str2 = "AABBCCDDEEFF";
$str3 = "001122334455";

@STR= ($str1,$str2,$str3);
$N = @STR;           # number of strings
$M = 2;              # chars per token
$S = length $STR[0]; # string length

$out = join '', 
  ( join('',@STR) =~ /(.{$M})/gos )[
    map { my($i)=$_; map { $i + $_*$S/$M } 0..$N-1 }  0..($S/$M)-1
  ];





>Anno Siegel wrote:
>> According to Dave Tweed  <dtweed@acm.org>:
>> > I don't think you can do the fully general case as a one-liner.
>> 
>> Why not?  Given any number of strings in @strings, this interleaves
>> chunks of $n:
>> 
>>     $out .= substr( $strings[ 0], 0, $n, ''),
>>         push @strings, shift @strings while length $strings[ 0];
>> 
>> You can put most anything in a single Perl expression if you try hard
>> enough and don't mind the obfuscation.   "...it just requires will,
>> ver-bosity and time".
>
>Close, but this destroys @strings, so you need another line to either
>restore it or create a temporary copy in the first place. It also needs
>an initialization for $out.
>
>I think to have a "proper" one-liner in this context, it needs to be an
>expression that yields the output value without side-effects.
>Jean-Philippe's first effort met these criteria, but wasn't fully general.
>
>Otherwise, you can write *any* Perl script as a one-liner. Just remove
>the newlines.
>
>-- Dave Tweed



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

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.  

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 V10 Issue 1879
***************************************


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