• R/O
  • HTTP
  • SSH
  • HTTPS

fswiki-lite: Commit

FSWikiLite


Commit MetaInfo

Revisiona417171bf4b28dc2e0901a3deec723cb779eabe5 (tree)
Time2017-12-07 22:46:59
Authorkgsoft <kgsoft@871d...>
Commiterkgsoft

Log Message

改行コードをLFに統一。

Change Summary

Incremental Difference

--- a/category.cgi
+++ b/category.cgi
@@ -1,39 +1,39 @@
1-#!/usr/bin/perl
2-################################################################################
3-#
4-# FSWiki Lite - カテゴリの一覧
5-#
6-################################################################################
7-require "./lib/common.pl";
8-#===============================================================================
9-# 処理の振り分け
10-#===============================================================================
11-&ReadParse();
12-if($in{'c'} ne ""){
13- &show_category($in{'c'});
14-
15-} else {
16- &show_all_category();
17-
18-}
19-
20-#===============================================================================
21-# 指定されたカテゴリを表示
22-#===============================================================================
23-sub show_category {
24- my $category = shift;
25-
26- &print_header("カテゴリ");
27- print &Wiki::Plugin::category_list($category);
28- &print_footer();
29-}
30-
31-#===============================================================================
32-# 全てのカテゴリを表示
33-#===============================================================================
34-sub show_all_category {
35- &print_header("カテゴリ");
36- print "<h2>".&Util::escapeHTML($category)."</h2>\n";
37- print &Wiki::Plugin::category_list();
38- &print_footer();
39-}
1+#!/usr/bin/perl
2+################################################################################
3+#
4+# FSWiki Lite - カテゴリの一覧
5+#
6+################################################################################
7+require "./lib/common.pl";
8+#===============================================================================
9+# 処理の振り分け
10+#===============================================================================
11+&ReadParse();
12+if($in{'c'} ne ""){
13+ &show_category($in{'c'});
14+
15+} else {
16+ &show_all_category();
17+
18+}
19+
20+#===============================================================================
21+# 指定されたカテゴリを表示
22+#===============================================================================
23+sub show_category {
24+ my $category = shift;
25+
26+ &print_header("カテゴリ");
27+ print &Wiki::Plugin::category_list($category);
28+ &print_footer();
29+}
30+
31+#===============================================================================
32+# 全てのカテゴリを表示
33+#===============================================================================
34+sub show_all_category {
35+ &print_header("カテゴリ");
36+ print "<h2>".&Util::escapeHTML($category)."</h2>\n";
37+ print &Wiki::Plugin::category_list();
38+ &print_footer();
39+}
--- a/docs/default.css
+++ b/docs/default.css
@@ -1,124 +1,124 @@
1-body {
2- background-color: #FFFFFF;
3- color : #000000;
4- font-family : Verdana,Arial,Helvetica,sans-serif;
5-}
6-
7-p.adminmenu {
8- text-align : right;
9- padding-bottom : 5px;
10- margin-bottom : 5px;
11- border-bottom : #000088 1px dotted;
12- font-size : 80%;
13- text-indent : 10px;
14-}
15-
16-.footer {
17- border-top : #000088 1px dotted;
18- margin-top : 20px;
19- padding-top : 5px;
20- text-align : right;
21- font-size : 80%;
22- font-style : italic;
23-}
24-
25-hr {
26- color : #FFFFFF;
27-}
28-
29-pre {
30- border : #888888 1px solid;
31- padding : 4px;
32- margin-left : 40px;
33-}
34-
35-p {
36- padding-left : 20pt;
37-}
38-
39-strong {
40- font-weight : normal;
41-}
42-
43-h1 {
44- background-color : #FFFFFF;
45- border-bottom : #AABBFF 1px solid;
46- font-family : Verdana,Arial,Helvetica,sans-serif;
47- padding-left : 4pt;
48-}
49-
50-
51-h2 {
52- background-color : #AABBFF;
53- font-family : Verdana,Arial,Helvetica,sans-serif;
54- padding-left : 4pt;
55-}
56-
57-h3 {
58- border-left : #AABBFF 10px solid;
59- border-top : #AABBFF 5px solid;
60- border-right : #AABBFF 1px solid;
61- border-bottom : #AABBFF 1px solid;
62- font-family : Verdana,Arial,Helvetica,sans-serif;
63- font-size : 100%;
64- padding-left : 4pt;
65-}
66-
67-h4 {
68- border-left : #AABBFF 10px solid;
69- padding-left : 4px;
70- font-family : Verdana,Arial,Helvetica,sans-serif;
71- padding-left : 4pt;
72-}
73-
74-table {
75- border : #888888 2px solid;
76-}
77-
78-th {
79- border : #888888 1px solid;
80- background-color : #88AAFF;
81-}
82-
83-td {
84- border : #888888 1px solid;
85-}
86-
87-A:link {
88- color : #4444FF;
89- text-decoration : none;
90-}
91-A:visited {
92- color : #4444FF;
93- text-decoration : none;
94-}
95-A:hover {
96- color : #FF4444;
97- text-decoration : underline;
98-}
99-
100-div.main {
101- margin-left: 20%;
102-}
103-
104-div.sidebar {
105- position : absolute;
106- top : 0px;
107- left : 0px;
108- width : 20%;
109- font-size : x-small;
110- padding: 2px 2px 100% 2px;
111- border-style: solid;
112- border-color: #CCCCFF;
113- border-width: 2px;
114- color : #000000;
115- background-color: #EEEEFF;
116-}
117-
118-div.comment {
119- margin-top : 10px;
120- margin-bottom : 10px;
121- background-color : DDDDFF;
122- border : AAAAFF 2px solid;
123- font-size : 80%;
124-}
1+body {
2+ background-color: #FFFFFF;
3+ color : #000000;
4+ font-family : Verdana,Arial,Helvetica,sans-serif;
5+}
6+
7+p.adminmenu {
8+ text-align : right;
9+ padding-bottom : 5px;
10+ margin-bottom : 5px;
11+ border-bottom : #000088 1px dotted;
12+ font-size : 80%;
13+ text-indent : 10px;
14+}
15+
16+.footer {
17+ border-top : #000088 1px dotted;
18+ margin-top : 20px;
19+ padding-top : 5px;
20+ text-align : right;
21+ font-size : 80%;
22+ font-style : italic;
23+}
24+
25+hr {
26+ color : #FFFFFF;
27+}
28+
29+pre {
30+ border : #888888 1px solid;
31+ padding : 4px;
32+ margin-left : 40px;
33+}
34+
35+p {
36+ padding-left : 20pt;
37+}
38+
39+strong {
40+ font-weight : normal;
41+}
42+
43+h1 {
44+ background-color : #FFFFFF;
45+ border-bottom : #AABBFF 1px solid;
46+ font-family : Verdana,Arial,Helvetica,sans-serif;
47+ padding-left : 4pt;
48+}
49+
50+
51+h2 {
52+ background-color : #AABBFF;
53+ font-family : Verdana,Arial,Helvetica,sans-serif;
54+ padding-left : 4pt;
55+}
56+
57+h3 {
58+ border-left : #AABBFF 10px solid;
59+ border-top : #AABBFF 5px solid;
60+ border-right : #AABBFF 1px solid;
61+ border-bottom : #AABBFF 1px solid;
62+ font-family : Verdana,Arial,Helvetica,sans-serif;
63+ font-size : 100%;
64+ padding-left : 4pt;
65+}
66+
67+h4 {
68+ border-left : #AABBFF 10px solid;
69+ padding-left : 4px;
70+ font-family : Verdana,Arial,Helvetica,sans-serif;
71+ padding-left : 4pt;
72+}
73+
74+table {
75+ border : #888888 2px solid;
76+}
77+
78+th {
79+ border : #888888 1px solid;
80+ background-color : #88AAFF;
81+}
82+
83+td {
84+ border : #888888 1px solid;
85+}
86+
87+A:link {
88+ color : #4444FF;
89+ text-decoration : none;
90+}
91+A:visited {
92+ color : #4444FF;
93+ text-decoration : none;
94+}
95+A:hover {
96+ color : #FF4444;
97+ text-decoration : underline;
98+}
99+
100+div.main {
101+ margin-left: 20%;
102+}
103+
104+div.sidebar {
105+ position : absolute;
106+ top : 0px;
107+ left : 0px;
108+ width : 20%;
109+ font-size : x-small;
110+ padding: 2px 2px 100% 2px;
111+ border-style: solid;
112+ border-color: #CCCCFF;
113+ border-width: 2px;
114+ color : #000000;
115+ background-color: #EEEEFF;
116+}
117+
118+div.comment {
119+ margin-top : 10px;
120+ margin-bottom : 10px;
121+ background-color : DDDDFF;
122+ border : AAAAFF 2px solid;
123+ font-size : 80%;
124+}
--- a/docs/gpl.txt
+++ b/docs/gpl.txt
@@ -1,340 +1,340 @@
1- GNU GENERAL PUBLIC LICENSE
2- Version 2, June 1991
3-
4- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
5- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
6- Everyone is permitted to copy and distribute verbatim copies
7- of this license document, but changing it is not allowed.
8-
9- Preamble
10-
11- The licenses for most software are designed to take away your
12-freedom to share and change it. By contrast, the GNU General Public
13-License is intended to guarantee your freedom to share and change free
14-software--to make sure the software is free for all its users. This
15-General Public License applies to most of the Free Software
16-Foundation's software and to any other program whose authors commit to
17-using it. (Some other Free Software Foundation software is covered by
18-the GNU Library General Public License instead.) You can apply it to
19-your programs, too.
20-
21- When we speak of free software, we are referring to freedom, not
22-price. Our General Public Licenses are designed to make sure that you
23-have the freedom to distribute copies of free software (and charge for
24-this service if you wish), that you receive source code or can get it
25-if you want it, that you can change the software or use pieces of it
26-in new free programs; and that you know you can do these things.
27-
28- To protect your rights, we need to make restrictions that forbid
29-anyone to deny you these rights or to ask you to surrender the rights.
30-These restrictions translate to certain responsibilities for you if you
31-distribute copies of the software, or if you modify it.
32-
33- For example, if you distribute copies of such a program, whether
34-gratis or for a fee, you must give the recipients all the rights that
35-you have. You must make sure that they, too, receive or can get the
36-source code. And you must show them these terms so they know their
37-rights.
38-
39- We protect your rights with two steps: (1) copyright the software, and
40-(2) offer you this license which gives you legal permission to copy,
41-distribute and/or modify the software.
42-
43- Also, for each author's protection and ours, we want to make certain
44-that everyone understands that there is no warranty for this free
45-software. If the software is modified by someone else and passed on, we
46-want its recipients to know that what they have is not the original, so
47-that any problems introduced by others will not reflect on the original
48-authors' reputations.
49-
50- Finally, any free program is threatened constantly by software
51-patents. We wish to avoid the danger that redistributors of a free
52-program will individually obtain patent licenses, in effect making the
53-program proprietary. To prevent this, we have made it clear that any
54-patent must be licensed for everyone's free use or not licensed at all.
55-
56- The precise terms and conditions for copying, distribution and
57-modification follow.
58-
59- GNU GENERAL PUBLIC LICENSE
60- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
61-
62- 0. This License applies to any program or other work which contains
63-a notice placed by the copyright holder saying it may be distributed
64-under the terms of this General Public License. The "Program", below,
65-refers to any such program or work, and a "work based on the Program"
66-means either the Program or any derivative work under copyright law:
67-that is to say, a work containing the Program or a portion of it,
68-either verbatim or with modifications and/or translated into another
69-language. (Hereinafter, translation is included without limitation in
70-the term "modification".) Each licensee is addressed as "you".
71-
72-Activities other than copying, distribution and modification are not
73-covered by this License; they are outside its scope. The act of
74-running the Program is not restricted, and the output from the Program
75-is covered only if its contents constitute a work based on the
76-Program (independent of having been made by running the Program).
77-Whether that is true depends on what the Program does.
78-
79- 1. You may copy and distribute verbatim copies of the Program's
80-source code as you receive it, in any medium, provided that you
81-conspicuously and appropriately publish on each copy an appropriate
82-copyright notice and disclaimer of warranty; keep intact all the
83-notices that refer to this License and to the absence of any warranty;
84-and give any other recipients of the Program a copy of this License
85-along with the Program.
86-
87-You may charge a fee for the physical act of transferring a copy, and
88-you may at your option offer warranty protection in exchange for a fee.
89-
90- 2. You may modify your copy or copies of the Program or any portion
91-of it, thus forming a work based on the Program, and copy and
92-distribute such modifications or work under the terms of Section 1
93-above, provided that you also meet all of these conditions:
94-
95- a) You must cause the modified files to carry prominent notices
96- stating that you changed the files and the date of any change.
97-
98- b) You must cause any work that you distribute or publish, that in
99- whole or in part contains or is derived from the Program or any
100- part thereof, to be licensed as a whole at no charge to all third
101- parties under the terms of this License.
102-
103- c) If the modified program normally reads commands interactively
104- when run, you must cause it, when started running for such
105- interactive use in the most ordinary way, to print or display an
106- announcement including an appropriate copyright notice and a
107- notice that there is no warranty (or else, saying that you provide
108- a warranty) and that users may redistribute the program under
109- these conditions, and telling the user how to view a copy of this
110- License. (Exception: if the Program itself is interactive but
111- does not normally print such an announcement, your work based on
112- the Program is not required to print an announcement.)
113-
114-These requirements apply to the modified work as a whole. If
115-identifiable sections of that work are not derived from the Program,
116-and can be reasonably considered independent and separate works in
117-themselves, then this License, and its terms, do not apply to those
118-sections when you distribute them as separate works. But when you
119-distribute the same sections as part of a whole which is a work based
120-on the Program, the distribution of the whole must be on the terms of
121-this License, whose permissions for other licensees extend to the
122-entire whole, and thus to each and every part regardless of who wrote it.
123-
124-Thus, it is not the intent of this section to claim rights or contest
125-your rights to work written entirely by you; rather, the intent is to
126-exercise the right to control the distribution of derivative or
127-collective works based on the Program.
128-
129-In addition, mere aggregation of another work not based on the Program
130-with the Program (or with a work based on the Program) on a volume of
131-a storage or distribution medium does not bring the other work under
132-the scope of this License.
133-
134- 3. You may copy and distribute the Program (or a work based on it,
135-under Section 2) in object code or executable form under the terms of
136-Sections 1 and 2 above provided that you also do one of the following:
137-
138- a) Accompany it with the complete corresponding machine-readable
139- source code, which must be distributed under the terms of Sections
140- 1 and 2 above on a medium customarily used for software interchange; or,
141-
142- b) Accompany it with a written offer, valid for at least three
143- years, to give any third party, for a charge no more than your
144- cost of physically performing source distribution, a complete
145- machine-readable copy of the corresponding source code, to be
146- distributed under the terms of Sections 1 and 2 above on a medium
147- customarily used for software interchange; or,
148-
149- c) Accompany it with the information you received as to the offer
150- to distribute corresponding source code. (This alternative is
151- allowed only for noncommercial distribution and only if you
152- received the program in object code or executable form with such
153- an offer, in accord with Subsection b above.)
154-
155-The source code for a work means the preferred form of the work for
156-making modifications to it. For an executable work, complete source
157-code means all the source code for all modules it contains, plus any
158-associated interface definition files, plus the scripts used to
159-control compilation and installation of the executable. However, as a
160-special exception, the source code distributed need not include
161-anything that is normally distributed (in either source or binary
162-form) with the major components (compiler, kernel, and so on) of the
163-operating system on which the executable runs, unless that component
164-itself accompanies the executable.
165-
166-If distribution of executable or object code is made by offering
167-access to copy from a designated place, then offering equivalent
168-access to copy the source code from the same place counts as
169-distribution of the source code, even though third parties are not
170-compelled to copy the source along with the object code.
171-
172- 4. You may not copy, modify, sublicense, or distribute the Program
173-except as expressly provided under this License. Any attempt
174-otherwise to copy, modify, sublicense or distribute the Program is
175-void, and will automatically terminate your rights under this License.
176-However, parties who have received copies, or rights, from you under
177-this License will not have their licenses terminated so long as such
178-parties remain in full compliance.
179-
180- 5. You are not required to accept this License, since you have not
181-signed it. However, nothing else grants you permission to modify or
182-distribute the Program or its derivative works. These actions are
183-prohibited by law if you do not accept this License. Therefore, by
184-modifying or distributing the Program (or any work based on the
185-Program), you indicate your acceptance of this License to do so, and
186-all its terms and conditions for copying, distributing or modifying
187-the Program or works based on it.
188-
189- 6. Each time you redistribute the Program (or any work based on the
190-Program), the recipient automatically receives a license from the
191-original licensor to copy, distribute or modify the Program subject to
192-these terms and conditions. You may not impose any further
193-restrictions on the recipients' exercise of the rights granted herein.
194-You are not responsible for enforcing compliance by third parties to
195-this License.
196-
197- 7. If, as a consequence of a court judgment or allegation of patent
198-infringement or for any other reason (not limited to patent issues),
199-conditions are imposed on you (whether by court order, agreement or
200-otherwise) that contradict the conditions of this License, they do not
201-excuse you from the conditions of this License. If you cannot
202-distribute so as to satisfy simultaneously your obligations under this
203-License and any other pertinent obligations, then as a consequence you
204-may not distribute the Program at all. For example, if a patent
205-license would not permit royalty-free redistribution of the Program by
206-all those who receive copies directly or indirectly through you, then
207-the only way you could satisfy both it and this License would be to
208-refrain entirely from distribution of the Program.
209-
210-If any portion of this section is held invalid or unenforceable under
211-any particular circumstance, the balance of the section is intended to
212-apply and the section as a whole is intended to apply in other
213-circumstances.
214-
215-It is not the purpose of this section to induce you to infringe any
216-patents or other property right claims or to contest validity of any
217-such claims; this section has the sole purpose of protecting the
218-integrity of the free software distribution system, which is
219-implemented by public license practices. Many people have made
220-generous contributions to the wide range of software distributed
221-through that system in reliance on consistent application of that
222-system; it is up to the author/donor to decide if he or she is willing
223-to distribute software through any other system and a licensee cannot
224-impose that choice.
225-
226-This section is intended to make thoroughly clear what is believed to
227-be a consequence of the rest of this License.
228-
229- 8. If the distribution and/or use of the Program is restricted in
230-certain countries either by patents or by copyrighted interfaces, the
231-original copyright holder who places the Program under this License
232-may add an explicit geographical distribution limitation excluding
233-those countries, so that distribution is permitted only in or among
234-countries not thus excluded. In such case, this License incorporates
235-the limitation as if written in the body of this License.
236-
237- 9. The Free Software Foundation may publish revised and/or new versions
238-of the General Public License from time to time. Such new versions will
239-be similar in spirit to the present version, but may differ in detail to
240-address new problems or concerns.
241-
242-Each version is given a distinguishing version number. If the Program
243-specifies a version number of this License which applies to it and "any
244-later version", you have the option of following the terms and conditions
245-either of that version or of any later version published by the Free
246-Software Foundation. If the Program does not specify a version number of
247-this License, you may choose any version ever published by the Free Software
248-Foundation.
249-
250- 10. If you wish to incorporate parts of the Program into other free
251-programs whose distribution conditions are different, write to the author
252-to ask for permission. For software which is copyrighted by the Free
253-Software Foundation, write to the Free Software Foundation; we sometimes
254-make exceptions for this. Our decision will be guided by the two goals
255-of preserving the free status of all derivatives of our free software and
256-of promoting the sharing and reuse of software generally.
257-
258- NO WARRANTY
259-
260- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
261-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
262-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
263-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
264-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
265-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
266-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
267-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
268-REPAIR OR CORRECTION.
269-
270- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
271-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
272-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
273-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
274-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
275-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
276-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
277-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
278-POSSIBILITY OF SUCH DAMAGES.
279-
280- END OF TERMS AND CONDITIONS
281-
282- How to Apply These Terms to Your New Programs
283-
284- If you develop a new program, and you want it to be of the greatest
285-possible use to the public, the best way to achieve this is to make it
286-free software which everyone can redistribute and change under these terms.
287-
288- To do so, attach the following notices to the program. It is safest
289-to attach them to the start of each source file to most effectively
290-convey the exclusion of warranty; and each file should have at least
291-the "copyright" line and a pointer to where the full notice is found.
292-
293- <one line to give the program's name and a brief idea of what it does.>
294- Copyright (C) <year> <name of author>
295-
296- This program is free software; you can redistribute it and/or modify
297- it under the terms of the GNU General Public License as published by
298- the Free Software Foundation; either version 2 of the License, or
299- (at your option) any later version.
300-
301- This program is distributed in the hope that it will be useful,
302- but WITHOUT ANY WARRANTY; without even the implied warranty of
303- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
304- GNU General Public License for more details.
305-
306- You should have received a copy of the GNU General Public License
307- along with this program; if not, write to the Free Software
308- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
309-
310-
311-Also add information on how to contact you by electronic and paper mail.
312-
313-If the program is interactive, make it output a short notice like this
314-when it starts in an interactive mode:
315-
316- Gnomovision version 69, Copyright (C) year name of author
317- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
318- This is free software, and you are welcome to redistribute it
319- under certain conditions; type `show c' for details.
320-
321-The hypothetical commands `show w' and `show c' should show the appropriate
322-parts of the General Public License. Of course, the commands you use may
323-be called something other than `show w' and `show c'; they could even be
324-mouse-clicks or menu items--whatever suits your program.
325-
326-You should also get your employer (if you work as a programmer) or your
327-school, if any, to sign a "copyright disclaimer" for the program, if
328-necessary. Here is a sample; alter the names:
329-
330- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
331- `Gnomovision' (which makes passes at compilers) written by James Hacker.
332-
333- <signature of Ty Coon>, 1 April 1989
334- Ty Coon, President of Vice
335-
336-This General Public License does not permit incorporating your program into
337-proprietary programs. If your program is a subroutine library, you may
338-consider it more useful to permit linking proprietary applications with the
339-library. If this is what you want to do, use the GNU Library General
340-Public License instead of this License.
1+ GNU GENERAL PUBLIC LICENSE
2+ Version 2, June 1991
3+
4+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
5+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
6+ Everyone is permitted to copy and distribute verbatim copies
7+ of this license document, but changing it is not allowed.
8+
9+ Preamble
10+
11+ The licenses for most software are designed to take away your
12+freedom to share and change it. By contrast, the GNU General Public
13+License is intended to guarantee your freedom to share and change free
14+software--to make sure the software is free for all its users. This
15+General Public License applies to most of the Free Software
16+Foundation's software and to any other program whose authors commit to
17+using it. (Some other Free Software Foundation software is covered by
18+the GNU Library General Public License instead.) You can apply it to
19+your programs, too.
20+
21+ When we speak of free software, we are referring to freedom, not
22+price. Our General Public Licenses are designed to make sure that you
23+have the freedom to distribute copies of free software (and charge for
24+this service if you wish), that you receive source code or can get it
25+if you want it, that you can change the software or use pieces of it
26+in new free programs; and that you know you can do these things.
27+
28+ To protect your rights, we need to make restrictions that forbid
29+anyone to deny you these rights or to ask you to surrender the rights.
30+These restrictions translate to certain responsibilities for you if you
31+distribute copies of the software, or if you modify it.
32+
33+ For example, if you distribute copies of such a program, whether
34+gratis or for a fee, you must give the recipients all the rights that
35+you have. You must make sure that they, too, receive or can get the
36+source code. And you must show them these terms so they know their
37+rights.
38+
39+ We protect your rights with two steps: (1) copyright the software, and
40+(2) offer you this license which gives you legal permission to copy,
41+distribute and/or modify the software.
42+
43+ Also, for each author's protection and ours, we want to make certain
44+that everyone understands that there is no warranty for this free
45+software. If the software is modified by someone else and passed on, we
46+want its recipients to know that what they have is not the original, so
47+that any problems introduced by others will not reflect on the original
48+authors' reputations.
49+
50+ Finally, any free program is threatened constantly by software
51+patents. We wish to avoid the danger that redistributors of a free
52+program will individually obtain patent licenses, in effect making the
53+program proprietary. To prevent this, we have made it clear that any
54+patent must be licensed for everyone's free use or not licensed at all.
55+
56+ The precise terms and conditions for copying, distribution and
57+modification follow.
58+
59+ GNU GENERAL PUBLIC LICENSE
60+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
61+
62+ 0. This License applies to any program or other work which contains
63+a notice placed by the copyright holder saying it may be distributed
64+under the terms of this General Public License. The "Program", below,
65+refers to any such program or work, and a "work based on the Program"
66+means either the Program or any derivative work under copyright law:
67+that is to say, a work containing the Program or a portion of it,
68+either verbatim or with modifications and/or translated into another
69+language. (Hereinafter, translation is included without limitation in
70+the term "modification".) Each licensee is addressed as "you".
71+
72+Activities other than copying, distribution and modification are not
73+covered by this License; they are outside its scope. The act of
74+running the Program is not restricted, and the output from the Program
75+is covered only if its contents constitute a work based on the
76+Program (independent of having been made by running the Program).
77+Whether that is true depends on what the Program does.
78+
79+ 1. You may copy and distribute verbatim copies of the Program's
80+source code as you receive it, in any medium, provided that you
81+conspicuously and appropriately publish on each copy an appropriate
82+copyright notice and disclaimer of warranty; keep intact all the
83+notices that refer to this License and to the absence of any warranty;
84+and give any other recipients of the Program a copy of this License
85+along with the Program.
86+
87+You may charge a fee for the physical act of transferring a copy, and
88+you may at your option offer warranty protection in exchange for a fee.
89+
90+ 2. You may modify your copy or copies of the Program or any portion
91+of it, thus forming a work based on the Program, and copy and
92+distribute such modifications or work under the terms of Section 1
93+above, provided that you also meet all of these conditions:
94+
95+ a) You must cause the modified files to carry prominent notices
96+ stating that you changed the files and the date of any change.
97+
98+ b) You must cause any work that you distribute or publish, that in
99+ whole or in part contains or is derived from the Program or any
100+ part thereof, to be licensed as a whole at no charge to all third
101+ parties under the terms of this License.
102+
103+ c) If the modified program normally reads commands interactively
104+ when run, you must cause it, when started running for such
105+ interactive use in the most ordinary way, to print or display an
106+ announcement including an appropriate copyright notice and a
107+ notice that there is no warranty (or else, saying that you provide
108+ a warranty) and that users may redistribute the program under
109+ these conditions, and telling the user how to view a copy of this
110+ License. (Exception: if the Program itself is interactive but
111+ does not normally print such an announcement, your work based on
112+ the Program is not required to print an announcement.)
113+
114+These requirements apply to the modified work as a whole. If
115+identifiable sections of that work are not derived from the Program,
116+and can be reasonably considered independent and separate works in
117+themselves, then this License, and its terms, do not apply to those
118+sections when you distribute them as separate works. But when you
119+distribute the same sections as part of a whole which is a work based
120+on the Program, the distribution of the whole must be on the terms of
121+this License, whose permissions for other licensees extend to the
122+entire whole, and thus to each and every part regardless of who wrote it.
123+
124+Thus, it is not the intent of this section to claim rights or contest
125+your rights to work written entirely by you; rather, the intent is to
126+exercise the right to control the distribution of derivative or
127+collective works based on the Program.
128+
129+In addition, mere aggregation of another work not based on the Program
130+with the Program (or with a work based on the Program) on a volume of
131+a storage or distribution medium does not bring the other work under
132+the scope of this License.
133+
134+ 3. You may copy and distribute the Program (or a work based on it,
135+under Section 2) in object code or executable form under the terms of
136+Sections 1 and 2 above provided that you also do one of the following:
137+
138+ a) Accompany it with the complete corresponding machine-readable
139+ source code, which must be distributed under the terms of Sections
140+ 1 and 2 above on a medium customarily used for software interchange; or,
141+
142+ b) Accompany it with a written offer, valid for at least three
143+ years, to give any third party, for a charge no more than your
144+ cost of physically performing source distribution, a complete
145+ machine-readable copy of the corresponding source code, to be
146+ distributed under the terms of Sections 1 and 2 above on a medium
147+ customarily used for software interchange; or,
148+
149+ c) Accompany it with the information you received as to the offer
150+ to distribute corresponding source code. (This alternative is
151+ allowed only for noncommercial distribution and only if you
152+ received the program in object code or executable form with such
153+ an offer, in accord with Subsection b above.)
154+
155+The source code for a work means the preferred form of the work for
156+making modifications to it. For an executable work, complete source
157+code means all the source code for all modules it contains, plus any
158+associated interface definition files, plus the scripts used to
159+control compilation and installation of the executable. However, as a
160+special exception, the source code distributed need not include
161+anything that is normally distributed (in either source or binary
162+form) with the major components (compiler, kernel, and so on) of the
163+operating system on which the executable runs, unless that component
164+itself accompanies the executable.
165+
166+If distribution of executable or object code is made by offering
167+access to copy from a designated place, then offering equivalent
168+access to copy the source code from the same place counts as
169+distribution of the source code, even though third parties are not
170+compelled to copy the source along with the object code.
171+
172+ 4. You may not copy, modify, sublicense, or distribute the Program
173+except as expressly provided under this License. Any attempt
174+otherwise to copy, modify, sublicense or distribute the Program is
175+void, and will automatically terminate your rights under this License.
176+However, parties who have received copies, or rights, from you under
177+this License will not have their licenses terminated so long as such
178+parties remain in full compliance.
179+
180+ 5. You are not required to accept this License, since you have not
181+signed it. However, nothing else grants you permission to modify or
182+distribute the Program or its derivative works. These actions are
183+prohibited by law if you do not accept this License. Therefore, by
184+modifying or distributing the Program (or any work based on the
185+Program), you indicate your acceptance of this License to do so, and
186+all its terms and conditions for copying, distributing or modifying
187+the Program or works based on it.
188+
189+ 6. Each time you redistribute the Program (or any work based on the
190+Program), the recipient automatically receives a license from the
191+original licensor to copy, distribute or modify the Program subject to
192+these terms and conditions. You may not impose any further
193+restrictions on the recipients' exercise of the rights granted herein.
194+You are not responsible for enforcing compliance by third parties to
195+this License.
196+
197+ 7. If, as a consequence of a court judgment or allegation of patent
198+infringement or for any other reason (not limited to patent issues),
199+conditions are imposed on you (whether by court order, agreement or
200+otherwise) that contradict the conditions of this License, they do not
201+excuse you from the conditions of this License. If you cannot
202+distribute so as to satisfy simultaneously your obligations under this
203+License and any other pertinent obligations, then as a consequence you
204+may not distribute the Program at all. For example, if a patent
205+license would not permit royalty-free redistribution of the Program by
206+all those who receive copies directly or indirectly through you, then
207+the only way you could satisfy both it and this License would be to
208+refrain entirely from distribution of the Program.
209+
210+If any portion of this section is held invalid or unenforceable under
211+any particular circumstance, the balance of the section is intended to
212+apply and the section as a whole is intended to apply in other
213+circumstances.
214+
215+It is not the purpose of this section to induce you to infringe any
216+patents or other property right claims or to contest validity of any
217+such claims; this section has the sole purpose of protecting the
218+integrity of the free software distribution system, which is
219+implemented by public license practices. Many people have made
220+generous contributions to the wide range of software distributed
221+through that system in reliance on consistent application of that
222+system; it is up to the author/donor to decide if he or she is willing
223+to distribute software through any other system and a licensee cannot
224+impose that choice.
225+
226+This section is intended to make thoroughly clear what is believed to
227+be a consequence of the rest of this License.
228+
229+ 8. If the distribution and/or use of the Program is restricted in
230+certain countries either by patents or by copyrighted interfaces, the
231+original copyright holder who places the Program under this License
232+may add an explicit geographical distribution limitation excluding
233+those countries, so that distribution is permitted only in or among
234+countries not thus excluded. In such case, this License incorporates
235+the limitation as if written in the body of this License.
236+
237+ 9. The Free Software Foundation may publish revised and/or new versions
238+of the General Public License from time to time. Such new versions will
239+be similar in spirit to the present version, but may differ in detail to
240+address new problems or concerns.
241+
242+Each version is given a distinguishing version number. If the Program
243+specifies a version number of this License which applies to it and "any
244+later version", you have the option of following the terms and conditions
245+either of that version or of any later version published by the Free
246+Software Foundation. If the Program does not specify a version number of
247+this License, you may choose any version ever published by the Free Software
248+Foundation.
249+
250+ 10. If you wish to incorporate parts of the Program into other free
251+programs whose distribution conditions are different, write to the author
252+to ask for permission. For software which is copyrighted by the Free
253+Software Foundation, write to the Free Software Foundation; we sometimes
254+make exceptions for this. Our decision will be guided by the two goals
255+of preserving the free status of all derivatives of our free software and
256+of promoting the sharing and reuse of software generally.
257+
258+ NO WARRANTY
259+
260+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
261+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
262+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
263+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
264+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
265+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
266+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
267+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
268+REPAIR OR CORRECTION.
269+
270+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
271+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
272+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
273+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
274+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
275+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
276+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
277+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
278+POSSIBILITY OF SUCH DAMAGES.
279+
280+ END OF TERMS AND CONDITIONS
281+
282+ How to Apply These Terms to Your New Programs
283+
284+ If you develop a new program, and you want it to be of the greatest
285+possible use to the public, the best way to achieve this is to make it
286+free software which everyone can redistribute and change under these terms.
287+
288+ To do so, attach the following notices to the program. It is safest
289+to attach them to the start of each source file to most effectively
290+convey the exclusion of warranty; and each file should have at least
291+the "copyright" line and a pointer to where the full notice is found.
292+
293+ <one line to give the program's name and a brief idea of what it does.>
294+ Copyright (C) <year> <name of author>
295+
296+ This program is free software; you can redistribute it and/or modify
297+ it under the terms of the GNU General Public License as published by
298+ the Free Software Foundation; either version 2 of the License, or
299+ (at your option) any later version.
300+
301+ This program is distributed in the hope that it will be useful,
302+ but WITHOUT ANY WARRANTY; without even the implied warranty of
303+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
304+ GNU General Public License for more details.
305+
306+ You should have received a copy of the GNU General Public License
307+ along with this program; if not, write to the Free Software
308+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
309+
310+
311+Also add information on how to contact you by electronic and paper mail.
312+
313+If the program is interactive, make it output a short notice like this
314+when it starts in an interactive mode:
315+
316+ Gnomovision version 69, Copyright (C) year name of author
317+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
318+ This is free software, and you are welcome to redistribute it
319+ under certain conditions; type `show c' for details.
320+
321+The hypothetical commands `show w' and `show c' should show the appropriate
322+parts of the General Public License. Of course, the commands you use may
323+be called something other than `show w' and `show c'; they could even be
324+mouse-clicks or menu items--whatever suits your program.
325+
326+You should also get your employer (if you work as a programmer) or your
327+school, if any, to sign a "copyright disclaimer" for the program, if
328+necessary. Here is a sample; alter the names:
329+
330+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
331+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
332+
333+ <signature of Ty Coon>, 1 April 1989
334+ Ty Coon, President of Vice
335+
336+This General Public License does not permit incorporating your program into
337+proprietary programs. If your program is a subroutine library, you may
338+consider it more useful to permit linking proprietary applications with the
339+library. If this is what you want to do, use the GNU Library General
340+Public License instead of this License.
--- a/docs/makedoc.sh
+++ b/docs/makedoc.sh
@@ -1,4 +1,4 @@
1-#!/bin/sh
2-# HTMLファイルに変換
3-perl ../../tools/wiki2html.pl "http://fswiki.poi.jp/wiki.cgi/docs?action=SOURCE&page=FSWikiLite%2Freadme" -css=default.css -title=README > readme.html
4-perl ../../tools/wiki2html.pl "http://fswiki.poi.jp/wiki.cgi/docs?action=SOURCE&page=FSWikiLite%2F%A5%D7%A5%E9%A5%B0%A5%A4%A5%F3%B3%AB%C8%AF" -css=default.css -title=プラグイン開発 > plugindev.html
1+#!/bin/sh
2+# HTMLファイルに変換
3+perl ../../tools/wiki2html.pl "http://fswiki.poi.jp/wiki.cgi/docs?action=SOURCE&page=FSWikiLite%2Freadme" -css=default.css -title=README > readme.html
4+perl ../../tools/wiki2html.pl "http://fswiki.poi.jp/wiki.cgi/docs?action=SOURCE&page=FSWikiLite%2F%A5%D7%A5%E9%A5%B0%A5%A4%A5%F3%B3%AB%C8%AF" -css=default.css -title=プラグイン開発 > plugindev.html
--- a/docs/plugindev.html
+++ b/docs/plugindev.html
@@ -1,43 +1,43 @@
1-<html>
2-<head>
3- <title>プラグイン開発</title>
4- <link rel="stylesheet" type="text/css" href="default.css">
5-</head>
6-<body>
7-<h2>サポートするプラグイン</h2>
8-<p>FSWikiLiteはFSWikiとは違い、Wikiページに記述して使用するタイプのプラグイン(インラインプラグインとパラグラフプラグイン)しかサポートしていません。ただし、FSWikiでアクションプラグインと呼ばれているものについては別のCGIスクリプトを用意することで対応することができます(Liteのcategory.cgiなどがこれにあたります)。</p><p>プラグインは〜.plという名前を付けてpluginディレクトリに配置します。そしてlib/setup.plでrequireします。デフォルトのsetup.plではcore.plのみ読み込むよう設定されています。</p><pre>require &quot;./plugin/core.pl&quot;;
9-</pre><h2>インラインプラグイン</h2>
10-<p>インラインプラグインはWiki::Pluginパッケージで定義されたPerl関数のリファレンスです。関数の引数にはWikiソースで記述した引数がそのまま渡されます。関数は戻り値としてHTMLを返すように実装します。また、スクリプトのBEGIN節で関数のリファレンスをインラインプラグインとして登録します。</p><pre>package Wiki::Plugin;
11-BEGIN {
12- $main::I_PLUGIN-&gt;{hello} = \&amp;hello;
13-}
14-sub hello {
15- my $name = shift;
16- if($name eq ''){
17- return &quot;名前を入力してください。&quot;;
18- } else {
19- return &quot;こんにちは&quot;.&amp;Util::escapeHTML($name).&quot;さん&quot;;
20- }
21-}
22-1;
23-</pre><p>ページ編集時に以下の書式で使用することができます。</p><pre>{{hello たろう}}
24-</pre><h2>パラグラフプラグイン</h2>
25-<p>パラグラフプラグインも実装方法はインラインプラグインと同様です。ブロック要素を含むHTMLを返却する場合にはパラグラフプラグインとして実装します。BEGIN節での登録方法のみが異なります。</p><pre>BEGIN {
26- $main::P_PLUGIN-&gt;{hello} = \&amp;hello;
27-}
28-</pre><h2>リクエストパラメータへのアクセス</h2>
29-<p>プラグイン内部からリクエストパラメータにアクセスするには%main::inという変数を利用します。これはcgi-lib.plでパースされたリクエストパラメータが格納された連想配列です。</p><pre># ページ名を取得
30-my $p = $main::in{'p'};
31-</pre><h2>プラグインから利用可能なユーティリティ</h2>
32-<p>プラグイン内部ではUtilパッケージに定義されたユーティリティ関数を使用することができます。Utilパッケージには以下のような関数が定義されています。</p><table>
33-<tr><th>関数名</th><th>説明</th></tr>
34-<tr><td>url_encode</td><td>URLエンコードします。</td></tr>
35-<tr><td>url_decode</td><td>URLエンコードされた文字列をデコードします。</td></tr>
36-<tr><td>escapeHTML</td><td>HTMLをエスケープします。</td></tr>
37-<tr><td>trim</td><td>文字列の前後の空白を取り除きます。</td></tr>
38-<tr><td>check_numeric</td><td>文字列が数値かどうかチェックします。</td></tr>
39-<tr><td>handyphone</td><td>携帯電話かどうかを判断します。</td></tr>
40-</table>
41-<h2>アクションスクリプト</h2>
42-<p>FSWikiでアクションプラグインとして実装されているプラグインは別途CGIスクリプトを作成することで対応することが出来ます。actionパラメータの代わりにそのCGIスクリプトを呼び出すようにします。CGIスクリプトからはcommon.plに定義された関数群を使用してページの取得や保存などを行うことが出来ます。</p><p>FSWikiLiteではデフォルトでedit.cgi(ページの編集)、download.cgi(添付ファイルのダウンロード)、category.cgi(カテゴリ表示)という3つのアクションスクリプトが用意されていますので、これらを参考にしてください。</p></body>
43-</html>
1+<html>
2+<head>
3+ <title>プラグイン開発</title>
4+ <link rel="stylesheet" type="text/css" href="default.css">
5+</head>
6+<body>
7+<h2>サポートするプラグイン</h2>
8+<p>FSWikiLiteはFSWikiとは違い、Wikiページに記述して使用するタイプのプラグイン(インラインプラグインとパラグラフプラグイン)しかサポートしていません。ただし、FSWikiでアクションプラグインと呼ばれているものについては別のCGIスクリプトを用意することで対応することができます(Liteのcategory.cgiなどがこれにあたります)。</p><p>プラグインは〜.plという名前を付けてpluginディレクトリに配置します。そしてlib/setup.plでrequireします。デフォルトのsetup.plではcore.plのみ読み込むよう設定されています。</p><pre>require &quot;./plugin/core.pl&quot;;
9+</pre><h2>インラインプラグイン</h2>
10+<p>インラインプラグインはWiki::Pluginパッケージで定義されたPerl関数のリファレンスです。関数の引数にはWikiソースで記述した引数がそのまま渡されます。関数は戻り値としてHTMLを返すように実装します。また、スクリプトのBEGIN節で関数のリファレンスをインラインプラグインとして登録します。</p><pre>package Wiki::Plugin;
11+BEGIN {
12+ $main::I_PLUGIN-&gt;{hello} = \&amp;hello;
13+}
14+sub hello {
15+ my $name = shift;
16+ if($name eq ''){
17+ return &quot;名前を入力してください。&quot;;
18+ } else {
19+ return &quot;こんにちは&quot;.&amp;Util::escapeHTML($name).&quot;さん&quot;;
20+ }
21+}
22+1;
23+</pre><p>ページ編集時に以下の書式で使用することができます。</p><pre>{{hello たろう}}
24+</pre><h2>パラグラフプラグイン</h2>
25+<p>パラグラフプラグインも実装方法はインラインプラグインと同様です。ブロック要素を含むHTMLを返却する場合にはパラグラフプラグインとして実装します。BEGIN節での登録方法のみが異なります。</p><pre>BEGIN {
26+ $main::P_PLUGIN-&gt;{hello} = \&amp;hello;
27+}
28+</pre><h2>リクエストパラメータへのアクセス</h2>
29+<p>プラグイン内部からリクエストパラメータにアクセスするには%main::inという変数を利用します。これはcgi-lib.plでパースされたリクエストパラメータが格納された連想配列です。</p><pre># ページ名を取得
30+my $p = $main::in{'p'};
31+</pre><h2>プラグインから利用可能なユーティリティ</h2>
32+<p>プラグイン内部ではUtilパッケージに定義されたユーティリティ関数を使用することができます。Utilパッケージには以下のような関数が定義されています。</p><table>
33+<tr><th>関数名</th><th>説明</th></tr>
34+<tr><td>url_encode</td><td>URLエンコードします。</td></tr>
35+<tr><td>url_decode</td><td>URLエンコードされた文字列をデコードします。</td></tr>
36+<tr><td>escapeHTML</td><td>HTMLをエスケープします。</td></tr>
37+<tr><td>trim</td><td>文字列の前後の空白を取り除きます。</td></tr>
38+<tr><td>check_numeric</td><td>文字列が数値かどうかチェックします。</td></tr>
39+<tr><td>handyphone</td><td>携帯電話かどうかを判断します。</td></tr>
40+</table>
41+<h2>アクションスクリプト</h2>
42+<p>FSWikiでアクションプラグインとして実装されているプラグインは別途CGIスクリプトを作成することで対応することが出来ます。actionパラメータの代わりにそのCGIスクリプトを呼び出すようにします。CGIスクリプトからはcommon.plに定義された関数群を使用してページの取得や保存などを行うことが出来ます。</p><p>FSWikiLiteではデフォルトでedit.cgi(ページの編集)、download.cgi(添付ファイルのダウンロード)、category.cgi(カテゴリ表示)という3つのアクションスクリプトが用意されていますので、これらを参考にしてください。</p></body>
43+</html>
--- a/docs/readme.html
+++ b/docs/readme.html
@@ -1,114 +1,114 @@
1-<html>
2-<head>
3- <title>README</title>
4- <link rel="stylesheet" type="text/css" href="default.css">
5-</head>
6-<body>
7-<h2>FSWikiLiteとは?</h2>
8-<p>FSWikiLiteの元になっているFreeStyleWikiはPerlによるmodulableなWikiクローンです。プラグインによって様々な機能を追加することができます。ただし、高機能な分、通常のCGIスクリプトと比較すると動作が重いという欠点がありました。</p><p>FSWikiLiteはFSWikiほど高機能ではありませんが、機能を限定することで軽快に動作します。プラグインは一部しか使用できませんが、文法はFSWikiと完全互換です。また、FSWikiと比べると構造がシンプルな分、設置も容易です。</p><p>その他にFSWikiLiteは以下のような特徴があります。</p><ul>
9-<li>tDiaryのテーマを使用可能。
10-</li>
11-<li>サイドバーやヘッダ、フッタを表示可能。
12-</li>
13-<li>FSWikiとは異なるシンプルなプラグイン機構を備えている。
14-</li>
15-<li>.htaccessを使用することで編集を管理人のみに限定することが可能。
16-</li>
17-<li>ページのカテゴライズが可能。
18-</li>
19-<li>ファイルの添付が可能。
20-</li>
21-<li>PDF生成、キーワードリンク、InterWikiなどは使用不可。
22-</li>
23-</ul><h2>インストール</h2>
24-<p>lib/setup.plを編集し、各自の設定を行います。</p><ul>
25-<li>$DATA_DIR - データファイルの格納場所。
26-</li>
27-<li>$BACKUP_DIR - バックアップファイルの格納場所。
28-</li>
29-<li>$ATTACH_DIR - 添付ファイルの格納場所。
30-</li>
31-<li>$THEME_URL - テーマ(CSS)の場所。
32-</li>
33-<li>$SEND_MAIL - sendmailのパス。更新通知を受け取る場合は設定してください。
34-</li>
35-<li>$ADMIN_MAIL- 管理者のメールアドレス。更新通知を受け取る場合は設定してください。
36-</li>
37-<li>$WIKI_NAME - WikiNameを使用する場合は1、使用しない場合は0を指定してください。
38-</li>
39-<li>$MAIN_SCRIPT - メインスクリプトのファイル名。変更しなくてもいいです。
40-</li>
41-<li>$EDIT_SCRIPT - 編集用スクリプトのファイル名。変更しなくてもいいです。
42-</li>
43-<li>$DOWNLOAD_SCRIPT - 添付ファイルのダウンロード用スクリプトのファイル名。変更しなくてもいいです。
44-</li>
45-<li>$CATEGORY_SCRIPT - カテゴリ表示用スクリプトのファイル名。変更しなくてもいいです。
46-</li>
47-<li>$SITE_TITLE - サイト名。自由に変更してください。
48-</li>
49-<li>$VERSION - FSWikiLiteのバージョン。変更しなくてもいいです。
50-</li>
51-<li>$SITE_URL - FSWiki公式サイトのURL。変更しなくてもいいです。
52-</li>
53-</ul><p>FTPなどで以下のようにファイルを配置します(デフォルトの設定の場合)。</p><pre>-+- wiki.cgi
54- |
55- +- edit.cgi
56- |
57- +- category.cgi
58- |
59- +- download.cgi
60- |
61- +- /lib (ライブラリを配置します)
62- | |
63- | +- jcode.pl
64- | |
65- | +- cgi-lib.pl
66- | |
67- | +- setup.pl
68- | |
69- | +- common.pl
70- | |
71- | +- mimew.pl
72- |
73- +- /plugin (プラグインを配置します)
74- | |
75- | +- core.pl
76- |
77- +- /data (ページデータが出力されます)
78- |
79- +- /backup (バックアップファイルが出力されます)
80- |
81- +- /attach(添付ファイルが出力されます)
82- |
83- +-/theme (テーマを配置します)
84- |
85- +- /default
86- |
87- +- default.css
88-</pre><p>wiki.cgi、edit.cgi、category.cgi、download.cgiのパーミッションをCGIとして実行可能なように設定します。また、dataディレクトリ、backupディレクトリ、attachディレクトリはCGIから書き込み可能なパーミッションに設定します。なお、ディレクトリ構成に関してはsetup.plを編集することで任意の構造に変更することができます。</p><p>テーマに関しては現在のFSWikiLiteの配布アーカイブには同梱されていません。FSWikiのディストリビューションや、tDiaryのWebサイトよりお好みのテーマを取得してください。</p><h2>編集を管理者に限定する</h2>
89-<p>.htaccessを使ってedit.cgiにアクセス制限をかけます。詳細についてはそのうち。</p><h2>使用可能なプラグイン</h2>
90-<h3>recent</h3>
91-<p>更新日時順にページ名の一覧を出力します。引数で表示件数を指定できます。表示件数を省略すると全件出力します。</p><pre>{{recent 10}}
92-</pre><h3>recentdays</h3>
93-<p>日付ごとに更新されたページを一覧表示します。引数で表示日数を指定できます。表示日数を省略すると最新の5日分を出力します。</p><pre>{{recentdays 10}}
94-</pre><h3>lastmodified</h3>
95-<p>ページの最終更新日時を表示します。</p><pre>{{lastmodified}}
96-</pre><h3>category</h3>
97-<p>ページをカテゴライズするためのプラグインです。引数にカテゴリ名を指定します。</p><pre>{{category カテゴリ名}}
98-</pre><h3>category_list</h3>
99-<p>カテゴリごとのページ一覧を表示します。</p><pre>{{category_list}}
100-</pre><p>引数として表示するカテゴリを指定することもできます。</p><pre>{{category_list カテゴリ名}}
101-</pre><h3>ref</h3>
102-<p>添付ファイルへのリンクを出力するプラグインです。</p><pre>{{ref ファイル名}}
103-</pre><h3>ref_image</h3>
104-<p>添付ファイルを画像として表示するプラグインです。</p><pre>{{ref_image ファイル名}}
105-</pre><h3>ref_text</h3>
106-<p>添付ファイルを整形済テキストとして表示するプラグインです。</p><pre>{{ref_text ファイル名}}
107-</pre><h3>outline</h3>
108-<p>ページのアウトラインを表示します。見出しがツリー形式で表示され、クリックするとその見出しにジャンプします。<a href="wiki.cgi?page=Header" class="wikipage">Header</a>などに入れておくと便利です。</p><pre>{{outline}}
109-</pre><h3>search</h3>
110-<p>検索フォームを表示します。サイドバーなどに入れておくと便利です。</p><pre>{{search}}
111-</pre><h2>ライセンス</h2>
112-<p>FSWikiLiteはGNUL GPLライセンスに基づいて改変、再配布が可能です。</p><h2>作成者</h2>
113-<p>Naoki Takezoe &lt;<a href="mailto:takezoe@aa.bb-east.ne.jp">mailto:takezoe@aa.bb-east.ne.jp</a>&gt;</p></body>
114-</html>
1+<html>
2+<head>
3+ <title>README</title>
4+ <link rel="stylesheet" type="text/css" href="default.css">
5+</head>
6+<body>
7+<h2>FSWikiLiteとは?</h2>
8+<p>FSWikiLiteの元になっているFreeStyleWikiはPerlによるmodulableなWikiクローンです。プラグインによって様々な機能を追加することができます。ただし、高機能な分、通常のCGIスクリプトと比較すると動作が重いという欠点がありました。</p><p>FSWikiLiteはFSWikiほど高機能ではありませんが、機能を限定することで軽快に動作します。プラグインは一部しか使用できませんが、文法はFSWikiと完全互換です。また、FSWikiと比べると構造がシンプルな分、設置も容易です。</p><p>その他にFSWikiLiteは以下のような特徴があります。</p><ul>
9+<li>tDiaryのテーマを使用可能。
10+</li>
11+<li>サイドバーやヘッダ、フッタを表示可能。
12+</li>
13+<li>FSWikiとは異なるシンプルなプラグイン機構を備えている。
14+</li>
15+<li>.htaccessを使用することで編集を管理人のみに限定することが可能。
16+</li>
17+<li>ページのカテゴライズが可能。
18+</li>
19+<li>ファイルの添付が可能。
20+</li>
21+<li>PDF生成、キーワードリンク、InterWikiなどは使用不可。
22+</li>
23+</ul><h2>インストール</h2>
24+<p>lib/setup.plを編集し、各自の設定を行います。</p><ul>
25+<li>$DATA_DIR - データファイルの格納場所。
26+</li>
27+<li>$BACKUP_DIR - バックアップファイルの格納場所。
28+</li>
29+<li>$ATTACH_DIR - 添付ファイルの格納場所。
30+</li>
31+<li>$THEME_URL - テーマ(CSS)の場所。
32+</li>
33+<li>$SEND_MAIL - sendmailのパス。更新通知を受け取る場合は設定してください。
34+</li>
35+<li>$ADMIN_MAIL- 管理者のメールアドレス。更新通知を受け取る場合は設定してください。
36+</li>
37+<li>$WIKI_NAME - WikiNameを使用する場合は1、使用しない場合は0を指定してください。
38+</li>
39+<li>$MAIN_SCRIPT - メインスクリプトのファイル名。変更しなくてもいいです。
40+</li>
41+<li>$EDIT_SCRIPT - 編集用スクリプトのファイル名。変更しなくてもいいです。
42+</li>
43+<li>$DOWNLOAD_SCRIPT - 添付ファイルのダウンロード用スクリプトのファイル名。変更しなくてもいいです。
44+</li>
45+<li>$CATEGORY_SCRIPT - カテゴリ表示用スクリプトのファイル名。変更しなくてもいいです。
46+</li>
47+<li>$SITE_TITLE - サイト名。自由に変更してください。
48+</li>
49+<li>$VERSION - FSWikiLiteのバージョン。変更しなくてもいいです。
50+</li>
51+<li>$SITE_URL - FSWiki公式サイトのURL。変更しなくてもいいです。
52+</li>
53+</ul><p>FTPなどで以下のようにファイルを配置します(デフォルトの設定の場合)。</p><pre>-+- wiki.cgi
54+ |
55+ +- edit.cgi
56+ |
57+ +- category.cgi
58+ |
59+ +- download.cgi
60+ |
61+ +- /lib (ライブラリを配置します)
62+ | |
63+ | +- jcode.pl
64+ | |
65+ | +- cgi-lib.pl
66+ | |
67+ | +- setup.pl
68+ | |
69+ | +- common.pl
70+ | |
71+ | +- mimew.pl
72+ |
73+ +- /plugin (プラグインを配置します)
74+ | |
75+ | +- core.pl
76+ |
77+ +- /data (ページデータが出力されます)
78+ |
79+ +- /backup (バックアップファイルが出力されます)
80+ |
81+ +- /attach(添付ファイルが出力されます)
82+ |
83+ +-/theme (テーマを配置します)
84+ |
85+ +- /default
86+ |
87+ +- default.css
88+</pre><p>wiki.cgi、edit.cgi、category.cgi、download.cgiのパーミッションをCGIとして実行可能なように設定します。また、dataディレクトリ、backupディレクトリ、attachディレクトリはCGIから書き込み可能なパーミッションに設定します。なお、ディレクトリ構成に関してはsetup.plを編集することで任意の構造に変更することができます。</p><p>テーマに関しては現在のFSWikiLiteの配布アーカイブには同梱されていません。FSWikiのディストリビューションや、tDiaryのWebサイトよりお好みのテーマを取得してください。</p><h2>編集を管理者に限定する</h2>
89+<p>.htaccessを使ってedit.cgiにアクセス制限をかけます。詳細についてはそのうち。</p><h2>使用可能なプラグイン</h2>
90+<h3>recent</h3>
91+<p>更新日時順にページ名の一覧を出力します。引数で表示件数を指定できます。表示件数を省略すると全件出力します。</p><pre>{{recent 10}}
92+</pre><h3>recentdays</h3>
93+<p>日付ごとに更新されたページを一覧表示します。引数で表示日数を指定できます。表示日数を省略すると最新の5日分を出力します。</p><pre>{{recentdays 10}}
94+</pre><h3>lastmodified</h3>
95+<p>ページの最終更新日時を表示します。</p><pre>{{lastmodified}}
96+</pre><h3>category</h3>
97+<p>ページをカテゴライズするためのプラグインです。引数にカテゴリ名を指定します。</p><pre>{{category カテゴリ名}}
98+</pre><h3>category_list</h3>
99+<p>カテゴリごとのページ一覧を表示します。</p><pre>{{category_list}}
100+</pre><p>引数として表示するカテゴリを指定することもできます。</p><pre>{{category_list カテゴリ名}}
101+</pre><h3>ref</h3>
102+<p>添付ファイルへのリンクを出力するプラグインです。</p><pre>{{ref ファイル名}}
103+</pre><h3>ref_image</h3>
104+<p>添付ファイルを画像として表示するプラグインです。</p><pre>{{ref_image ファイル名}}
105+</pre><h3>ref_text</h3>
106+<p>添付ファイルを整形済テキストとして表示するプラグインです。</p><pre>{{ref_text ファイル名}}
107+</pre><h3>outline</h3>
108+<p>ページのアウトラインを表示します。見出しがツリー形式で表示され、クリックするとその見出しにジャンプします。<a href="wiki.cgi?page=Header" class="wikipage">Header</a>などに入れておくと便利です。</p><pre>{{outline}}
109+</pre><h3>search</h3>
110+<p>検索フォームを表示します。サイドバーなどに入れておくと便利です。</p><pre>{{search}}
111+</pre><h2>ライセンス</h2>
112+<p>FSWikiLiteはGNUL GPLライセンスに基づいて改変、再配布が可能です。</p><h2>作成者</h2>
113+<p>Naoki Takezoe &lt;<a href="mailto:takezoe@aa.bb-east.ne.jp">mailto:takezoe@aa.bb-east.ne.jp</a>&gt;</p></body>
114+</html>
--- a/download.cgi
+++ b/download.cgi
@@ -1,73 +1,73 @@
1-#!/usr/bin/perl
2-################################################################################
3-#
4-# FSWiki Lite - 添付ファイルをダウンロードするためのCGIスクリプト
5-#
6-################################################################################
7-require "./lib/common.pl";
8-#==============================================================================
9-# パラメータを受け取る
10-#==============================================================================
11-&ReadParse();
12-my $page = $in{"p"};
13-my $file = $in{"f"};
14-
15-#==============================================================================
16-# エラーチェック
17-#==============================================================================
18-if($page eq ""){
19- &Util::error("ページが指定されていません。");
20-}
21-if($file eq ""){
22- &Util::error("ファイルが指定されていません。");
23-}
24-#==============================================================================
25-# ダウンロード
26-#==============================================================================
27-my $filename = sprintf("$main::ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));
28-unless(-e $filename){
29- &Util::error("指定されたファイルは存在しません。");
30-}
31-
32-my $contenttype = &get_mime_type($file);
33-my $ua = $ENV{"HTTP_USER_AGENT"};
34-my $disposition = ($contenttype =~ /^image\// && $ua !~ /MSIE/ ? "inline" : "attachment");
35-
36-&jcode::convert(\$file,'sjis');
37-
38-print "Content-Type: $contenttype\n";
39-print "Content-Disposition: $disposition;filename=\"$file\"\n\n";
40-open(DATA,$filename);
41-binmode(DATA);
42-while(<DATA>){
43- print $_;
44-}
45-close(DATA);
46-
47-
48-#==============================================================================
49-# MIMEタイプを取得します
50-#==============================================================================
51-sub get_mime_type {
52- my $file = shift;
53- my $type = lc(substr($file,rindex($file,".")));
54- my $ctype;
55-
56- if ($type eq ".gif" ){ $ctype = "image/gif"; }
57- elsif($type eq ".txt" ){ $ctype = "text/plain"; }
58- elsif($type eq ".rb" ){ $ctype = "text/plain"; }
59- elsif($type eq ".pl" ){ $ctype = "text/plain"; }
60- elsif($type eq ".java"){ $ctype = "text/plain"; }
61-# elsif($type eq ".html"){ $ctype = "text/html"; }
62-# elsif($type eq ".htm" ){ $ctype = "text/html"; }
63- elsif($type eq ".css" ){ $ctype = "text/css"; }
64- elsif($type eq ".jpeg"){ $ctype = "image/jpeg"; }
65- elsif($type eq ".jpg" ){ $ctype = "image/jpeg"; }
66- elsif($type eq ".png" ){ $ctype = "image/png"; }
67- elsif($type eq ".bmp" ){ $ctype = "image/bmp"; }
68- elsif($type eq ".doc" ){ $ctype = "application/msword"; }
69- elsif($type eq ".xls" ){ $ctype = "application/vnd.ms-excel"; }
70- else { $ctype = "application/octet-stream"; }
71-
72- return $ctype;
73-}
1+#!/usr/bin/perl
2+################################################################################
3+#
4+# FSWiki Lite - 添付ファイルをダウンロードするためのCGIスクリプト
5+#
6+################################################################################
7+require "./lib/common.pl";
8+#==============================================================================
9+# パラメータを受け取る
10+#==============================================================================
11+&ReadParse();
12+my $page = $in{"p"};
13+my $file = $in{"f"};
14+
15+#==============================================================================
16+# エラーチェック
17+#==============================================================================
18+if($page eq ""){
19+ &Util::error("ページが指定されていません。");
20+}
21+if($file eq ""){
22+ &Util::error("ファイルが指定されていません。");
23+}
24+#==============================================================================
25+# ダウンロード
26+#==============================================================================
27+my $filename = sprintf("$main::ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));
28+unless(-e $filename){
29+ &Util::error("指定されたファイルは存在しません。");
30+}
31+
32+my $contenttype = &get_mime_type($file);
33+my $ua = $ENV{"HTTP_USER_AGENT"};
34+my $disposition = ($contenttype =~ /^image\// && $ua !~ /MSIE/ ? "inline" : "attachment");
35+
36+&jcode::convert(\$file,'sjis');
37+
38+print "Content-Type: $contenttype\n";
39+print "Content-Disposition: $disposition;filename=\"$file\"\n\n";
40+open(DATA,$filename);
41+binmode(DATA);
42+while(<DATA>){
43+ print $_;
44+}
45+close(DATA);
46+
47+
48+#==============================================================================
49+# MIMEタイプを取得します
50+#==============================================================================
51+sub get_mime_type {
52+ my $file = shift;
53+ my $type = lc(substr($file,rindex($file,".")));
54+ my $ctype;
55+
56+ if ($type eq ".gif" ){ $ctype = "image/gif"; }
57+ elsif($type eq ".txt" ){ $ctype = "text/plain"; }
58+ elsif($type eq ".rb" ){ $ctype = "text/plain"; }
59+ elsif($type eq ".pl" ){ $ctype = "text/plain"; }
60+ elsif($type eq ".java"){ $ctype = "text/plain"; }
61+# elsif($type eq ".html"){ $ctype = "text/html"; }
62+# elsif($type eq ".htm" ){ $ctype = "text/html"; }
63+ elsif($type eq ".css" ){ $ctype = "text/css"; }
64+ elsif($type eq ".jpeg"){ $ctype = "image/jpeg"; }
65+ elsif($type eq ".jpg" ){ $ctype = "image/jpeg"; }
66+ elsif($type eq ".png" ){ $ctype = "image/png"; }
67+ elsif($type eq ".bmp" ){ $ctype = "image/bmp"; }
68+ elsif($type eq ".doc" ){ $ctype = "application/msword"; }
69+ elsif($type eq ".xls" ){ $ctype = "application/vnd.ms-excel"; }
70+ else { $ctype = "application/octet-stream"; }
71+
72+ return $ctype;
73+}
--- a/edit.cgi
+++ b/edit.cgi
@@ -1,219 +1,219 @@
1-#!/usr/bin/perl
2-################################################################################
3-#
4-# FSWiki Lite - ページ作成、編集用スクリプト
5-#
6-################################################################################
7-require "./lib/common.pl";
8-#===============================================================================
9-# 処理の振り分け
10-#===============================================================================
11-&ReadParse();
12-if($in{"p"} eq ""){
13- $in{"p"} = "FrontPage";
14-}
15-
16-if($in{"p"}=~ /[\|:\[\]]/){
17- &Util::error("ページ名に使用できない文字が含まれています。");
18-}
19-
20-if($in{"a"} eq "edit"){
21- &edit_page();
22-
23-} elsif($in{"a"} eq "new"){
24- &new_page();
25-
26-} elsif($in{"a"} eq "save"){
27- &save_page();
28-
29-} elsif($in{"a"} eq "attach"){
30- &attach_file();
31-
32-} elsif($in{"a"} eq "delconf"){
33- &attach_delete_confirm();
34-
35-} elsif($in{"a"} eq "delete"){
36- &attach_delete();
37-
38-} else {
39- redirect("FrontPage");
40-}
41-
42-#-------------------------------------------------------------------------------
43-# ページの編集
44-#-------------------------------------------------------------------------------
45-sub edit_page {
46- my $source = shift;
47- my $page = $in{"p"};
48- my $preview = 0;
49- my $time = $in{"t"};
50-
51- if($source ne ""){
52- $preview = 1;
53- } elsif(&Wiki::exists_page($page)){
54- $source = &Wiki::get_page($page);
55- $time = &Wiki::get_last_modified($page);
56- }
57-
58- &print_header($in{"p"}."の編集");
59-
60- if($preview==1){
61- print &Wiki::process_wiki($source);
62- }
63-
64- print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";
65- print " <textarea name=\"source\" rows=\"20\" cols=\"80\">".&Util::escapeHTML($source)."</textarea><br>\n";
66- print " <input type=\"submit\" name=\"do_save\" value=\" 保 存 \">\n";
67- print " <input type=\"submit\" name=\"preview\" value=\"プレビュー\">\n";
68- print " <input type=\"hidden\" name=\"a\" value=\"save\">\n";
69- print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
70- print " <input type=\"hidden\" name=\"t\" value=\"".&Util::escapeHTML($time)."\">\n";
71- print "</form>\n";
72-
73- opendir(DIR, $main::ATTACH_DIR);
74- my ($attachentry, @attachfiles);
75- while($attachentry = readdir(DIR)){
76- my $type = rindex($attachentry,&Util::url_encode($page).".");
77- if($type eq 0){
78- push(@attachfiles, "$main::ATTACH_DIR/$attachentry");
79- }
80- }
81- closedir(DIR);
82- foreach my $attach (@attachfiles){
83- $attach =~ /^\Q$main::ATTACH_DIR\E\/(.+)\.(.+)$/;
84- my $pagename = $1;
85- my $filename = $2;
86- print &Wiki::Plugin::ref(&Util::url_decode($filename));
87- printf ("[<a href=\"$EDIT_SCRIPT?a=delconf&p=%s&f=%s\">削除</a>]\n",$pagename,$filename);
88- }
89-
90- print "<form action=\"$EDIT_SCRIPT\" method=\"post\" enctype=\"multipart/form-data\">\n";
91- print " <input type=\"file\" name=\"f\">\n";
92- print " <input type=\"submit\" name=\"do_attach\" value=\" 添 付 \">\n";
93- print " <input type=\"hidden\" name=\"a\" value=\"attach\">\n";
94- print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
95- print "</form>\n";
96-
97- &print_footer();
98-}
99-
100-#-------------------------------------------------------------------------------
101-# ページの作成
102-#-------------------------------------------------------------------------------
103-sub new_page {
104- &print_header("ページの作成");
105- print "<form action=\"$SCRIPT_NAME\" method=\"POST\">\n";
106- print " <input type=\"text\" name=\"p\" size=\"40\">\n";
107- print " <input type=\"submit\" name=\"do_save\" value=\" 作 成 \">\n";
108- print " <input type=\"hidden\" name=\"a\" value=\"edit\">\n";
109- print "</form>\n";
110- &print_footer();
111-}
112-
113-#-------------------------------------------------------------------------------
114-# ページの保存
115-#-------------------------------------------------------------------------------
116-sub save_page {
117- my $page = $in{"p"};
118- my $source = $in{"source"};
119-
120- if($in{"preview"} ne ""){
121- &edit_page($source);
122-
123- } else {
124- # ページの削除
125- if($source eq ""){
126- # 更新の重複チェック
127- if(&Wiki::exists_page($page)){
128- if($in{"t"} != &Wiki::get_last_modified($page)){
129- &Util::error("このページは既に更新されています。");
130- } else {
131- &Wiki::remove_page($page);
132- }
133- }
134- &redirect("FrontPage");
135-
136- # ページの作成または更新
137- } else {
138- # 更新の重複チェック
139- if(&Wiki::exists_page($page)){
140- if($in{"t"} != &Wiki::get_last_modified($page)){
141- &Util::error("このページは既に更新されています。");
142- }
143- }
144- &Wiki::save_page($page,$source);
145- &redirect($page);
146- }
147- }
148-}
149-
150-#-------------------------------------------------------------------------------
151-# ファイルの添付
152-#-------------------------------------------------------------------------------
153-sub attach_file {
154- my $page = $in{"p"};
155- my $file = $in{"f"}; # ファイル内容を取得
156- my $name = $incfn{"f"}; # ファイル名を取得
157-
158- if($file eq ""){
159- &Util::error("ファイルが指定されていません。");
160- }
161-
162- if($name eq ""){
163- return;
164- }
165-
166- $name =~ s/\\/\//g; # パス区切り文字を/に変換
167- $name = substr($name,rindex($name,"/")+1); # ファイル名のみを取得
168-
169- my $filename = sprintf("%s/%s.%s",$main::ATTACH_DIR,&Util::url_encode($page),&Util::url_encode($name));
170- open(DATA,">$filename");
171- binmode(DATA);
172- print DATA $file;
173- close(DATA);
174-
175- &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));
176-}
177-
178-#-------------------------------------------------------------------------------
179-# 添付ファイルの削除確認
180-#-------------------------------------------------------------------------------
181-sub attach_delete_confirm {
182- my $page = $in{"p"};
183- my $file = $in{"f"};
184-
185- if($file eq ""){
186- &Util::error("ファイルが指定されていません。");
187- }
188-
189- &print_header("添付ファイルの削除");
190- printf ("<p><a href=\"$MAIN_SCRIPT?p=%s\">%s</a>から".
191- "<a href=\"$DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>を削除してよろしいですか?</p>\n",
192- &Util::url_encode($page),&Util::escapeHTML($page),
193- &Util::url_encode($page),&Util::url_encode($file),&Util::escapeHTML($file));
194-
195- print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";
196- print " <input type=\"submit\" name=\"do_delete\" value=\" 削 除 \">\n";
197- print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
198- print " <input type=\"hidden\" name=\"f\" value=\"".&Util::escapeHTML($file)."\">\n";
199- print " <input type=\"hidden\" name=\"a\" value=\"delete\">\n";
200- print "</form>\n";
201- &print_footer();
202-}
203-
204-#-------------------------------------------------------------------------------
205-# 添付ファイルの削除
206-#-------------------------------------------------------------------------------
207-sub attach_delete {
208- my $page = $in{"p"};
209- my $file = $in{"f"};
210-
211- if($file eq ""){
212- &Util::error("ファイルが指定されていません。");
213- }
214-
215- my $filename = sprintf("$ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));
216- unlink($filename);
217-
218- &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));
219-}
1+#!/usr/bin/perl
2+################################################################################
3+#
4+# FSWiki Lite - ページ作成、編集用スクリプト
5+#
6+################################################################################
7+require "./lib/common.pl";
8+#===============================================================================
9+# 処理の振り分け
10+#===============================================================================
11+&ReadParse();
12+if($in{"p"} eq ""){
13+ $in{"p"} = "FrontPage";
14+}
15+
16+if($in{"p"}=~ /[\|:\[\]]/){
17+ &Util::error("ページ名に使用できない文字が含まれています。");
18+}
19+
20+if($in{"a"} eq "edit"){
21+ &edit_page();
22+
23+} elsif($in{"a"} eq "new"){
24+ &new_page();
25+
26+} elsif($in{"a"} eq "save"){
27+ &save_page();
28+
29+} elsif($in{"a"} eq "attach"){
30+ &attach_file();
31+
32+} elsif($in{"a"} eq "delconf"){
33+ &attach_delete_confirm();
34+
35+} elsif($in{"a"} eq "delete"){
36+ &attach_delete();
37+
38+} else {
39+ redirect("FrontPage");
40+}
41+
42+#-------------------------------------------------------------------------------
43+# ページの編集
44+#-------------------------------------------------------------------------------
45+sub edit_page {
46+ my $source = shift;
47+ my $page = $in{"p"};
48+ my $preview = 0;
49+ my $time = $in{"t"};
50+
51+ if($source ne ""){
52+ $preview = 1;
53+ } elsif(&Wiki::exists_page($page)){
54+ $source = &Wiki::get_page($page);
55+ $time = &Wiki::get_last_modified($page);
56+ }
57+
58+ &print_header($in{"p"}."の編集");
59+
60+ if($preview==1){
61+ print &Wiki::process_wiki($source);
62+ }
63+
64+ print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";
65+ print " <textarea name=\"source\" rows=\"20\" cols=\"80\">".&Util::escapeHTML($source)."</textarea><br>\n";
66+ print " <input type=\"submit\" name=\"do_save\" value=\" 保 存 \">\n";
67+ print " <input type=\"submit\" name=\"preview\" value=\"プレビュー\">\n";
68+ print " <input type=\"hidden\" name=\"a\" value=\"save\">\n";
69+ print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
70+ print " <input type=\"hidden\" name=\"t\" value=\"".&Util::escapeHTML($time)."\">\n";
71+ print "</form>\n";
72+
73+ opendir(DIR, $main::ATTACH_DIR);
74+ my ($attachentry, @attachfiles);
75+ while($attachentry = readdir(DIR)){
76+ my $type = rindex($attachentry,&Util::url_encode($page).".");
77+ if($type eq 0){
78+ push(@attachfiles, "$main::ATTACH_DIR/$attachentry");
79+ }
80+ }
81+ closedir(DIR);
82+ foreach my $attach (@attachfiles){
83+ $attach =~ /^\Q$main::ATTACH_DIR\E\/(.+)\.(.+)$/;
84+ my $pagename = $1;
85+ my $filename = $2;
86+ print &Wiki::Plugin::ref(&Util::url_decode($filename));
87+ printf ("[<a href=\"$EDIT_SCRIPT?a=delconf&p=%s&f=%s\">削除</a>]\n",$pagename,$filename);
88+ }
89+
90+ print "<form action=\"$EDIT_SCRIPT\" method=\"post\" enctype=\"multipart/form-data\">\n";
91+ print " <input type=\"file\" name=\"f\">\n";
92+ print " <input type=\"submit\" name=\"do_attach\" value=\" 添 付 \">\n";
93+ print " <input type=\"hidden\" name=\"a\" value=\"attach\">\n";
94+ print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
95+ print "</form>\n";
96+
97+ &print_footer();
98+}
99+
100+#-------------------------------------------------------------------------------
101+# ページの作成
102+#-------------------------------------------------------------------------------
103+sub new_page {
104+ &print_header("ページの作成");
105+ print "<form action=\"$SCRIPT_NAME\" method=\"POST\">\n";
106+ print " <input type=\"text\" name=\"p\" size=\"40\">\n";
107+ print " <input type=\"submit\" name=\"do_save\" value=\" 作 成 \">\n";
108+ print " <input type=\"hidden\" name=\"a\" value=\"edit\">\n";
109+ print "</form>\n";
110+ &print_footer();
111+}
112+
113+#-------------------------------------------------------------------------------
114+# ページの保存
115+#-------------------------------------------------------------------------------
116+sub save_page {
117+ my $page = $in{"p"};
118+ my $source = $in{"source"};
119+
120+ if($in{"preview"} ne ""){
121+ &edit_page($source);
122+
123+ } else {
124+ # ページの削除
125+ if($source eq ""){
126+ # 更新の重複チェック
127+ if(&Wiki::exists_page($page)){
128+ if($in{"t"} != &Wiki::get_last_modified($page)){
129+ &Util::error("このページは既に更新されています。");
130+ } else {
131+ &Wiki::remove_page($page);
132+ }
133+ }
134+ &redirect("FrontPage");
135+
136+ # ページの作成または更新
137+ } else {
138+ # 更新の重複チェック
139+ if(&Wiki::exists_page($page)){
140+ if($in{"t"} != &Wiki::get_last_modified($page)){
141+ &Util::error("このページは既に更新されています。");
142+ }
143+ }
144+ &Wiki::save_page($page,$source);
145+ &redirect($page);
146+ }
147+ }
148+}
149+
150+#-------------------------------------------------------------------------------
151+# ファイルの添付
152+#-------------------------------------------------------------------------------
153+sub attach_file {
154+ my $page = $in{"p"};
155+ my $file = $in{"f"}; # ファイル内容を取得
156+ my $name = $incfn{"f"}; # ファイル名を取得
157+
158+ if($file eq ""){
159+ &Util::error("ファイルが指定されていません。");
160+ }
161+
162+ if($name eq ""){
163+ return;
164+ }
165+
166+ $name =~ s/\\/\//g; # パス区切り文字を/に変換
167+ $name = substr($name,rindex($name,"/")+1); # ファイル名のみを取得
168+
169+ my $filename = sprintf("%s/%s.%s",$main::ATTACH_DIR,&Util::url_encode($page),&Util::url_encode($name));
170+ open(DATA,">$filename");
171+ binmode(DATA);
172+ print DATA $file;
173+ close(DATA);
174+
175+ &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));
176+}
177+
178+#-------------------------------------------------------------------------------
179+# 添付ファイルの削除確認
180+#-------------------------------------------------------------------------------
181+sub attach_delete_confirm {
182+ my $page = $in{"p"};
183+ my $file = $in{"f"};
184+
185+ if($file eq ""){
186+ &Util::error("ファイルが指定されていません。");
187+ }
188+
189+ &print_header("添付ファイルの削除");
190+ printf ("<p><a href=\"$MAIN_SCRIPT?p=%s\">%s</a>から".
191+ "<a href=\"$DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>を削除してよろしいですか?</p>\n",
192+ &Util::url_encode($page),&Util::escapeHTML($page),
193+ &Util::url_encode($page),&Util::url_encode($file),&Util::escapeHTML($file));
194+
195+ print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";
196+ print " <input type=\"submit\" name=\"do_delete\" value=\" 削 除 \">\n";
197+ print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
198+ print " <input type=\"hidden\" name=\"f\" value=\"".&Util::escapeHTML($file)."\">\n";
199+ print " <input type=\"hidden\" name=\"a\" value=\"delete\">\n";
200+ print "</form>\n";
201+ &print_footer();
202+}
203+
204+#-------------------------------------------------------------------------------
205+# 添付ファイルの削除
206+#-------------------------------------------------------------------------------
207+sub attach_delete {
208+ my $page = $in{"p"};
209+ my $file = $in{"f"};
210+
211+ if($file eq ""){
212+ &Util::error("ファイルが指定されていません。");
213+ }
214+
215+ my $filename = sprintf("$ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));
216+ unlink($filename);
217+
218+ &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));
219+}
--- a/lib/cgi-lib.pl
+++ b/lib/cgi-lib.pl
@@ -1,456 +1,456 @@
1-# Perl Routines to Manipulate CGI input
2-# S.E.Brenner@bioc.cam.ac.uk
3-# $Id: cgi-lib.pl,v 1.2 2004/05/24 14:35:08 takezoe Exp $
4-#
5-# Copyright (c) 1996 Steven E. Brenner
6-# Unpublished work.
7-# Permission granted to use and modify this library so long as the
8-# copyright above is maintained, modifications are documented, and
9-# credit is given for any use of the library.
10-#
11-# Thanks are due to many people for reporting bugs and suggestions
12-# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
13-# Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews
14-
15-# For more information, see:
16-# http://www.bio.cam.ac.uk/cgi-lib/
17-
18-$cgi_lib'version = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
19-
20-
21-# Parameters affecting cgi-lib behavior
22-# User-configurable parameters affecting file upload.
23-$cgi_lib'maxdata = 131072; # maximum bytes to accept via POST - 2^17
24-$cgi_lib'writefiles = 0; # directory to which to write files, or
25- # 0 if files should not be written
26-$cgi_lib'filepre = "cgi-lib"; # Prefix of file names, in directory above
27-
28-# Do not change the following parameters unless you have special reasons
29-$cgi_lib'bufsize = 8192; # default buffer size when reading multipart
30-$cgi_lib'maxbound = 100; # maximum boundary length to be encounterd
31-$cgi_lib'headerout = 0; # indicates whether the header has been printed
32-
33-
34-# ReadParse
35-# Reads in GET or POST data, converts it to unescaped text, and puts
36-# key/value pairs in %in, using "\0" to separate multiple selections
37-
38-# Returns >0 if there was input, 0 if there was no input
39-# undef indicates some failure.
40-
41-# Now that cgi scripts can be put in the normal file space, it is useful
42-# to combine both the form and the script in one place. If no parameters
43-# are given (i.e., ReadParse returns FALSE), then a form could be output.
44-
45-# If a reference to a hash is given, then the data will be stored in that
46-# hash, but the data from $in and @in will become inaccessable.
47-# If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse,
48-# information is stored there, rather than in $in, @in, and %in.
49-# Second, third, and fourth parameters fill associative arrays analagous to
50-# %in with data relevant to file uploads.
51-
52-# If no method is given, the script will process both command-line arguments
53-# of the form: name=value and any text that is in $ENV{'QUERY_STRING'}
54-# This is intended to aid debugging and may be changed in future releases
55-
56-sub ReadParse {
57- local (*in) = shift if @_; # CGI input
58- local (*incfn, # Client's filename (may not be provided)
59- *inct, # Client's content-type (may not be provided)
60- *insfn) = @_; # Server's filename (for spooled files)
61- local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn, $got);
62-
63- # Disable warnings as this code deliberately uses local and environment
64- # variables which are preset to undef (i.e., not explicitly initialized)
65- $perlwarn = $^W;
66- $^W = 0;
67-
68- binmode(STDIN); # we need these for DOS-based systems
69- binmode(STDOUT); # and they shouldn't hurt anything else
70- binmode(STDERR);
71-
72- # Get several useful env variables
73- $type = $ENV{'CONTENT_TYPE'};
74- $len = $ENV{'CONTENT_LENGTH'};
75- $meth = $ENV{'REQUEST_METHOD'};
76-
77- if ($len > $cgi_lib'maxdata) { #'
78- &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n");
79- }
80-
81- if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD' ||
82- $type eq 'application/x-www-form-urlencoded') {
83- local ($key, $val, $i);
84-
85- # Read in text
86- if (!defined $meth || $meth eq '') {
87- $in = $ENV{'QUERY_STRING'};
88- $cmdflag = 1; # also use command-line options
89- } elsif($meth eq 'GET' || $meth eq 'HEAD') {
90- $in = $ENV{'QUERY_STRING'};
91- } elsif ($meth eq 'POST') {
92- if (($got = read(STDIN, $in, $len) != $len))
93- {$errflag="Short Read: wanted $len, got $got\n";};
94- } else {
95- &CgiDie("cgi-lib.pl: Unknown request method: $meth\n");
96- }
97-
98- @in = split(/[&;]/,$in);
99- push(@in, @ARGV) if $cmdflag; # add command-line parameters
100-
101- foreach $i (0 .. $#in) {
102- # Convert plus to space
103- $in[$i] =~ s/\+/ /g;
104-
105- # Split into key and value.
106- ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
107-
108- # Convert %XX from hex numbers to alphanumeric
109- $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
110- $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
111-
112- # Associate key and value
113- $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
114- $in{$key} .= $val;
115- }
116-
117- } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
118- # for efficiency, compile multipart code only if needed
119-$errflag = !(eval <<'END_MULTIPART');
120-
121- local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
122- local ($bpos, $lpos, $left, $amt, $fn, $ser);
123- local ($bufsize, $maxbound, $writefiles) =
124- ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);
125-
126-
127- # The following lines exist solely to eliminate spurious warning messages
128- $buf = '';
129-
130- ($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary
131- ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
132- &CgiDie ("Boundary not provided: probably a bug in your server")
133- unless $boundary;
134- $boundary = "--" . $boundary;
135- $blen = length ($boundary);
136-
137- if ($ENV{'REQUEST_METHOD'} ne 'POST') {
138- &CgiDie("Invalid request method for multipart/form-data: $meth\n");
139- }
140-
141- if ($writefiles) {
142- local($me);
143- stat ($writefiles);
144- $writefiles = "/tmp" unless -d _ && -r _ && -w _;
145- # ($me) = $0 =~ m#([^/]*)$#;
146- $writefiles .= "/$cgi_lib'filepre";
147- }
148-
149- # read in the data and split into parts:
150- # put headers in @in and data in %in
151- # General algorithm:
152- # There are two dividers: the border and the '\r\n\r\n' between
153- # header and body. Iterate between searching for these
154- # Retain a buffer of size(bufsize+maxbound); the latter part is
155- # to ensure that dividers don't get lost by wrapping between two bufs
156- # Look for a divider in the current batch. If not found, then
157- # save all of bufsize, move the maxbound extra buffer to the front of
158- # the buffer, and read in a new bufsize bytes. If a divider is found,
159- # save everything up to the divider. Then empty the buffer of everything
160- # up to the end of the divider. Refill buffer to bufsize+maxbound
161- # Note slightly odd organization. Code before BODY: really goes with
162- # code following HEAD:, but is put first to 'pre-fill' buffers. BODY:
163- # is placed before HEAD: because we first need to discard any 'preface,'
164- # which would be analagous to a body without a preceeding head.
165-
166- $left = $len;
167- PART: # find each part of the multi-part while reading data
168- while (1) {
169- die $@ if $errflag;
170-
171- $amt = ($left > $bufsize+$maxbound-length($buf)
172- ? $bufsize+$maxbound-length($buf): $left);
173- $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
174- die "Short Read: wanted $amt, got $got\n" if $errflag;
175- $left -= $amt;
176-
177- $in{$name} .= "\0" if defined $in{$name};
178- $in{$name} .= $fn if $fn;
179-
180- $name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted
181- if (defined $1) {
182- $insfn{$1} .= "\0" if defined $insfn{$1};
183- $insfn{$1} .= $fn if $fn;
184- }
185-
186- BODY:
187- while (($bpos = index($buf, $boundary)) == -1) {
188- die $@ if $errflag;
189- if ($name) { # if no $name, then it's the prologue -- discard
190- if ($fn) { print FILE substr($buf, 0, $bufsize); }
191- else { $in{$name} .= substr($buf, 0, $bufsize); }
192- }
193- $buf = substr($buf, $bufsize);
194- $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
195- $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt);
196- die "Short Read: wanted $amt, got $got\n" if $errflag;
197- $left -= $amt;
198- }
199- if (defined $name) { # if no $name, then it's the prologue -- discard
200- if ($fn) { print FILE substr($buf, 0, $bpos-2); }
201- else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
202- }
203- close (FILE);
204- last PART if substr($buf, $bpos + $blen, 4) eq "--\r\n";
205- substr($buf, 0, $bpos+$blen+2) = '';
206- $amt = ($left > $bufsize+$maxbound-length($buf)
207- ? $bufsize+$maxbound-length($buf) : $left);
208- $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
209- die "Short Read: wanted $amt, got $got\n" if $errflag;
210- $left -= $amt;
211-
212-
213- undef $head; undef $fn;
214- HEAD:
215- while (($lpos = index($buf, "\r\n\r\n")) == -1) {
216- die $@ if $errflag;
217- $head .= substr($buf, 0, $bufsize);
218- $buf = substr($buf, $bufsize);
219- $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
220- $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt);
221- die "Short Read: wanted $amt, got $got\n" if $errflag;
222- $left -= $amt;
223- }
224- $head .= substr($buf, 0, $lpos+2);
225- push (@in, $head);
226- @heads = split("\r\n", $head);
227- ($cd) = grep (/^\s*Content-Disposition:/i, @heads);
228- ($ct) = grep (/^\s*Content-Type:/i, @heads);
229-
230- ($name) = $cd =~ /\bname="([^"]+)"/i; #";
231- ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
232-
233- ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str
234- ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
235- $incfn{$name} .= (defined $in{$name} ? "\0" : "") .
236- (defined $fname ? $fname : "");
237-
238- ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #";
239- ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;
240- $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;
241-
242- if ($writefiles && defined $fname) {
243- $ser++;
244- $fn = $writefiles . ".$$.$ser";
245- open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
246- binmode (FILE); # write files accurately
247- }
248- substr($buf, 0, $lpos+4) = '';
249- undef $fname;
250- undef $ctype;
251- }
252-
253-1;
254-END_MULTIPART
255- if ($errflag) {
256- local ($errmsg, $value);
257- $errmsg = $@ || $errflag;
258- foreach $value (values %insfn) {
259- unlink(split("\0",$value));
260- }
261- &CgiDie($errmsg);
262- } else {
263- # everything's ok.
264- }
265- } else {
266- &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");
267- }
268-
269- # no-ops to avoid warnings
270- $insfn = $insfn;
271- $incfn = $incfn;
272- $inct = $inct;
273-
274- $^W = $perlwarn;
275-
276- return ($errflag ? undef : scalar(@in));
277-}
278-
279-
280-# PrintHeader
281-# Returns the magic line which tells WWW that we're an HTML document
282-
283-sub PrintHeader {
284- return "Content-type: text/html\n\n";
285-}
286-
287-
288-# HtmlTop
289-# Returns the <head> of a document and the beginning of the body
290-# with the title and a body <h1> header as specified by the parameter
291-
292-sub HtmlTop
293-{
294- local ($title) = @_;
295-
296- return <<END_OF_TEXT;
297-<html>
298-<head>
299-<title>$title</title>
300-</head>
301-<body>
302-<h1>$title</h1>
303-END_OF_TEXT
304-}
305-
306-
307-# HtmlBot
308-# Returns the </body>, </html> codes for the bottom of every HTML page
309-
310-sub HtmlBot
311-{
312- return "</body>\n</html>\n";
313-}
314-
315-
316-# SplitParam
317-# Splits a multi-valued parameter into a list of the constituent parameters
318-
319-sub SplitParam
320-{
321- local ($param) = @_;
322- local (@params) = split ("\0", $param);
323- return (wantarray ? @params : $params[0]);
324-}
325-
326-
327-# MethGet
328-# Return true if this cgi call was using the GET request, false otherwise
329-
330-sub MethGet {
331- return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "GET");
332-}
333-
334-
335-# MethPost
336-# Return true if this cgi call was using the POST request, false otherwise
337-
338-sub MethPost {
339- return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "POST");
340-}
341-
342-
343-# MyBaseUrl
344-# Returns the base URL to the script (i.e., no extra path or query string)
345-sub MyBaseUrl {
346- local ($ret, $perlwarn);
347- $perlwarn = $^W; $^W = 0;
348- $ret = 'http://' . $ENV{'SERVER_NAME'} .
349- ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
350- $ENV{'SCRIPT_NAME'};
351- $^W = $perlwarn;
352- return $ret;
353-}
354-
355-
356-# MyFullUrl
357-# Returns the full URL to the script (i.e., with extra path or query string)
358-sub MyFullUrl {
359- local ($ret, $perlwarn);
360- $perlwarn = $^W; $^W = 0;
361- $ret = 'http://' . $ENV{'SERVER_NAME'} .
362- ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
363- $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
364- (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');
365- $^W = $perlwarn;
366- return $ret;
367-}
368-
369-
370-# MyURL
371-# Returns the base URL to the script (i.e., no extra path or query string)
372-# This is obsolete and will be removed in later versions
373-sub MyURL {
374- return &MyBaseUrl;
375-}
376-
377-
378-# CgiError
379-# Prints out an error message which which containes appropriate headers,
380-# markup, etcetera.
381-# Parameters:
382-# If no parameters, gives a generic error message
383-# Otherwise, the first parameter will be the title and the rest will
384-# be given as different paragraphs of the body
385-
386-sub CgiError {
387- local (@msg) = @_;
388- local ($i,$name);
389-
390- if (!@msg) {
391- $name = &MyFullUrl;
392- @msg = ("Error: script $name encountered fatal error\n");
393- };
394-
395- if (!$cgi_lib'headerout) { #')
396- print &PrintHeader;
397- print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";
398- }
399- print "<h1>$msg[0]</h1>\n";
400- foreach $i (1 .. $#msg) {
401- print "<p>$msg[$i]</p>\n";
402- }
403-
404- $cgi_lib'headerout++;
405-}
406-
407-
408-# CgiDie
409-# Identical to CgiError, but also quits with the passed error message.
410-
411-sub CgiDie {
412- local (@msg) = @_;
413- &CgiError (@msg);
414- die @msg;
415-}
416-
417-
418-# PrintVariables
419-# Nicely formats variables. Three calling options:
420-# A non-null associative array - prints the items in that array
421-# A type-glob - prints the items in the associated assoc array
422-# nothing - defaults to use %in
423-# Typical use: &PrintVariables()
424-
425-sub PrintVariables {
426- local (*in) = @_ if @_ == 1;
427- local (%in) = @_ if @_ > 1;
428- local ($out, $key, $output);
429-
430- $output = "\n<dl compact>\n";
431- foreach $key (sort keys(%in)) {
432- foreach (split("\0", $in{$key})) {
433- ($out = $_) =~ s/\n/<br>\n/g;
434- $output .= "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";
435- }
436- }
437- $output .= "</dl>\n";
438-
439- return $output;
440-}
441-
442-# PrintEnv
443-# Nicely formats all environment variables and returns HTML string
444-sub PrintEnv {
445- &PrintVariables(*ENV);
446-}
447-
448-
449-# The following lines exist only to avoid warning messages
450-$cgi_lib'writefiles = $cgi_lib'writefiles;
451-$cgi_lib'bufsize = $cgi_lib'bufsize ;
452-$cgi_lib'maxbound = $cgi_lib'maxbound;
453-$cgi_lib'version = $cgi_lib'version;
454-$cgi_lib'filepre = $cgi_lib'filepre;
455-
1+# Perl Routines to Manipulate CGI input
2+# S.E.Brenner@bioc.cam.ac.uk
3+# $Id: cgi-lib.pl,v 1.2 2004/05/24 14:35:08 takezoe Exp $
4+#
5+# Copyright (c) 1996 Steven E. Brenner
6+# Unpublished work.
7+# Permission granted to use and modify this library so long as the
8+# copyright above is maintained, modifications are documented, and
9+# credit is given for any use of the library.
10+#
11+# Thanks are due to many people for reporting bugs and suggestions
12+# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
13+# Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews
14+
15+# For more information, see:
16+# http://www.bio.cam.ac.uk/cgi-lib/
17+
18+$cgi_lib'version = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
19+
20+
21+# Parameters affecting cgi-lib behavior
22+# User-configurable parameters affecting file upload.
23+$cgi_lib'maxdata = 131072; # maximum bytes to accept via POST - 2^17
24+$cgi_lib'writefiles = 0; # directory to which to write files, or
25+ # 0 if files should not be written
26+$cgi_lib'filepre = "cgi-lib"; # Prefix of file names, in directory above
27+
28+# Do not change the following parameters unless you have special reasons
29+$cgi_lib'bufsize = 8192; # default buffer size when reading multipart
30+$cgi_lib'maxbound = 100; # maximum boundary length to be encounterd
31+$cgi_lib'headerout = 0; # indicates whether the header has been printed
32+
33+
34+# ReadParse
35+# Reads in GET or POST data, converts it to unescaped text, and puts
36+# key/value pairs in %in, using "\0" to separate multiple selections
37+
38+# Returns >0 if there was input, 0 if there was no input
39+# undef indicates some failure.
40+
41+# Now that cgi scripts can be put in the normal file space, it is useful
42+# to combine both the form and the script in one place. If no parameters
43+# are given (i.e., ReadParse returns FALSE), then a form could be output.
44+
45+# If a reference to a hash is given, then the data will be stored in that
46+# hash, but the data from $in and @in will become inaccessable.
47+# If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse,
48+# information is stored there, rather than in $in, @in, and %in.
49+# Second, third, and fourth parameters fill associative arrays analagous to
50+# %in with data relevant to file uploads.
51+
52+# If no method is given, the script will process both command-line arguments
53+# of the form: name=value and any text that is in $ENV{'QUERY_STRING'}
54+# This is intended to aid debugging and may be changed in future releases
55+
56+sub ReadParse {
57+ local (*in) = shift if @_; # CGI input
58+ local (*incfn, # Client's filename (may not be provided)
59+ *inct, # Client's content-type (may not be provided)
60+ *insfn) = @_; # Server's filename (for spooled files)
61+ local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn, $got);
62+
63+ # Disable warnings as this code deliberately uses local and environment
64+ # variables which are preset to undef (i.e., not explicitly initialized)
65+ $perlwarn = $^W;
66+ $^W = 0;
67+
68+ binmode(STDIN); # we need these for DOS-based systems
69+ binmode(STDOUT); # and they shouldn't hurt anything else
70+ binmode(STDERR);
71+
72+ # Get several useful env variables
73+ $type = $ENV{'CONTENT_TYPE'};
74+ $len = $ENV{'CONTENT_LENGTH'};
75+ $meth = $ENV{'REQUEST_METHOD'};
76+
77+ if ($len > $cgi_lib'maxdata) { #'
78+ &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n");
79+ }
80+
81+ if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD' ||
82+ $type eq 'application/x-www-form-urlencoded') {
83+ local ($key, $val, $i);
84+
85+ # Read in text
86+ if (!defined $meth || $meth eq '') {
87+ $in = $ENV{'QUERY_STRING'};
88+ $cmdflag = 1; # also use command-line options
89+ } elsif($meth eq 'GET' || $meth eq 'HEAD') {
90+ $in = $ENV{'QUERY_STRING'};
91+ } elsif ($meth eq 'POST') {
92+ if (($got = read(STDIN, $in, $len) != $len))
93+ {$errflag="Short Read: wanted $len, got $got\n";};
94+ } else {
95+ &CgiDie("cgi-lib.pl: Unknown request method: $meth\n");
96+ }
97+
98+ @in = split(/[&;]/,$in);
99+ push(@in, @ARGV) if $cmdflag; # add command-line parameters
100+
101+ foreach $i (0 .. $#in) {
102+ # Convert plus to space
103+ $in[$i] =~ s/\+/ /g;
104+
105+ # Split into key and value.
106+ ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
107+
108+ # Convert %XX from hex numbers to alphanumeric
109+ $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
110+ $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
111+
112+ # Associate key and value
113+ $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
114+ $in{$key} .= $val;
115+ }
116+
117+ } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
118+ # for efficiency, compile multipart code only if needed
119+$errflag = !(eval <<'END_MULTIPART');
120+
121+ local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
122+ local ($bpos, $lpos, $left, $amt, $fn, $ser);
123+ local ($bufsize, $maxbound, $writefiles) =
124+ ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);
125+
126+
127+ # The following lines exist solely to eliminate spurious warning messages
128+ $buf = '';
129+
130+ ($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary
131+ ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
132+ &CgiDie ("Boundary not provided: probably a bug in your server")
133+ unless $boundary;
134+ $boundary = "--" . $boundary;
135+ $blen = length ($boundary);
136+
137+ if ($ENV{'REQUEST_METHOD'} ne 'POST') {
138+ &CgiDie("Invalid request method for multipart/form-data: $meth\n");
139+ }
140+
141+ if ($writefiles) {
142+ local($me);
143+ stat ($writefiles);
144+ $writefiles = "/tmp" unless -d _ && -r _ && -w _;
145+ # ($me) = $0 =~ m#([^/]*)$#;
146+ $writefiles .= "/$cgi_lib'filepre";
147+ }
148+
149+ # read in the data and split into parts:
150+ # put headers in @in and data in %in
151+ # General algorithm:
152+ # There are two dividers: the border and the '\r\n\r\n' between
153+ # header and body. Iterate between searching for these
154+ # Retain a buffer of size(bufsize+maxbound); the latter part is
155+ # to ensure that dividers don't get lost by wrapping between two bufs
156+ # Look for a divider in the current batch. If not found, then
157+ # save all of bufsize, move the maxbound extra buffer to the front of
158+ # the buffer, and read in a new bufsize bytes. If a divider is found,
159+ # save everything up to the divider. Then empty the buffer of everything
160+ # up to the end of the divider. Refill buffer to bufsize+maxbound
161+ # Note slightly odd organization. Code before BODY: really goes with
162+ # code following HEAD:, but is put first to 'pre-fill' buffers. BODY:
163+ # is placed before HEAD: because we first need to discard any 'preface,'
164+ # which would be analagous to a body without a preceeding head.
165+
166+ $left = $len;
167+ PART: # find each part of the multi-part while reading data
168+ while (1) {
169+ die $@ if $errflag;
170+
171+ $amt = ($left > $bufsize+$maxbound-length($buf)
172+ ? $bufsize+$maxbound-length($buf): $left);
173+ $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
174+ die "Short Read: wanted $amt, got $got\n" if $errflag;
175+ $left -= $amt;
176+
177+ $in{$name} .= "\0" if defined $in{$name};
178+ $in{$name} .= $fn if $fn;
179+
180+ $name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted
181+ if (defined $1) {
182+ $insfn{$1} .= "\0" if defined $insfn{$1};
183+ $insfn{$1} .= $fn if $fn;
184+ }
185+
186+ BODY:
187+ while (($bpos = index($buf, $boundary)) == -1) {
188+ die $@ if $errflag;
189+ if ($name) { # if no $name, then it's the prologue -- discard
190+ if ($fn) { print FILE substr($buf, 0, $bufsize); }
191+ else { $in{$name} .= substr($buf, 0, $bufsize); }
192+ }
193+ $buf = substr($buf, $bufsize);
194+ $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
195+ $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt);
196+ die "Short Read: wanted $amt, got $got\n" if $errflag;
197+ $left -= $amt;
198+ }
199+ if (defined $name) { # if no $name, then it's the prologue -- discard
200+ if ($fn) { print FILE substr($buf, 0, $bpos-2); }
201+ else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
202+ }
203+ close (FILE);
204+ last PART if substr($buf, $bpos + $blen, 4) eq "--\r\n";
205+ substr($buf, 0, $bpos+$blen+2) = '';
206+ $amt = ($left > $bufsize+$maxbound-length($buf)
207+ ? $bufsize+$maxbound-length($buf) : $left);
208+ $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
209+ die "Short Read: wanted $amt, got $got\n" if $errflag;
210+ $left -= $amt;
211+
212+
213+ undef $head; undef $fn;
214+ HEAD:
215+ while (($lpos = index($buf, "\r\n\r\n")) == -1) {
216+ die $@ if $errflag;
217+ $head .= substr($buf, 0, $bufsize);
218+ $buf = substr($buf, $bufsize);
219+ $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
220+ $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt);
221+ die "Short Read: wanted $amt, got $got\n" if $errflag;
222+ $left -= $amt;
223+ }
224+ $head .= substr($buf, 0, $lpos+2);
225+ push (@in, $head);
226+ @heads = split("\r\n", $head);
227+ ($cd) = grep (/^\s*Content-Disposition:/i, @heads);
228+ ($ct) = grep (/^\s*Content-Type:/i, @heads);
229+
230+ ($name) = $cd =~ /\bname="([^"]+)"/i; #";
231+ ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
232+
233+ ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str
234+ ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
235+ $incfn{$name} .= (defined $in{$name} ? "\0" : "") .
236+ (defined $fname ? $fname : "");
237+
238+ ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #";
239+ ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;
240+ $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;
241+
242+ if ($writefiles && defined $fname) {
243+ $ser++;
244+ $fn = $writefiles . ".$$.$ser";
245+ open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
246+ binmode (FILE); # write files accurately
247+ }
248+ substr($buf, 0, $lpos+4) = '';
249+ undef $fname;
250+ undef $ctype;
251+ }
252+
253+1;
254+END_MULTIPART
255+ if ($errflag) {
256+ local ($errmsg, $value);
257+ $errmsg = $@ || $errflag;
258+ foreach $value (values %insfn) {
259+ unlink(split("\0",$value));
260+ }
261+ &CgiDie($errmsg);
262+ } else {
263+ # everything's ok.
264+ }
265+ } else {
266+ &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");
267+ }
268+
269+ # no-ops to avoid warnings
270+ $insfn = $insfn;
271+ $incfn = $incfn;
272+ $inct = $inct;
273+
274+ $^W = $perlwarn;
275+
276+ return ($errflag ? undef : scalar(@in));
277+}
278+
279+
280+# PrintHeader
281+# Returns the magic line which tells WWW that we're an HTML document
282+
283+sub PrintHeader {
284+ return "Content-type: text/html\n\n";
285+}
286+
287+
288+# HtmlTop
289+# Returns the <head> of a document and the beginning of the body
290+# with the title and a body <h1> header as specified by the parameter
291+
292+sub HtmlTop
293+{
294+ local ($title) = @_;
295+
296+ return <<END_OF_TEXT;
297+<html>
298+<head>
299+<title>$title</title>
300+</head>
301+<body>
302+<h1>$title</h1>
303+END_OF_TEXT
304+}
305+
306+
307+# HtmlBot
308+# Returns the </body>, </html> codes for the bottom of every HTML page
309+
310+sub HtmlBot
311+{
312+ return "</body>\n</html>\n";
313+}
314+
315+
316+# SplitParam
317+# Splits a multi-valued parameter into a list of the constituent parameters
318+
319+sub SplitParam
320+{
321+ local ($param) = @_;
322+ local (@params) = split ("\0", $param);
323+ return (wantarray ? @params : $params[0]);
324+}
325+
326+
327+# MethGet
328+# Return true if this cgi call was using the GET request, false otherwise
329+
330+sub MethGet {
331+ return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "GET");
332+}
333+
334+
335+# MethPost
336+# Return true if this cgi call was using the POST request, false otherwise
337+
338+sub MethPost {
339+ return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "POST");
340+}
341+
342+
343+# MyBaseUrl
344+# Returns the base URL to the script (i.e., no extra path or query string)
345+sub MyBaseUrl {
346+ local ($ret, $perlwarn);
347+ $perlwarn = $^W; $^W = 0;
348+ $ret = 'http://' . $ENV{'SERVER_NAME'} .
349+ ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
350+ $ENV{'SCRIPT_NAME'};
351+ $^W = $perlwarn;
352+ return $ret;
353+}
354+
355+
356+# MyFullUrl
357+# Returns the full URL to the script (i.e., with extra path or query string)
358+sub MyFullUrl {
359+ local ($ret, $perlwarn);
360+ $perlwarn = $^W; $^W = 0;
361+ $ret = 'http://' . $ENV{'SERVER_NAME'} .
362+ ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
363+ $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
364+ (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');
365+ $^W = $perlwarn;
366+ return $ret;
367+}
368+
369+
370+# MyURL
371+# Returns the base URL to the script (i.e., no extra path or query string)
372+# This is obsolete and will be removed in later versions
373+sub MyURL {
374+ return &MyBaseUrl;
375+}
376+
377+
378+# CgiError
379+# Prints out an error message which which containes appropriate headers,
380+# markup, etcetera.
381+# Parameters:
382+# If no parameters, gives a generic error message
383+# Otherwise, the first parameter will be the title and the rest will
384+# be given as different paragraphs of the body
385+
386+sub CgiError {
387+ local (@msg) = @_;
388+ local ($i,$name);
389+
390+ if (!@msg) {
391+ $name = &MyFullUrl;
392+ @msg = ("Error: script $name encountered fatal error\n");
393+ };
394+
395+ if (!$cgi_lib'headerout) { #')
396+ print &PrintHeader;
397+ print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";
398+ }
399+ print "<h1>$msg[0]</h1>\n";
400+ foreach $i (1 .. $#msg) {
401+ print "<p>$msg[$i]</p>\n";
402+ }
403+
404+ $cgi_lib'headerout++;
405+}
406+
407+
408+# CgiDie
409+# Identical to CgiError, but also quits with the passed error message.
410+
411+sub CgiDie {
412+ local (@msg) = @_;
413+ &CgiError (@msg);
414+ die @msg;
415+}
416+
417+
418+# PrintVariables
419+# Nicely formats variables. Three calling options:
420+# A non-null associative array - prints the items in that array
421+# A type-glob - prints the items in the associated assoc array
422+# nothing - defaults to use %in
423+# Typical use: &PrintVariables()
424+
425+sub PrintVariables {
426+ local (*in) = @_ if @_ == 1;
427+ local (%in) = @_ if @_ > 1;
428+ local ($out, $key, $output);
429+
430+ $output = "\n<dl compact>\n";
431+ foreach $key (sort keys(%in)) {
432+ foreach (split("\0", $in{$key})) {
433+ ($out = $_) =~ s/\n/<br>\n/g;
434+ $output .= "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";
435+ }
436+ }
437+ $output .= "</dl>\n";
438+
439+ return $output;
440+}
441+
442+# PrintEnv
443+# Nicely formats all environment variables and returns HTML string
444+sub PrintEnv {
445+ &PrintVariables(*ENV);
446+}
447+
448+
449+# The following lines exist only to avoid warning messages
450+$cgi_lib'writefiles = $cgi_lib'writefiles;
451+$cgi_lib'bufsize = $cgi_lib'bufsize ;
452+$cgi_lib'maxbound = $cgi_lib'maxbound;
453+$cgi_lib'version = $cgi_lib'version;
454+$cgi_lib'filepre = $cgi_lib'filepre;
455+
456456 1; #return true
\ No newline at end of file
--- a/lib/common.pl
+++ b/lib/common.pl
@@ -1,1236 +1,1236 @@
1-################################################################################
2-#
3-# FSWikiLite 共通関数ファイル
4-#
5-################################################################################
6-require "./lib/cgi-lib.pl";
7-require "./lib/jcode.pl";
8-require "./lib/mimew.pl";
9-require "./lib/setup.pl";
10-#-------------------------------------------------------------------------------
11-# 引数で渡したページに遷移
12-#-------------------------------------------------------------------------------
13-sub redirect {
14- my $page = shift;
15- my $url = "$MAIN_SCRIPT?p=".&Util::url_encode($page);
16- &redirectURL($url);
17-}
18-
19-#-------------------------------------------------------------------------------
20-# 引数で渡したURLに遷移
21-#-------------------------------------------------------------------------------
22-sub redirectURL {
23- my $url = shift;
24-
25- print "Content-Type: text/html;charset=EUC-JP\n";
26- print "Pragma: no-cache\n";
27- print "Cache-Control: no-cache\n\n";
28- print "<html>\n";
29- print " <head>\n";
30- print " <title>moving...</title>\n";
31- print " <meta http-equiv=\"Refresh\" content=\"0;URL=$url\">\n";
32- print " </head>\n";
33- print " <body>\n";
34- print " Wait or <a href=\"$url\">Click Here!!</a>\n";
35- print " </body>\n";
36- print "</html>\n";
37-
38- exit;
39-}
40-
41-#-------------------------------------------------------------------------------
42-# ヘッダを表示
43-#-------------------------------------------------------------------------------
44-sub print_header {
45- my $title = shift;
46- my $show = shift;
47-
48- print "Content-Type: text/html;charset=EUC-JP\n";
49- print "Pragma: no-cache\n";
50- print "Cache-Control: no-cache\n\n";
51- print "<html>\n";
52- print "<head>\n";
53- print "<title>".&Util::escapeHTML($title)." - $SITE_TITLE</title>\n";
54- print "<link rel=\"stylesheet\" type=\"text/css\" href=\"$THEME_URL\">\n";
55- print "</head>\n";
56- print "<body>\n";
57-
58- print "<div class=\"adminmenu\">\n";
59- print " <span class=\"adminmenu\">\n";
60- print " <a href=\"$MAIN_SCRIPT?p=FrontPage\">FrontPage</a>\n";
61- print " <a href=\"$EDIT_SCRIPT?a=new\">新規</a>\n";
62- if($show==1){
63- print " <a href=\"$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($in{"p"})."\">編集</a>\n";
64- }
65- print " <a href=\"$MAIN_SCRIPT?a=search\">検索</a>\n";
66- print " <a href=\"$MAIN_SCRIPT?a=list\">一覧</a>\n";
67- print " <a href=\"$MAIN_SCRIPT?p=Help\">ヘルプ</a>\n";
68- print " </span>\n";
69- print "</div>\n";
70-
71- print "<h1>".&Util::escapeHTML($title)."</h1>\n";
72- if(&Wiki::exists_page("Menu")){
73- print "<div class=\"main\">\n";
74- }
75-
76-}
77-
78-#-------------------------------------------------------------------------------
79-# フッタを表示
80-#-------------------------------------------------------------------------------
81-sub print_footer {
82- if(&Wiki::exists_page("Menu")){
83- print "</div>\n";
84- print "<div class=\"sidebar\">\n";
85- print &Wiki::process_wiki(&Wiki::get_page("Menu"));
86- print "</div>\n";
87- }
88- print "<div class=\"footer\">Powered by <a href=\"$main::SITE_URL\">FreeStyleWikiLite $main::VERSION</a></div>\n";
89- print "</body></html>\n";
90-}
91-
92-###############################################################################
93-#
94-# Wiki関連の関数を提供するパッケージ
95-#
96-###############################################################################
97-package Wiki;
98-#-------------------------------------------------------------------------------
99-# ページを取得
100-#-------------------------------------------------------------------------------
101-sub get_page {
102- my $page = &Util::url_encode(shift);
103-
104- open(DATA,"$main::DATA_DIR/$page.wiki") or &Util::error("$main::DATA_DIR/$page.wikiのオープンに失敗しました。");
105- my $content = "";
106- while(<DATA>){
107- $content .= $_;
108- }
109- close(DATA);
110-
111- return $content;
112-}
113-#-------------------------------------------------------------------------------
114-# ページを保存
115-#-------------------------------------------------------------------------------
116-sub save_page {
117- my $page = shift;
118- my $source = shift;
119-
120- $page = &Util::trim($page);
121- $source =~ s/\r\n/\n/g;
122- $source =~ s/\r/\n/g;
123-
124- my $enc_page = &Util::url_encode($page);
125- my $action = 'MODIFY';
126- unless(-e "$main::DATA_DIR/$enc_page.wiki"){
127- $action = 'CREATE';
128- }
129-
130- # バックアップファイルを作成
131- if(-e "$main::DATA_DIR/$enc_page.wiki"){
132- open(BACKUP,">$main::BACKUP_DIR/$enc_page.bak") or &Util::error("$main::BACKUP_DIR/$enc_page.bakのオープンに失敗しました。");
133- open(DATA ,"$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wikiのオープンに失敗しました。");
134- while(<DATA>){
135- print BACKUP $_;
136- }
137- close(DATA);
138- close(BACKUP);
139- }
140-
141- # 入力内容を保存
142- open(DATA,">$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wikiのオープンに失敗しました。");
143- print DATA $source;
144- close(DATA);
145-
146- &send_mail($action,$page);
147-}
148-#-------------------------------------------------------------------------------
149-# ページを削除
150-#-------------------------------------------------------------------------------
151-sub remove_page {
152- my $page = shift;
153- my $enc_page = &Util::url_encode($page);
154- unlink("$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wikiの削除に失敗しました。");
155-
156- &send_mail('DELETE',$page);
157-}
158-#-------------------------------------------------------------------------------
159-# メール送信
160-#-------------------------------------------------------------------------------
161-sub send_mail {
162- my $action = shift;
163- my $page = shift;
164- my $enc_page = &Util::url_encode($page);
165-
166- if($main::ADMIN_MAIL eq "" || $main::SEND_MAIL eq ""){
167- return;
168- }
169-
170- my $subject = "";
171- if($action eq 'CREATE'){
172- $subject = "[FSWikiLite]$pageが作成されました";
173-
174- } elsif($action eq 'MODIFY'){
175- $subject = "[FSWikiLite]$pageが更新されました";
176-
177- } elsif($action eq 'DELETE'){
178- $subject = "[FSWikiLite]$pageが削除されました";
179- }
180-
181- # MIMEエンコード
182- $subject = &main::mimeencode($subject);
183-
184- my $head = "Subject: $subject\n".
185- "From: $main::ADMIN_MAIL\n".
186- "Content-Transfer-Encoding: 7bit\n".
187- "Content-Type: text/plain; charset=\"ISO-2022-JP\"\n".
188- "Reply-To: $main::ADMIN_MAIL\n".
189- "\n";
190-
191- my $body = "IP:".$ENV{'REMOTE_ADDR'}."\n".
192- "UA:".$ENV{'HTTP_USER_AGENT'}."\n";
193-
194- if($action eq 'MODIFY' || $action eq 'DELETE'){
195- if(-e "$main::BACKUP_DIR/$enc_page.bak"){
196- $body .= "以下は変更前のソースです。\n".
197- "-----------------------------------------------------\n";
198- open(BACKUP,"$main::BACKUP_DIR/$enc_page.bak");
199- while(my $line = <BACKUP>){
200- $body .= $line;
201- }
202- close(BACKUP);
203- }
204- }
205-
206- # 文字コードの変換(jcode.plを使用する)
207- &jcode::convert(\$body,'jis');
208-
209- open(MAIL,"| $main::SEND_MAIL $main::ADMIN_MAIL");
210- print MAIL $head;
211- print MAIL $body;
212- close(MAIL);
213-}
214-#-------------------------------------------------------------------------------
215-# ページの一覧を取得
216-#-------------------------------------------------------------------------------
217-sub get_page_list {
218- opendir(DIR, $main::DATA_DIR);
219- my ($fileentry, @files);
220- while($fileentry = readdir(DIR)){
221- my $type = substr($fileentry,rindex($fileentry,"."));
222- if($type eq ".wiki"){
223- push(@files, "$main::DATA_DIR/$fileentry");
224- }
225- }
226- closedir(DIR);
227-
228- my @pages;
229- foreach my $entry (@files){
230- my @stat = stat($entry);
231- my $time = $stat[9];
232-
233- $entry = substr($entry,length($main::DATA_DIR)+1);
234- $entry =~ /(.+?)\.wiki/;
235- my $page = &Util::url_decode($1);
236- push(@pages,{NAME=>$page,TIME=>$time});
237- }
238-
239- @pages = sort { $b->{TIME}<=>$a->{TIME} } @pages;
240- return @pages;
241-}
242-
243-#-------------------------------------------------------------------------------
244-# ページの更新日時を取得
245-#-------------------------------------------------------------------------------
246-sub get_last_modified {
247- my $page = shift;
248- if(&exists_page($page)){
249- my $file = sprintf("%s/%s.wiki",$main::DATA_DIR,&Util::url_encode($page));
250- my @stat = stat($file);
251- return $stat[9];
252- } else {
253- return undef;
254- }
255-}
256-
257-#-------------------------------------------------------------------------------
258-# ページが存在するかどうか
259-#-------------------------------------------------------------------------------
260-sub exists_page {
261- my $page = &Util::url_encode(shift);
262- if(-e "$main::DATA_DIR/$page.wiki"){
263- return 1;
264- } else {
265- return 0;
266- }
267-}
268-
269-#-------------------------------------------------------------------------------
270-# Wikiソースを渡してHTMLを取得します
271-#-------------------------------------------------------------------------------
272-sub process_wiki {
273- my $source = shift;
274- my $main = shift;
275- my $parser = HTMLParser->new($main);
276- $parser->parse($source);
277-
278- return $parser->{html};
279-}
280-
281-###############################################################################
282-#
283-# HTMLパーサ
284-#
285-###############################################################################
286-package HTMLParser;
287-#==============================================================================
288-# コンストラクタ
289-#==============================================================================
290-sub new {
291- my $class = shift;
292- my $mainflg = shift;
293- my $self = {};
294-
295- if(!defined($mainflg) || $mainflg eq ""){ $mainflg = 0; }
296-
297- $self->{html} = "";
298- $self->{pre} = "";
299- $self->{quote} = "";
300- $self->{table} = 0;
301- $self->{level} = 0;
302- $self->{para} = 0;
303- $self->{p_cnt} = 0;
304- $self->{explan} = 0;
305- $self->{main} = $mainflg;
306- return bless $self,$class;
307-}
308-
309-#===============================================================================
310-# パース
311-#===============================================================================
312-sub parse {
313- my $self = shift;
314- my $source = shift;
315-
316- $source =~ s/\r//g;
317- my @lines = split(/\n/,$source);
318-
319- foreach my $line (@lines){
320- chomp $line;
321-
322- # 複数行の説明
323- $self->multi_explanation($line);
324-
325- my $word1 = substr($line,0,1);
326- my $word2 = substr($line,0,2);
327- my $word3 = substr($line,0,3);
328-
329- # 空行
330- if($line eq ""){
331- $self->l_paragraph();
332- next;
333- }
334-
335- # パラグラフプラグイン
336- if($line =~ /^{{((.|\s)+?)}}$/){
337- my $plugin = &Util::parse_plugin($1);
338- my $class = $main::P_PLUGIN->{$plugin->{command}};
339- if(defined($class)){
340- $self->l_plugin($plugin);
341- } else {
342- my @obj = $self->parse_line($line);
343- $self->l_text(\@obj);
344- }
345- next;
346- }
347-
348- # PRE
349- if($word1 eq " " || $word1 eq "\t"){
350- $self->l_verbatim($line);
351-
352- # 見出し
353- } elsif($word3 eq "!!!"){
354- my @obj = $self->parse_line(substr($line,3));
355- $self->l_headline(1,\@obj);
356-
357- } elsif($word2 eq "!!"){
358- my @obj = $self->parse_line(substr($line,2));
359- $self->l_headline(2,\@obj);
360-
361- } elsif($word1 eq "!"){
362- my @obj = $self->parse_line(substr($line,1));
363- $self->l_headline(3,\@obj);
364-
365- # 項目
366- } elsif($word3 eq "***"){
367- my @obj = $self->parse_line(substr($line,3));
368- $self->l_list(3,\@obj);
369-
370- } elsif($word2 eq "**"){
371- my @obj = $self->parse_line(substr($line,2));
372- $self->l_list(2,\@obj);
373-
374- } elsif($word1 eq "*"){
375- my @obj = $self->parse_line(substr($line,1));
376- $self->l_list(1,\@obj);
377-
378- # 番号付き項目
379- } elsif($word3 eq "+++"){
380- my @obj = $self->parse_line(substr($line,3));
381- $self->l_numlist(3,\@obj);
382-
383- } elsif($word2 eq "++"){
384- my @obj = $self->parse_line(substr($line,2));
385- $self->l_numlist(2,\@obj);
386-
387- } elsif($word1 eq "+"){
388- my @obj = $self->parse_line(substr($line,1));
389- $self->l_numlist(1,\@obj);
390-
391- # 水平線
392- } elsif($line eq "----"){
393- $self->l_line();
394-
395- # 引用
396- } elsif($word2 eq '""'){
397- my @obj = $self->parse_line(substr($line,2));
398- $self->l_quotation(\@obj);
399-
400- # 説明
401- } elsif(index($line,":")==0 && index($line,":",1)!=-1){
402- if(index($line,":::")==0){
403- $self->{dd} .= substr($line,3);
404- next;
405- }
406- if(index($line,"::")==0){
407- if($self->{dt} ne "" || $self->{dd} ne ""){
408- $self->multi_explanation;
409- }
410- $self->{dt} = substr($line,2);
411- $self->{dl_flag} = 1;
412- next;
413- }
414- my $dt = substr($line,1,index($line,":",1)-1);
415- my $dd = substr($line,index($line,":",1)+1);
416- my @obj1 = $self->parse_line($dt);
417- my @obj2 = $self->parse_line($dd);
418- $self->l_explanation(\@obj1,\@obj2);
419-
420- # テーブル
421- } elsif($word1 eq ","){
422- if($line =~ /,$/){
423- $line .= " ";
424- }
425- my @spl = map {/^"(.*)"$/ ? scalar($_ = $1, s/\"\"/\"/g, $_) : $_}
426- ($line =~ /,\s*(\"[^\"]*(?:\"\"[^\"]*)*\"|[^,]*)/g);
427- my @array;
428- foreach my $value (@spl){
429- my @cell = $self->parse_line($value);
430- push @array,\@cell;
431- }
432- $self->l_table(\@array);
433-
434- # コメント
435- } elsif($word2 eq "//"){
436-
437- # 何もない行
438- } else {
439- my @obj = $self->parse_line($line);
440- $self->l_text(\@obj);
441- }
442- }
443-
444- # 複数行の説明
445- $self->multi_explanation;
446-
447- $self->end_parse;
448-}
449-
450-#===============================================================================
451-# 複数行の説明
452-#===============================================================================
453-sub multi_explanation {
454- my $self = shift;
455- my $line = shift;
456- if($self->{dl_flag}==1 && (index($line,":")!=0 || !defined($line))){
457- my @obj1 = $self->parse_line($self->{dt});
458- my @obj2 = $self->parse_line($self->{dd});
459- $self->l_explanation(\@obj1,\@obj2);
460- $self->{dl_flag} = 0;
461- $self->{dt} = "";
462- $self->{dd} = "";
463- }
464-}
465-
466-#===============================================================================
467-# 1行分をパース
468-#===============================================================================
469-sub parse_line {
470- my $self = shift;
471- my $source = shift;
472- my @array = ();
473-
474- # プラグイン
475- if($source =~ /{{((.|\s)+?)}}/){
476- my $pre = $`;
477- my $post = $';
478- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
479- my $plugin = &Util::parse_plugin($1);
480- my $class = $main::I_PLUGIN->{$plugin->{command}};
481- if(defined($class)){
482- push @array,$self->plugin($plugin);
483- } else {
484- push @array,$self->text("{{$1}}");
485- }
486- if($post ne ""){ push(@array,$self->parse_line($post)); }
487-
488- # ボールド、イタリック、取り消し線、下線
489- } elsif($source =~ /((''')|('')|(==)|(__))(.+?)(\1)/){
490- my $pre = $`;
491- my $post = $';
492- my $type = $1;
493- my $label = $6;
494- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
495- if($type eq "'''"){
496- push @array,$self->bold($label);
497- } elsif($type eq "__"){
498- push @array,$self->underline($label);
499- } elsif($type eq "''"){
500- push @array,$self->italic($label);
501- } elsif($type eq "=="){
502- push @array,$self->denialline($label);
503- }
504- if($post ne ""){ push(@array,$self->parse_line($post)); }
505-
506- # ページ別名リンク
507- } elsif($source =~ /\[\[([^\[]+?)\|(.+?)\]\]/){
508- my $pre = $`;
509- my $post = $';
510- my $label = $1;
511- my $page = $2;
512- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
513- push @array,$self->wiki_anchor($page,$label);
514- if($post ne ""){ push(@array,$self->parse_line($post)); }
515-
516- # URL別名リンク
517- } elsif($source =~ /\[([^\[]+?)\|((http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/
518- || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/
519- || $source =~ /\[([^\[]+?)\|((\/|\.\/|\.\.\/)+[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/){
520- my $pre = $`;
521- my $post = $';
522- my $label = $1;
523- my $url = $2;
524- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
525- if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
526- push @array,"<span class=\"error\">不正なリンクです。</span>";
527- } else {
528- push @array,$self->url_anchor($url,$label);
529- }
530- if($post ne ""){ push(@array,$self->parse_line($post)); }
531-
532- # URLリンク
533- } elsif($source =~ /(http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*/
534- || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/){
535- my $pre = $`;
536- my $post = $';
537- my $url = $&;
538- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
539- if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
540- push @array,"<span class=\"error\">不正なリンクです。</span>";
541- } else {
542- push @array,$self->url_anchor($url);
543- }
544- if($post ne ""){ push(@array,$self->parse_line($post)); }
545-
546- # ページリンク
547- } elsif($source =~ /\[\[([^\|]+?)\]\]/){
548- my $pre = $`;
549- my $post = $';
550- my $page = $1;
551- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
552- push @array,$self->wiki_anchor($page);
553- if($post ne ""){ push(@array,$self->parse_line($post)); }
554-
555- # 任意のURLリンク
556- } elsif($source =~ /\[([^\[]+?)\|(.+?)\]/){
557- my $pre = $`;
558- my $post = $';
559- my $label = $1;
560- my $url = $2;
561- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
562- if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
563- push @array,"<span class=\"error\">不正なリンクです。</span>";
564- } else {
565- push @array,$self->url_anchor($url,$label);
566- }
567- if($post ne ""){ push(@array,$self->parse_line($post)); }
568-
569- # WikiName
570- } elsif($main::WIKI_NAME==1 && $source =~ /[A-Z]+?[a-z]+?([A-Z]+?[a-z]+)+/){
571- my $pre = $`;
572- my $post = $';
573- my $page = $&;
574- if($pre ne ""){ push(@array,$self->parse_line($pre)); }
575- push @array,$self->wiki_anchor($page);
576- if($post ne ""){ push(@array,$self->parse_line($post)); }
577-
578- } else {
579- push @array,$self->text($source);
580- }
581-
582- return @array;
583-}
584-
585-#==============================================================================
586-# リスト
587-#==============================================================================
588-sub l_list {
589- my $self = shift;
590- my $level = shift;
591- my $obj = shift;
592-
593- if($self->{para}==1){
594- $self->{html} .= "</p>\n";
595- $self->{para} = 0;
596- }
597-
598- $self->end_verbatim;
599- $self->end_table;
600- $self->end_quote;
601- $self->end_explan;
602-
603- my $html = join("",@$obj);
604- my $plus = 1;
605-
606- if($level < $self->{level}){ $plus = -1; }
607- if($level==$self->{level}){
608- $self->{html} .= "</li>\n";
609- }
610- while($level != $self->{level}){
611- if($plus==1){
612- $self->{html} .= "<ul>\n";
613- push(@{$self->{close_list}},"</ul>\n");
614- } else {
615- $self->{html} .= "</li>\n";
616- $self->{html} .= pop(@{$self->{close_list}});
617- }
618- $self->{level} += $plus;
619- }
620-
621- $self->{html} .= "<li>".$html;
622-}
623-
624-#==============================================================================
625-# 番号付きリスト
626-#==============================================================================
627-sub l_numlist {
628- my $self = shift;
629- my $level = shift;
630- my $obj = shift;
631-
632- if($self->{para}==1){
633- $self->{html} .= "</p>\n";
634- $self->{para} = 0;
635- }
636-
637- $self->end_verbatim;
638- $self->end_table;
639- $self->end_quote;
640- $self->end_explan;
641-
642- my $html = join("",@$obj);
643- my $plus = 1;
644-
645- if($level < $self->{level}){ $plus = -1; }
646- if($level==$self->{level}){
647- $self->{html} .= "</li>\n";
648- }
649- while($level != $self->{level}){
650- if($plus==1){
651- $self->{html} .= "<ol>\n";
652- push(@{$self->{close_list}},"</ol>\n");
653- } else {
654- $self->{html} .= "</li>\n";
655- $self->{html} .= pop(@{$self->{close_list}});
656- }
657- $self->{level} += $plus;
658- }
659- $self->{html} .= "<li>".$html;
660-}
661-
662-#==============================================================================
663-# リストの終了
664-#==============================================================================
665-sub end_list {
666- my $self = shift;
667- if ($self->{level}!=0) {
668- $self->{html} .= "</li>\n";
669- while($self->{level}!=0){
670- $self->{html} .= pop(@{$self->{close_list}});
671- $self->{level} += -1;
672- }
673- }
674-}
675-
676-#==============================================================================
677-# ヘッドライン
678-#==============================================================================
679-sub l_headline {
680- my $self = shift;
681- my $level = shift;
682- my $obj = shift;
683-
684- if($self->{para}==1){
685- $self->{html} .= "</p>\n";
686- $self->{para} = 0;
687- }
688-
689- $self->end_list;
690- $self->end_verbatim;
691- $self->end_table;
692- $self->end_quote;
693- $self->end_explan;
694-
695- my $html = join("",@$obj);
696-
697- if(!$self->{main}){
698- $self->{html} .= "<h".($level+1).">".$html."</h".($level+1).">\n";
699- } else {
700- if($level==2){
701- $self->{html} .= "<h".($level+1)."><a name=\"p".$self->{p_cnt}."\">".
702- "<span class=\"sanchor\">_</span></a>".$html."</h".($level+1).">\n";
703- } else {
704- $self->{html} .= "<h".($level+1).">".
705- "<a name=\"p".$self->{p_cnt}."\">".$html."</a>".
706- "</h".($level+1).">\n";
707- }
708- }
709- $self->{p_cnt}++;
710-}
711-
712-#==============================================================================
713-# 水平線
714-#==============================================================================
715-sub l_line {
716- my $self = shift;
717-
718- $self->end_list;
719- $self->end_verbatim;
720- $self->end_table;
721- $self->end_quote;
722- $self->end_explan;
723-
724- $self->{html} .= "<hr>\n";
725-}
726-
727-#==============================================================================
728-# 段落区切り
729-#==============================================================================
730-sub l_paragraph {
731- my $self = shift;
732-
733- $self->end_list;
734- $self->end_verbatim;
735- $self->end_table;
736- $self->end_quote;
737- $self->end_explan;
738-
739- if($self->{para}==1){
740- $self->{html} .= "</p>\n";
741- $self->{para} = 0;
742- }
743-}
744-
745-#==============================================================================
746-# 整形済テキスト
747-#==============================================================================
748-sub l_verbatim {
749- my $self = shift;
750- my $text = shift;
751-
752- if($self->{para}==1){
753- $self->{html} .= "</p>\n";
754- $self->{para} = 0;
755- }
756-
757- $self->end_list;
758- $self->end_table;
759- $self->end_quote;
760- $self->end_explan;
761-
762- $self->{pre} .= Util::escapeHTML($text)."\n";
763-}
764-
765-sub end_verbatim {
766- my $self = shift;
767- if($self->{pre} ne ""){
768- $self->{html} .= "<pre>".$self->{pre}."</pre>";
769- $self->{pre} = "";
770- }
771-}
772-
773-#==============================================================================
774-# テーブル
775-#==============================================================================
776-sub l_table {
777- my $self = shift;
778- my $row = shift;
779- $self->end_list;
780- $self->end_verbatim;
781- $self->end_quote;
782- $self->end_explan;
783-
784- if($self->{table}==0){
785- $self->{table}=1;
786- $self->{html} .= "<table>\n";
787- $self->{html} .= "<tr>\n";
788- foreach(@$row){
789- my $html = join("",@$_);
790- $self->{html} .= "<th>".$html."</th>\n";
791- }
792- $self->{html} .= "</tr>\n";
793- } else {
794- $self->{table}=2;
795- $self->{html} .= "<tr>\n";
796- foreach(@$row){
797- my $html = join("",@$_);
798- $self->{html} .= "<td>".$html."</td>\n";
799- }
800- $self->{html} .= "</tr>\n";
801- }
802-}
803-
804-sub end_table {
805- my $self = shift;
806- if($self->{table}!=0){
807- $self->{table} = 0;
808- $self->{html} .= "</table>\n";
809- }
810-}
811-
812-#==============================================================================
813-# パース終了時の処理
814-#==============================================================================
815-sub end_parse {
816- my $self = shift;
817- $self->end_list;
818- $self->end_verbatim;
819- $self->end_table;
820- $self->end_quote;
821- $self->end_explan;
822-
823- if($self->{para}==1){
824- $self->{html} .= "</p>\n";
825- $self->{para} = 0;
826- }
827-}
828-
829-#==============================================================================
830-# 行書式に該当しない行
831-#==============================================================================
832-sub l_text {
833- my $self = shift;
834- my $obj = shift;
835- $self->end_list;
836- $self->end_verbatim;
837- $self->end_table;
838- $self->end_quote;
839- $self->end_explan;
840- my $html = join("",@$obj);
841-
842- if($self->{para}==0){
843- $self->{html} .= "<p>";
844- $self->{para} = 1;
845- }
846- $self->{html} .= $html;
847-}
848-
849-#==============================================================================
850-# 引用
851-#==============================================================================
852-sub l_quotation {
853- my $self = shift;
854- my $obj = shift;
855- $self->end_list;
856- $self->end_verbatim;
857- $self->end_table;
858- $self->end_explan;
859- my $html = join("",@$obj);
860- $self->{quote} .= "<p>".$html."</p>\n";
861-}
862-
863-sub end_quote {
864- my $self = shift;
865- if($self->{quote} ne ""){
866- $self->{html} .= "<blockquote>".$self->{quote}."</blockquote>\n";
867- $self->{quote} = "";
868- }
869-}
870-
871-#==============================================================================
872-# 説明
873-#==============================================================================
874-sub l_explanation {
875- my $self = shift;
876- my $obj1 = shift;
877- my $obj2 = shift;
878-
879- if($self->{para}==1){
880- $self->{html} .= "</p>";
881- $self->{para} = 0;
882- }
883-
884- $self->end_list;
885- $self->end_verbatim;
886- $self->end_table;
887- $self->end_quote;
888-
889- if($self->{explan}==0){
890- $self->{explan}=1;
891- $self->{html} .= "<dl>\n";
892- }
893-
894- my $html1 = join("",@$obj1);
895- my $html2 = join("",@$obj2);
896-
897- $self->{html} .= "<dt>".$html1."</dt>\n<dd>".$html2."</dd>\n";
898-}
899-
900-sub end_explan {
901- my $self = shift;
902- if($self->{explan}!=0){
903- $self->{explan} = 0;
904- $self->{html} .= "</dl>\n";
905- }
906-}
907-
908-#==============================================================================
909-# ボールド
910-#==============================================================================
911-sub bold {
912- my $self = shift;
913- my $text = shift;
914- return "<strong>".join("",$self->parse_line($text))."</strong>";
915-}
916-
917-#==============================================================================
918-# イタリック
919-#==============================================================================
920-sub italic {
921- my $self = shift;
922- my $text = shift;
923- return "<em>".join("",$self->parse_line($text))."</em>";
924-}
925-
926-#==============================================================================
927-# 下線
928-#==============================================================================
929-sub underline {
930- my $self = shift;
931- my $text = shift;
932- return "<ins>".join("",$self->parse_line($text))."</ins>";
933-}
934-
935-#==============================================================================
936-# 打ち消し線
937-#==============================================================================
938-sub denialline {
939- my $self = shift;
940- my $text = shift;
941- return "<del>".join("",$self->parse_line($text))."</del>";
942-}
943-
944-#==============================================================================
945-# URLアンカ
946-#==============================================================================
947-sub url_anchor {
948- my $self = shift;
949- my $url = shift;
950- my $name = shift;
951-
952- if($name eq ""){
953- $name = $url;
954- }
955-
956- if($url eq $name && $url=~/\.(gif|jpg|jpeg|bmp|png)$/i){
957- return "<img src=\"".$url."\">";
958- } else {
959- return "<a href=\"$url\">".Util::escapeHTML($name)."</a>";
960- }
961-}
962-
963-#==============================================================================
964-# Wikiページへのアンカ
965-#==============================================================================
966-sub wiki_anchor {
967- my $self = shift;
968- my $page = shift;
969- my $name = shift;
970-
971- if(!defined($name) || $name eq ""){
972- $name = $page;
973- }
974-
975- if(&Wiki::exists_page($page)){
976- return "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\" class=\"wikipage\">".
977- &Util::escapeHTML($name)."</a>";
978- } else {
979- return "<span class=\"nopage\">".&Util::escapeHTML($name)."</span>".
980- "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">?</a>";
981- }
982-}
983-
984-#==============================================================================
985-# ただのテキスト
986-#==============================================================================
987-sub text {
988- my $self = shift;
989- my $text = shift;
990- return &Util::escapeHTML($text);
991-}
992-
993-#==============================================================================
994-# インラインプラグイン
995-#==============================================================================
996-sub plugin {
997- my $self = shift;
998- my $plugin = shift;
999-
1000- my $func_ref = $main::I_PLUGIN->{$plugin->{command}};
1001- my $result = &$func_ref(@{$plugin->{args}});
1002- if(defined($result) && $result ne ""){
1003- return ($result);
1004- }
1005-
1006- return undef;
1007-}
1008-
1009-#==============================================================================
1010-# パラグラフプラグイン
1011-#==============================================================================
1012-sub l_plugin {
1013- my $self = shift;
1014- my $plugin = shift;
1015-
1016- if($self->{para}==1){
1017- $self->{html} .= "</p>\n";
1018- $self->{para} = 0;
1019- }
1020-
1021- $self->end_list;
1022- $self->end_verbatim;
1023- $self->end_table;
1024- $self->end_quote;
1025- $self->end_explan;
1026-
1027- my $func_ref = $main::P_PLUGIN->{$plugin->{command}};
1028- my $result = &$func_ref(@{$plugin->{args}});
1029- if(defined($result) && $result ne ""){
1030- $self->{html} .= $result;
1031- }
1032-}
1033-
1034-#==============================================================================
1035-# イメージ
1036-#==============================================================================
1037-sub l_image {
1038- my $self = shift;
1039- my $page = shift;
1040- my $file = shift;
1041- my $wiki = $self->{wiki};
1042-
1043- if($self->{para}==1){
1044- $self->{html} .= "</p>";
1045- $self->{para} = 0;
1046- }
1047-
1048- $self->end_list;
1049- $self->end_verbatim;
1050- $self->end_table;
1051- $self->end_quote;
1052- $self->end_explan;
1053-
1054- $self->{html} .= "<img src=\"".$wiki->config('script_name')."?action=ATTACH&amp;".
1055- "page=".&Util::url_encode($page)."&amp;file=".&Util::url_encode($file)."\">";
1056-}
1057-
1058-
1059-################################################################################
1060-#
1061-# ユーティリティ関数を提供するパッケージ
1062-#
1063-################################################################################
1064-package Util;
1065-#===============================================================================
1066-# 引数で渡された文字列をURLエンコードして返します。
1067-#===============================================================================
1068-sub url_encode {
1069- my $retstr = shift;
1070- $retstr =~ s/([^ 0-9A-Za-z])/sprintf("%%%.2X", ord($1))/eg;
1071- $retstr =~ tr/ /+/;
1072- return $retstr;
1073-}
1074-
1075-#===============================================================================
1076-# 引数で渡された文字列をURLデコードして返します。
1077-#===============================================================================
1078-sub url_decode{
1079- my $retstr = shift;
1080- $retstr =~ tr/+/ /;
1081- $retstr =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
1082- return $retstr;
1083-}
1084-
1085-#===============================================================================
1086-# 引数で渡された文字列のHTMLタグをエスケープして返します。
1087-#===============================================================================
1088-sub escapeHTML {
1089- my($retstr) = shift;
1090- my %table = (
1091- '&' => '&amp;',
1092- '"' => '&quot;',
1093- '<' => '&lt;',
1094- '>' => '&gt;',
1095- );
1096- $retstr =~ s/([&\"<>])/$table{$1}/go;
1097- return $retstr;
1098-}
1099-
1100-
1101-#===============================================================================
1102-# 日付をフォーマットします。
1103-#===============================================================================
1104-sub format_date {
1105- my $t = shift;
1106- my ($sec, $min, $hour, $mday, $mon, $year) = localtime($t);
1107- return sprintf("%04d年%02d月%02d日 %02d時%02d分%02d秒",
1108- $year+1900,$mon+1,$mday,$hour,$min,$sec);
1109-}
1110-
1111-#===============================================================================
1112-# 文字列の両端の空白を切り落とします。
1113-#===============================================================================
1114-sub trim {
1115- my $text = shift;
1116- if(!defined($text)){
1117- return "";
1118- }
1119- $text =~ s/^(?:\s)+//o;
1120- $text =~ s/(?:\s)+$//o;
1121- return $text;
1122-}
1123-
1124-
1125-#===============================================================================
1126-# タグを削除して文字列のみを取得します。
1127-#===============================================================================
1128-sub delete_tag {
1129- my $text = shift;
1130- $text =~ s/<(.|\s)+?>//g;
1131- return $text;
1132-}
1133-
1134-#===============================================================================
1135-# 数値かどうかチェックします。
1136-#===============================================================================
1137-sub check_numeric {
1138- my $text = shift;
1139- if($text =~ /^[0-9]+$/){
1140- return 1;
1141- } else {
1142- return 0;
1143- }
1144-}
1145-
1146-#===============================================================================
1147-# エラーを通知
1148-#===============================================================================
1149-sub error {
1150- my $error = shift;
1151-
1152- print "Content-Type: text/html;charset=EUC-JP\n\n";
1153- print "<html>\n";
1154- print "<head><title>エラー - FSWikiLite</title></head>\n";
1155- print "<body>\n";
1156- print "<h1>エラーが発生しました</h1>\n";
1157- print "<pre>\n";
1158- print &Util::escapeHTML($error);
1159- print "</pre>\n";
1160- print "</body><html>\n";
1161-
1162- exit;
1163-}
1164-
1165-#===============================================================================
1166-# 携帯電話かどうかチェックします。
1167-#===============================================================================
1168-sub handyphone {
1169- my $ua = $ENV{'HTTP_USER_AGENT'};
1170- if(!defined($ua)){
1171- return 0;
1172- }
1173- if($ua=~/^DoCoMo\// || $ua=~ /^J-PHONE\// || $ua=~ /UP\.Browser/){
1174- return 1;
1175- } else {
1176- return 0;
1177- }
1178-}
1179-
1180-#===============================================================================
1181-# インラインプラグインをパースしてコマンドと引数に分割
1182-#===============================================================================
1183-sub parse_plugin {
1184- my $text = shift;
1185- my ($cmd,@args_tmp) = split(/ /,$text);
1186- my $args_txt = &Util::trim(join(" ",@args_tmp));
1187-
1188- my @ret_args;
1189- my $tmp = "";
1190- my $escape = 0;
1191- my $quote = 0;
1192-
1193- for(my $i=0;$i<length($args_txt);$i++){
1194- my $c = substr($args_txt,$i,1);
1195-
1196- if($quote!=1 && $c eq ","){
1197- if($tmp ne ""){
1198- push(@ret_args,$tmp);
1199- $tmp = "";
1200- $quote = 0;
1201- }
1202- } elsif($quote==1 && $c eq "\\"){
1203- if($escape==0){
1204- $escape = 1;
1205- } else {
1206- $tmp .= $c;
1207- $escape = 0;
1208- }
1209- } elsif($quote==0 && $c eq '"'){
1210- if($tmp eq ""){
1211- $quote = 1;
1212- } else {
1213- $tmp .= $c;
1214- }
1215- } elsif($quote==1 && $c eq '"'){
1216- if($escape==1){
1217- $tmp .= $c;
1218- $escape = 0;
1219- } else {
1220- $quote = 2;
1221- }
1222- } elsif($quote==2){
1223- return {error=>"インラインプラグインの構文が不正です。"};
1224- } else {
1225- $tmp .= $c;
1226- }
1227- }
1228-
1229- if($tmp ne ""){
1230- push(@ret_args,$tmp);
1231- }
1232-
1233- return {command=>$cmd,args=>\@ret_args};
1234-}
1235-
1236-1;
1+################################################################################
2+#
3+# FSWikiLite 共通関数ファイル
4+#
5+################################################################################
6+require "./lib/cgi-lib.pl";
7+require "./lib/jcode.pl";
8+require "./lib/mimew.pl";
9+require "./lib/setup.pl";
10+#-------------------------------------------------------------------------------
11+# 引数で渡したページに遷移
12+#-------------------------------------------------------------------------------
13+sub redirect {
14+ my $page = shift;
15+ my $url = "$MAIN_SCRIPT?p=".&Util::url_encode($page);
16+ &redirectURL($url);
17+}
18+
19+#-------------------------------------------------------------------------------
20+# 引数で渡したURLに遷移
21+#-------------------------------------------------------------------------------
22+sub redirectURL {
23+ my $url = shift;
24+
25+ print "Content-Type: text/html;charset=EUC-JP\n";
26+ print "Pragma: no-cache\n";
27+ print "Cache-Control: no-cache\n\n";
28+ print "<html>\n";
29+ print " <head>\n";
30+ print " <title>moving...</title>\n";
31+ print " <meta http-equiv=\"Refresh\" content=\"0;URL=$url\">\n";
32+ print " </head>\n";
33+ print " <body>\n";
34+ print " Wait or <a href=\"$url\">Click Here!!</a>\n";
35+ print " </body>\n";
36+ print "</html>\n";
37+
38+ exit;
39+}
40+
41+#-------------------------------------------------------------------------------
42+# ヘッダを表示
43+#-------------------------------------------------------------------------------
44+sub print_header {
45+ my $title = shift;
46+ my $show = shift;
47+
48+ print "Content-Type: text/html;charset=EUC-JP\n";
49+ print "Pragma: no-cache\n";
50+ print "Cache-Control: no-cache\n\n";
51+ print "<html>\n";
52+ print "<head>\n";
53+ print "<title>".&Util::escapeHTML($title)." - $SITE_TITLE</title>\n";
54+ print "<link rel=\"stylesheet\" type=\"text/css\" href=\"$THEME_URL\">\n";
55+ print "</head>\n";
56+ print "<body>\n";
57+
58+ print "<div class=\"adminmenu\">\n";
59+ print " <span class=\"adminmenu\">\n";
60+ print " <a href=\"$MAIN_SCRIPT?p=FrontPage\">FrontPage</a>\n";
61+ print " <a href=\"$EDIT_SCRIPT?a=new\">新規</a>\n";
62+ if($show==1){
63+ print " <a href=\"$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($in{"p"})."\">編集</a>\n";
64+ }
65+ print " <a href=\"$MAIN_SCRIPT?a=search\">検索</a>\n";
66+ print " <a href=\"$MAIN_SCRIPT?a=list\">一覧</a>\n";
67+ print " <a href=\"$MAIN_SCRIPT?p=Help\">ヘルプ</a>\n";
68+ print " </span>\n";
69+ print "</div>\n";
70+
71+ print "<h1>".&Util::escapeHTML($title)."</h1>\n";
72+ if(&Wiki::exists_page("Menu")){
73+ print "<div class=\"main\">\n";
74+ }
75+
76+}
77+
78+#-------------------------------------------------------------------------------
79+# フッタを表示
80+#-------------------------------------------------------------------------------
81+sub print_footer {
82+ if(&Wiki::exists_page("Menu")){
83+ print "</div>\n";
84+ print "<div class=\"sidebar\">\n";
85+ print &Wiki::process_wiki(&Wiki::get_page("Menu"));
86+ print "</div>\n";
87+ }
88+ print "<div class=\"footer\">Powered by <a href=\"$main::SITE_URL\">FreeStyleWikiLite $main::VERSION</a></div>\n";
89+ print "</body></html>\n";
90+}
91+
92+###############################################################################
93+#
94+# Wiki関連の関数を提供するパッケージ
95+#
96+###############################################################################
97+package Wiki;
98+#-------------------------------------------------------------------------------
99+# ページを取得
100+#-------------------------------------------------------------------------------
101+sub get_page {
102+ my $page = &Util::url_encode(shift);
103+
104+ open(DATA,"$main::DATA_DIR/$page.wiki") or &Util::error("$main::DATA_DIR/$page.wikiのオープンに失敗しました。");
105+ my $content = "";
106+ while(<DATA>){
107+ $content .= $_;
108+ }
109+ close(DATA);
110+
111+ return $content;
112+}
113+#-------------------------------------------------------------------------------
114+# ページを保存
115+#-------------------------------------------------------------------------------
116+sub save_page {
117+ my $page = shift;
118+ my $source = shift;
119+
120+ $page = &Util::trim($page);
121+ $source =~ s/\r\n/\n/g;
122+ $source =~ s/\r/\n/g;
123+
124+ my $enc_page = &Util::url_encode($page);
125+ my $action = 'MODIFY';
126+ unless(-e "$main::DATA_DIR/$enc_page.wiki"){
127+ $action = 'CREATE';
128+ }
129+
130+ # バックアップファイルを作成
131+ if(-e "$main::DATA_DIR/$enc_page.wiki"){
132+ open(BACKUP,">$main::BACKUP_DIR/$enc_page.bak") or &Util::error("$main::BACKUP_DIR/$enc_page.bakのオープンに失敗しました。");
133+ open(DATA ,"$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wikiのオープンに失敗しました。");
134+ while(<DATA>){
135+ print BACKUP $_;
136+ }
137+ close(DATA);
138+ close(BACKUP);
139+ }
140+
141+ # 入力内容を保存
142+ open(DATA,">$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wikiのオープンに失敗しました。");
143+ print DATA $source;
144+ close(DATA);
145+
146+ &send_mail($action,$page);
147+}
148+#-------------------------------------------------------------------------------
149+# ページを削除
150+#-------------------------------------------------------------------------------
151+sub remove_page {
152+ my $page = shift;
153+ my $enc_page = &Util::url_encode($page);
154+ unlink("$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wikiの削除に失敗しました。");
155+
156+ &send_mail('DELETE',$page);
157+}
158+#-------------------------------------------------------------------------------
159+# メール送信
160+#-------------------------------------------------------------------------------
161+sub send_mail {
162+ my $action = shift;
163+ my $page = shift;
164+ my $enc_page = &Util::url_encode($page);
165+
166+ if($main::ADMIN_MAIL eq "" || $main::SEND_MAIL eq ""){
167+ return;
168+ }
169+
170+ my $subject = "";
171+ if($action eq 'CREATE'){
172+ $subject = "[FSWikiLite]$pageが作成されました";
173+
174+ } elsif($action eq 'MODIFY'){
175+ $subject = "[FSWikiLite]$pageが更新されました";
176+
177+ } elsif($action eq 'DELETE'){
178+ $subject = "[FSWikiLite]$pageが削除されました";
179+ }
180+
181+ # MIMEエンコード
182+ $subject = &main::mimeencode($subject);
183+
184+ my $head = "Subject: $subject\n".
185+ "From: $main::ADMIN_MAIL\n".
186+ "Content-Transfer-Encoding: 7bit\n".
187+ "Content-Type: text/plain; charset=\"ISO-2022-JP\"\n".
188+ "Reply-To: $main::ADMIN_MAIL\n".
189+ "\n";
190+
191+ my $body = "IP:".$ENV{'REMOTE_ADDR'}."\n".
192+ "UA:".$ENV{'HTTP_USER_AGENT'}."\n";
193+
194+ if($action eq 'MODIFY' || $action eq 'DELETE'){
195+ if(-e "$main::BACKUP_DIR/$enc_page.bak"){
196+ $body .= "以下は変更前のソースです。\n".
197+ "-----------------------------------------------------\n";
198+ open(BACKUP,"$main::BACKUP_DIR/$enc_page.bak");
199+ while(my $line = <BACKUP>){
200+ $body .= $line;
201+ }
202+ close(BACKUP);
203+ }
204+ }
205+
206+ # 文字コードの変換(jcode.plを使用する)
207+ &jcode::convert(\$body,'jis');
208+
209+ open(MAIL,"| $main::SEND_MAIL $main::ADMIN_MAIL");
210+ print MAIL $head;
211+ print MAIL $body;
212+ close(MAIL);
213+}
214+#-------------------------------------------------------------------------------
215+# ページの一覧を取得
216+#-------------------------------------------------------------------------------
217+sub get_page_list {
218+ opendir(DIR, $main::DATA_DIR);
219+ my ($fileentry, @files);
220+ while($fileentry = readdir(DIR)){
221+ my $type = substr($fileentry,rindex($fileentry,"."));
222+ if($type eq ".wiki"){
223+ push(@files, "$main::DATA_DIR/$fileentry");
224+ }
225+ }
226+ closedir(DIR);
227+
228+ my @pages;
229+ foreach my $entry (@files){
230+ my @stat = stat($entry);
231+ my $time = $stat[9];
232+
233+ $entry = substr($entry,length($main::DATA_DIR)+1);
234+ $entry =~ /(.+?)\.wiki/;
235+ my $page = &Util::url_decode($1);
236+ push(@pages,{NAME=>$page,TIME=>$time});
237+ }
238+
239+ @pages = sort { $b->{TIME}<=>$a->{TIME} } @pages;
240+ return @pages;
241+}
242+
243+#-------------------------------------------------------------------------------
244+# ページの更新日時を取得
245+#-------------------------------------------------------------------------------
246+sub get_last_modified {
247+ my $page = shift;
248+ if(&exists_page($page)){
249+ my $file = sprintf("%s/%s.wiki",$main::DATA_DIR,&Util::url_encode($page));
250+ my @stat = stat($file);
251+ return $stat[9];
252+ } else {
253+ return undef;
254+ }
255+}
256+
257+#-------------------------------------------------------------------------------
258+# ページが存在するかどうか
259+#-------------------------------------------------------------------------------
260+sub exists_page {
261+ my $page = &Util::url_encode(shift);
262+ if(-e "$main::DATA_DIR/$page.wiki"){
263+ return 1;
264+ } else {
265+ return 0;
266+ }
267+}
268+
269+#-------------------------------------------------------------------------------
270+# Wikiソースを渡してHTMLを取得します
271+#-------------------------------------------------------------------------------
272+sub process_wiki {
273+ my $source = shift;
274+ my $main = shift;
275+ my $parser = HTMLParser->new($main);
276+ $parser->parse($source);
277+
278+ return $parser->{html};
279+}
280+
281+###############################################################################
282+#
283+# HTMLパーサ
284+#
285+###############################################################################
286+package HTMLParser;
287+#==============================================================================
288+# コンストラクタ
289+#==============================================================================
290+sub new {
291+ my $class = shift;
292+ my $mainflg = shift;
293+ my $self = {};
294+
295+ if(!defined($mainflg) || $mainflg eq ""){ $mainflg = 0; }
296+
297+ $self->{html} = "";
298+ $self->{pre} = "";
299+ $self->{quote} = "";
300+ $self->{table} = 0;
301+ $self->{level} = 0;
302+ $self->{para} = 0;
303+ $self->{p_cnt} = 0;
304+ $self->{explan} = 0;
305+ $self->{main} = $mainflg;
306+ return bless $self,$class;
307+}
308+
309+#===============================================================================
310+# パース
311+#===============================================================================
312+sub parse {
313+ my $self = shift;
314+ my $source = shift;
315+
316+ $source =~ s/\r//g;
317+ my @lines = split(/\n/,$source);
318+
319+ foreach my $line (@lines){
320+ chomp $line;
321+
322+ # 複数行の説明
323+ $self->multi_explanation($line);
324+
325+ my $word1 = substr($line,0,1);
326+ my $word2 = substr($line,0,2);
327+ my $word3 = substr($line,0,3);
328+
329+ # 空行
330+ if($line eq ""){
331+ $self->l_paragraph();
332+ next;
333+ }
334+
335+ # パラグラフプラグイン
336+ if($line =~ /^{{((.|\s)+?)}}$/){
337+ my $plugin = &Util::parse_plugin($1);
338+ my $class = $main::P_PLUGIN->{$plugin->{command}};
339+ if(defined($class)){
340+ $self->l_plugin($plugin);
341+ } else {
342+ my @obj = $self->parse_line($line);
343+ $self->l_text(\@obj);
344+ }
345+ next;
346+ }
347+
348+ # PRE
349+ if($word1 eq " " || $word1 eq "\t"){
350+ $self->l_verbatim($line);
351+
352+ # 見出し
353+ } elsif($word3 eq "!!!"){
354+ my @obj = $self->parse_line(substr($line,3));
355+ $self->l_headline(1,\@obj);
356+
357+ } elsif($word2 eq "!!"){
358+ my @obj = $self->parse_line(substr($line,2));
359+ $self->l_headline(2,\@obj);
360+
361+ } elsif($word1 eq "!"){
362+ my @obj = $self->parse_line(substr($line,1));
363+ $self->l_headline(3,\@obj);
364+
365+ # 項目
366+ } elsif($word3 eq "***"){
367+ my @obj = $self->parse_line(substr($line,3));
368+ $self->l_list(3,\@obj);
369+
370+ } elsif($word2 eq "**"){
371+ my @obj = $self->parse_line(substr($line,2));
372+ $self->l_list(2,\@obj);
373+
374+ } elsif($word1 eq "*"){
375+ my @obj = $self->parse_line(substr($line,1));
376+ $self->l_list(1,\@obj);
377+
378+ # 番号付き項目
379+ } elsif($word3 eq "+++"){
380+ my @obj = $self->parse_line(substr($line,3));
381+ $self->l_numlist(3,\@obj);
382+
383+ } elsif($word2 eq "++"){
384+ my @obj = $self->parse_line(substr($line,2));
385+ $self->l_numlist(2,\@obj);
386+
387+ } elsif($word1 eq "+"){
388+ my @obj = $self->parse_line(substr($line,1));
389+ $self->l_numlist(1,\@obj);
390+
391+ # 水平線
392+ } elsif($line eq "----"){
393+ $self->l_line();
394+
395+ # 引用
396+ } elsif($word2 eq '""'){
397+ my @obj = $self->parse_line(substr($line,2));
398+ $self->l_quotation(\@obj);
399+
400+ # 説明
401+ } elsif(index($line,":")==0 && index($line,":",1)!=-1){
402+ if(index($line,":::")==0){
403+ $self->{dd} .= substr($line,3);
404+ next;
405+ }
406+ if(index($line,"::")==0){
407+ if($self->{dt} ne "" || $self->{dd} ne ""){
408+ $self->multi_explanation;
409+ }
410+ $self->{dt} = substr($line,2);
411+ $self->{dl_flag} = 1;
412+ next;
413+ }
414+ my $dt = substr($line,1,index($line,":",1)-1);
415+ my $dd = substr($line,index($line,":",1)+1);
416+ my @obj1 = $self->parse_line($dt);
417+ my @obj2 = $self->parse_line($dd);
418+ $self->l_explanation(\@obj1,\@obj2);
419+
420+ # テーブル
421+ } elsif($word1 eq ","){
422+ if($line =~ /,$/){
423+ $line .= " ";
424+ }
425+ my @spl = map {/^"(.*)"$/ ? scalar($_ = $1, s/\"\"/\"/g, $_) : $_}
426+ ($line =~ /,\s*(\"[^\"]*(?:\"\"[^\"]*)*\"|[^,]*)/g);
427+ my @array;
428+ foreach my $value (@spl){
429+ my @cell = $self->parse_line($value);
430+ push @array,\@cell;
431+ }
432+ $self->l_table(\@array);
433+
434+ # コメント
435+ } elsif($word2 eq "//"){
436+
437+ # 何もない行
438+ } else {
439+ my @obj = $self->parse_line($line);
440+ $self->l_text(\@obj);
441+ }
442+ }
443+
444+ # 複数行の説明
445+ $self->multi_explanation;
446+
447+ $self->end_parse;
448+}
449+
450+#===============================================================================
451+# 複数行の説明
452+#===============================================================================
453+sub multi_explanation {
454+ my $self = shift;
455+ my $line = shift;
456+ if($self->{dl_flag}==1 && (index($line,":")!=0 || !defined($line))){
457+ my @obj1 = $self->parse_line($self->{dt});
458+ my @obj2 = $self->parse_line($self->{dd});
459+ $self->l_explanation(\@obj1,\@obj2);
460+ $self->{dl_flag} = 0;
461+ $self->{dt} = "";
462+ $self->{dd} = "";
463+ }
464+}
465+
466+#===============================================================================
467+# 1行分をパース
468+#===============================================================================
469+sub parse_line {
470+ my $self = shift;
471+ my $source = shift;
472+ my @array = ();
473+
474+ # プラグイン
475+ if($source =~ /{{((.|\s)+?)}}/){
476+ my $pre = $`;
477+ my $post = $';
478+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
479+ my $plugin = &Util::parse_plugin($1);
480+ my $class = $main::I_PLUGIN->{$plugin->{command}};
481+ if(defined($class)){
482+ push @array,$self->plugin($plugin);
483+ } else {
484+ push @array,$self->text("{{$1}}");
485+ }
486+ if($post ne ""){ push(@array,$self->parse_line($post)); }
487+
488+ # ボールド、イタリック、取り消し線、下線
489+ } elsif($source =~ /((''')|('')|(==)|(__))(.+?)(\1)/){
490+ my $pre = $`;
491+ my $post = $';
492+ my $type = $1;
493+ my $label = $6;
494+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
495+ if($type eq "'''"){
496+ push @array,$self->bold($label);
497+ } elsif($type eq "__"){
498+ push @array,$self->underline($label);
499+ } elsif($type eq "''"){
500+ push @array,$self->italic($label);
501+ } elsif($type eq "=="){
502+ push @array,$self->denialline($label);
503+ }
504+ if($post ne ""){ push(@array,$self->parse_line($post)); }
505+
506+ # ページ別名リンク
507+ } elsif($source =~ /\[\[([^\[]+?)\|(.+?)\]\]/){
508+ my $pre = $`;
509+ my $post = $';
510+ my $label = $1;
511+ my $page = $2;
512+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
513+ push @array,$self->wiki_anchor($page,$label);
514+ if($post ne ""){ push(@array,$self->parse_line($post)); }
515+
516+ # URL別名リンク
517+ } elsif($source =~ /\[([^\[]+?)\|((http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/
518+ || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/
519+ || $source =~ /\[([^\[]+?)\|((\/|\.\/|\.\.\/)+[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/){
520+ my $pre = $`;
521+ my $post = $';
522+ my $label = $1;
523+ my $url = $2;
524+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
525+ if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
526+ push @array,"<span class=\"error\">不正なリンクです。</span>";
527+ } else {
528+ push @array,$self->url_anchor($url,$label);
529+ }
530+ if($post ne ""){ push(@array,$self->parse_line($post)); }
531+
532+ # URLリンク
533+ } elsif($source =~ /(http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*/
534+ || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/){
535+ my $pre = $`;
536+ my $post = $';
537+ my $url = $&;
538+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
539+ if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
540+ push @array,"<span class=\"error\">不正なリンクです。</span>";
541+ } else {
542+ push @array,$self->url_anchor($url);
543+ }
544+ if($post ne ""){ push(@array,$self->parse_line($post)); }
545+
546+ # ページリンク
547+ } elsif($source =~ /\[\[([^\|]+?)\]\]/){
548+ my $pre = $`;
549+ my $post = $';
550+ my $page = $1;
551+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
552+ push @array,$self->wiki_anchor($page);
553+ if($post ne ""){ push(@array,$self->parse_line($post)); }
554+
555+ # 任意のURLリンク
556+ } elsif($source =~ /\[([^\[]+?)\|(.+?)\]/){
557+ my $pre = $`;
558+ my $post = $';
559+ my $label = $1;
560+ my $url = $2;
561+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
562+ if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
563+ push @array,"<span class=\"error\">不正なリンクです。</span>";
564+ } else {
565+ push @array,$self->url_anchor($url,$label);
566+ }
567+ if($post ne ""){ push(@array,$self->parse_line($post)); }
568+
569+ # WikiName
570+ } elsif($main::WIKI_NAME==1 && $source =~ /[A-Z]+?[a-z]+?([A-Z]+?[a-z]+)+/){
571+ my $pre = $`;
572+ my $post = $';
573+ my $page = $&;
574+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
575+ push @array,$self->wiki_anchor($page);
576+ if($post ne ""){ push(@array,$self->parse_line($post)); }
577+
578+ } else {
579+ push @array,$self->text($source);
580+ }
581+
582+ return @array;
583+}
584+
585+#==============================================================================
586+# リスト
587+#==============================================================================
588+sub l_list {
589+ my $self = shift;
590+ my $level = shift;
591+ my $obj = shift;
592+
593+ if($self->{para}==1){
594+ $self->{html} .= "</p>\n";
595+ $self->{para} = 0;
596+ }
597+
598+ $self->end_verbatim;
599+ $self->end_table;
600+ $self->end_quote;
601+ $self->end_explan;
602+
603+ my $html = join("",@$obj);
604+ my $plus = 1;
605+
606+ if($level < $self->{level}){ $plus = -1; }
607+ if($level==$self->{level}){
608+ $self->{html} .= "</li>\n";
609+ }
610+ while($level != $self->{level}){
611+ if($plus==1){
612+ $self->{html} .= "<ul>\n";
613+ push(@{$self->{close_list}},"</ul>\n");
614+ } else {
615+ $self->{html} .= "</li>\n";
616+ $self->{html} .= pop(@{$self->{close_list}});
617+ }
618+ $self->{level} += $plus;
619+ }
620+
621+ $self->{html} .= "<li>".$html;
622+}
623+
624+#==============================================================================
625+# 番号付きリスト
626+#==============================================================================
627+sub l_numlist {
628+ my $self = shift;
629+ my $level = shift;
630+ my $obj = shift;
631+
632+ if($self->{para}==1){
633+ $self->{html} .= "</p>\n";
634+ $self->{para} = 0;
635+ }
636+
637+ $self->end_verbatim;
638+ $self->end_table;
639+ $self->end_quote;
640+ $self->end_explan;
641+
642+ my $html = join("",@$obj);
643+ my $plus = 1;
644+
645+ if($level < $self->{level}){ $plus = -1; }
646+ if($level==$self->{level}){
647+ $self->{html} .= "</li>\n";
648+ }
649+ while($level != $self->{level}){
650+ if($plus==1){
651+ $self->{html} .= "<ol>\n";
652+ push(@{$self->{close_list}},"</ol>\n");
653+ } else {
654+ $self->{html} .= "</li>\n";
655+ $self->{html} .= pop(@{$self->{close_list}});
656+ }
657+ $self->{level} += $plus;
658+ }
659+ $self->{html} .= "<li>".$html;
660+}
661+
662+#==============================================================================
663+# リストの終了
664+#==============================================================================
665+sub end_list {
666+ my $self = shift;
667+ if ($self->{level}!=0) {
668+ $self->{html} .= "</li>\n";
669+ while($self->{level}!=0){
670+ $self->{html} .= pop(@{$self->{close_list}});
671+ $self->{level} += -1;
672+ }
673+ }
674+}
675+
676+#==============================================================================
677+# ヘッドライン
678+#==============================================================================
679+sub l_headline {
680+ my $self = shift;
681+ my $level = shift;
682+ my $obj = shift;
683+
684+ if($self->{para}==1){
685+ $self->{html} .= "</p>\n";
686+ $self->{para} = 0;
687+ }
688+
689+ $self->end_list;
690+ $self->end_verbatim;
691+ $self->end_table;
692+ $self->end_quote;
693+ $self->end_explan;
694+
695+ my $html = join("",@$obj);
696+
697+ if(!$self->{main}){
698+ $self->{html} .= "<h".($level+1).">".$html."</h".($level+1).">\n";
699+ } else {
700+ if($level==2){
701+ $self->{html} .= "<h".($level+1)."><a name=\"p".$self->{p_cnt}."\">".
702+ "<span class=\"sanchor\">_</span></a>".$html."</h".($level+1).">\n";
703+ } else {
704+ $self->{html} .= "<h".($level+1).">".
705+ "<a name=\"p".$self->{p_cnt}."\">".$html."</a>".
706+ "</h".($level+1).">\n";
707+ }
708+ }
709+ $self->{p_cnt}++;
710+}
711+
712+#==============================================================================
713+# 水平線
714+#==============================================================================
715+sub l_line {
716+ my $self = shift;
717+
718+ $self->end_list;
719+ $self->end_verbatim;
720+ $self->end_table;
721+ $self->end_quote;
722+ $self->end_explan;
723+
724+ $self->{html} .= "<hr>\n";
725+}
726+
727+#==============================================================================
728+# 段落区切り
729+#==============================================================================
730+sub l_paragraph {
731+ my $self = shift;
732+
733+ $self->end_list;
734+ $self->end_verbatim;
735+ $self->end_table;
736+ $self->end_quote;
737+ $self->end_explan;
738+
739+ if($self->{para}==1){
740+ $self->{html} .= "</p>\n";
741+ $self->{para} = 0;
742+ }
743+}
744+
745+#==============================================================================
746+# 整形済テキスト
747+#==============================================================================
748+sub l_verbatim {
749+ my $self = shift;
750+ my $text = shift;
751+
752+ if($self->{para}==1){
753+ $self->{html} .= "</p>\n";
754+ $self->{para} = 0;
755+ }
756+
757+ $self->end_list;
758+ $self->end_table;
759+ $self->end_quote;
760+ $self->end_explan;
761+
762+ $self->{pre} .= Util::escapeHTML($text)."\n";
763+}
764+
765+sub end_verbatim {
766+ my $self = shift;
767+ if($self->{pre} ne ""){
768+ $self->{html} .= "<pre>".$self->{pre}."</pre>";
769+ $self->{pre} = "";
770+ }
771+}
772+
773+#==============================================================================
774+# テーブル
775+#==============================================================================
776+sub l_table {
777+ my $self = shift;
778+ my $row = shift;
779+ $self->end_list;
780+ $self->end_verbatim;
781+ $self->end_quote;
782+ $self->end_explan;
783+
784+ if($self->{table}==0){
785+ $self->{table}=1;
786+ $self->{html} .= "<table>\n";
787+ $self->{html} .= "<tr>\n";
788+ foreach(@$row){
789+ my $html = join("",@$_);
790+ $self->{html} .= "<th>".$html."</th>\n";
791+ }
792+ $self->{html} .= "</tr>\n";
793+ } else {
794+ $self->{table}=2;
795+ $self->{html} .= "<tr>\n";
796+ foreach(@$row){
797+ my $html = join("",@$_);
798+ $self->{html} .= "<td>".$html."</td>\n";
799+ }
800+ $self->{html} .= "</tr>\n";
801+ }
802+}
803+
804+sub end_table {
805+ my $self = shift;
806+ if($self->{table}!=0){
807+ $self->{table} = 0;
808+ $self->{html} .= "</table>\n";
809+ }
810+}
811+
812+#==============================================================================
813+# パース終了時の処理
814+#==============================================================================
815+sub end_parse {
816+ my $self = shift;
817+ $self->end_list;
818+ $self->end_verbatim;
819+ $self->end_table;
820+ $self->end_quote;
821+ $self->end_explan;
822+
823+ if($self->{para}==1){
824+ $self->{html} .= "</p>\n";
825+ $self->{para} = 0;
826+ }
827+}
828+
829+#==============================================================================
830+# 行書式に該当しない行
831+#==============================================================================
832+sub l_text {
833+ my $self = shift;
834+ my $obj = shift;
835+ $self->end_list;
836+ $self->end_verbatim;
837+ $self->end_table;
838+ $self->end_quote;
839+ $self->end_explan;
840+ my $html = join("",@$obj);
841+
842+ if($self->{para}==0){
843+ $self->{html} .= "<p>";
844+ $self->{para} = 1;
845+ }
846+ $self->{html} .= $html;
847+}
848+
849+#==============================================================================
850+# 引用
851+#==============================================================================
852+sub l_quotation {
853+ my $self = shift;
854+ my $obj = shift;
855+ $self->end_list;
856+ $self->end_verbatim;
857+ $self->end_table;
858+ $self->end_explan;
859+ my $html = join("",@$obj);
860+ $self->{quote} .= "<p>".$html."</p>\n";
861+}
862+
863+sub end_quote {
864+ my $self = shift;
865+ if($self->{quote} ne ""){
866+ $self->{html} .= "<blockquote>".$self->{quote}."</blockquote>\n";
867+ $self->{quote} = "";
868+ }
869+}
870+
871+#==============================================================================
872+# 説明
873+#==============================================================================
874+sub l_explanation {
875+ my $self = shift;
876+ my $obj1 = shift;
877+ my $obj2 = shift;
878+
879+ if($self->{para}==1){
880+ $self->{html} .= "</p>";
881+ $self->{para} = 0;
882+ }
883+
884+ $self->end_list;
885+ $self->end_verbatim;
886+ $self->end_table;
887+ $self->end_quote;
888+
889+ if($self->{explan}==0){
890+ $self->{explan}=1;
891+ $self->{html} .= "<dl>\n";
892+ }
893+
894+ my $html1 = join("",@$obj1);
895+ my $html2 = join("",@$obj2);
896+
897+ $self->{html} .= "<dt>".$html1."</dt>\n<dd>".$html2."</dd>\n";
898+}
899+
900+sub end_explan {
901+ my $self = shift;
902+ if($self->{explan}!=0){
903+ $self->{explan} = 0;
904+ $self->{html} .= "</dl>\n";
905+ }
906+}
907+
908+#==============================================================================
909+# ボールド
910+#==============================================================================
911+sub bold {
912+ my $self = shift;
913+ my $text = shift;
914+ return "<strong>".join("",$self->parse_line($text))."</strong>";
915+}
916+
917+#==============================================================================
918+# イタリック
919+#==============================================================================
920+sub italic {
921+ my $self = shift;
922+ my $text = shift;
923+ return "<em>".join("",$self->parse_line($text))."</em>";
924+}
925+
926+#==============================================================================
927+# 下線
928+#==============================================================================
929+sub underline {
930+ my $self = shift;
931+ my $text = shift;
932+ return "<ins>".join("",$self->parse_line($text))."</ins>";
933+}
934+
935+#==============================================================================
936+# 打ち消し線
937+#==============================================================================
938+sub denialline {
939+ my $self = shift;
940+ my $text = shift;
941+ return "<del>".join("",$self->parse_line($text))."</del>";
942+}
943+
944+#==============================================================================
945+# URLアンカ
946+#==============================================================================
947+sub url_anchor {
948+ my $self = shift;
949+ my $url = shift;
950+ my $name = shift;
951+
952+ if($name eq ""){
953+ $name = $url;
954+ }
955+
956+ if($url eq $name && $url=~/\.(gif|jpg|jpeg|bmp|png)$/i){
957+ return "<img src=\"".$url."\">";
958+ } else {
959+ return "<a href=\"$url\">".Util::escapeHTML($name)."</a>";
960+ }
961+}
962+
963+#==============================================================================
964+# Wikiページへのアンカ
965+#==============================================================================
966+sub wiki_anchor {
967+ my $self = shift;
968+ my $page = shift;
969+ my $name = shift;
970+
971+ if(!defined($name) || $name eq ""){
972+ $name = $page;
973+ }
974+
975+ if(&Wiki::exists_page($page)){
976+ return "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\" class=\"wikipage\">".
977+ &Util::escapeHTML($name)."</a>";
978+ } else {
979+ return "<span class=\"nopage\">".&Util::escapeHTML($name)."</span>".
980+ "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">?</a>";
981+ }
982+}
983+
984+#==============================================================================
985+# ただのテキスト
986+#==============================================================================
987+sub text {
988+ my $self = shift;
989+ my $text = shift;
990+ return &Util::escapeHTML($text);
991+}
992+
993+#==============================================================================
994+# インラインプラグイン
995+#==============================================================================
996+sub plugin {
997+ my $self = shift;
998+ my $plugin = shift;
999+
1000+ my $func_ref = $main::I_PLUGIN->{$plugin->{command}};
1001+ my $result = &$func_ref(@{$plugin->{args}});
1002+ if(defined($result) && $result ne ""){
1003+ return ($result);
1004+ }
1005+
1006+ return undef;
1007+}
1008+
1009+#==============================================================================
1010+# パラグラフプラグイン
1011+#==============================================================================
1012+sub l_plugin {
1013+ my $self = shift;
1014+ my $plugin = shift;
1015+
1016+ if($self->{para}==1){
1017+ $self->{html} .= "</p>\n";
1018+ $self->{para} = 0;
1019+ }
1020+
1021+ $self->end_list;
1022+ $self->end_verbatim;
1023+ $self->end_table;
1024+ $self->end_quote;
1025+ $self->end_explan;
1026+
1027+ my $func_ref = $main::P_PLUGIN->{$plugin->{command}};
1028+ my $result = &$func_ref(@{$plugin->{args}});
1029+ if(defined($result) && $result ne ""){
1030+ $self->{html} .= $result;
1031+ }
1032+}
1033+
1034+#==============================================================================
1035+# イメージ
1036+#==============================================================================
1037+sub l_image {
1038+ my $self = shift;
1039+ my $page = shift;
1040+ my $file = shift;
1041+ my $wiki = $self->{wiki};
1042+
1043+ if($self->{para}==1){
1044+ $self->{html} .= "</p>";
1045+ $self->{para} = 0;
1046+ }
1047+
1048+ $self->end_list;
1049+ $self->end_verbatim;
1050+ $self->end_table;
1051+ $self->end_quote;
1052+ $self->end_explan;
1053+
1054+ $self->{html} .= "<img src=\"".$wiki->config('script_name')."?action=ATTACH&amp;".
1055+ "page=".&Util::url_encode($page)."&amp;file=".&Util::url_encode($file)."\">";
1056+}
1057+
1058+
1059+################################################################################
1060+#
1061+# ユーティリティ関数を提供するパッケージ
1062+#
1063+################################################################################
1064+package Util;
1065+#===============================================================================
1066+# 引数で渡された文字列をURLエンコードして返します。
1067+#===============================================================================
1068+sub url_encode {
1069+ my $retstr = shift;
1070+ $retstr =~ s/([^ 0-9A-Za-z])/sprintf("%%%.2X", ord($1))/eg;
1071+ $retstr =~ tr/ /+/;
1072+ return $retstr;
1073+}
1074+
1075+#===============================================================================
1076+# 引数で渡された文字列をURLデコードして返します。
1077+#===============================================================================
1078+sub url_decode{
1079+ my $retstr = shift;
1080+ $retstr =~ tr/+/ /;
1081+ $retstr =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
1082+ return $retstr;
1083+}
1084+
1085+#===============================================================================
1086+# 引数で渡された文字列のHTMLタグをエスケープして返します。
1087+#===============================================================================
1088+sub escapeHTML {
1089+ my($retstr) = shift;
1090+ my %table = (
1091+ '&' => '&amp;',
1092+ '"' => '&quot;',
1093+ '<' => '&lt;',
1094+ '>' => '&gt;',
1095+ );
1096+ $retstr =~ s/([&\"<>])/$table{$1}/go;
1097+ return $retstr;
1098+}
1099+
1100+
1101+#===============================================================================
1102+# 日付をフォーマットします。
1103+#===============================================================================
1104+sub format_date {
1105+ my $t = shift;
1106+ my ($sec, $min, $hour, $mday, $mon, $year) = localtime($t);
1107+ return sprintf("%04d年%02d月%02d日 %02d時%02d分%02d秒",
1108+ $year+1900,$mon+1,$mday,$hour,$min,$sec);
1109+}
1110+
1111+#===============================================================================
1112+# 文字列の両端の空白を切り落とします。
1113+#===============================================================================
1114+sub trim {
1115+ my $text = shift;
1116+ if(!defined($text)){
1117+ return "";
1118+ }
1119+ $text =~ s/^(?:\s)+//o;
1120+ $text =~ s/(?:\s)+$//o;
1121+ return $text;
1122+}
1123+
1124+
1125+#===============================================================================
1126+# タグを削除して文字列のみを取得します。
1127+#===============================================================================
1128+sub delete_tag {
1129+ my $text = shift;
1130+ $text =~ s/<(.|\s)+?>//g;
1131+ return $text;
1132+}
1133+
1134+#===============================================================================
1135+# 数値かどうかチェックします。
1136+#===============================================================================
1137+sub check_numeric {
1138+ my $text = shift;
1139+ if($text =~ /^[0-9]+$/){
1140+ return 1;
1141+ } else {
1142+ return 0;
1143+ }
1144+}
1145+
1146+#===============================================================================
1147+# エラーを通知
1148+#===============================================================================
1149+sub error {
1150+ my $error = shift;
1151+
1152+ print "Content-Type: text/html;charset=EUC-JP\n\n";
1153+ print "<html>\n";
1154+ print "<head><title>エラー - FSWikiLite</title></head>\n";
1155+ print "<body>\n";
1156+ print "<h1>エラーが発生しました</h1>\n";
1157+ print "<pre>\n";
1158+ print &Util::escapeHTML($error);
1159+ print "</pre>\n";
1160+ print "</body><html>\n";
1161+
1162+ exit;
1163+}
1164+
1165+#===============================================================================
1166+# 携帯電話かどうかチェックします。
1167+#===============================================================================
1168+sub handyphone {
1169+ my $ua = $ENV{'HTTP_USER_AGENT'};
1170+ if(!defined($ua)){
1171+ return 0;
1172+ }
1173+ if($ua=~/^DoCoMo\// || $ua=~ /^J-PHONE\// || $ua=~ /UP\.Browser/){
1174+ return 1;
1175+ } else {
1176+ return 0;
1177+ }
1178+}
1179+
1180+#===============================================================================
1181+# インラインプラグインをパースしてコマンドと引数に分割
1182+#===============================================================================
1183+sub parse_plugin {
1184+ my $text = shift;
1185+ my ($cmd,@args_tmp) = split(/ /,$text);
1186+ my $args_txt = &Util::trim(join(" ",@args_tmp));
1187+
1188+ my @ret_args;
1189+ my $tmp = "";
1190+ my $escape = 0;
1191+ my $quote = 0;
1192+
1193+ for(my $i=0;$i<length($args_txt);$i++){
1194+ my $c = substr($args_txt,$i,1);
1195+
1196+ if($quote!=1 && $c eq ","){
1197+ if($tmp ne ""){
1198+ push(@ret_args,$tmp);
1199+ $tmp = "";
1200+ $quote = 0;
1201+ }
1202+ } elsif($quote==1 && $c eq "\\"){
1203+ if($escape==0){
1204+ $escape = 1;
1205+ } else {
1206+ $tmp .= $c;
1207+ $escape = 0;
1208+ }
1209+ } elsif($quote==0 && $c eq '"'){
1210+ if($tmp eq ""){
1211+ $quote = 1;
1212+ } else {
1213+ $tmp .= $c;
1214+ }
1215+ } elsif($quote==1 && $c eq '"'){
1216+ if($escape==1){
1217+ $tmp .= $c;
1218+ $escape = 0;
1219+ } else {
1220+ $quote = 2;
1221+ }
1222+ } elsif($quote==2){
1223+ return {error=>"インラインプラグインの構文が不正です。"};
1224+ } else {
1225+ $tmp .= $c;
1226+ }
1227+ }
1228+
1229+ if($tmp ne ""){
1230+ push(@ret_args,$tmp);
1231+ }
1232+
1233+ return {command=>$cmd,args=>\@ret_args};
1234+}
1235+
1236+1;
--- a/lib/jcode.pl
+++ b/lib/jcode.pl
@@ -1,780 +1,780 @@
1-package jcode;
2-;######################################################################
3-;#
4-;# jcode.pl: Perl library for Japanese character code conversion
5-;#
6-;# Copyright (c) 1995-1999 Kazumasa Utashiro <utashiro@iij.ad.jp>
7-;# Internet Initiative Japan Inc.
8-;# 3-13 Kanda Nishiki-cho, Chiyoda-ku, Tokyo 101-0054, Japan
9-;#
10-;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
11-;# Software Research Associates, Inc.
12-;#
13-;# Use and redistribution for ANY PURPOSE are granted as long as all
14-;# copyright notices are retained. Redistribution with modification
15-;# is allowed provided that you make your modified version obviously
16-;# distinguishable from the original one. THIS SOFTWARE IS PROVIDED
17-;# BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE
18-;# DISCLAIMED.
19-;#
20-;# Original version was developed under the name of srekcah@sra.co.jp
21-;# February 1992 and it was called kconv.pl at the beginning. This
22-;# address was a pen name for group of individuals and it is no longer
23-;# valid.
24-;#
25-;# The latest version is available here:
26-;#
27-;# ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/
28-;#
29-;; $rcsid = q$Id: jcode.pl,v 1.1 2003/09/18 15:35:28 takezoe Exp $;
30-;#
31-;######################################################################
32-;#
33-;# PERL4 INTERFACE:
34-;#
35-;# &jcode'getcode(*line)
36-;# Return 'jis', 'sjis', 'euc' or undef according to
37-;# Japanese character code in $line. Return 'binary' if
38-;# the data has non-character code.
39-;#
40-;# When evaluated in array context, it returns a list
41-;# contains two items. First value is the number of
42-;# characters which matched to the expected code, and
43-;# second value is the code name. It is useful if and
44-;# only if the number is not 0 and the code is undef;
45-;# that case means it couldn't tell 'euc' or 'sjis'
46-;# because the evaluation score was exactly same. This
47-;# interface is too tricky, though.
48-;#
49-;# Code detection between euc and sjis is very difficult
50-;# or sometimes impossible or even lead to wrong result
51-;# when it includes JIS X0201 KANA characters. So JIS
52-;# X0201 KANA is ignored for automatic code detection.
53-;#
54-;# &jcode'convert(*line, $ocode [, $icode [, $option]])
55-;# Convert the contents of $line to the specified
56-;# Japanese code given in the second argument $ocode.
57-;# $ocode can be any of "jis", "sjis" or "euc", or use
58-;# "noconv" when you don't want the code conversion.
59-;# Input code is recognized automatically from the line
60-;# itself when $icode is not supplied (JIS X0201 KANA is
61-;# ignored in code detection. See the above descripton
62-;# of &getcode). $icode also can be specified, but
63-;# xxx2yyy routine is more efficient when both codes are
64-;# known.
65-;#
66-;# It returns the code of input string in scalar context,
67-;# and a list of pointer of convert subroutine and the
68-;# input code in array context.
69-;#
70-;# Japanese character code JIS X0201, X0208, X0212 and
71-;# ASCII code are supported. X0212 characters can not be
72-;# represented in SJIS and they will be replased by
73-;# "geta" character when converted to SJIS.
74-;#
75-;# See next paragraph for $option parameter.
76-;#
77-;# &jcode'xxx2yyy(*line [, $option])
78-;# Convert the Japanese code from xxx to yyy. String xxx
79-;# and yyy are any convination from "jis", "euc" or
80-;# "sjis". They return *approximate* number of converted
81-;# bytes. So return value 0 means the line was not
82-;# converted at all.
83-;#
84-;# Optional parameter $option is used to specify optional
85-;# conversion method. String "z" is for JIS X0201 KANA
86-;# to X0208 KANA, and "h" is for reverse.
87-;#
88-;# $jcode'convf{'xxx', 'yyy'}
89-;# The value of this associative array is pointer to the
90-;# subroutine jcode'xxx2yyy().
91-;#
92-;# &jcode'to($ocode, $line [, $icode [, $option]])
93-;# &jcode'jis($line [, $icode [, $option]])
94-;# &jcode'euc($line [, $icode [, $option]])
95-;# &jcode'sjis($line [, $icode [, $option]])
96-;# These functions are prepared for easy use of
97-;# call/return-by-value interface. You can use these
98-;# funcitons in s///e operation or any other place for
99-;# convenience.
100-;#
101-;# &jcode'jis_inout($in, $out)
102-;# Set or inquire JIS start and end sequences. Default
103-;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
104-;# character, "ESC-$" or "ESC-(" is prepended for each
105-;# character respectively. Acutually "ESC-(-B" is not a
106-;# sequence to end JIS code but a sequence to start ASCII
107-;# code set. So `in' and `out' are somewhat misleading.
108-;#
109-;# &jcode'get_inout($string)
110-;# Get JIS start and end sequences from $string.
111-;#
112-;# &jcode'cache()
113-;# &jcode'nocache()
114-;# &jcode'flush()
115-;# Usually, converted character is cached in memory to
116-;# avoid same calculations have to be done many times.
117-;# To disable this caching, call &jcode'nocache(). It
118-;# can be revived by &jcode'cache() and cache is flushed
119-;# by calling &jcode'flush(). &cache() and &nocache()
120-;# functions return previous caching state.
121-;#
122-;# ---------------------------------------------------------------
123-;#
124-;# &jcode'h2z_xxx(*line)
125-;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
126-;# (Zenkaku-KANA) code conversion routine. String xxx is
127-;# any of "jis", "sjis" and "euc". From the difficulty
128-;# of recognizing code set from 1-byte KATAKANA string,
129-;# automatic code recognition is not supported.
130-;#
131-;# &jcode'z2h_xxx(*line)
132-;# X0208 to X0201 KANA code conversion routine. String
133-;# xxx is any of "jis", "sjis" and "euc".
134-;#
135-;# $jcode'z2hf{'xxx'}
136-;# $jcode'h2zf{'xxx'}
137-;# These are pointer to the corresponding function just
138-;# as $jcode'convf.
139-;#
140-;# ---------------------------------------------------------------
141-;#
142-;# &jcode'tr(*line, $from, $to [, $option])
143-;# &jcode'tr emulates tr operator for 2 byte code. Only 'd'
144-;# is interpreted as an option.
145-;#
146-;# Range operator like `A-Z' for 2 byte code is partially
147-;# supported. Code must be JIS or EUC, and first byte
148-;# have to be same on first and last character.
149-;#
150-;# CAUTION: Handling range operator is a kind of trick
151-;# and it is not perfect. So if you need to transfer `-'
152-;# character, please be sure to put it at the beginning
153-;# or the end of $from and $to strings.
154-;#
155-;# &jcode'trans($line, $from, $to [, $option)
156-;# Same as &jcode'tr but accept string and return string
157-;# after translation.
158-;#
159-;# ---------------------------------------------------------------
160-;#
161-;# &jcode'init()
162-;# Initialize the variables used in this package. You
163-;# don't have to call this when using jocde.pl by `do' or
164-;# `require' interface. Call it first if you embedded
165-;# the jcode.pl at the end of your script.
166-;#
167-;######################################################################
168-;#
169-;# PERL5 INTERFACE:
170-;#
171-;# Current jcode.pl is written in Perl 4 but it is possible to use
172-;# from Perl 5 using `references'. Fully perl5 capable version is
173-;# future issue.
174-;#
175-;# Since lexical variable is not a subject of typeglob, *string style
176-;# call doesn't work if the variable is declared as `my'. Same thing
177-;# happens to special variable $_ if the perl is compiled to use
178-;# thread capability. So using reference is generally recommented to
179-;# avoid the mysterious error.
180-;#
181-;# jcode::getcode(\$line)
182-;# jcode::convert(\$line, $ocode [, $icode [, $option]])
183-;# jcode::xxx2yyy(\$line [, $option])
184-;# &{$jcode::convf{'xxx', 'yyy'}}(\$line)
185-;# jcode::to($ocode, $line [, $icode [, $option]])
186-;# jcode::jis($line [, $icode [, $option]])
187-;# jcode::euc($line [, $icode [, $option]])
188-;# jcode::sjis($line [, $icode [, $option]])
189-;# jcode::jis_inout($in, $out)
190-;# jcode::get_inout($string)
191-;# jcode::cache()
192-;# jcode::nocache()
193-;# jcode::flush()
194-;# jcode::h2z_xxx(\$line)
195-;# jcode::z2h_xxx(\$line)
196-;# &{$jcode::z2hf{'xxx'}}(\$line)
197-;# &{$jcode::h2zf{'xxx'}}(\$line)
198-;# jcode::tr(\$line, $from, $to [, $option])
199-;# jcode::trans($line, $from, $to [, $option)
200-;# jcode::init()
201-;#
202-;######################################################################
203-;#
204-;# SAMPLES
205-;#
206-;# Convert any Kanji code to JIS and print each line with code name.
207-;#
208-;# while (defined($s = <>)) {
209-;# $code = &jcode'convert(*s, 'jis');
210-;# print $code, "\t", $s;
211-;# }
212-;#
213-;# Convert all lines to JIS according to the first recognized line.
214-;#
215-;# while (defined($s = <>)) {
216-;# print, next unless $s =~ /[\033\200-\377]/;
217-;# (*f, $icode) = &jcode'convert(*s, 'jis');
218-;# print;
219-;# defined(&f) || next;
220-;# while (<>) { &f(*s); print; }
221-;# last;
222-;# }
223-;#
224-;# The safest way of JIS conversion.
225-;#
226-;# while (defined($s = <>)) {
227-;# ($matched, $icode) = &jcode'getcode(*s);
228-;# if (@buf == 0 && $matched == 0) {
229-;# print $s;
230-;# next;
231-;# }
232-;# push(@buf, $s);
233-;# next unless $icode;
234-;# while (defined($s = shift(@buf))) {
235-;# &jcode'convert(*s, 'jis', $icode);
236-;# print $s;
237-;# }
238-;# while (defined($s = <>)) {
239-;# &jcode'convert(*s, 'jis', $icode);
240-;# print $s;
241-;# }
242-;# last;
243-;# }
244-;# print @buf if @buf;
245-;#
246-;######################################################################
247-
248-;#
249-;# Call initialize function if it is not called yet. This may sound
250-;# strange but it makes easy to embed the jcode.pl at the end of
251-;# script. Call &jcode'init at the beginning of the script in that
252-;# case.
253-;#
254-&init unless defined $version;
255-
256-;#
257-;# Initialize variables.
258-;#
259-sub init {
260- $version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';
261-
262- $re_bin = '[\000-\006\177\377]';
263-
264- $re_jis0208_1978 = '\e\$\@';
265- $re_jis0208_1983 = '\e\$B';
266- $re_jis0208_1990 = '\e&\@\e\$B';
267- $re_jis0208 = "$re_jis0208_1978|$re_jis0208_1983|$re_jis0208_1990";
268- $re_jis0212 = '\e\$\(D';
269- $re_jp = "$re_jis0208|$re_jis0212";
270- $re_asc = '\e\([BJ]';
271- $re_kana = '\e\(I';
272-
273- $esc_0208 = "\e\$B";
274- $esc_0212 = "\e\$(D";
275- $esc_asc = "\e(B";
276- $esc_kana = "\e(I";
277-
278- $re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
279- $re_sjis_kana = '[\241-\337]';
280-
281- $re_euc_c = '[\241-\376][\241-\376]';
282- $re_euc_kana = '\216[\241-\337]';
283- $re_euc_0212 = '\217[\241-\376][\241-\376]';
284-
285- # Use `geta' for undefined character code
286- $undef_sjis = "\x81\xac";
287-
288- $cache = 1;
289-
290- # X0201 -> X0208 KANA conversion table. Looks weird? Not that
291- # much. This is simply JIS text without escape sequences.
292- ($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\041-\176/\241-\376/;
293-! !# $ !" % !& " !V # !W
294-^ !+ _ !, 0 !<
295-' %! ( %# ) %% * %' + %)
296-, %c - %e . %g / %C
297-1 %" 2 %$ 3 %& 4 %( 5 %*
298-6 %+ 7 %- 8 %/ 9 %1 : %3
299-6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
300-; %5 < %7 = %9 > %; ? %=
301-;^ %6 <^ %8 =^ %: >^ %< ?^ %>
302-@ %? A %A B %D C %F D %H
303-@^ %@ A^ %B B^ %E C^ %G D^ %I
304-E %J F %K G %L H %M I %N
305-J %O K %R L %U M %X N %[
306-J^ %P K^ %S L^ %V M^ %Y N^ %\
307-J_ %Q K_ %T L_ %W M_ %Z N_ %]
308-O %^ P %_ Q %` R %a S %b
309-T %d U %f V %h
310-W %i X %j Y %k Z %l [ %m
311-\ %o ] %s & %r 3^ %t
312-__TABLE_END__
313- %h2z = split(/\s+/, $h2z . $h2z_high);
314- %z2h = reverse %h2z;
315-
316- $convf{'jis' , 'jis' } = *jis2jis;
317- $convf{'jis' , 'sjis'} = *jis2sjis;
318- $convf{'jis' , 'euc' } = *jis2euc;
319- $convf{'euc' , 'jis' } = *euc2jis;
320- $convf{'euc' , 'sjis'} = *euc2sjis;
321- $convf{'euc' , 'euc' } = *euc2euc;
322- $convf{'sjis' , 'jis' } = *sjis2jis;
323- $convf{'sjis' , 'sjis'} = *sjis2sjis;
324- $convf{'sjis' , 'euc' } = *sjis2euc;
325- $h2zf{'jis' } = *h2z_jis;
326- $z2hf{'jis' } = *z2h_jis;
327- $h2zf{'euc' } = *h2z_euc;
328- $z2hf{'euc' } = *z2h_euc;
329- $h2zf{'sjis'} = *h2z_sjis;
330- $z2hf{'sjis'} = *z2h_sjis;
331-}
332-
333-;#
334-;# Set escape sequences which should be put before and after Japanese
335-;# (JIS X0208) string.
336-;#
337-sub jis_inout {
338- $esc_0208 = shift || $esc_0208;
339- $esc_0208 = "\e\$$esc_0208" if length($esc_0208) == 1;
340- $esc_asc = shift || $esc_asc;
341- $esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
342- ($esc_0208, $esc_asc);
343-}
344-
345-;#
346-;# Get JIS in and out sequences from the string.
347-;#
348-sub get_inout {
349- local($esc_0208, $esc_asc);
350- $_[$[] =~ /($re_jis0208)/o && ($esc_0208 = $1);
351- $_[$[] =~ /($re_asc)/o && ($esc_asc = $1);
352- ($esc_0208, $esc_asc);
353-}
354-
355-;#
356-;# Recognize character code.
357-;#
358-sub getcode {
359- local(*s) = @_;
360- local($matched, $code);
361-
362- if ($s !~ /[\e\200-\377]/) { # not Japanese
363- $matched = 0;
364- $code = undef;
365- } # 'jis'
366- elsif ($s =~ /$re_jp|$re_asc|$re_kana/o) {
367- $matched = 1;
368- $code = 'jis';
369- }
370- elsif ($s =~ /$re_bin/o) { # 'binary'
371- $matched = 0;
372- $code = 'binary';
373- }
374- else { # should be 'euc' or 'sjis'
375- local($sjis, $euc) = (0, 0);
376-
377- while ($s =~ /(($re_sjis_c)+)/go) {
378- $sjis += length($1);
379- }
380- while ($s =~ /(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/go) {
381- $euc += length($1);
382- }
383- $matched = &max($sjis, $euc);
384- $code = ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1];
385- }
386- wantarray ? ($matched, $code) : $code;
387-}
388-sub max { $_[ $[ + ($_[ $[ ] < $_[ $[ + 1 ]) ]; }
389-
390-;#
391-;# Convert any code to specified code.
392-;#
393-sub convert {
394- local(*s, $ocode, $icode, $opt) = @_;
395- return (undef, undef) unless $icode = $icode || &getcode(*s);
396- return (undef, $icode) if $icode eq 'binary';
397- $ocode = 'jis' unless $ocode;
398- $ocode = $icode if $ocode eq 'noconv';
399- local(*f) = $convf{$icode, $ocode};
400- &f(*s, $opt);
401- wantarray ? (*f, $icode) : $icode;
402-}
403-
404-;#
405-;# Easy return-by-value interfaces.
406-;#
407-sub jis { &to('jis', @_); }
408-sub euc { &to('euc', @_); }
409-sub sjis { &to('sjis', @_); }
410-sub to {
411- local($ocode, $s, $icode, $opt) = @_;
412- &convert(*s, $ocode, $icode, $opt);
413- $s;
414-}
415-sub what {
416- local($s) = @_;
417- &getcode(*s);
418-}
419-sub trans {
420- local($s) = shift;
421- &tr(*s, @_);
422- $s;
423-}
424-
425-;#
426-;# SJIS to JIS
427-;#
428-sub sjis2jis {
429- local(*s, $opt, $n) = @_;
430- &sjis2sjis(*s, $opt) if $opt;
431- $s =~ s/(($re_sjis_c|$re_sjis_kana)+)/&_sjis2jis($1) . $esc_asc/geo;
432- $n;
433-}
434-sub _sjis2jis {
435- local($s) = shift;
436- $s =~ s/(($re_sjis_c)+|($re_sjis_kana)+)/&__sjis2jis($1)/geo;
437- $s;
438-}
439-sub __sjis2jis {
440- local($s) = shift;
441- if ($s =~ /^$re_sjis_kana/o) {
442- $n += $s =~ tr/\241-\337/\041-\137/;
443- $esc_kana . $s;
444- } else {
445- $n += $s =~ s/($re_sjis_c)/$s2e{$1}||&s2e($1)/geo;
446- $s =~ tr/\241-\376/\041-\176/;
447- $esc_0208 . $s;
448- }
449-}
450-
451-;#
452-;# EUC to JIS
453-;#
454-sub euc2jis {
455- local(*s, $opt, $n) = @_;
456- &euc2euc(*s, $opt) if $opt;
457- $s =~ s/(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/
458- &_euc2jis($1) . $esc_asc
459- /geo;
460- $n;
461-}
462-sub _euc2jis {
463- local($s) = shift;
464- $s =~ s/(($re_euc_c)+|($re_euc_kana)+|($re_euc_0212)+)/&__euc2jis($1)/geo;
465- $s;
466-}
467-sub __euc2jis {
468- local($s) = shift;
469- local($esc);
470-
471- if ($s =~ tr/\216//d) {
472- $esc = $esc_kana;
473- } elsif ($s =~ tr/\217//d) {
474- $esc = $esc_0212;
475- } else {
476- $esc = $esc_0208;
477- }
478-
479- $n += $s =~ tr/\241-\376/\041-\176/;
480- $esc . $s;
481-}
482-
483-;#
484-;# JIS to EUC
485-;#
486-sub jis2euc {
487- local(*s, $opt, $n) = @_;
488- $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
489- &euc2euc(*s, $opt) if $opt;
490- $n;
491-}
492-sub _jis2euc {
493- local($esc, $s) = @_;
494- if ($esc !~ /^$re_asc/o) {
495- $n += $s =~ tr/\041-\176/\241-\376/;
496- if ($esc =~ /^$re_kana/o) {
497- $s =~ s/([\241-\337])/\216$1/g;
498- }
499- elsif ($esc =~ /^$re_jis0212/o) {
500- $s =~ s/([\241-\376][\241-\376])/\217$1/g;
501- }
502- }
503- $s;
504-}
505-
506-;#
507-;# JIS to SJIS
508-;#
509-sub jis2sjis {
510- local(*s, $opt, $n) = @_;
511- &jis2jis(*s, $opt) if $opt;
512- $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
513- $n;
514-}
515-sub _jis2sjis {
516- local($esc, $s) = @_;
517- if ($esc =~ /^$re_jis0212/o) {
518- $s =~ s/../$undef_sjis/g;
519- $n = length;
520- }
521- elsif ($esc !~ /^$re_asc/o) {
522- $n += $s =~ tr/\041-\176/\241-\376/;
523- if ($esc =~ /^$re_jp/o) {
524- $s =~ s/($re_euc_c)/$e2s{$1}||&e2s($1)/geo;
525- }
526- }
527- $s;
528-}
529-
530-;#
531-;# SJIS to EUC
532-;#
533-sub sjis2euc {
534- local(*s, $opt,$n) = @_;
535- $n = $s =~ s/($re_sjis_c|$re_sjis_kana)/$s2e{$1}||&s2e($1)/geo;
536- &euc2euc(*s, $opt) if $opt;
537- $n;
538-}
539-sub s2e {
540- local($c1, $c2, $code);
541- ($c1, $c2) = unpack('CC', $code = shift);
542-
543- if (0xa1 <= $c1 && $c1 <= 0xdf) {
544- $c2 = $c1;
545- $c1 = 0x8e;
546- } elsif (0x9f <= $c2) {
547- $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
548- $c2 += 2;
549- } else {
550- $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
551- $c2 += 0x60 + ($c2 < 0x7f);
552- }
553- if ($cache) {
554- $s2e{$code} = pack('CC', $c1, $c2);
555- } else {
556- pack('CC', $c1, $c2);
557- }
558-}
559-
560-;#
561-;# EUC to SJIS
562-;#
563-sub euc2sjis {
564- local(*s, $opt,$n) = @_;
565- &euc2euc(*s, $opt) if $opt;
566- $n = $s =~ s/($re_euc_c|$re_euc_kana|$re_euc_0212)/$e2s{$1}||&e2s($1)/geo;
567-}
568-sub e2s {
569- local($c1, $c2, $code);
570- ($c1, $c2) = unpack('CC', $code = shift);
571-
572- if ($c1 == 0x8e) { # SS2
573- return substr($code, 1, 1);
574- } elsif ($c1 == 0x8f) { # SS3
575- return $undef_sjis;
576- } elsif ($c1 % 2) {
577- $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
578- $c2 -= 0x60 + ($c2 < 0xe0);
579- } else {
580- $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
581- $c2 -= 2;
582- }
583- if ($cache) {
584- $e2s{$code} = pack('CC', $c1, $c2);
585- } else {
586- pack('CC', $c1, $c2);
587- }
588-}
589-
590-;#
591-;# JIS to JIS, SJIS to SJIS, EUC to EUC
592-;#
593-sub jis2jis {
594- local(*s, $opt) = @_;
595- $s =~ s/$re_jis0208/$esc_0208/go;
596- $s =~ s/$re_asc/$esc_asc/go;
597- &h2z_jis(*s) if $opt =~ /z/;
598- &z2h_jis(*s) if $opt =~ /h/;
599-}
600-sub sjis2sjis {
601- local(*s, $opt) = @_;
602- &h2z_sjis(*s) if $opt =~ /z/;
603- &z2h_sjis(*s) if $opt =~ /h/;
604-}
605-sub euc2euc {
606- local(*s, $opt) = @_;
607- &h2z_euc(*s) if $opt =~ /z/;
608- &z2h_euc(*s) if $opt =~ /h/;
609-}
610-
611-;#
612-;# Cache control functions
613-;#
614-sub cache {
615- ($cache, $cache = 1)[$[];
616-}
617-sub nocache {
618- ($cache, $cache = 0)[$[];
619-}
620-sub flushcache {
621- undef %e2s;
622- undef %s2e;
623-}
624-
625-;#
626-;# X0201 -> X0208 KANA conversion routine
627-;#
628-sub h2z_jis {
629- local(*s, $n) = @_;
630- if ($s =~ s/$re_kana([^\e]*)/$esc_0208 . &_h2z_jis($1)/geo) {
631- 1 while $s =~ s/(($re_jis0208)[^\e]*)($re_jis0208)/$1/o;
632- }
633- $n;
634-}
635-sub _h2z_jis {
636- local($s) = @_;
637- $n += $s =~ s/([\41-\137]([\136\137])?)/$h2z{$1}/g;
638- $s;
639-}
640-
641-sub h2z_euc {
642- local(*s) = @_;
643- $s =~ s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;
644-}
645-
646-sub h2z_sjis {
647- local(*s, $n) = @_;
648- $s =~ s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/
649- $1 || ($n++, $e2s{$h2z{$3}} || &e2s($h2z{$3}))
650- /geo;
651- $n;
652-}
653-
654-;#
655-;# X0208 -> X0201 KANA conversion routine
656-;#
657-sub z2h_jis {
658- local(*s, $n) = @_;
659- $s =~ s/($re_jis0208)([^\e]+)/&_z2h_jis($2)/geo;
660- $n;
661-}
662-sub _z2h_jis {
663- local($s) = @_;
664- $s =~ s/((\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+)/
665- &__z2h_jis($1)
666- /ge;
667- $s;
668-}
669-sub __z2h_jis {
670- local($s) = @_;
671- return $esc_0208 . $s unless /^%/ || $s =~ /^![\#\"&VW+,<]/;
672- $n += length($s) / 2;
673- $s =~ s/(..)/$z2h{$1}/g;
674- $esc_kana . $s;
675-}
676-
677-sub z2h_euc {
678- local(*s, $n) = @_;
679- &init_z2h_euc unless defined %z2h_euc;
680- $s =~ s/($re_euc_c|$re_euc_kana)/
681- $z2h_euc{$1} ? ($n++, $z2h_euc{$1}) : $1
682- /geo;
683- $n;
684-}
685-
686-sub z2h_sjis {
687- local(*s, $n) = @_;
688- &init_z2h_sjis unless defined %z2h_sjis;
689- $s =~ s/($re_sjis_c)/$z2h_sjis{$1} ? ($n++, $z2h_sjis{$1}) : $1/geo;
690- $n;
691-}
692-
693-;#
694-;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
695-;# can be done in &init but it's not worth doing. Similarly,
696-;# precalculated table is not worth to occupy the file space and
697-;# reduce the readability. The author personnaly discourages to use
698-;# X0201 Kana character in the any situation.
699-;#
700-sub init_z2h_euc {
701- local($k, $s);
702- while (($k, $s) = each %z2h) {
703- $s =~ s/([\241-\337])/\216$1/g && ($z2h_euc{$k} = $s);
704- }
705-}
706-sub init_z2h_sjis {
707- local($s, $v);
708- while (($s, $v) = each %z2h) {
709- $s =~ /[\200-\377]/ && ($z2h_sjis{&e2s($s)} = $v);
710- }
711-}
712-
713-;#
714-;# TR function for 2-byte code
715-;#
716-sub tr {
717- # $prev_from, $prev_to, %table are persistent variables
718- local(*s, $from, $to, $opt) = @_;
719- local(@from, @to);
720- local($jis, $n) = (0, 0);
721-
722- $jis++, &jis2euc(*s) if $s =~ /$re_jp|$re_asc|$re_kana/o;
723- $jis++ if $to =~ /$re_jp|$re_asc|$re_kana/o;
724-
725- if (!defined($prev_from) || $from ne $prev_from || $to ne $prev_to) {
726- ($prev_from, $prev_to) = ($from, $to);
727- undef %table;
728- &_maketable;
729- }
730-
731- $s =~ s/([\200-\377][\000-\377]|[\000-\377])/
732- defined($table{$1}) && ++$n ? $table{$1} : $1
733- /ge;
734-
735- &euc2jis(*s) if $jis;
736-
737- $n;
738-}
739-
740-sub _maketable {
741- local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';
742-
743- &jis2euc(*to) if $to =~ /$re_jp|$re_asc|$re_kana/o;
744- &jis2euc(*from) if $from =~ /$re_jp|$re_asc|$re_kana/o;
745-
746- grep(s/(([\200-\377])[\200-\377]-\2[\200-\377])/&_expnd2($1)/ge,
747- $from, $to);
748- grep(s/($ascii-$ascii)/&_expnd1($1)/geo,
749- $from, $to);
750-
751- @to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;
752- @from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;
753- push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
754- @table{@from} = @to;
755-}
756-
757-sub _expnd1 {
758- local($s) = @_;
759- $s =~ s/\\(.)/$1/g;
760- local($c1, $c2) = unpack('CxC', $s);
761- if ($c1 <= $c2) {
762- for ($s = ''; $c1 <= $c2; $c1++) {
763- $s .= pack('C', $c1);
764- }
765- }
766- $s;
767-}
768-
769-sub _expnd2 {
770- local($s) = @_;
771- local($c1, $c2, $c3, $c4) = unpack('CCxCC', $s);
772- if ($c1 == $c3 && $c2 <= $c4) {
773- for ($s = ''; $c2 <= $c4; $c2++) {
774- $s .= pack('CC', $c1, $c2);
775- }
776- }
777- $s;
778-}
779-
780-1;
1+package jcode;
2+;######################################################################
3+;#
4+;# jcode.pl: Perl library for Japanese character code conversion
5+;#
6+;# Copyright (c) 1995-1999 Kazumasa Utashiro <utashiro@iij.ad.jp>
7+;# Internet Initiative Japan Inc.
8+;# 3-13 Kanda Nishiki-cho, Chiyoda-ku, Tokyo 101-0054, Japan
9+;#
10+;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
11+;# Software Research Associates, Inc.
12+;#
13+;# Use and redistribution for ANY PURPOSE are granted as long as all
14+;# copyright notices are retained. Redistribution with modification
15+;# is allowed provided that you make your modified version obviously
16+;# distinguishable from the original one. THIS SOFTWARE IS PROVIDED
17+;# BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE
18+;# DISCLAIMED.
19+;#
20+;# Original version was developed under the name of srekcah@sra.co.jp
21+;# February 1992 and it was called kconv.pl at the beginning. This
22+;# address was a pen name for group of individuals and it is no longer
23+;# valid.
24+;#
25+;# The latest version is available here:
26+;#
27+;# ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/
28+;#
29+;; $rcsid = q$Id: jcode.pl,v 1.1 2003/09/18 15:35:28 takezoe Exp $;
30+;#
31+;######################################################################
32+;#
33+;# PERL4 INTERFACE:
34+;#
35+;# &jcode'getcode(*line)
36+;# Return 'jis', 'sjis', 'euc' or undef according to
37+;# Japanese character code in $line. Return 'binary' if
38+;# the data has non-character code.
39+;#
40+;# When evaluated in array context, it returns a list
41+;# contains two items. First value is the number of
42+;# characters which matched to the expected code, and
43+;# second value is the code name. It is useful if and
44+;# only if the number is not 0 and the code is undef;
45+;# that case means it couldn't tell 'euc' or 'sjis'
46+;# because the evaluation score was exactly same. This
47+;# interface is too tricky, though.
48+;#
49+;# Code detection between euc and sjis is very difficult
50+;# or sometimes impossible or even lead to wrong result
51+;# when it includes JIS X0201 KANA characters. So JIS
52+;# X0201 KANA is ignored for automatic code detection.
53+;#
54+;# &jcode'convert(*line, $ocode [, $icode [, $option]])
55+;# Convert the contents of $line to the specified
56+;# Japanese code given in the second argument $ocode.
57+;# $ocode can be any of "jis", "sjis" or "euc", or use
58+;# "noconv" when you don't want the code conversion.
59+;# Input code is recognized automatically from the line
60+;# itself when $icode is not supplied (JIS X0201 KANA is
61+;# ignored in code detection. See the above descripton
62+;# of &getcode). $icode also can be specified, but
63+;# xxx2yyy routine is more efficient when both codes are
64+;# known.
65+;#
66+;# It returns the code of input string in scalar context,
67+;# and a list of pointer of convert subroutine and the
68+;# input code in array context.
69+;#
70+;# Japanese character code JIS X0201, X0208, X0212 and
71+;# ASCII code are supported. X0212 characters can not be
72+;# represented in SJIS and they will be replased by
73+;# "geta" character when converted to SJIS.
74+;#
75+;# See next paragraph for $option parameter.
76+;#
77+;# &jcode'xxx2yyy(*line [, $option])
78+;# Convert the Japanese code from xxx to yyy. String xxx
79+;# and yyy are any convination from "jis", "euc" or
80+;# "sjis". They return *approximate* number of converted
81+;# bytes. So return value 0 means the line was not
82+;# converted at all.
83+;#
84+;# Optional parameter $option is used to specify optional
85+;# conversion method. String "z" is for JIS X0201 KANA
86+;# to X0208 KANA, and "h" is for reverse.
87+;#
88+;# $jcode'convf{'xxx', 'yyy'}
89+;# The value of this associative array is pointer to the
90+;# subroutine jcode'xxx2yyy().
91+;#
92+;# &jcode'to($ocode, $line [, $icode [, $option]])
93+;# &jcode'jis($line [, $icode [, $option]])
94+;# &jcode'euc($line [, $icode [, $option]])
95+;# &jcode'sjis($line [, $icode [, $option]])
96+;# These functions are prepared for easy use of
97+;# call/return-by-value interface. You can use these
98+;# funcitons in s///e operation or any other place for
99+;# convenience.
100+;#
101+;# &jcode'jis_inout($in, $out)
102+;# Set or inquire JIS start and end sequences. Default
103+;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
104+;# character, "ESC-$" or "ESC-(" is prepended for each
105+;# character respectively. Acutually "ESC-(-B" is not a
106+;# sequence to end JIS code but a sequence to start ASCII
107+;# code set. So `in' and `out' are somewhat misleading.
108+;#
109+;# &jcode'get_inout($string)
110+;# Get JIS start and end sequences from $string.
111+;#
112+;# &jcode'cache()
113+;# &jcode'nocache()
114+;# &jcode'flush()
115+;# Usually, converted character is cached in memory to
116+;# avoid same calculations have to be done many times.
117+;# To disable this caching, call &jcode'nocache(). It
118+;# can be revived by &jcode'cache() and cache is flushed
119+;# by calling &jcode'flush(). &cache() and &nocache()
120+;# functions return previous caching state.
121+;#
122+;# ---------------------------------------------------------------
123+;#
124+;# &jcode'h2z_xxx(*line)
125+;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
126+;# (Zenkaku-KANA) code conversion routine. String xxx is
127+;# any of "jis", "sjis" and "euc". From the difficulty
128+;# of recognizing code set from 1-byte KATAKANA string,
129+;# automatic code recognition is not supported.
130+;#
131+;# &jcode'z2h_xxx(*line)
132+;# X0208 to X0201 KANA code conversion routine. String
133+;# xxx is any of "jis", "sjis" and "euc".
134+;#
135+;# $jcode'z2hf{'xxx'}
136+;# $jcode'h2zf{'xxx'}
137+;# These are pointer to the corresponding function just
138+;# as $jcode'convf.
139+;#
140+;# ---------------------------------------------------------------
141+;#
142+;# &jcode'tr(*line, $from, $to [, $option])
143+;# &jcode'tr emulates tr operator for 2 byte code. Only 'd'
144+;# is interpreted as an option.
145+;#
146+;# Range operator like `A-Z' for 2 byte code is partially
147+;# supported. Code must be JIS or EUC, and first byte
148+;# have to be same on first and last character.
149+;#
150+;# CAUTION: Handling range operator is a kind of trick
151+;# and it is not perfect. So if you need to transfer `-'
152+;# character, please be sure to put it at the beginning
153+;# or the end of $from and $to strings.
154+;#
155+;# &jcode'trans($line, $from, $to [, $option)
156+;# Same as &jcode'tr but accept string and return string
157+;# after translation.
158+;#
159+;# ---------------------------------------------------------------
160+;#
161+;# &jcode'init()
162+;# Initialize the variables used in this package. You
163+;# don't have to call this when using jocde.pl by `do' or
164+;# `require' interface. Call it first if you embedded
165+;# the jcode.pl at the end of your script.
166+;#
167+;######################################################################
168+;#
169+;# PERL5 INTERFACE:
170+;#
171+;# Current jcode.pl is written in Perl 4 but it is possible to use
172+;# from Perl 5 using `references'. Fully perl5 capable version is
173+;# future issue.
174+;#
175+;# Since lexical variable is not a subject of typeglob, *string style
176+;# call doesn't work if the variable is declared as `my'. Same thing
177+;# happens to special variable $_ if the perl is compiled to use
178+;# thread capability. So using reference is generally recommented to
179+;# avoid the mysterious error.
180+;#
181+;# jcode::getcode(\$line)
182+;# jcode::convert(\$line, $ocode [, $icode [, $option]])
183+;# jcode::xxx2yyy(\$line [, $option])
184+;# &{$jcode::convf{'xxx', 'yyy'}}(\$line)
185+;# jcode::to($ocode, $line [, $icode [, $option]])
186+;# jcode::jis($line [, $icode [, $option]])
187+;# jcode::euc($line [, $icode [, $option]])
188+;# jcode::sjis($line [, $icode [, $option]])
189+;# jcode::jis_inout($in, $out)
190+;# jcode::get_inout($string)
191+;# jcode::cache()
192+;# jcode::nocache()
193+;# jcode::flush()
194+;# jcode::h2z_xxx(\$line)
195+;# jcode::z2h_xxx(\$line)
196+;# &{$jcode::z2hf{'xxx'}}(\$line)
197+;# &{$jcode::h2zf{'xxx'}}(\$line)
198+;# jcode::tr(\$line, $from, $to [, $option])
199+;# jcode::trans($line, $from, $to [, $option)
200+;# jcode::init()
201+;#
202+;######################################################################
203+;#
204+;# SAMPLES
205+;#
206+;# Convert any Kanji code to JIS and print each line with code name.
207+;#
208+;# while (defined($s = <>)) {
209+;# $code = &jcode'convert(*s, 'jis');
210+;# print $code, "\t", $s;
211+;# }
212+;#
213+;# Convert all lines to JIS according to the first recognized line.
214+;#
215+;# while (defined($s = <>)) {
216+;# print, next unless $s =~ /[\033\200-\377]/;
217+;# (*f, $icode) = &jcode'convert(*s, 'jis');
218+;# print;
219+;# defined(&f) || next;
220+;# while (<>) { &f(*s); print; }
221+;# last;
222+;# }
223+;#
224+;# The safest way of JIS conversion.
225+;#
226+;# while (defined($s = <>)) {
227+;# ($matched, $icode) = &jcode'getcode(*s);
228+;# if (@buf == 0 && $matched == 0) {
229+;# print $s;
230+;# next;
231+;# }
232+;# push(@buf, $s);
233+;# next unless $icode;
234+;# while (defined($s = shift(@buf))) {
235+;# &jcode'convert(*s, 'jis', $icode);
236+;# print $s;
237+;# }
238+;# while (defined($s = <>)) {
239+;# &jcode'convert(*s, 'jis', $icode);
240+;# print $s;
241+;# }
242+;# last;
243+;# }
244+;# print @buf if @buf;
245+;#
246+;######################################################################
247+
248+;#
249+;# Call initialize function if it is not called yet. This may sound
250+;# strange but it makes easy to embed the jcode.pl at the end of
251+;# script. Call &jcode'init at the beginning of the script in that
252+;# case.
253+;#
254+&init unless defined $version;
255+
256+;#
257+;# Initialize variables.
258+;#
259+sub init {
260+ $version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';
261+
262+ $re_bin = '[\000-\006\177\377]';
263+
264+ $re_jis0208_1978 = '\e\$\@';
265+ $re_jis0208_1983 = '\e\$B';
266+ $re_jis0208_1990 = '\e&\@\e\$B';
267+ $re_jis0208 = "$re_jis0208_1978|$re_jis0208_1983|$re_jis0208_1990";
268+ $re_jis0212 = '\e\$\(D';
269+ $re_jp = "$re_jis0208|$re_jis0212";
270+ $re_asc = '\e\([BJ]';
271+ $re_kana = '\e\(I';
272+
273+ $esc_0208 = "\e\$B";
274+ $esc_0212 = "\e\$(D";
275+ $esc_asc = "\e(B";
276+ $esc_kana = "\e(I";
277+
278+ $re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
279+ $re_sjis_kana = '[\241-\337]';
280+
281+ $re_euc_c = '[\241-\376][\241-\376]';
282+ $re_euc_kana = '\216[\241-\337]';
283+ $re_euc_0212 = '\217[\241-\376][\241-\376]';
284+
285+ # Use `geta' for undefined character code
286+ $undef_sjis = "\x81\xac";
287+
288+ $cache = 1;
289+
290+ # X0201 -> X0208 KANA conversion table. Looks weird? Not that
291+ # much. This is simply JIS text without escape sequences.
292+ ($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\041-\176/\241-\376/;
293+! !# $ !" % !& " !V # !W
294+^ !+ _ !, 0 !<
295+' %! ( %# ) %% * %' + %)
296+, %c - %e . %g / %C
297+1 %" 2 %$ 3 %& 4 %( 5 %*
298+6 %+ 7 %- 8 %/ 9 %1 : %3
299+6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
300+; %5 < %7 = %9 > %; ? %=
301+;^ %6 <^ %8 =^ %: >^ %< ?^ %>
302+@ %? A %A B %D C %F D %H
303+@^ %@ A^ %B B^ %E C^ %G D^ %I
304+E %J F %K G %L H %M I %N
305+J %O K %R L %U M %X N %[
306+J^ %P K^ %S L^ %V M^ %Y N^ %\
307+J_ %Q K_ %T L_ %W M_ %Z N_ %]
308+O %^ P %_ Q %` R %a S %b
309+T %d U %f V %h
310+W %i X %j Y %k Z %l [ %m
311+\ %o ] %s & %r 3^ %t
312+__TABLE_END__
313+ %h2z = split(/\s+/, $h2z . $h2z_high);
314+ %z2h = reverse %h2z;
315+
316+ $convf{'jis' , 'jis' } = *jis2jis;
317+ $convf{'jis' , 'sjis'} = *jis2sjis;
318+ $convf{'jis' , 'euc' } = *jis2euc;
319+ $convf{'euc' , 'jis' } = *euc2jis;
320+ $convf{'euc' , 'sjis'} = *euc2sjis;
321+ $convf{'euc' , 'euc' } = *euc2euc;
322+ $convf{'sjis' , 'jis' } = *sjis2jis;
323+ $convf{'sjis' , 'sjis'} = *sjis2sjis;
324+ $convf{'sjis' , 'euc' } = *sjis2euc;
325+ $h2zf{'jis' } = *h2z_jis;
326+ $z2hf{'jis' } = *z2h_jis;
327+ $h2zf{'euc' } = *h2z_euc;
328+ $z2hf{'euc' } = *z2h_euc;
329+ $h2zf{'sjis'} = *h2z_sjis;
330+ $z2hf{'sjis'} = *z2h_sjis;
331+}
332+
333+;#
334+;# Set escape sequences which should be put before and after Japanese
335+;# (JIS X0208) string.
336+;#
337+sub jis_inout {
338+ $esc_0208 = shift || $esc_0208;
339+ $esc_0208 = "\e\$$esc_0208" if length($esc_0208) == 1;
340+ $esc_asc = shift || $esc_asc;
341+ $esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
342+ ($esc_0208, $esc_asc);
343+}
344+
345+;#
346+;# Get JIS in and out sequences from the string.
347+;#
348+sub get_inout {
349+ local($esc_0208, $esc_asc);
350+ $_[$[] =~ /($re_jis0208)/o && ($esc_0208 = $1);
351+ $_[$[] =~ /($re_asc)/o && ($esc_asc = $1);
352+ ($esc_0208, $esc_asc);
353+}
354+
355+;#
356+;# Recognize character code.
357+;#
358+sub getcode {
359+ local(*s) = @_;
360+ local($matched, $code);
361+
362+ if ($s !~ /[\e\200-\377]/) { # not Japanese
363+ $matched = 0;
364+ $code = undef;
365+ } # 'jis'
366+ elsif ($s =~ /$re_jp|$re_asc|$re_kana/o) {
367+ $matched = 1;
368+ $code = 'jis';
369+ }
370+ elsif ($s =~ /$re_bin/o) { # 'binary'
371+ $matched = 0;
372+ $code = 'binary';
373+ }
374+ else { # should be 'euc' or 'sjis'
375+ local($sjis, $euc) = (0, 0);
376+
377+ while ($s =~ /(($re_sjis_c)+)/go) {
378+ $sjis += length($1);
379+ }
380+ while ($s =~ /(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/go) {
381+ $euc += length($1);
382+ }
383+ $matched = &max($sjis, $euc);
384+ $code = ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1];
385+ }
386+ wantarray ? ($matched, $code) : $code;
387+}
388+sub max { $_[ $[ + ($_[ $[ ] < $_[ $[ + 1 ]) ]; }
389+
390+;#
391+;# Convert any code to specified code.
392+;#
393+sub convert {
394+ local(*s, $ocode, $icode, $opt) = @_;
395+ return (undef, undef) unless $icode = $icode || &getcode(*s);
396+ return (undef, $icode) if $icode eq 'binary';
397+ $ocode = 'jis' unless $ocode;
398+ $ocode = $icode if $ocode eq 'noconv';
399+ local(*f) = $convf{$icode, $ocode};
400+ &f(*s, $opt);
401+ wantarray ? (*f, $icode) : $icode;
402+}
403+
404+;#
405+;# Easy return-by-value interfaces.
406+;#
407+sub jis { &to('jis', @_); }
408+sub euc { &to('euc', @_); }
409+sub sjis { &to('sjis', @_); }
410+sub to {
411+ local($ocode, $s, $icode, $opt) = @_;
412+ &convert(*s, $ocode, $icode, $opt);
413+ $s;
414+}
415+sub what {
416+ local($s) = @_;
417+ &getcode(*s);
418+}
419+sub trans {
420+ local($s) = shift;
421+ &tr(*s, @_);
422+ $s;
423+}
424+
425+;#
426+;# SJIS to JIS
427+;#
428+sub sjis2jis {
429+ local(*s, $opt, $n) = @_;
430+ &sjis2sjis(*s, $opt) if $opt;
431+ $s =~ s/(($re_sjis_c|$re_sjis_kana)+)/&_sjis2jis($1) . $esc_asc/geo;
432+ $n;
433+}
434+sub _sjis2jis {
435+ local($s) = shift;
436+ $s =~ s/(($re_sjis_c)+|($re_sjis_kana)+)/&__sjis2jis($1)/geo;
437+ $s;
438+}
439+sub __sjis2jis {
440+ local($s) = shift;
441+ if ($s =~ /^$re_sjis_kana/o) {
442+ $n += $s =~ tr/\241-\337/\041-\137/;
443+ $esc_kana . $s;
444+ } else {
445+ $n += $s =~ s/($re_sjis_c)/$s2e{$1}||&s2e($1)/geo;
446+ $s =~ tr/\241-\376/\041-\176/;
447+ $esc_0208 . $s;
448+ }
449+}
450+
451+;#
452+;# EUC to JIS
453+;#
454+sub euc2jis {
455+ local(*s, $opt, $n) = @_;
456+ &euc2euc(*s, $opt) if $opt;
457+ $s =~ s/(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/
458+ &_euc2jis($1) . $esc_asc
459+ /geo;
460+ $n;
461+}
462+sub _euc2jis {
463+ local($s) = shift;
464+ $s =~ s/(($re_euc_c)+|($re_euc_kana)+|($re_euc_0212)+)/&__euc2jis($1)/geo;
465+ $s;
466+}
467+sub __euc2jis {
468+ local($s) = shift;
469+ local($esc);
470+
471+ if ($s =~ tr/\216//d) {
472+ $esc = $esc_kana;
473+ } elsif ($s =~ tr/\217//d) {
474+ $esc = $esc_0212;
475+ } else {
476+ $esc = $esc_0208;
477+ }
478+
479+ $n += $s =~ tr/\241-\376/\041-\176/;
480+ $esc . $s;
481+}
482+
483+;#
484+;# JIS to EUC
485+;#
486+sub jis2euc {
487+ local(*s, $opt, $n) = @_;
488+ $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
489+ &euc2euc(*s, $opt) if $opt;
490+ $n;
491+}
492+sub _jis2euc {
493+ local($esc, $s) = @_;
494+ if ($esc !~ /^$re_asc/o) {
495+ $n += $s =~ tr/\041-\176/\241-\376/;
496+ if ($esc =~ /^$re_kana/o) {
497+ $s =~ s/([\241-\337])/\216$1/g;
498+ }
499+ elsif ($esc =~ /^$re_jis0212/o) {
500+ $s =~ s/([\241-\376][\241-\376])/\217$1/g;
501+ }
502+ }
503+ $s;
504+}
505+
506+;#
507+;# JIS to SJIS
508+;#
509+sub jis2sjis {
510+ local(*s, $opt, $n) = @_;
511+ &jis2jis(*s, $opt) if $opt;
512+ $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
513+ $n;
514+}
515+sub _jis2sjis {
516+ local($esc, $s) = @_;
517+ if ($esc =~ /^$re_jis0212/o) {
518+ $s =~ s/../$undef_sjis/g;
519+ $n = length;
520+ }
521+ elsif ($esc !~ /^$re_asc/o) {
522+ $n += $s =~ tr/\041-\176/\241-\376/;
523+ if ($esc =~ /^$re_jp/o) {
524+ $s =~ s/($re_euc_c)/$e2s{$1}||&e2s($1)/geo;
525+ }
526+ }
527+ $s;
528+}
529+
530+;#
531+;# SJIS to EUC
532+;#
533+sub sjis2euc {
534+ local(*s, $opt,$n) = @_;
535+ $n = $s =~ s/($re_sjis_c|$re_sjis_kana)/$s2e{$1}||&s2e($1)/geo;
536+ &euc2euc(*s, $opt) if $opt;
537+ $n;
538+}
539+sub s2e {
540+ local($c1, $c2, $code);
541+ ($c1, $c2) = unpack('CC', $code = shift);
542+
543+ if (0xa1 <= $c1 && $c1 <= 0xdf) {
544+ $c2 = $c1;
545+ $c1 = 0x8e;
546+ } elsif (0x9f <= $c2) {
547+ $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
548+ $c2 += 2;
549+ } else {
550+ $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
551+ $c2 += 0x60 + ($c2 < 0x7f);
552+ }
553+ if ($cache) {
554+ $s2e{$code} = pack('CC', $c1, $c2);
555+ } else {
556+ pack('CC', $c1, $c2);
557+ }
558+}
559+
560+;#
561+;# EUC to SJIS
562+;#
563+sub euc2sjis {
564+ local(*s, $opt,$n) = @_;
565+ &euc2euc(*s, $opt) if $opt;
566+ $n = $s =~ s/($re_euc_c|$re_euc_kana|$re_euc_0212)/$e2s{$1}||&e2s($1)/geo;
567+}
568+sub e2s {
569+ local($c1, $c2, $code);
570+ ($c1, $c2) = unpack('CC', $code = shift);
571+
572+ if ($c1 == 0x8e) { # SS2
573+ return substr($code, 1, 1);
574+ } elsif ($c1 == 0x8f) { # SS3
575+ return $undef_sjis;
576+ } elsif ($c1 % 2) {
577+ $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
578+ $c2 -= 0x60 + ($c2 < 0xe0);
579+ } else {
580+ $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
581+ $c2 -= 2;
582+ }
583+ if ($cache) {
584+ $e2s{$code} = pack('CC', $c1, $c2);
585+ } else {
586+ pack('CC', $c1, $c2);
587+ }
588+}
589+
590+;#
591+;# JIS to JIS, SJIS to SJIS, EUC to EUC
592+;#
593+sub jis2jis {
594+ local(*s, $opt) = @_;
595+ $s =~ s/$re_jis0208/$esc_0208/go;
596+ $s =~ s/$re_asc/$esc_asc/go;
597+ &h2z_jis(*s) if $opt =~ /z/;
598+ &z2h_jis(*s) if $opt =~ /h/;
599+}
600+sub sjis2sjis {
601+ local(*s, $opt) = @_;
602+ &h2z_sjis(*s) if $opt =~ /z/;
603+ &z2h_sjis(*s) if $opt =~ /h/;
604+}
605+sub euc2euc {
606+ local(*s, $opt) = @_;
607+ &h2z_euc(*s) if $opt =~ /z/;
608+ &z2h_euc(*s) if $opt =~ /h/;
609+}
610+
611+;#
612+;# Cache control functions
613+;#
614+sub cache {
615+ ($cache, $cache = 1)[$[];
616+}
617+sub nocache {
618+ ($cache, $cache = 0)[$[];
619+}
620+sub flushcache {
621+ undef %e2s;
622+ undef %s2e;
623+}
624+
625+;#
626+;# X0201 -> X0208 KANA conversion routine
627+;#
628+sub h2z_jis {
629+ local(*s, $n) = @_;
630+ if ($s =~ s/$re_kana([^\e]*)/$esc_0208 . &_h2z_jis($1)/geo) {
631+ 1 while $s =~ s/(($re_jis0208)[^\e]*)($re_jis0208)/$1/o;
632+ }
633+ $n;
634+}
635+sub _h2z_jis {
636+ local($s) = @_;
637+ $n += $s =~ s/([\41-\137]([\136\137])?)/$h2z{$1}/g;
638+ $s;
639+}
640+
641+sub h2z_euc {
642+ local(*s) = @_;
643+ $s =~ s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;
644+}
645+
646+sub h2z_sjis {
647+ local(*s, $n) = @_;
648+ $s =~ s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/
649+ $1 || ($n++, $e2s{$h2z{$3}} || &e2s($h2z{$3}))
650+ /geo;
651+ $n;
652+}
653+
654+;#
655+;# X0208 -> X0201 KANA conversion routine
656+;#
657+sub z2h_jis {
658+ local(*s, $n) = @_;
659+ $s =~ s/($re_jis0208)([^\e]+)/&_z2h_jis($2)/geo;
660+ $n;
661+}
662+sub _z2h_jis {
663+ local($s) = @_;
664+ $s =~ s/((\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+)/
665+ &__z2h_jis($1)
666+ /ge;
667+ $s;
668+}
669+sub __z2h_jis {
670+ local($s) = @_;
671+ return $esc_0208 . $s unless /^%/ || $s =~ /^![\#\"&VW+,<]/;
672+ $n += length($s) / 2;
673+ $s =~ s/(..)/$z2h{$1}/g;
674+ $esc_kana . $s;
675+}
676+
677+sub z2h_euc {
678+ local(*s, $n) = @_;
679+ &init_z2h_euc unless defined %z2h_euc;
680+ $s =~ s/($re_euc_c|$re_euc_kana)/
681+ $z2h_euc{$1} ? ($n++, $z2h_euc{$1}) : $1
682+ /geo;
683+ $n;
684+}
685+
686+sub z2h_sjis {
687+ local(*s, $n) = @_;
688+ &init_z2h_sjis unless defined %z2h_sjis;
689+ $s =~ s/($re_sjis_c)/$z2h_sjis{$1} ? ($n++, $z2h_sjis{$1}) : $1/geo;
690+ $n;
691+}
692+
693+;#
694+;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
695+;# can be done in &init but it's not worth doing. Similarly,
696+;# precalculated table is not worth to occupy the file space and
697+;# reduce the readability. The author personnaly discourages to use
698+;# X0201 Kana character in the any situation.
699+;#
700+sub init_z2h_euc {
701+ local($k, $s);
702+ while (($k, $s) = each %z2h) {
703+ $s =~ s/([\241-\337])/\216$1/g && ($z2h_euc{$k} = $s);
704+ }
705+}
706+sub init_z2h_sjis {
707+ local($s, $v);
708+ while (($s, $v) = each %z2h) {
709+ $s =~ /[\200-\377]/ && ($z2h_sjis{&e2s($s)} = $v);
710+ }
711+}
712+
713+;#
714+;# TR function for 2-byte code
715+;#
716+sub tr {
717+ # $prev_from, $prev_to, %table are persistent variables
718+ local(*s, $from, $to, $opt) = @_;
719+ local(@from, @to);
720+ local($jis, $n) = (0, 0);
721+
722+ $jis++, &jis2euc(*s) if $s =~ /$re_jp|$re_asc|$re_kana/o;
723+ $jis++ if $to =~ /$re_jp|$re_asc|$re_kana/o;
724+
725+ if (!defined($prev_from) || $from ne $prev_from || $to ne $prev_to) {
726+ ($prev_from, $prev_to) = ($from, $to);
727+ undef %table;
728+ &_maketable;
729+ }
730+
731+ $s =~ s/([\200-\377][\000-\377]|[\000-\377])/
732+ defined($table{$1}) && ++$n ? $table{$1} : $1
733+ /ge;
734+
735+ &euc2jis(*s) if $jis;
736+
737+ $n;
738+}
739+
740+sub _maketable {
741+ local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';
742+
743+ &jis2euc(*to) if $to =~ /$re_jp|$re_asc|$re_kana/o;
744+ &jis2euc(*from) if $from =~ /$re_jp|$re_asc|$re_kana/o;
745+
746+ grep(s/(([\200-\377])[\200-\377]-\2[\200-\377])/&_expnd2($1)/ge,
747+ $from, $to);
748+ grep(s/($ascii-$ascii)/&_expnd1($1)/geo,
749+ $from, $to);
750+
751+ @to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;
752+ @from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;
753+ push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
754+ @table{@from} = @to;
755+}
756+
757+sub _expnd1 {
758+ local($s) = @_;
759+ $s =~ s/\\(.)/$1/g;
760+ local($c1, $c2) = unpack('CxC', $s);
761+ if ($c1 <= $c2) {
762+ for ($s = ''; $c1 <= $c2; $c1++) {
763+ $s .= pack('C', $c1);
764+ }
765+ }
766+ $s;
767+}
768+
769+sub _expnd2 {
770+ local($s) = @_;
771+ local($c1, $c2, $c3, $c4) = unpack('CCxCC', $s);
772+ if ($c1 == $c3 && $c2 <= $c4) {
773+ for ($s = ''; $c2 <= $c4; $c2++) {
774+ $s .= pack('CC', $c1, $c2);
775+ }
776+ }
777+ $s;
778+}
779+
780+1;
--- a/lib/mimew.pl
+++ b/lib/mimew.pl
@@ -1,322 +1,322 @@
1-package MIME;
2-# Copyright (C) 1993-94,1997 Noboru Ikuta <noboru@ikuta.ichihara.chiba.jp>
3-#
4-# mimew.pl: MIME encoder library Ver.2.02 (1997/12/30)
5-
6-$main'mimew_version = "2.02";
7-
8-# インストール : @INC のディレクトリ(通常は /usr/local/lib/perl)にコピー
9-# して下さい。
10-#
11-# 使用例1 : require 'mimew.pl';
12-# $from = "From: 生田 昇 <noboru\@ikuta.ichihara.chiba.jp>";
13-# print &mimeencode($from);
14-#
15-# 使用例2 : # UNIXでBase64エンコードする場合
16-# require 'mimew.pl';
17-# undef $/;
18-# $body = <>;
19-# print &bodyencode($body);
20-# print &benflush;
21-#
22-# &bodyencode($data,$coding):
23-# データをBase64形式またはQuoted-Printable形式でエンコードする。
24-# 第2パラメータに"qp"または"b64"を指定することによりコーディング形式
25-# を指示することができる。第2パラメータを省略するとBase64形式でエン
26-# コードする。
27-# Base64形式のエンコードの場合は、$foldcol*3/4 バイト単位で変換する
28-# ので、渡されたデータのうち半端な部分はバッファに保存され次に呼ばれ
29-# たときに処理される。最後にバッファに残ったデータは&benflushを呼ぶ
30-# ことにより処理されバッファからクリアされる。
31-# Quoted-Printable形式のエンコードの場合は、行単位で変換するため、
32-# データの最後に改行文字が無い場合、最後の改行文字の後ろのデータは
33-# バッファに保存され、次に呼ばれたときに処理される。最後にバッファ
34-# に残ったデータは&benflush("qp")を呼ぶことにより処理されバッファ
35-# からクリアされる。
36-#
37-# &benflush($coding):
38-# 第1パラメータに"b64"または"qp"を指定することにより、それぞれBase64
39-# 形式またはQuoted-Printable形式のエンコードを指定することができる。
40-# 第1パラメータに何も指定しなければBase64形式でエンコードされる。
41-# Base64のエンコードの場合、&bodyencodeが処理し残したデータを処理し
42-# pad文字を出力する。Quoted-Printableの場合、行単位でなくブロック単
43-# 位で&bodyencodeを呼ぶ場合、&bodyencodeが処理し残したデータがもし
44-# バッファに残っていればそれを処理する。
45-# 一つのデータを(1回または何回かに分けて)&bodyencodeした後に必ず1回
46-# 呼ぶ必要がある。
47-#
48-# &mimeencode($text):
49-# 第1パラメータが日本語文字列を含んでいれば、その部分をISO-2022-JPに
50-# 変換したあと、MIME encoded-word(RFC2047参照)に変換する。必要に応じ
51-# てencoded-wordの分割とencoded-wordの前後での行分割を行う。
52-#
53-# 文字コードの自動判定は、同一行にShiftJISとEUCが混在している場合を
54-# 除いて漢字コードの混在にも対応している。ShiftJISかEUCかどうしても
55-# 判断できないときは$often_use_kanjiに設定されているコードと判定する。
56-# ISO-2022-JPのエスケープシーケンスは$jis_inと$jis_outに設定すること
57-# により変更可能である。
58-
59-$often_use_kanji = 'EUC'; # or 'SJIS'
60-
61-$jis_in = "\x1b\$B"; # ESC-$-B ( or ESC-$-@ )
62-$jis_out = "\x1b\(B"; # ESC-(-B ( or ESC-(-J )
63-
64-# 配布条件 : 著作権は放棄しませんが、配布・改変は自由とします。改変して
65-# 配布する場合は、オリジナルと異なることを明記し、オリジナル
66-# のバージョンナンバーに改変版バージョンナンバーを付加した形
67-# 例えば Ver.2.02-XXXXX のようなバージョンナンバーを付けて下
68-# さい。なお、Copyright表示は変更しないでください。
69-#
70-# 注意 : &mimeencodeをjperl1.X(の2バイト文字対応モード)で使用すると、SJIS
71-# とEUCをうまく7bit JIS(ISO-2022-JP)に変換できません。
72-# 入力に含まれる文字が7bit JIS(ISO-2022-JP)とASCIIのみであること
73-# が保証されている場合を除き、必ずoriginalの英語版のperl(または
74-# jperl1.4以上を -Llatin オプション付き)で動かしてください。
75-# なお、Perl5対応のjperlは試したことがないのでどのような動作になる
76-# かわかりません。
77-#
78-# 参照 : RFC1468, RFC2045, RFC2047
79-
80-## MIME base64 アルファベットテーブル(RFC2045より)
81-%mime = (
82-"000000", "A", "000001", "B", "000010", "C", "000011", "D",
83-"000100", "E", "000101", "F", "000110", "G", "000111", "H",
84-"001000", "I", "001001", "J", "001010", "K", "001011", "L",
85-"001100", "M", "001101", "N", "001110", "O", "001111", "P",
86-"010000", "Q", "010001", "R", "010010", "S", "010011", "T",
87-"010100", "U", "010101", "V", "010110", "W", "010111", "X",
88-"011000", "Y", "011001", "Z", "011010", "a", "011011", "b",
89-"011100", "c", "011101", "d", "011110", "e", "011111", "f",
90-"100000", "g", "100001", "h", "100010", "i", "100011", "j",
91-"100100", "k", "100101", "l", "100110", "m", "100111", "n",
92-"101000", "o", "101001", "p", "101010", "q", "101011", "r",
93-"101100", "s", "101101", "t", "101110", "u", "101111", "v",
94-"110000", "w", "110001", "x", "110010", "y", "110011", "z",
95-"110100", "0", "110101", "1", "110110", "2", "110111", "3",
96-"111000", "4", "111001", "5", "111010", "6", "111011", "7",
97-"111100", "8", "111101", "9", "111110", "+", "111111", "/",
98-);
99-
100-## JISコード(byte数)→encoded-word の文字数対応
101-%mimelen = (
102- 8,30, 10,34, 12,34, 14,38, 16,42,
103-18,42, 20,46, 22,50, 24,50, 26,54,
104-28,58, 30,58, 32,62, 34,66, 36,66,
105-38,70, 40,74, 42,74,
106-);
107-
108-## ヘッダエンコード時の行の長さの制限
109-$limit=74; ## *注意* $limitを75より大きい数字に設定してはいけない。
110-
111-## ボディbase64エンコード時の行の長さの制限
112-$foldcol=72; ## *注意* $foldcolは76以下の4の倍数に設定すること。
113-
114-## ボディQuoted-Printableエンコード時の行の長さの制限
115-$qfoldcol=75; ## *注意* $foldcolは76以下に設定すること。
116-
117-## null bitの挿入と pad文字の挿入のためのテーブル
118-@zero = ( "", "00000", "0000", "000", "00", "0" );
119-@pad = ( "", "===", "==", "=" );
120-
121-## ASCII, 7bit JIS, Shift-JIS 及び EUC の各々にマッチするパターン
122-$match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)';
123-$match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)';
124-$match_sjis = '([\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])+';
125-$match_euc = '([\xa1-\xfe]{2})+';
126-
127-## MIME Part 2(charset=`ISO-2022-JP',encoding=`B') の head と tail
128-$mime_head = '=?ISO-2022-JP?B?';
129-$mime_tail = '?=';
130-
131-## &bodyencode が使う処理残しデータ用バッファ
132-$benbuf = "";
133-
134-## &bodyencode の処理単位(バイト)
135-$bensize = int($foldcol/4)*3;
136-
137-## &mimeencode interface ##
138-sub main'mimeencode {
139- local($_) = @_;
140- s/$match_jis/$jis_in$1/go;
141- s/$match_ascii/$jis_out$1/go;
142- $kanji = &checkkanji;
143- s/$match_sjis/&s2j($&)/geo if ($kanji eq 'SJIS');
144- s/$match_euc/&e2j($&)/geo if ($kanji eq 'EUC');
145- s/(\x1b[\$\(][BHJ@])+/$1/g;
146- 1 while s/(\x1b\$[B@][\x21-\x7e]+)\x1b\$[B@]/$1/;
147- 1 while s/$match_jis/&mimeencode($&,$`,$')/eo;
148- s/$match_ascii/$1/go;
149- $_;
150-}
151-
152-## &bodyencode interface ##
153-sub main'bodyencode {
154- local($_,$coding) = @_;
155- if (!defined($coding) || $coding eq "" || $coding eq "b64"){
156- $_ = $benbuf . $_;
157- local($cut) = int((length)/$bensize)*$bensize;
158- $benbuf = substr($_, $cut+$[);
159- $_ = substr($_, $[, $cut);
160- $_ = &base64encode($_);
161- s/.{$foldcol}/$&\n/g;
162- }elsif ($coding eq "qp"){
163- # $benbuf が空でなければデータの最初に追加する
164- $_ = $benbuf . $_;
165-
166- # 改行文字を正規化する
167- s/\r\n/\n/g;
168- s/\r/\n/g;
169-
170- # データを行単位に分割する(最後の改行文字以降を $benbuf に保存する)
171- @line = split(/\n/,$_,-1);
172- $benbuf = pop(@line);
173-
174- local($result) = "";
175- foreach (@line){
176- $_ = &qpencode($_);
177- $result .= $_ . "\n";
178- }
179- $_ = $result;
180- }
181- $_;
182-}
183-
184-## &benflush interface ##
185-sub main'benflush {
186- local($coding) = @_;
187- local($ret) = "";
188- if ((!defined($coding) || $coding eq "" || $coding eq "b64")
189- && $benbuf ne ""){
190- $ret = &base64encode($benbuf) . "\n";
191- $benbuf = "";
192- }elsif ($coding eq "qp" && $benbuf ne ""){
193- $ret = &qpencode($benbuf) . "\n";
194- $benbuf = "";
195- }
196- $ret;
197-}
198-
199-## MIME ヘッダエンコーディング
200-sub mimeencode {
201- local($_, $befor, $after) = @_;
202- local($back, $forw, $blen, $len, $flen, $str);
203- $befor = substr($befor, rindex($befor, "\n")+1);
204- $after = substr($after, 0, index($after, "\n")-$[);
205- $back = " " unless ($befor eq ""
206- || $befor =~ /[ \t\(]$/);
207- $forw = " " unless ($after =~ /^\x1b\([BHJ]$/
208- || $after =~ /^\x1b\([BHJ][ \t\)]/);
209- $blen = length($befor);
210- $flen = length($forw)+length($&)-3 if ($after =~ /^$match_ascii/o);
211- $len = length($_);
212- return "" if ($len <= 3);
213- if ($len > 39 || $blen + $mimelen{$len+3} > $limit){
214- if ($limit-$blen < 30){
215- $len = 0;
216- }else{
217- $len = int(($limit-$blen-26)/4)*2+3;
218- }
219- if ($len >= 5){
220- $str = substr($_, 0, $len).$jis_out;
221- $str = &base64encode($str);
222- $str = $mime_head.$str.$mime_tail;
223- $back.$str."\n ".$jis_in.substr($_, $len);
224- }else{
225- "\n ".$_;
226- }
227- }else{
228- $_ .= $jis_out;
229- $_ = &base64encode($_);
230- $_ = $back.$mime_head.$_.$mime_tail;
231- if ($blen + (length) + $flen > $limit){
232- $_."\n ";
233- }else{
234- $_.$forw;
235- }
236- }
237-}
238-
239-## MIME base64 エンコーディング
240-sub base64encode {
241- local($_) = @_;
242- $_ = unpack("B".((length)<<3), $_);
243- $_ .= $zero[(length)%6];
244- s/.{6}/$mime{$&}/go;
245- $_.$pad[(length)%4];
246-}
247-
248-## Quoted-Printable エンコーディング
249-sub qpencode {
250- local($_) = @_;
251-
252- # `=' 文字を16進表現に変換する
253- s/=/=3D/g;
254-
255- # 行末のタブとスペースを16進表現に変換する
256- s/\t$/=09/;
257- s/ $/=20/;
258-
259- # 印字可能文字(`!'〜`~')以外の文字を16進表現に変換する
260- s/([^!-~ \t])/&qphex($1)/ge;
261-
262- # 1行が$qfoldcol文字以下になるようにソフト改行をいれる
263- local($folded, $line) = "";
264- while (length($_) > $qfoldcol){
265- $line = substr($_, 0, $qfoldcol-1);
266- if ($line =~ /=$/){
267- $line = substr($_, 0, $qfoldcol-2);
268- $_ = substr($_, $qfoldcol-2);
269- }elsif ($line =~ /=[0-9A-Fa-f]$/){
270- $line = substr($_, 0, $qfoldcol-3);
271- $_ = substr($_, $qfoldcol-3);
272- }else{
273- $_ = substr($_, $qfoldcol-1);
274- }
275- $folded .= $line . "=\n";
276- }
277- $folded . $_;
278-}
279-
280-sub qphex {
281- local($_) = @_;
282- $_ = '=' . unpack("H2", $_);
283- tr/a-f/A-F/;
284- $_;
285-}
286-
287-## Shift-JIS と EUC のどちらの漢字コードが含まれるかをチェック
288-sub checkkanji {
289- local($sjis,$euc);
290- $sjis += length($&) while(/$match_sjis/go);
291- $euc += length($&) while(/$match_euc/go);
292- return 'NONE' if ($sjis == 0 && $euc == 0);
293- return 'SJIS' if ($sjis > $euc);
294- return 'EUC' if ($sjis < $euc);
295- $often_use_kanji;
296-}
297-
298-## EUC を 7bit JIS に変換
299-sub e2j {
300- local($_) = @_;
301- tr/\xa1-\xfe/\x21-\x7e/;
302- $jis_in.$_.$jis_out;
303-}
304-
305-## Shift-JIS を 7bit JIS に変換
306-sub s2j {
307- local($string);
308- local(@ch) = split(//, $_[0]);
309- while(($j1,$j2)=unpack("CC",shift(@ch).shift(@ch))){
310- if ($j2 > 0x9e){
311- $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+2;
312- $j2 -= 0x7e;
313- }
314- else{
315- $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+1;
316- $j2 -= ($j2>0x7e ? 0x20 : 0x1f);
317- }
318- $string .= pack("CC", $j1, $j2);
319- }
320- $jis_in.$string.$jis_out;
321-}
322-1;
1+package MIME;
2+# Copyright (C) 1993-94,1997 Noboru Ikuta <noboru@ikuta.ichihara.chiba.jp>
3+#
4+# mimew.pl: MIME encoder library Ver.2.02 (1997/12/30)
5+
6+$main'mimew_version = "2.02";
7+
8+# インストール : @INC のディレクトリ(通常は /usr/local/lib/perl)にコピー
9+# して下さい。
10+#
11+# 使用例1 : require 'mimew.pl';
12+# $from = "From: 生田 昇 <noboru\@ikuta.ichihara.chiba.jp>";
13+# print &mimeencode($from);
14+#
15+# 使用例2 : # UNIXでBase64エンコードする場合
16+# require 'mimew.pl';
17+# undef $/;
18+# $body = <>;
19+# print &bodyencode($body);
20+# print &benflush;
21+#
22+# &bodyencode($data,$coding):
23+# データをBase64形式またはQuoted-Printable形式でエンコードする。
24+# 第2パラメータに"qp"または"b64"を指定することによりコーディング形式
25+# を指示することができる。第2パラメータを省略するとBase64形式でエン
26+# コードする。
27+# Base64形式のエンコードの場合は、$foldcol*3/4 バイト単位で変換する
28+# ので、渡されたデータのうち半端な部分はバッファに保存され次に呼ばれ
29+# たときに処理される。最後にバッファに残ったデータは&benflushを呼ぶ
30+# ことにより処理されバッファからクリアされる。
31+# Quoted-Printable形式のエンコードの場合は、行単位で変換するため、
32+# データの最後に改行文字が無い場合、最後の改行文字の後ろのデータは
33+# バッファに保存され、次に呼ばれたときに処理される。最後にバッファ
34+# に残ったデータは&benflush("qp")を呼ぶことにより処理されバッファ
35+# からクリアされる。
36+#
37+# &benflush($coding):
38+# 第1パラメータに"b64"または"qp"を指定することにより、それぞれBase64
39+# 形式またはQuoted-Printable形式のエンコードを指定することができる。
40+# 第1パラメータに何も指定しなければBase64形式でエンコードされる。
41+# Base64のエンコードの場合、&bodyencodeが処理し残したデータを処理し
42+# pad文字を出力する。Quoted-Printableの場合、行単位でなくブロック単
43+# 位で&bodyencodeを呼ぶ場合、&bodyencodeが処理し残したデータがもし
44+# バッファに残っていればそれを処理する。
45+# 一つのデータを(1回または何回かに分けて)&bodyencodeした後に必ず1回
46+# 呼ぶ必要がある。
47+#
48+# &mimeencode($text):
49+# 第1パラメータが日本語文字列を含んでいれば、その部分をISO-2022-JPに
50+# 変換したあと、MIME encoded-word(RFC2047参照)に変換する。必要に応じ
51+# てencoded-wordの分割とencoded-wordの前後での行分割を行う。
52+#
53+# 文字コードの自動判定は、同一行にShiftJISとEUCが混在している場合を
54+# 除いて漢字コードの混在にも対応している。ShiftJISかEUCかどうしても
55+# 判断できないときは$often_use_kanjiに設定されているコードと判定する。
56+# ISO-2022-JPのエスケープシーケンスは$jis_inと$jis_outに設定すること
57+# により変更可能である。
58+
59+$often_use_kanji = 'EUC'; # or 'SJIS'
60+
61+$jis_in = "\x1b\$B"; # ESC-$-B ( or ESC-$-@ )
62+$jis_out = "\x1b\(B"; # ESC-(-B ( or ESC-(-J )
63+
64+# 配布条件 : 著作権は放棄しませんが、配布・改変は自由とします。改変して
65+# 配布する場合は、オリジナルと異なることを明記し、オリジナル
66+# のバージョンナンバーに改変版バージョンナンバーを付加した形
67+# 例えば Ver.2.02-XXXXX のようなバージョンナンバーを付けて下
68+# さい。なお、Copyright表示は変更しないでください。
69+#
70+# 注意 : &mimeencodeをjperl1.X(の2バイト文字対応モード)で使用すると、SJIS
71+# とEUCをうまく7bit JIS(ISO-2022-JP)に変換できません。
72+# 入力に含まれる文字が7bit JIS(ISO-2022-JP)とASCIIのみであること
73+# が保証されている場合を除き、必ずoriginalの英語版のperl(または
74+# jperl1.4以上を -Llatin オプション付き)で動かしてください。
75+# なお、Perl5対応のjperlは試したことがないのでどのような動作になる
76+# かわかりません。
77+#
78+# 参照 : RFC1468, RFC2045, RFC2047
79+
80+## MIME base64 アルファベットテーブル(RFC2045より)
81+%mime = (
82+"000000", "A", "000001", "B", "000010", "C", "000011", "D",
83+"000100", "E", "000101", "F", "000110", "G", "000111", "H",
84+"001000", "I", "001001", "J", "001010", "K", "001011", "L",
85+"001100", "M", "001101", "N", "001110", "O", "001111", "P",
86+"010000", "Q", "010001", "R", "010010", "S", "010011", "T",
87+"010100", "U", "010101", "V", "010110", "W", "010111", "X",
88+"011000", "Y", "011001", "Z", "011010", "a", "011011", "b",
89+"011100", "c", "011101", "d", "011110", "e", "011111", "f",
90+"100000", "g", "100001", "h", "100010", "i", "100011", "j",
91+"100100", "k", "100101", "l", "100110", "m", "100111", "n",
92+"101000", "o", "101001", "p", "101010", "q", "101011", "r",
93+"101100", "s", "101101", "t", "101110", "u", "101111", "v",
94+"110000", "w", "110001", "x", "110010", "y", "110011", "z",
95+"110100", "0", "110101", "1", "110110", "2", "110111", "3",
96+"111000", "4", "111001", "5", "111010", "6", "111011", "7",
97+"111100", "8", "111101", "9", "111110", "+", "111111", "/",
98+);
99+
100+## JISコード(byte数)→encoded-word の文字数対応
101+%mimelen = (
102+ 8,30, 10,34, 12,34, 14,38, 16,42,
103+18,42, 20,46, 22,50, 24,50, 26,54,
104+28,58, 30,58, 32,62, 34,66, 36,66,
105+38,70, 40,74, 42,74,
106+);
107+
108+## ヘッダエンコード時の行の長さの制限
109+$limit=74; ## *注意* $limitを75より大きい数字に設定してはいけない。
110+
111+## ボディbase64エンコード時の行の長さの制限
112+$foldcol=72; ## *注意* $foldcolは76以下の4の倍数に設定すること。
113+
114+## ボディQuoted-Printableエンコード時の行の長さの制限
115+$qfoldcol=75; ## *注意* $foldcolは76以下に設定すること。
116+
117+## null bitの挿入と pad文字の挿入のためのテーブル
118+@zero = ( "", "00000", "0000", "000", "00", "0" );
119+@pad = ( "", "===", "==", "=" );
120+
121+## ASCII, 7bit JIS, Shift-JIS 及び EUC の各々にマッチするパターン
122+$match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)';
123+$match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)';
124+$match_sjis = '([\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])+';
125+$match_euc = '([\xa1-\xfe]{2})+';
126+
127+## MIME Part 2(charset=`ISO-2022-JP',encoding=`B') の head と tail
128+$mime_head = '=?ISO-2022-JP?B?';
129+$mime_tail = '?=';
130+
131+## &bodyencode が使う処理残しデータ用バッファ
132+$benbuf = "";
133+
134+## &bodyencode の処理単位(バイト)
135+$bensize = int($foldcol/4)*3;
136+
137+## &mimeencode interface ##
138+sub main'mimeencode {
139+ local($_) = @_;
140+ s/$match_jis/$jis_in$1/go;
141+ s/$match_ascii/$jis_out$1/go;
142+ $kanji = &checkkanji;
143+ s/$match_sjis/&s2j($&)/geo if ($kanji eq 'SJIS');
144+ s/$match_euc/&e2j($&)/geo if ($kanji eq 'EUC');
145+ s/(\x1b[\$\(][BHJ@])+/$1/g;
146+ 1 while s/(\x1b\$[B@][\x21-\x7e]+)\x1b\$[B@]/$1/;
147+ 1 while s/$match_jis/&mimeencode($&,$`,$')/eo;
148+ s/$match_ascii/$1/go;
149+ $_;
150+}
151+
152+## &bodyencode interface ##
153+sub main'bodyencode {
154+ local($_,$coding) = @_;
155+ if (!defined($coding) || $coding eq "" || $coding eq "b64"){
156+ $_ = $benbuf . $_;
157+ local($cut) = int((length)/$bensize)*$bensize;
158+ $benbuf = substr($_, $cut+$[);
159+ $_ = substr($_, $[, $cut);
160+ $_ = &base64encode($_);
161+ s/.{$foldcol}/$&\n/g;
162+ }elsif ($coding eq "qp"){
163+ # $benbuf が空でなければデータの最初に追加する
164+ $_ = $benbuf . $_;
165+
166+ # 改行文字を正規化する
167+ s/\r\n/\n/g;
168+ s/\r/\n/g;
169+
170+ # データを行単位に分割する(最後の改行文字以降を $benbuf に保存する)
171+ @line = split(/\n/,$_,-1);
172+ $benbuf = pop(@line);
173+
174+ local($result) = "";
175+ foreach (@line){
176+ $_ = &qpencode($_);
177+ $result .= $_ . "\n";
178+ }
179+ $_ = $result;
180+ }
181+ $_;
182+}
183+
184+## &benflush interface ##
185+sub main'benflush {
186+ local($coding) = @_;
187+ local($ret) = "";
188+ if ((!defined($coding) || $coding eq "" || $coding eq "b64")
189+ && $benbuf ne ""){
190+ $ret = &base64encode($benbuf) . "\n";
191+ $benbuf = "";
192+ }elsif ($coding eq "qp" && $benbuf ne ""){
193+ $ret = &qpencode($benbuf) . "\n";
194+ $benbuf = "";
195+ }
196+ $ret;
197+}
198+
199+## MIME ヘッダエンコーディング
200+sub mimeencode {
201+ local($_, $befor, $after) = @_;
202+ local($back, $forw, $blen, $len, $flen, $str);
203+ $befor = substr($befor, rindex($befor, "\n")+1);
204+ $after = substr($after, 0, index($after, "\n")-$[);
205+ $back = " " unless ($befor eq ""
206+ || $befor =~ /[ \t\(]$/);
207+ $forw = " " unless ($after =~ /^\x1b\([BHJ]$/
208+ || $after =~ /^\x1b\([BHJ][ \t\)]/);
209+ $blen = length($befor);
210+ $flen = length($forw)+length($&)-3 if ($after =~ /^$match_ascii/o);
211+ $len = length($_);
212+ return "" if ($len <= 3);
213+ if ($len > 39 || $blen + $mimelen{$len+3} > $limit){
214+ if ($limit-$blen < 30){
215+ $len = 0;
216+ }else{
217+ $len = int(($limit-$blen-26)/4)*2+3;
218+ }
219+ if ($len >= 5){
220+ $str = substr($_, 0, $len).$jis_out;
221+ $str = &base64encode($str);
222+ $str = $mime_head.$str.$mime_tail;
223+ $back.$str."\n ".$jis_in.substr($_, $len);
224+ }else{
225+ "\n ".$_;
226+ }
227+ }else{
228+ $_ .= $jis_out;
229+ $_ = &base64encode($_);
230+ $_ = $back.$mime_head.$_.$mime_tail;
231+ if ($blen + (length) + $flen > $limit){
232+ $_."\n ";
233+ }else{
234+ $_.$forw;
235+ }
236+ }
237+}
238+
239+## MIME base64 エンコーディング
240+sub base64encode {
241+ local($_) = @_;
242+ $_ = unpack("B".((length)<<3), $_);
243+ $_ .= $zero[(length)%6];
244+ s/.{6}/$mime{$&}/go;
245+ $_.$pad[(length)%4];
246+}
247+
248+## Quoted-Printable エンコーディング
249+sub qpencode {
250+ local($_) = @_;
251+
252+ # `=' 文字を16進表現に変換する
253+ s/=/=3D/g;
254+
255+ # 行末のタブとスペースを16進表現に変換する
256+ s/\t$/=09/;
257+ s/ $/=20/;
258+
259+ # 印字可能文字(`!'〜`~')以外の文字を16進表現に変換する
260+ s/([^!-~ \t])/&qphex($1)/ge;
261+
262+ # 1行が$qfoldcol文字以下になるようにソフト改行をいれる
263+ local($folded, $line) = "";
264+ while (length($_) > $qfoldcol){
265+ $line = substr($_, 0, $qfoldcol-1);
266+ if ($line =~ /=$/){
267+ $line = substr($_, 0, $qfoldcol-2);
268+ $_ = substr($_, $qfoldcol-2);
269+ }elsif ($line =~ /=[0-9A-Fa-f]$/){
270+ $line = substr($_, 0, $qfoldcol-3);
271+ $_ = substr($_, $qfoldcol-3);
272+ }else{
273+ $_ = substr($_, $qfoldcol-1);
274+ }
275+ $folded .= $line . "=\n";
276+ }
277+ $folded . $_;
278+}
279+
280+sub qphex {
281+ local($_) = @_;
282+ $_ = '=' . unpack("H2", $_);
283+ tr/a-f/A-F/;
284+ $_;
285+}
286+
287+## Shift-JIS と EUC のどちらの漢字コードが含まれるかをチェック
288+sub checkkanji {
289+ local($sjis,$euc);
290+ $sjis += length($&) while(/$match_sjis/go);
291+ $euc += length($&) while(/$match_euc/go);
292+ return 'NONE' if ($sjis == 0 && $euc == 0);
293+ return 'SJIS' if ($sjis > $euc);
294+ return 'EUC' if ($sjis < $euc);
295+ $often_use_kanji;
296+}
297+
298+## EUC を 7bit JIS に変換
299+sub e2j {
300+ local($_) = @_;
301+ tr/\xa1-\xfe/\x21-\x7e/;
302+ $jis_in.$_.$jis_out;
303+}
304+
305+## Shift-JIS を 7bit JIS に変換
306+sub s2j {
307+ local($string);
308+ local(@ch) = split(//, $_[0]);
309+ while(($j1,$j2)=unpack("CC",shift(@ch).shift(@ch))){
310+ if ($j2 > 0x9e){
311+ $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+2;
312+ $j2 -= 0x7e;
313+ }
314+ else{
315+ $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+1;
316+ $j2 -= ($j2>0x7e ? 0x20 : 0x1f);
317+ }
318+ $string .= pack("CC", $j1, $j2);
319+ }
320+ $jis_in.$string.$jis_out;
321+}
322+1;
--- a/lib/setup.pl
+++ b/lib/setup.pl
@@ -1,33 +1,33 @@
1-################################################################################
2-#
3-# 設定ファイル
4-#
5-################################################################################
6-#===============================================================================
7-# 初期設定
8-#===============================================================================
9-$DATA_DIR = './data';
10-$BACKUP_DIR = './backup';
11-$ATTACH_DIR = './attach';
12-$THEME_URL = './theme/default/default.css';
13-$ADMIN_MAIL = '';
14-$SEND_MAIL = '';
15-$WIKI_NAME = 0;
16-$MAIN_SCRIPT = 'wiki.cgi';
17-$EDIT_SCRIPT = 'edit.cgi';
18-$CATEGORY_SCRIPT = 'category.cgi';
19-$DOWNLOAD_SCRIPT = 'download.cgi';
20-$SITE_TITLE = 'FSWikiLite';
21-
22-#===============================================================================
23-# プロダクト情報
24-#===============================================================================
25-$VERSION = '0.0.12';
26-$SITE_URL = 'http://fswiki.poi.jp/';
27-
28-#===============================================================================
29-# プラグインの設定
30-#===============================================================================
31-require "./plugin/core.pl";
32-
33-1;
1+################################################################################
2+#
3+# 設定ファイル
4+#
5+################################################################################
6+#===============================================================================
7+# 初期設定
8+#===============================================================================
9+$DATA_DIR = './data';
10+$BACKUP_DIR = './backup';
11+$ATTACH_DIR = './attach';
12+$THEME_URL = './theme/default/default.css';
13+$ADMIN_MAIL = '';
14+$SEND_MAIL = '';
15+$WIKI_NAME = 0;
16+$MAIN_SCRIPT = 'wiki.cgi';
17+$EDIT_SCRIPT = 'edit.cgi';
18+$CATEGORY_SCRIPT = 'category.cgi';
19+$DOWNLOAD_SCRIPT = 'download.cgi';
20+$SITE_TITLE = 'FSWikiLite';
21+
22+#===============================================================================
23+# プロダクト情報
24+#===============================================================================
25+$VERSION = '0.0.12';
26+$SITE_URL = 'http://fswiki.osdn.jp/cgi-bin/wiki.cgi';
27+
28+#===============================================================================
29+# プラグインの設定
30+#===============================================================================
31+require "./plugin/core.pl";
32+
33+1;
--- a/plugin/core.pl
+++ b/plugin/core.pl
@@ -1,301 +1,301 @@
1-################################################################################
2-#
3-# コアプラグインの実装
4-#
5-################################################################################
6-package Wiki::Plugin;
7-
8-BEGIN {
9- # パラグラフプラグインのエントリ
10- $main::P_PLUGIN->{recent} = \&Wiki::Plugin::recent;
11- $main::P_PLUGIN->{recentdays} = \&Wiki::Plugin::recentdays;
12- $main::P_PLUGIN->{category_list} = \&Wiki::Plugin::category_list;
13- $main::P_PLUGIN->{ref_image} = \&Wiki::Plugin::ref_image;
14- $main::P_PLUGIN->{ref_text} = \&Wiki::Plugin::ref_text;
15- $main::P_PLUGIN->{outline} = \&Wiki::Plugin::outline;
16- $main::P_PLUGIN->{search} = \&Wiki::Plugin::search;
17-
18- # インラインプラグインのエントリ
19- $main::I_PLUGIN->{category} = \&Wiki::Plugin::category;
20- $main::I_PLUGIN->{lastmodified} = \&Wiki::Plugin::lastmodified;
21- $main::I_PLUGIN->{ref} = \&Wiki::Plugin::ref;
22-}
23-
24-#==============================================================================
25-# ページの一覧を更新日時順に表示するプラグイン。
26-#==============================================================================
27-sub recent {
28- my $max = shift;
29- $max = 0 if($max eq "");
30- my $buf = "";
31-
32- my @pages = &Wiki::get_page_list();
33- my $count = 0;
34-
35- $buf .= "<ul>\n";
36- foreach my $page (@pages){
37- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
38- &Util::escapeHTML($page->{NAME})."</a></li>\n";
39- $count++;
40- last if($count==$max && $max!=0);
41- }
42- $buf .= "</ul>\n";
43-
44- return $buf;
45-}
46-
47-#==============================================================================
48-# 日付ごとに更新されたページを一覧表示するプラグイン。
49-#==============================================================================
50-sub recentdays {
51- my $max = shift;
52- $max = 5 if($max eq "");
53- my $buf = "";
54-
55- my @pages = &Wiki::get_page_list();
56- my $count = 0;
57-
58- my $last_year = 0;
59- my $last_mon = 0;
60- my $last_day = 0;
61-
62- foreach my $page (@pages){
63- my ($sec, $min, $hour, $day, $mon, $year) = localtime($page->{TIME});
64-
65- $year += 1900;
66- $mon += 1;
67-
68- if($last_year!=$year || $last_mon!=$mon || $last_day!=$day){
69-
70- $count++;
71- last if($count == $max+1);
72-
73- $last_year = $year;
74- $last_mon = $mon;
75- $last_day = $day;
76-
77- $buf .= "</ul>\n" if($buf ne "");
78- $buf .= sprintf("<b>%04d/%02d/%02d</b>\n",$year,$mon,$day);
79- $buf .= "<ul>\n";
80- }
81-
82- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
83- &Util::escapeHTML($page->{NAME})."</a></li>\n";
84- }
85-
86- if($buf ne ""){
87- $buf .= "</UL>\n";
88- }
89-
90- return $buf;
91-}
92-
93-#==============================================================================
94-# ページをカテゴライズするためのプラグイン。
95-#==============================================================================
96-sub category {
97- my $category = shift;
98- if($category eq ""){
99- return "カテゴリが指定されていません。";
100- } else {
101- return "[<a href=\"$main::CATEGORY_SCRIPT?c=".&Util::url_encode($category)."\">".
102- "カテゴリ:".&Util::escapeHTML($category)."</a>]";
103- }
104-}
105-
106-#=============================================================================
107-# ページの最終更新日時を表示するプラグイン。
108-#=============================================================================
109-sub lastmodified {
110- my $page = $main::in{"p"};
111- if(&Wiki::exists_page($page)){
112- return "最終更新時間:".&Util::format_date(&Wiki::get_last_modified($page));
113- } else {
114- return undef;
115- }
116-}
117-
118-#=============================================================================
119-# カテゴリごとのページ一覧を表示するプラグイン。
120-#=============================================================================
121-sub category_list {
122- my $category = shift;
123- my $buf = "";
124-
125- # 指定されたカテゴリを表示
126- if($category ne ""){
127- my @pages = &Wiki::get_page_list();
128- $buf .= "<h2>".&Util::escapeHTML($category)."</h2>\n";
129- $buf .= "<ul>\n";
130- #foreach my $page (sort(@pages)){
131- foreach my $page (sort {$a->{NAME} cmp $b->{NAME}} @pages){
132- my $source = &Wiki::get_page($page->{NAME});
133- foreach my $line (split(/\n/,$source)){
134- # コメントか整形済テキストの場合は飛ばす
135- next if($line =~ /^(\t| |\/\/)/);
136-
137- # カテゴリにマッチしたらリスティング
138- if($line =~ /{{category\s+$category}}/){
139- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
140- &Util::escapeHTML($page->{NAME})."</a></li>";
141- last;
142- }
143- }
144- }
145- $buf .= "</ul>\n";
146-
147- # 全てのカテゴリを表示
148- } else {
149- my $category = {};
150- my @pages = &Wiki::get_page_list();
151-
152- foreach my $page (@pages){
153- my $source = &Wiki::get_page($page->{NAME});
154- foreach my $line (split(/\n/,$source)){
155- # コメントか整形済テキストの場合は飛ばす
156- next if($line =~ /^(\t| |\/\/)/);
157-
158- # カテゴリにマッチしたらリスティング
159- while($line =~ /{{category\s+(.+?)}}/g){
160- $category->{$1}->{$page->{NAME}} = 1;
161- }
162- }
163- }
164-
165- foreach my $name (sort(keys(%$category))){
166- $buf .= "<h2>".&Util::escapeHTML($name)."</h2>\n";
167- $buf .= "<ul>\n";
168- foreach my $page (sort(keys(%{$category->{$name}}))){
169- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">".
170- &Util::escapeHTML($page)."</a></li>\n";
171- }
172- $buf .= "</ul>\n";
173- }
174- }
175- return $buf;
176-}
177-
178-#=============================================================================
179-# 添付ファイルへのリンクを表示するためのプラグイン。
180-#=============================================================================
181-sub ref {
182- my $page = $main::in{"p"};
183- my $file = shift;
184-
185- if($file eq ""){
186- return "ファイルが指定されていません。";
187- }
188-
189- my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
190- &Util::url_encode($page),&Util::url_encode($file));
191- unless(-e $filename){
192- return "ファイルが存在しません。";
193- }
194-
195- return sprintf("<a href=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>",
196- &Util::url_encode($page),&Util::url_encode($file),$file);
197-}
198-
199-#=============================================================================
200-# 添付ファイルを画像として表示するためのプラグイン。
201-#=============================================================================
202-sub ref_image {
203- my $page = $main::in{"p"};
204- my $file = shift;
205-
206- if($file eq ""){
207- return "ファイルが指定されていません。";
208- }
209-
210- my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
211- &Util::url_encode($page),&Util::url_encode($file));
212- unless(-e $filename){
213- return "<p>ファイルが存在しません。</p>\n";
214- }
215-
216- return sprintf("<div><img src=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\"></div>",
217- &Util::url_encode($page),&Util::url_encode($file));
218-}
219-
220-#=============================================================================
221-# 添付ファイルを画像として表示するためのプラグイン。
222-#=============================================================================
223-sub ref_text {
224- my $page = $main::in{"p"};
225- my $file = shift;
226-
227- if($file eq ""){
228- return "ファイルが指定されていません。";
229- }
230-
231- my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
232- &Util::url_encode($page),&Util::url_encode($file));
233- unless(-e $filename){
234- return "<p>ファイルが存在しません。</p>\n";
235- }
236-
237- my $text = "";
238- open(DATA,$filename);
239- while(<DATA>){
240- $text .= $_;
241- }
242- close(DATA);
243-
244- # 改行コードを変換
245- $text =~ s/\r\n/\n/g;
246- $text =~ s/\r/\n/g;
247- # 文字コードを変換
248- &jcode::convert(\$text,"euc");
249-
250- # preタグをつけて返却
251- return "<pre>".&Util::escapeHTML($text)."</pre>\n";
252-}
253-
254-#=============================================================================
255-# アウトラインを表示するためのプラグイン
256-# 出力されるHTMLはちょっと手抜きです…
257-#=============================================================================
258-sub outline {
259- my $page = $main::in{'p'};
260- my $source = &Wiki::get_page($page);
261- my $level = 0;
262- my $count = 0;
263- my $buf = "";
264- foreach my $line (split(/\n/,$source)){
265- if($line=~/^(!{1,3})(.+)$/){
266- my $find_level = 4 - length($1);
267-
268- while($level < $find_level){
269- $buf .= "<ul>\n";
270- $level++;
271- }
272-
273- while($level > $find_level){
274- $buf .= "</ul>\n";
275- $level--;
276- }
277- my $section = &Util::delete_tag(&Wiki::process_wiki($2));
278-
279- $buf .= "<li><a href=\"#p$count\">$section</a></li>\n";
280- $count++;
281- }
282- }
283- while($level > 0){
284- $buf .= "</ul>\n";
285- $level--;
286- }
287- return $buf;
288-}
289-
290-#=============================================================================
291-# 検索フォームを表示するためのプラグイン
292-#=============================================================================
293-sub search {
294- return "<form action=\"$main::MAIN_SCRIPT\" method=\"GET\">\n".
295- " キーワード <input type=\"text\" name=\"w\" size=\"20\" value=\"".&Util::escapeHTML($main::in{'w'})."\">\n".
296- " <input type=\"submit\" value=\" 検 索 \">\n".
297- " <input type=\"hidden\" name=\"a\" value=\"search\">\n".
298- "</form>\n";
299-}
300-
301-1;
1+################################################################################
2+#
3+# コアプラグインの実装
4+#
5+################################################################################
6+package Wiki::Plugin;
7+
8+BEGIN {
9+ # パラグラフプラグインのエントリ
10+ $main::P_PLUGIN->{recent} = \&Wiki::Plugin::recent;
11+ $main::P_PLUGIN->{recentdays} = \&Wiki::Plugin::recentdays;
12+ $main::P_PLUGIN->{category_list} = \&Wiki::Plugin::category_list;
13+ $main::P_PLUGIN->{ref_image} = \&Wiki::Plugin::ref_image;
14+ $main::P_PLUGIN->{ref_text} = \&Wiki::Plugin::ref_text;
15+ $main::P_PLUGIN->{outline} = \&Wiki::Plugin::outline;
16+ $main::P_PLUGIN->{search} = \&Wiki::Plugin::search;
17+
18+ # インラインプラグインのエントリ
19+ $main::I_PLUGIN->{category} = \&Wiki::Plugin::category;
20+ $main::I_PLUGIN->{lastmodified} = \&Wiki::Plugin::lastmodified;
21+ $main::I_PLUGIN->{ref} = \&Wiki::Plugin::ref;
22+}
23+
24+#==============================================================================
25+# ページの一覧を更新日時順に表示するプラグイン。
26+#==============================================================================
27+sub recent {
28+ my $max = shift;
29+ $max = 0 if($max eq "");
30+ my $buf = "";
31+
32+ my @pages = &Wiki::get_page_list();
33+ my $count = 0;
34+
35+ $buf .= "<ul>\n";
36+ foreach my $page (@pages){
37+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
38+ &Util::escapeHTML($page->{NAME})."</a></li>\n";
39+ $count++;
40+ last if($count==$max && $max!=0);
41+ }
42+ $buf .= "</ul>\n";
43+
44+ return $buf;
45+}
46+
47+#==============================================================================
48+# 日付ごとに更新されたページを一覧表示するプラグイン。
49+#==============================================================================
50+sub recentdays {
51+ my $max = shift;
52+ $max = 5 if($max eq "");
53+ my $buf = "";
54+
55+ my @pages = &Wiki::get_page_list();
56+ my $count = 0;
57+
58+ my $last_year = 0;
59+ my $last_mon = 0;
60+ my $last_day = 0;
61+
62+ foreach my $page (@pages){
63+ my ($sec, $min, $hour, $day, $mon, $year) = localtime($page->{TIME});
64+
65+ $year += 1900;
66+ $mon += 1;
67+
68+ if($last_year!=$year || $last_mon!=$mon || $last_day!=$day){
69+
70+ $count++;
71+ last if($count == $max+1);
72+
73+ $last_year = $year;
74+ $last_mon = $mon;
75+ $last_day = $day;
76+
77+ $buf .= "</ul>\n" if($buf ne "");
78+ $buf .= sprintf("<b>%04d/%02d/%02d</b>\n",$year,$mon,$day);
79+ $buf .= "<ul>\n";
80+ }
81+
82+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
83+ &Util::escapeHTML($page->{NAME})."</a></li>\n";
84+ }
85+
86+ if($buf ne ""){
87+ $buf .= "</UL>\n";
88+ }
89+
90+ return $buf;
91+}
92+
93+#==============================================================================
94+# ページをカテゴライズするためのプラグイン。
95+#==============================================================================
96+sub category {
97+ my $category = shift;
98+ if($category eq ""){
99+ return "カテゴリが指定されていません。";
100+ } else {
101+ return "[<a href=\"$main::CATEGORY_SCRIPT?c=".&Util::url_encode($category)."\">".
102+ "カテゴリ:".&Util::escapeHTML($category)."</a>]";
103+ }
104+}
105+
106+#=============================================================================
107+# ページの最終更新日時を表示するプラグイン。
108+#=============================================================================
109+sub lastmodified {
110+ my $page = $main::in{"p"};
111+ if(&Wiki::exists_page($page)){
112+ return "最終更新時間:".&Util::format_date(&Wiki::get_last_modified($page));
113+ } else {
114+ return undef;
115+ }
116+}
117+
118+#=============================================================================
119+# カテゴリごとのページ一覧を表示するプラグイン。
120+#=============================================================================
121+sub category_list {
122+ my $category = shift;
123+ my $buf = "";
124+
125+ # 指定されたカテゴリを表示
126+ if($category ne ""){
127+ my @pages = &Wiki::get_page_list();
128+ $buf .= "<h2>".&Util::escapeHTML($category)."</h2>\n";
129+ $buf .= "<ul>\n";
130+ #foreach my $page (sort(@pages)){
131+ foreach my $page (sort {$a->{NAME} cmp $b->{NAME}} @pages){
132+ my $source = &Wiki::get_page($page->{NAME});
133+ foreach my $line (split(/\n/,$source)){
134+ # コメントか整形済テキストの場合は飛ばす
135+ next if($line =~ /^(\t| |\/\/)/);
136+
137+ # カテゴリにマッチしたらリスティング
138+ if($line =~ /{{category\s+$category}}/){
139+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
140+ &Util::escapeHTML($page->{NAME})."</a></li>";
141+ last;
142+ }
143+ }
144+ }
145+ $buf .= "</ul>\n";
146+
147+ # 全てのカテゴリを表示
148+ } else {
149+ my $category = {};
150+ my @pages = &Wiki::get_page_list();
151+
152+ foreach my $page (@pages){
153+ my $source = &Wiki::get_page($page->{NAME});
154+ foreach my $line (split(/\n/,$source)){
155+ # コメントか整形済テキストの場合は飛ばす
156+ next if($line =~ /^(\t| |\/\/)/);
157+
158+ # カテゴリにマッチしたらリスティング
159+ while($line =~ /{{category\s+(.+?)}}/g){
160+ $category->{$1}->{$page->{NAME}} = 1;
161+ }
162+ }
163+ }
164+
165+ foreach my $name (sort(keys(%$category))){
166+ $buf .= "<h2>".&Util::escapeHTML($name)."</h2>\n";
167+ $buf .= "<ul>\n";
168+ foreach my $page (sort(keys(%{$category->{$name}}))){
169+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">".
170+ &Util::escapeHTML($page)."</a></li>\n";
171+ }
172+ $buf .= "</ul>\n";
173+ }
174+ }
175+ return $buf;
176+}
177+
178+#=============================================================================
179+# 添付ファイルへのリンクを表示するためのプラグイン。
180+#=============================================================================
181+sub ref {
182+ my $page = $main::in{"p"};
183+ my $file = shift;
184+
185+ if($file eq ""){
186+ return "ファイルが指定されていません。";
187+ }
188+
189+ my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
190+ &Util::url_encode($page),&Util::url_encode($file));
191+ unless(-e $filename){
192+ return "ファイルが存在しません。";
193+ }
194+
195+ return sprintf("<a href=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>",
196+ &Util::url_encode($page),&Util::url_encode($file),$file);
197+}
198+
199+#=============================================================================
200+# 添付ファイルを画像として表示するためのプラグイン。
201+#=============================================================================
202+sub ref_image {
203+ my $page = $main::in{"p"};
204+ my $file = shift;
205+
206+ if($file eq ""){
207+ return "ファイルが指定されていません。";
208+ }
209+
210+ my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
211+ &Util::url_encode($page),&Util::url_encode($file));
212+ unless(-e $filename){
213+ return "<p>ファイルが存在しません。</p>\n";
214+ }
215+
216+ return sprintf("<div><img src=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\"></div>",
217+ &Util::url_encode($page),&Util::url_encode($file));
218+}
219+
220+#=============================================================================
221+# 添付ファイルを画像として表示するためのプラグイン。
222+#=============================================================================
223+sub ref_text {
224+ my $page = $main::in{"p"};
225+ my $file = shift;
226+
227+ if($file eq ""){
228+ return "ファイルが指定されていません。";
229+ }
230+
231+ my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
232+ &Util::url_encode($page),&Util::url_encode($file));
233+ unless(-e $filename){
234+ return "<p>ファイルが存在しません。</p>\n";
235+ }
236+
237+ my $text = "";
238+ open(DATA,$filename);
239+ while(<DATA>){
240+ $text .= $_;
241+ }
242+ close(DATA);
243+
244+ # 改行コードを変換
245+ $text =~ s/\r\n/\n/g;
246+ $text =~ s/\r/\n/g;
247+ # 文字コードを変換
248+ &jcode::convert(\$text,"euc");
249+
250+ # preタグをつけて返却
251+ return "<pre>".&Util::escapeHTML($text)."</pre>\n";
252+}
253+
254+#=============================================================================
255+# アウトラインを表示するためのプラグイン
256+# 出力されるHTMLはちょっと手抜きです…
257+#=============================================================================
258+sub outline {
259+ my $page = $main::in{'p'};
260+ my $source = &Wiki::get_page($page);
261+ my $level = 0;
262+ my $count = 0;
263+ my $buf = "";
264+ foreach my $line (split(/\n/,$source)){
265+ if($line=~/^(!{1,3})(.+)$/){
266+ my $find_level = 4 - length($1);
267+
268+ while($level < $find_level){
269+ $buf .= "<ul>\n";
270+ $level++;
271+ }
272+
273+ while($level > $find_level){
274+ $buf .= "</ul>\n";
275+ $level--;
276+ }
277+ my $section = &Util::delete_tag(&Wiki::process_wiki($2));
278+
279+ $buf .= "<li><a href=\"#p$count\">$section</a></li>\n";
280+ $count++;
281+ }
282+ }
283+ while($level > 0){
284+ $buf .= "</ul>\n";
285+ $level--;
286+ }
287+ return $buf;
288+}
289+
290+#=============================================================================
291+# 検索フォームを表示するためのプラグイン
292+#=============================================================================
293+sub search {
294+ return "<form action=\"$main::MAIN_SCRIPT\" method=\"GET\">\n".
295+ " キーワード <input type=\"text\" name=\"w\" size=\"20\" value=\"".&Util::escapeHTML($main::in{'w'})."\">\n".
296+ " <input type=\"submit\" value=\" 検 索 \">\n".
297+ " <input type=\"hidden\" name=\"a\" value=\"search\">\n".
298+ "</form>\n";
299+}
300+
301+1;
--- a/release.sh
+++ b/release.sh
@@ -1,68 +1,68 @@
1-#!/bin/sh
2-##########################################################################
3-#
4-# FSWikiLiteリリース用シェルスクリプト
5-#
6-##########################################################################
7-#=========================================================================
8-# 引数のチェック
9-#=========================================================================
10-if [ $# -lt 1 ]
11-then
12- echo "./release.sh version"
13- exit 1
14-fi
15-
16-#=========================================================================
17-# バージョン情報
18-#=========================================================================
19-VERSION=$1
20-RELEASE="fswiki_lite_$VERSION"
21-
22-#=========================================================================
23-# テンポラリディレクトリがある場合は削除
24-#=========================================================================
25-if [ -e $RELEASE ]; then
26- echo "delete temp directory..."
27- rm -rf $RELEASE
28-fi
29-
30-#=========================================================================
31-# zipファイルがある場合は削除
32-#=========================================================================
33-if [ -e $RELEASE.zip ]; then
34- echo "delete zip file..."
35- rm -f $RELEASE.zip
36-fi
37-
38-#=========================================================================
39-# テンポラリディレクトリの作成
40-#=========================================================================
41-echo "create temp directory..."
42-mkdir $RELEASE
43-
44-#=========================================================================
45-# ファイルのコピー
46-#=========================================================================
47-echo "copy to temp directory..."
48-cp ./*.cgi $RELEASE
49-cp -r ./docs $RELEASE
50-cp -r ./lib $RELEASE
51-cp -r ./plugin $RELEASE
52-
53-#=========================================================================
54-# zipファイルの作成
55-#=========================================================================
56-echo "create zip file..."
57-find ./$RELEASE \! -path '*/CVS*' -exec zip $RELEASE.zip {} \;
58-
59-#=========================================================================
60-# テンポラリディレクトリを削除
61-#=========================================================================
62-echo "remove temp directory..."
63-rm -rf $RELEASE
64-
65-#=========================================================================
66-# 終了
67-#=========================================================================
68-echo "complete."
1+#!/bin/sh
2+##########################################################################
3+#
4+# FSWikiLiteリリース用シェルスクリプト
5+#
6+##########################################################################
7+#=========================================================================
8+# 引数のチェック
9+#=========================================================================
10+if [ $# -lt 1 ]
11+then
12+ echo "./release.sh version"
13+ exit 1
14+fi
15+
16+#=========================================================================
17+# バージョン情報
18+#=========================================================================
19+VERSION=$1
20+RELEASE="fswiki_lite_$VERSION"
21+
22+#=========================================================================
23+# テンポラリディレクトリがある場合は削除
24+#=========================================================================
25+if [ -e $RELEASE ]; then
26+ echo "delete temp directory..."
27+ rm -rf $RELEASE
28+fi
29+
30+#=========================================================================
31+# zipファイルがある場合は削除
32+#=========================================================================
33+if [ -e $RELEASE.zip ]; then
34+ echo "delete zip file..."
35+ rm -f $RELEASE.zip
36+fi
37+
38+#=========================================================================
39+# テンポラリディレクトリの作成
40+#=========================================================================
41+echo "create temp directory..."
42+mkdir $RELEASE
43+
44+#=========================================================================
45+# ファイルのコピー
46+#=========================================================================
47+echo "copy to temp directory..."
48+cp ./*.cgi $RELEASE
49+cp -r ./docs $RELEASE
50+cp -r ./lib $RELEASE
51+cp -r ./plugin $RELEASE
52+
53+#=========================================================================
54+# zipファイルの作成
55+#=========================================================================
56+echo "create zip file..."
57+find ./$RELEASE \! -path '*/CVS*' -exec zip $RELEASE.zip {} \;
58+
59+#=========================================================================
60+# テンポラリディレクトリを削除
61+#=========================================================================
62+echo "remove temp directory..."
63+rm -rf $RELEASE
64+
65+#=========================================================================
66+# 終了
67+#=========================================================================
68+echo "complete."
--- a/wiki.cgi
+++ b/wiki.cgi