The Perl Short Questions Megathread: executable line noise

The Something Awful Forums > Discussion > Serious Hardware/Software Crap > The Cavern of COBOL > The Perl Short Questions Megathread: executable line noise

«‹›72 »

checkeredshawn: Jul 16, 2007

Triple Tech posted:

Yes, I'm talking to checkeredshawn. So, now we know what the data looks like. What exactly are you trying to determine based off of this data? Are you picking out special elements? Are you deleting duplicates? Are you... doing something?

Not really doing much with it right now other than printing, and that all happens within the nested foreach loops I posted. I'm just printing out the results of the comparison. This would be a typical output:

firstserver returns the same result(s) as secondserver
secondserver returns the same result(s) as firstserver

or if they're different

firstserver differs from secondserver
secondserver differs from firstserver

# ? Jul 17, 2008 18:17

Adbot: ADBOT LOVES YOU

# ? May 17, 2024 04:04

Erasmus Darwin: Mar 6, 2001

What about creating a new hash where each key is the DNS server value from the previous hash and each value is an array of keys from the previous hash that had that DNS server?

Something like this:

code:

for $k (sort keys %servervalues) {
  if (! $newhash{$servervalues{k}}) {
    $newhash{$servervalues{$k}} = [ ];
  }
  push @{$newhash{$servervalues{$k}}}, $k;
}

The sort is obviously optional but is a quick and easy way to make sure the individual arrays are created in a sorted order.

And then you can do something like:

code:

for $k (keys %newhash) {
  if (@{$newhash{$k}} > 1) {
    print join(', ', @{$newhash{$k}}), " share the same value.\n";
  }
}

# ? Jul 17, 2008 20:09

checkeredshawn: Jul 16, 2007

I appreciate the advice, Erasmus Darwin, but to clarify, I'm trying to shorten the script. I figured I could find some module that would help me better compare the data, but I've failed to find any such module through cpan.

# ? Jul 17, 2008 20:13

<deleted user>

checkeredshawn posted:

I appreciate the advice, Erasmus Darwin, but to clarify, I'm trying to shorten the script. I figured I could find some module that would help me better compare the data, but I've failed to find any such module through cpan.

Shorter? This is only three lines and creates a structure with the comparisons you want...

code:

&nbsp;
    my %compare = %servervalues;
    map { 
        my $ips = $_;
        $_ = {
            'result' => $ips,
            'same' => [ grep { $servervalues{$_} eq $ips } keys(%servervalues) ],
            'unsame' => [ grep { $servervalues{$_} ne $ips } keys(%servervalues) ],
        };
    } @compare{keys(%compare)};
    printf(
        "%s\n -> differs from '%s'\n -> same as '%s'\n", $_,
        join(', ', @{$compare{$_}->{unsame}}),
        join(', ', @{$compare{$_}->{same}})
    ) foreach(keys(%compare));

# ? Jul 18, 2008 00:21

TiMBuS: Sep 25, 2007; LOL WUT?

genericadmin posted:

code:

@compare{keys(%compare)};

wat
isn't that the same as values(%compare)?

# ? Jul 18, 2008 07:30

<deleted user>

TiMBuS posted:

wat
isn't that the same as values(%compare)?

It is. I had @compare{keys(%different_hash)} there before and changed it. But values would be better because it is faster than a slice.

# ? Jul 18, 2008 15:34

xobofni: Mar 28, 2003

I have this code which queries the root name servers for the NS records of a domain (nice and concise unlike dig +trace or whois records).

code:

#!/usr/bin/perl -w

use Net::DNS;

# root name servers
@root_servers = (
    '198.41.0.4', 
    '192.228.79.201', 
    '192.33.4.12', 
    '128.8.10.90', 
    '192.203.230.10', 
    '192.5.5.241', 
    '192.112.36.4', 
    '128.63.2.53', 
    '192.36.148.17', 
    '192.58.128.30', 
    '193.0.14.129', 
    '199.7.83.42', 
    '202.12.27.33');
$domain = $ARGV[0];

# find the authoritative name servers for this TLD
$resolver = Net::DNS::Resolver->new(
    nameservers => [$root_servers[int(rand($#root_servers + 1))]],
    recurse => 0);
$response = $resolver->send($domain);
die 'Failed to query root name servers.' if !defined($response);

# query authoritative servers for that TLD
$resolver->nameservers(($response->authority)[0]->rdatastr);
$response = $resolver->send($domain);
die 'Failed to query authoritative name server for TLD.' if !defined($response);

# if there's an SOA record, it's not registered
if ([u]($response->authority)[0]->type[/u] eq 'SOA') {
    print "Domain not registered.\n";
    exit;
}

# additional means we have glue records, so print those along side NS records
if ([u]int($response->additional)[/u]) {
    foreach $rr ($response->authority) {:
        @glue = grep { [u]$a = $_->name; $rr->rdatastr =~ /$a/i[/u] } $response->additional;
        @glue = map { $_->rdatastr } @glue;
        print lc($rr->rdatastr);
        print " (".join(', ', @glue).")" if (defined(@glue));
        print "\n";
    }
}
# no glue, just print NS records
else {
    print $_->rdatastr."\n" foreach ($response->authority);
}

Couple of questions regarding the underlined portions.

1. Can someone tell me what $response->authority actually is? Printed as string, it looks like Net::DNS::RR::A=HASH(0x9060438) Net::DNS::RR::A=HASH(0x90604a4)... which doesn't seem to be an Array or reference to one.

2. And why does the syntax I'm using the reference the elements in the array work (just using parentheses instead of something like @{})?

3. In line with the previous questions, what are the alternative ways to get the scalar value of it (instead of using int())?

4. Instead of using $a, can I somehow embed $_->name into the regular expression?

Comments on anything else in the program are appreciated as well.

xobofni fucked around with this message at 19:07 on Jul 20, 2008

# ? Jul 20, 2008 19:05

Triple Tech: Jul 28, 2006; So what, are you quitting to join Homo Explosion?

xobofni posted:

1. Can someone tell me what $response->authority actually is? Printed as string, it looks like Net:NS::RR::A=HASH(0x9060438) Net:NS::RR::A=HASH(0x90604a4)... which doesn't seem to be an Array or reference to one.

2. And why does the syntax I'm using the reference the elements in the array work (just using parentheses instead of something like @{})?

3. In line with the previous questions, what are the alternative ways to get the scalar value of it (instead of using int())?

4. Instead of using $a, can I somehow embed $_->name into the regular expression?

1. It's an object* that you're trying to look at in scalar context, i.e. you're not interfacing with it as intended. * There are no real objects in Perl, just a system of blessed hashes.

2. Because the slice notation works fine for lists. You could say print +(1, 2, 3)[0] and it prints 1 (the plus sign is unrelated but required for this example).

3. Not even sure what you mean.

4. Probably, but you shouldn't, for the sake of clarity.

# ? Jul 20, 2008 19:24

Kidane: Dec 15, 2004; DANGER TO MANIFOLD

Triple Tech posted:

1. It's an object* that you're trying to look at in scalar context, i.e. you're not interfacing with it as intended. * There are no real objects in Perl, just a system of blessed hashes.

2. Because the slice notation works fine for lists. You could say print +(1, 2, 3)[0] and it prints 1 (the plus sign is unrelated but required for this example).

3. Not even sure what you mean.

4. Probably, but you shouldn't, for the sake of clarity.

Regarding question #1 you may want to try dumping the object since it may help you visualize it better.

Use Data::Dumper;
<code...>
$response = $resolver->send($domain);
print Dumper $response;

# ? Jul 20, 2008 23:00

Ninja Rope: Oct 22, 2005; Wee.

To expand on what Triple Tech wrote...

xobofni posted:

1. Can someone tell me what $response->authority actually is? Printed as string, it looks like Net::DNS::RR::A=HASH(0x9060438) Net::DNS::RR::A=HASH(0x90604a4)... which doesn't seem to be an Array or reference to one.

The authority method returns an array of Net::DNS::RR objects, and you are correctly accessing the first element with [0]. I think you're confused because of how you printed out the return value from authority, since printing out the contents of an array prints out each of its elements as a string without directly telling you that you printed an array.

xobofni posted:

2. And why does the syntax I'm using the reference the elements in the array work (just using parentheses instead of something like @{})?

That syntax is used for array references. You're working with an array here, not an array reference, so that syntax is not needed.

xobofni posted:

3. In line with the previous questions, what are the alternative ways to get the scalar value of it (instead of using int())?

You don't need to use int there, the if should work fine without it. In general, if you want the length of an array, you should use the scalar function. Using int forces the returned array into scalar context (which is the array's length), and the converts it to an integer (which it already is). Using int does the same thing as using scalar but with an extra layer of indirection (and confusion).

# ? Jul 20, 2008 23:08

xobofni: Mar 28, 2003

Thanks for the replies

# ? Jul 21, 2008 04:46

maskenfreiheit: Dec 30, 2004

Hi, I'm a major beginner, just finished Beginning Perl and am working on one of my first programs. So I have this code for one of the functions, that deals with a long file of 3 digit numbers (area codes to be specific)

It's meant to loop through a data file, which very simple: just area codes, seperated by spaces. This is the code I have so far.

code:

sub ThreeDigitMost{
        my %ThreeHash;
        my %hash;

        while (<>) {
                chomp($_); 
                $ThreeHash{$_}++; 
                        }

        foreach my $key (keys %ThreeHash){
                print "$key appeared $ThreeHash{$key} times.\n";
        }
}

ThreeDigitMost();

However, instead of my intended result (going through each 3 digit value and incrementing the appropriate spot in the hash), it seems to tell me that the entire file (a long list of area codes, separated by spaces) appeared once. Technically, it's correct, but how can I get it to present the results way I'm trying for?

# ? Jul 21, 2008 05:22

Triple Tech: Jul 28, 2006; So what, are you quitting to join Homo Explosion?

Seperated by spaces or new lines? The <> operator only seperates automatically by new lines. So, if you want by spaces, you're going to have to cut up each line of numbers first, and then pump your counter algo into it, which on the surface looks sound.

Does the output say something like "732 201 212 973
appeared 1 times."

# ? Jul 21, 2008 05:51

Erasmus Darwin: Mar 6, 2001

Triple Tech posted:

So, if you want by spaces, you're going to have to cut up each line of numbers first, and then pump your counter algo into it, which on the surface looks sound.

In which case, the 'split' function is probably what you want. You feed it a regexp and a string, and it splits the string into an array of strings using the regexp as the separator. For example:

split /:/, 'foo:bar:baz' would return [ 'foo', 'bar', 'baz' ]. (Note that the separator, ':' in this case, is completely removed from the output.)

Also, since the output of split is an array, you can quickly iterate through it using a foreach loop.

Here's one way to write the main read/processing loop (in spoiler tags because it's worth trying to figure it out on your own first):

code:

[spoiler]while (<>) {
    chomp; # Implicitly acts on $_.
    foreach (split /\s/, $_) {
        $ThreeHash{$_}++;
    }
}[/spoiler]

Also, I abused $_ a bit in there. Don't let that throw you. A more explicit version would be:

code:

[spoiler]while (my $line = <>) {
    chomp $line;
    foreach my $code (split /\s/, $line) {
        $ThreeHash{$code}++;
    }
}[/spoiler]

That effectively does the same thing as the last block.

Also, there are other ways to do it besides using split. For example, you can use a loop that iterates on the regexp operator with the 'g' flag in order to have it return every 3 digit block in a given string. That works better if your file's not in a consistent format or if there's a lot of stuff you're skipping over. For example, that'd be the way to go if you wanted to count every area code embedded in a bunch of English text talking about the joys of area codes.

# ? Jul 21, 2008 14:16

maskenfreiheit: Dec 30, 2004

Triple Tech posted:

Seperated by spaces or new lines? The <> operator only seperates automatically by new lines. So, if you want by spaces, you're going to have to cut up each line of numbers first, and then pump your counter algo into it, which on the surface looks sound.

Does the output say something like "732 201 212 973
appeared 1 times."

You're right, I went into my other script that grabbed the data and had it add newlines and everything works now. Thanks.

# ? Jul 21, 2008 18:13

Ninja Rope: Oct 22, 2005; Wee.

This is a perfect time to do something like:

code:

local $/ = ' '; # Change the input record separator to a single space while we
                # read our area code file, since the area codes are space-
                # delimited and not newline-delimited.

You can then use <> as before.

(Although, if performance was an issue, it would be better to read from the file 4 bytes at a time (3 for the area code + 1 for the trailing space) and chop the result. Let the OS handle the prefetching by specifying the correct flags to sysopen.)

# ? Jul 21, 2008 23:35

uG: Apr 23, 2003; by Ralp

code:

sub trade : Runmode {
   my $self = shift;
   (undef, undef, my $nid) = split(/\//, $ENV{'PATH_INFO'});
   
   my $trade_ref = $self->DB_get_trades($self->session->param('uid'));
   #DB_get_trades returns a reference to an array of hash references

   #Not activating TMPL_LOOP 'TRADE_INFO' or setting TMPL_VARs inside loop
   return $self->html_generate("trade.html", TRADE_INFO => $trade_ref);

}

Basically I want to be able to pass html_generate TRADE_INFO => $array_reference_of_hashrefs. I've been tinkering with this too long today to explain things clearly, so if you guys need any more info please ask! This simple thing is killing me

EDIT: html_generate just sets the HTML::Template variables and template page and returns the output

Heres DB_get_trades just incase i'm returning things wrong...

code:

sub DB_get_trades{
    my $self = shift;
    my $uid = shift;
    my $sql = qq{SELECT * FROM trade_info WHERE id1 = ?};
    my $sth = $self->dbh->prepare($sql) or die "Cannot prepare: " . $dbh->errstr();
       $sth->execute($uid) or die "Cannot execute: " . $sth->errstr();
    my @row;
    my @fields;
    my @trade_nations;

   while(@row = $sth->fetchrow_array()) {
      my @record = @row;
      push(@fields, \@record);
   }

   $sth->finish();

   if (@fields != 0) {
      my $i=0;

      foreach my $line (@fields) {
          if(@$line[1] != $uid) {
               push(@trade_nations, @$line[1]);
          }
          else {
               push(@trade_nations, @$line[2]);
          }

         $i++;
      }
   }

   my @resource_loop;

   foreach(@trade_nations) {
            my $resource_hash = $self->dbh->selectrow_hashref("SELECT * FROM nation_info WHERE id = ?", undef, $_);

            push(@resource_loop, %resource_hash);
   }

   return \@resource_loop;
}

# ? Jul 22, 2008 05:35

Ninja Rope: Oct 22, 2005; Wee.

uG posted:

code:

   my @resource_loop;

   foreach(@trade_nations) {
            my $resource_hash = $self->dbh->selectrow_hashref("SELECT * FROM nation_info WHERE id = ?", undef, $_);

            push(@resource_loop, %resource_hash);
   }

   return \@resource_loop;
}

Does this code run under use strict? Where is %resource_hash defined? Are you sure you don't mean to push $resource_hash instead?

# ? Jul 22, 2008 09:31

uG: Apr 23, 2003; by Ralp

Ninja Rope posted:

Does this code run under use strict? Where is %resource_hash defined? Are you sure you don't mean to push $resource_hash instead?

It runs under strict, and instead of pushing %resource_hash I think I should be pushing $resource_hash. Unfortunately that is not the problem

EDIT: Problem solved. Just needed some sleep and a clear mind

uG fucked around with this message at 18:27 on Jul 22, 2008

# ? Jul 22, 2008 18:01

maskenfreiheit: Dec 30, 2004

...

maskenfreiheit fucked around with this message at 04:22 on Sep 29, 2010

# ? Jul 23, 2008 01:27

Filburt Shellbach: Nov 6, 2007; Apni tackat say tujay aaj mitta juu gaa!

Why are you using my $hash{key}? Just remove the mys.

# ? Jul 23, 2008 01:31

maskenfreiheit: Dec 30, 2004

...

maskenfreiheit fucked around with this message at 04:23 on Sep 29, 2010

# ? Jul 23, 2008 01:42

Triple Tech: Jul 28, 2006; So what, are you quitting to join Homo Explosion?

The data structure must exist outside the scope of the Evaluate function. Just collapse the ThreeDigitMost subroutine into regular code and put the Evaluate definition all the way at the bottom.

# ? Jul 23, 2008 01:50

maskenfreiheit: Dec 30, 2004

...

maskenfreiheit fucked around with this message at 04:23 on Sep 29, 2010

# ? Jul 23, 2008 02:08

tef: May 30, 2004; -> some l-system crap ->

You could just do this:

code:

#!/usr/bin/perl
use strict;

#ThreeDigitMost loops through the stripped numbers, then stores 
#which ones came up the most often in a hash. 
#This hash is then sorted and printed.

my %ThreeHash;  
while (<>) {
        chomp; 
        $ThreeHash{$_}++;
}
foreach my $key (sort {$ThreeHash{$a} <=>$ThreeHash{$b}} (keys(%ThreeHash))) {
        print "$key appeared $ThreeHash{key} times\n";
}

The idiom you might like is the: http://en.wikipedia.org/wiki/Schwartzian_transform

code:

#!/usr/bin/perl
use strict;

my %ThreeHash;  

while (<>) {
        chomp; 
        $ThreeHash{$_}++;
}

@sorted = map  { $_->[0] }
          sort { $a->[1] cmp $b->[1] }
          map  { [$_, $ThreeHash($_)] }
          keys(%ThreeHash);

foreach my $key (@sorted) {
        print "$key appeared $ThreeHash{key} times\n";
}

Alternatively: cat numbers.txt | sort -n | uniq -c

tef fucked around with this message at 02:19 on Jul 23, 2008

# ? Jul 23, 2008 02:15

Ninja Rope: Oct 22, 2005; Wee.

Add use warnings; right before use strict; or you're fired. Out of a cannon. Into the sun.

# ? Jul 23, 2008 05:24

Mario Incandenza: Aug 24, 2000; Tell me, small fry, have you ever heard of the golden Triumph Forks?

Thanks to strict.pm's 33% stacking combo against skeletons you're better off loading it first, then warnings. But hey, whatever works for you.

In the meantime the horrible code I'm paid to stop spontaneously combusting all the time is driving me insane, how do you guys mentally cope when dealing with really bad code all day, every day?

Mario Incandenza fucked around with this message at 15:14 on Jul 23, 2008

# ? Jul 23, 2008 15:08

more falafel please: Feb 26, 2005; forums poster

Ninja Rope posted:

Add use warnings; right before use strict; or you're fired. Out of a cannon. Into the sun.

I thought the generally accepted canon was

code:

#!/usr/bin/perl -w
use strict;

Or is use warnings; preferred now?

# ? Jul 23, 2008 16:55

Mario Incandenza: Aug 24, 2000; Tell me, small fry, have you ever heard of the golden Triumph Forks?

perl -w enables warnings globally, which you might not want. use warnings is lexical, and only affects the current file/sub/block.

# ? Jul 23, 2008 17:08

more falafel please: Feb 26, 2005; forums poster

SpeedFrog posted:

perl -w enables warnings globally, which you might not want. use warnings is lexical, and only affects the current file/sub/block.

Ah, good point.

# ? Jul 23, 2008 17:08

Triple Tech: Jul 28, 2006; So what, are you quitting to join Homo Explosion?

Also not all platforms (Windows) respect the shebang.

# ? Jul 23, 2008 17:16

Erasmus Darwin: Mar 6, 2001

Triple Tech posted:

Also not all platforms (Windows) respect the shebang.

Windows obviously doesn't use the shebang to invoke perl, but perl on Windows (or at least the copy of ActivePerl that I've got installed here) is smart enough to manually parse the shebang line once it's invoked. So "#!/usr/bin/perl -w" still works on Windows.

# ? Jul 23, 2008 18:36

Triple Tech: Jul 28, 2006; So what, are you quitting to join Homo Explosion?

Is there a way to see how much Perl I know? Or how much I stack up against the competition? I'm reading this job posting and wonder if I qualify. I probably don't.

I've heard any of the following are metrics for god-like Perl programmers:

� contributing to perl itself (5 or 6)
� working with XS
� publishing to CPAN

I've done nothing of the sort. Am I not as good as I think I am?

# ? Jul 23, 2008 19:35

tef: May 30, 2004; -> some l-system crap ->

Triple Tech posted:

Am I not as good as I think I am?

Yes.

I would expect the top 1% of perl hackers to understand lexical scope.

# ? Jul 23, 2008 19:57

Easychair Bootson: May 7, 2004; _{Where's the last guy?

Ultimo hombre.

Last man standing.

Must've been one.}

I used to be handy enough with Perl that I could probably hack my way to a solution for this problem in a relatively short amount of time, but what little skill I had has atrophied since I moved out of development.

I've got files named foo1.jpg, foo2.jpg, ... foo521.jpg

No, they're not porn. I just want to rename them with the integer part of the filename padded with zeros (foo001.jpg, foo002.jpg, ...). Given that this can probably be done with about three lines of Perl, can anyone offer a quick solution? Google wasn't very helpful, or maybe I just suck at crafting searches.

# ? Jul 27, 2008 04:59

Filburt Shellbach: Nov 6, 2007; Apni tackat say tujay aaj mitta juu gaa!

GroovinPickle posted:

I've got files named foo1.jpg, foo2.jpg, ... foo521.jpg

No, they're not porn. I just want to rename them with the integer part of the filename padded with zeros (foo001.jpg, foo002.jpg, ...).

First, you suck for posting this in the Perl thread.

If you have the rename perl script:

rename 's/\d+/sprintf "%03d", $&/' foo*.jpg

Otherwise,

perl -e 'for (@ARGV) { my $old = $_; s/\d+/sprintf "%03d", $&/; rename $old => $_ }' foo*.jpg

# ? Jul 27, 2008 05:05

Easychair Bootson: May 7, 2004; _{Where's the last guy?

Ultimo hombre.

Last man standing.

Must've been one.}

This worked for me:

rename 's/\d+/sprintf "%03d", $&/e' foo*.jpg

# ? Jul 27, 2008 05:43

Filburt Shellbach: Nov 6, 2007; Apni tackat say tujay aaj mitta juu gaa!

Ah. Good catch. Sorry.

# ? Jul 27, 2008 05:51

uG: Apr 23, 2003; by Ralp

/folder/
/folder/number
/folder/number/filename

Is there a regex that will match the above 3 strings, but will capture number and filename *if* they exist?

# ? Jul 28, 2008 07:02

Adbot: ADBOT LOVES YOU

# ? May 17, 2024 04:04

xobofni: Mar 28, 2003

uG posted:

/folder/
/folder/number
/folder/number/filename

Is there a regex that will match the above 3 strings, but will capture number and filename *if* they exist?

Here ya go.

quote:

# for i in "/folder/" "/folder/number" "/folder/number/filename"; do echo -e "\n=== $i"; echo $i | perl -ne 'chomp;/\/[^\/]*\/([^\/]*)[\/]*(.*)/; print "num = $1\nfilename = $2\n";'; done

=== /folder/
num =
filename =

=== /folder/number
num = number
filename =

=== /folder/number/filename
num = number
filename = filename

Might add some more specific character set matching for the "number" and "filename," but not really necessary.

# ? Jul 28, 2008 08:06

The Something Awful Forums > Discussion > Serious Hardware/Software Crap > The Cavern of COBOL > The Perl Short Questions Megathread: executable line noise

«‹›72 »