Reminder: Phoenix.pm: Meeting 07/18/2002

[Scott Walters]

Thanks everyone who showed up, and as always, Doug for having us.

Errata:

The other thing I was hoping to see a slide on but neglected to have
was interface.pm.

interface.pm is a pragma that does compile-time interface checking.

For example:

use interface 'DBI::DBD', 'Clonable', 'Storable';

...code...

would look through DBI/DBD.pm, Clonable.pm, and Storable.pm, and make sure
that your package contained every method that each of these modules did.
It also lists your module as ->isa() for each thing you list as an interface.

ImplicitThis.pm and interface.pm are both available on CPAN:

http://www.cpan.org/modules/by-authors/id/S/SW/SWALTERS/

With the inner classes example, I screwed up the slide:

The example should have read:

sub getIterator {
  my $parentThis = shift;
  return eval {
    package WebsafeColors::Iterator;
    # this mini sub-package only knows how to iterate over our data structure
    @ISA=(Iterator);
    sub new {
      my $type = shift;
      my $this = { currentIndex=>0 };
      bless $this, $type;
    } 
    sub hasNext {
      my $this = shift;
      return @{$parentThis->{'colors'}} > $this->{'currentIndex'};
    }
    sub getNext {
      my $this = shift;
      die unless $this->hasNext();
      return $parentThis->{'colors'}->[$this->{'currentIndex'}++];
    }
    __PACKAGE__;
  }->new(); 
} 
  

I'm attaching the full test module to this message so that you can run it yourself.

-scott
-------------- next part --------------

#
# this is an example of an inner class in perl.
# an inner class is a class that is wholely contained inside of
# another class. it is declared where it is needed and an instance
# is returned immediately.
#

package Iterator;

# abstract class

sub new     { die };
sub hasNext { die };
sub getNext { die };

1;

package WebsafeColors;

sub new {
  my $type = shift;
  my $this = { };
  # this is our internal representation: a large array. we might change this in the future,
  # so we dont want to hand out this array directly. instead, we provide an interator
  # interface.
  my $sixcube = ['00', '33', '66', '99', 'cc', 'ff'];
  $this->{'colors'} = [ 
    map { $a =  $_;  map { $b = $_; map { '0x'.$a.$b.$_ } @$sixcube } @$sixcube } @$sixcube
  ];
  bless $this, $type;
}

sub findClosistColor {
  my $this = shift;
  my $colorIn = shift;
  (my $red, my $green, my $blue) = $this->_intToRGB($colorIn);
  my $computeDistance = sub {
    return abs($red - $_[0]) + abs($green - $_[1]) + abs($blue - $_[2]);
  };
  my $it = $this->getIterator(); # we can call this, and so can outsiders
  my $minDistance = 1<<25;
  my $newColor;
  my $colorSafeColor;
  my $distance;
  while($it->hasNext()) {
    $colorSafeColor = $it->getNext();
    $distance = $computeDistance->($this->_intToRGB(hex $colorSafeColor));
    if($distance < $minDistance) {
      $newColor = $colorSafeColor; $minDistance = $distance;
    }
  }
  return $newColor || 0x000000;
}

sub _intToRGB {
  my $this = shift;
  die unless caller eq __PACKAGE__; # private
  my $color = shift;
  my $red =   ($color & 0xff0000) >> 16;
  my $green = ($color & 0x00ff00) >> 8;
  my $blue =  ($color & 0x0000ff);
  return ($red, $green, $blue);
}

sub getIterator {
  my $parentThis = shift;
  return eval {
    package WebsafeColors::Iterator;
    # this mini sub-package only knows how to iterate over our data structure
    @ISA=(Iterator);
    sub new {
      my $type = shift;
      my $this = { currentIndex=>0 };
      bless $this, $type;
    }
    sub hasNext {
      my $this = shift;
      return @{$parentThis->{'colors'}} > $this->{'currentIndex'};
    }
    sub getNext {
      my $this = shift;
      die unless $this->hasNext();
      return $parentThis->{'colors'}->[$this->{'currentIndex'}++];
    }
    __PACKAGE__;
  }->new();
}

1;