allow subclassing of Global::Context

mjdominus · Nov 21, 2010 · 82df0b9 · 82df0b9
1 parent 74f1f20
commit 82df0b9
Showing 1 changed file with 16 additions and 9 deletions.
diff --git a/lib/Global/Context.pm b/lib/Global/Context.pm
@@ -5,40 +5,47 @@ package Global::Context;
 use Carp ();
 use Global::Context::Env::Basic;
 use Global::Context::StackFrame::Trivial;
+use Sub::Exporter::Util ();
 
 our $Object;
 
 use Sub::Exporter -setup => {
   exports    => [
-    ctx_init =>
-    ctx_push =>
+    ctx_init => Sub::Exporter::Util::curry_method,
+    ctx_push => Sub::Exporter::Util::curry_method,
   ],
   collectors => { '$Context' => \'_export_context_glob' },
 };
 
+sub default_variable_name { 'Context' }
+sub default_shared_glob { \*Object }
+
 sub _export_context_glob {
   my ($self, $value, $data) = @_;
 
   my $name;
-  $name = $value->{'-as'} || 'Context';
+  $name = $value->{'-as'} || $self->default_variable_name;
   $name =~ s/^\$//;
 
   my $sym = "$data->{into}::$name";
 
   {
     no strict 'refs';
-    *{$sym} = *Global::Context::Object;
+    *{$sym} = *{ $self->default_shared_glob };
   }
 
   return 1;
 }
 
+sub default_context_class { 'Global::Context::Env::Basic' }
+sub default_frame_class   { 'Global::Context::StackFrame::Trivial' }
+
 sub ctx_init {
-  my ($arg) = @_;
+  my ($class, $arg) = @_;
   Carp::confess("context has already been initialized") if $Object;
 
-  $Object = Global::Context::Env::Basic->new($arg)->with_pushed_frame(
-    Global::Context::StackFrame::Trivial->new({
+  $Object = $class->default_context_class->new($arg)->with_pushed_frame(
+    $class->default_frame_class->new({
       description => Carp::shortmess("context initialized"),
       ephemeral   => 1,
     }),
@@ -48,11 +55,11 @@ sub ctx_init {
 }
 
 sub ctx_push {
-  my ($frame) = @_;
+  my ($class, $frame) = @_;
 
   $frame = { description => $frame } unless ref $frame;
 
-  $frame = Global::Context::StackFrame::Trivial->new($frame)
+  $frame = $class->default_frame_class->new($frame)
     unless Scalar::Util::blessed($frame);
 
   return $Object->with_pushed_frame($frame);