EO::Class - introspection class for Perl.

  use EO::Class

  my $class  = EO::Class->new();
  $class     = EO::Class->new_with_classname( 'Some::Class' );
  $class     = EO::Class->new_with_object( $foo );

  $classname = $class->name;

  $methods   = $class->methods;
  @methods  = $class->methods;

  if ($class->loaded) {
    $path = $class->path
  } else {
    $class->load();
    $path = $class->path;
  }

  $parent_classes = $class->parents;

  $class->add_method(
                     EO::Method->new()
                               ->name('foo')
                               ->reference( sub {} )
                    );

package EO::Class;

use strict;
use warnings;

use EO;
use EO::Error;
use EO::Array;
use EO::Method;

use Scalar::Util qw( blessed );

our @ISA = qw( EO );
our $VERSION = 0.96;

exception EO::Error::InvalidState;
exception EO::Error::ClassNotFound;

##
## construct with an object as a parameter
##
sub new_with_object {
  my $class = shift;
  my $obj   = shift;
  if (!$obj || !blessed( $obj )) {
    throw EO::Error::InvalidParameters text => 'no object provided';
  }
  $class->new_with_classname( ref($obj) );
}

##
## construct with a classname as a parameter
##
sub new_with_classname {
  my $class = shift;
  my $obj   = shift;
  if (!$obj || ref($obj)) {
    throw EO::Error::InvalidParameters text => 'no classname provided';
  }
  my $self = $class->new();
  $self->name( $obj );
  return $self;
}


##
## gets/sets the name of the class
##
sub name {
  my $self = shift;
  if (@_) {
    $self->{ classname } = shift;
    return $self;
  }
  return $self->{ classname };
}

##
## adds a method to a class
##
sub add_method {
  my $self   = shift;
  my $method = shift;
  if (!$method) {
    throw EO::Error::InvalidParameters text => "must provide a EO::Method object as an argument";
  }
  if (!$method->name) {
    throw EO::Error::InvalidState text => 'Method object has no name value set';
  }
  if (!$method->reference) {
    throw EO::Error::InvalidState text => 'Method object has no reference value set';
  }
  my $class  = $self->name;
  {
    no strict 'refs';
    *{$class . '::' . $method->name} = $method->reference;
  }
}

##
## gets a method from a class
##
sub get_method {
  my $self = shift;
  my $name = shift;
  if (!$name) {
    throw EO::Error::InvalidParameters text => "no methodname provided";
  }
  if (!$self->name) {
    throw EO::Error::InvalidState text => "class has no name()";
  }
  my $symbol;
  {
    no strict 'refs';
    $symbol = *{$self->name .'::'.$name};
  }
  my $method = EO::Method->new();
  my $ref    = $self->name->can($symbol);
  if ($ref) {
    return EO::Method->new()
                     ->name( $name )
		     ->reference( $ref );
  }
  throw EO::Error::Method::NotFound text => "cannot find method $symbol";
}

##
## returns a list of methods
##
sub methods {
  my $self = shift;
  if (!$self->name) {
    throw EO::Error::InvalidState text => "class has no name()";
  }
  my $glob;
  {
    no strict 'refs';
    $glob = *{$self->name .'::'};
  }
  my @syms = keys %{$glob};
  my $methods = EO::Array->new();
  foreach my $symbol (@syms) {
    next unless $symbol;
    my $method;
    eval {
      $method = $self->get_method( $symbol );
    };
    if (!$@) {
      $methods->push( $method );
    }
  }
  if (wantarray) {
    return $methods->iterator;
  } else {
    return $methods;
  }
}

##
## returns the path to the class as an EO::File object
##
sub path {
  my $self = shift;
  if (!$self->name) {
    throw EO::Error::InvalidState text => "class has no name()";
  }
  my $path = $INC{$self->_classToFile};
  if ($path) {
    my $pathclass = ref($self)->new_with_classname( 'EO::File' );
    eval {
      $pathclass->load();
    };
    if (!$@) {
      EO::File->new( path => $INC{$self->_classToFile} );
    } else {
      EO::File::Stub->new( $path );
    }
  } else {
    my $name = $self->name;
    throw EO::Error::InvalidState text => "class $name has not yet been loaded";
  }
}

##
## returns true if the the class can delegate
##
sub can_delegate {
  my $self = shift;
  if (!$self->name) {
    throw EO::Error::InvalidState text => "class has no name()";
  }
  $self->name->can('delegate');
}

##
## returns the parent classes of the class
##
sub parents {
  my $self = shift;
  if (!$self->name) {
    throw EO::Error::InvalidState text => "class has no name()";
  }
  my $list = EO::Array->new();
  {
    no strict 'refs';
    $list->push( map { EO::Class->new_with_classname( $_ ) } @{$self->name . '::ISA'} );
  }
  if (wantarray) {
    return $list->iterator;
  } else {
    return $list;
  }
}

##
## adds a parent class
##
sub add_parent {
  my $self  = shift;
  {
    no strict 'refs';
    push @{ $self->name . '::ISA' },
      map { (ref( $_ )) ? $_->name : $_ }
	grep { defined }
	  @_;
  }
  return $self;
}

##
## removes a parent class
##
sub del_parent {
  my $self = shift;
  my %PARENTHASH = ();
  {
    no strict 'refs';
    %PARENTHASH = map { ($_ => 1) } @{ $self->name . '::ISA' };
  }
  foreach my $parent (@_) {
    delete $PARENTHASH{ $parent };
  }
  {
    no strict 'refs';
    @{ $self->name . '::ISA' } = keys %PARENTHASH;
  }
  return $self;
}

##
## returns true if the class has been loaded
##
sub loaded {
  my $self = shift;
  my $path;
  !!$INC{ $self->_classToFile };
}

##
## loads a class
##
sub load {
  my $self = shift;
  eval {
    require $self->_classToFile;
  };
  if ($@) {
    throw EO::Error::ClassNotFound text => $@;
  }
  return 1;
}

##
## _classToFile is an internal method used to turn
##  class names into files that may be represented on
##  the disk.  The number of times I have written this
##  in the past I cannot remember...
##
sub _classToFile {
  my $self = shift;
  my $name = $self->name;
  $name =~ s/::/\//g;
  $name .= '.pm';
}

##
##
## stub package to handle situations when EO::File is not installed
##
##
package EO::File::Stub;

use strict;
our @ISA = qw( EO );

sub init {
  my $self = shift;
  if ($self->SUPER::init( @_ )) {
    $self->{ pathname } = shift;
    return 1;
  }
}

sub as_string {
  my $self = shift;
  return $self->{ pathname };
}

1;
__END__