[31899] in Perl-Users-Digest
Perl-Users Digest, Issue: 3162 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Oct 6 03:09:30 2010
Date: Wed, 6 Oct 2010 00:09:10 -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 Wed, 6 Oct 2010 Volume: 11 Number: 3162
Today's topics:
becoming superuser <merrilljensen@q.com>
Re: becoming superuser <merrilljensen@q.com>
Re: fetching webpage and extracting contents <alfonso.baldaserra@gmail.com>
Re: fetching webpage and extracting contents <alfonso.baldaserra@gmail.com>
Re: fetching webpage and extracting contents <peter@makholm.net>
Re: fetching webpage and extracting contents sln@netherlands.com
Re: fetching webpage and extracting contents <alfonso.baldaserra@gmail.com>
Re: Posting Guidelines for comp.lang.perl.misc ($Revisi <ralph@happydays.com>
system(@ssh) steals stdin <marc.girod@gmail.com>
Re: system(@ssh) steals stdin (Randal L. Schwartz)
Re: system(@ssh) steals stdin <marc.girod@gmail.com>
Re: toy list processing problem: collect similar terms <e9427749@stud4.tuwien.ac.at>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 05 Oct 2010 23:53:24 -0600
From: Uno <merrilljensen@q.com>
Subject: becoming superuser
Message-Id: <xoednS6zNeNIkzHRnZ2dnUVZ5s2dnZ2d@giganews.com>
I'm trying to write a template for my garden-variety perl script that
starts from scratch, and following closely the development of xhmod in
the camel book p 688:
$ perl template1.pl
count is 0
No such file or directory
$ cat l2.pl
#!/usr/bin/perl
use strict;
use warnings;
# l2.pl
$ cat template1.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = 'l2.pl';
open my $fh, ">", $filename or die "cannot open $filename: $!";
print $fh "#!/usr/bin/perl\n";
print $fh "use strict;\n";
print $fh "use warnings;\n";
print $fh " \n";
print $fh " \n";
print $fh " \n";
print $fh "# ", $filename, "\n";
my $cnt = chmod 0755 ,'$fh';
print "count is ", $cnt, "\n";
print $!, "\n";
close($fh);
$
I think the above clearly shows that I don't have superuser priveleges.
I certainly know the password.
How does one achieve this?
--
Uno
------------------------------
Date: Wed, 06 Oct 2010 00:57:22 -0600
From: Uno <merrilljensen@q.com>
Subject: Re: becoming superuser
Message-Id: <UrSdndMhFpROgDHRnZ2dnUVZ5sadnZ2d@giganews.com>
Uno wrote:
> I think the above clearly shows that I don't have superuser priveleges.
> I certainly know the password.
>
> How does one achieve this?
I think this is a better version, but I still have the same outstanding
question:
$ perl template1.pl
chmod could not open l2.pl No such file or directory
$ cat l2.pl
#!/usr/bin/perl
use strict;
use warnings;
# l2.pl
$ cat template1.pl
#!/usr/bin/perl
use strict;
use warnings;
my $filename = 'l2.pl';
open my $fh, ">", $filename or die "cannot open $filename: $!";
print $fh "#!/usr/bin/perl\n";
print $fh "use strict;\n";
print $fh "use warnings;\n";
print $fh " \n";
print $fh " \n";
print $fh " \n";
print $fh "# ", $filename, "\n";
close($fh);
chmod 0755 ,'$filename' or die "chmod could not open ", $filename, " $!\n";
$
--
Uno
------------------------------
Date: Tue, 5 Oct 2010 00:24:27 -0700 (PDT)
From: alfonsobaldaserra <alfonso.baldaserra@gmail.com>
Subject: Re: fetching webpage and extracting contents
Message-Id: <0dd21bcd-d5e1-49e3-ae99-fe5909692d29@t20g2000yqa.googlegroups.com>
> #1 how to parse $res->decoded_content without writing it to a file
> because apparently the whole page is a single string
got it fixed by opening a fh to $res->decoded_content
> #2 how to show data in artist - track format, like
> Tinie Tempah - Written In The Stars
so the new code is
#!/usr/bin/perl
use strict;
#use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
my $res = $ua->get("http://www.bbc.co.uk/radio1/chart/singles");
if ($res->is_success) {
open my $bbc, "<", \$res->decoded_content or die "$!\n";
while (defined (my $con = <$bbc>)) {
chomp $con;
next unless $con =~ m!(<span class="artist">)|(<span
class="track">)!;
my ($artist) = $con =~ m!<span class="artist">(.*?)</
span>!;
my ($track) = $con =~ m!<span class="track">(.*?)</
span>!;
print "$artist - $track\n";
}
} else {
die "could not fetch bbc.co.uk\n";
}
but the output is coming as
Tinie Tempah -
- Written In The Stars
Bruno Mars -
- Just The Way You Are (Amazing)
Labrinth -
- Let The Sun Shine
Adele -
- Make You Feel My Love
while it should have been
Tinie Tempah - Written In The Stars
Bruno Mars - Just The Way You Are (Amazing)
Labrinth - Let The Sun Shine
Adele - Make You Feel My Love
i cant figure out why this is happening.
any help guys?
thanku :)
------------------------------
Date: Tue, 5 Oct 2010 01:13:03 -0700 (PDT)
From: alfonsobaldaserra <alfonso.baldaserra@gmail.com>
Subject: Re: fetching webpage and extracting contents
Message-Id: <545e10db-538a-4873-8488-40e594372944@i13g2000yqd.googlegroups.com>
i got a real bad code working :)
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
my $res = $ua->get("http://www.bbc.co.uk/radio1/chart/singles");
if ($res->is_success) {
open my $bbc, "<", \$res->decoded_content or die "$!\n";
while (defined (my $con = <$bbc>)) {
chomp $con;
next if $con =~ /^\s*$/;
next unless $con =~ m!(<span class="artist">)|(<span
class="track">)!;
$con =~ s/^\s*|\s*$//g;
if ($con =~ m!<span class="artist">(.*)</span>!) {
print $1, " - ";
} elsif ($con =~ m!<span class="track">(.*)</span>!) {
print $1, "\n";
}
}
}
thank you gents for giving me a chance to do it myself.
though i am still looking for any improvements that you could
suggest :-)
------------------------------
Date: Tue, 05 Oct 2010 10:39:33 +0200
From: Peter Makholm <peter@makholm.net>
Subject: Re: fetching webpage and extracting contents
Message-Id: <87mxqt11a2.fsf@vps1.hacking.dk>
alfonsobaldaserra <alfonso.baldaserra@gmail.com> writes:
> i got a real bad code working :)
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
> use LWP::UserAgent;
>
> my $ua = LWP::UserAgent->new;
> $ua->timeout(10);
> $ua->env_proxy;
>
> my $res = $ua->get("http://www.bbc.co.uk/radio1/chart/singles");
>
> if ($res->is_success) {
> open my $bbc, "<", \$res->decoded_content or die "$!\n";
Don't do this. While possible, it is kind of obscure and shoul in my
opinion only be used when existing interfaces requires a perl file
handle.
Just split the content on newlines if you want to iterate over the
lines.
> while (defined (my $con = <$bbc>)) {
> chomp $con;
> next if $con =~ /^\s*$/;
> next unless $con =~ m!(<span class="artist">)|(<span
> class="track">)!;
> $con =~ s/^\s*|\s*$//g;
> if ($con =~ m!<span class="artist">(.*)</span>!) {
> print $1, " - ";
> } elsif ($con =~ m!<span class="track">(.*)</span>!) {
> print $1, "\n";
> }
Don't parse HTML by throwing naive regexpes at the problem. This would
fail horribly if BBC decided to remove unneded newlines from their
content.
> }
> }
I would rather use one of the existing HTML parsing modules. One
option could be HTML::TreeBuilder. Base on a quick read in the
documentation it would looke something like this:
my $html = HTML::TreeBuilder->new_from_content( $res->decoded_content );
for my $tag ($html->find('span') {
my $class = $tag->attr('class');
if ( $class eq 'artist' ) {
...;
} elsif ( $class eq 'track' ) {
...;
}
}
This would be a much more robust solution. (But I don't parse HTML in
my day to day work, so I might not be uptodate on the current set of
HTML parsers.)
//Makholm
------------------------------
Date: Tue, 05 Oct 2010 09:01:13 -0700
From: sln@netherlands.com
Subject: Re: fetching webpage and extracting contents
Message-Id: <8rima6hdr1mkf1fv1ukklvnnff0v08kj3s@4ax.com>
On Tue, 5 Oct 2010 01:13:03 -0700 (PDT), alfonsobaldaserra <alfonso.baldaserra@gmail.com> wrote:
>i got a real bad code working :)
>
>#!/usr/bin/perl
>
>use strict;
>use warnings;
>use LWP::UserAgent;
>
>my $ua = LWP::UserAgent->new;
>$ua->timeout(10);
>$ua->env_proxy;
>
>my $res = $ua->get("http://www.bbc.co.uk/radio1/chart/singles");
>
>if ($res->is_success) {
> open my $bbc, "<", \$res->decoded_content or die "$!\n";
> while (defined (my $con = <$bbc>)) {
> chomp $con;
> next if $con =~ /^\s*$/;
> next unless $con =~ m!(<span class="artist">)|(<span
>class="track">)!;
> $con =~ s/^\s*|\s*$//g;
> if ($con =~ m!<span class="artist">(.*)</span>!) {
> print $1, " - ";
> } elsif ($con =~ m!<span class="track">(.*)</span>!) {
> print $1, "\n";
> }
> }
>}
>
>
>thank you gents for giving me a chance to do it myself.
>
>though i am still looking for any improvements that you could
>suggest :-)
Along the lines of what you are doing, something like below.
-sln
-----------
use strict;
use warnings;
my $string =<<EOHTML;
<html>
<span class="artist">
Tinie Tempah
</span>
<span class="track">
Written In The Stars
</span>
<span class="artist"> Bruno Mars </span>
<span class="track">Just The Way You Are (Amazing)</span>
<span class="artist">
Labrinth</span>
<span class="track">Let The Sun Shine
</span>
<span class="track">A song by Labrinth</span>
<span class="artist">Adele </span>
<span class="track">Make You Feel My Love</span>
<span class="artist">Taio Cruz</span>
<span class="track">Dynamite</span>
<html/>
EOHTML
my $artist;
while ( $string =~
/ <span \s+ class \s* = \s* ['"]\s* (artist|track) \s*['"] \s* >
\s* (.*?) \s*
<\/span\s*>
/xsig )
{
if ($1 eq 'artist') {
$artist = $2;
}
else {
if (length $artist) {
print "$artist - $2\n";
}
$artist = '';
}
}
print "\n";
## Alternate -
##
$artist = '';
my %tracks;
while ( $string =~
/ <span \s+ class \s* = \s* ['"]\s* (artist|track) \s*['"] \s* >
\s* (.*?) \s*
<\/span\s*>
/xsig )
{
if ($1 eq 'artist') {
$artist = $2;
}
else {
push @{ $tracks{$artist} }, $2;
}
}
for $artist (sort keys %tracks) {
print "\n$artist\n";
for my $track ( sort @{ $tracks{$artist} } ) {
print " - $track\n"
}
}
------------------------------
Date: Tue, 5 Oct 2010 22:35:01 -0700 (PDT)
From: alfonsobaldaserra <alfonso.baldaserra@gmail.com>
Subject: Re: fetching webpage and extracting contents
Message-Id: <82352894-01a2-483c-be6d-52c94fb4b139@26g2000yqv.googlegroups.com>
thank you for such beautiful codes sln.
though i am inclined towards peter's advise to use html parsers.
unfortunately, i couldn't get your code to work due to lack of usage
examples of html::treebuilder online.
does anybody happen to know a good html parser with some good examples
online?
------------------------------
Date: Tue, 05 Oct 2010 09:50:34 -0400
From: Ralph Malph <ralph@happydays.com>
Subject: Re: Posting Guidelines for comp.lang.perl.misc ($Revision: 1.9 $)
Message-Id: <9d409$4cab2d2a$ce534406$11820@news.eurofeeds.com>
Remember, every time you feel inclined to post
"have you read the 'Posting Guidelines'?" that the answer is
"no" and the reason for that is that they suck.
HTH
------------------------------
Date: Tue, 5 Oct 2010 02:36:29 -0700 (PDT)
From: Marc Girod <marc.girod@gmail.com>
Subject: system(@ssh) steals stdin
Message-Id: <6bf021e7-8184-4e7c-9f59-f401a8c4cdd8@p26g2000yqb.googlegroups.com>
Hello,
Only partly a Perl question...
For some reason (don't ask...) I need to read data from stdin after
having invoked a program remotely, with ssh.
Surprise: there is nothing there...
Demo:
$ cat rsdtin
#!/usr/bin/perl -w
use strict;
use warnings;
my @ssh = qw(/usr/bin/ssh -q);
system(@ssh, qw(myhost /bin/date));
my @a = <>;
print "a: @a\n";
$ cat << eot | rstdin
aaa
bbb
eot
> > > Mon Oct 4 18:23:24 BST 2010
a:
$
Something I miss?
I thought of using Net::SSH::Perl, but I had some problems to install
it (or some dependency) in a way which would work on both Solaris 8
and 10...
Thanks,
Marc
------------------------------
Date: Tue, 05 Oct 2010 05:05:20 -0700
From: merlyn@stonehenge.com (Randal L. Schwartz)
To: Marc Girod <marc.girod@gmail.com>
Subject: Re: system(@ssh) steals stdin
Message-Id: <86hbh04zgf.fsf@red.stonehenge.com>
>>>>> "Marc" == Marc Girod <marc.girod@gmail.com> writes:
Marc> Hello,
Marc> Only partly a Perl question...
Marc> For some reason (don't ask...) I need to read data from stdin after
Marc> having invoked a program remotely, with ssh.
Marc> Surprise: there is nothing there...
No surprise for me. In general, the child process started by system()
inherits Perl's stdin, stdout, and stderr. Your "ssh" is very likely
reading stdin in anticipation of sending it to the remote host.
If you tried the same trick with:
system "ssh myhost /bin/date </dev/null";
Or even:
system "date";
I'm sure you'd see a different output.
So it's not "system" stealing your input. It's ssh.
print "Just another Perl hacker,"; # the original
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.posterous.com/ for Smalltalk discussion
------------------------------
Date: Tue, 5 Oct 2010 06:08:32 -0700 (PDT)
From: Marc Girod <marc.girod@gmail.com>
Subject: Re: system(@ssh) steals stdin
Message-Id: <4a8d9943-02b8-47bf-90b9-6aef77f96bbf@f6g2000yqa.googlegroups.com>
On Oct 5, 1:05=A0pm, mer...@stonehenge.com (Randal L. Schwartz) wrote:
> I'm sure you'd see a different output.
I do.
Thanks!
Marc
------------------------------
Date: Tue, 05 Oct 2010 18:59:50 +0200
From: Josef <e9427749@stud4.tuwien.ac.at>
Subject: Re: toy list processing problem: collect similar terms
Message-Id: <4cab599e$0$11868$3b214f66@tunews.univie.ac.at>
Hi!
Am 27.09.2010 02:56, schrieb Ben Morrow:
>> Ertugrul Söylemez<es@ertes.de> wrote:
>>
>>> In Haskell the solution looks like this: [...]
>
> Hmmm. Not likely :)
It looks like Perl is beaten by better libraries
instead of higher elegance and orthogonality.
The latter isn't a problem: Perl mongers have no problem with
that other people think perl is ugly and dirty.
(Maybe simply because it is true.)
But this was an attack to theirs proudness about the all-embracing CPAN.
(So at least i start missing
Set::Bag::Value -or- Set::Scalar::MultiValue.)
This posting is cross-posted to c.l.f only, because even some of the
stuff in the appended code looks familiar at first, it holds
things in it which can cause heart attacks to this guys.
So be warned.
One the other side, it is time that functional programmer came in
contact with the real world, instead always be protected by gloves
called monads, isn't it?
xp&fup.
just kidding,
josef
DISCLAIMER@c.l.f: Looking at the appended source on your own risk!
O /
---X----------------------------------------------------------
O \ dedicated_to_a_spammer.pl
#! /usr/bin/env perl
use strict; use warnings;
use Data::Dump 'dump';
my @inp=([0,'a','b'],[1,'c','d'],[2,'e','f'],[3,'g','h'],
[1,'i','j'],[2,'k','l'],[4,'m','n'],[2,'o','p'],
[4,'q','r'],[5,'s','t']);
#helper functions:
#sub distributefirst_as (&@) { ((my $f),$a)=splice @_,0,2; map {
$f->($a,$b=$_) } @_ }
#sub wo_dup { my %e; grep { ! $e{$_}++ } @_ }
# -----------------------------------------------------
print "\ntie variant (first occurence order):\n";
use Tie::Hash::MultiValue;
use Array::Unique;
sub distributefirst { my $t=shift; map { $t => $_ } @_ }
tie my @keys, 'Array::Unique';
tie my %h, 'Tie::Hash::MultiValue';
%h=map { distributefirst @$_ } @inp;
@keys=map { $_->[0] } @inp; # or: List::MoreUtils::each_arrayref(@inp)->()
dump @h{@keys};
# -----------------------------------------------------
print "\nreduce variant (first occurence order):\n";
use List::Util qw'reduce first';
dump @{+reduce { my @t=@$b; push @{$a->{+shift @t}}, @t; $a } {},@inp}
{@{+reduce { (first {$_ eq $b->[0]} @$a) ? $a : [@$a,$b->[0]] }
[],@inp}};
# -----------------------------------------------------
print "\narray based reduce variant (key must be a number):\n";
use List::Util 'reduce';
dump reduce { push @{$a->[$b->[0]]}, @{$b}[1..$#$b]; $a } [],@inp;
#or: dump reduce { push @{$a->[shift $b]}, @$b; $a } [],clone @inp;
# ------------------------------------------------------
print "\nperlish array variant (key must be a number):\n";
my @v;
push @{$v[$_->[0]]}, @{$_}[1..$#$_] for @inp;
dump @v;
# ------------------------------------------------------
print "\npresort variant (alphabetically orderd):\n";
sub butfirst { @_[1..$#_] }; sub deref { @{$_[0]} };
sub clone { map {[@$_]} @_ }
my @sorted=sort { $a->[0] cmp $b->[0] } clone @inp;
dump map { [ butfirst @$_ ] } deref # @{$_}[1..$#$_]
reduce { $a->[$#$a]->[0] ne $b->[0] ? [@$a,$b] :
(push @{$a->[$#$a]},butfirst @$b)&&$a }
[$sorted[0]],butfirst @sorted;
# ------------------------------------------------------
print "\npresort variant2 (alphabetically orderd):\n";
@sorted=sort { $a->[0] cmp $b->[0] } @inp;
dump grep { shift @$_;1 } map { @$_ } #=deref
reduce { my ($b0,@br)=@$b;$a->[$#$a]->[0] ne $b0 ? [@$a,[@$b]] :
[@$a[0..$#$a-1],[@{$a->[$#$a]},@br]] }
[[@{$sorted[0]}]],@sorted[1..$#sorted];
#dump @inp;
# ------------------------------------------------------
print "\nTie::IxHash variant (first occurence order):\n";
use Tie::IxHash;
tie my %ixh, 'Tie::IxHash';
push @{$ixh{$_->[0]}}, @{$_}[1..$#$_] for @inp;
#or: push @{$h{+shift @$_}},@$_ for clone @inp;
dump values @v;
# ------------------------------------------------------
print "\nTie::IxHash variant2 (first occurence order):\n";
use Tie::IxHash;
tie my %ix2, 'Tie::IxHash';
%ix2=map { my ($k,@r)=@$_; $k => [@{$ix2{$k}||[]},@r]} @inp;
dump values @v;
# ------------------------------------------------------
print "\nData::Pairs variant (first occurence order):\n";
use Data::Pairs;
sub makepairs { my $t=shift; map { { $t => $_ } } @_ }
sub wo_dup { my %e; grep { ! $e{$_}++ } @_ }
my $dp=Data::Pairs->new([map { makepairs @$_ } @inp]);
dump map [$dp->get_values($_)], wo_dup $dp->get_keys;
# ------------------------------------------------------
#use DBI;
#my $dbh = DBI->connect('DBI:RAM:','','',{RaiseError=>1});
#$dbh->func({
# table_name => 'inp',
# col_names => 'id,value',
# data_type => 'ARRAY',
# data_source => [map { distributefirst @$_ } @inp] # nf
#}, 'import' );
#dump $dbh->selectcol_arrayref('SELECT value FROM inp GROUP BY id');
------------------------------
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:
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests.
#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 3162
***************************************
