tilesets.md

tileSets.pm

package tileSets;

use strict;
use Exporter;
use Time::HiRes 'usleep';
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
my $TILES;

$VERSION = 0.0.1;
@ISA = qw(Exporter);
@EXPORT = (qw(getTiles addTile execTile newTileSet execTileSet));
@EXPORT_OK = qw(getTiles);
%EXPORT_TAGS = (
  DEFAULT => [qw(&getTiles)]
);
$TILES = {
  TIMER => sub{
    my $timer = $_;
    $timer = $timer > 5000 ? 5000 : $timer < 0 ? 0 : $timer;
    usleep($timer);
    1;
  }
};

420;

sub getTiles{
  my @array;
  for(keys $TILES){
    push(@array, $_);
  }
  @array;
}

sub addTile{
  my $tile = shift;
  $TILES->{$tile->{"name"}} = $tile->{"routine"};
  1;
}

sub execTile{
  my ($tile, $args) = @_;
  $TILES->{$tile}($args);
}

sub newTileSet{
  {
    ROUTINE => undef
    ,SUCCESS => undef
    ,FAILURE => undef
  };
}

sub execTileSet{
  my ($hash,$inputs,$depth) = @_;
  $depth = (defined $depth && $depth =~ /^[+-]?\d+$/g) ? $depth : 5;
  if($depth == 0){
    return 1;
  }
  if(ref $hash->{'ROUTINE'} eq "CODE"){
    my $ret = $hash->{'ROUTINE'}($inputs) ? "SUCCESS" : "FAILURE";
    if(ref $hash->{$ret} eq "HASH"){
      execTileSet($hash->{$ret},$inputs,$depth-1);
    }
  }
  1;
}

test.pl

#!/usr/bin/perl -w

use strict;

use tileSets;

addTile({
  name => "TEST"
  ,routine => sub{
    my ($args) = @_;
    print("TEST1 <-> $args\n");
    1;
  }
});

execTile("TEST", "TEST1");

my $tileset = newTileSet();
my $random = rand(10);
my $step = 0;
my $success = 0;
my $fail = 0;
my $s = sub{
  $step++;
  print("step $step : $random\n");
  if($random < 5){
    $random = rand(10);
    $fail++;
    0;
  }else{
    $random = rand(10);
    $success++;
    1;
  }
};
$tileset->{"ROUTINE"} = $s;
$tileset->{"SUCCESS"} = $tileset;
$tileset->{"FAILURE"} = $tileset;


execTileSet($tileset, $random);
print("Successes: $success\nFailures: $fail\n");

OO

package tileSets;
use strict;
#use Exporter;
use Time::HiRes 'usleep';
#use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

sub new{
  my $class = shift;
  my ($self);
  $self = {
    TILES => {
      TIMER => sub{
        my $timer = $_;
        $timer = $timer > 5000 ? 5000 : $timer < 0 ? 0 : $timer;
        usleep($timer);
        1;
      }
    }
  };
  bless $self, $class;
  $self;
};

sub getTiles{
  my ($self,@array) = @_;
  for(keys $self->{"TILES"}){
    push(@array, $_);
  }
  @array;
};

sub addTile{
  my ($self,$tile) = @_;
  $self->{"TILES"}->{$tile->{"name"}} = $tile->{"routine"};
  1;
};

sub execTile{
  my ($self, $tile, $args) = @_;
  $self->{"TILES"}->{$tile}($args);
};

sub newTileSet{
  {
    ROUTINE => undef
    ,SUCCESS => undef
    ,FAILURE => undef
  };
};

sub execTileSet{
  my ($self,$hash,$inputs,$depth) = @_;
  $depth = (defined $depth && $depth =~ /^[+-]?\d+$/g) ? $depth : 5;
  if($depth == 0){
    return 1;
  }
  if(ref $hash->{'ROUTINE'} eq "CODE"){
    my $ret = $hash->{'ROUTINE'}($inputs) ? "SUCCESS" : "FAILURE";
    if(ref $hash->{$ret} eq "HASH"){
      $self->execTileSet($hash->{$ret},$inputs,$depth-1);
    }
  }
  1;
};
1;

test OO

#!/usr/bin/perl -w

use strict;

use tileSets;


my $ts1 = new tileSets();

$ts1->addTile({
  name => "TEST"
  ,routine => sub{
    my ($args) = @_;
    print("TEST1 <-> $args\n");
    1;
  }
});

$ts1->execTile("TEST", "TEST1");

my $tileset = $ts1->newTileSet();
my $random = rand(10);
my $step = 0;
my $success = 0;
my $fail = 0;
my $s = sub{
  $step++;
  print("step $step : $random\n");
  if($random < 5){
    $random = rand(10);
    $fail++;
    0;
  }else{
    $random = rand(10);
    $success++;
    1;
  }
};
$tileset->{"ROUTINE"} = $s;
$tileset->{"SUCCESS"} = $tileset;
$tileset->{"FAILURE"} = $tileset;


$ts1->execTileSet($tileset, $random);
print("Successes: $success\nFailures: $fail\n");