File Coverage

blib/lib/WebService/GData.pm

Criterion	Covered	Total	%
statement	70	70	100.0
branch	10	12	83.3
condition	4	6	66.6
subroutine	22	22	100.0
pod	5	5	100.0
total	111	115	96.5

package WebService::GData;
use 5.008008;
use strict;
use warnings;
use Carp;
use overload '""' => "__to_string", '==' => 'equal', fallback => 1;

our $VERSION = 0.06;

our $AUTOLOAD;

sub import {
	strict->import;
	warnings->import;
	my $import  = shift;
	my $package = caller;
	if ($import) {
		install_in_package( ['private'], sub { return \&private; }, $package );
	}
}

sub new {
	my $package = shift;
	my $this    = {};
	bless $this, $package;
	$this->__init(@_);
	return $this;
}

sub __init {
	my ( $this, %params ) = @_;

	while ( my ( $prop, $val ) = each %params ) {
		$this->{$prop} = $val;
	}
}

sub __to_string {
	return shift;
}

sub equal {
	my ( $left, $right ) = @_;
	return overload::StrVal($left) eq overload::StrVal($right);
}

sub install_in_package {
	my ( $subnames, $callback, $package ) = @_;

	$package = $package || caller;
	return if ( $package eq 'main' );    #never import into main
	{                                    #install
		no strict 'refs';
		no warnings 'redefine';
		foreach my $sub (@$subnames) {
			*{ $package . '::' . $sub } = &$callback($sub);
		}
	}

}

sub private {
	my ( $name, $sub ) = @_;
	my $package = caller;
	install_in_package(
		[$name],
		sub {
			return sub {
				my @args = @_;
				my $p    = caller;
				croak {
					code    => 'forbidden_access',
					content => 'private method called outside of its package'
				  }
				  if ( $p ne $package );
				return &$sub(@args);
			  }
		},
		$package
	);
}

sub disable {
	my ( $parameters, $package ) = @_;
	$package = $package || caller;
	install_in_package(
		$parameters,
		sub {
			return sub {

				#keep the chaining
				return shift();
			  }
		},
		$package
	);

}

##must test for side effects.
##Might get rid of the following...

sub AUTOLOAD {
	my $func = $AUTOLOAD;

	$func =~ s/.*:://;
	my $this = shift;

	return if $func =~ m/[A-Z]+/;

	return $this->__set( $func, @_ ) if @_ >= 1;

	$this->__get($func);

}

sub __set {
	my ( $this, $func, @args ) = @_;
	$this->{$func} = @args == 1 ? $args[0] : \@args;
	return $this;
}

sub __get {
	my ( $this, $func ) = @_;
	return $this->{$func};
}

"The earth is blue like an orange.";

__END__