/var/log/rant: July 2015

2015/07/29

Justifying My Existence: Indent Style

I just got dinked for my indent style on StackOverflow.

I wrote an answer to someone's question, even as I figured there are much better ways to handle his greater issue than store everything in text files like that.

Nearly immediately, I see this: For uncuddled elses the practice is to let the closing block brace } be vertically aligned with the following elsif.

I remember when I started coding oh so many years ago. I remember looking at GNU style and not liking it.

if ($boolean)
{
    ...
}

"You've disconnected the beginning brace from the conditional", I thought. "I can't code like that."

The other primary style people talk about is K&R.

if ($boolean) {
    ...
}

"Better", I thought. "The beginning of the block is connected to the conditional, so that's good. But the end. The brace at the end of the block won't tell you it's connected to the block at all. Nope."

It's about the readability. The part that's in the main part of the code is the if statement. The block should be separate from the sounding code, and this style (I'm told it's Ratliff style) is what I've been using since.

if ($boolean) {
    ...
    }

My first degree was in journalism, and part of how I proved myself in my first computing jobs is making the large text blocks of the early web attractive and readable. At least, as far as early web browsers let you. And, while I am a vocal Python hater, and a hater of significant white space in programming languages in general, by-the-books Python is close to how I like to format code. (Just be sure to tell your editor that \t is the devil's work and should be shunned.)

Below is my .perltidyrc. I believe I first started using that tool soon after I read Perl Best Practices by Damian Conway. Ironically, perhaps, I moved to the long form because I found the terse form found in PBP to be unreadable and uneditable, anyway.

	# my .perltidyrc config file
	# http://perldoc.perl.org/perlstyle.html

	# I'm using long-names for this because dotfiles are a place where
	# you go back and edit on occasion, so things like -nsbl are not
	# things you will understand, but --noopening-sub-brace-on-new-line
	# will be much clearer

	--backup-and-modify-in-place
	#--cuddled-else
	--continuation-indentation=4
	--indent-columns=4
	--maximum-line-length=80
	#--line-up-parentheses
	--opening-brace-always-on-right
	--noopening-sub-brace-on-new-line # -nsbl # opening sub braces on right
	--indent-closing-brace # thought this was -ibc
	--indent-block-comments # -icb # indent comment blocs
	--vertical-tightness=0
	--vertical-tightness-closing=0
	--closing-token-indentation=3
	--stack-opening-tokens
	#--stack-closing-tokens
	--space-terminal-semicolon
	--space-for-semicolon
	--brace-tightness=0
	--paren-tightness=0
	--block-brace-tightness=0
	--square-bracket-tightness=0
	--no-outdent-long-quotes

view raw .perltidyrc hosted with ❤ by GitHub

If you have a problem with my code alignment, perltidy exists. Use it.

I'd rather offend you with substance than with style, anyway.

2015/07/28

Threads Unspooling, or "What's my problem NOW?"

I have never done much with access control lists (or ACLs), as most of my time as a Linux and Unix user has been in positions where everything needed to control access could be done with standard unix permissions: owner/group/all and read/write/execute.

Also, most of the file systems were not set up to support them, which makes the barrier to entry enough that I never got beyond "I wonder how ACLs work".

I work with genomics data on the top university supercomputing cluster in the US, and we generate lots of data for lots of users, and we had been doing some ugly hacks to share data with our users, but with the new file system, we have ACLs, which makes it as easy as setfacl -R -m "u:username:r-x" /path/to/research.

ACLs are not actually my problem.

The length of time it takes to set ACLs on a large data set is my problem.

Running the tool to set everything takes five minutes. With a subset of our total data. Which is only going to get bigger. If we're talking about a daily "get everything back to proper shape", that's well within bounds. If it's something a user is supposed to run, then no.

So, I'm looking into threads, and I can set all my ACLs in parallel using Parallel::ForkManager, and while I'm not sure threads are the asynchronous solution for Modern Perl, they work and I can get a number of directories getting their ACLs recursively set at once.

Sometimes, however, because machines go down or NFS mounts get hosed or you kill a process just to watch it die, the setting process gets interrupted. Or, you do more work and generate more data, and that goes into a subdirectory. Then, the ACLs at the top of the directory tree may be correct, but the deep nodes will be wrong, and it's best to not wait until the end-of-the day "set everything" process to get your bits in order.

So you want to set a flag. If the flag is set, you do it all. And when I try to set flags in the threaded version, I get an error.

Threads are not actually my problem.

I have the threads in the database, which makes both the incomplete-pass and the add-new-data options equally easy to handle. And, to make databases easier to handle, I have a module I call oDB which handles database access so I don't have to worry about correctness or having passwords in plaintext in my code. It uses another module I wrote, called MyDB, to connect to MySQL in the first place. I share the gist above, but I cut to the chase below.

view plain print ?

my $_dbh ; # Save the handle.
sub db_connect {
my ( $param_ptr, $attr_ptr ) = @_ ;
my $port = '3306' ;
# ...
if ( defined $_dbh
&& ( !defined $param_ptr || $param_ptr eq '' ) ) {
return $_dbh ;
}
# ...
if ( defined $_dbh && $new_db_params eq $_db_params ) {
return $_dbh ;
}
# ...
$_dbh = DBI->connect(
$source,
$params{ user },
$params{ password }, \%attr )
or croak $DBI::errstr ;
return $_dbh ;
} # End of db_connect

my $_dbh ;               # Save the handle.

sub db_connect {
    my ( $param_ptr, $attr_ptr ) = @_ ;
    my $port = '3306' ;

    # ...

    if ( defined $_dbh
        && ( !defined $param_ptr || $param_ptr eq '' ) ) {
        return $_dbh ;
        }

    # ...

    if ( defined $_dbh && $new_db_params eq $_db_params ) {
        return $_dbh ;
        }

    # ...

    $_dbh = DBI->connect( 
        $source, 
        $params{ user }, 
        $params{ password }, \%attr )
        or croak $DBI::errstr ;

    return $_dbh ;
    }    # End of db_connect

Essentially , the "right thing" in this case is to generate a new DB handle each and every time, and my code is doing everything in it's power to avoid creating a new DB handle.

My problem is that I didn't write this as thread-safe. Because doing so was the furthest thing from my mind.

My problem is a failure of imagination.

2015/07/27

Things I learned for perlbrew: Config

Config.

Mostly, I haven't developed for Perl, I've developed for the perl on this machine. Sometimes, my perl on this machine, with this set of modules.

With perlbrew, you're starting with whatever Perl is available, and sometimes, upgrading the perl you're using. So, it's good to know something about that perl, isn't it?

So, how do we do that?

Config.

Look in there and you get api_revision, api_version and api_subversion, which allows you to know which version you are running.

Which makes me think that there are options here, if you're deploying software to places where they're not using the most recent perl.

In Javascript, they have a concept of polyfills, so that, if your page is loaded on an older browser with no HTML5 support, you can install a module that gives your old browser the capabilities it needs to do that.

Now, honestly, that seems a nicer way to handle things than
use 5.14 ; # Here's a nickel, buy yourself a Modern Perl
Doesn't it?

view plain print ?

# pseudocode ahead. I'm just thinking through this
# polyfill_say.pl
use Config ;
use lib '$HOME/lib/Tools' ;
BEGIN {
if ( $Config{ 'api_revision' } < 5 ||
$Config{ 'api_revision' } == 5 && $Config{ 'api_version' } < 10 ) {
require Tools::JankySayReplacement qw{ say };
}
}
say 'OK' ;

# pseudocode ahead. I'm just thinking through this
# polyfill_say.pl
use Config ;

use lib '$HOME/lib/Tools' ;

BEGIN {

if ( $Config{ 'api_revision' } < 5 || 
     $Config{ 'api_revision' } == 5 && $Config{ 'api_version' } < 10 ) {
        require Tools::JankySayReplacement qw{ say };
    }
}

say 'OK' ;

Of course there's perlbrew, plenv and just putting a modern perl in /opt/bin/perl or ~/bin/perl and being done with it. Just because I'm jazzed by an idea, that doesn't mean it's a good idea. But aren't a lot of the new cool things in Perl 5 just polyfilled back from Perl 6 these days? Shouldn't we be as nice to those stuck in 5.old as the Perl 6 people are to us?

Anyway, Config. It is in Core and it is cool.

2015/07/26

What I learned from perlbrew

I signed up for Neil Bowers' CPAN Pull Request Challenge, and the first module I got was App::perlbrew. After some looking and guessing, gugod pointed me to one of his problems, and after some time reading and understanding how things work, I got it done.

It took me a while to figure out how it worked. I had seen and used something like it — I had found out about dispatch tables from my local friendly neighborhood Perl Mongers — and I have started to use old-school Perl object orientation on occasion, but this combined them in a very interesting way.

A lot of the clever, however, isn't where I thought it was, which I didn't realize until now. The symbol-table manipulation isn't about making the commands work, but rather guessing what you meant if you give a command it can't handle. The "magic" is all about $s = $self->can($command) and $self->$s(@$args).

I wrote a quick stub of an application that would show off how to this works, with lots of comments that are meant to explain what's meant to happen instead of how it's supposed to work, as "Most comments in code are in fact a pernicious form of code duplication".

If you try symtest.pl foo, it will print 1 and foo. If you try symtest.pl food, it'll just print 1. If you instead try symtest.pl fod, it'll print "unknown command" and suggest foo and food as alternate suggestions. Like a boss.

One of the coolest things, I think is that you can put your user-facing methods in a second module. Or, perhaps I just have a low threshold for cool.

If you have questions about the code, or understand the things I handwave and know you can do better, please comment below.

	package Sym ;

	# Sample code for making an easily extendable command-line
	# application with Perl

	use feature qw{ say } ;
	use strict ;
	use warnings ;

	use Data::Dumper ;

	# Sym2 includes all the actual called functions
	use Sym2 ;

	# the object just contains the arguments set.

	sub new {
	my ( $class, @argv ) = @_ ;
	my $self ;
	$self->{args} = [] ;
	if (@argv) {
	$self->{args} = \@argv ;
	}
	return bless $self, $class ;
	}

	# you could replace this with Pod::Usage or the like

	# this can be moved to just run instead of run_command, I suppose,
	# but this is exactly how I grabbed this from perlbrew

	# it'd be easy, as $args is essentially $self->{args}

	sub run {
	my ($self) = @_ ;
	$self->run_command( $self->{args} ) ;
	}

	# this is easily the coolest part of the program right here

	sub run_command {
	my ( $self, $args ) = @_ ;

	if ( scalar @$args == 0 \|\| lc $args->[0] eq 'help' ) {
	$self->help() ;
	exit ;
	}

	if ( lc $args->[0] eq 'commands' ) {
	say join "\n\t" , '' , $self->commands() ;
	exit ;
	}

	my $command = $args->[0] ;

	# I didn't know can() existed. It tells you if a string works as
	# an object method. This is the cool thing that is at the core of
	# this code. $self->can($var) is the core of this bit, and we could
	# easily go to drop the rest of this if desired.

	# $self->can($var) simply turns the symbol table into a
	# dispatch table.

	my $s = $self->can("run_command_$command") ;
	unless ($s) {
	$command =~ y/-/_/ ;
	$s = $self->can("run_command_$command") ;
	}

	# If we haven't gotten the name so far, we'll give it another pass.

	unless ($s) {

	# we think you might've meant something else. If there's many
	# choices we guess you meant, we'll show you a list.
	# if there's one, we'll show you that one.
	# else, we don't think you typed that right. lots of clever behind
	# that,, too.

	my @commands = $self->find_similar_commands($command) ;
	if ( @commands > 1 ) {
	@commands = map { ' ' . $_ } @commands ;
	die
	"Unknown command: `$command`. Did you mean one of the following?\n"
	. join( "\n", @commands )
	. "\n" ;
	}
	elsif ( @commands == 1 ) {
	die "Unknown command: `$command`. Did you mean `$commands[0]`?\n"
	;
	}
	else {
	die "Unknown command: `$command`. Typo?\n" ;
	}
	}

	# this is probably not necessary, but when mocking this up,
	# I didn't have everything put together, $s should be a code
	# ref, so we check to see that it is, and if not, we alert
	# and exit.

	unless ( 'CODE' eq ref $s ) { say 'Not a valid command' ; exit ; }

	$self->$s(@$args) ;
	}

	# another function more or less grabbed direct from perlbrew.
	# you add functions of the form "run_command_*", such as
	# "run_command_do_this_thing" and it puts it into the @commands
	# array, so you can later run "app.pl do-this-thing"

	sub commands {
	my ($self) = @_ ;
	my @commands ;

	# interviewers love to ask about the ternary operator, so
	# if you don't know it:
	# $variable = (boolean statement) ? val if true : val if false
	# here we grab the package and the symbol table for the package
	my $package = ref $self ? ref $self : $self ;
	my $symtable = do {
	no strict 'refs' ;
	\%{ $package . '::' } ;
	} ;

	# he're we're just grabbing the names of the functions and, if they
	# start with "run_command_", we turn all underlines into dashes and
	# add it to the commands list

	foreach my $sym ( sort %$symtable ) {
	if ( $sym =~ /^run_command_/ ) {
	my $glob = $symtable->{$sym} ;
	if ( defined *$glob{CODE} ) {
	$sym =~ s/^run_command_// ;
	$sym =~ s/_/-/g ;
	push @commands, $sym ;
	}
	}
	}

	return @commands ;
	}

	# this uses editdist, which I don't really get, but beyond that, it's
	# fairly simple. editdist gives a number of choices with a numerical
	# indication of how close it is to the desired command. That array
	# of choices is sorted by that similarity index, and it returns just
	# the closest entries.

	sub find_similar_commands {
	my ( $self, $command ) = @_ ;
	my $SIMILAR_DISTANCE = 6 ;

	my @commands = sort { $a->[1] <=> $b->[1] }
	grep {defined}
	map {
	my $d = editdist( $_, $command ) ;
	( $d < $SIMILAR_DISTANCE ) ? [ $_, $d ] : undef
	} $self->commands ;

	if (@commands) {
	my $best = $commands[0][1] ;
	@commands = map { $_->[0] } grep { $_->[1] == $best } @commands ;
	}

	return @commands ;
	}

	# another straight grab.

	# straight copy of Wikipedia's "Levenshtein Distance"
	sub editdist {
	my @a = split //, shift ;
	my @b = split //, shift ;

	# There is an extra row and column in the matrix. This is the
	# distance from the empty string to a substring of the target.
	my @d ;
	$d[$_][0] = $_ for ( 0 .. @a ) ;
	$d[0][$_] = $_ for ( 0 .. @b ) ;

	for my $i ( 1 .. @a ) {
	for my $j ( 1 .. @b ) {
	$d[$i][$j] = (
	$a[ $i - 1 ] eq $b[ $j - 1 ]
	? $d[ $i - 1 ][ $j - 1 ]
	: 1 + min(
	$d[ $i - 1 ][$j],
	$d[$i][ $j - 1 ],
	$d[ $i - 1 ][ $j - 1 ]
	)
	) ;
	}
	}

	return $d[@a][@b] ;
	}

	# returns the minimum value of the array. used in editdist()
	sub min(@) {
	my $m = $_[0] ;
	for (@_) {
	$m = $_ if $_ < $m ;
	}
	return $m ;
	}

	# this would best be replaced by something using Pod::Usage or the
	# like.
	sub help {
	my ($self) = @) ;
	say 'HELP!!!' ;
	}

	1 ;

	__DATA__
	The MIT License

	Copyright (c) 2015 Dave Jacoby
	Copyright (c) 2010,2011,2012,2013 Kang-min Liu

	Permission is hereby granted, free of charge, to any person obtaining a copy
	of this software and associated documentation files (the "Software"), to deal
	in the Software without restriction, including without limitation the rights
	to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
	copies of the Software, and to permit persons to whom the Software is
	furnished to do so, subject to the following conditions:

	The above copyright notice and this permission notice shall be included in
	all copies or substantial portions of the Software.

	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
	IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
	FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
	AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
	LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
	OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
	THE SOFTWARE.

view raw Sym.pm hosted with ❤ by GitHub

	package Sym2 ;

	use feature qw{ say } ;
	use strict ;
	use warnings ;

	use Exporter qw{import} ;
	use Data::Dumper ;

	# all these are nonsense functions, serving to pad out the
	# symbol table and give find_similar_commands() a reason to
	# show multiple

	our @EXPORT = qw{
	run_command_diesel_fitter
	run_command_bar
	run_command_blee
	run_command_foo
	run_command_food
	run_command_quuz
	run_command_smith
	run_command_xyz
	} ;

	sub run_command_bar {
	my ($self) = @) ;
	say '2' ;
	}

	sub run_command_blee {
	my ($self) = @) ;
	say '3' ;
	}

	sub run_command_diesel_fitter {
	my ($self) = @) ;
	say q{These'll fit 'er} ;
	}

	sub run_command_foo {
	my ($self) = @) ;
	say '1' ;
	say join '\|', @ARGV ;
	}

	sub run_command_food {
	my ($self) = @) ;
	say '1' ;
	}

	sub run_command_quuz {
	my ($self) = @) ;
	say '4' ;
	}

	sub run_command_smith {
	my ($self) = @) ;
	say q{xxxxxxxx} ;
	}

	sub run_command_xyz {
	my ($self) = @) ;
	say 'xyz' ;
	}

	1 ;

view raw Sym2.pm hosted with ❤ by GitHub

	#!/usr/bin/env perl

	use feature qw{ say } ;
	use strict ;
	use warnings ;

	use lib '~' ;
	use Sym ;

	my $sym = Sym->new(@ARGV) ;
	$sym->run() ;

view raw symtest.pl hosted with ❤ by GitHub

2015/07/11

Interview-Style Coding Problem: Estimate Pi

Saw this as an example of the kind of programming test you get in interviews, so I decided to give it a try.

Just to report, it gets there at $i = 130657.

view plain print ?

#!/usr/bin/env perl
use feature qw{ say } ;
use strict ;
use warnings ;
use utf8 ;
# Given that Pi can be estimated using the function
# 4 * (1 – 1/3 + 1/5 – 1/7 + …)
# with more terms giving greater accuracy,
# write a function that calculates Pi
# to an accuracy of 5 decimal places.
my $pi = '3.14159' ;
my $c ;
for my $i ( 0..1_000_000 ) {
my $j = 2 * $i + 1 ;
if ( $i % 2 == 1 ) { $c -= 1 / $j ; }
else { $c += 1 / $j ; }
my $p = 4 * $c ;
my $p2 = sprintf '%.05f' , $p ;
say join ' ' , $i , $pi , $p2 , $p ;
exit if $p2 eq $pi ;
}

#!/usr/bin/env perl

use feature qw{ say  } ;
use strict ;
use warnings ;
use utf8 ;

# Given that Pi can be estimated using the function 
#   4 * (1 – 1/3 + 1/5 – 1/7 + …) 
# with more terms giving greater accuracy, 
# write a function that calculates Pi 
# to an accuracy of 5 decimal places.

my $pi = '3.14159' ;

my $c ;
for my $i ( 0..1_000_000 ) {
    my $j = 2 * $i + 1 ;
    if ( $i % 2 == 1 ) { $c -= 1 / $j  ; }
    else { $c += 1 / $j ; }
    my $p = 4 * $c ;
    my $p2 = sprintf '%.05f' , $p ;
    say join ' ' , $i , $pi , $p2 , $p  ;
    exit if $p2 eq $pi ;
    }

2015/07/08

Because everything can jump the rails...

learned how to SSH in Perl yesterday. Opens cool opportunities, but it scares the shit out of me.
— Dave Jacoby (@JacobyDave) July 8, 2015

I will have to do a write up. (While you wait for me, read Net::OpenSSH on MetaCPAN and know the key is keypath.) The thing to remember is that this means I can write complex programs that connect to other machines while I'm not there.

I've been able to do similar things with bash scripts for a while, but there's a complexity you can only get once you step away from a shell and move to a language.

That complexity has consequences. If you've never written a thing that went out of control and had unexpected destructive consequences, you're not a programmer. I'd go as far as to say that everyone has written rm -rf foo. * instead of rm -rf foo.* at least once.

This is why computer people strive to be very detail oriented. We wanted remove all the things, be they file or directory, if they start with the string "foo.", not REMOVE ALL THE THINGS!!! BUT GET THAT 'foo.' THING ESPECIALLY!!!! The stereotypical geek response starts with "Well, actually...", because "Well, actually, there's a space in there that'll ruin everyone's day" keeps everyone from spending the next few hours pulling everything off tape backup, or potentially never having those pictures from your wedding ever again.

One of the arguments toward "AI means we're doomed" is that of the stamp collector. Watch the Computerphile video, but the collector wants stamps and tells his AI "I want more stamps to fill out my collection". This is clearly a general statement, conversationally a wildcard, and the AI can take this several different ways, going from going to eBay and buying a few things with your credit card to hacking several printing presses and printing billions and billions of stamps, and to harvesting living beings to be turned into paper ink and glue.

I have a response to this thought experiment, but a part of my problem that I didn't get into is that deleting all your files is easy, spending all your money on eBay is slightly harder, but controlling things on another computer is far more difficult. If you have an open API on a machine, all I can do is things that the API lets me do, and if you have a delete everything option, you've probably done it wrong. (Or you're a Snowdenesque paranoid hacker, in which case, you know what you're doing and that's fine.)

Which brings us back to Net::OpenSSH. The first step is "connect to that server", and once you realize it's going to prompt you for a password, the second step becomes "hard code your password to make it work" and the quick follow up is "Use config files or enable ssh keys or anything that allows you to not have your password in clear text, you idiot!"

Because, with an SSH shell controlled by a program, you grant the program permissions to do every command you're capable of on that system, and for many systems, you have the ability to be very destructive.

And I have that between a number of systems, because I'm trying to make a thing work that has SSH not AJAX and JSON as the API and need to know it works outside of that. I do know, however, that it means I have the capability to run code on another machine.

Which I'm not necessarily logged on and not necessarily monitoring.

Where I'm not the admin, nor the sole user.

Where I can ruin the days of myself and many many others.

So while I code, I feel the same fear I feel while standing in line for that rickety-looking wooden roller coaster at an amusement park.

2015/07/01

Unstuck in Time and Space: An Investigation into Location over WiFi.

I track my location with Google and my phone, because I lack sufficient paranoia. To the right is my June 30.

I swear that I didn't leave the Greater Lafayette area. I certainly didn't teleport to the southern suburbs of Indianapolis.

This happens to me all the time, and it has bugged me a lot. But, normally I've just looked and griped, rather than trying to work it out.

Today, however, I'm watching a compiler or two, so I have some time I can use to work this out.

The protocol is KML, and this is what it looks like:

	<?xml version="1.0" encoding="UTF-8"?>
	<kml xmlns="http://www.opengis.net/kml/2.2" xmlns:gx="http://www.google.com/kml/ext/2.2" xmlns:kml="http://www.opengis.net/kml/2.2" xmlns:atom="http://www.w3.org/2005/Atom">
	<Document>
	<name>Location history from 06/30/2015 to 07/01/2015</name>
	<open>1</open>
	<description/>
	<StyleMap id="multiTrack">
	<Pair>
	<key>normal</key>
	<styleUrl>#multiTrack_n</styleUrl>
	</Pair>
	<Pair>
	<key>highlight</key>
	<styleUrl>#multiTrack_h</styleUrl>
	</Pair>
	</StyleMap>
	<Style id="multiTrack_n">
	<IconStyle>
	<Icon>
	<href>http://earth.google.com/images/kml-icons/track-directional/track-0.png</href>
	</Icon>
	</IconStyle>
	<LineStyle>
	<color>99ffac59</color>
	<width>6</width>
	</LineStyle>
	</Style>
	<Style id="multiTrack_h">
	<IconStyle>
	<scale>1.2</scale>
	<Icon>
	<href>http://earth.google.com/images/kml-icons/track-directional/track-0.png</href>
	</Icon>
	</IconStyle>
	<LineStyle>
	<color>99ffac59</color>
	<width>8</width>
	</LineStyle>
	</Style>
	<Placemark>
	<name>Latitude User</name>
	<description>Location history for Latitude User from 06/30/2015 to 07/01/2015</description>
	<styleUrl>#multiTrack</styleUrl>
	<gx:Track>
	<altitudeMode>clampToGround</altitudeMode>
	<when>2015-06-30T13:11:50.556-07:00</when>
	<gx:coord>-86.9113936 40.4224106 0</gx:coord>
	<when>2015-06-30T13:13:05.103-07:00</when>
	<gx:coord>-86.1233968 39.6461108 0</gx:coord>
	</gx:Track>
	</Placemark>
	</Document>
	</kml>

view raw history-06-29-2015.kml hosted with ❤ by GitHub

That isn't all day's results, merely the point in time I jumped 67 miles to the southeast. I was going to try to use a KML-specific Perl module, but found that the ones I could find were more about generating it than parsing it, and it's XML, so I figured what the heck.

I had previous code to work out the distance between two points, so it was an easy case of parsing to find the jump:

	#!/usr/bin/env perl

	use feature qw{ say } ;
	use strict ;
	use warnings ;
	use utf8 ;

	use DateTime ;
	use Math::Trig qw(deg2rad pi great_circle_distance asin acos) ;

	# Lafayette: 40°25′2″N 86°52′43″W
	# Greenwood: 39°36′41″N 86°07′05″W

	my $file = '/home/jacoby/Dropbox/history-06-29-2015.kml' ;
	my @when ;
	my @latlong ;
	if ( open my $fh, '<', $file ) {
	while (<$fh>) {
	if (m{<when>}) {
	my ($time) = m{<when>(.+)</when>} ;
	push @when, $time ;
	}
	if (m{<gx:coord>}) {
	my ($place) = m{<gx:coord>(.+)</gx:coord>} ;
	push @latlong, $place ;
	}
	}
	close $fh ;
	}

	my $last_time ;
	my $last_place ;
	for my $i ( map { $_ - 1 } 1 .. scalar @when ) {
	my $time = $when[$i] ;
	my $place = $latlong[$i] ;

	if ($last_time) {
	my $tt = ( split m{\.}, $time )[0] ;
	my ( $long, $lat ) = split m{\s+}, $place ;
	my $d_time = diff_time( $time, $last_time ) ;
	my $d_place = diff_loc( $place, $last_place ) ;
	my $flag = ( $d_place > 1 ) ? '*' : ' ' ;
	say join "\t", $flag, $tt, $lat, $long, $d_time,
	( sprintf '%.5f', $d_place
	if $d_place > 30 ;
	}

	$last_time = $time ;
	$last_place = $place ;
	}

	sub diff_loc {
	my ( $place1, $place2 ) = @_ ;
	my ( $lon1, $lat1 ) = split m{\s+}, $place1 ;
	my ( $lon2, $lat2 ) = split m{\s+}, $place2 ;
	return haversine( $lat1, $lon1, $lat2, $lon2 ) ;
	}

	sub haversine {
	my ( $lat1, $lon1, $lat2, $lon2 ) = @_ ;
	my $r = 3956 ;
	my $dlon = deg2rad($lon1) - deg2rad($lon2) ;
	my $dlat = deg2rad($lat1) - deg2rad($lat2) ;

	my $a
	= sin( $dlat / 2 )**2
	+ cos( deg2rad($lat1) ) * cos( deg2rad($lat2) ) * sin( $dlon / 2 )
	**2 ;
	my $c = 2 * ( asin( sqrt($a) ) ) ;
	my $dist = $r * $c ;
	return $dist ;
	}

	sub diff_time {
	my ( $time1, $time2 ) = @_ ;
	my $t1 = parsetime($time1) ;
	my $t2 = parsetime($time2) ;
	my $diff = abs $t2->epoch - $t1->epoch ;
	return $diff ;
	}

	sub parsetime {
	my $string = shift ;
	$string =~ s{\..+$}{} ;
	my @time = split m{\D+}, $string ;
	my $dt = DateTime->new(
	year => $time[0],
	month => $time[1],
	day => $time[2],
	hour => $time[3],
	minute => $time[4],
	second => $time[5],
	time_zone => 'America/Indiana/Indianapolis'
	) ;
	return $dt ;
	}

view raw find_greenwood.pl hosted with ❤ by GitHub

Breaking it down, at 2015-06-30T13:13:05.103-07:00 I go 67 miles to Greenwood, and at 2015-06-30T13:53:31.467-07:00 I pop back.

Let me bring up an other map.

I didn't have any mapping software going, and I was using wifi, so this data is location via wifi not GPS. I know, though, that the group that runs my servers has a weekly "coffee break" on Tuesdays, that I met with my admin there, and I walked around toward his office before goign back to mine. His building is off S. Grant St., and I walked next to Hawkins Hall, in front of Pao Hall, near the Forestry Building and down to my office in Whistler.

So, question is, how does location over WiFi work? I recall hearing that routers and access points report location, but I'm not sure of the protocols involved. I can imagine two possible scenarios that cause this.

First is that one of Purdue's routers is misreporting location, either in Forestry or Pao. This is possible; I have another issue that I haven't worked through yet where I leap instantly to the EE building, and it seems that's entirely based on location within my building.

The second scenario, one I'm taking more and more seriously, is that there's a replicated MAC address or something between the apartments across from Pao Hall. I say "or something" because MAC addresses should be unique. The thing that makes me suspect this is that it points me to a residential neighborhood south of Indy, and I could see that mistake happening with two residential routers or two experimental electronics projects.

I'm curious about how to test this, because I do want to know it has something to do with Purdue's networking gear before I complain. I'm also curious about how these things actually work. I could very much see me walking around, looking at Google Maps and tripping over things, then trying to dump my ARP tables or something.

Cookie Notice

2015/07/29

2015/07/28

2015/07/27

2015/07/26

2015/07/11

2015/07/08

2015/07/01