File Coverage

blib/lib/POD/Tested.pm
Criterion Covered Total %
statement 58 139 41.7
branch 7 50 14.0
condition n/a
subroutine 15 22 68.1
pod 10 10 100.0
total 90 221 40.7


line stmt bran cond sub pod time code
1              
2             package POD::Tested ;
3              
4 1     1   39505 use base qw(Pod::Parser) ;
  1         2  
  1         114  
5              
6 1     1   6 use strict;
  1         3  
  1         30  
7 1     1   5 use warnings ;
  1         7  
  1         30  
8 1     1   5 use Carp ;
  1         2  
  1         92  
9              
10             BEGIN
11             {
12 1     1   984 use Sub::Exporter -setup => { exports => [ qw() ] } ;
  1         14287  
  1         19  
13              
14 1     1   344 use vars qw ($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
  1         2  
  1         72  
15 1     1   19 $VERSION = '0.06' ;
16             }
17              
18             #-------------------------------------------------------------------------------------------------------------------------------
19              
20 1     1   1097 use English qw( -no_match_vars ) ;
  1         4183  
  1         4  
21              
22 1     1   1182 use Readonly ;
  1         2704  
  1         56  
23             Readonly my $EMPTY_STRING => q{} ;
24              
25 1     1   5 use Carp qw(carp croak confess) ;
  1         2  
  1         41  
26              
27 1     1   855 use Lexical::Persistence ;
  1         21242  
  1         41  
28 1     1   1028 use IO::String ;
  1         5627  
  1         2073  
29              
30             #-------------------------------------------------------------------------------------------------------------------------------
31              
32             =head1 NAME
33              
34             POD::Tested - Test the code in your POD and generates POD.
35              
36             =head1 SYNOPSIS
37              
38             my $parser = POD::Tested->new(@options);
39            
40             $parser->parse_from_file($input_file) ;
41            
42             #or
43            
44             $parser->parse_from_filehandle($input_filehandle) ;
45            
46             write_file($output, $parser->GetPOD()) ;
47              
48             =head1 DESCRIPTION
49              
50             This module lets you write POD documents that are testable. It also let's you generate pod sections dynamically.
51              
52             Any verbatim section (indented section) is considered part of the POD and the code to be tested. See the I
53             tag for verbatim sections that are not code.
54              
55             =head1 DOCUMENTATION
56              
57             I wrote this module because I wanted a mechanism to verify the code I write in my POD. Code changes, output
58             changes and I would like my documentation to always be up to date.
59              
60             The installation procedure should install a B that you can use to verify your POD. This module is
61             very simple to use and has but a few commands. Since it's rather difficult to explain simple things, I'll use an
62             example based approach.
63              
64             Please give me feedback on the documentation or some examples and I'll integrate them in
65             module's documentation.
66              
67             =head2 From POD to POD
68              
69             =head1 Config::Hierarchical cookbook
70            
71             =head2 Simple usage
72            
73             Some Text
74            
75             =cut
76              
77             Let's run the above POD through B.
78              
79             $> perl pod_tested.pl -input simple.pod -output simple.tested.pod
80            
81             # Generating POD in 'simple.tested.pod'.
82             # No tests run!
83              
84             $> cat simple.tested.pod
85            
86             =head1 cookbook
87            
88             =head2 Simple usage
89            
90             Some Text
91            
92             =cut
93              
94             =head2 Testing your code
95              
96             =head1 cookbook
97            
98             =head2 Simple usage
99            
100             Some Text
101            
102             =begin hidden
103            
104             my $cc = 'cc' ;
105             my $expected_cc = 'cc' ;
106            
107             is($cc, $expected_cc, 'expected value') ;
108            
109             =end hidden
110              
111             Let's run the above POD through B.
112              
113             $> perl pod_tested.pl -input test.pod -output test.tested.pod
114             # output from 'script/test.pod:9':
115            
116             ok 1 - expected value
117            
118             # Generating POD in 'test.tested.pod'.
119             1..1
120              
121             The Generated POD output goes to the output file you specified. You get the test output on your terminal. The POD
122             would look like:
123              
124             =head1 cookbook
125            
126             =head2 Simple usage
127            
128             Some Text
129            
130             =cut
131              
132             Note that your test code is not part of the generated POD.
133              
134             =head2 Section common to your POD and tests
135              
136             Most often we want to show an example in the POD and verify it.
137              
138             =head1 Config::Hierarchical cookbook
139            
140             =head2 Simple usage
141            
142             Some text
143            
144             use Config::Hierarchical ;
145            
146             my $config = new Config::Hierarchical();
147            
148             $config->Set(NAME => 'CC', VALUE => 'acc') ;
149             $config->Set(NAME => 'CC', VALUE => 'gcc') ;
150            
151             my $cc_value = $config->Get(NAME => 'CC') ;
152            
153             print "CC = '$cc_value'\n" ;
154            
155             =begin hidden
156            
157             my $expected_output = 'gcc' ;
158             is($cc_value, $expected_output, 'expected value') ;
159            
160             =end hidden
161            
162             =cut
163              
164             Let's run the above POD through B.
165              
166             $> perl pod_tested.pl -input common.pod -output common.tested.pod
167             # output from 'script/common.pod:9':
168            
169             CC = 'gcc'
170            
171             # output from 'script/common.pod:24':
172            
173             ok 1 - expected value
174            
175             # Generating POD in 'common.tested.pod'.
176             1..1
177              
178             The POD is:
179              
180             =head1 Config::Hierarchical cookbook
181            
182             =head2 Simple usage
183            
184             Some text
185            
186             use Config::Hierarchical ;
187            
188             my $config = new Config::Hierarchical();
189            
190             $config->Set(NAME => 'CC', VALUE => 'acc') ;
191             $config->Set(NAME => 'CC', VALUE => 'gcc') ;
192            
193             my $cc_value = $config->Get(NAME => 'CC') ;
194            
195             print "CC = '$cc_value'\n" ;
196            
197             =cut
198              
199             =head2 When things go wrong
200              
201             =head1 cookbook
202            
203             =head2 Simple usage
204            
205             Some Text
206            
207             =begin hidden
208            
209             my $cc = 'cc' ;
210             my $expected_cc = 'cc' ;
211            
212             is($cc_value, $expected_output) ;
213            
214             =end hidden
215              
216             Let's run the above POD through B.
217              
218             $> perl pod_tested.pl -input test.pod -output test.tested.pod
219             Global symbol "$cc_value" requires explicit package name at 'script/test.pod' line 12, <$in_fh> line 15.
220             Global symbol "$expected_output" requires explicit package name at 'script/test.pod' line 12, <$in_fh> line 15.
221             at script/pod_tested.pl line 31
222             # Looks like your test died before it could output anything.
223              
224             Oops! This is a rather common error, copy/pasting code and modifying it for pod.
225              
226             The following pod:
227              
228             =head1 HEADER
229            
230             my $cc = ;
231             my $expected_cc = 'cc' ;
232            
233             is($cc, $expected_cc) ;
234            
235             =cut
236              
237             produces:
238              
239             syntax error at 'script/error_1.pod' line 9, at EOF
240             at script/pod_tested.pl line 31
241             # Looks like your test died before it could output anything.
242              
243             while:
244              
245             =head1 HEADER
246            
247             sub error { 1/0 }
248            
249             error() ;
250            
251             =cut
252              
253             produces:
254              
255             Illegal division by zero at 'script/error_2.pod' line 5, <$in_fh> line 10.
256             at script/pod_tested.pl line 31
257             # Looks like your test died before it could output anything.
258              
259             =head2 keeping your context together
260              
261             =head1 HEADER
262            
263             Some text
264            
265             my $cc_value = 'CC' ;
266            
267             print "CC = '$cc_value'\n" ;
268            
269             More text or code examples.
270            
271             =begin not_tested
272            
273             # this section is not part of the test but is part of the POD
274            
275             my $non_tested_code = 1 ;
276             DoSomething() ;
277            
278             =end not_tested
279            
280             =begin hidden
281            
282             my $expected_output = 'gcc' ;
283             is($cc_value, $expected_output) ;
284            
285             =end hidden
286            
287             =cut
288              
289             The example above defines a variable in a section and uses it in another section.
290              
291             the output would be:
292              
293             # output from 'script/context.pod:7':
294            
295             CC = 'CC'
296            
297             # output from 'script/context.pod:20':
298            
299             not ok 1
300             # Failed test at 'script/context.pod' line 21.
301             # got: 'CC'
302             # expected: 'gcc'
303            
304             # No POD output will be generated.
305             # Failed tests: 1.
306             1..1
307             # Looks like you failed 1 test of 1.
308              
309             Note that any test fails and the output file already exists, pod_tested will rename the existing file
310             so there is little risk for using an invalid file.
311              
312             =head2 Resetting your context
313              
314             =head1 HEADER
315            
316             =head2 Example 1
317            
318             my $cc_value = 'CC' ;
319            
320            
321            
322             =begin hidden
323            
324             is($cc_value, 'CC') ;
325            
326             =end hidden
327            
328             =head2 Example 2
329            
330             my $cc_value = 'ABC' ;
331            
332            
333            
334             =begin hidden
335            
336             is($cc_value, 'ABC') ;
337            
338             =end hidden
339            
340             =cut
341              
342             Running the above pod gives the following output:
343              
344             # output from 'script/new_context_error.pod:7':
345            
346            
347             # output from 'script/new_context_error.pod:16':
348            
349             ok 1 - expected value
350            
351             "my" variable $cc_value masks earlier declaration in same scope at 'script/new_context_error.pod' line 24, <$in_fh> line 27.
352             # output from 'script/new_context_error.pod:24':
353            
354            
355             # output from 'script/new_context_error.pod:32':
356            
357             ok 2 - expected value
358            
359             # Generating POD in 'new_context_error.tested.pod'.
360             1..2
361              
362             Local variables are kept between test sections. What we want is two separate section. This can be achieved with
363             B<=for POD::Tested reset>
364              
365             =head1 HEADER
366            
367             = head2 Example 1
368            
369             my $cc_value = 'CC' ;
370            
371            
372            
373             =begin hidden
374            
375             is($cc_value, 'CC') ;
376            
377             =end hidden
378            
379             =head2 Example 2
380            
381             =for POD::Tested reset
382            
383             my $cc_value = 'ABC' ;
384            
385            
386            
387             =begin hidden
388            
389             is($cc_value, 'ABC') ;
390            
391             =end hidden
392            
393             =cut
394              
395             Gives:
396              
397             # output from 'script/new_context.pod:7':
398            
399            
400             # output from 'script/new_context.pod:15':
401            
402             ok 1 - expected value
403            
404             # output from 'script/new_context.pod:25':
405            
406            
407             # output from 'script/new_context.pod:33':
408            
409             ok 2 - expected value
410            
411             # Generating POD in 'new_contex.tested.pod'.
412             1..2
413              
414             and this POD:
415              
416             =head1 HEADER
417            
418             = head2 Example 1
419            
420             my $cc_value = 'CC' ;
421            
422            
423            
424             =head2 Example 2
425            
426             my $cc_value = 'ABC' ;
427            
428            
429            
430             =cut
431              
432             =head2 Generating POD
433              
434             So far we have code in pod that we can test and the code itself is kept as part of the generated POD. Let's add the
435             result of some code execution to the POD. We'll use B to achieve that.
436              
437             =head1 Config::Hierarchical cookbook
438            
439             =head2 Simple usage
440            
441             use Config::Hierarchical ;
442            
443             my $config = new Config::Hierarchical();
444             $config->Set(NAME => 'CC', VALUE => 'acc') ;
445            
446             my $cc_value = $config->Get(NAME => 'CC') ;
447             print "CC = '$cc_value'\n" ;
448            
449             Result:
450            
451             =begin hidden
452            
453             my $expected_output = 'acc' ;
454             is($cc_value, $expected_output) ;
455            
456             generate_pod(" CC = '$expected_output'\n\n") ;
457             generate_pod($config->GetHistoryDump(NAME => 'CC')) ;
458            
459             =end hidden
460            
461             =cut
462              
463             running this gives this output:
464              
465             # output from 'script/generate_pod.pod:10':
466            
467             CC = 'acc'
468            
469             # output from 'script/generate_pod.pod:24':
470            
471             ok 1 - expected value
472            
473             # Generating POD in 'generate_pod.tested.pod.pod'.
474             1..1
475              
476             and the generated POD looks like:
477              
478             =head1 Config::Hierarchical cookbook
479            
480             =head2 Simple usage
481            
482             use Config::Hierarchical ;
483            
484             my $config = new Config::Hierarchical();
485             $config->Set(NAME => 'CC', VALUE => 'acc') ;
486            
487             my $cc_value = $config->Get(NAME => 'CC') ;
488             print "CC = '$cc_value'\n" ;
489            
490             Result:
491            
492             CC = 'acc'
493            
494             History for variable 'CC' from config 'Anonymous' created at ''script/generate_pod.pod':13':
495             `- 0
496             |- EVENT = CREATE AND SET. value = 'acc', category = 'CURRENT' at ''script/generate_pod.pod':14', status = OK.
497             `- TIME = 0
498            
499             =cut
500              
501             you don't need to copy/paste output from your modules into your POD as you can generate it directly.
502              
503             =head2 Using more test modules than the default ones
504              
505             simply use the modules you need in a B<=begin hidden> section.
506              
507             =begin hidden
508            
509             use Test::Some::Great::Module ;
510            
511             =end hidden
512              
513             =head1 SUBROUTINES/METHODS
514              
515             =cut
516              
517             #-------------------------------------------------------------------------------------------------------------------------------
518              
519             my $global_current_active_parser ;
520              
521             #-------------------------------------------------------------------------------------------------------------------------------
522              
523             sub new
524             {
525            
526             =head2 new
527              
528             =head3 Options
529              
530             You must, in the new sub, pass what your POD source is with one of the following options:
531              
532             =over 4
533              
534             =item * FILE_HANDLE
535              
536              
537             =item * FILE
538              
539              
540             =item * STRING
541              
542              
543             =back
544              
545              
546             Other options:
547              
548             =over 2
549              
550             =item * VERBOSE
551              
552             Set to true to display extra information when parsing and testing POD.
553              
554             =item * VERBOSE_POD_GENERATION
555              
556             Set to true to display the POD added through B.
557              
558             =item * NOT_TESTED
559              
560             The tag that is used to declare a section that are not common to the POD and the tests.
561              
562             default value is:
563              
564             qr/\s*not_tested/xmi
565              
566             =item * HIDDEN_TAG
567              
568             The tag that is used to declare a test section.
569              
570             default value is:
571              
572             qr/\s*hidden/xmi
573              
574             =item * RESET_TAG
575              
576             The tag that is used to reset the lexical context. Type is a B.
577              
578             default value is:
579              
580             qr/\s*POD::Tested\s+reset/xmi
581              
582             =item * DEFAULT_TEST_MODULES
583              
584             the test modules loaded when B starts.
585              
586             default value is:
587              
588             use Test::More ;
589             use Test::Block qw($Plan);
590             use Test::Exception ;
591             use Test::Warn ;
592            
593             plan qw(no_plan) unless(defined Test::More->builder->has_plan());
594              
595             if you use Test::More, which you should, the last line is necessary only when B is installed or
596             tested.
597              
598             =back
599              
600             =cut
601              
602 2     2 1 1361 my ($class, @setup_data) = @_ ;
603              
604 2 100       31 confess 'Invalid constructor call!' if @setup_data % 2 ;
605              
606 1         12 my $object =
607             {
608             BLOCK_START => 0,
609             VERBOSE => 0,
610             VERBOSE_POD_GENERATION => 0,
611             STATE => $EMPTY_STRING,
612             CODE => $EMPTY_STRING,
613             POD => $EMPTY_STRING,
614             LP => Lexical::Persistence->new(),
615            
616             NOT_TESTED_TAG => qr/\s*not_tested/sxmi,
617             HIDDEN_TAG => qr/\s*hidden/sxmi,
618             RESET_TAG => qr/\s*POD::Tested\s+reset/sxmi,
619            
620             DEFAULT_TEST_MODULES => <<'EOM',
621             use Test::More ;
622             use Test::Block qw($Plan);
623             use Test::Exception ;
624             use Test::Warn ;
625              
626             plan qw(no_plan) unless(defined Test::More->builder->has_plan());
627              
628             EOM
629              
630             @setup_data,
631             } ;
632              
633 1         68 $global_current_active_parser = $object ;
634              
635 1         7 my($code_as_text, $code)
636             = GetWrappedCode
637             (
638             $object->{LP},
639             $object->{DEFAULT_TEST_MODULES},
640             $EMPTY_STRING,
641             $EMPTY_STRING,
642             'POD::Test::new',
643             0
644             ) ;
645            
646 1         3 eval { $code->() } ;
  1         4  
647              
648 1         71 my ($package, $file_name, $line) = caller() ;
649 1         23 bless $object, $class ;
650              
651 1         95 $object->initialize() ;
652              
653 1 50       17 if(defined $object->{FILE_HANDLE})
    50          
    50          
654             {
655 0         0 $object->parse_from_filehandle($object->{FILE_HANDLE}) ;
656             }
657             elsif(defined $object->{FILE})
658             {
659 0         0 $object->parse_from_file($object->{FILE}) ;
660             }
661             elsif(defined $object->{STRING})
662             {
663 1         9 $object->parse_from_filehandle( IO::String->new($object->{STRING})) ;
664             }
665             else
666             {
667 0         0 croak "Expecting input data through argument 'STRING', 'FILE' or 'FILE_HANDLE'!\n" ;
668             }
669              
670 1         207 $object->RunTestCode() ;
671              
672 1         17 return($object) ;
673             }
674              
675             #-------------------------------------------------------------------------------------------------------------------------------
676              
677             sub command
678             {
679            
680             =head2 command
681              
682             Handles POD commands. See Pod::Parser for more information.
683              
684             =cut
685              
686 0     0 1 0 my ($parser, $command, $paragraph, $line_num, $pod_para) = @_ ;
687              
688 0         0 chomp($paragraph) ;
689 0         0 chomp($paragraph) ;
690             #~ print "<$command> <$paragraph><$line_num>" ;
691              
692 0         0 for($command)
693             {
694             $_ eq 'for' and do
695 0 0       0 {
696 0 0       0 if($paragraph =~ $parser->{RESET_TAG})
697             {
698 0         0 $parser->{LP}= Lexical::Persistence->new() ;
699             }
700             else
701             {
702 0         0 $parser->{POD} .= "=$command $paragraph\n\n" ;
703             }
704            
705 0         0 last ;
706             } ;
707            
708             $_ eq 'begin' && do
709 0 0       0 {
710 0         0 $parser->{STATE} = $paragraph ;
711 0         0 $parser->{BLOCK_START} = 0 ;
712            
713 0 0       0 if($paragraph =~ $parser->{HIDDEN_TAG})
714             {
715             }
716             else
717             {
718 0         0 $parser->{POD} .= "=$command $paragraph\n\n" ;
719             }
720            
721 0         0 last ;
722             } ;
723            
724             $_ eq 'end' && do
725 0 0       0 {
726 0 0       0 if($paragraph =~ $parser->{HIDDEN_TAG})
727             {
728 0         0 $parser->RunTestCode() ;
729             }
730             else
731             {
732 0         0 $parser->{POD} .= "=$command $paragraph\n\n" ;
733             }
734            
735 0         0 $parser->{BLOCK_START} = 0 ;
736 0         0 $parser->{STATE} = $EMPTY_STRING;
737            
738 0         0 last ;
739             } ;
740            
741 0         0 $parser->{POD} .= "=$command $paragraph\n\n" ;
742             }
743            
744 0         0 return(1) ;
745             }
746              
747             #-------------------------------------------------------------------------------------------------------------------------------
748              
749             sub RunTestCode
750             {
751              
752             =head2 RunTestCode
753              
754             Not to be used directly.
755              
756             =cut
757              
758 1     1 1 3 my ($parser) = @_ ;
759              
760 1 50       7 return(0) if $parser->{CODE} eq $EMPTY_STRING ;
761              
762 0         0 my $input= $parser->input_file() ;
763 0 0       0 $input = $global_current_active_parser->{INPUT} if defined $global_current_active_parser->{INPUT} ;
764              
765 0         0 my $line = $parser->{BLOCK_START} ;
766 0 0       0 $line= $global_current_active_parser->{LINE} if defined $global_current_active_parser->{LINE} ;
767              
768 0         0 EvalInContext
769             (
770             $parser->{LP},
771             $parser->{CODE},
772             $parser->{VERBOSE},
773             $input ,
774             $line,
775             ) ;
776              
777 0         0 $parser->{CODE} = $EMPTY_STRING ;
778              
779 0         0 return(1) ;
780             }
781              
782             #-------------------------------------------------------------------------------------------------------------------------------
783              
784             sub verbatim
785             {
786            
787             =head2 verbatim
788              
789             Handles POD verbatim sections. See Pod::Parser for more information.
790              
791             =cut
792              
793 0     0 1 0 my ($parser, $paragraph, $line_num, $pod_para) = @_;
794              
795 0 0       0 $parser->{BLOCK_START} = $line_num if $parser->{BLOCK_START} == 0;
796              
797             #~ print "verbatim $parser->{STATE} >>$paragraph<<\n" ;
798              
799 0 0       0 if($parser->{STATE} =~ $parser->{HIDDEN_TAG})
    0          
800             {
801 0         0 $parser->{CODE} .= $paragraph ;
802             }
803             elsif($parser->{STATE} eq $EMPTY_STRING)
804             {
805 0         0 $parser->{CODE} .= $paragraph ;
806 0         0 $parser->{POD} .= $paragraph ;
807            
808 0         0 $parser->{BLOCK_START} = 0 ;
809             }
810             else
811             {
812 0         0 $parser->{POD} .= $paragraph ;
813             }
814              
815 0         0 return(1) ;
816             }
817              
818             #-------------------------------------------------------------------------------------------------------------------------------
819              
820             sub textblock
821             {
822            
823             =head2 textblock
824              
825             Handles POD textblocks. See Pod::Parser for more information.
826              
827             =cut
828              
829 0     0 1 0 my ($parser, $paragraph, $line_num, $pod_para) = @_;
830              
831             #~ print "textblock $parser->{STATE} >>$paragraph<<\n" ;
832              
833 0         0 $parser->RunTestCode() ;
834              
835 0 0       0 $parser->{BLOCK_START} = $line_num if $parser->{BLOCK_START} == 0;
836              
837 0 0       0 if($parser->{STATE} =~ $parser->{HIDDEN_TAG})
838             {
839 0         0 $parser->{CODE} .= $paragraph ;
840             }
841             else
842             {
843 0         0 $parser->{POD} .= $paragraph ;
844             }
845              
846 0         0 return(1) ;
847             }
848              
849             #-------------------------------------------------------------------------------------------------------------------------------
850              
851             sub generate_pod
852             {
853            
854             =head2 generate_pod
855              
856             =cut
857              
858 0     0 1 0 my (@pod_snippets) = @_ ;
859              
860 0         0 my ($pod) = join ($EMPTY_STRING, @pod_snippets) ;
861              
862 0 0       0 if($global_current_active_parser->{VERBOSE_POD_GENERATION})
863             {
864 0         0 my ($package, $file_name, $line) = caller() ;
865            
866 0         0 my $input = '(unknown)';
867 0 0       0 $input = $global_current_active_parser->{FILE} if defined $global_current_active_parser->{FILE} ;
868 0 0       0 $line= $global_current_active_parser->{LINE} if defined $global_current_active_parser->{LINE} ;
869            
870 0         0 OutputStrings("# Generating POD at '$input' line $line:\n$pod") ;
871             }
872              
873 0         0 $global_current_active_parser->{POD} .= $pod ;
874              
875 0         0 return(1) ;
876             }
877              
878             #-------------------------------------------------------------------------------------------------------------------------------
879              
880             sub GetPOD
881             {
882            
883             =head2 GetPOD
884              
885             Returns the result of parsing and testing your POD. You can pass the result to L or other pod
886             transformers.
887              
888             =cut
889              
890 0     0 1 0 my ($parser) = @_;
891              
892 0         0 Readonly my $PADDING_SIZE => 2 ;
893              
894 0         0 my $pod_end = substr($parser->{POD}, -2, 2) ;
895              
896 0         0 my $amount_of_nl = $pod_end =~ tr[\n][\n] ;
897 0         0 my $padding_nl = "\n" x ($PADDING_SIZE - $amount_of_nl) ;
898              
899 0         0 return($parser->{POD} . $padding_nl . "=cut\n") ;
900             }
901              
902             #-------------------------------------------------------------------------------------------------------------------------------
903              
904             sub EvalInContext
905             {
906            
907             =head2 EvalInContext
908              
909             Not to be used directly.
910              
911             =cut
912              
913 0     0 1 0 my ($lp, $original_code, $verbose, $file, $line) = @_ ;
914              
915 0         0 OutputStrings("# output from '$file:$line':\n\n") ;
916              
917 0 0       0 if($verbose)
918             {
919 0         0 OutputStrings(<<"EOC") ;
920             running code from '$file:$line':
921              
922             $original_code
923              
924             EOC
925             }
926            
927 0         0 my($code_as_text, $code) = GetWrappedCode($lp, $EMPTY_STRING, $original_code, $EMPTY_STRING, $file, $line) ;
928              
929 0         0 eval { $code->() } ;
  0         0  
930 0 0       0 if($EVAL_ERROR)
931             {
932 0         0 croak $EVAL_ERROR ;
933             }
934            
935 0         0 OutputStrings("\n") ;
936              
937 0         0 return(1) ;
938             }
939              
940             #-------------------------------------------------------------------------------------------------------------------------------
941              
942             sub GetWrappedCode
943             { ## no critic (Subroutines::ProhibitManyArgs)
944            
945             =head2 GetWrappedCode
946              
947             Not to be used directly.
948              
949             =cut
950              
951 1     1 1 4 my ($lp, $code_header, $code, $code_footer, $file, $line) = @_ ;
952              
953 1         10 my $lexical_variables = join($EMPTY_STRING, map { "my $_;\n" } keys %{$lp->get_context('_')}) ;
  0         0  
  1         6  
954              
955 1         17 my $subified = <<"EOC" ;
956             #line 0 'GetWrappedCode'
957             sub
958             {
959             $lexical_variables
960              
961             $code_header
962              
963             #line $line '$file'
964             $code
965              
966             $code_footer
967             } ;
968             EOC
969              
970 1         260 my $compiled = eval $subified ; ## no critic (eval)
971 1 50       8530 croak $EVAL_ERROR if $EVAL_ERROR ;
972              
973 1         8 my $wrapped_code = $lp->wrap($compiled) ;
974              
975 1         14 return($subified, $wrapped_code) ;
976             }
977              
978             #-------------------------------------------------------------------------------------------------------------------------------
979              
980             sub OutputStrings
981             {
982              
983             =head2 OutputStrings
984              
985             Not to be used directly.
986              
987             =cut
988              
989 0     0 1   my (@strings) = @_ ;
990              
991 0 0         print(@strings) or croak $ERRNO ;
992              
993 0           return ;
994             }
995              
996             #-------------------------------------------------------------------------------------------------------------------------------
997              
998             1 ;
999              
1000             =head1 BUGS AND LIMITATIONS
1001              
1002             None so far.
1003              
1004             =head1 AUTHOR
1005              
1006             Khemir Nadim ibn Hamouda
1007             CPAN ID: NKH
1008             mailto:nadim@khemir.net
1009              
1010             =head1 LICENSE AND COPYRIGHT
1011              
1012             This program is free software; you can redistribute
1013             it and/or modify it under the same terms as Perl itself.
1014              
1015             =head1 SUPPORT
1016              
1017             You can find documentation for this module with the perldoc command.
1018              
1019             perldoc POD::Tested
1020              
1021             You can also look for information at:
1022              
1023             =over 4
1024              
1025             =item * AnnoCPAN: Annotated CPAN documentation
1026              
1027             L
1028              
1029             =item * RT: CPAN's request tracker
1030              
1031             Please report any bugs or feature requests to L .
1032              
1033             We will be notified, and then you'll automatically be notified of progress on
1034             your bug as we make changes.
1035              
1036             =item * Search CPAN
1037              
1038             L
1039              
1040             =back
1041              
1042             =head1 SEE ALSO
1043              
1044             L
1045              
1046             L
1047              
1048             L
1049              
1050             L
1051              
1052             =cut