File Coverage

blib/lib/CGI/Widget.pm

Criterion	Covered	Total	%
statement	17	54	31.4
branch	1	24	4.1
condition	0	3	0.0
subroutine	5	15	33.3
pod	0	8	0.0
total	23	104	22.1

package CGI::Widget;

use strict;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $VERSION $AUTOLOAD);
#use vars qw($VERSION $AUTOLOAD);

$VERSION = '0.15';

require Exporter;
@ISA = 'Exporter';
@EXPORT_OK   = qw(AUTOLOAD);
%EXPORT_TAGS = ( 'standard' => [qw(AUTOLOAD)] );

use overload
 '""'     => \&asString,
 fallback => 1;

sub new {
  my $class = shift;
  my $self = bless {}, $class;
  $self->_init(@_);
  return $self;
}

sub import {
  my $exportset = $_[1];
  my $to_package = ((caller)[0]);
  my $code = '';

  return unless $exportset;

  if ($exportset eq ':html' or $exportset eq ':standard') {
    $code = "*".$to_package."::AUTOLOAD = \\&AUTOLOAD_html";
  } elsif ($exportset eq ':wml') {
    $code = "*".$to_package."::AUTOLOAD = \\&AUTOLOAD_wml";
  } elsif ($exportset eq ':javascript') {
    $code = "*".$to_package."::AUTOLOAD = \\&AUTOLOAD_javascript";
  }

  eval $code;
  die $@ if $@;
}

sub AUTOLOAD_html {
  my ($pack,$func) = $AUTOLOAD =~ /(.+)::([^:]+)$/;
  $func =~ s/__/::/g;

  my $req = "CGI::Widget::$func";
  eval "require $req" || die "couldn't find $req : $!";

  return CGI::Widget::html($func) unless $req->can('html');
  return $req->html(@_);
}

sub AUTOLOAD_wml {
  my ($pack,$func) = $AUTOLOAD =~ /(.+)::([^:]+)$/;
  $func =~ s/__/::/g;

  my $req = "CGI::Widget::$func";
  eval "require $req" || die "couldn't find $req : $!";

  return CGI::Widget::wml($func) unless $req->can('wml');
  return $req->wml(@_);
}

sub AUTOLOAD_javascript {
  my ($pack,$func) = $AUTOLOAD =~ /(.+)::([^:]+)$/;
  $func =~ s/__/::/g;

  my $req = "CGI::Widget::$func";
  eval "require $req" || die "couldn't find $req : $!";

  return CGI::Widget::javascript($func) unless $req->can('javascript');
  return $req->javascript(@_);
}

sub AUTOLOAD {
  my ($pack,$func) = $AUTOLOAD =~ /(.+)::([^:]+)$/;

  $func =~ s/__/::/g;

  my $req = "CGI::Widget::$func";
  eval "require $req" || die "couldn't find $req : $!";
  return $req->new(@_);
}

sub DESTROY {}

sub _init {
  my $self = shift;
  return 1;
}

sub html       { die "Looks like html() isn't defined in package ".shift;       }
sub wml        { die "Looks like wml() isn't defined in package ".shift;        }
sub javascript { die "Looks like javascript() isn't defined in package ".shift; }

sub asString {
  my $self = shift;
  return $self;  #what did you expect from the base class?
}

1;
__END__