Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

rjbs (4671)

rjbs
  (email not shown publicly)
http://rjbs.manxome.org/
AOL IM: RicardoJBSignes (Add Buddy, Send Message)
Yahoo! ID: RicardoSignes (Add User, Send Message)

I'm a Perl coder living in Bethlehem, PA and working Philadelphia. I'm a philosopher and theologan by training, but I was shocked to learn upon my graduation that these skills don't have many associated careers. Now I write code.

Journal of rjbs (4671)

Tuesday December 02, 2008
05:16 PM

rjbs no longer found at use.perl.org journals

It is very likely that I will no longer be posting to my use.perl.org journal.

I have always posted both to my Rubric at http://rjbs.manxome.org/rubric (or /journal) and to this journal. I posted here for visibility and comments.

I have added TypePad Connect to my Rubric, which will handle comments for me without needing to cross-post. If you are, for some reason, interested in my noise-making, please follow it at my Rubric.

Maybe this means I'll get back to adding features to Rubric!

Friday November 28, 2008
08:55 AM

the problem with console rpgs

I'm playing Mass Effect now. It's pretty good, although I'm starting to find it a bit tedious, mostly because I keep having to repeat the same bits. This is especially frustrating when I have several dialog options that look very similar but end up coming out of my mouth with very different tones of voice.

That's a problem specific to Mass Effect, and it has some others. The thing that annoys me the most, though, is that it suffers particularly badly from a case of Stupid Game Economy. I wrote about the stupid Cyberpunk 2020 economy before, and it's a problem you can find all over the place if you look.

Mass Effect is a space opera. It has laser guns, super armor, space grenades, and holographic healing gauntlets. You start out with some of these, but they're bottom of the barrel and you have to acquire better ones as you play. You acquire these, sometimes, as spoils of war, but a lot of the really good stuff needs to be purchased. For example, some of the best weapons and armor I can get right now sell for six figures.

It not easy for me to acquire that kind of capital. It might be impossible without hours and hours more gameplay to even get close to it.

A minor upgrade to one of my weapons costs maybe 3000 credits. A license to preach on the main space station's promenade costs 150 credits.

So, let's say these are dollars. One hundred fifty dollars for a license from the government is not insane. Three thousand dollars for a pretty nice gun is not insane. One hundred thousand dollars for a really badass shield generator... well, let's say it's sane. Let's say all the prices make sense.

I ran a smuggling job for an alien. I used my status as a Spectre to bring experimental weapons into a tightly-controlled facility for him to resell. For my trouble, he gave me $250. I broke into an office complex and murdered something like twenty (corrupt) law enforcement officers. The guy who hired me to do that gave me about $700. What the hell is going on here?

Oh, so I mentioned I'm a Spectre? A Spectre is a super-elite ultra-secret agent who reports directly to the triumvirate that rules the galaxy. I've been sent to capture a rogue agent. They sent me as an alternative to sending an entire fleet. "Here," they said, "have a starship."

Not pictured, of course, is the conversation where I say, "Wow, thanks, that's a fantastic starship, and I know it's the best one in the whole human fleet. Do you think I could get some better kit for my team, too? Maybe one of those Ripper IV assault rifles and some shield generators?" The Council of Galactic Omnipotence then says, "Sorry, no. We know your mission is going to prevent the destruction of all life int he galaxy, but... we want you to work for it."

This is present in any game where the hero is known by all to be, you know, a hero saving the world from destruction, but he still has to pay for a glass of milk to heal.

"I need an ice hammer."

"Sure thing, Hero of Eternity. That'll be 350 gilootnis."

"Um... I need the hammer to get into the mountains to defeat the dragon that's been attacking your village."

"Yeah, I heard. Thanks!"

"So, really, can't you just give me the hammer? Or loan it to me? I'm trying to save you and, you know, your family. The Great Deity Thrumboat didn't give me a budget or anything when he imbued me with the Master Spirit so I could save you. I guess he figured people would be reasonable and want to contribute to their own salvation."

"Ho! That Thrumboat! Always figuring."

"..."

"Yeah, seriously though, tree fiddy."

Wednesday November 26, 2008
01:00 PM

awful itunes hack for album listening

It's bugged me that iTunes makes it hard to listen to things as albums. Sure, it has shuffle-by-album, but smart playlists are all per-track.

After years of meaning to, this morning I wrote a (very very slow) Mac::Glue script to build a playlist of unrated or highly-rated albums that I haven't listened to lately. When I was nearly done and looked into one little bug, I found some other similar scripts. Oh well!

I'll eventually update this to avoid having it pick all albums by one artist, but for now, it's good. Thanks to it, I am re-listening to Method Man's Tical.

#!/usr/bin/perl
use strict;
use warnings;
use Mac::Glue qw(:glue);
use List::Util qw(sum);

my $itunes = Mac::Glue->new('iTunes');

my $pl = $itunes->obj(
  playlist => whose(name => equals => 'Regular Music')
)->get;

my $albumen = $itunes->obj(
  playlist => whose(name => equals => 'Albumen')
)->get;

die "no albumen" unless $albumen;

{
  my $tracks = $itunes->obj(
    'track' => gAll,
    playlist => $albumen->prop('index')->get,
  );

  for my $t ( $tracks->get ){
    $t->delete;
  }
}

print "getting tracks\n";
my @tracks = $pl->obj('tracks')->get;

my %album;

while (my $track = shift @tracks) {
  my $trackid = $track->prop('database ID')->get;
  my $album   = $track->prop('album')->get;
  my $artist  = $track->prop('compilation')->get
              ? '-'
              : $track->prop('artist')->get;

  next unless defined $album and defined $artist;
  next unless length  $album and length  $artist;

  my $rec = $album{ $album, $artist } ||= [];

  printf "storing record of $trackid ($album/$artist); %s remain\n",
    scalar @tracks;

  push @$rec, {
    id     => $trackid,
    rating => scalar $track->prop('rating')->get,
    played => scalar $track->prop('played date')->get, # epoch sec
    size   => scalar $track->prop('size')->get, # in bytes
  };
}

my $DEFAULT_TIME = time - 30 * 86_400;
my %avg_age;

ALBUM: for my $key (keys %album) {
  my ($album, $artist) = split $;, $key;
  printf "considering (%s/%s)\n", $album, $artist;

  my @tracks = @{ $album{ $key } };

  unless (@tracks > 4) {
    printf "skipping (%s/%s); too few tracks\n", $album, $artist;
    delete $album{$key};
    next ALBUM;
  }

  my @lp_dates = map { undef $_ if $_ eq 'msng'; $_ || $DEFAULT_TIME }
                 map { $_->{played} }
                 @tracks;

  my $avg_age  = time - (sum(@lp_dates) / @lp_dates);
  $avg_age{ $key } = $avg_age;

  if ($avg_age < 86_400 * 30) {
    printf "skipping (%s/%s); too recent\n", $album, $artist;
    delete $album{$key};
    next ALBUM;
  }

  my @ratings    = grep { $_ > 0 } map { $_->{rating} } @tracks;
  my $avg_rating = sum(@ratings) / @ratings if @ratings;

  if ($avg_rating and $avg_rating < 60) {
    printf "skipping (%s/%s); too lousy\n", $album, $artist;
    delete $album{$key};
    next ALBUM;
  }

  printf "keeping (%s/%s) @ %s\n", $album, $artist, $avg_rating || '(n/a)';
}

my $total_size = 0;
ADDITION: for my $key (sort { $avg_age{$b} <=> $avg_age{$a} } keys %album) {
  my @tracks = @{ $album{ $key } };

  for my $track (@tracks) {
    $total_size += $track->{size};

    my $t = $itunes->obj(
      track => whose('database id' => equals => $track->{id})
    )->get;

    $itunes->duplicate($t, to => $albumen);
  }

  last ADDITION if $total_size > 500_000_000;
}

Monday November 24, 2008
10:04 AM

first few xbox games

My Xbox 360 came with LEGO Indiana Jones and Kung Fu Panda. I haven't tried Kung Fu Panda, but I finished the story mode of Indiana Jones. It was pretty good, although nearly the entire Last Crusade scenario was incredibly annoying. The LEGO games from Tt have a lot going for them, but they also have a lot of flaws that just don't seem to be getting fixed. They have awful cameras, terrible jumping predictability, horrible partner AI, and the vehicle chapters tend to kind of suck. Despite all that, I'd probably give it a B-. Like I said, the LEGO games have a lot going for them.

I borrowed Assassin's Creed from Bryan and played through a bit of it. It's pretty cool, but I'm not sure it's going to get its hooks into me. I'll give it another hour or so, and then call it "good but not addictive enough." I need to be picky about what games I play, since I don't have lots of gaming time to spend.

I rented Bioshock and Gears of War from Gamefly. Bioshock is pretty great. The setting is a lot of fun. If you aren't familiar with it, it's basically an Ayn-Rand-inspired community that has gone insane and self-destructed. The whole thing is very art deco looking, with slogans hung around the place like, "Altruism is the origin of all degeneracy."

The gameplay is also good, ranging between really innovative and frustratingly familiar. I supposed I should be ashamed of saying this, but I liked FPS better when you couldn't jump. Well, no, that's not true. I get frustrated when it's impossible to tell whether a surface is too high to jump or I just suck at jumping. Further, if I'm a big tough guy who can run and jump, why can't I climb? I mean, that wall is only four feet high. Do I really need to find a way around it? And why must there be constant footfalls even when there's nothing nearby? "Because it's spooky" isn't a good enough reason.

Anyway, that's mostly nitpicking. Since I set the game to Easy (so that I could defeat one of the nasty Big Daddies) I've had little reason to complain. It's really very good.

I was ready to give up on Gears of War after the first mission or so. It looked good and seemed interesting, but I kept getting slaughtered and I had trouble getting my head around how to play. Last night I gave it one last chance and ended up playing for two or three hours. I really got the hang of it, and it's fantastic. I've always liked it when shooters are more tactical than frantic, and Gears of War is very, very tactics-based. It throws in some frenzy, too. In the last bit I played last night before quitting, I was engaged in a shooting match with some aliens who had good cover, while also trying to fend off rushing little bastards who'd swarm me. I'd stand up to shoot the "wretches" only to have a "grub" take pot shots at me from behind cover.

It's very rewarding.

Next up, I'm waiting for Dead Space or Dead Rising. I played the Dead Rising demo and it seemed like it might be fun, but I'm not expecting to feel the need to buy it. I've heard mostly intense praise for Dead Space, so I'm hoping to get that next. I also have Bryan's copy of Mass Effect, and might try to give that a go this weekend if I haven't gotten a new game from Gamefly yet.

Monday November 17, 2008
10:36 AM

in which rjbs apologizes for being a dick

A while ago, I did a bit of work applying patches to MIME::Lite. It's the most widely depended upon of the dists I maintain, and one of the oldest, with the most RT tickets. I also don't really like it very much, so it doesn't get as much work as I'd like to give it.

Anyway, I recently applied a patch from one of those tickets, which was marked as being the patch that Debian used. In the changelog, I put a snarky remark about Debian maintainers being jerks and not sending me (the upstream maintainer) their patch.

It was then pointed out to me that they had, in fact, sent me the patch, that it was in a ticket, and that I had marked it resolved.

So, hey, Debian guys who might be reading this and whom I didn't already apologize to: I'm sorry. What was I thinking? Well, clearly I wasn't.

After giving people a hard time about giving people a hard time, I should really know better. I will endeavor to be better about sticking to my own rule: don't be snarky.

Sunday November 16, 2008
12:34 AM

i have an xbox 360 now

I noticed, recently, that I had enough Amex rewards points to get an Xbox 360. I thought about it for a while and then decided to go for it. As is my habit when ordering something, I obsessively checked the status of my order every few hours, and it kept sitting at "submitted." I figured it could take quite a while, since I was buying with points.

Today, though, the Xbox showed up via FedEx around two o'clock. I had it set up before I left for my evening out, but it wasn't online. It turns out that the Xbox 360 doesn't have a built-in wifi connection. You can buy a USB wifi adapter for it, but the only one that seems to still be made that works is Microsoft's, and they want $100 for it. That is completely insane. I bought a USB adapter for my TiVo and it cost $20.

I decided to use my old Airport Extreme as an extension for my Time Capsule's network, but this ended up being a big headache. I had to use WDS, because my Airport predates the simpler "extend wireless network" option. Then I struggled with making WDS work, until I finally found that I had to set both devices to use the same channel. I thought this would be a bad idea, as there would be some kind of conflict. Goes to show what I know, I guess.

I got my Xbox Live account ported over from my old Xbox days, hooked up my Xbox Live account to my Live Messenger account, played the first level of LEGO Indiana Jones (meh) and that's that. I'll probably try renting or borrowing some games over the next few weeks. Given that the thing cost me nothing, I'm in no hurry to recoup the expense.

Friday November 14, 2008
11:19 PM

publishing parts of my tiddlywiki

Some time ago I wrote that I had moved my D&D wiki to TiddlyWiki. This has worked pretty well, although I've mostly given up storing YAML in my TiddlyWiki -- mostly because I didn't end up using the tools that used it all that much. Maybe next time.

Anyway, I'm getting close to starting my next game, and I've been doing much more work on the wiki for that one, and I have been annoyed at all the copying and pasting I've been doing. I want to give some of the content to the players but keep most of it private.

I looked at using two TiddlyWikis, but of course I'd want a single one to edit. I thought maybe I could have the second be for the players, and I'd sync it from mine. It was going to be a pain, though, to edit the list of synced pages. I really wanted to say, "sync everything tagged Public."

Then I realized that I didn't want this, either. I want to be able to put secret data on my wiki pages, and to easily give the page to my players -- sans the internal notes.

My solution is an ugly hack that I think will work just fine. I've set up a shared folder on Dropbox where my players will save their notes, maps, and so on. I made a folder in that share where I'll put articles about house rules, mechanics, and so on. It's all stuff from my wiki, published with a script that iterates over my TiddlyWiki finding and reformatting pages with the Public tag. It strips out private notes, replaces transclusion with cross reference, and does some other stuff.

I thought I'd be able to publish HTML using some CPAN module, but the only TiddlyWiki formatter on the CPAN seems to be vaporware. In the end, I decoded that wiki markup is easy enough for the players to read. I think this will work really well.

Here is the hacky script I'm using:

use strict;
use warnings;
use 5.010;
use HTML::TreeBuilder;
use Text::Autoformat;
use Text::Balanced qw(gen_extract_tagged);

my $extractor = gen_extract_tagged(map quotemeta, qw( [[ ]] ));

my $tree = HTML::TreeBuilder->new->parse_file($ARGV[0]);

my @tiddlers = grep { ($_->attr('tags') || '') =~ /\bPublic\b/ }
               $tree->look_down(_tag => 'div');

sub eq_pad {
  my ($str) = @_;
  my $total = 73 - length $str;
  return "$str " . ('=' x $total);
}

sub filename {
  my ($title) = @_;
  $title =~ s/\W+/-/g;
  return lc "$title.txt";
}

for my $tiddler (@tiddlers) {
  my $title = $tiddler->attr('title');
  my $fn = filename($title);
  open my $fh, '>', $fn or die "can't open $fn to write: $!";

  my $tag_str = $tiddler->attr('tags') || '';
  my @tags;
  while (length $tag_str) {
    my $tag;
    ($tag, $tag_str) = $extractor->($tag_str);
    if ($tag) {
      push @tags, $tag;
      next;
    } else {
      push @tags, split /\s+/, $tag_str;
      last;
    }
  }

  my $mod_date = $tiddler->attr('modified') || '';
  my (@date) = $mod_date =~ /^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})$/;

  say $fh 'Title   : ', $title;
  say $fh 'Tags    : ', join ', ', sort @tags;
  say $fh join ' ', 'Modified:',
    ($mod_date ? (join('-', @date[0,1,2]), join(':', @date[3,4])) : '??'),
    'by', $tiddler->attr('modifier') || '?';
  say $fh '';

  my $text = $tiddler->as_text;
  $text =~ s{<part \w+>\n}{}g;
  $text =~ s{</part>\n?}{}g;

  $text =~ s/^!!(.+)$/"\n\n== " . eq_pad($1) . "\n"/meg;

  my @chunks = split /\n{2,}/, $text;
  my @xref;

  for my $chunk (@chunks) {
    last if $chunk =~ /^----/;
    next if $chunk =~ /@@/;

    $chunk =~ s/\[\[([^\]|]+)(?:\|[^\]]+)?\]\]/$1/g;
    if ($chunk =~ /<<tiddler Template:Summary with: ([\s\w]+)>>/) {
      push @xref, $1;
      next;
    }

    if ($chunk =~ /^== /) {
      $chunk .= "\n\n";
    } else {
      $chunk = autoformat $chunk
    }
    print $fh $chunk;
  }

  say $fh "SEE ALSO: $_" for @xref;
}

Tuesday November 11, 2008
09:33 PM

astounding optimization! thanks nytprof!

We've been unhappy with the performance of some code, recently. I was pretty sure I knew where the problem was, but I thought I'd run NYTProf just to see how things looked. I'm running an older NYTprof, so it's not 100% clear that my SQL-level optimization is what I need to do -- but it's the right thing to do anyway. Anyway, I figured I might see something sort of interesting, but I never expected this:

Calls     InclTime   ExclTime     Subroutine
27,908        406        406     DBI::st::execute
543,412         79         31     Carp::caller_info

...and let's not go any further. The program took almost exactly 600s to run. Of that, nearly five percent was because the program called Carp, and it called it a half million times! What?!

I won't be coy, because I'm writing this while waiting for a test suite to run and while watching House. It turns out that it was related to this line:

Calls     InclTime   ExclTime     Subroutine
139,340        222          6     SUPER::get_all_parents

That subroutine looks like this:

sub get_all_parents {
  my ($invocant, $class) = @_;

  my @parents = eval { $invocant->__get_parents() };

  unless ( @parents ) {
    no strict 'refs';
    @parents = @{ $class . '::ISA' };
  }

  return 'UNIVERSAL' unless @parents;
  return @parents, map { get_all_parents( $_, $_ ) } @parents;
}

See how it calls $invocant->__get_parents? Well, that's great, except that our internal ORM has an AUTOLOAD subroutine that looks like this:

sub AUTOLOAD {
  my $self = $_[0];
  my $class = (ref $self) || $self;
  (my $method = $AUTOLOAD) =~ s/.*:://;
  return if $method eq "DESTROY";
  unless (blessed($self)) {
    confess qq(AUTOLOAD: \$self for ->$method is not a blessed reference: )
      . Dumper($self);
  }

  ...
}

Now, to avoid hitting the database too much, we have a mixin that makes it talk to a memcached. That mixin (like many such modules) uses SUPER.pm. SUPER then calls __get_parents on our ORM, but hits the AUTOLOAD instead, and since that's only supposed to work on objects, it confesses. It does this every time we check consider using a cached copy of an object, causing us to invoke Carp::confess a half million times.

The solution? I added this line to our ORM:

sub __get_parents { return; }

Shaved two minutes off the test case. That's about 20%.

Tuesday November 04, 2008
02:06 PM

more more cpan metrics

As suggested, I have run the code such that a dist's mere appearance on the CPAN is not counted. In other words: code exists if it is used. If not, it is ignored entirely. It ends up not having much effect.

author   | volume | req (old) | req (new)
ZOFFIX   | 1      | 145       | (n/a)
ADAMK    | 2      | 32        | 34
RJBS     | 3      | 43        | 43
MIYAGAWA | 4      | 82        | 84
NUFFIN   | 5      | 85        | 91
GBARR    | 114    |  1        | 1
PMQS     | 221    |  2        | 2
PETDANCE | 31     |  3        | 3
MSCHWERN | 40     |  4        | 4
SAPER    | 32     |  5        | 5

JROCKWAY suggested running this in reverse: see who uses the most. I think that doing both would be interesting: who gets used a lot, "despite" also using a lot of prereqs.

10:47 AM

more cpan metrics

For a while, I've been keeping track of the total usage of my code on the CPAN. It helps me see what people have found useful, and lets me decide how scared to be of introducing back-incompat changes. Sometimes people talk about the sort of catastrophe that can occur if a highly-required module is broken. For example, over 11,000 dists require the code in Getopt-Long. If it broke badly and people installed the new code, it would be a nightmare.

So, I applied my "who needs me?" script to the whole CPAN. It produces a list of every author with dists, showing how many other dists (recursively) use that dist. When an author uses his own dist, it is not counted as a prerequisite. The "total cpan-breaking power" score is more accurate that way.

This scoreboard is quite different to Simon Wistow's CPAN Leaderboard. Here's a comparison:

author   | volume | requiredness
ZOFFIX   | 1      | 145
ADAMK    | 2      | 32
RJBS     | 3      | 43
MIYAGAWA | 4      | 82
NUFFIN   | 5      | 85
GBARR    | 114    | 1
PMQS     | 221    | 2
PETDANCE | 31     | 3
MSCHWERN | 40     | 4
SAPER    | 32     | 5

The program is included below. It's a quick and dirty hack, but it was fun to write and look at.

#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use DBI;
use JSON::XS;

my $dbh = DBI->connect('dbi:SQLite:dbname=cpants_all.db', undef, undef);

my $authors = $dbh->selectall_arrayref(
  "SELECT id, pauseid
  FROM author
  WHERE pauseid IS NOT NULL
  ORDER BY pauseid"
);

my @results;

for my $author (@$authors) {
  my ($author_id, $pauseid) = @$author;

  my $dists = $dbh->selectall_arrayref(
    "SELECT id, dist FROM dist WHERE author = ? ORDER BY dist",
    undef,
    $author_id,
  );

  my %analysis;

  analyze_dist(\%analysis, $author_id, $_) for @$dists;

  my $sum = 0;
  $sum += $_ for values %analysis;

  next unless $sum;

  warn "$pauseid,$sum\n";
  push @results, {
    pauseid => $pauseid,
    result  => $sum,
    dists   => \%analysis,
  };
}

my $JSON = JSON::XS->new;
for my $author (sort { $b->{result} <=> $a->{result} } @results) {
  say $JSON->encode($author);
}

sub analyze_dist {
  my ($analysis, $author_id, $dist, $seen, $add_to) = @_;
  $seen ||= {};
  $add_to ||= $dist->[1];

  my @queue = $dist;

  $analysis->{ $add_to }++;

  my $needed_by = $dbh->selectall_arrayref(
    "SELECT p.dist, d.dist AS name
    FROM prereq p
    JOIN dist d ON d.id = p.dist
    WHERE p.in_dist = ?
    AND author <> ?",
    undef,
    $dist->[0],
    $author_id
  );

  for my $needed (@$needed_by) {
    next if $seen->{ $needed->[1] };
    $seen->{ $dist->[1] }++;
    analyze_dist($analysis, $author_id, $needed, $seen, $add_to);
  }
}

You can find the results of the results as of last night in my drop box.