A little bit ago, I was asked to test a new version of Net::Printer (after I submitted a bug four days ago that the tests were hanging on Windows) which resided in a GitHub repo. There was this shiny button labeled "Clone in Windows" which I clicked. I was taken to GitHub for Windows which I downloaded and installed. I already like this better than the last time I used Git for Windows (not that it is bad). Now that I've got it installed, I seem to remember seeing this before so I guess I had just forgotten about it.

It turns out that there is also GitHub for Mac, Git in Eclipse and GitHub Mobile. Pretty cool.

Then I did the same thing on my laptop that was running Strawberry Perl 5.16.2.

I quickly discovered that many modules will hang during the make or make test phase. I looked around the CPAN Testers Wiki and found out about Distroprefs (http://wiki.cpantesters.org/wiki/Distroprefs). I didn't pull down anyone's repo though. I just started compiling a list of my own one by one as I encountered problems (making sure to check for bug reports too).

After a few days, I had pretty much the same list of hanging modules on both PCs. I thought "hey, I already have Dropbox installed on both computers, why not just link the prefs to a directory under Dropbox?"

Open a command prompt with Administrator rights and run:
mklink /D target source

For me that was:
mklink /D c:\strawberry\cpan\prefs c:\Users\mmusgrove\Dropbox\prefs

I'd maintain one copy of the distroprefs files and it would be used by two smokers. I added a few more entries to disable things like ACME and Task modules. It worked really well.

I decided to finally switch away from 5.12.3 so I uninstalled it and installed a 64-bit copy of Strawberry Perl 5.16.2 on one of the PCs. As I started setting up Task::CPAN::Reporter I thought that I would need to enable Task modules before it would install.

That's when I noticed that using Dropbox for such a task is not a good idea unless you remember to remove the link before uninstalling Strawberry Perl. D'oh.

Two changes went into this release.
- The link-file script will be installed now. (Hinrik)
- The --add-ignore option works properly now. (Matt)

I'd like to thank Philip Durbin for pointing out that --add-ignore wasn't working properly.

It loops through all of the versions of perl I'm interested in. It starts perlbrew with the specified options but backgrounded. When the build.log shows up, it sends keystrokes to tmux window 4 telling it tail the build.log and brings perlbrew to the foreground. When the install is finished, it sends keystrokes to tmux window 4 telling it stop tailing the file and moves the build.log out of the way so we can view it later.

perlinstall.sh

We recently updated DBI to 1.620 and DBD::Oracle to 1.44 (late last week I think). Today I saw an error that I have never seen before (but should have). "ORA-02391: exceeded simultaneous SESSIONS_PER_USER limit" You see otheruser has a profile that limits SESSIONS_PER_USER to one. We're creating between one and eleven of these database connections simultaneously in different processes.

So I tried it with the older install that was using DBI 1.616 and DBD::Oracle 1.30. I didn't receive the error so it appears that the SESSIONS_PER_USER profile limit was not being respected.

We're bumping up the SESSIONS_PER_USER where appropriate and adding some checks for this error condition now that it's being thrown.

I'm curious if anyone is aware of which change may have caused this to start working correctly?

Who maintains http://www.yetanother.org these days? I emailed kevinm@yetanother.org (the only email address found) but it bounced.

At a minimum, it should redirect to http://www.perlfoundation.org. Ideally some of the original content would remain that explains the relationship between Yet Another Society and The Perl Foundation as well as relevant links to other parts of the Perl community.

Recently at home I have been using Notepad++ and it's really grown on me. I've always liked having all of my open documents in tabs. It also has syntax highlighting which really helps me see mistakes before I've even tried a compilation check.

I'm going to install it on my work laptop and see how it works out for me.

Googling for it isn't really helpful. I get a bunch of pages that say the same thing as the Oracle docs (turn on tracing and reproduce the issue).

The problem is that we don't see it consistently enough to even know to reproduce it properly much less create a minimal test case.

Update:
I looked in the alert.log and found a few "ORA-609 : opiodr aborting process unknown ospid" errors each with a corresponding trace file that ends with "opiino: Attach failed due to ORA-12537".

use Apache::DBI;

Most stuff just works. When I find something that is only slightly broken, I fix it. When I find something that is horribly broken, I just create a Location in httpd.conf to tell Apache to run that as plain CGI and I’ll update them later.

The entire application suite feels faster. I suspect much of the speed up is due to caching database handles but I’d like to profile it. I have no problems profiling CGI with Devel::NYTProf. When I configure httpd.conf to use Devel::NYTProf::Apache like this I get issues.

PerlSetEnv NYTPROF trace=2:file=/tmp/mm-nytprof.out:addpid=1:start=begin:use_db_sub=1
PerlModule Devel::NYTProf::Apache

I guess I’ll have to file a bug report. Here is just one of the many issues showing up in the error log:

Marking 'Apache2::RequestRec::args' as xsub
Marking 'CGI::Cookie::CORE:subst' as sop
Marking 'CGI::Cookie::CORE:substcont' as sop
NYTProf is confused about CV 0x2ac1ed3023e0 called as /opt/perl/lib/site_perl/5.12.3/x86_64-linux-thread-multi/ModPerl/RegistryCooker.pm at /opt/perl/lib/site_perl/5.12.3/x86_64-linux-thread-multi/ModPerl/RegistryCooker.pm line 225 (please report as a bug)
SV = PVCV(0x2ac1ed2b49d0) at 0x2ac1ed3023e0
  REFCNT = 2
  FLAGS = (POK,pPOK,CONST)
  PROTOTYPE = ""
  COMP_STASH = 0x2ac1ed240ad0   "ModPerl::RegistryCooker"
  XSUB = 0x2ac1d2d845b0
  XSUBANY = 0x2ac1ed2d0da8 (CONST SV)
    SV = IV(0x2ac1ed2d0da0) at 0x2ac1ed2d0da8
      REFCNT = 2
      FLAGS = (PADMY,IOK,READONLY,pIOK)
      IV = 0
  GVGV::GV = 0x2ac1ed2d2910     ""
  FILE = "/opt/perl/lib/site_perl/5.12.3/x86_64-linux-thread-multi/ModPerl/RegistryCooker.pm"
  DEPTH = 0
  FLAGS = 0xc00
  OUTSIDE_SEQ = 0
  PADLIST = 0x0
  OUTSIDE = 0x0 (null)
unknown entersub xsub assumed to be anon called_cv '/opt/perl/lib/site_perl/5.12.3/x86_64-linux-thread-multi/ModPerl/RegistryCooker.pm'

Is there a way to tell Devel::NYTProf not to profile ModPerl::RegistryCooker?

So I give you a better (although still not 100% accurate) solution. It has not yet been optimized. It may have bugs. Your mileage may vary. Some conditions and limitations may apply. Yadda yadda yadda.

#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw( min max );

my $red     = [ 0xFF, 0x00, 0x00 ];
my $yellow  = [ 0xFF, 0xFF, 0x00 ];
my $green   = [ 0x00, 0xFF, 0x00 ];
my $cyan    = [ 0x00, 0xFF, 0xFF ];
my $blue    = [ 0x00, 0x00, 0xFF ];
my $magenta = [ 0xFF, 0x00, 0xFF ];

my $steps = 16;

#my $colors = chained_gradients( $steps * 3, $red, $green, $blue ); # change me!
my $colors = chained_gradients( $steps * 2, $red, $yellow, $green ); # change me!
#my $colors = chained_gradients( $steps, $red, $green ); # change me!

open my $html, '>', 'colors.html';
print $html "<html><head><title>colors</title></head><body><table>\n";
for my $color ( @{ $colors } )
{
    printf "%02X%02X%02X  [ %1\$3s, %2\$3s, %3\$3s ]  h: %3s, s: %3s, v: %3s\n", @{ $color }, @{ to_hsv( $color ) };
    printf $html qq{<tr><td style="background-color:#%02X%02X%02X">%1\$02X%2\$02X%3\$02X</td></tr>\n}, @{ $color };
}
print $html "</table></body></html>\n";
close $html;

sub step
{
    my ( $steps, $first, $last ) = @_;

    $steps--;

    my $sign = $last <=> $first;
    my $step = $first == $last ? 0 : int( ( $first + $last ) / $steps );

    return $sign == 0 ? $step : $sign * $step;
}

sub gradient
{
    my ( $steps, $first, $last ) = @_;

    my $step = [ 
    step( $steps, $first->[0], $last->[0] ), 
    step( $steps, $first->[1], $last->[1] ), 
    step( $steps, $first->[2], $last->[2] ),
    ];

    my $gradients = [ ( undef ) x $steps ];
    for my $curr ( 0 .. $#{ $gradients } )
    {
    my $prev = $curr - 1;
    if ( $curr == 0 )
    {
        $gradients->[$curr] = $first;
    }
    elsif ( $curr == $#{ $gradients } )
    {
        $gradients->[$curr] = $last;
    }
    else
    {
        $gradients->[$curr] = [ 
            $gradients->[$prev][0] + $step->[0], 
            $gradients->[$prev][1] + $step->[1], 
            $gradients->[$prev][2] + $step->[2],
        ];
    }
    }

    return $gradients;
}

sub chained_gradients
{
    my ( $steps, @colors ) = @_;

    my $max = $#colors;
    $steps = int( $steps / $max );
    my $sections = $#colors - 1;

    my @gradients;
    while ( @colors >= 2 )
    {
    my $start = shift @colors;
    my $end = $colors[0];
    my $step = ( @colors == $max ) ? $steps + 1 : $steps;

    push @gradients, gradient( $step, $start, $end );
    }

    for my $curr ( 1 .. $sections )
    {
    my $prev = $curr - 1;
    my $ndx = ( $curr == 1 ) ? $steps : $steps - 1;
    if (
        $gradients[$curr]->[0][0] == $gradients[$prev]->[$ndx][0] &&
        $gradients[$curr]->[0][1] == $gradients[$prev]->[$ndx][1] &&
        $gradients[$curr]->[0][2] == $gradients[$prev]->[$ndx][2]
    )
    {
        $#{ $gradients[$prev] }--;
    }
    }

    my $gradients;
    for my $i ( 0 .. $max )
    {
    my $grad = $gradients[$i];
    for my $j ( 0 .. $#{ $grad } )
    {
        push @{ $gradients }, $grad->[$j];
    }
    }

    return $gradients;

}

# Algorithm found at http://www.cs.rit.edu/~ncs/color/t_convert.html
sub to_hsv 
{
    my $color = shift;
    my ( $h, $s, $v );

    my $min = min( @{ $color } );
    my $max = max( @{ $color } );

    $v = int( ( $max / 255 ) * 100 );

    my $delta = $max - $min;

    if ( $max == 0 )
    {
    # red = green = blue = 0 
    # s = 0, v is undef
    $s = 0;
    $h = -1;
    }
    else
    {
    $s = int( ( $delta / $max ) * 100 );

    if ( $color->[0] == $max )
    {
        $h = ( $color->[1] - $color->[2] ) / $delta; # between yellow & magenta
    }
    elsif ( $color->[1] == $max )
    {
        $h = 2 + ( $color->[2] - $color->[0] ) / $delta; # between cyan & yellow
    }
    else
    {
        $h = 4 + ( $color->[0] - $color->[1] ) / $delta; # between magenta & cyan
    }

    $h = int ( $h * 60 ); # degrees

    if ( $h < 0 )
    {
        $h += 360;
    }

    }

    return [ $h, $s, $v ];
}

It will print out the hex, RGB and HSV values for the colors you pass into chained_gradients. It also creates a very basic HTML file containing a table of your colors.

Here’s the output.

FF0000  [ 255,   0,   0 ]  h:   0, s: 100, v: 100
FF0F00  [ 255,  15,   0 ]  h:   3, s: 100, v: 100
FF1E00  [ 255,  30,   0 ]  h:   7, s: 100, v: 100
FF2D00  [ 255,  45,   0 ]  h:  10, s: 100, v: 100
FF3C00  [ 255,  60,   0 ]  h:  14, s: 100, v: 100
FF4B00  [ 255,  75,   0 ]  h:  17, s: 100, v: 100
FF5A00  [ 255,  90,   0 ]  h:  21, s: 100, v: 100
FF6900  [ 255, 105,   0 ]  h:  24, s: 100, v: 100
FF7800  [ 255, 120,   0 ]  h:  28, s: 100, v: 100
FF8700  [ 255, 135,   0 ]  h:  31, s: 100, v: 100
FF9600  [ 255, 150,   0 ]  h:  35, s: 100, v: 100
FFA500  [ 255, 165,   0 ]  h:  38, s: 100, v: 100
FFB400  [ 255, 180,   0 ]  h:  42, s: 100, v: 100
FFC300  [ 255, 195,   0 ]  h:  45, s: 100, v: 100
FFD200  [ 255, 210,   0 ]  h:  49, s: 100, v: 100
FFE100  [ 255, 225,   0 ]  h:  52, s: 100, v: 100
FFFF00  [ 255, 255,   0 ]  h:  60, s: 100, v: 100
EEFF00  [ 238, 255,   0 ]  h:  64, s: 100, v: 100
DDFF00  [ 221, 255,   0 ]  h:  68, s: 100, v: 100
CCFF00  [ 204, 255,   0 ]  h:  72, s: 100, v: 100
BBFF00  [ 187, 255,   0 ]  h:  76, s: 100, v: 100
AAFF00  [ 170, 255,   0 ]  h:  80, s: 100, v: 100
99FF00  [ 153, 255,   0 ]  h:  84, s: 100, v: 100
88FF00  [ 136, 255,   0 ]  h:  88, s: 100, v: 100
77FF00  [ 119, 255,   0 ]  h:  92, s: 100, v: 100
66FF00  [ 102, 255,   0 ]  h:  96, s: 100, v: 100
55FF00  [  85, 255,   0 ]  h: 100, s: 100, v: 100
44FF00  [  68, 255,   0 ]  h: 104, s: 100, v: 100
33FF00  [  51, 255,   0 ]  h: 108, s: 100, v: 100
22FF00  [  34, 255,   0 ]  h: 112, s: 100, v: 100
11FF00  [  17, 255,   0 ]  h: 116, s: 100, v: 100
00FF00  [   0, 255,   0 ]  h: 120, s: 100, v: 100

Here’s the HTML table that it generated.

Today, one of my coworkers asked about a piece of code that wasn’t giving the expected results. It’s a part of some really old code that would be done differently given the time to rewrite it. Any way, there are a series of if/elsif/else clauses that check various things. One of those things is to validate some data against a known constraint. This particular section is supposed to validate that the given data falls within the range of a valid UINT (UINT8, UINT16, etc).

elsif ( $constraint =~ /^UINT(\d+)/ )
{   
    $start = 0;
    $end = ( 0x1 << ( $1 - 1 ) );
}

That looks right, doesn’t it? Maybe… If you just glance at it…

Start with 1 and bit shift it left $1 - 1 times. So if we are validating a UINT8, we take 1 and bit shift it left 7 times which gives us… 128. Uh, that’s not right.

It should be written like this:

elsif ( $constraint =~ /^UINT(\d+)/ )
{   
    $start = 0;
    $end = ( 0x1 << $1 ) - 1;
}

Start with 1 and bit shift it left $1 times and subtract 1. So given a UINT8 again, we take a 1 and bit shift it left 8 times and subtract 1 leaving us with 255. Good.

It might be better if we did away with the bit shifts altogether though and did it using a power of 2 like this instead:

elsif ( $constraint =~ /^UINT(\d+)/ )
{   
    $start = 0;
    $end = 2 ** $1 - 1;
}

I haven’t looked at the commit to see who made this mistake because there’s about a 50/50 chance that it was me.