Codebase list libtext-mediawikiformat-perl / 17aba66
[svn-inject] Installing original source of libtext-mediawikiformat-perl Stefan Hornburg 14 years ago
28 changed file(s) with 3809 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+124
-0
ARTISTIC less more
0 The "Artistic License"
1
2 Preamble
3
4 The intent of this document is to state the conditions under which a
5 Package may be copied, such that the Copyright Holder maintains some
6 semblance of artistic control over the development of the package,
7 while giving the users of the package the right to use and distribute
8 the Package in a more-or-less customary fashion, plus the right to
9 make reasonable modifications.
10
11 Definitions
12
13 "Package" refers to the collection of files distributed by the
14 Copyright Holder, and derivatives of that collection of files
15 created through textual modification.
16
17 "Standard Version" refers to such a Package if it has not been
18 modified, or has been modified in accordance with the wishes of the
19 Copyright Holder as specified below.
20
21 "Copyright Holder" is whoever is named in the copyright or
22 copyrights for the package.
23
24 "You" is you, if you're thinking about copying or distributing this
25 Package.
26
27 "Reasonable copying fee" is whatever you can justify on the basis
28 of media cost, duplication charges, time of people involved, and so
29 on. (You will not be required to justify it to the Copyright
30 Holder, but only to the computing community at large as a market
31 that must bear the fee.)
32
33 "Freely Available" means that no fee is charged for the item
34 itself, though there may be fees involved in handling the item. It
35 also means that recipients of the item may redistribute it under
36 the same conditions they received it.
37
38 1. You may make and give away verbatim copies of the source form of
39 the Standard Version of this Package without restriction, provided
40 that you duplicate all of the original copyright notices and
41 associated disclaimers.
42 2. You may apply bug fixes, portability fixes and other modifications
43 derived from the Public Domain or from the Copyright Holder. A
44 Package modified in such a way shall still be considered the
45 Standard Version.
46 3. You may otherwise modify your copy of this Package in any way,
47 provided that you insert a prominent notice in each changed file
48 stating how and when you changed that file, and provided that you
49 do at least ONE of the following:
50
51 a. place your modifications in the Public Domain or otherwise make
52 them Freely Available, such as by posting said modifications to
53 Usenet or an equivalent medium, or placing the modifications on a
54 major archive site such as uunet.uu.net, or by allowing the
55 Copyright Holder to include your modifications in the Standard
56 Version of the Package.
57 b. use the modified Package only within your corporation or
58 organization.
59 c. rename any non-standard executables so the names do not conflict
60 with standard executables, which must also be provided, and
61 provide a separate manual page for each non-standard executable
62 that clearly documents how it differs from the Standard Version.
63 d. make other distribution arrangements with the Copyright Holder.
64
65 You may distribute the programs of this Package in object code or
66 executable form, provided that you do at least ONE of the following:
67
68 a. distribute a Standard Version of the executables and library
69 files, together with instructions (in the manual page or
70 equivalent) on where to get the Standard Version.
71 b. accompany the distribution with the machine-readable source of the
72 Package with your modifications.
73 c. give non-standard executables non-standard names, and clearly
74 document the differences in manual pages (or equivalent), together
75 with instructions on where to get the Standard Version.
76 d. make other distribution arrangements with the Copyright Holder.
77
78 You may charge a reasonable copying fee for any distribution of this
79 Package. You may charge any fee you choose for support of this
80 Package. You may not charge a fee for this Package itself. However,
81 you may distribute this Package in aggregate with other (possibly
82 commercial) programs as part of a larger (possibly commercial)
83 software distribution provided that you do not advertise this Package
84 as a product of your own. You may embed this Package's interpreter
85 within an executable of yours (by linking); this shall be construed as
86 a mere form of aggregation, provided that the complete Standard
87 Version of the interpreter is so embedded.
88
89 The scripts and library files supplied as input to or produced as
90 output from the programs of this Package do not automatically fall
91 under the copyright of this Package, but belong to whomever generated
92 them, and may be sold commercially, and may be aggregated with this
93 Package. If such scripts or library files are aggregated with this
94 Package via the so-called "undump" or "unexec" methods of producing a
95 binary executable image, then distribution of such an image shall
96 neither be construed as a distribution of this Package nor shall it
97 fall under the restrictions of Paragraphs 3 and 4, provided that you
98 do not represent such an executable image as a Standard Version of
99 this Package.
100
101 C subroutines (or comparably compiled subroutines in other
102 languages) supplied by you and linked into this Package in order to
103 emulate subroutines and variables of the language defined by this
104 Package shall not be considered part of this Package, but are the
105 equivalent of input as in Paragraph 6, provided these subroutines do
106 not change the language in any way that would cause it to fail the
107 regression tests for the language.
108
109 Aggregation of this Package with a commercial distribution is always
110 permitted provided that the use of this Package is embedded; that is,
111 when no overt attempt is made to make this Package's interfaces
112 visible to the end user of the commercial distribution. Such use shall
113 not be construed as a distribution of this Package.
114
115 The name of the Copyright Holder may not be used to endorse or
116 promote products derived from this software without specific prior
117 written permission.
118
119 THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
120 WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
121 MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
122
123 The End
+58
-0
Build.PL less more
0 #! perl
1
2 use Module::Build;
3
4 my $class = Module::Build->subclass(
5 class => 'Module::Build::FilterTests',
6 code => <<'END_HERE',
7
8 use File::Glob;
9 use File::Spec::Functions;
10
11 sub ACTION_disttest
12 {
13 my $self = shift;
14 local $ENV{PERL_RUN_ALL_TESTS} = 1;
15 $self->SUPER::ACTION_disttest (@_);
16 }
17
18 sub find_test_files
19 {
20 my $self = shift;
21 my $tests = $self->SUPER::find_test_files (@_);
22
23 return $tests unless $ENV{PERL_RUN_ALL_TESTS};
24
25 my $test_pattern = catfile (qw(t developer *.t));
26 push @$tests, File::Glob::bsd_glob( $test_pattern );
27 return $tests;
28 }
29 END_HERE
30 );
31
32 my $build = $class->new(
33 license => 'perl',
34 module_name => 'Text::MediawikiFormat',
35 requires =>
36 {
37 'Scalar::Util' => '1.14',
38 'URI' => '',
39 'URI::Escape' => '',
40 'version' => '0.74',
41 },
42 recommends =>
43 {
44 'HTML::Parser' => '',
45 'HTML::Tagset' => '',
46 },
47 build_requires =>
48 {
49 'Test::More' => 0.30,
50 'Test::NoWarnings' => 0,
51 'Test::Warn' => 0,
52 },
53 create_makefile_pl => 'traditional',
54 sign => '1',
55 );
56
57 $build->create_build_script();
+203
-0
Changes less more
0 Revision history for Text-MediawikiFormat
1
2 1.0 June 19, 2008
3 - Empty tags are handled like they should be. This should make it
4 easier to implement <references /> & <ref name="previous" /> (fixes
5 rt.cpan.org #25386).
6 - Disable HTML inside <pre> tags, as with <nowiki> tags (fixes
7 rt.cpan.org #25417)
8 - Angle backets (<>) around URIs are ignored as per Mediawiki 1.12's
9 observed behavior.
10 - Use "vars" pragma instead of "our" for Perl 5.005.
11 - Check for undefined values in the extended_link_delimiters field and
12 warn but ignore when found (fixes rt.cpan.org #26879).
13 - Use uri_escape_utf8 unless charset is set to something other than
14 utf-8 in the options hash (fixes rt.cpan.org #26880).
15 - Documentation fixes.
16
17 0.06 June 17, 2008
18 - Tests skip HTML processing when HTML::Parser and HTML::Tagset are
19 not installed.
20 - format() actually processes the options hash.
21 - Change _clone to Return arrays and a deep copy of hashes.
22 Rather than a copy of arrays.
23
24 0.05 September 28, 2006
25 - Remove the <> when linkifying <http://absolute.link>.
26
27 0.04 September 27, 2006
28 - Process absolute links more robustly.
29
30 0.03 September 27, 2006
31 - Default to absolute_links => 1.
32 - Prefer "our" to "use vars".
33
34 0.02 September 26, 2006
35 - Improved documentation.
36 - Defaults to Mediawiki behaviors.
37
38 0.01 September 20, 2006
39 - Avoid applying wikification when block level allowed html elements
40 are present, when process_html option is set.
41 - content of list items is now formatted by default.
42 - (non)formatting of blocks is now configurable.
43 - additional tests added, re RT 4700.
44 - the $tags{link} func is now passed the tags hash, re RT 21393.
45 - extended_link_delimiters may now be specified as a regex, re RT 21330.
46 - merge_hash() now copies hashes.
47 - several nesting bugs fixed, re RT 21269.
48 - code refs now preserve indenting after the " ", not before.
49
50
51
52 ###
53 ### as Text::WikiFormat
54 ###
55
56 0.78
57 Thu Mar 30 06:13:42 UTC 2006
58 - fixed merge_blocks() bug reported by Richard Harman
59 - moved developer tests to t/developer and skipped them for everyone else
60 - updated copyright notices
61
62 0.77
63 Sat Oct 29 02:54:02 UTC 2005 (Rev: 9337, Author: chromatic)
64 - removed MANIFEST.SKIP (hopefully fixing Test::Signature errors)
65
66 0.76
67 Mon Jul 25 05:58:24 UTC 2005 (Rev: 6518, Author: chromatic)
68 - bumped up version number
69 - added documentation to Text::WikiFormat::Blocks
70 - checked in t/pod.t
71
72 Thu Jul 14 06:45:57 UTC 2005 (Rev: 6309, Author: chromatic)
73 - fixed CAMELCASE linking bug reported by punkish on Perl Monks
74 - fixed inadvertent $title reuse in find_link_title()
75
76 Wed Jul 13 03:16:14 UTC 2005 (Rev: 6249, Author: chromatic)
77 - fixed a bug in list detection (find paragraphs correctly)
78 - removed unnecessary .t files in top-level directory (not distributed)
79 - removed unused functions:
80 - get_block()
81 - get_indentation()
82 - find_list()
83 - end_list()
84 - end_all_lists()
85 - added POD and POD coverage tests
86 - added stub documentation to Text::WikiFormat::Blocks
87 - modified tests to work better with Devel::Cover
88
89 0.75
90 Sat Jul 2 19:48:00 UTC 2005 (Rev: 5727, Author: chromatic)
91 - support absolute_links (Alex Vandiver and Best Practical)
92 - edited documentation to use better English
93 - added tests for a few undertested functions (t/subs.t)
94 - signed distribution
95 - added passthrough Makefile
96 - bumped up copyright year
97
98 Sun Apr 17 05:10:19 UTC 2005 (Rev: 5727, Author: chromatic)
99 - added t/embedded-links.t from Art Henry
100 - allowed nested embedded links (MediaWiki support)
101
102 Sun Nov 28 23:58:18 UTC 2004 (Rev: 16, Author: chromatic)
103 - re-set properties on Changes
104 - bumped up version number (also stringify it)
105 - added Text::WikiFormat::Blocks to MANIFEST (oops)
106
107 Sun Nov 28 23:38:20 UTC 2004 (Rev: 15, chromatic)
108 - added more nesting tests (Teun van Eijsden)
109 - fix multiple levels of nesting (Teun van Eijsden)
110
111 Sun Nov 28 08:39:37 UTC 2004 (Rev: 14, chromatic)
112 - moved blocks into their own classes
113 - added Text::WikiFormat::Blocks
114 - fixed up failing tests from that fallout
115 - simplified lots of Text::WikiFormat internals
116
117 Sat Nov 27 16:44:38 UTC 2004
118 - mark build_requires in Build.PL
119 - use Scalar::Util::reftype() for checking ref
120 - added missing t/links.t test (don't know where it came from)
121
122 0.72 Sun May 9 00:20:26 UTC 2004
123 - further code block nested indentation fixes (reported by Chris Winters)
124
125 Sat May 8 06:44:54 UTC 2004
126 - improve code block handling (reported by Chris Winters)
127
128 Sat Apr 24 18:57:17 UTC 2004
129 - don't add prefix to absolute links when expecting them (Paul Schmidt and
130 Chris Winters)
131
132 0.71 Tue Aug 5 00:49:09 GMT 2003
133 - fixed a bug in default paragraph regex (Sam Vilain and Kake)
134
135 0.70 Thu Jul 31 04:56:51 GMT 2003
136 - apply slightly modified patch from Andy H. for absolute extended links
137
138 Wed Jul 30 01:23:01 GMT 2003
139 - process header block contents (Kake)
140 - fix an unintentional static variable bug in find_link_title()
141 - fix a hash order bug in base.t (found by Kake)
142
143 Tue Jul 29 04:11:05 GMT 2003
144 - fix Kake's last nesting problem
145 - allow overriding strong and emphasized tag regexes
146
147 Fri May 16 07:29:15 GMT 2003
148 - allow nested lists
149 - major cleanup (see first point)
150 - add indent tag
151 - remove indent from list regexes
152
153 0.60 Sat Mar 1 18:54:06 GMT 2003
154 - ported to use Module::Build
155
156 Wed Feb 19 22:25:56 GMT 2003
157 - added t/merge-hash.t (Kake)
158 - make sure nested hashes merge even if not in destination (Kake)
159 - protect against overwriting values of 0 (almost wrote a bug!)
160 - fix a doc typo (Kake)
161 - allow alternate extended link delimiters (Kake)
162 - addede explicit.t (Kake)
163 - added t/tag-override-use-as.t (Kake)
164
165 0.50 Thu Dec 26 23:07:07 GMT 2002
166 - added t/tag-override.t tests for tag overriding (Kake)
167 - minor refactorings to improve design
168 - use hash merging to fix HoH overriding (Kake, again)
169 - added t/lists-no-indent.t to test that non-indented lists work (kake)
170 - added patch from Kake to allow non-indented lists
171
172 0.45 Fri Oct 18 01:14:53 UTC 2002
173 - signed distribution with Module::Signature (thanks, Autrijus!)
174
175 Thu Sep 12 18:11:10 UTC 2002
176 - end lists followed by empty paragraphs (RT #1455b, <kake@earth.li>)
177 - add 'implicit_links' flag (suggestion from Kate (kake))
178 - fixed an import bug (also from kake, who provided tests!)
179 - encode links property (yet another kake idea!)
180
181 Sat Aug 24 23:35:44 UTC 2002
182 - don't end a list if no list is active (RT #1455, <deus_x@pobox.com>)
183
184 0.40 Tue Jun 11 05:23:44 UTC 2002
185 - added _available_lists(), 'linkorder', and t/lists.t
186 - made format() respect 'linkorder'
187 - made end_list() return blank code for empty list
188 (all suggested by Tom Hukins, see CPAN RT #671)
189
190 - avoid 'Subroutine redefined' warning with 5.8 in t/Wiki.t
191
192 0.30 Thu May 2 20:42:14 PDT 2002
193 - added import() and its tests, suggested by Tony Bowden <tony@kasei.com>
194
195 0.20 Lost in the Mists of Time
196 - initial CPAN release
197
198 0.10 Before Beer Was Invented
199 - distributed with SlashWiki
200
201 0.01 Pre-History
202 - part of the Jellybean project
+280
-0
GPL less more
0 GNU GENERAL PUBLIC LICENSE
1 Version 2, June 1991
2
3 Copyright (C) 1989, 1991 Free Software Foundation, Inc.
4 675 Mass Ave, Cambridge, MA 02139, USA
5 Everyone is permitted to copy and distribute verbatim copies
6 of this license document, but changing it is not allowed.
7
8 Preamble
9
10 The licenses for most software are designed to take away your
11 freedom to share and change it. By contrast, the GNU General Public
12 License is intended to guarantee your freedom to share and change free
13 software--to make sure the software is free for all its users. This
14 General Public License applies to most of the Free Software
15 Foundation's software and to any other program whose authors commit to
16 using it. (Some other Free Software Foundation software is covered by
17 the GNU Library General Public License instead.) You can apply it to
18 your programs, too.
19
20 When we speak of free software, we are referring to freedom, not
21 price. Our General Public Licenses are designed to make sure that you
22 have the freedom to distribute copies of free software (and charge for
23 this service if you wish), that you receive source code or can get it
24 if you want it, that you can change the software or use pieces of it
25 in new free programs; and that you know you can do these things.
26
27 To protect your rights, we need to make restrictions that forbid
28 anyone to deny you these rights or to ask you to surrender the rights.
29 These restrictions translate to certain responsibilities for you if you
30 distribute copies of the software, or if you modify it.
31
32 For example, if you distribute copies of such a program, whether
33 gratis or for a fee, you must give the recipients all the rights that
34 you have. You must make sure that they, too, receive or can get the
35 source code. And you must show them these terms so they know their
36 rights.
37
38 We protect your rights with two steps: (1) copyright the software, and
39 (2) offer you this license which gives you legal permission to copy,
40 distribute and/or modify the software.
41
42 Also, for each author's protection and ours, we want to make certain
43 that everyone understands that there is no warranty for this free
44 software. If the software is modified by someone else and passed on, we
45 want its recipients to know that what they have is not the original, so
46 that any problems introduced by others will not reflect on the original
47 authors' reputations.
48
49 Finally, any free program is threatened constantly by software
50 patents. We wish to avoid the danger that redistributors of a free
51 program will individually obtain patent licenses, in effect making the
52 program proprietary. To prevent this, we have made it clear that any
53 patent must be licensed for everyone's free use or not licensed at all.
54
55 The precise terms and conditions for copying, distribution and
56 modification follow.
57
58 GNU GENERAL PUBLIC LICENSE
59 TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
60
61 0. This License applies to any program or other work which contains
62 a notice placed by the copyright holder saying it may be distributed
63 under the terms of this General Public License. The "Program", below,
64 refers to any such program or work, and a "work based on the Program"
65 means either the Program or any derivative work under copyright law:
66 that is to say, a work containing the Program or a portion of it,
67 either verbatim or with modifications and/or translated into another
68 language. (Hereinafter, translation is included without limitation in
69 the term "modification".) Each licensee is addressed as "you".
70
71 Activities other than copying, distribution and modification are not
72 covered by this License; they are outside its scope. The act of
73 running the Program is not restricted, and the output from the Program
74 is covered only if its contents constitute a work based on the
75 Program (independent of having been made by running the Program).
76 Whether that is true depends on what the Program does.
77
78 1. You may copy and distribute verbatim copies of the Program's
79 source code as you receive it, in any medium, provided that you
80 conspicuously and appropriately publish on each copy an appropriate
81 copyright notice and disclaimer of warranty; keep intact all the
82 notices that refer to this License and to the absence of any warranty;
83 and give any other recipients of the Program a copy of this License
84 along with the Program.
85
86 You may charge a fee for the physical act of transferring a copy, and
87 you may at your option offer warranty protection in exchange for a fee.
88
89 2. You may modify your copy or copies of the Program or any portion
90 of it, thus forming a work based on the Program, and copy and
91 distribute such modifications or work under the terms of Section 1
92 above, provided that you also meet all of these conditions:
93
94 a) You must cause the modified files to carry prominent notices
95 stating that you changed the files and the date of any change.
96
97 b) You must cause any work that you distribute or publish, that in
98 whole or in part contains or is derived from the Program or any
99 part thereof, to be licensed as a whole at no charge to all third
100 parties under the terms of this License.
101
102 c) If the modified program normally reads commands interactively
103 when run, you must cause it, when started running for such
104 interactive use in the most ordinary way, to print or display an
105 announcement including an appropriate copyright notice and a
106 notice that there is no warranty (or else, saying that you provide
107 a warranty) and that users may redistribute the program under
108 these conditions, and telling the user how to view a copy of this
109 License. (Exception: if the Program itself is interactive but
110 does not normally print such an announcement, your work based on
111 the Program is not required to print an announcement.)
112
113 These requirements apply to the modified work as a whole. If
114 identifiable sections of that work are not derived from the Program,
115 and can be reasonably considered independent and separate works in
116 themselves, then this License, and its terms, do not apply to those
117 sections when you distribute them as separate works. But when you
118 distribute the same sections as part of a whole which is a work based
119 on the Program, the distribution of the whole must be on the terms of
120 this License, whose permissions for other licensees extend to the
121 entire whole, and thus to each and every part regardless of who wrote it.
122
123 Thus, it is not the intent of this section to claim rights or contest
124 your rights to work written entirely by you; rather, the intent is to
125 exercise the right to control the distribution of derivative or
126 collective works based on the Program.
127
128 In addition, mere aggregation of another work not based on the Program
129 with the Program (or with a work based on the Program) on a volume of
130 a storage or distribution medium does not bring the other work under
131 the scope of this License.
132
133 3. You may copy and distribute the Program (or a work based on it,
134 under Section 2) in object code or executable form under the terms of
135 Sections 1 and 2 above provided that you also do one of the following:
136
137 a) Accompany it with the complete corresponding machine-readable
138 source code, which must be distributed under the terms of Sections
139 1 and 2 above on a medium customarily used for software interchange; or,
140
141 b) Accompany it with a written offer, valid for at least three
142 years, to give any third party, for a charge no more than your
143 cost of physically performing source distribution, a complete
144 machine-readable copy of the corresponding source code, to be
145 distributed under the terms of Sections 1 and 2 above on a medium
146 customarily used for software interchange; or,
147
148 c) Accompany it with the information you received as to the offer
149 to distribute corresponding source code. (This alternative is
150 allowed only for noncommercial distribution and only if you
151 received the program in object code or executable form with such
152 an offer, in accord with Subsection b above.)
153
154 The source code for a work means the preferred form of the work for
155 making modifications to it. For an executable work, complete source
156 code means all the source code for all modules it contains, plus any
157 associated interface definition files, plus the scripts used to
158 control compilation and installation of the executable. However, as a
159 special exception, the source code distributed need not include
160 anything that is normally distributed (in either source or binary
161 form) with the major components (compiler, kernel, and so on) of the
162 operating system on which the executable runs, unless that component
163 itself accompanies the executable.
164
165 If distribution of executable or object code is made by offering
166 access to copy from a designated place, then offering equivalent
167 access to copy the source code from the same place counts as
168 distribution of the source code, even though third parties are not
169 compelled to copy the source along with the object code.
170
171 4. You may not copy, modify, sublicense, or distribute the Program
172 except as expressly provided under this License. Any attempt
173 otherwise to copy, modify, sublicense or distribute the Program is
174 void, and will automatically terminate your rights under this License.
175 However, parties who have received copies, or rights, from you under
176 this License will not have their licenses terminated so long as such
177 parties remain in full compliance.
178
179 5. You are not required to accept this License, since you have not
180 signed it. However, nothing else grants you permission to modify or
181 distribute the Program or its derivative works. These actions are
182 prohibited by law if you do not accept this License. Therefore, by
183 modifying or distributing the Program (or any work based on the
184 Program), you indicate your acceptance of this License to do so, and
185 all its terms and conditions for copying, distributing or modifying
186 the Program or works based on it.
187
188 6. Each time you redistribute the Program (or any work based on the
189 Program), the recipient automatically receives a license from the
190 original licensor to copy, distribute or modify the Program subject to
191 these terms and conditions. You may not impose any further
192 restrictions on the recipients' exercise of the rights granted herein.
193 You are not responsible for enforcing compliance by third parties to
194 this License.
195
196 7. If, as a consequence of a court judgment or allegation of patent
197 infringement or for any other reason (not limited to patent issues),
198 conditions are imposed on you (whether by court order, agreement or
199 otherwise) that contradict the conditions of this License, they do not
200 excuse you from the conditions of this License. If you cannot
201 distribute so as to satisfy simultaneously your obligations under this
202 License and any other pertinent obligations, then as a consequence you
203 may not distribute the Program at all. For example, if a patent
204 license would not permit royalty-free redistribution of the Program by
205 all those who receive copies directly or indirectly through you, then
206 the only way you could satisfy both it and this License would be to
207 refrain entirely from distribution of the Program.
208
209 If any portion of this section is held invalid or unenforceable under
210 any particular circumstance, the balance of the section is intended to
211 apply and the section as a whole is intended to apply in other
212 circumstances.
213
214 It is not the purpose of this section to induce you to infringe any
215 patents or other property right claims or to contest validity of any
216 such claims; this section has the sole purpose of protecting the
217 integrity of the free software distribution system, which is
218 implemented by public license practices. Many people have made
219 generous contributions to the wide range of software distributed
220 through that system in reliance on consistent application of that
221 system; it is up to the author/donor to decide if he or she is willing
222 to distribute software through any other system and a licensee cannot
223 impose that choice.
224
225 This section is intended to make thoroughly clear what is believed to
226 be a consequence of the rest of this License.
227
228 8. If the distribution and/or use of the Program is restricted in
229 certain countries either by patents or by copyrighted interfaces, the
230 original copyright holder who places the Program under this License
231 may add an explicit geographical distribution limitation excluding
232 those countries, so that distribution is permitted only in or among
233 countries not thus excluded. In such case, this License incorporates
234 the limitation as if written in the body of this License.
235
236 9. The Free Software Foundation may publish revised and/or new versions
237 of the General Public License from time to time. Such new versions will
238 be similar in spirit to the present version, but may differ in detail to
239 address new problems or concerns.
240
241 Each version is given a distinguishing version number. If the Program
242 specifies a version number of this License which applies to it and "any
243 later version", you have the option of following the terms and conditions
244 either of that version or of any later version published by the Free
245 Software Foundation. If the Program does not specify a version number of
246 this License, you may choose any version ever published by the Free Software
247 Foundation.
248
249 10. If you wish to incorporate parts of the Program into other free
250 programs whose distribution conditions are different, write to the author
251 to ask for permission. For software which is copyrighted by the Free
252 Software Foundation, write to the Free Software Foundation; we sometimes
253 make exceptions for this. Our decision will be guided by the two goals
254 of preserving the free status of all derivatives of our free software and
255 of promoting the sharing and reuse of software generally.
256
257 NO WARRANTY
258
259 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
260 FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
261 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
262 PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
263 OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
264 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
265 TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
266 PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
267 REPAIR OR CORRECTION.
268
269 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
270 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
271 REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
272 INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
273 OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
274 TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
275 YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
276 PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
277 POSSIBILITY OF SUCH DAMAGES.
278
279 END OF TERMS AND CONDITIONS
+29
-0
MANIFEST less more
0 ARTISTIC
1 Build.PL
2 Changes
3 GPL
4 MANIFEST
5 Makefile.PL
6 META.yml
7 README
8 lib/Text/MediawikiFormat.pm
9 lib/Text/MediawikiFormat/Blocks.pm
10 t/Wiki.t
11 t/absolute_links.t
12 t/base.t
13 t/bugs.t
14 t/developer/0-signature.t
15 t/developer/pod.t
16 t/developer/pod-coverage.t
17 t/embedded-links.t
18 t/explicit.t
19 t/implicit.t
20 t/kake.t
21 t/lists.t
22 t/lists-nested.t
23 t/lists-no-indent.t
24 t/merge-hash.t
25 t/tag-override-use-as.t
26 t/tag-override.t
27 SIGNATURE Added here by Module::Build
28 SIGNATURE Added here by Module::Build
+32
-0
META.yml less more
0 ---
1 name: Text-MediawikiFormat
2 version: v1.0
3 author: []
4 abstract: Translate Wiki markup into other text formats
5 license: perl
6 resources:
7 license: http://dev.perl.org/licenses/
8 requires:
9 Scalar::Util: 1.14
10 URI: ''
11 URI::Escape: ''
12 version: 0.74
13 build_requires:
14 Test::More: 0.3
15 Test::NoWarnings: 0
16 Test::Warn: 0
17 recommends:
18 HTML::Parser: ''
19 HTML::Tagset: ''
20 provides:
21 Text::MediawikiFormat:
22 file: lib/Text/MediawikiFormat.pm
23 version: v1.0
24 Text::MediawikiFormat::Block:
25 file: lib/Text/MediawikiFormat/Blocks.pm
26 Text::MediawikiFormat::Blocks:
27 file: lib/Text/MediawikiFormat/Blocks.pm
28 generated_by: Module::Build version 0.2808
29 meta-spec:
30 url: http://module-build.sourceforge.net/META-spec-v1.2.html
31 version: 1.2
+20
-0
Makefile.PL less more
0 # Note: this file was auto-generated by Module::Build::Compat version 0.03
1 use ExtUtils::MakeMaker;
2 WriteMakefile
3 (
4 'NAME' => 'Text::MediawikiFormat',
5 'VERSION_FROM' => 'lib/Text/MediawikiFormat.pm',
6 'PREREQ_PM' => {
7 'Scalar::Util' => '1.14',
8 'Test::More' => '0.3',
9 'Test::NoWarnings' => '0',
10 'Test::Warn' => '0',
11 'URI' => '',
12 'URI::Escape' => '',
13 'version' => '0.74'
14 },
15 'INSTALLDIRS' => 'site',
16 'EXE_FILES' => [],
17 'PL_FILES' => {}
18 )
19 ;
+7
-0
README less more
0 Text::WikiFormat converts text in a simple Wiki markup language to whatever
1 your little heart desires, provided you can describe it accurately in a
2 semi-regular tag language.
3
4 This program is Free Software, provided without warranty or implied
5 merchantability, but available under the same terms as Perl itself. What a
6 deal! It's copyrighted and copylefted 2002 - 2006, chromatic.
+50
-0
SIGNATURE less more
0 This file contains message digests of all files listed in MANIFEST,
1 signed via the Module::Signature module, version 0.55.
2
3 To verify the content in this distribution, first make sure you have
4 Module::Signature installed, then type:
5
6 % cpansign -v
7
8 It will check each file's integrity, as well as the signature's
9 validity. If "==> Signature verified OK! <==" is not displayed,
10 the distribution may already have been compromised, and you should
11 not run its Makefile.PL or Build.PL.
12
13 -----BEGIN PGP SIGNED MESSAGE-----
14 Hash: SHA1
15
16 SHA1 de99730c9cff5401331cc9b10da8fffc2607119e ARTISTIC
17 SHA1 22316eae2efc4afadca11b79369f9e173d6039b1 Build.PL
18 SHA1 205fdf6b110d7a4ab9935d5c0ad4bfcff2294e3a Changes
19 SHA1 2d29c273fda30310211bbf6a24127d589be09b6c GPL
20 SHA1 eccb0808083e42742ab218aade252010ec49a567 MANIFEST
21 SHA1 32787552984162e780b38633dd67f4809fb5e992 META.yml
22 SHA1 c37ec8e62f2d6b0fffe4b4a73c2bdf3c3f2def3b Makefile.PL
23 SHA1 32770eb383f51fec27a092d2c39f0b1c302df6e6 README
24 SHA1 ac1b2db56ba408051f88f7515b5d041400547b0f lib/Text/MediawikiFormat.pm
25 SHA1 fd66bd52dab924fbdf8185b56b4b0f835cba8b44 lib/Text/MediawikiFormat/Blocks.pm
26 SHA1 645310aa31699333b7d7bfaa9da48e7a8fdbb8f7 t/Wiki.t
27 SHA1 b617b7515b2c9cc7a194693af3f002b7665c943d t/absolute_links.t
28 SHA1 d6b24c5b497740c653882d6f3a691b7e51ea8f02 t/base.t
29 SHA1 d7db75f52a1631a3f78ceb00ece490f1f0d6c6b1 t/bugs.t
30 SHA1 e7fbd29bd994639e82a480ca7668208c84faf780 t/developer/0-signature.t
31 SHA1 9f8e6742d15fc02f70fea8c7883e534b5ab0027e t/developer/pod-coverage.t
32 SHA1 0190346d7072d458c8a10a45c19f86db641dcc48 t/developer/pod.t
33 SHA1 c09a0d0ba5a0b9c152a1f93315b9c49fcfbd865c t/embedded-links.t
34 SHA1 8f75e7cd212a52a42eea81ed150fe5450c70e87a t/explicit.t
35 SHA1 bbc7124baf9098da6c2dcf89f2a3284683413b6a t/implicit.t
36 SHA1 6b7053b05703eb121a6b45452dca7372a5ae4d7b t/kake.t
37 SHA1 784b48b387dd561d52de82cd2b94af222c61d26d t/lists-nested.t
38 SHA1 dcacb77dfbcb5a2036f5aba0aa5aabf0a1082098 t/lists-no-indent.t
39 SHA1 29d22f52586b606688d50640d15266439d74eb93 t/lists.t
40 SHA1 e8317c38218cf0420d4cc4c2fb66cb50c3caed99 t/merge-hash.t
41 SHA1 1a5a502110014d7694d78dad6fdd8d182bd16eb9 t/tag-override-use-as.t
42 SHA1 e8161481a91f596eaa2bf6852cadb4ac0b9379df t/tag-override.t
43 -----BEGIN PGP SIGNATURE-----
44 Version: GnuPG v1.4.2.2 (GNU/Linux)
45
46 iD8DBQFIWr9dLD1OTBfyMaQRAhnjAJ91HRbRtBZOsbp7PCzqw+NYnxaRKwCffQAA
47 ujduk8fkZPX40g58mtBNZlY=
48 =gfGy
49 -----END PGP SIGNATURE-----
+247
-0
lib/Text/MediawikiFormat/Blocks.pm less more
0 package Text::MediawikiFormat::Blocks;
1
2 use strict;
3 use warnings::register;
4
5 sub import
6 {
7 my $caller = caller();
8 no strict 'refs';
9 *{ $caller . '::new_block' } = sub
10 {
11 my $type = shift;
12 my $class = "Text::MediawikiFormat::Block::$type";
13
14 *{ $class . '::ISA' } = [ 'Text::MediawikiFormat::Block' ]
15 unless $class->can( 'new' );
16
17 return $class->new( type => $type, @_ );
18 };
19 }
20
21 package Text::MediawikiFormat::Block;
22
23 use Scalar::Util qw( blessed reftype );
24
25 sub new
26 {
27 my ($class, %args) = @_;
28
29 $args{text} = $class->arg_to_ref (delete $args{text} || '');
30 $args{args} = [$class->arg_to_ref (delete $args{args} || [])];
31
32 bless \%args, $class;
33 }
34
35 sub arg_to_ref
36 {
37 my ($class, $value) = @_;
38 return $value if ( reftype( $value ) || '' ) eq 'ARRAY';
39 return [ $value ];
40 }
41
42 sub shift_args
43 {
44 my $self = shift;
45 my $args = shift @{ $self->{args} };
46 return wantarray ? @$args : $args;
47 }
48
49 sub all_args
50 {
51 my $args = $_[0]{args};
52 return wantarray ? @$args : $args;
53 }
54
55 sub text
56 {
57 my $text = $_[0]{text};
58 return wantarray ? @$text : $text;
59 }
60
61 sub add_text
62 {
63 my $self = shift;
64 push @{ $self->{text} }, @_;
65 }
66
67 sub formatted_text
68 {
69 my $self = shift;
70 return map
71 {
72 blessed( $_ ) ? $_ : $self->formatter( $_ )
73 } $self->text();
74 }
75
76 sub formatter
77 {
78 my ($self, $line) = @_;
79 Text::MediawikiFormat::format_line ($line, $self->tags(),
80 $self->opts());
81 }
82
83 sub add_args
84 {
85 my $self = shift;
86 push @{ $self->{args} }, @_;
87 }
88
89 {
90 no strict 'refs';
91 for my $attribute (qw( level opts tags type ))
92 {
93 *{ $attribute } = sub { $_[0]{$attribute} };
94 }
95 }
96
97 sub merge
98 {
99 my ($self, $next_block) = @_;
100
101 return $next_block unless $self->type() eq $next_block->type();
102 return $next_block unless $self->level() == $next_block->level();
103
104 $self->add_text( $next_block->text() );
105 $self->add_args( $next_block->all_args() );
106 return;
107 }
108
109 sub nests
110 {
111 my ($self, $maynest) = @_;
112 my $tags = $self->{tags};
113
114 return exists $tags->{nests}{$self->type()}
115 && exists $tags->{nests}{$maynest->type()}
116 && $self->level() < $maynest->level()
117 # <nowiki> tags nest anywhere, regardless of level and parent
118 || exists $tags->{nests_anywhere}{$maynest->type()};
119 }
120
121 sub nest
122 {
123 my ($self, $next_block) = @_;
124
125 return unless $next_block = $self->merge ($next_block);
126 return $next_block unless $self->nests ($next_block);
127
128 # if there's a nested block at the end, maybe it can nest too
129 my $last_item = ( $self->text() )[-1];
130 return $last_item->nest( $next_block ) if blessed( $last_item );
131
132 $self->add_text( $next_block );
133 return;
134 }
135
136 1;
137 __END__
138 =head1 NAME
139
140 Text::MediawikiFormat::Blocks - blocktypes for Text::MediawikiFormat
141
142 =head1 SYNOPSIS
143
144 None. Use L<Text::MediawikiFormat> as the public interface, unless you want to
145 create your own block type.
146
147 =head1 DESCRIPTION
148
149 This module merely creates subclasses of Text::MediawikiFormat::Block, which is
150 the interesting code. A block is a collection of related lines, such as a code
151 block (text to display verbatim in a monospaced font), a header, an unordered
152 list, an ordered list, and a paragraph (text to display in a proportional
153 font).
154
155 Every block extends C<Text::MediawikiFormat::Block>.
156
157 =head1 METHODS
158
159 The following methods exist:
160
161 =over 4
162
163 =item * C<new( %args )>
164
165 Creates and returns a new block. The valid arguments are:
166
167 =over 4
168
169 =item * C<text>
170
171 The text of the line found in the block.
172
173 =item * C<args>
174
175 The arguments captured by the block-identifying regular expression.
176
177 =item * C<level>
178
179 The level of indentation for the block (usually only useful for list blocks).
180
181 =item * C<tags>
182
183 The tags in effect for the current type of wiki formatting.
184
185 =item * C<opts>
186
187 The options in effect for the current type of wiki formatting.
188
189 =back
190
191 Use the accessors of the same names to retrieve the values of the attributes.
192
193 =item * C<add_text( @lines_of_text )>
194
195 Adds a list of lines of text to the current text for the block. This is very
196 useful when you encounter a block and want to merge it with the previous block
197 of the same type
198
199 =item * C<add_args( @arguments )>
200
201 Adds further arguments to the block; useful when merging blocks.
202
203 =item * C<formatted_text()>
204
205 Returns text formatted appropriately for this block. Blocks don't have to have
206 formatters, but they may.
207
208 =item * C<formatter( $line_of_text )>
209
210 Formats the C<$line> using C<Text::MediawikiFormat::format_line()>. You can add
211 your own formatter here; this is worth overriding.
212
213 =item * C<merge( $next_block )>
214
215 Merges the current block with C<$next_block> (the next block encountered) if
216 they're of the same type and are at the same level. This adds the text and
217 args of C<$next_block> to the current block. It's your responsibility to
218 remove C<$next_block> from whatever your code iterates over.
219
220 =item * C<nests()>
221
222 Returns true if this block should nest (as in lists and unordered lists) for
223 the active wiki formatting.
224
225 =item * C<nest( $next_block )>
226
227 Nests C<$next_block> under this block if the both nest and if C<$next_block>
228 has a level greater than the current block. This actually adds C<$next_block>
229 as a text item within the current block. Beware.
230
231 =back
232
233 =head1 AUTHOR
234
235 chromatic, C<< chromatic at wgz dot org >>
236
237 =head1 BUGS
238
239 No known bugs.
240
241 =head1 COPYRIGHT
242
243 Copyright (c) 2006, chromatic. Some rights reserved.
244
245 This module is free software; you can use, redistribute, and modify it under
246 the same terms as Perl 5.8.x.
+1438
-0
lib/Text/MediawikiFormat.pm less more
0 package Text::MediawikiFormat;
1
2 use strict;
3 use warnings::register;
4
5 =head1 NAME
6
7 Text::MediawikiFormat - Translate Wiki markup into other text formats
8
9 =head1 VERSION
10
11 Version 1.0
12
13 =cut
14
15 use vars qw($VERSION);
16 use version; $VERSION = qv('1.0');
17
18 =head1 SYNOPSIS
19
20 use Text::MediawikiFormat 'wikiformat';
21 my $html = wikiformat ($raw);
22 my $text = wikiformat ($raw, {}, {implicit_links => 1});
23
24 =head1 DESCRIPTION
25
26 L<http://wikipedia.org> and its sister projects use the PHP Mediawiki to format
27 their pages. This module attempts to duplicate the Mediawiki formatting rules.
28 Those formatting rules can be simple and easy to use, while providing more
29 advanced options for the power user. They are also easy to translate into
30 other, more complicated markup languages with this module. It creates HTML by
31 default, but could produce valid POD, DocBook, XML, or any other format
32 imaginable.
33
34 The most important function is C<Text::MediawikiFormat::format()>. It is
35 not exported by default, but will be exported as C<wikiformat()> if any
36 options at all are passed to the exporter, unless the name is overridden
37 explicitly. See L<"EXPORT"> for more information.
38
39 It should be noted that this module is written as a drop in replacement for
40 L<Text::WikiMarkup> that expands on that modules functionality and provides
41 a default rule set that may be used to format text like the PHP Mediawiki. It
42 is also well to note early that if you just want a Mediawiki clone (you don't
43 need to customize it heavily and you want integration with a back end
44 database), you should look at L<Wiki::Toolkit::Formatter::Mediawiki>.
45
46 =cut
47
48 use Carp qw(carp confess croak);
49 use CGI qw(:standard);
50 use Scalar::Util qw(blessed);
51 use Text::MediawikiFormat::Blocks;
52 use URI;
53 use URI::Escape qw(uri_escape uri_escape_utf8);
54
55 use vars qw($missing_html_packages %tags %opts %merge_matrix
56 $uric $uricCheat $uriCruft);
57
58 BEGIN
59 {
60 # Try to load optional HTML packages, recording any errors.
61 eval {require HTML::Parser};
62 $missing_html_packages = $@;
63 eval {require HTML::Tagset};
64 $missing_html_packages .= $@;
65 }
66
67
68
69 ###
70 ### Defaults
71 ###
72 %tags =
73 (
74 indent => qr/^(?:[:*#;]*)(?=[:*#;])/,
75 link => \&_make_html_link,
76 strong => sub {"<strong>$_[0]</strong>"},
77 emphasized => sub {"<em>$_[0]</em>"},
78 strong_tag => qr/'''(.+?)'''/,
79 emphasized_tag => qr/''(.+?)''/,
80
81 code => ['<pre>', "</pre>\n", '', "\n"],
82 line => ['', '', '<hr />', "\n"],
83 paragraph => ["<p>", "</p>\n", '', "\n", 1],
84 paragraph_break => ['', '', '', "\n"],
85 unordered => ["<ul>\n", "</ul>\n", '<li>', "</li>\n"],
86 ordered => ["<ol>\n", "</ol>\n", '<li>', "</li>\n"],
87 definition => ["<dl>\n", "</dl>\n", \&_dl],
88 header => ['', "\n", \&_make_header],
89
90 blocks =>
91 {
92 code => qr/^ /,
93 header => qr/^(=+)\s*(.+?)\s*\1$/,
94 line => qr/^-{4,}$/,
95 ordered => qr/^#\s*/,
96 unordered => qr/^\*\s*/,
97 definition => qr/^([;:])\s*/,
98 paragraph => qr/^/,
99 paragraph_break => qr/^\s*$/,
100 },
101
102 indented => {map {$_ => 1} qw(ordered unordered definition)},
103 nests => {map {$_ => 1} qw(ordered unordered definition)},
104 nests_anywhere => {map {$_ => 1} qw(nowiki)},
105
106 blockorder => [qw(code header line ordered unordered definition
107 paragraph_break paragraph)],
108 implicit_link_delimiters
109 => qr!\b(?:[A-Z][a-z0-9]\w*){2,}!,
110 extended_link_delimiters
111 => qr!\[(?:\[[^][]*\]|[^][]*)\]!,
112
113 schemas => [qw(http https ftp mailto gopher)],
114
115 unformatted_blocks => [qw(header nowiki pre)],
116
117 allowed_tags => [#HTML
118 qw(b big blockquote br caption center cite code dd
119 div dl dt em font h1 h2 h3 h4 h5 h6 hr i li ol p
120 pre rb rp rt ruby s samp small strike strong sub
121 sup table td th tr tt u ul var),
122 # Mediawiki Specific
123 qw(nowiki),],
124 allowed_attrs => [qw(title align lang dir width height bgcolor),
125 qw(clear), # BR
126 qw(noshade), # HR
127 qw(cite), # BLOCKQUOTE, Q
128 qw(size face color), # FONT
129 # For various lists, mostly deprecated but safe
130 qw(type start value compact),
131 # Tables
132 qw(summary width border frame rules cellspacing
133 cellpadding valign char charoff colgroup col
134 span abbr axis headers scope rowspan colspan),
135 qw(id class name style), # For CSS
136 ],
137
138 _toc => [],
139 );
140
141 %opts =
142 (
143 extended => 1,
144 implicit_links => 0,
145 absolute_links => 1,
146 prefix => '',
147 process_html => 1,
148 charset => 'utf-8',
149 );
150
151 # Make sure import's argument hash contains an `as' entry. `as' defaults to
152 # `wikiformat' when none is given.
153 sub _process_args
154 {
155 shift; # Class
156 return as => shift if @_ == 1;
157 return as => 'wikiformat', @_;
158 }
159
160 # Delete the options (prefix, extended, implicit_links, ...) from a hash,
161 # returning a new hash with the deleted options.
162 sub _extract_opts
163 {
164 my %newopts;
165
166 for my $key (qw{prefix extended implicit_links absolute_links
167 process_html debug})
168 {
169 if (defined (my $val = delete $_[0]->{$key}))
170 {
171 $newopts{$key} = $val;
172 }
173 }
174
175 return \%newopts;
176 }
177
178 # Shamelessly ripped from Hash::Merge, which doesn't work in a threaded
179 # environment with two threads trying to use different merge matrices.
180 %merge_matrix =
181 (
182 SCALAR =>
183 {
184 SCALAR => sub {return $_[0]},
185 ARRAY => sub {# Need to be able to replace scalar with array
186 # for extended_link_delimiters (could be array
187 # or regex).
188 return $_[0];},
189 HASH => sub {confess "Attempt to replace hash with scalar"
190 if defined $_[0];
191 return _clone ($_[1]);}
192 },
193
194 ARRAY =>
195 {
196 SCALAR => sub {# Need to be able to replace array with scalar
197 # for extended_link_delimiters (could be array
198 # or regex).
199 return _clone ($_[0]);},
200 ARRAY => sub {return _clone ($_[0]);},
201 HASH => sub {confess "Attempt to replace hash with array"}
202 },
203
204 HASH =>
205 {
206 SCALAR => sub {confess "Attempt to replace scalar with hash"},
207 ARRAY => sub {confess "Attempt to replace array with hash"},
208 HASH => sub {_merge_hash_elements ($_[0], $_[1])}
209 }
210 );
211 # Return arrays and a deep copy of hashes.
212 sub _clone
213 {
214 my ($obj) = @_;
215 my $type;
216 if (!defined $obj) { # Perl 5.005 compatibility
217 $type = 'SCALAR';
218 } elsif (ref $obj eq 'HASH') {
219 $type = 'HASH';
220 } elsif (ref $obj eq 'ARRAY') {
221 $type = 'ARRAY';
222 } else {
223 $type = 'SCALAR';
224 }
225
226 return $obj if $type eq 'SCALAR';
227 return $obj if $type eq 'ARRAY';
228
229 my %copy;
230 foreach my $key (keys %$obj)
231 {
232 $copy{$key} = _clone ($obj->{$key});
233 }
234 return \%copy;
235 }
236 # This does a straight merge of hashes, delegating the merge-specific
237 # work to '_merge_hashes'.
238 sub _merge_hash_elements
239 {
240 my ($left, $right) = @_;
241 die "Arguments for _merge_hash_elements must be hash references" unless
242 UNIVERSAL::isa ($left, 'HASH') && UNIVERSAL::isa ($right, 'HASH');
243
244 my %newhash;
245 foreach my $leftkey (keys %$left)
246 {
247 if (exists $right->{$leftkey})
248 {
249 $newhash{$leftkey} =
250 _merge_hashes ($left->{$leftkey}, $right->{$leftkey});
251 }
252 else
253 {
254 $newhash{$leftkey} = _clone ($left->{$leftkey});
255 }
256 }
257 foreach my $rightkey (keys %$right)
258 {
259 $newhash{$rightkey} = _clone ($right->{$rightkey})
260 if !exists $left->{$rightkey};
261 }
262 return \%newhash;
263 }
264 sub _merge_hashes
265 {
266 my ($left, $right) = @_;
267
268 # if one argument or the other is undefined or empty, don't worry about
269 # copying, just return the original.
270 return $right unless defined $left;
271 return $left unless defined $right;
272
273 # For the general use of this function, we want to create duplicates
274 # of all data that is merged.
275
276 my ($lefttype, $righttype);
277 if (ref $left eq 'HASH') {
278 $lefttype = 'HASH';
279 } elsif (ref $left eq 'ARRAY') {
280 $lefttype = 'ARRAY';
281 } else {
282 $lefttype = 'SCALAR';
283 }
284
285 if (ref $right eq 'HASH') {
286 $righttype = 'HASH';
287 } elsif (ref $right eq 'ARRAY') {
288 $righttype = 'ARRAY';
289 } else {
290 $righttype = 'SCALAR';
291 }
292
293 return $merge_matrix{$lefttype}->{$righttype} ($left, $right);
294 }
295
296 sub _require_html_packages
297 {
298 croak "$missing_html_packages\n"
299 . "HTML::Parser & HTML::Tagset is required for process_html\n"
300 if $missing_html_packages;
301 }
302
303 sub import
304 {
305 return unless @_ > 1;
306
307 my $class = shift;
308 my %args = $class->_process_args (@_);
309 my $name = delete $args{as};
310
311 my $caller = caller();
312 my $iopts = _merge_hashes _extract_opts (\%args), \%opts;
313 my $itags = _merge_hashes \%args, \%tags;
314
315 _require_html_packages
316 if $iopts->{process_html};
317
318 # Could verify ITAGS here via _check_blocks, but what if a user
319 # wants to add a block to block_order that they intend to override
320 # the implementation of with every call to format()?
321
322 no strict 'refs';
323 *{ $caller . "::" . $name } = sub
324 {
325 Text::MediawikiFormat::_format ($itags, $iopts, @_);
326 }
327 }
328
329
330
331 =head1 FUNCTIONS
332
333 =head2 format
334
335 C<format()> takes one required argument, the text to convert, and returns the
336 converted text. It allows two optional arguments. The first is a reference to
337 a hash of tags used to override the function's default behavior. Anything
338 passed in here will override the default tags. The second argument is a hash
339 reference of options. The options are currently:
340
341 =over 4
342
343 =item prefix
344
345 The prefix of any links to wiki pages. In HTML mode, this is the path to the
346 Wiki. The actual linked item itself will be appended to the prefix. This is
347 useful to create full URIs:
348
349 {prefix => 'http://example.com/wiki.pl?page='}
350
351 =item extended
352
353 A boolean flag, true by default, to let square brackets mark links.
354 An optional title may occur after the Wiki targets, preceded by an open pipe.
355 URI titles are separated from their title with a space. These are valid
356 extended links:
357
358 [[A wiki page|and the title to display]]
359 [http://ximbiot.com URI title]
360
361 Where the linking semantics of the destination format allow it, the result will
362 display the title instead of the URI. In HTML terms, the title is the content
363 of an C<A> element (not the content of its C<HREF> attribute).
364
365 You can use delimiters other than single square brackets for marking extended
366 links by passing a value for C<extended_link_delimiters> in the C<%tags> hash
367 when calling C<format>.
368
369 Note that if you disable this flag, you should probably enable
370 C<implicit_links> or there will be no automated way to link to other pages in
371 your wiki.
372
373 =item implicit_links
374
375 A boolean flag, false by default, to create links from StudlyCapsStrings.
376
377 =item absolute_links
378
379 A boolean flag, true by default, which treats any links that are absolute URIs
380 (such as C<http://www.cpan.org/>) specially. Any prefix will not apply.
381 This should maybe be called implicit_absolute_links since the C<extended>
382 option enables absolute links inside square brackets by default.
383
384 A link is any text that starts with a known schema followed by a colon and one
385 or more non-whitespace characters. This is a distinct subset of what L<URI>
386 recognizes as a URI, but is a good first-order approximation. If you need to
387 recognize more complex URIs, use the standard wiki formatting explained
388 earlier.
389
390 The recognized schemas are those defined in the C<schema> value in the C<%tags>
391 hash. C<schema> defaults to C<http>, C<https>, C<ftp>, C<mailto>, and
392 C<gopher>.
393
394 =item process_html
395
396 This flag, true by default, causes the formatter to ignore block level wiki
397 markup (code, ordered, unordered, etc...) when they occur on lines which also
398 contain allowed block-level HTML tags (<pre>, <ol>, <ul>, </pre>, etc...).
399 Phrase level wiki markup (emphasis, strong, & links) is unaffected by this
400 flag.
401
402 =back
403
404 =cut
405
406 sub format
407 {
408 _format (\%tags, \%opts, @_);
409 }
410
411 # Turn the contents after a ; or : into a dictionary list.
412 # Using : without ; just looks like an indent.
413 sub _dl
414 {
415 #my ($line, $indent, $lead) = @_;
416 my ($term, $def);
417
418 if ($_[2] eq ';')
419 {
420 if ($_[0] =~ /^(.*?)\s+:\s+(.*)$/)
421 {
422 $term = $1;
423 $def = $2;
424 }
425 else
426 {
427 $term = $_[0];
428 }
429 }
430 else
431 {
432 $def = $_[0];
433 }
434
435 my @retval;
436 push @retval, "<dt>", $term, "</dt>\n" if defined $term;
437 push @retval, "<dd>", $def, "</dd>\n" if defined $def;
438 return @retval;
439 }
440
441 # Makes a regex out of the allowed schema array.
442 sub _make_schema_regex
443 {
444 my $re = join "|", map {qr/\Q$_\E/} @_;
445 return qr/(?:$re)/;
446 }
447
448 $uric = $URI::uric;
449 $uricCheat = $uric;
450
451 # We need to avoid picking up 'HTTP::Request::Common' so we have a
452 # subset of uric without a colon.
453 $uricCheat =~ tr/://d;
454
455 # Identifying characters often accidentally picked up trailing a URI.
456 $uriCruft = q/]),.!'";}/;
457
458 # escape a URI based on our charset.
459 sub _escape_uri
460 {
461 my ($opts, $uri) = @_;
462 confess "charset not initialized" unless $opts->{charset};
463 return uri_escape_utf8 $uri if $opts->{charset} =~ /^utf-?8$/i;
464 return uri_escape $uri;
465 }
466
467 # Turn [[Wiki Link|Title]], [URI Title], scheme:url, or StudlyCaps into links.
468 sub _make_html_link
469 {
470 my ($tag, $opts, $tags) = @_;
471
472 my ($class, $trailing) = ('', '');
473 my ($href, $title);
474 if ($tag =~ /^\[\[([^|#]*)(?:(#)([^|]*))?(?:(\|)(.*))?\]\]$/)
475 {
476 # Wiki link
477 $href = $opts->{prefix} . _escape_uri $opts, $1 if $1;
478 $href .= $2 . _escape_uri $opts, $3 if $2;
479
480 if ($4)
481 {
482 # Title specified explicitly.
483 if (length $5)
484 {
485 $title = $5;
486 }
487 else
488 {
489 # An empty title asks Mediawiki to strip any parens off the end
490 # of the node name.
491 $1 =~ /^([^(]*)(?:\s*\()?/;
492 $title = $1;
493 }
494 }
495 else
496 {
497 # Title defaults to the node name.
498 $title = $1;
499 }
500 }
501 elsif ($tag =~ /^\[(\S*)(?:(\s+)(.*))?\]$/)
502 {
503 # URI
504 $href = $1;
505 if ($2)
506 {
507 $title = $3;
508 }
509 else
510 {
511 $title = ++$opts->{_uri_refs};
512 }
513 $href =~ s/'/%27/g;
514 }
515 else
516 {
517 # Shouldn't be able to get here without either $opts->{absolute_links}
518 # or $opts->{implicit_links};
519 $tags->{_schema_regex} ||= _make_schema_regex @{$tags->{schemas}};
520 my $s = $tags->{_schema_regex};
521
522 if ($tag =~ /^$s:[$uricCheat][$uric]*$/)
523 {
524 # absolute link
525 $href = $&;
526 $trailing = $& if $href =~ s/[$uriCruft]$//;
527 $title = $href;
528 }
529 else
530 {
531 # StudlyCaps
532 $href = $opts->{prefix} . _escape_uri $opts, $tag;
533 $title = $tag;
534 }
535 }
536
537 return "<a$class href='$href'>$title</a>$trailing";
538 }
539
540 # Store a TOC line for later.
541 #
542 # ASSUMPTIONS
543 # $level >= 1
544 sub _store_toc_line
545 {
546 my ($toc, $level, $title, $name) = @_;
547
548 # TODO: Strip formatting from $title.
549
550 if (@$toc && $level > $toc->[-1]->{level})
551 {
552 # Nest a sublevel.
553 $toc->[-1]->{sublevel} = []
554 unless exists $toc->[-1]->{sublevel};
555 _store_toc_line ($toc->[-1]->{sublevel}, $level, $title, $name);
556 }
557 else
558 {
559 push @$toc, {level => $level, title => $title, name => $name};
560 }
561
562 return $level;
563 }
564
565 # Make header text, storing the line for the TOC.
566 #
567 # ASSUMPTIONS
568 # $tags->{_toc} has been initialized to an array ref.
569 sub _make_header
570 {
571 my $level = length $_[2];
572 my $n = _escape_uri $_[-1], $_[3];
573
574 _store_toc_line ($_[-2]->{_toc}, $level, $_[3], $n);
575
576 return "<a name='$n'></a><h$level>",
577 Text::MediawikiFormat::format_line ($_[3], @_[-2, -1]),
578 "</h$level>\n";
579 }
580
581 sub _format
582 {
583 my ($itags, $iopts, $text, $tags, $opts) = @_;
584
585 # Overwriting the caller's hashes locally after merging its contents
586 # is okay.
587 $tags = _merge_hashes ($tags || {}, $itags);
588 $opts = _merge_hashes ($opts || {}, $iopts);
589
590 _require_html_packages
591 if $opts->{process_html};
592
593 # Always verify the blocks since the user may have slagged the
594 # default hash on import.
595 _check_blocks ($tags);
596
597 my @blocks = _find_blocks ($text, $tags, $opts);
598 @blocks = _nest_blocks (\@blocks);
599 return _process_blocks (\@blocks, $tags, $opts);
600 }
601
602 sub _check_blocks
603 {
604 my $tags = shift;
605 my %blocks = %{$tags->{blocks}};
606 delete @blocks{@{$tags->{blockorder}}};
607
608 carp
609 "No order specified for blocks: "
610 . join (', ', keys %blocks)
611 . ".\n"
612 if keys %blocks;
613 }
614
615 # This sub recognizes three states:
616 #
617 # 1. undef
618 # Normal wiki processing will be done on this line.
619 #
620 # 2. html
621 # Links and phrasal processing will be done, but formatting should be
622 # ignored.
623 #
624 # 3. nowiki
625 # No further wiki processing should be done.
626 #
627 # Each state may override the lower ones if already set on a given line.
628 #
629 sub _append_processed_line
630 {
631 my ($parser, $text, $state) = @_;
632 my $lines = $parser->{processed_lines};
633
634 $state ||= '';
635
636 my @newlines = split /(?<=\n)/, $text;
637 if (@$lines && $lines->[-1]->[1] !~ /\n$/
638 && # State not changing from or to 'nowiki'
639 !($state ne $lines->[-1]->[0]
640 && grep /^nowiki$/, $state, $lines->[-1]->[0]))
641 {
642 $lines->[-1]->[1] .= shift @newlines;
643 $lines->[-1]->[0] = $state if $state eq 'html';
644 }
645
646 foreach my $line (@newlines)
647 {
648 $lines->[-1]->[2] = '1' if @$lines;
649 push @$lines, [$state, $line];
650 }
651 $lines->[-1]->[2] = '1'
652 if @$lines && $lines->[-1]->[1] =~ /\n$/;
653 }
654
655 sub _html_tag
656 {
657 my ($parser, $type, $tagname, $orig, $attr) = @_;
658 my $tags = $parser->{tags};
659
660 # $tagname may have been generated by an empty tag. If so, HTML::Parser
661 # will sometimes include the trailing / in the tag name.
662 my $isEmptyTag = $orig =~ m#/>$#;
663 $tagname =~ s#/$## if $isEmptyTag;
664
665 unless (grep /^\Q$tagname\E$/, @{$tags->{allowed_tags}})
666 {
667 _append_processed_line $parser, CGI::escapeHTML $orig;
668 return;
669 }
670 # Any $tagname must now be in the allowed list, including <nowiki>.
671
672 my $tagstack = $parser->{tag_stack};
673 my $stacktop = @$tagstack ? $tagstack->[-1] : '';
674
675 # First, process end tags, since they can change our state.
676 if ($type eq 'E' && $stacktop eq $tagname)
677 {
678 # The closing tag is at the top of the stack, like it should be.
679 # Pop it and append the close tag to the output.
680 pop @$tagstack;
681 my $newtag;
682
683 if ($tagname eq 'nowiki')
684 {
685 # The browser doesn't need to see the </nowiki> tag.
686 $newtag = '';
687 }
688 else
689 {
690 $newtag = "</$tagname>";
691 }
692
693 # Can't close a state into <pre> or <nowiki>
694 _append_processed_line $parser, $newtag, 'html';
695 return;
696 }
697
698 if (@$tagstack && grep /^\Q$stacktop\E$/, qw{nowiki pre})
699 {
700 # Ignore all markup within <pre> or <nowiki> tags.
701 _append_processed_line $parser, CGI::escapeHTML ($orig), 'nowiki';
702 return;
703 }
704
705 if ($type eq 'E' && $HTML::Tagset::isPhraseMarkup{$tagname})
706 # If we ask for artificial end element events for self-closed elements,
707 # then we need to check $HTML::Tagset::emptyElement($tagname) here too.
708 {
709 # We didn't record phrase markup on the stack, so it's okay to just
710 # let it close.
711 _append_processed_line $parser, "</$tagname>";
712 return;
713 }
714
715 if ($type eq 'E')
716 {
717 # We got a non-phrase end tag that wasn't on the stack. Escape it.
718 _append_processed_line $parser, CGI::escapeHTML ($orig);
719 return;
720 }
721
722
723 ###
724 ### $type must now eq 'S'.
725 ###
726
727 # The browser doesn't need to see the <nowiki> tag.
728 if ($tagname eq 'nowiki')
729 {
730 push @$tagstack, $tagname
731 unless $isEmptyTag;
732 return;
733 }
734
735 # Strip disallowed attributes.
736 my $newtag = "<$tagname";
737 foreach (@{$tags->{allowed_attrs}})
738 {
739 if (defined $attr->{$_})
740 {
741 $newtag .= " $_";
742 unless ($attr->{$_}
743 eq '__TEXT_MEDIAWIKIFORMAT_BOOL__')
744 {
745 # CGI::escapeHTML escapes single quotes.
746 $attr->{$_} = CGI::escapeHTML $attr->{$_};
747 $newtag .= "='" . $attr->{$_} . "'";
748 }
749 }
750 }
751 $newtag .= " /" if $HTML::Tagset::emptyElement{$tagname} || $isEmptyTag;
752 $newtag .= ">";
753
754 # If this isn't a block level element, there's no need to track nesting.
755 if ($HTML::Tagset::isPhraseMarkup{$tagname}
756 || $HTML::Tagset::emptyElement{$tagname})
757 {
758 _append_processed_line $parser, $newtag;
759 return;
760 }
761
762 # Some elements can close implicitly
763 if (@$tagstack)
764 {
765 if ($tagname eq $stacktop
766 && $HTML::Tagset::optionalEndTag{$tagname})
767 {
768 pop @$tagstack;
769 }
770 elsif (!$HTML::Tagset::is_Possible_Strict_P_Content{$tagname})
771 {
772 # Need to check more than the last item for paragraphs.
773 for (my $i = $#{$tagstack}; $i >= 0; $i--)
774 {
775 my $checking = $tagstack->[$i];
776 last if grep /^\Q$checking\E$/,
777 @HTML::Tagset::p_closure_barriers;
778
779 if ($checking eq 'p')
780 {
781 # pop 'em all.
782 splice @$tagstack, $i;
783 last;
784 }
785 }
786 }
787 }
788
789 # Could verify here that <li> and <table> sub-elements only appear where
790 # they belong.
791
792 # Push the new tag onto the stack.
793 push @$tagstack, $tagname
794 unless $isEmptyTag;
795
796 _append_processed_line $parser, $newtag,
797 $tagname eq 'pre' ? 'nowiki' : 'html';
798 return;
799 }
800
801 sub _html_comment
802 {
803 my ($parser, $text) = @_;
804
805 _append_processed_line $parser, $text, 'nowiki';
806 }
807
808 sub _html_text
809 {
810 my ($parser, $dtext, $skipped_text, $is_cdata) = @_;
811 my $tagstack = $parser->{tag_stack};
812 my ($newtext, $newstate);
813
814 warnings::warnif ("Got skipped_text: `$skipped_text'")
815 if $skipped_text;
816
817 if (@$tagstack)
818 {
819 if (grep /\Q$tagstack->[-1]\E/, qw{nowiki pre})
820 {
821 $newstate = 'nowiki'
822 }
823 elsif ($is_cdata && $HTML::Tagset::isCDATA_Parent{$tagstack->[-1]})
824 {
825 # If the user hadn't specifically allowed a tag which contains
826 # CDATA, then it won't be on the tag stack.
827 $newtext = $dtext;
828 }
829 }
830
831 unless (defined $newtext)
832 {
833 $newtext = CGI::escapeHTML $dtext unless defined $newtext;
834 # CGI::escapeHTML escapes single quotes so the text may be included
835 # in attribute values, but we know we aren't processing an attribute
836 # value here.
837 $newtext =~ s/&#39;/'/g;
838 }
839
840 _append_processed_line $parser, $newtext, $newstate;
841 }
842
843 sub _find_blocks_in_html
844 {
845 my ($text, $tags, $opts) = @_;
846
847 my $parser = HTML::Parser->new
848 (start_h => [\&_html_tag, 'self, "S", tagname, text, attr'],
849 end_h => [\&_html_tag, 'self, "E", tagname, text'],
850 comment_h => [\&_html_comment, 'self, text'],
851 text_h => [\&_html_text, 'self, dtext, skipped_text, is_cdata'],
852 marked_sections => 1,
853 boolean_attribute_value => '__TEXT_MEDIAWIKIFORMAT_BOOL__',
854 );
855 $parser->{opts} = $opts;
856 $parser->{tags} = $tags;
857 $parser->{processed_lines} = [];
858 $parser->{tag_stack} = [];
859
860 my @blocks;
861 my @lines = split /\r?\n/, $text;
862 for (my $i = 0; $i < @lines; $i++)
863 {
864 $parser->parse ($lines[$i]);
865 $parser->parse ("\n");
866 $parser->eof if $i == $#lines;
867
868 # @{$parser->{processed_lines}} may be empty when tags are
869 # still open.
870 while (@{$parser->{processed_lines}}
871 && $parser->{processed_lines}->[0]->[2])
872 {
873 my ($type, $dtext)
874 = @{shift @{$parser->{processed_lines}}};
875
876 my $block;
877 if ($type)
878 {
879 $block = _start_block ($dtext, $tags, $opts, $type);
880 }
881 else
882 {
883 chomp $dtext;
884 $block = _start_block ($dtext, $tags, $opts);
885 }
886 push @blocks, $block if $block;
887 }
888 }
889
890 return @blocks;
891 }
892
893 sub _find_blocks
894 {
895 my ($text, $tags, $opts) = @_;
896 my @blocks;
897
898 if ($opts->{process_html})
899 {
900 @blocks = _find_blocks_in_html $text, $tags, $opts;
901 }
902 else
903 {
904 # The original behavior.
905 for my $line (split /\r?\n/, $text)
906 {
907 my $block = _start_block ($line, $tags, $opts);
908 push @blocks, $block if $block;
909 }
910 }
911
912 return @blocks;
913 }
914
915 sub _start_block
916 {
917 my ($text, $tags, $opts, $type) = @_;
918
919 return new_block ('end', level => 0) unless $text;
920 return new_block ($type,
921 level => 0,
922 opts => $opts,
923 text => $text,
924 tags => $tags,)
925 if $type;
926
927 for my $block (@{$tags->{blockorder}})
928 {
929 my ($line, $level, $indentation) = ($text, 0, '');
930
931 ($level, $line, $indentation) = _get_indentation ($tags, $line)
932 if $tags->{indented}{$block};
933
934 my $marker_removed = length ($line =~ s/$tags->{blocks}{$block}//);
935
936 next unless $marker_removed;
937
938 return new_block ($block,
939 args => [grep {defined} $1, $2, $3, $4, $5, $6, $7,
940 $8, $9],
941 level => $level || 0,
942 opts => $opts,
943 text => $line,
944 tags => $tags,
945 );
946 }
947 }
948
949 sub _nest_blocks
950 {
951 my $blocks = shift;
952 return unless @$blocks;
953
954 my @processed = shift @$blocks;
955
956 for my $block (@$blocks)
957 {
958 push @processed, $processed[-1]->nest( $block );
959 }
960
961 return @processed;
962 }
963
964 sub _process_blocks
965 {
966 my ($blocks, $tags, $opts) = @_;
967
968 my @open;
969 for my $block (@$blocks)
970 {
971 push @open, _process_block ($block, $tags, $opts)
972 unless $block->type() eq 'end';
973 }
974
975 return join '', @open ;
976 }
977
978 sub _process_block
979 {
980 my ($block, $tags, $opts) = @_;
981 my $type = $block->type();
982
983 my ($start, $end, $start_line, $end_line, $between);
984 if ($tags->{$type})
985 {
986 ($start, $end, $start_line, $end_line, $between) = @{$tags->{$type}};
987 }
988 else
989 {
990 ($start, $end, $start_line, $end_line) = ('', '', '', '');
991 }
992
993 my @text = ();
994 for my $line (grep (/^\Q$type\E$/, @{$tags->{unformatted_blocks}})
995 ? $block->text()
996 : $block->formatted_text())
997 {
998 if (blessed $line)
999 {
1000 my $prev_end = pop @text || ();
1001 push @text, _process_block ($line, $tags, $opts), $prev_end;
1002 next;
1003 }
1004
1005 my @triplets;
1006 if ((ref ($start_line) || '') eq 'CODE')
1007 {
1008 @triplets = $start_line->($line, $block->level(),
1009 $block->shift_args(), $tags, $opts);
1010 }
1011 else
1012 {
1013 @triplets = ($start_line, $line, $end_line);
1014 }
1015 push @text, @triplets;
1016 }
1017
1018 pop @text if $between;
1019 return join '', $start, @text, $end;
1020 }
1021
1022 sub _get_indentation
1023 {
1024 my ($tags, $text) = @_;
1025
1026 return 1, $text unless $text =~ s/($tags->{indent})//;
1027 return length ($1) + 1, $text, $1;
1028 }
1029
1030 =head2 format_line
1031
1032 $formatted = format_line ($raw, $tags, $opts);
1033
1034 This function is never exported. It formats the phrase elements of a single
1035 line of text (emphasised, strong, and links).
1036
1037 This is only meant to be called from L<Text::MediawikiFormat::Block> and so
1038 requires $tags and $opts to have all elements filled in. If you find a use for
1039 it, please let me know and maybe I will have it default the missing elements as
1040 C<format()> does.
1041
1042 =cut
1043
1044 sub format_line
1045 {
1046 my ($text, $tags, $opts) = @_;
1047
1048 $text =~ s!$tags->{strong_tag}!$tags->{strong}->($1, $opts)!eg;
1049 $text =~ s!$tags->{emphasized_tag}!$tags->{emphasized}->($1, $opts)!eg;
1050
1051 $text = _find_links ($text, $tags, $opts)
1052 if $opts->{extended}
1053 || $opts->{absolute_links}
1054 || $opts->{implicit_links};
1055
1056 return $text;
1057 }
1058
1059 sub _find_innermost_balanced_pair
1060 {
1061 my ($text, $open, $close) = @_;
1062
1063 my $start_pos = rindex $text, $open;
1064 return if $start_pos == -1;
1065
1066 my $end_pos = index $text, $close, $start_pos;
1067 return if $end_pos == -1;
1068
1069 my $open_length = length $open;
1070 my $close_length = length $close;
1071 my $close_pos = $end_pos + $close_length;
1072 my $enclosed_length = $close_pos - $start_pos;
1073
1074 my $enclosed_atom = substr $text, $start_pos, $enclosed_length;
1075 return substr ($enclosed_atom, $open_length, 0 - $close_length),
1076 substr ($text, 0, $start_pos),
1077 substr ($text, $close_pos);
1078 }
1079
1080 sub _find_links
1081 {
1082 my ($text, $tags, $opts) = @_;
1083
1084 # Build Regexp
1085 my @res;
1086
1087 if ($opts->{absolute_links})
1088 {
1089 # URI
1090 my $s;
1091 $tags->{_schema_regex} ||= _make_schema_regex @{$tags->{schemas}};
1092 $s = $tags->{_schema_regex};
1093 push @res, qr/\b$s:[$uricCheat][$uric]*/
1094 }
1095
1096 if ($opts->{implicit_links})
1097 {
1098 # StudlyCaps
1099 if ($tags->{implicit_link_delimiters})
1100 {
1101 push @res, qr/$tags->{implicit_link_delimiters}/;
1102 }
1103 else
1104 {
1105 warnings::warnif ("Ignoring implicit_links option since implicit_link_delimiters is empty");
1106 }
1107 }
1108
1109 if ($opts->{extended})
1110 {
1111 # [[Wiki Page]]
1112 if (!$tags->{extended_link_delimiters})
1113 {
1114 warnings::warnif ("Ignoring extended option since extended_link_delimiters is empty");
1115 }
1116 elsif (ref $tags->{extended_link_delimiters} eq "ARRAY")
1117 {
1118 # Backwards compatibility for extended links.
1119 # Bypasses the regex substitution used by absolute and implicit
1120 # links.
1121 my ($start, $end) = @{$tags->{extended_link_delimiters}};
1122 while (my @pieces = _find_innermost_balanced_pair ($text, $start,
1123 $end))
1124 {
1125 my ($tag, $before, $after) = map { defined $_ ? $_ : '' }
1126 @pieces;
1127 my $extended = $tags->{link}->($tag, $opts, $tags) || '';
1128 $text = $before . $extended . $after;
1129 }
1130 }
1131 else
1132 {
1133 push @res, qr/$tags->{extended_link_delimiters}/;
1134 }
1135 }
1136
1137 if (@res)
1138 {
1139 my $re = join "|", @res;
1140 $text =~ s/$re/$tags->{link}->($&, $opts, $tags)/ge;
1141 }
1142
1143 return $text;
1144 }
1145
1146 =head1 Wiki Format
1147
1148 Refer to L<http://en.wikipedia.org/wiki/Help:Contents/Editing_Wikipedia> for
1149 description of the default wiki format, as interpreted by this module. Any
1150 discrepencies will be considered bugs in this module, with a few exceptions.
1151
1152 =head2 Unimplemented Wiki Markup
1153
1154 =over 4
1155
1156 =item Templates, Magic Words, and Wanted Links
1157
1158 Templates, magic words, and the colorization of wanted links all require a back
1159 end data store that can be consulted on the existance and content of named
1160 pages. C<Text::MediawikiFormat> has deliberately been constructed such that it
1161 operates independantly from such a back end. For an interface to
1162 C<Text::MediawikiFormat> which implements these features, see
1163 L<Wiki::Toolkit::Formatter::Mediawiki>.
1164
1165 =item Tables
1166
1167 This is on the TODO list.
1168
1169 =back
1170
1171 =head1 EXPORT
1172
1173 If you'd like to make your life more convenient, you can optionally import a
1174 subroutine that already has default tags and options set up. This is
1175 especially handy if you use a prefix:
1176
1177 use Text::MediawikiFormat prefix => 'http://www.example.com/';
1178 wikiformat ('some text');
1179
1180 Tags are interpreted as default members of the $tags hash normally passed to
1181 C<format>, except for the five options (see above) and the C<as> key, who's
1182 value is interpreted as an alternate name for the imported function.
1183
1184 To use the C<as> flag to control the name by which your code calls the imported
1185 function, for example,
1186
1187 use Text::MediawikiFormat as => 'formatTextWithWikiStyle';
1188 formatTextWithWikiStyle ('some text');
1189
1190 You might choose a better name, though.
1191
1192 The calling semantics are effectively the same as those of the C<format()>
1193 function. Any additional tags or options to the imported function will
1194 override the defaults. This code:
1195
1196 use Text::MediawikiFormat as => 'wf', extended => 0;
1197 wf ('some text', {}, {extended => 1});
1198
1199 enables extended links, after specifying that the default behavior should be
1200 to disable them.
1201
1202 =head1 GORY DETAILS
1203
1204 =head2 Tags
1205
1206 There are two types of Wiki markup: phrase markup and blocks. Blocks include
1207 lists, which are made up of lines and can also contain other lists.
1208
1209 =head3 Phrase Markup
1210
1211 The are currently three types of wiki phrase markup. These are the
1212 strong and emphasized markup and links. Links may additionally be of three
1213 subtypes, extended, implicit, or absolute.
1214
1215 You can change the regular expressions used to find strong and emphasized tags:
1216
1217 %tags = (
1218 strong_tag => qr/\*([^*]+?)\*/,
1219 emphasized_tag => qr|/([^/]+?)/|,
1220 );
1221
1222 $wikitext = 'this is *strong*, /emphasized/, and */em+strong/*';
1223 $htmltext = wikiformat ($wikitext, \%tags, {});
1224
1225 You can also change the regular expressions used to find links. The following
1226 just sets them to their default states (but enables parsing of implicit links,
1227 which is I<not> the default):
1228
1229 my $html = wikiformat
1230 (
1231 $raw,
1232 {implicit_link_delimiters => qr!\b(?:[A-Z][a-z0-9]\w*){2,}!,
1233 extended_link_delimiters => qr!\[(?:\[[^][]*\]|[^][]*)\]!,
1234 },
1235 {implicit_links => 1}
1236 );
1237
1238 In addition, you may set the function references that format strong and
1239 emphasized text and links. The strong and emphasized functions receive only
1240 the text to be formatted as an argument and are expected to return the
1241 formatted text. The link formatter also recieves references to the C<$tags>
1242 and C<$opts> arrays. For example, the following sets the strong and
1243 emphasized formatters to their default state while replacing the link formatter
1244 with one which strips href information and returns only the title text:
1245
1246 my $html = wikiformat
1247 (
1248 $raw,
1249 {strong => sub {"<strong>$_[0]</strong>"},
1250 emphasized => sub {"<em>$_[0]</em>"},
1251 link => sub
1252 {
1253 my ($tag, $opts, $tags) = @_;
1254 if ($tag =~ s/^\[\[([^][]+)\]\]$/$1/)
1255 {
1256 my ($page, $title) = split qr/\|/, $tag, 2;
1257 return $title if $title;
1258 return $page;
1259 }
1260 elsif ($tag =~ s/^\[([^][]+)\]$/$1/)
1261 {
1262 my ($href, $title) = split qr/ /, $tag, 2;
1263 return $title if $title;
1264 return $href;
1265 }
1266 else
1267 {
1268 return $tag;
1269 }
1270 },
1271 },
1272 );
1273
1274 =head3 Blocks
1275
1276 The default block types are C<code>, C<line>, C<paragraph>, C<paragraph_break>,
1277 C<unordered>, C<ordered>, C<definition>, and C<header>.
1278
1279 Block entries in the tag hashes must contain array references. The first two
1280 items are the tags used at the start and end of the block. The third and
1281 fourth contain the tags used at the start and end of each line. Where there
1282 needs to be more processing of individual lines, use a subref as the third
1283 item. This is how the module processes ordered lines in HTML lists and
1284 headers:
1285
1286 my $html = wikiformat
1287 (
1288 $raw,
1289 {ordered => ['<ol>', "</ol>\n", '<li>', "<li>\n"],
1290 header => ['', "\n", \&_make_header],
1291 },
1292 );
1293
1294 The first argument to these subrefs is the post-processed text of the line
1295 itself. (Processing removes the indentation and tokens used to mark this as a
1296 list and checks the rest of the line for other line formattings.) The second
1297 argument is the indentation level (see below). The subsequent arguments are
1298 captured variables in the regular expression used to find this list type. The
1299 regexp for headers is:
1300
1301 $html = wikiformat
1302 (
1303 $raw,
1304 {blocks => {header => qr/^(=+)\s*(.+?)\s*\1$/}}
1305 );
1306
1307 The module processes indentation first, if applicable, and stores the
1308 indentation level (the length of the indentation removed).
1309
1310 Lists automatically start and end as necessary.
1311
1312 Because regular expressions could conceivably match more than one line, block
1313 level markup is processed in a specific order. The C<blockorder> tag governs
1314 this order. It contains a reference to an array of the names of the
1315 appropriate blocks to process. If you add a block type, be sure to add an
1316 entry for it in C<blockorder>:
1317
1318 my $html = wikiformat
1319 (
1320 $raw,
1321 {invisible => ['', '', '', ''],
1322 blocks => {invisible => qr!^--(.*?)--$!},
1323 blockorder => [qw(code header line ordered
1324 unordered definition invisible
1325 paragraph_break paragraph)]
1326 },
1327 },
1328 );
1329
1330 =head3 Finding blocks
1331
1332 As has already been mentioned in passing, C<Text::MediawikiFormat> uses regular
1333 expressions to find blocks. These are in the C<%tags> hash under the C<blocks>
1334 key. For example, to change the regular expression to find code block items,
1335 use:
1336
1337 my $html = wikiformat ($raw, {blocks => {code => qr/^:\s+/}});
1338
1339 This will require a leading colon to mark code lines (note that as writted
1340 here, this would interfere with the default processing of definition lists).
1341
1342 =head3 Finding Blocks in the Correct Order
1343
1344 As intrepid bug reporter Tom Hukins pointed out in CPAN RT bug #671, the order
1345 in which C<Text::MediawikiFormat> searches for blocks varies by platform and
1346 version of Perl. Because some block-finding regular expressions are more
1347 specific than others, what you intend to be one type of block may turn into a
1348 different list type.
1349
1350 If you're adding new block types, be aware of this. The C<blockorder> entry in
1351 C<%tags> exists to force C<Text::MediawikiFormat> to apply its regexes from
1352 most specific to least specific. It contains an array reference. By default,
1353 it looks for ordered lists first, unordered lists second, and code references
1354 at the end.
1355
1356 =head1 SEE ALSO
1357
1358 L<Wiki::Toolkit::Formatter::Mediawiki>
1359
1360 =head1 SUPPORT
1361
1362 You can find documentation for this module with the perldoc command.
1363
1364 perldoc Text::MediawikiFormat
1365
1366 You can also look for information at:
1367
1368 =over 4
1369
1370 =item * AnnoCPAN: Annotated CPAN documentation
1371
1372 L<http://annocpan.org/dist/Text-MediawikiFormat>
1373
1374 =item * CPAN Ratings
1375
1376 L<http://cpanratings.perl.org/d/Text-MediawikiFormat>
1377
1378 =item * RT: CPAN's request tracker
1379
1380 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-MediawikiFormat>
1381
1382 =item * Search CPAN
1383
1384 L<http://search.cpan.org/dist/Text-MediawkiFormat>
1385
1386 =back
1387
1388 =head1 AUTHOR
1389
1390 Derek Price C<derek at ximbiot.com> is the author.
1391
1392 =head1 ACKNOWLEDGEMENTS
1393
1394 This module is derived from L<Text::WikiFormat>, written by chromatic.
1395 chromatic's original credits are below:
1396
1397 chromatic, C<chromatic at wgz.org>, with much input from the Jellybean team
1398 (including Jonathan Paulett). Kate L Pugh has also provided several patches,
1399 many failing tests, and is usually the driving force behind new features and
1400 releases. If you think this module is worth buying me a beer, she deserves at
1401 least half of it.
1402
1403 Alex Vandiver added a nice patch and tests for extended links.
1404
1405 Tony Bowden, Tom Hukins, and Andy H. all suggested useful features that are now
1406 implemented.
1407
1408 Sam Vilain, Chris Winters, Paul Schmidt, and Art Henry have all found and
1409 reported silly bugs.
1410
1411 Blame me for the implementation.
1412
1413 =head1 BUGS
1414
1415 The link checker in C<format_line()> may fail to detect existing links that do
1416 not follow HTML, XML, or SGML style. They may die with some SGML styles too.
1417 I<Sic transit gloria mundi>.
1418
1419 =head1 TODO
1420
1421 =over 4
1422
1423 =item * Optimize C<format_line()> to work on a list of lines
1424
1425 =back
1426
1427 =head1 COPYRIGHT & LICENSE
1428
1429 Copyright (c) 2006-2008 Derek R. Price, all rights reserved.
1430 Copyright (c) 2002 - 2006, chromatic, all rights reserved.
1431
1432 This program is free software; you can redistribute it and/or modify it
1433 under the same terms as Perl itself.
1434
1435 =cut
1436
1437 1; # End of Text::MediaiwkiFormat
+193
-0
t/Wiki.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 # for testing 'rootdir' in links
8 my %constants = (
9 rootdir => 'rootdir',
10 );
11
12 local *Text::MediawikiFormat::getCurrentStatic;
13 *Text::MediawikiFormat::getCurrentStatic = sub {
14 return \%constants;
15 };
16
17 use Test::More tests => 34;
18 use Test::NoWarnings;
19
20 use_ok 'Text::MediawikiFormat';
21
22 my $wikitext =<<WIKI;
23 '''hello'''
24 ''hi''
25 -----
26 woo
27 -----
28 LinkMeSomewhere
29 [[LinkMeElsewhere|BYE]]
30
31 * unordered one
32 * unordered two
33
34 # ordered one
35 # ordered two
36
37 code one
38 code two
39
40 WIKI
41
42 ok %Text::MediawikiFormat::tags,
43 '%tags should be available from Text::MediawikiFormat';
44 my %tags = %Text::MediawikiFormat::tags;
45
46 ok %Text::MediawikiFormat::opts,
47 '%opts should be available from Text::MediawikiFormat';
48 my %opts = (
49 %Text::MediawikiFormat::opts,
50 prefix => 'rootdir/wiki.pl?page=',
51 implicit_links => 1,
52 extended => 0,
53 process_html => 0,
54 );
55
56 my $htmltext = Text::MediawikiFormat::format_line ($wikitext, \%tags, \%opts);
57
58 like $htmltext, qr!\[<a href='rootdir/wiki\.pl\?page=LinkMeElsewhere'>!,
59 'format_line () should link StudlyCaps where found)';
60 like $htmltext, qr!<strong>hello</strong>!, 'three ticks should mark strong';
61 like $htmltext, qr!<em>hi</em>!, 'two ticks should mark emphasized';
62 like $htmltext, qr!LinkMeSomewhere</a>\n!m, 'should catch StudlyCaps';
63 like $htmltext, qr!\[\[!, 'should not handle extended links without flag';
64
65 $opts{extended} = 1;
66 $htmltext = Text::MediawikiFormat::format_line ($wikitext, \%tags, \%opts);
67 like $htmltext, qr!^<a href='rootdir/wiki\.pl\?page=LinkMeElsewhere'>BYE!m,
68 'should handle extended links with flag';
69
70 $htmltext = Text::MediawikiFormat::format ($wikitext, {}, {process_html => 0});
71 like $htmltext, qr!<strong>hello</strong>!, 'three ticks should mark strong';
72 like $htmltext, qr!<em>hi</em>!, 'two ticks should mark emphasized';
73
74 is scalar @{$tags{ordered}}, 4,
75 '...default ordered entry should have four items';
76 is join ('', map {ref $_} @{$tags{ordered}}), '',
77 '...and should have no subrefs';
78
79 # make sure this starts a paragraph (buglet)
80 $htmltext = Text::MediawikiFormat::format ("nothing to see here\nmoveAlong\n",
81 {},
82 {prefix => 'foo=',
83 process_html => 0});
84 like $htmltext, qr!^<p>nothing!, '...should start new text with paragraph';
85
86 # another buglet had the wrong tag pairs when ending a list
87 my $wikiexample =<<WIKIEXAMPLE;
88 I am modifying this because ItIsFun. There is:
89 # MuchJoy
90 # MuchFun
91 # MuchToDo
92
93 Here is a paragraph.
94 There are newlines in my paragraph.
95
96 Here is another paragraph.
97
98 here is some code that should have ''emphatic text''
99 how amusing
100
101 WIKIEXAMPLE
102
103 $htmltext = Text::MediawikiFormat::format ($wikiexample, {},
104 {prefix => 'foo=',
105 process_html => 0});
106
107 like $htmltext, qr!^<p>I am modifying this!,
108 '... should use correct tags when ending lists';
109 like $htmltext, qr!<p>Here is a paragraph.\n!,
110 '...should add no newline before paragraph, but at newline in paragraph';
111 like $htmltext, qr!<p>Here is another paragraph.</p>!,
112 '... should add no newline at end of paragraph';
113 like $htmltext, qr|<em>emphatic text</em>|,
114 '...should sub markup in code sections';
115 unlike $htmltext, qr!<(\w+)></\1>!, '...but should not create empty lists';
116
117 $wikitext =<<WIKI;
118 [escape spaces in links]
119
120 WIKI
121
122 %opts = (
123 prefix => 'rootdir/wiki.pl?page=',
124 process_html => 0,
125 );
126
127 $htmltext = Text::MediawikiFormat::format ($wikitext, {}, \%opts);
128 like $htmltext, qr!<a href='escape'!m,
129 '...should extended absolute links on spaces';
130 like $htmltext, qr!spaces in links</a>!m,
131 '...should leave spaces alone in titles of extended links';
132
133 $wikitext =<<'WIKI';
134 = heading =
135 == sub heading ==
136
137 some text
138
139 === sub sub heading ===
140
141 more text
142
143 WIKI
144
145 $htmltext = Text::MediawikiFormat::format($wikitext, \%tags, \%opts);
146 like $htmltext, qr!<h1>heading</h1>!, 'headings should be marked';
147 like $htmltext, qr!<h2>sub heading</h2>!, '... and numbered appropriately';
148
149 # test overridable tags
150
151 ok !UNIVERSAL::can ('main', 'wikiformat'),
152 'Module should import nothing by default';
153
154 can_ok 'Text::MediawikiFormat', 'import';
155
156 SKIP: {
157 # process_html defaults to 1, so we can't test the single-argument version
158 # of the importer without the HTML modules.
159 eval { require HTML::Parser; require HTML::Tagset; };
160 skip "HTML::Parser or HTML::Tagset not installed", 1 if $@;
161
162 # given an argument, export wikiformat() somehow
163 package Foo;
164
165 Text::MediawikiFormat->import('wikiformat');
166 ::can_ok 'Foo', 'wikiformat';
167 }
168
169 package Bar;
170 Text::MediawikiFormat->import(as => 'wf', prefix => 'foo', tag => 'bar',
171 process_html => 0);
172 ::can_ok 'Bar', 'wf';
173 ::isnt \&wf, \&Text::MediawikiFormat::format,
174 '...and should be a wrapper around format()';
175
176 my @args;
177 local *Text::MediawikiFormat::_format;
178 *Text::MediawikiFormat::_format = sub {
179 @args = @_;
180 };
181
182 wf();
183 ::is $args[1]{prefix}, 'foo',
184 'imported sub should pass through default option';
185 ::is $args[0]{tag}, 'bar', '... and default tag';
186
187 wf ('text', {tag2 => 1}, {prefix => 'baz'});
188 ::is $args[2], 'text', '...passing through text unharmed';
189 ::is $args[3]{tag2}, 1, '...along with new tags';
190 ::is $args[4]{prefix}, 'baz', '...overriding default args as needed';
191
192 1;
+64
-0
t/absolute_links.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 8;
8 use Test::NoWarnings;
9 use Text::MediawikiFormat as => 'wf', implicit_links => 0, absolute_links => 0,
10 process_html => 0;
11
12 my $wikitext = <<'WIKI';
13
14 I download code from http://www.cpan.org/ or ftp://ftp.cpan.org/ and
15 email mailto:chromatic@example.com
16
17 WIKI
18
19 my $htmltext = wf ($wikitext, {}, {absolute_links => 1});
20
21 is $htmltext,
22 qq{<p>I download code from <a href='http://www.cpan.org/'>}
23 . qq{http://www.cpan.org/</a> }
24 . qq{or <a href='ftp://ftp.cpan.org/'>ftp://ftp.cpan.org/</a> and\n}
25 . q{email <a href='mailto:chromatic@example.com'>}
26 . q{mailto:chromatic@example.com</a>}
27 . qq{</p>\n},
28 'Picking up absolute links';
29
30 $htmltext = wf ($wikitext, {}, {absolute_links => 0});
31 is $htmltext,
32 qq{<p>I download code from http://www.cpan.org/ or ftp://ftp.cpan.org/ }
33 . qq{and\n}
34 . q{email mailto:chromatic@example.com}
35 . qq{</p>\n},
36 q{Doesn't pick up links when absolute_links is off};
37
38 $wikitext = "this is a moose:notalink";
39
40 $htmltext = wf ($wikitext, {}, {absolute_links => 1});
41 is $htmltext,
42 qq{<p>this is a moose:notalink</p>\n},
43 q{Doesn't pick up things that might look like links};
44
45 $htmltext = wf ($wikitext, {schemas => ['moose']}, {absolute_links => 1});
46 is $htmltext,
47 qq{<p>this is a <a href='moose:notalink'>moose:notalink</a></p>\n},
48 q{Schema tag allows specifying what is a link};
49
50 $wikitext = <<'WIKI';
51
52 http://www.cpan.org/.
53
54 A link in angle brackets: <http://link.org>.
55 WIKI
56
57 $htmltext = wf ($wikitext, {}, {absolute_links => 1});
58 like $htmltext, qr{href='http://www.cpan.org/'>},
59 'Links work at beginning of line and lose cruft';
60 like $htmltext, qr{org/</a>\.},
61 'Cruft restored after link';
62 like $htmltext, qr{>http://link\.org</a>>\.},
63 'Angle brackets around links are left alone';
+189
-0
t/base.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 35;
8
9 my $module = 'Text::MediawikiFormat';
10 use_ok $module or exit;
11
12 can_ok $module, '_start_block';
13 my $text =<<END_WIKI;
14 = heading =
15
16 * unordered item
17 1. ordered item
18
19 some code
20
21 a normal paragraph
22
23 END_WIKI
24
25 sub fetchsub
26 {
27 return $module->can( $_[0] );
28 }
29
30 my $tags = \%Text::MediawikiFormat::tags;
31 local *Text::MediawikiFormat::tags = $tags;
32 my $opts = \%Text::MediawikiFormat::opts;
33 local *Text::MediawikiFormat::opts = $opts;
34
35 my $sb = fetchsub '_start_block';
36 my ($result) = $sb->('= heading =', $tags);
37
38 ok $result->isa ('Text::MediawikiFormat::Block::header'),
39 '_start_block() should find headings' or diag "... it's a $result";
40
41 is $result->level(), 0, '... at the correct level';
42
43 ($result) = $sb->('** unordered item', $tags);
44
45 ok $result->isa ('Text::MediawikiFormat::Block::unordered'),
46 '_start_block() should find unordered lists' or diag "... it's a $result";
47 is $result->level(), 2, '... at the correct level';
48 is join ('', $result->text()), 'unordered item', '... with the correct text';
49
50 ($result) = $sb->('## ordered item', $tags);
51
52 ok $result->isa ('Text::MediawikiFormat::Block::ordered'),
53 '_start_block() should find ordered lists' or diag "... it's a $result";
54 is $result->level(), 2, '... at the correct level';
55 is join ('', $result->text()), 'ordered item', '... with the correct text';
56
57 ($result) = $sb->(' some code', $tags);
58
59 ok $result->isa ('Text::MediawikiFormat::Block::code'),
60 '_start_block() should find code' or diag "... it's a $result";
61 is $result->level(), 0, '... at the correct level';
62 is join ('', $result->text()), "some code", '... with the correct text';
63
64 ($result) = $sb->('paragraph', $tags);
65
66 ok $result->isa ('Text::MediawikiFormat::Block::paragraph'),
67 '_start_block() should find paragraph' or diag "... it's a $result";
68 is $result->level(), 0, '... at the correct level';
69 is join ('', $result->text()), 'paragraph', '...with the correct text';
70
71 can_ok $module, '_nest_blocks';
72 my $nb = fetchsub '_nest_blocks';
73 my @result = $nb->([
74 map {Text::MediawikiFormat::new_block (@$_)}
75 ['code', text => 'a', level => 1],
76 ['code', text => 'b', level => 1],
77 ]);
78 is @result, 1, '_nest_blocks() should merge identical blocks together';
79 is_deeply $result[0]{text}, [qw(a b)], '...merging their text';
80
81 @result = $nb->([
82 map {Text::MediawikiFormat::new_block (@$_)}
83 ['unordered', text => 'foo', level => 1],
84 ['unordered', text => 'bar', level => 1],
85 ], $tags);
86 is @result, 1, '... merging unordered blocks';
87 is_deeply $result[0]{text}, [qw(foo bar)], '...and their text';
88
89 @result = $nb->([
90 map {Text::MediawikiFormat::new_block (@$_)}
91 ['ordered', text => 'foo', level => 2],
92 ['ordered', text => 'bar', level => 3],
93 ], $tags);
94 is @result, 2, '... not merging blocks at different levels';
95
96 can_ok $module, '_process_blocks';
97 my $pb = fetchsub '_process_blocks';
98 my @opts = (tags => $tags, opts => $opts);
99 my @blocks = map {Text::MediawikiFormat::new_block (@$_, @opts)}
100 ['header', text => [''], level => 0,
101 args => ['==', 'my header']], ['end', text => [ '' ],
102 level => 0, @opts],
103 ['paragraph', text => [qw(my lines of text)], args => [],
104 level => 0],
105 ['end', text => [ '' ], level => 0, @opts ],
106 ['ordered', text => [qw(my ordered lines),
107 Text::MediawikiFormat::new_block
108 ('unordered',
109 text => [qw(my unordered lines)],
110 level => 3, args => [], @opts),],
111 level => 2, args => []];
112
113 # it's hard to fake these up; this may be a bad test
114 $blocks[2]{args} = [[], [], [] ];
115 $blocks[4]{args} = [[2], [3], [5]];
116 $blocks[4]{text}[3]{args} = [[], [], []];
117
118 @result = $pb->(\@blocks, $tags, $opts);
119
120 is @result, 1, '_process_blocks() should return processed text';
121 $result = $result[0];
122 like $result, qr!<h2>my header</h2>!, '...marking header';
123 like $result, qr!<p>my[^<]+text</p>\n!s, '...paragraph';
124 like $result, qr!<ol>\n<li>my</li>.+<li>lines!s, '...ordered list';
125 like $result, qr!<ul>\n<li>my</li>!m, '...and unordered list';
126 like $result, qr!</li>\n</ul>\n</li>\n</ol>!, '...nesting properly';
127
128 my $f = fetchsub( 'format' );
129 my $fullresult = $f->(<<END_WIKI, $tags, {process_html => 0});
130 == my header ==
131
132 my
133 lines
134 of
135 text
136
137 # my
138 # ordered
139 # lines
140 #* my
141 #* unordered
142 #* lines
143 END_WIKI
144
145 is $fullresult, $result, 'format() should give same results';
146
147 $fullresult = $f->(<<END_WIKI, $tags, {process_html => 0});
148 = heading =
149
150 * aliases can expire
151 ** use the Expires directive
152 ** no messages sent after the expiration date
153 * aliases can be closed
154 ** use the Closed directive
155 ** messages allowed only from people on the list
156 * aliases can auto-add people
157 ** use the Auto-add directive
158 ** anyone in the Cc line is added to the alias
159 ** they won't get duplicates
160 ** makes "just reply to alias" easier
161
162 END_WIKI
163
164 like $fullresult, qr!expire<ul>!, 'nested list should start immediately';
165 like $fullresult, qr!date</li>\n</ul>!, '... ending after last nested item';
166
167 can_ok $module, '_check_blocks';
168
169 my @warnings;
170 local $SIG{__WARN__} = sub {
171 push @warnings, shift;
172 };
173
174 my $cb = \&Text::MediawikiFormat::_check_blocks;
175 my $newtags = {
176 blocks => {foo => 1, bar => 1, baz => 1},
177 blockorder => [qw(bar baz)],
178 };
179 $cb->($newtags);
180 my $warning = shift @warnings;
181 like $warning, qr/No order specified for blocks: foo\./,
182 '_check_blocks() should warn if block is not ordered';
183
184 $newtags->{blockorder} = ['baz'];
185 $cb->($newtags);
186 $warning = shift @warnings;
187 ok $warning =~ /foo/ && $warning =~ /bar/, '... for all missing blocks'
188 or diag $warning;
+115
-0
t/bugs.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 16;
8 use Test::NoWarnings;
9
10 use_ok 'Text::MediawikiFormat', as => 'wf', process_html => 0;
11
12 my $wikitext =<<WIKI;
13
14
15 * unordered
16
17 Final paragraph.
18
19 WIKI
20
21 my $htmltext = eval { wf ($wikitext) };
22
23 is $@, '',
24 'format() should throw no warnings for text starting with newlines';
25
26 like $htmltext, qr!<li>unordered</li>!,
27 'ensure that lists followed by paragraphs are included correctly';
28
29 package Baz;
30 use Text::MediawikiFormat as => 'wf', process_html => 0;
31
32 ::can_ok( 'Baz', 'wf' );
33
34 package main;
35
36 ##
37 ## make sure tag overrides work for Kake
38 ##
39
40 $wikitext = <<WIKI;
41
42 * foo
43 ** bar
44
45 WIKI
46
47 my %format_tags = (
48 indent => qr/^(?:\t+|\s{4,}|(?=\*+))/,
49 blocks => { unordered => qr/^\s*\*+\s*/ },
50 nests => { unordered => 1 },
51 );
52
53 $htmltext = wf ($wikitext, \%format_tags);
54
55 like $htmltext, qr/<li>foo<\/li>/, "first level of unordered list";
56 like $htmltext, qr/<li>bar<\/li>/, "nested unordered lists OK";
57
58 ##
59 ## Check that blocks not in blockorder are not fatal
60 ##
61 %format_tags = (
62 blocks => {
63 definition => qr/^:\s*/
64 },
65 definition => [ "<dl>\n", "</dl>\n", '<dt><dd>', "\n" ],
66 blockorder => [ 'definition' ],
67 );
68
69 my $warning;
70 local $SIG{__WARN__} = sub { $warning = shift };
71 eval { wf ($wikitext, \%format_tags) };
72 is $@, '', 'format() should not die if a block is missing from blockorder';
73 like $warning, qr/No order specified/, '... warning instead';
74
75 my $foo = 'x';
76 $foo .= '' unless $foo =~ /x/;
77 my $html = wf ('test');
78 is $html, "<p>test</p>\n", 'successful prior match should not whomp format()';
79
80 $wikitext =<<'WIKI';
81 Here is some example code:
82
83 sub example_code
84 {
85 my ($foo) = @_;
86 my $this = call_that $foo;
87 }
88
89 Isn't it nice?
90 WIKI
91
92 $htmltext = wf ($wikitext, {blocks => {code => qr/^\t/}});
93
94 like $htmltext, qr!<pre>sub example_code[^<]+}\s*</pre>!m,
95 'pre tags should work';
96
97 like $htmltext, qr!^\tmy \(\$foo\)!m, '... not removing further indents';
98
99 $wikitext =<<WIKI;
100 CamelCase
101 CamooseCase
102 NOTCAMELCASE
103 WIKI
104
105 $htmltext = wf ($wikitext, {}, {implicit_links => 1});
106
107 like $htmltext, qr!<a href='CamelCase'>CamelCase</a>!,
108 'parse actual CamelCase words into links';
109 like $htmltext, qr!<a href='CamooseCase'>CamooseCase</a>!,
110 '... not repeating if using link as title';
111 like $htmltext, qr!^NOTCAMELCASE!m, '... but not words in all uppercase';
112
113 my @processed = Text::MediawikiFormat::_nest_blocks ([]);
114 is @processed, 0, '_nest_blocks() should not autovivify empty blocks array';
+20
-0
t/developer/0-signature.t less more
0 #!perl
1
2 use strict;
3 use warnings;
4
5 use Test::More tests => 1;
6
7 SKIP: {
8 if (eval { require Module::Signature; 1 }) {
9 ok(Module::Signature::verify() == Module::Signature::SIGNATURE_OK()
10 => "Valid signature" );
11 }
12 else {
13 diag("Next time around, consider installing Module::Signature,\n".
14 "so you can verify the integrity of this distribution.\n");
15 skip("Module::Signature not installed", 1)
16 }
17 }
18
19 __END__
+14
-0
t/developer/pod-coverage.t less more
0 #!perl -T
1
2 use lib 'lib';
3 use Test::More;
4
5 eval "use Test::Pod::Coverage 1.04";
6
7 plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage"
8 if $@;
9
10 plan tests => 2;
11
12 pod_coverage_ok ('Text::MediawikiFormat');
13 pod_coverage_ok ('Text::MediawikiFormat::Blocks');
+6
-0
t/developer/pod.t less more
0 #!perl -T
1
2 use Test::More;
3 eval "use Test::Pod 1.14";
4 plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
5 all_pod_files_ok();
+67
-0
t/embedded-links.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 4;
8 use Test::NoWarnings;
9
10 use Text::MediawikiFormat as => 'wf', process_html => 0;
11
12 my $wikitext = <<WIKI;
13
14 [[SuperLink|[[Description|Desc]] of the [[Link]]]]
15
16 WIKI
17
18 {
19 my $htmltext = wf ($wikitext);
20 is $htmltext,
21 qq{<p>[[SuperLink|<a href='Description'>Desc</a> of the }
22 . qq{<a href='Link'>Link</a>]]</p>\n},
23 '...ignore embedded links by default';
24 }
25
26 {
27 # Redefine the delimiters to something different.
28 my %tags = (extended_link_delimiters => [qw{[[ ]]}],
29 link => \&_make_html_link);
30
31 my $htmltext = wf ($wikitext, \%tags);
32 is $htmltext,
33 qq{<p><a href='SuperLink'><a href='Description'>Desc</a> of the }
34 . qq{<a href='Link'>Link</a></a></p>\n},
35 '...processing all embedded links';
36
37 sub _make_html_link
38 {
39 my ($link) = @_;
40 my ($href, $title) = split qr/\|/, $link, 2;
41 $title ||= $href;
42 return "<a href='$href'>$title</a>";
43 }
44 }
45
46 TODO:
47 {
48 # Art Henry's bug; but not sure it's really a bug
49 local $TODO = "Unsupported MediaWiki features.";
50
51 my %tags = (link => \&link_handler);
52
53 # Or with the link handler overridden.
54 my $htmltext = wf ($wikitext, \%tags);
55 is $htmltext,
56 "<p>Desc of the </p>\n",
57 '...and also work with a handler override.';
58
59 sub link_handler
60 {
61 my ($link, $opts) = @_;
62 ($link, my $title) = split /\|/, $link, 2;
63 $title ||= $link;
64 return $title;
65 }
66 }
+74
-0
t/explicit.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 14;
8 use Test::NoWarnings;
9 use Test::Warn;
10
11 use Text::MediawikiFormat as => 'wf', process_html => 0;
12
13 my $wikitext =<<WIKI;
14
15 [Ordinary extended link]
16
17 [http://nowhere.com explicit URI]
18
19 [[Usemod extended link]]
20
21 WIKI
22
23 my $htmltext = wf ($wikitext);
24 like $htmltext, qr!'Ordinary'>extended link</a>!m,
25 'extended links rendered correctly with default delimiters';
26 like $htmltext, qr!'http://nowhere\.com'>explicit URI</a>!m,
27 'explicit URIs rendered correctly with default delimiters';
28 like $htmltext, qr!Usemod%20extended%20link'>Usemod extended link</a>!m,
29 'Wiki URIs rendered correctly with default delimiters';
30
31 # Redefine the delimiters to the same thing again.
32 my %tags = (
33 extended_link_delimiters => qr/(\[(?:\[[^][]*\]|[^][]*)\])/,
34 );
35
36 $htmltext = wf ($wikitext, \%tags);
37 like $htmltext, qr!'Ordinary'>extended link</a>!m,
38 'extended links rendered correctly with default delimiters';
39 like $htmltext, qr!'http://nowhere\.com'>explicit URI</a>!m,
40 'explicit URIs rendered correctly with default delimiters';
41 like $htmltext, qr!Usemod%20extended%20link'>Usemod extended link</a>!m,
42 'Wiki URIs rendered correctly with default delimiters';
43
44 # Redefine the delimiters to something different.
45 %tags = (
46 extended_link_delimiters => [qw([ ])],
47 );
48
49 $htmltext = wf ($wikitext, \%tags);
50
51 unlike $htmltext, qr!'Ordinary'>extended link</a>!m,
52 'extended links ignored with overridden delimiters';
53 unlike $htmltext, qr!'http://nowhere\.com'>explicit URI</a>!m,
54 'explicit URIs ignored with overridden delimiters';
55 like $htmltext, qr!Usemod extended link</a>[^\]]!m,
56 '...and new delimiters recognised';
57
58 # Make sure we handle empty delimiters
59 %tags = (
60 extended_link_delimiters => '',
61 );
62
63
64 warning_like {$htmltext = wf ($wikitext, \%tags)}
65 {carped => [map {qr/^Ignoring/} (1..3)]},
66 "warn of empty extended_link_delimiters";
67
68 unlike $htmltext, qr!'Ordinary'>extended link</a>!m,
69 'extended links ignored with empty delimiters';
70 unlike $htmltext, qr!'http://nowhere\.com'>explicit URI</a>!m,
71 'explicit URIs ignored with empty delimiters';
72 unlike $htmltext, qr!Usemod extended link</a>[^\]]!m,
73 'Wiki URIs ignored with empty delimiters';
+29
-0
t/implicit.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 4;
8 use Test::NoWarnings;
9
10 use Text::MediawikiFormat as => 'wf', prefix => 'rootdir/wiki.pl?page=',
11 process_html => 0;
12
13 my $wikitext =<<WIKI;
14 StudlyCaps
15
16 WIKI
17
18 my $htmltext = wf ($wikitext);
19 unlike $htmltext, qr!<a href='rootdir/wiki\.pl\?page=StudlyCaps'>!m,
20 'should create links from StudlyCaps if implicit_links is left alone';
21
22 $htmltext = wf ($wikitext, {}, {implicit_links => 0});
23 unlike ($htmltext, qr!<a href='rootdir/wiki\.pl\?page=StudlyCaps'>!m,
24 '...and if implicit_links set to 0');
25
26 $htmltext = wf ($wikitext, {}, {implicit_links => 1});
27 like ($htmltext, qr!<a href='rootdir/wiki\.pl\?page=StudlyCaps'>!m,
28 '...and if implicit_links set to 0');
+82
-0
t/kake.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 8;
8 use Test::NoWarnings;
9
10 use Text::MediawikiFormat as => 'wikiformat', implicit_links => 1,
11 process_html => 0;
12
13 my $wikitext = "
14 WikiTest
15
16 code: foo bar baz
17
18 ";
19
20 my %format_tags = (
21 blocks => {code => qr/^code: /},
22 );
23
24 my $cooked = wikiformat ($wikitext, \%format_tags);
25 like $cooked, qr|<pre>foo bar baz\n</pre>|,
26 'unindented code markers should still work';
27
28 $wikitext = <<WIKI;
29
30 * foo
31 ** bar
32
33 WIKI
34
35 %format_tags = (
36 indent => qr/^(?:\t+|\s{4,}|\*?(?=\*+))/,
37 blocks => {unordered => qr/^\s*\*+\s*/},
38 nests => {unordered => 1},
39 );
40
41 $cooked = wikiformat $wikitext, \%format_tags;
42
43 like $cooked, qr/<li>foo/, 'first level of unordered list';
44 like $cooked, qr/<ul>.+?<li>bar<\/li>/s, 'second level of unordered list';
45
46 $wikitext = <<WIKI;
47
48 : boing
49
50 WIKI
51
52 my @blocks = @{$Text::MediawikiFormat::tags{blockorder}};
53 %format_tags = (
54 blocks => {definition => qr/^:\s*/},
55 indented => {definition => 0},
56 definition => ["<dl>\n", "</dl>\n", "<dt><dd>", "\n"],
57 blockorder => ['definition', @blocks],
58 );
59
60 $cooked = wikiformat $wikitext, \%format_tags;
61 like $cooked, qr/<dt><dd>boing/, 'definition list works';
62
63 $wikitext =<<WIKITEXT;
64
65 ==== Welcome ====
66
67 ==== LinkInAHeader ====
68
69 ==== Header with an = in ====
70
71 WIKITEXT
72
73 $ENV{SHOW} = 1;
74 $cooked = wikiformat $wikitext, {unformatted_blocks => [qw(code nowiki pre)]},
75 {prefix => 'wiki.pl?', implicit_links => 1};
76
77 like $cooked, qr|<h4>Welcome</h4>|, 'headings work';
78 like $cooked,
79 qr|<h4><a href='wiki.pl\?LinkInAHeader'>LinkInAHeader</a></h4>|,
80 '... links work in headers';
81 like $cooked, qr|<h4>Header with an = in</h4>|, '...headers may contain =';
+134
-0
t/lists-nested.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 9;
8 use Test::NoWarnings;
9
10 use_ok 'Text::MediawikiFormat', as => 'wf', process_html => 0 or exit;
11
12 my $wikitext =<<END_HERE;
13 * start of list
14 * second line
15 ** indented list
16 * now back to the first
17 END_HERE
18
19 my $htmltext = wf ($wikitext);
20 like $htmltext, qr|second line<ul>.*?<li>indented|s,
21 'nested lists should start correctly';
22 like $htmltext, qr|indented list.*?</li>.*?</ul>|s,
23 '... and end correctly';
24
25 $wikitext =<<END_HERE;
26 * 1
27 * 2
28 ** 2.1
29 *** 2.1.1
30 * 3
31
32 * 4
33 ** 4.1
34 *** 4.1.1
35 *** 4.1.2
36 * 5
37 END_HERE
38
39 $htmltext = wf ($wikitext);
40
41 like $htmltext,
42 qr|<ul>\s*
43 <li>1</li>\s*
44 <li>2<ul>\s*
45 <li>2\.1<ul>\s*
46 <li>2\.1\.1</li>\s*
47 </ul>\s*
48 </li>\s*
49 </ul>\s*
50 </li>\s*
51 <li>3</li>\s*
52 </ul>\s*
53 <ul>\s*
54 <li>4<ul>\s*
55 <li>4\.1<ul>\s*
56 <li>4\.1\.1</li>\s*
57 <li>4\.1\.2</li>\s*
58 </ul>\s*
59 </li>\s*
60 </ul>\s*
61 </li>\s*
62 <li>5</li>\s*
63 </ul>|sx,
64 'nesting should be correct for multiple levels';
65 like $htmltext, qr|<li>4<|s,
66 'spaces should work instead of tabs';
67 like $htmltext,
68 qr|<li>4<ul>\s*<li>4.1<ul>\s*<li>4.1.1</li>\s*<li>4.1.2</li>\s*</ul>
69 \s*</li>|sx,
70 'nesting should be correct for spaces too';
71
72
73 TODO: {
74 local $TODO = 'Dictionary lists not nesting correctly.';
75
76 ###
77 ### Dictionary Lists
78 ###
79 $wikitext =<<END_HERE;
80 ; Term 1
81 : Def 1.1
82 :; Term 1.1.1 : Def 1.1.1.1
83 :; Term 1.1.2 : Def 1.1.2.1
84 :: Def 1.1.2.2
85 :; Term 1.1.3
86 :: Def 1.1.3.1
87 ::; Term 1.1.3.1.1 : Def 1.1.3.1.1.1
88 ; Term 2
89 : Def 2.1
90 : Def 2.2
91 :; Term 2.2.1 : Def 2.2.1.1
92 ; Term 3 : Def 3.1
93 END_HERE
94
95 $htmltext = wf ($wikitext);
96
97 is $htmltext, '', 'dictionary lists nest correctly';
98
99 $wikitext =<<END_HERE;
100 ; A
101 : A.a
102 :# A.a.1
103 :## A.a.1.1
104 :# A.a.2
105 :#* A.a.2.*
106 :#* A.a.2.*
107 :#*# A.a.2.*.1
108 : A.b
109 END_HERE
110
111 $htmltext = wf ($wikitext);
112
113 is $htmltext, '<dl>
114 <dt>A</dt>
115 <dd>A.a</dd>
116 <ol>
117 <li>A.a.1<ol>
118 <li>A.a.1.1</li>
119 </ol>
120 </li>
121 <li>A.a.2<ul>
122 <li>A.a.2.*</li>
123 <li>A.a.2.*<ol>
124 <li>A.a.2.*.1</li>
125 </ol>
126 </li>
127 </ul>
128 </li>
129 </ol>
130 <dd>A.b</dd>
131 </dl>
132 ', 'lists nest correctly within dictionary lists';
133 };
+79
-0
t/lists-no-indent.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 8;
8 use Test::NoWarnings;
9
10 use Text::MediawikiFormat as => 'wf', process_html => 0;
11
12 my $wikitext =<<WIKI;
13
14 * This should be a list.
15
16 # This should be an ordered list.
17
18 ** This is like the default unordered list
19 ** But not indented
20
21 ! This is like the default unordered list
22 ! But marked differently
23
24 ## This is like the default ordered list
25 ## But not indented
26
27 WIKI
28
29 my $htmltext = wf ($wikitext);
30 like $htmltext, qr!<li>This should be a list.</li>!m,
31 'unordered lists should render correctly';
32 like $htmltext, qr!<li>This should be an ordered list.</li>!m,
33 '...ordered lists too';
34
35 # Redefine all the list regexps to what they were to start with.
36 my %tags = (
37 lists => {
38 ordered => qr/^#\s*/,
39 unordered => qr/^\*\s*/,
40 code => qr/^ /,
41 },
42 );
43
44 $htmltext = wf ($wikitext, \%tags);
45 like $htmltext, qr!<li>This should be a list.</li>!m,
46 'unordered should remain okay when we redefine all list regexps';
47 like $htmltext, qr!<li>This should be an ordered list.</li>!m,
48 '...ordered lists too';
49
50 # Redefine again, set one of them to something different.
51 %tags = (
52 blocks => {
53 ordered => qr/^#\s*/,
54 unordered => qr/^!\s*/,
55 code => qr/^ /,
56 },
57 );
58
59 $htmltext = wf ($wikitext, \%tags);
60 like $htmltext, qr!<li>But marked differently</li>!m,
61 'unordered should still work when redefined';
62 like $htmltext, qr!<li>This should be an ordered list.</li>!m,
63 '...ordered should be unaffected';
64
65 # Now try it without requiring an indent.
66 %tags = (
67 indent => qr/^\s*/,
68 blocks => {
69 ordered => qr/^#\s*/,
70 unordered => qr/^\*\s*/,
71 code => qr/^ /,
72 },
73 indented => {unordered => 0},
74 );
75
76 $htmltext = wf ($wikitext, \%tags);
77 like $htmltext, qr!<li># But not indented!m,
78 'redefining a list type to require no indent should work';
+65
-0
t/lists.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 8;
8 use Test::NoWarnings;
9
10 use_ok 'Text::MediawikiFormat', as => 'wf', process_html => 0 or exit;
11 ok exists $Text::MediawikiFormat::tags{blockorder},
12 'T:MF should have a blockorder entry in %tags';
13
14 # isan ARRAY
15 isa_ok $Text::MediawikiFormat::tags{blockorder}, 'ARRAY',
16 '...and it should be an array';
17
18 like join(' ', @{$Text::MediawikiFormat::tags{blockorder}}),
19 qr/^code/,
20 '...and code should come before everything';
21
22 my $wikitext =<<END_HERE;
23 * first list item
24 * second list item
25 * list item with a [[Wiki Link]]
26 END_HERE
27
28 my $htmltext = wf ($wikitext);
29
30 like $htmltext, qr!<li>first list item!,
31 'lists should be able to start on the first line of text';
32 like $htmltext, qr!href='Wiki%20Link'!,
33 'list item content should be formatted';
34
35 ###
36 ### Dictionary Lists
37 ###
38 $wikitext =<<END_HERE;
39 ; Term 1 : definition 1.1
40 : definition 1.2
41 ; Term 2
42 : definition 2.1
43 : definition 2.2
44
45 : indented 1
46 : indented 2
47 END_HERE
48
49 $htmltext = wf ($wikitext);
50
51 is $htmltext, '<dl>
52 <dt>Term 1</dt>
53 <dd>definition 1.1</dd>
54 <dd>definition 1.2</dd>
55 <dt>Term 2</dt>
56 <dd>definition 2.1</dd>
57 <dd>definition 2.2</dd>
58 </dl>
59 <dl>
60 <dd>indented 1</dd>
61 <dd>indented 2</dd>
62 </dl>
63 ',
64 'dictionary lists format correctly';
+45
-0
t/merge-hash.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 9;
8 use Test::NoWarnings;
9
10 use_ok( 'Text::MediawikiFormat' ) or exit;
11
12 my $full = { foo => { bar => 'baz' } };
13 my $empty = {};
14 my $nonempty = { foo => { a => 'b' } };
15 my $full_flat = { a => 'b' };
16 my $empty_flat = {};
17 my $zero = { foo => 0, bar => { baz => 0 } };
18
19 $nonempty = Text::MediawikiFormat::_merge_hashes ($full, $nonempty);
20 is_deeply $nonempty, {foo => {a => 'b', bar => 'baz'}},
21 "merge should work when all keys in from exist in to";
22 $full->{foo}->{bar} = 'boo';
23 is_deeply $nonempty, {foo => {a => 'b', bar => 'baz'}},
24 "merge should copy subhashes";
25
26 $empty_flat = Text::MediawikiFormat::_merge_hashes ($full_flat, $empty_flat);
27 is_deeply $empty_flat, $full_flat,
28 '... in flat case when keys exist in from but not in to';
29
30 $empty = Text::MediawikiFormat::_merge_hashes ($full, $empty);
31 is_deeply $empty, $full,
32 '... in non-flat case when keys exist in but not in to';
33
34 $empty = {};
35 $empty = Text::MediawikiFormat::_merge_hashes ($zero, $empty);
36 is_deeply $empty, $zero, '...and when value is zero but defined';
37
38 my $regexer = {a => "regex"};
39 my $arrayer = {a => ["X", "Y", "Z"]};
40 my $merged;
41 $merged = Text::MediawikiFormat::_merge_hashes ($regexer, $arrayer);
42 is_deeply $merged, {a => "regex"}, "regexes should replace arrays";
43 $merged = Text::MediawikiFormat::_merge_hashes ($arrayer, $regexer);
44 is_deeply $merged, {a => ["X", "Y", "Z"]}, "...and vice versa";
+44
-0
t/tag-override-use-as.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 3;
8 use Test::NoWarnings;
9
10 use Text::MediawikiFormat as => 'wf', process_html => 0;
11
12 my $wikitext =<<WIKI;
13
14 * This should be a list.
15
16 # This should be an ordered list.
17
18 ** This is like the default unordered list
19 ** But not indented
20
21 ! This is like the default unordered list
22 ! But marked differently
23
24 WIKI
25
26 my %format_tags = (blocks => {unordered => qr/^!\s*/});
27
28 my $htmltext = wf ($wikitext, \%format_tags);
29 like ($htmltext, qr!<li>But marked differently</li>!m,
30 'redefining a list type works with use as');
31
32 %format_tags = (
33 indent => qr//,
34 blocks => {
35 ordered => qr/^#\s*/,
36 unordered => qr/^\*\s*/
37 },
38 indented => {unordered => 0},
39 );
40
41 $htmltext = wf ($wikitext, \%format_tags);
42 like ($htmltext, qr!<li>\* But not indented!m,
43 'redefining a list type to require no indent works with use as');
+101
-0
t/tag-override.t less more
0 #!perl
1
2 BEGIN { chdir 't' if -d 't' }
3
4 use strict;
5 use warnings;
6
7 use Test::More tests => 14;
8 use Test::NoWarnings;
9
10 use Text::MediawikiFormat as => 'wf', process_html => 0;
11
12 my $wikitext =<<WIKI;
13
14 * This should be a list.
15
16 # This should be an ordered list.
17
18 ! This is like the default unordered list
19 ! But marked differently
20
21 WIKI
22
23 my $htmltext = wf ($wikitext);
24 like ($htmltext, qr!<li>This should be a list.</li>!m,
25 'unordered lists should be rendered correctly');
26 like ($htmltext, qr!<li>This should be an ordered list.</li>!m,
27 '...and ordered lists too');
28
29 # Redefine all the list regexps to what they were to start with.
30 my %tags = (
31 blocks => {
32 ordered => qr/^#\s*/,
33 unordered => qr/^\*\s*/,
34 code => qr/^ /,
35 },
36 );
37
38 $htmltext = wf ($wikitext, \%tags);
39 like ($htmltext, qr!<li>This should be a list.</li>!m,
40 'unordered should remain okay when we redefine all list regexps');
41 like ($htmltext, qr!<li>This should be an ordered list.</li>!m,
42 '... and so should ordered');
43
44 # Redefine again, set one of them to something different.
45 %tags = (
46 blocks => {
47 ordered => qr/^#\s*/,
48 unordered => qr/^!\s*/,
49 code => qr/^ /,
50 },
51 );
52
53 $htmltext = wf ($wikitext, \%tags);
54 like ($htmltext, qr!<li>But marked differently</li>!m,
55 'unordered should still work when redefined');
56 like ($htmltext, qr!<li>This should be an ordered list.</li>!m,
57 '...and ordered should be unaffected');
58
59 # Now try redefining just one list type.
60 %tags = (
61 blocks => {unordered => qr/^!\s*/},
62 );
63
64 $htmltext = wf ($wikitext, \%tags);
65 like ($htmltext, qr!<li>This is like the default unordered list</li>!m,
66 'redefining just one list type should work for that type');
67 like ($htmltext, qr!<li>This should be an ordered list.</li>!m,
68 '...and should not affect other types too');
69
70 # now test overriding strong and emphasized tags
71 # don't use // to mark emphasized tags unless you /like/ this lookbehind
72 %tags = (
73 strong_tag => qr/\*(.+?)\*/,
74 emphasized_tag => qr|(?<!<)/(.+?)/|,
75 );
76
77 $wikitext = 'this is *strong*, /emphasized/, and */emphasized strong/*';
78 $htmltext = wf ($wikitext, \%tags);
79
80 like( $htmltext, qr!<strong>strong</strong>!, '... overriding strong tag' );
81 like( $htmltext, qr!<em>emphasized</em>!, '... overriding emphasized tag' );
82 like( $htmltext, qr!<strong><em>em.+ng</em></strong>!,
83 '... and both at once' );
84
85 # Test redefining just one list type after using import with a list definition.
86 package Bar;
87 Text::MediawikiFormat->import(
88 as => 'wf',
89 blocks => {
90 unordered => qr/^!\s*/
91 },
92 process_html => 0,
93 );
94
95 $htmltext = wf ("!1. Ordered list\n! Unordered list",
96 {blocks => {ordered => qr/^\s*!([\d]+)\.\s*/}}, {});
97 ::like ($htmltext, qr!<li>Ordered list</li>!m,
98 'redefining a single list type after import should work for that type');
99 ::like ($htmltext, qr!<li>Unordered list</li>!m,
100 '...and also for a different type defined on import');