File Coverage

blib/lib/Games/Sudoku/Component/Table/Permission.pm

Criterion	Covered	Total	%
statement	61	68	89.7
branch	18	26	69.2
condition	1	4	25.0
subroutine	14	15	93.3
pod	7	7	100.0
total	101	120	84.1

package Games::Sudoku::Component::Table::Permission;
{
  use strict;
  use warnings;
  use Carp;

  our $VERSION = '0.01';

  use base qw/Games::Sudoku::Component::Base/;

  my $Verbose = 0;

  sub _initialize {
    my ($this, %options) = @_;

    $this->clear;
  }

  sub verbose { shift; $Verbose = shift; }

  sub clear {
    my $this = shift;

    my $size = $this->{size};
    my $flag = (2 ** $size) - 1;

    foreach my $ct (1..$size) {
      $this->{row}[$ct] = $flag;
      $this->{col}[$ct] = $flag;
      $this->{blk}[$ct] = $flag;
    }
  }

  sub allow {
    my ($this, $row, $col, $value) = @_;

    my $blk = $this->_block_id($row,$col);

    $this->{row}[$row] = $this->_on($this->{row}[$row], $value);
    $this->{col}[$col] = $this->_on($this->{col}[$col], $value);
    $this->{blk}[$blk] = $this->_on($this->{blk}[$blk], $value);
  }

  sub deny {
    my ($this, $row, $col, $value) = @_;

    my $blk = $this->_block_id($row,$col);

    $this->{row}[$row] = $this->_off($this->{row}[$row], $value);
    $this->{col}[$col] = $this->_off($this->{col}[$col], $value);
    $this->{blk}[$blk] = $this->_off($this->{blk}[$blk], $value);
  }

  sub allowed {
    my ($this, $row, $col) = @_;

    my @allowed = ();
    foreach my $ct (1..$this->{size}) {
      push @allowed, $ct if $this->is_allowed($row, $col, $ct);
    }
    @allowed;
  }

  sub is_allowed {
    my ($this, $row, $col, $value) = @_;

    my $blk = $this->_block_id($row, $col);

    return $this->result(
      result => 0,
      reason => "row $row has $value"
    ) unless $this->_flag($this->{row}[$row], $value);

    return $this->result(
      result => 0,
      reason => "col $col has $value"
    ) unless $this->_flag($this->{col}[$col], $value);

    return $this->result(
      result => 0,
      reason => "blk $blk has $value"
    )  unless $this->_flag($this->{blk}[$blk], $value);

    return $this->result(1);
  }

  sub result {
    my $this = shift;

    if ($Verbose) {
      require Games::Sudoku::Component::Result;
      my $result = Games::Sudoku::Component::Result->new(@_);
    }
    else {
      if (@_ == 1) {
        if (ref $_[0] eq 'HASH') {
          my %options = %{ $_[0] };
          return $options{result} || 0;
        }
        else {
          return $_[0];
        }
      }
      else {
        my %options = @_;
        return $options{result} || 0;
      }
    }
  }

  sub _flag {
    my ($this, $flag, $value) = @_;

    croak "Invalid value: $value" unless $this->_check($value);
    croak "Invalid flag: undef"   unless defined $flag;

    return (0 + $flag) & (2 ** ($value - 1));
  }

  sub _on {
    my ($this, $flag, $value) = @_;

    croak "Invalid value: $value" unless $this->_check($value);
    croak "Invalid flag: undef"   unless defined $flag;

    return (0 + $flag) | (2 ** ($value - 1));
  }

  sub _off {
    my ($this, $flag, $value) = @_;

    croak "Invalid value: $value" unless $this->_check($value);
    croak "Invalid flag: undef"   unless defined $flag;

    return (0 + $flag) & ~(2 ** ($value - 1));
  }
}

1;
__END__