Commit | Line | Data |
---|---|---|
8d07cc75 | 1 | #!/usr/bin/perl |
f46dd377 | 2 | use strict; |
8d07cc75 MG |
3 | use warnings; |
4 | use lib 't'; | |
5 | ||
6 | use File::Temp qw/tempfile/; | |
7 | use Test::More tests => 19; | |
8 | ||
9 | our ($section_1, $section_2, $section_3, $section_4, %options); | |
10 | ||
11 | sub handle_item { | |
12 | my ($options, $description) = m/^(.*?)\n\n(.*)/s; | |
13 | my (@options, $longest); | |
14 | $longest = ""; | |
15 | for my $option ($options =~ m/\G((?:-\w|--\w+))(?:,\s*)?/g) { | |
16 | push @options, $option; | |
17 | $longest = $option if length $option > length $longest | |
18 | } | |
19 | $longest =~ s/^-*//; | |
20 | $options{$longest} = { | |
21 | options => \@options, | |
22 | description => $description, | |
23 | }; | |
24 | } | |
25 | ||
26 | sub run_parser { | |
27 | Pod::Constants->import( | |
28 | section_1 => \$section_1, | |
29 | -trim => 1, | |
30 | section_2 => \$section_2, | |
31 | section_3 => sub { tr/[a-z]/[A-Z]/; $section_3 = $_ }, | |
32 | section_4 => sub { eval }, | |
33 | 'command line parameters' => sub { | |
34 | Pod::Constants::add_hook('*item' => \&handle_item) | |
35 | }); | |
36 | } | |
37 | ||
38 | use_ok('Pod::Constants'); | |
39 | run_parser; | |
40 | ||
41 | ok $Pod::Constants::VERSION, "Pod::Constants sets its own VERSION"; | |
42 | ||
f46dd377 MG |
43 | # to avoid a warning |
44 | if ( 0 ) { $Cheese::foo = $ReEntrancyTest::wohoo = $Cheese::quux; } | |
8d07cc75 | 45 | eval 'use Cheese'; |
f46dd377 MG |
46 | |
47 | is($section_1, "Down with Pants!\n\n", "no trim from main"); | |
48 | is($section_2, "42", "with trim from main"); | |
49 | is($section_3, "CLANK_EST", "sub"); | |
50 | is($section_4, "touche", "eval"); | |
51 | is($Cheese::foo, "detcepxe", "From module"); | |
52 | is($ReEntrancyTest::wohoo, "Re-entrancy works!", "From module"); | |
53 | is($Cheese::quux, "Blah.", "From module(2)"); | |
54 | like(`$^X -c t/Cheese.pm 2>&1`, qr/syntax OK/, "perl -c module"); | |
55 | like(`$^X -c t/cheese.pl 2>&1`, qr/syntax OK/, "perl -c script"); | |
56 | ||
57 | # test the examples on the man page :) | |
58 | package Pod::Constants; | |
59 | Pod::Constants->import (SYNOPSIS => sub { | |
60 | $main::section_1 = join "\n", map { s/^ //; $_ } split /\n/, $_ | |
61 | }); | |
62 | ||
63 | package main; | |
f46dd377 | 64 | # why define your test results when you can read them in from POD? |
612aada2 | 65 | $section_1 =~ s/myhash\)/myhash, %myhash2)/; |
f46dd377 | 66 | $section_1 =~ s/myhash;/myhash, "%myhash\'s value after the above:" => sub { %myhash2 = eval };/; |
8d07cc75 MG |
67 | |
68 | my ($fh, $file) = tempfile 'pod-constants-testXXXX', TMPDIR => 1, UNLINK => 1; | |
69 | print $fh <<"EOF"; | |
70 | package TestManPage; | |
71 | $section_1; | |
72 | 1 | |
73 | EOF | |
74 | close $fh; | |
75 | ||
76 | $INC{'TestManPage.pm'} = $file; | |
77 | require $file; | |
78 | ||
79 | is $TestManPage::myvar, 'This string will be loaded into $myvar',"man page example 1"; | |
80 | is $TestManPage::VERSION, $Pod::Constants::VERSION, "man page example 2"; | |
81 | ok $TestManPage::VERSION, "man page example 2 cross-check"; | |
82 | is $TestManPage::myarray[2], 'For example, this is $myarray[2].', "man page example 3"; | |
83 | ||
f46dd377 MG |
84 | my $ok = 0; |
85 | while (my ($k, $v) = each %TestManPage::myhash) { | |
86 | if (exists $TestManPage::myhash2{$k}) { $ok ++ }; | |
87 | if ($v eq $TestManPage::myhash2{$k}) { $ok ++ }; | |
88 | } | |
8d07cc75 MG |
89 | |
90 | is $ok, 4, "man page example 4"; | |
91 | is scalar keys %TestManPage::myhash, 2, "man page example 4 cross-check"; | |
92 | is $TestManPage::html, '<p>This text will be in $html</p>', "man page example 5"; | |
93 | ||
f46dd377 MG |
94 | # supress warnings |
95 | $TestManPage::myvar = $TestManPage::html = undef; | |
96 | @TestManPage::myarray = (); | |
97 | ||
8d07cc75 | 98 | is $options{foo}->{options}->[0], "-f", "Pod::Constants::add_hook"; |
f46dd377 MG |
99 | |
100 | =head2 section_1 | |
101 | ||
102 | Down with Pants! | |
103 | ||
104 | =head2 section_2 | |
105 | ||
106 | 42 | |
107 | ||
108 | =head2 section_3 | |
109 | ||
110 | clank_est | |
111 | ||
112 | =head2 section_4 | |
113 | ||
114 | $section_4 = "touche" | |
115 | ||
116 | =cut | |
117 | ||
118 | =head1 command line parameters | |
119 | ||
120 | the following command line parameters are supported | |
121 | ||
122 | =item -f, --foo | |
123 | ||
124 | This does something cool. | |
125 | ||
126 | =item -h, --help | |
127 | ||
128 | This also does something pretty cool. | |
129 | ||
130 | =cut |