Add support for 'use $module (@$imports)' to Context.pm

perl5-dbi · Feb 12, 2014 · 7933736 · 7933736
1 parent 89c106b
commit 7933736
Showing 1 changed file with 43 additions and 19 deletions.
diff --git a/sandbox/tim/lib/Context.pm b/sandbox/tim/lib/Context.pm
@@ -29,24 +29,32 @@ sub push_var { # add a var to an existing config
     return;
 }
 
-sub get_env_var { my ($self, $name) = @_; return $self->get_var($name, 'Context::EnvVar') }
-sub get_our_var { my ($self, $name) = @_; return $self->get_var($name, 'Context::OurVar') }
-
-sub new_env_var { shift->new( Context::EnvVar->new(@_) ) }
-sub new_our_var { shift->new( Context::OurVar->new(@_) ) }
-
-
-
-my $quote_value_as_perl = sub {
-    my ($value) = @_;
-    my $perl_value = Data::Dumper->new([$value])->Terse(1)->Purity(1)->Useqq(1)->Sortkeys(1)->Dump;
-    chomp $perl_value;
-    return $perl_value;
+sub get_env_var    { my ($self, $name) = @_; return $self->get_var($name, 'Context::EnvVar') }
+sub get_our_var    { my ($self, $name) = @_; return $self->get_var($name, 'Context::OurVar') }
+sub get_module_use { my ($self, $name) = @_; return $self->get_var($name, 'Context::ModuleUse') }
+
+sub new_env_var    { shift->new( Context::EnvVar->new(@_) ) }
+sub new_our_var    { shift->new( Context::OurVar->new(@_) ) }
+sub new_module_use { shift->new( Context::ModuleUse->new(@_) ) }
+
+
+
+my $quote_values_as_perl = sub {
+    my @perl_values = map {
+        my $val = Data::Dumper->new([$_])->Terse(1)->Purity(1)->Useqq(1)->Sortkeys(1)->Dump;
+        chomp $val;
+        $val;
+    } @_;
+    require Carp;
+    Carp::croak("quote_values_as_perl called with multiple items in scalar context")
+        if @perl_values > 1 && !wantarray;
+    return $perl_values[0] unless wantarray;
+    return @perl_values;
 };
 
 
 {
-    package Context::BaseVar;
+    package Context::BaseItem;
     use strict;
 
     # base class for a named value
@@ -66,19 +74,19 @@ my $quote_value_as_perl = sub {
         return $self->{value};                  # scalar
     }
 
-} # Context::BaseVar
+} # Context::BaseItem
 
 
 {
     package Context::EnvVar;
     use strict;
-    use parent -norequire, 'Context::BaseVar';
+    use parent -norequire, 'Context::BaseItem';
 
     # subclass representing a named environment variable
 
     sub pre_code {
         my $self = shift;
-        my $perl_value = $quote_value_as_perl->($self->{value});
+        my $perl_value = $quote_values_as_perl->($self->{value});
         return sprintf '$ENV{%s} = %s;%s', $self->{name}, $perl_value, "\n";
     }
 
@@ -93,16 +101,32 @@ my $quote_value_as_perl = sub {
 {
     package Context::OurVar;
     use strict;
-    use parent -norequire, 'Context::BaseVar';
+    use parent -norequire, 'Context::BaseItem';
 
     # subclass representing a named 'our' variable
 
     sub pre_code {
         my $self = shift;
-        my $perl_value = $quote_value_as_perl->($self->{value});
+        my $perl_value = $quote_values_as_perl->($self->{value});
         return sprintf 'our $%s = %s;%s', $self->{name}, $perl_value, "\n";
     }
 
 } # Context::OurVar
 
+
+{
+    package Context::ModuleUse;
+    use strict;
+    use parent -norequire, 'Context::BaseItem';
+
+    # subclass representing 'use $name (@$value)'
+
+    sub pre_code {
+        my $self = shift;
+        my @imports = $quote_values_as_perl->(@{$self->{value}});
+        return sprintf 'use %s (%s);%s', $self->{name}, join(", ", @imports), "\n";
+    }
+
+} # Context::ModuleUse
+
 1;