[Rt-commit] r2225 - in experiments/Bamboo: . ex/trivial
ex/trivial/lib ex/trivial/lib/Bamboo
ex/trivial/lib/Bamboo/Facade ex/trivial/lib/lib ex/trivial/t
lib/Bamboo/Model
jesse at bestpractical.com
jesse at bestpractical.com
Sun Feb 13 18:55:20 EST 2005
Author: jesse
Date: Sun Feb 13 18:55:19 2005
New Revision: 2225
Added:
experiments/Bamboo/ex/trivial/
experiments/Bamboo/ex/trivial/lib/
experiments/Bamboo/ex/trivial/lib/Bamboo/
experiments/Bamboo/ex/trivial/lib/Bamboo/Facade/
experiments/Bamboo/ex/trivial/lib/Bamboo/Facade/.Counter.pm.swp (contents, props changed)
experiments/Bamboo/ex/trivial/lib/Bamboo/Facade/Counter.pm
experiments/Bamboo/ex/trivial/lib/Counter.pm
experiments/Bamboo/ex/trivial/lib/lib/
experiments/Bamboo/ex/trivial/t/
experiments/Bamboo/ex/trivial/t/1counter.t
experiments/Bamboo/ex/trivial/t/2facade.t
experiments/Bamboo/lib/Bamboo/Model/Facade.pm
Modified:
experiments/Bamboo/ (props changed)
experiments/Bamboo/lib/Bamboo/Model/ProxyObject.pm
Log:
r4685 at hualien: jesse | 2005-02-13T23:53:37.004470Z
Checkpoint!
Added: experiments/Bamboo/ex/trivial/lib/Bamboo/Facade/.Counter.pm.swp
==============================================================================
Binary file. No diff available.
Added: experiments/Bamboo/ex/trivial/lib/Bamboo/Facade/Counter.pm
==============================================================================
--- (empty file)
+++ experiments/Bamboo/ex/trivial/lib/Bamboo/Facade/Counter.pm Sun Feb 13 18:55:19 2005
@@ -0,0 +1,22 @@
+package Bamboo::Facade::Counter;
+
+use warnings;
+use strict;
+use base qw/Bamboo::Model::Facade/;
+use Counter;
+
+__PACKAGE__->facade_for('Counter');
+
+
+__PACKAGE__->register_method('new');
+__PACKAGE__->register_method('increment');
+__PACKAGE__->register_method('set');
+__PACKAGE__->register_method('value');
+__PACKAGE__->register_parameter( method => 'set',
+ position => 1,
+ validator => 'Bamboo::Validator::integer'
+ );
+
+
+
+1;
Added: experiments/Bamboo/ex/trivial/lib/Counter.pm
==============================================================================
--- (empty file)
+++ experiments/Bamboo/ex/trivial/lib/Counter.pm Sun Feb 13 18:55:19 2005
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+package Counter;
+
+sub new {
+ my $self = {};
+ bless $self;
+ $self->{'counter'} = 0;
+ return($self);
+
+}
+
+sub increment {
+ my $self = shift;
+ $self->{counter}++;
+
+
+}
+
+sub value {
+ my $self = shift;
+ return $self->{counter};
+}
+
+sub set {
+ my $self = shift;
+ my $new = shift;
+ $self->{'counter'} = $new;
+}
+
+
+1;
Added: experiments/Bamboo/ex/trivial/t/1counter.t
==============================================================================
--- (empty file)
+++ experiments/Bamboo/ex/trivial/t/1counter.t Sun Feb 13 18:55:19 2005
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use Test::More qw/no_plan/;
+use_ok('Counter');
+
+my $counter = Counter->new();
+
+isa_ok($counter,'Counter');
+foreach my $method qw(value set increment ) {
+can_ok($counter, $method);
+
+}
+
+is ($counter->value,0);
+$counter->increment;
+
+is($counter->value,1);
+
+$counter->set(5);
+
+is($counter->value,5);
+$counter->increment;
+
+is($counter->value,6);
Added: experiments/Bamboo/ex/trivial/t/2facade.t
==============================================================================
--- (empty file)
+++ experiments/Bamboo/ex/trivial/t/2facade.t Sun Feb 13 18:55:19 2005
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+use Test::More qw/no_plan/;
+use_ok('Bamboo::Facade::Counter');
+
+my $counter = Bamboo::Facade::Counter->new();
+
+isa_ok($counter,'Bamboo::Facade::Counter');
+foreach my $method qw(value set increment ) {
+ can_ok($counter, $method);
+}
+
+is ($counter->call('value'),0);
+$counter->call('increment');
+
+is($counter->call('value'),1);
+
+$counter->call(set => 5);
+
+is($counter->call('value'),5);
+$counter->call('increment');
+
+is($counter->call('value'),6);
Added: experiments/Bamboo/lib/Bamboo/Model/Facade.pm
==============================================================================
--- (empty file)
+++ experiments/Bamboo/lib/Bamboo/Model/Facade.pm Sun Feb 13 18:55:19 2005
@@ -0,0 +1,395 @@
+use warnings;
+use strict;
+
+package Bamboo::Model::Facade;
+use Params::Validate qw(:all);
+use base qw/Bamboo::Base/;
+
+our %_NOTES;
+our ($BACKEND_CLASS, $_METHODS);
+
+$_METHODS= {};
+
+# Set up the facade {{{
+
+=head2 facade_for CLASS
+
+
+=cut
+
+sub facade_for {
+ my $package = shift;
+ $BACKEND_CLASS = shift if (@_);
+ return ($BACKEND_CLASS);
+
+}
+
+=head2 _setup_delegate
+
+This method is called by the "new" constructor and sets up a new, empty delegate object for this facade to proxy to. The default behaviour is:
+
+ $delegate = facade_for()->new();
+
+If you want something else, subclass.
+
+=cut
+
+sub _setup_delegate {
+ my $self = shift;
+ $self->{'__delegate'} = facade_for()->new();
+}
+
+
+=head2 delegate
+
+Return the delegated object
+
+=cut
+
+sub delegate {
+ my $self = shift;
+ return($self->{'__delegate'});
+}
+
+# }}}
+
+# methods dealing with delegated methods {{{
+
+=head2 register_method METHOD
+
+Register METHOD as a method that can be called through the facade
+
+=cut
+
+sub register_method {
+ my $package = shift;
+ my $method = shift;
+ unless (UNIVERSAL::can(facade_for(), $method)) {
+ warn "No such method $method for ".facade_for();
+ return(undef);
+ }
+ $_METHODS->{$method} = {};
+}
+
+=head2 can METHODNAME
+
+Does this proxy object have a given method
+
+=over
+
+=item METHODNAME
+
+Name of the method we're looking for
+
+=back
+
+=cut
+
+sub can {
+ my $self = shift; # we don't need it, but hey, we're a method
+ my $method = shift;
+ unless (defined $method && exists $_METHODS->{$method}) {
+ return undef;
+ }
+ return 1;
+}
+
+# }}}
+
+
+# methods deal with parameters for method calls {{{
+
+sub register_parameter {
+ my $package = shift;
+ my %args = (method => undef,
+ position => undef,
+ validator => undef,
+ name => undef,
+ @_);
+
+
+ unless ($package->can($args{'method'})) {
+ warn "Invalid method ".$args{'method'};
+ return(undef);
+ }
+ if ($args{'validator'}) {
+ eval "require $args{'validator'}";
+ if ($@) {
+ warn "Invalid validator (Couldn't load module): $@";
+ return undef;
+ }
+ }
+ if (!$args{'name'}) {
+ unless ($args{'position'}) {
+ warn "Parameters need names or positions";
+ }
+ $args{'name'} = "__Position-".$args{'position'};
+ delete $args{'position'};
+ }
+
+ $_METHODS->{$args{'method'}}->{$args{'name'}} = { validator => $args{'validator'} }
+
+
+}
+
+
+=head2 method_parameters method
+
+Takes a scalar name of a method.
+Returns a reference to a hash whose keys are the parameters this method takes.
+The value of each hash parameter is a reference to a canonicalizer and validator for that parameter.
+
+XXX TODO: should return a Bamboo::Model::parameters object
+
+=cut
+
+sub method_parameters {
+ my $self = shift;
+ my $method = shift;
+
+ #return the parameters this object expects for this method
+ return ( $_METHODS->{$method}->{params} );
+
+}
+
+
+=head2 method_has_parameter
+
+Returns true if the "method" parameter has an parameter
+with the name
+
+=over
+
+=item method
+
+=item parameter
+
+=back
+
+=cut
+
+sub method_has_parameter {
+ my $self = shift;
+ my %args = (
+ method => undef,
+ parameter => undef,
+ @_
+ );
+
+ if ( $self->method_parameter( $args{'method'} )->{ $args{'parameter'} } ) {
+ return (1);
+ }
+ else {
+ return undef;
+ }
+
+}
+
+# }}}
+
+# methods dealing with actually making method calls {{{
+
+
+sub call {
+ my $self = shift;
+ my $method = shift;
+
+ $self->delegate->$method(@_);
+}
+
+
+
+=head2 validate_method_call { method => SCALAR, parameters => HASHREF }
+
+
+Takes a method name and a hashref to the proposed parameters for this method.
+Validates the method and proposed parameters. Returns true if the method call is safe to make and false if not.
+
+
+** This method canonicalizes and massages the parameters in place.
+
+
+=cut
+
+sub validate_method_call {
+ my $self = shift;
+ my %args = (
+ method => undef,
+ parameters => undef,
+ @_
+ );
+
+ # make sure it's an ok method
+ return undef unless ( $self->can( $args{'method'} ) );
+
+ # make sure only known parameters are listed
+ $self->prune_method_call_parameters(
+ parameters => $args{'parameters'},
+ method => $args{'method'}
+ );
+
+
+ # canonicalize each parameter
+ $self->canonicalize_method_call_parameters(
+ parameters => $args{'parameters'},
+ method => $args{'method'}
+ );
+
+ # make sure that each of the parameters is valid
+
+ #XX Call the validate sub
+
+}
+
+
+
+=head2 prune_method_call_parameters
+
+Remove parameters that aren't valid parameters for this method
+
+=over
+
+=item method
+
+=item parameters
+
+=back
+
+=cut
+
+sub prune_method_call_parameters {
+ my $self = shift;
+ my %args = (
+ parameters => undef,
+ method => undef,
+ @_
+ );
+
+ foreach my $param ( keys %{ $args{'parameters'} } ) {
+ unless (
+ $self->method_has_parameter(
+ method => $args{'method'},
+ parameter => $param
+ )
+ )
+ {
+ $self->_record_note( object => $self,
+ method => $args{'method'},
+ parameter => $param,
+ message => 'No such parameter');
+ delete $args{'parameters'}->{$param};
+ }
+
+ }
+
+}
+
+
+
+=head2 canonicalize_method_call_parameters
+
+Remove parameters that aren't valid parameters for this method
+
+=over
+
+=item method
+
+=item parameters
+
+=back
+
+=cut
+
+sub canonicalize_method_call_parameters {
+ my $self = shift;
+ my %args = (
+ parameters => undef,
+ method => undef,
+ @_
+ );
+
+ foreach my $param ( keys %{ $args{'parameters'} } ) {
+ warn "Not canonicalizing yet";
+ }
+
+}
+
+# }}}
+
+=head2 _record_note
+
+Record some note, warning or error about this object for later presentation to the user
+
+=cut
+
+sub _record_note {
+ my $self = shift;
+ my %args = ( object => 'No object',
+ method => 'unknown',
+ parameter =>undef,
+ severity => undef,
+ value => undef,
+ message => undef,
+ @_
+ );
+
+ push @{ $_NOTES{ $args{'object'} }{ $args{'method'} } }, \%args;
+
+}
+
+
+=head1 What it needs to do
+
+=head2 new
+
+Create a proxy object
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+ $self->_setup_delegate();
+ return($self);
+}
+
+
+=head2 call_method
+
+Perform method calls on the object behind the proxy object.
+
+=head2 methods
+
+Find out what methods the proxy object supports.
+
+=head2 method_info
+
+For a given method that the proxy object supports, find out what its params are and what their types/validations are
+
+=cut
+
+=head2 current_user
+
+=over
+
+=item [current_user]
+
+An optional current_user that this method is a proxy for. Should be loaded just the once, when an current_user is instantiated.
+Proxy current_users shouldn't have their backend containers moving around
+
+=back
+
+=cut
+
+sub current_user {
+ my $self = shift;
+ if ( $_[0] ) {
+ my $current_user = shift;
+
+ $self->{_current_user} = $current_user;
+ }
+ return ( $self->{_current_user} );
+}
+
+1;
Modified: experiments/Bamboo/lib/Bamboo/Model/ProxyObject.pm
==============================================================================
--- experiments/Bamboo/lib/Bamboo/Model/ProxyObject.pm (original)
+++ experiments/Bamboo/lib/Bamboo/Model/ProxyObject.pm Sun Feb 13 18:55:19 2005
@@ -1,3 +1,6 @@
+die "You want facade";
+
+
use strict;
package Bamboo::Model::ProxyObject;
@@ -286,7 +289,7 @@
# }}}
-# {{{ prune_method_arguments
+# prune_method_arguments {{{
=head2 prune_method_arguments
More information about the Rt-commit
mailing list