[MKDoc-commit] [MKDoc::Control_List] behave as advertised, expressions are evaluated in

[bruno at mkdoc.demon.co.uk]

Log Message:
-----------
[MKDoc::Control_List] behave as advertised, expressions are evaluated in
the context of the calling module.

Modified Files:
--------------
    MKDoc_Control_List:
        Changes
        MANIFEST
    MKDoc_Control_List/lib/MKDoc:
        Control_List.pm

Added Files:
-----------
    MKDoc_Control_List:
        .cvsignore
    MKDoc_Control_List/t:
        101_toys.t
    MKDoc_Control_List/t/data:
        toy_config.txt

-------------- next part --------------
--- /dev/null
+++ .cvsignore
@@ -0,0 +1,4 @@
+.swp
+Makefile
+blib
+pm_to_blib
Index: MANIFEST
===================================================================
RCS file: /var/spool/cvs/MKDoc_Control_List/MANIFEST,v
retrieving revision 1.1
retrieving revision 1.2
diff -LMANIFEST -LMANIFEST -u -r1.1 -r1.2
--- MANIFEST
+++ MANIFEST
@@ -5,3 +5,5 @@
 META.yml
 README
 t/100_Basic_Tests.t
+t/101_toys.t
+t/data/toy_config.txt
Index: Changes
===================================================================
RCS file: /var/spool/cvs/MKDoc_Control_List/Changes,v
retrieving revision 1.2
retrieving revision 1.3
diff -LChanges -LChanges -u -r1.2 -r1.3
--- Changes
+++ Changes
@@ -4,3 +4,5 @@
         - Pod documentation was very wrong
         - Added Changes, README, MANIFEST, META.yml
         - Removed defunct email address
+        - Added more tests
+        - operate in the namespace of the calling module
Index: Control_List.pm
===================================================================
RCS file: /var/spool/cvs/MKDoc_Control_List/lib/MKDoc/Control_List.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/MKDoc/Control_List.pm -Llib/MKDoc/Control_List.pm -u -r1.5 -r1.6
--- lib/MKDoc/Control_List.pm
+++ lib/MKDoc/Control_List.pm
@@ -21,6 +21,7 @@
 sub process
 {
     my $self = shift;
+    $self->{'caller'} = caller;
     my $code = $self->_compile();
     my @res  = $code->();
     return @res;
@@ -91,8 +92,10 @@
 
 sub _build_code_header
 {
+    my $self = shift;
+    my $caller = $self->{'caller'};
     return (
-	'$VAR1 = sub {',
+	"\$VAR1 = sub { package $caller;",
        );    
 }
 
@@ -343,7 +346,8 @@
   CONDITION <condition_name> <Perl Expression>
 
 If the perl expression is too big to fit on one line, write a function in
-a specific package and call that instead.
+a specific package and call that instead.  By default, expressions operate
+in the namespace of the calling package.
 
   CONDITION foo_condition    MyPackage::is_foo()
 
@@ -356,7 +360,8 @@
   RET_VALUE <ret_value_name> <Perl Expression>
 
 If the perl expression is too big to fit on one line, write a function in
-a specific package and call that instead.
+a specific package and call that instead.  By default, expressions operate
+in the namespace of the calling package.
 
   RET_VALUE foo_value    MyPackage::my_ret_value()
 
--- /dev/null
+++ t/101_toys.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+
+package GDGDGD;
+
+use strict;
+use warnings;
+use Test::More qw /no_plan/;
+
+use lib 'lib';
+use MKDoc::Control_List;
+
+use vars qw /$Current_Child/;
+
+sub default {return "Gizmo"};
+
+my $control_list = new MKDoc::Control_List (file => 't/data/toy_config.txt');
+my $toy;
+
+$Current_Child = "Davey";
+($toy)      = $control_list->process();
+is ($toy, "Galaxy Warrior");
+
+$GDGDGD::Current_Child = "Deanna";
+($toy)      = $control_list->process();
+is ($toy, "Doll");
+
+local $Current_Child = "Deacus";
+($toy)      = $control_list->process();
+is ($toy, "Gizmo");
+
--- /dev/null
+++ t/data/toy_config.txt
@@ -0,0 +1,11 @@
+CONDITION always_true    "true"
+CONDITION isa_boy        $Current_Child eq "Davey";
+CONDITION isa_girl       $Current_Child eq "Deanna";
+
+RET_VALUE generic_toy    default()
+RET_VALUE boy_toy        "Galaxy Warrior"
+RET_VALUE girl_toy       "Doll"
+
+RULE boy_toy        WHEN isa_boy
+RULE girl_toy       WHEN isa_girl
+RULE generic_toy    WHEN always_true