File Coverage

blib/lib/Class/Random.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	10	14	71.4
condition	3	3	100.0
subroutine	9	9	100.0
pod	0	1	0.0
total	72	78	92.3

package Class::Random;

# $Id: Random.pm,v 1.3 2002/08/06 17:02:37 pmh Exp $

use overload '""','stringify';
use strict;
use Carp;
use vars qw($VERSION);

$VERSION=0.2;

sub stringify{
  my($self)=@_;

  if($self->{mode} eq 'choose'){
    @{$self->{isa}}=($self,@{$self->{list}[rand @{$self->{list}}]});
  }elsif($self->{mode} eq 'shuffle'){
    my @list=@{$self->{list}};
    my @isa;
    while(@list){
      push @isa,splice @list,rand @list,1;
    }
    @{$self->{isa}}=($self,@isa);
  }
  # Return a class with no methods, so the method search doesn't stop here
  'Class::Random::Empty';
}

sub import{
  my($pack,$mode,@list)=@_;
  @_>3
    or croak "Usage: use $pack BEHAVIOUR => LIST;";
  my $callpkg=caller;

  if($mode eq 'choose' || $mode eq 'shuffle'){
    if($mode eq 'choose'){
      foreach(@list){
        ref eq 'ARRAY'
          or croak "choose argument must be list of lists";
      }
    }

    my $self=bless {
      mode => $mode,
      list => \@list,
      isa => do{
        no strict 'refs';
        \@{$callpkg.'::ISA'};
      },
    };
    unshift @{$self->{isa}},$self;
    return "$self"; # Force setting of caller's @ISA
  }elsif($mode eq 'subclass'){
    my $new=sub{
      my $pkg=shift;
      $list[rand @list]->new(@_);
    };
    no strict 'refs';
    *{$callpkg.'::new'}=$new;
  }else{
    croak "Unknown $pack mode: $mode\n";
  }
}

package Class::Random::Empty;

1;

__END__