further refactor glob collector for spin-off

rjbs · Nov 21, 2010 · 30d4241 · 30d4241
1 parent c7a97ba
commit 30d4241
Showing 1 changed file with 53 additions and 39 deletions.
diff --git a/lib/Global/Context.pm b/lib/Global/Context.pm
@@ -7,65 +7,79 @@ use Global::Context::Env::Basic;
 use Global::Context::StackFrame::Trivial;
 use Sub::Exporter::Util ();
 
-use Sub::Exporter -setup => {
-  exports    => [
-    ctx_init => Sub::Exporter::Util::curry_method,
-    ctx_push => Sub::Exporter::Util::curry_method,
-  ],
-  collectors => { '$Context' => \'_export_context_glob' },
-};
+{
+  package Sub::Exporter::GlobSharer;
 
-sub default_variable_name { 'Context' }
-sub default_shared_glob   { \*Object }
+  sub glob_export_collector {
+    my ($default_name, $globref) = @_;
 
-sub _export_context_glob {
-  my ($self, $value, $data) = @_;
+    return sub {
+      my ($value, $data) = @_;
 
-  my $name;
-  $name = defined $value->{'-as'}
-        ? $value->{'-as'}
-        : $self->default_variable_name;
+      my $name;
+      $name = defined $value->{'-as'} ? $value->{'-as'} : $default_name;
 
-  $name =~ s/^\$//;
+      my $sym = "$data->{into}::$name";
 
-  my $sym = "$data->{into}::$name";
+      {
+        no strict 'refs';
+        *{$sym} = *$globref;
+      }
 
-  {
-    no strict 'refs';
-    *{$sym} = *{ $self->default_shared_glob };
+      $_[0] = $globref;
+      return 1;
+    }
   }
-
-  return 1;
 }
 
+use Sub::Exporter -setup => {
+  exports    => [
+    ctx_init => \'_build_ctx_init',
+    ctx_push => \'_build_ctx_push',
+  ],
+  collectors => {
+    '$Context' => Sub::Exporter::GlobSharer::glob_export_collector(
+      Context => \*Object,
+    )
+  },
+};
+
 sub default_context_class { 'Global::Context::Env::Basic' }
 sub default_frame_class   { 'Global::Context::StackFrame::Trivial' }
 
-sub ctx_init {
-  my ($class, $arg) = @_;
+sub _build_ctx_init {
+  my ($class, $name, $arg, $col) = @_;
 
-  my $ref = *{$class->default_shared_glob}{SCALAR};
-  Carp::confess("context has already been initialized") if $$ref;
+  return sub {
+    my ($arg) = @_;
 
-  $$ref = $class->default_context_class->new($arg)->with_pushed_frame(
-    $class->default_frame_class->new({
-      description => Carp::shortmess("context initialized"),
-      ephemeral   => 1,
-    }),
-  );
+    my $ref = *{ $col->{'$Context'} }{SCALAR};
+    Carp::confess("context has already been initialized") if $$ref;
 
-  return $$ref;
+    $$ref = $class->default_context_class->new($arg)->with_pushed_frame(
+      $class->default_frame_class->new({
+        description => Carp::shortmess("context initialized"),
+        ephemeral   => 1,
+      }),
+    );
+
+    return $$ref;
+  };
 }
 
-sub ctx_push {
-  my ($class, $frame) = @_;
+sub _build_ctx_push {
+  my ($class, $name, $arg, $col) = @_;
+
+  return sub {
+    my ($frame) = @_;
 
-  $frame = { description => $frame } unless ref $frame;
+    $frame = { description => $frame } unless ref $frame;
 
-  $frame = $class->default_frame_class->new($frame)
-    unless Scalar::Util::blessed($frame);
+    $frame = $class->default_frame_class->new($frame)
+      unless Scalar::Util::blessed($frame);
 
-  return ${ *{$class->default_shared_glob}{SCALAR} }->with_pushed_frame($frame);
+    return ${ *{ $col->{'$Context'} }{SCALAR} }->with_pushed_frame($frame);
+  }
 }
 
 1;