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 »

Blotto Skorzany: Nov 7, 2008; He's a PSoC, loose and runnin'
came the whisper from each lip
And he's here to do some business with
the bad ADC on his chip
bad ADC on his chiiiiip

Casao posted:

When did stat start returning an arrayref instead of an array? Cause every thing I can find on the internet says it'll return an array, but I have to reference before I can pull any thing out.

code:

mike@cheez-it:~/src/asm/cat$ perl -E 'say for stat "./cat.s"'
51713
394960
33188
1
1001
1001
0
2202
1301077328
1284266228
1284266228
4096
8

# ? Apr 23, 2011 01:57

Adbot: ADBOT LOVES YOU

# ? May 21, 2024 22:39

welcome to hell: Jun 9, 2006

There are a couple modules, File::stat and File::Stat (ugh), that can replace the stat function with a different version. Perhaps one of those is causing your problem.

# ? Apr 23, 2011 12:17

Clanpot Shake: Aug 10, 2006; shake shake!

Is there an easy way to get the difference between 2 calls of localtime(time)? Like break it down by hours/minutes/seconds?

# ? Apr 25, 2011 21:46

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

Call localtime in list context and it gives you the breakdown. From there all you need to do is subtract each element in a loop (or if you're feeling wizardly, use List::MoreUtils's pairwise).

# ? Apr 25, 2011 23:12

syphon: Jan 1, 2001

It's not terribly pretty code, but here's what I use to grab the time into a nice, human-readable format. I think I stole it from somewhere off the internet.

code:

my ($year, $month, $mday, $hour, $min, $sec) = (localtime)[5,4,3,2,1,0];
$year += 1900;
$month++;
$month = "0" . $month if ($month < 10);
$mday = "0" . $mday if ($mday < 10);
$hour = "0" . $hour if ($hour < 10);
$min = "0" . $min if ($min < 10);
$sec = "0" . $sec if ($sec < 10);

# ? Apr 26, 2011 01:39

Anaconda Rifle: Mar 23, 2007; Yam Slacker

If you want ugly code, here you go:

code:

printf "%d/%d/%d %d:%02d:%2d\n", (localtime)[4] + 1, (localtime)[3], (localtime)[5] + 1900, (localtime)[2,1,0];

(American mm/dd/yyyy)

# ? Apr 26, 2011 02:26

Ninja Rope: Oct 22, 2005; Wee.

There are also a million date manipulating modules you could use. Date::Time, Date::Manip, and Date::Calc come to mind.

# ? Apr 26, 2011 04:25

uG: Apr 23, 2003; by Ralp

code:


package Catalyst::TraitFor::Request::REST::ForBrowsers;
use Moose::Role;
use namespace::autoclean;

with 'Catalyst::TraitFor::Request::REST';

our $VERSION = '0.90';
$VERSION = eval $VERSION;

has _determined_real_method => (
    is  => 'rw',
    isa => 'Bool',
);

has looks_like_browser => (
    is       => 'rw',
    isa      => 'Bool',
    lazy     => 1,
    builder  => '_build_looks_like_browser',
    init_arg => undef,
);

# All this would be much less gross if Catalyst::Request used a builder to
# determine the method. Then we could just wrap the builder.
around method => sub {
    my $orig = shift;
    my $self = shift;

    return $self->$orig(@_)
        if @_ || $self->_determined_real_method;

    my $method = $self->$orig();

    my $tunneled;
    if ( defined $method && uc $method eq 'POST' ) {
        $tunneled = $self->param('x-tunneled-method')
            || $self->header('x-http-method-override');
    }

    $self->$orig( defined $tunneled ? uc $tunneled : $method );

    $self->_determined_real_method(1);

    return $self->$orig();
};

{
    my %HTMLTypes = map { $_ => 1 } qw(
        text/html
        application/xhtml+xml
    );

    sub _build_looks_like_browser {
        my $self = shift;

        my $with = $self->header('x-requested-with');
        return 1
            if $with && grep { $with eq $_ }
                qw( HTTP.Request XMLHttpRequest );

        if ( uc $self->method eq 'GET' ) {
            my $forced_type = $self->param('content-type');
            return 1
                if $forced_type && !$HTMLTypes{$forced_type};
        }

        # IE7 does not say it accepts any form of html, but _does_
        # accept */* (helpful ;)
        return 1
            if $self->accepts('*/*');

        return 1
            if grep { $self->accepts($_) } keys %HTMLTypes;

        return 1
            if @{ $self->accepted_content_types() };

        # If the client did not specify any content types at all,
        # assume they are a browser.
        return 1;
    }
}

1;

__END__

The above code is from Catalyst::TraitFor::Request::REST::ForBrowsers, except I have change the return 0s to return 1s. I did this because Catalyst::Action::REST::ForBrowsers was giving me a non-browser response for a POST request. It handled GET fine, so I don't know where to look next. The headers are clearly not the deciding factor since I changed all the returns as mentioned before. :confused:

# ? Apr 26, 2011 06:46

octobernight: Nov 25, 2004; High Priest of the Christian-Atheist Church

qntm posted:

That solution does work, but I foresee problems if the existing tree already contains elements ending in "_foo", e.g. "A" and "A_foo". The existing "A" will be converted to "A_foo" on the first pass, while the existing "A_foo" will be left alone. On the second pass, you will end up with "A_foo_foo" and "A_foo_foo" respectively, which is wrong.

This might work instead:
code:
$string =~ s/([$,])([^,$;]+)/$1$2_foo/sg;

Ah, you're correct. I didn't realize that problem. Thank you for pointing that out! I'll try your code snippet.

# ? Apr 26, 2011 08:02

qntm: Jun 17, 2009

uG posted:

code:

with 'Catalyst::TraitFor::Request::REST';

What does this mean? "with" is not a built-in Perl function and it doesn't seem to have been imported from anywhere.

Actually, nor are "has" or "around". Also, what is the point of "$VERSION = eval $VERSION;"?

# ? Apr 26, 2011 10:33

Mithaldu: Sep 25, 2007; Let's cuddle.

qntm posted:

What does this mean? "with" is not a built-in Perl function and it doesn't seem to have been imported from anywhere.

Actually, nor are "has" or "around". Also, what is the point of "$VERSION = eval $VERSION;"?

They come from Moose::Role. No idea about the version thing though.

# ? Apr 26, 2011 11:57

Clanpot Shake: Aug 10, 2006; shake shake!

Anaconda Rifle posted:

If you want ugly code, here you go:
code:
printf "%d/%d/%d %d:%02d:%2d\n", (localtime)[4] + 1, (localtime)[3], (localtime)[5] + 1900, (localtime)[2,1,0];
(American mm/dd/yyyy)

Thanks to you and the other people, but you seem to have misread my question. I'll be more clear.

I have a script that runs a set of instructions and can take anywhere from under a minute to several hours depending on the input. I'd like to print to the log file when it's finished how long the whole thing took. I'm using this at the start and end of the log:

pre:

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
$stamp = "Start logger.err\n%4d-%02d-%02d %02d:%02d:%02d\n======================================";
printf $stamp,$year+1900,$mon+1,$mday,$hour,$min,$sec;
printf $log $stamp,$year+1900,$mon+1,$mday,$hour,$min,$sec;   # $log is the output file

Think this takes the gold for ugly code, but it works.

Anyway, I'd like to get the difference in time between the first printing and the last - how long the whole thing took.

# ? Apr 26, 2011 14:10

clockwork automaton: May 2, 2007; You've probably never heard of them.; Fun Shoe

Clanpot Shake posted:

Thanks to you and the other people, but you seem to have misread my question. I'll be more clear.

I have a script that runs a set of instructions and can take anywhere from under a minute to several hours depending on the input. I'd like to print to the log file when it's finished how long the whole thing took. I'm using this at the start and end of the log:
pre:
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
$stamp = "Start logger.err\n%4d-%02d-%02d %02d:%02d:%02d\n======================================";
printf $stamp,$year+1900,$mon+1,$mday,$hour,$min,$sec;
printf $log $stamp,$year+1900,$mon+1,$mday,$hour,$min,$sec;   # $log is the output file
Think this takes the gold for ugly code, but it works.

Anyway, I'd like to get the difference in time between the first printing and the last - how long the whole thing took.

What you really want to do is get the start time and store that in a variable and the end time as a variable and subtract.

# ? Apr 26, 2011 15:40

uG: Apr 23, 2003; by Ralp

Mithaldu posted:

They come from Moose::Role. No idea about the version thing though.

http://www.dagolden.com/index.php/369/version-numbers-should-be-boring/

It mainly has to do with CPAN and using _ in the version.

code:

our $VERSION = 0.001_001; # WRONG: parse_version() gives 0.001001

our $VERSION = "0.001_001;
$VERSION = eval $VERSION; #CORRECT

quote:

The eval converts the string "0.001_001" to a number, following the rules for Perl numeric literals (which allow underscores for visual separation). The result is the number 0.001001.
Without the eval, the string is converted to a number following the rule for converting strings, which stops at the first non-numeric character.
E.g.: perl -e 'print "0.001_001" + 0'

uG fucked around with this message at 15:53 on Apr 26, 2011

# ? Apr 26, 2011 15:48

Clanpot Shake: Aug 10, 2006; shake shake!

clockwork automaton posted:

What you really want to do is get the start time and store that in a variable and the end time as a variable and subtract.

This is what I get when I store each call in different variables and subtract them:

pre:

Start logger.err
2011-04-26 11:36:25
======================================
======================================
End logger.err
2011-04-26 11:37:10
Total time taken: 00:01:-15

# ? Apr 26, 2011 16:40

uG: Apr 23, 2003; by Ralp

Clanpot Shake posted:

This is what I get when I store each call in different variables and subtract them:
pre:
Start logger.err
2011-04-26 11:36:25
======================================
======================================
End logger.err
2011-04-26 11:37:10
Total time taken: 00:01:-15

Subtract the epoch of each time (use DateTime). Alternatively:

code:

use Date::Manip;

$start_date = "01/31/2010";
$end_date =  "02/01/2010";

$date1 = ParseDate($start_date);
$date2 = ParseDate($end_date);
$diff = DateCalc($date1, $date2);

print "$diff";

# ? Apr 26, 2011 17:14

Clanpot Shake: Aug 10, 2006; shake shake!

uG posted:

Subtract the epoch of each time (use DateTime). Alternatively:

code:

use Date::Manip;

$start_date = "01/31/2010";
$end_date =  "02/01/2010";

$date1 = ParseDate($start_date);
$date2 = ParseDate($end_date);
$diff = DateCalc($date1, $date2);

print "$diff";

This works, thanks. Out of curiosity, does localtime(time) return drastically different results between linux and windows? I'm running this on linux and it looks good, wondering if it will look the same on windows.

# ? Apr 26, 2011 19:14

uG: Apr 23, 2003; by Ralp

I tracked my problem down to Catalyst::Action::REST, which only checks the traits during a GET request. It still sets the flag looks_like_browser, so I can just check inside the POST method. But I can't help and think there is a reason they did this, even though it seems you would want to return different things on a POST depending on if it was a browser request or a non browser REST request.

Clanpot Shake posted:

This works, thanks. Out of curiosity, does localtime(time) return drastically different results between linux and windows? I'm running this on linux and it looks good, wondering if it will look the same on windows.

I believe so, you might have to set the TZ ENV if it doesn't work.

# ? Apr 27, 2011 03:18

uG: Apr 23, 2003; by Ralp

code:

  	my @posts = map {
        	{
            		id      => $_->id,
            		user    => $_->user,
            		subject => $_->subject,
        	}
   		} $threads->all;

$self->status_ok($c, entity => {posts => {@posts}});

An example of this returns:

code:

{"posts":{"HASH(0x6982620)":{"subject":"Re: This is a new thread","user":"4","id":"80"},"HASH(0x6950088)":{"subject":"This is another new thread","user":"4","id":"78"}}}

I'm not quite sure what kind of structure that is, but its not doing what I want (which would be something like foreach post IN posts print post.id in the template).

# ? Apr 28, 2011 19:15

Roseo: Jun 1, 2000; Forum Veteran

I don't do MVC much, but I'm pretty sure you want:

code:

$self->status_ok($c, entity => {posts => \@posts});

code:

$self->status_ok($c, entity => {posts => [@posts]);

You're using @posts in list context to build an anon hash which is what's giving you your screwy data structure.

# ? Apr 30, 2011 22:49

qntm: Jun 17, 2009

How do I get an anonymous reference to the keys of a hash?

I have a subroutine which expected a single argument, and that argument should be a reference to an array.

I want to extract the keys from a hash and submit those keys to my subroutine, ideally in a one-liner instead of having to create a named @keys array.

The problem is, creating a reference to a the array returned by "keys" actually creates a an array of references to keys. Why Perl does this, I have absolutely no idea. But how do I stop it?

code:

sub processArray {
 my @array = @{ shift @_ };
 # do something with the array
}

my %hash = ("key1" => "value1", "key2" => "value2");

processArray( sort keys %hash );    # wrong, calls processArray("key1", "key2")
processArray( \(sort keys %hash) ); # wrong, calls processArray(\"key1", \"key2")
processArray( ??? );                # should call processArray(["key1", "key2"])

# ? May 9, 2011 13:06

Mithaldu: Sep 25, 2007; Let's cuddle.

You use [] to create a reference to an anonymous array:

code:

processArray( [ sort keys %hash ] );

# ? May 9, 2011 13:20

qntm: Jun 17, 2009

Yes, I just realised. I've used square brackets to make anonymous arrays in a [1, 2, 3] kind of style about a million times, but I never realised you could use them like "[(1, 2, 3)]" or "[@keys]" before. I kind of assumed that would return an array with only one array reference as an element.

# ? May 9, 2011 13:29

uG: Apr 23, 2003; by Ralp

Any advice for building a port scanner/proxy finder, module wise? Right now i'm using Nmap::Scanner to get a list of open ports. Next i'll probably use LWP::UserAgent to try to connect via proxy to a txt file on the server to see if the open port is a proxy.

I'm also supposed to detect the difference between:

quote:

Anonymity levels - applies for http/https proxies only.
Level 1: No anonymity; remote host knows your IP and knows you are using proxy.
Level 4: Low anonymity; remote host does not know your IP, but it knows you are using proxy.
Level 8: Medium anonymity; remote host knows you are using proxy, and thinks it knows your IP, but this is not yours (this is usually a multihomed proxy which shows its inbound interface as REMOTE_ADDR for a target host).
Level 16: High anonymity; remote host does not know your IP and has no direct proof of proxy usage (proxy-connection family header strings). If such hosts do not send additional header strings it may be considered as high-anonymous. If a high-anonymous proxy supports keep-alive you can consider it to be extremely-anonymous. However, such a host is highly possible to be a honey-pot.

Am I going to have to connect through the proxy to a known cgi script which would return all the ENV variables, and then compare them to what they should be?

uG fucked around with this message at 03:49 on May 16, 2011

# ? May 14, 2011 23:59

mister_gosh: May 24, 2002

How can I print the current package or program name?

Pseudo code:

code:

package abc;

...

print "Name of current package is " . __PACKAGE_NAME__ . "\n";

# ? May 17, 2011 17:12

qntm: Jun 17, 2009

mister_gosh posted:

How can I print the current package or program name?

Pseudo code:
code:
package abc;

...

print "Name of current package is " . __PACKAGE_NAME__ . "\n";

That is actually almost it.

code:

print __PACKAGE__."\n";

# ? May 17, 2011 17:47

mister_gosh: May 24, 2002

qntm posted:

That is actually almost it.

Thanks! That makes googling for it easier (left my Perl in a Nutshell book in the wrong location today.

# ? May 17, 2011 17:56

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

qntm posted:

code:

processArray( \(sort keys %hash) ); # wrong, calls processArray(\"key1", \"key2")

This is syntactic sugar to make building a list of refs easier. From perldoc perlref:

code:

As a special case, "\(@foo)" returns a list of references to the contents of
@foo, not a reference to @foo itself.  Likewise for %foo, except that the key
references are to copies (since the keys are just strings rather than full-
fledged scalars).

# ? May 18, 2011 01:41

syphon: Jan 1, 2001

Do you guys have any clever ideas for scraping a site and trying to extract relevant data from the HTML?

My buddy is trying to scrape some data for fantasy football from this site - http://www.nfl.com/fantasy/story/09000d5d817fb977/article/headline - Slurping up the HTML is trivial with LWP, but parsing out those stats would be very painful and expensive. This has to be a common problem that's been solved a million times before! I found a few modules that look applicable (HTML::Element, HTML::TreeBuilder) but I'm not sure what the easiest approach is.

# ? May 24, 2011 20:10

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

Web::Scraper is the poo poo. You can extract HTML using CSS selectors or XPath.

I used it recently to scrape the translation status of our project from a site that uses fixed-width images as progress bars.

code:

my $scraper = scraper {
    process '#languagestats tr.stats', 'languages[]' => scraper {
        process 'td > a',
            name => 'TEXT',
            link => '@href';

        process 'td > img',
            translated => '@width';
    };
};

my $results = $scraper->scrape(URI->new('https://...'));

__END__
$results = {
    languages => [
       {
         link       => URI->new('https://...'),
         name       => 'Arabic',
         translated => 17.0118343195
       },
       {
         link       => URI->new('https://...'),
         name       => 'Armenian',
         translated => 1.18343195266
       },
       {
         link       => URI->new('https://...'),
         name       => 'Brazilian Portuguese',
         translated => 81.3609467456
       },
       .
       .
       .
    ]
}

Filburt Shellbach fucked around with this message at 20:23 on May 24, 2011

# ? May 24, 2011 20:16

leedo: Nov 28, 2000

I've been using Web::Scraper recently too for writing a generic content embedding service, similar to what twitter does for certain links in tweets. Here is an example that scrapes the title and introduction to wikipedia articles.

# ? May 24, 2011 20:40

mobby_6kl: Aug 9, 2009; by Fluffdaddy

Let's turn this into a "Stupid question megathread" for a second, because I certainly feel stupid for not seeing why this won't work:

code:

while (split /\n/, get('http://example.com') ) {
	if (/something/) {
		#blah blah
	} 
}

Of course LWP::Simple is included and get works properly, but it just won't split the text as expected :wtf:

# ? May 25, 2011 00:31

Erasmus Darwin: Mar 6, 2001

mobby_6kl posted:

code:

while (split /\n/, get('http://example.com') ) {

Shouldn't this be 'for' instead of 'while'?

# ? May 25, 2011 01:29

uG: Apr 23, 2003; by Ralp

Erasmus Darwin posted:

Shouldn't this be 'for' instead of 'while'?

or...

code:

my $n = 0;
while (${split /\n/, get('http://example.com')}[$n] ) {
	if (/something/) {
		#blah blah
	} 
	$n++;
}

Well, maybe

# ? May 25, 2011 01:47

syphon: Jan 1, 2001

Yeah doesn't split return an array, so you should iterate over it with "for" and not "while"? Correct me if I'm wrong (which I may be, since I'm not positive on this), but 'while' runs until its expression returns 0, which split will never do since it's feeding you an array instead.

# ? May 25, 2011 03:01

mobby_6kl: Aug 9, 2009; by Fluffdaddy

Yes, that's it :doh:

.
For some reason I was sure split worked with while (even though @a=split... still made sense to me :downs:

), so I thought I was screwing up something else. Thanks!

uG posted:

or...

code:

my $n = 0;
while (${split /\n/, get('http://example.com')}[$n] ) {
	if (/something/) {
		#blah blah
	} 
	$n++;
}

Well, maybe

This... doesn't seem to work

but that's ok because I'm not biased toward while in any way, and foreach does what I need.

# ? May 25, 2011 17:43

uG: Apr 23, 2003; by Ralp

I've created a simple port scanner/proxy tester. It tries to use open ip/port combos it finds as a proxy to connect to a specified URL, which shows me the connections ENV variables (so I can determine how anonymous it really is). I've now been told it needs to test proxies to see if they have keep alive enabled. I'm not quite sure how to handle that... would I need to send a Keep Alive header, and look for one sent back? Or does this involve keeping a socket open to listen and see if any keep alive packets are sent?

# ? May 28, 2011 05:04

Roseo: Jun 1, 2000; Forum Veteran

uG posted:

I've created a simple port scanner/proxy tester. It tries to use open ip/port combos it finds as a proxy to connect to a specified URL, which shows me the connections ENV variables (so I can determine how anonymous it really is). I've now been told it needs to test proxies to see if they have keep alive enabled. I'm not quite sure how to handle that... would I need to send a Keep Alive header, and look for one sent back? Or does this involve keeping a socket open to listen and see if any keep alive packets are sent?

If the socket stays open after a HTTP request/response, the proxy has keep alive on.

# ? May 28, 2011 12:15

uG: Apr 23, 2003; by Ralp

Roseo posted:

If the socket stays open after a HTTP request/response, the proxy has keep alive on.

How would I check that if i'm making my requests with LWP? Or will I need to use an actual socket?

I'm trying to see if I can access the underlying IO::Socket::INET that LWP uses, but I don't think I can...

uG fucked around with this message at 17:20 on May 28, 2011

# ? May 28, 2011 15:39

Adbot: ADBOT LOVES YOU

# ? May 21, 2024 22:39

wolffenstein: Aug 2, 2002; Pork Pro

I'm looking over code from an internship to see if I've gotten any better at coding. The project was to pull web logs from multiple servers then store and process them on a separate server. I created and used a XML file as the data structure of all the servers and the sites hosted on each server. I persuaded the server admin to install XML::Simple to simplify handling XML. During the project, a need arose to duplicate the structure and invert it like so:

code:

<root>
 <server>
  <server configuration/>
  <site>
   <site config/>
  </site>
 </server>
 # start invert here
 <site>
  <server>
   <server configuration/>
   <site's config on server/>
  </server>
  # maybe another server here if in middle of transition
 </site>
</root>

The only solution intern me found was to iterate through the XML structure with two loops (one for every server, one for every site on server) then use another two loops to update the inverted structure equivalent or create it. Here's the relevant code:

code:

# Add server to host
foreach my $hostReference (@{$configurationXMLContent->{host}}) {
	next if $hostReference->{currentlyHosted} =~ m/^false$/i;
	
	# Check each server listed in root XML tree
	foreach my $serverReference (@{$configurationXMLContent->{server}}) {
		
		# First, find if host is located on server
		my $hostFound = 0;
		foreach my $serverHostRef (@{$serverReference->{host}}) {
	
			# Find host in server tree
			next if $serverHostRef->{name} ne $hostReference->{name};
			$hostFound = 1;
			
			# Second, find if server is listed under host
			my $serverFound = 0;
			foreach my $hostServerRef (@{$hostReference->{server}}) {
				
				# If server listed under host, keep values current.
				if ($hostServerRef->{name} eq $serverReference->{name}) {
					$serverFound = 1;
					
					# update data
					
					last;
				}
			}
			last if $serverFound == 1;
			
			# If server not found, time to add it
			my %hostServerHash;

			# add data to %hostServerHash

			my $hostServerHashRef = \%hostServerHash;
			push(@{$hostReference->{server}}, $hostServerHashRef);
			
			last;
		}
		
		# If host not found, go to next server and repeat loop
		next if $hostFound == 0;
	}
}

Today I can't think up a better solution. Intern me commented this isn't a good solution. I'm looking for an outside evaluation. Could any of this be done better?

# ? May 28, 2011 17:54

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

«‹›72 »