-#!/usr/bin/perl\r
-################################################################################\r
-#\r
-# FSWiki Lite - ¥«¥Æ¥´¥ê¤Î°ìÍ÷\r
-#\r
-################################################################################\r
-require "./lib/common.pl";\r
-#===============================================================================\r
-# ½èÍý¤Î¿¶¤êʬ¤±\r
-#===============================================================================\r
-&ReadParse();\r
-if($in{'c'} ne ""){\r
- &show_category($in{'c'});\r
- \r
-} else {\r
- &show_all_category();\r
- \r
-}\r
-\r
-#===============================================================================\r
-# »ØÄꤵ¤ì¤¿¥«¥Æ¥´¥ê¤òɽ¼¨\r
-#===============================================================================\r
-sub show_category {\r
- my $category = shift;\r
- \r
- &print_header("¥«¥Æ¥´¥ê");\r
- print &Wiki::Plugin::category_list($category);\r
- &print_footer();\r
-}\r
-\r
-#===============================================================================\r
-# Á´¤Æ¤Î¥«¥Æ¥´¥ê¤òɽ¼¨\r
-#===============================================================================\r
-sub show_all_category {\r
- &print_header("¥«¥Æ¥´¥ê");\r
- print "<h2>".&Util::escapeHTML($category)."</h2>\n";\r
- print &Wiki::Plugin::category_list();\r
- &print_footer();\r
-}\r
+#!/usr/bin/perl
+################################################################################
+#
+# FSWiki Lite - ¥«¥Æ¥´¥ê¤Î°ìÍ÷
+#
+################################################################################
+require "./lib/common.pl";
+#===============================================================================
+# ½èÍý¤Î¿¶¤êʬ¤±
+#===============================================================================
+&ReadParse();
+if($in{'c'} ne ""){
+ &show_category($in{'c'});
+
+} else {
+ &show_all_category();
+
+}
+
+#===============================================================================
+# »ØÄꤵ¤ì¤¿¥«¥Æ¥´¥ê¤òɽ¼¨
+#===============================================================================
+sub show_category {
+ my $category = shift;
+
+ &print_header("¥«¥Æ¥´¥ê");
+ print &Wiki::Plugin::category_list($category);
+ &print_footer();
+}
+
+#===============================================================================
+# Á´¤Æ¤Î¥«¥Æ¥´¥ê¤òɽ¼¨
+#===============================================================================
+sub show_all_category {
+ &print_header("¥«¥Æ¥´¥ê");
+ print "<h2>".&Util::escapeHTML($category)."</h2>\n";
+ print &Wiki::Plugin::category_list();
+ &print_footer();
+}
-body {\r
- background-color: #FFFFFF;\r
- color : #000000;\r
- font-family : Verdana,Arial,Helvetica,sans-serif;\r
-}\r
-\r
-p.adminmenu {\r
- text-align : right;\r
- padding-bottom : 5px;\r
- margin-bottom : 5px;\r
- border-bottom : #000088 1px dotted;\r
- font-size : 80%;\r
- text-indent : 10px;\r
-}\r
-\r
-.footer {\r
- border-top : #000088 1px dotted;\r
- margin-top : 20px;\r
- padding-top : 5px;\r
- text-align : right;\r
- font-size : 80%;\r
- font-style : italic;\r
-}\r
-\r
-hr {\r
- color : #FFFFFF;\r
-}\r
-\r
-pre {\r
- border : #888888 1px solid;\r
- padding : 4px;\r
- margin-left : 40px;\r
-}\r
-\r
-p {\r
- padding-left : 20pt;\r
-}\r
-\r
-strong {\r
- font-weight : normal;\r
-}\r
-\r
-h1 {\r
- background-color : #FFFFFF;\r
- border-bottom : #AABBFF 1px solid;\r
- font-family : Verdana,Arial,Helvetica,sans-serif;\r
- padding-left : 4pt;\r
-}\r
-\r
-\r
-h2 {\r
- background-color : #AABBFF;\r
- font-family : Verdana,Arial,Helvetica,sans-serif;\r
- padding-left : 4pt;\r
-}\r
-\r
-h3 {\r
- border-left : #AABBFF 10px solid;\r
- border-top : #AABBFF 5px solid;\r
- border-right : #AABBFF 1px solid;\r
- border-bottom : #AABBFF 1px solid;\r
- font-family : Verdana,Arial,Helvetica,sans-serif;\r
- font-size : 100%;\r
- padding-left : 4pt;\r
-}\r
-\r
-h4 {\r
- border-left : #AABBFF 10px solid;\r
- padding-left : 4px;\r
- font-family : Verdana,Arial,Helvetica,sans-serif;\r
- padding-left : 4pt;\r
-}\r
-\r
-table {\r
- border : #888888 2px solid;\r
-}\r
-\r
-th {\r
- border : #888888 1px solid;\r
- background-color : #88AAFF;\r
-}\r
-\r
-td {\r
- border : #888888 1px solid;\r
-}\r
-\r
-A:link { \r
- color : #4444FF;\r
- text-decoration : none;\r
-}\r
-A:visited {\r
- color : #4444FF;\r
- text-decoration : none;\r
-}\r
-A:hover {\r
- color : #FF4444;\r
- text-decoration : underline;\r
-}\r
-\r
-div.main {\r
- margin-left: 20%;\r
-}\r
-\r
-div.sidebar {\r
- position : absolute;\r
- top : 0px;\r
- left : 0px;\r
- width : 20%;\r
- font-size : x-small;\r
- padding: 2px 2px 100% 2px;\r
- border-style: solid;\r
- border-color: #CCCCFF;\r
- border-width: 2px;\r
- color : #000000;\r
- background-color: #EEEEFF;\r
-}\r
-\r
-div.comment {\r
- margin-top : 10px;\r
- margin-bottom : 10px;\r
- background-color : DDDDFF;\r
- border : AAAAFF 2px solid;\r
- font-size : 80%;\r
-}\r
+body {
+ background-color: #FFFFFF;
+ color : #000000;
+ font-family : Verdana,Arial,Helvetica,sans-serif;
+}
+
+p.adminmenu {
+ text-align : right;
+ padding-bottom : 5px;
+ margin-bottom : 5px;
+ border-bottom : #000088 1px dotted;
+ font-size : 80%;
+ text-indent : 10px;
+}
+
+.footer {
+ border-top : #000088 1px dotted;
+ margin-top : 20px;
+ padding-top : 5px;
+ text-align : right;
+ font-size : 80%;
+ font-style : italic;
+}
+
+hr {
+ color : #FFFFFF;
+}
+
+pre {
+ border : #888888 1px solid;
+ padding : 4px;
+ margin-left : 40px;
+}
+
+p {
+ padding-left : 20pt;
+}
+
+strong {
+ font-weight : normal;
+}
+
+h1 {
+ background-color : #FFFFFF;
+ border-bottom : #AABBFF 1px solid;
+ font-family : Verdana,Arial,Helvetica,sans-serif;
+ padding-left : 4pt;
+}
+
+
+h2 {
+ background-color : #AABBFF;
+ font-family : Verdana,Arial,Helvetica,sans-serif;
+ padding-left : 4pt;
+}
+
+h3 {
+ border-left : #AABBFF 10px solid;
+ border-top : #AABBFF 5px solid;
+ border-right : #AABBFF 1px solid;
+ border-bottom : #AABBFF 1px solid;
+ font-family : Verdana,Arial,Helvetica,sans-serif;
+ font-size : 100%;
+ padding-left : 4pt;
+}
+
+h4 {
+ border-left : #AABBFF 10px solid;
+ padding-left : 4px;
+ font-family : Verdana,Arial,Helvetica,sans-serif;
+ padding-left : 4pt;
+}
+
+table {
+ border : #888888 2px solid;
+}
+
+th {
+ border : #888888 1px solid;
+ background-color : #88AAFF;
+}
+
+td {
+ border : #888888 1px solid;
+}
+
+A:link {
+ color : #4444FF;
+ text-decoration : none;
+}
+A:visited {
+ color : #4444FF;
+ text-decoration : none;
+}
+A:hover {
+ color : #FF4444;
+ text-decoration : underline;
+}
+
+div.main {
+ margin-left: 20%;
+}
+
+div.sidebar {
+ position : absolute;
+ top : 0px;
+ left : 0px;
+ width : 20%;
+ font-size : x-small;
+ padding: 2px 2px 100% 2px;
+ border-style: solid;
+ border-color: #CCCCFF;
+ border-width: 2px;
+ color : #000000;
+ background-color: #EEEEFF;
+}
+
+div.comment {
+ margin-top : 10px;
+ margin-bottom : 10px;
+ background-color : DDDDFF;
+ border : AAAAFF 2px solid;
+ font-size : 80%;
+}
- GNU GENERAL PUBLIC LICENSE\r
- Version 2, June 1991\r
-\r
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.\r
- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA\r
- Everyone is permitted to copy and distribute verbatim copies\r
- of this license document, but changing it is not allowed.\r
-\r
- Preamble\r
-\r
- The licenses for most software are designed to take away your\r
-freedom to share and change it. By contrast, the GNU General Public\r
-License is intended to guarantee your freedom to share and change free\r
-software--to make sure the software is free for all its users. This\r
-General Public License applies to most of the Free Software\r
-Foundation's software and to any other program whose authors commit to\r
-using it. (Some other Free Software Foundation software is covered by\r
-the GNU Library General Public License instead.) You can apply it to\r
-your programs, too.\r
-\r
- When we speak of free software, we are referring to freedom, not\r
-price. Our General Public Licenses are designed to make sure that you\r
-have the freedom to distribute copies of free software (and charge for\r
-this service if you wish), that you receive source code or can get it\r
-if you want it, that you can change the software or use pieces of it\r
-in new free programs; and that you know you can do these things.\r
-\r
- To protect your rights, we need to make restrictions that forbid\r
-anyone to deny you these rights or to ask you to surrender the rights.\r
-These restrictions translate to certain responsibilities for you if you\r
-distribute copies of the software, or if you modify it.\r
-\r
- For example, if you distribute copies of such a program, whether\r
-gratis or for a fee, you must give the recipients all the rights that\r
-you have. You must make sure that they, too, receive or can get the\r
-source code. And you must show them these terms so they know their\r
-rights.\r
-\r
- We protect your rights with two steps: (1) copyright the software, and\r
-(2) offer you this license which gives you legal permission to copy,\r
-distribute and/or modify the software.\r
-\r
- Also, for each author's protection and ours, we want to make certain\r
-that everyone understands that there is no warranty for this free\r
-software. If the software is modified by someone else and passed on, we\r
-want its recipients to know that what they have is not the original, so\r
-that any problems introduced by others will not reflect on the original\r
-authors' reputations.\r
-\r
- Finally, any free program is threatened constantly by software\r
-patents. We wish to avoid the danger that redistributors of a free\r
-program will individually obtain patent licenses, in effect making the\r
-program proprietary. To prevent this, we have made it clear that any\r
-patent must be licensed for everyone's free use or not licensed at all.\r
-\r
- The precise terms and conditions for copying, distribution and\r
-modification follow.\r
-\f\r
- GNU GENERAL PUBLIC LICENSE\r
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION\r
-\r
- 0. This License applies to any program or other work which contains\r
-a notice placed by the copyright holder saying it may be distributed\r
-under the terms of this General Public License. The "Program", below,\r
-refers to any such program or work, and a "work based on the Program"\r
-means either the Program or any derivative work under copyright law:\r
-that is to say, a work containing the Program or a portion of it,\r
-either verbatim or with modifications and/or translated into another\r
-language. (Hereinafter, translation is included without limitation in\r
-the term "modification".) Each licensee is addressed as "you".\r
-\r
-Activities other than copying, distribution and modification are not\r
-covered by this License; they are outside its scope. The act of\r
-running the Program is not restricted, and the output from the Program\r
-is covered only if its contents constitute a work based on the\r
-Program (independent of having been made by running the Program).\r
-Whether that is true depends on what the Program does.\r
-\r
- 1. You may copy and distribute verbatim copies of the Program's\r
-source code as you receive it, in any medium, provided that you\r
-conspicuously and appropriately publish on each copy an appropriate\r
-copyright notice and disclaimer of warranty; keep intact all the\r
-notices that refer to this License and to the absence of any warranty;\r
-and give any other recipients of the Program a copy of this License\r
-along with the Program.\r
-\r
-You may charge a fee for the physical act of transferring a copy, and\r
-you may at your option offer warranty protection in exchange for a fee.\r
-\r
- 2. You may modify your copy or copies of the Program or any portion\r
-of it, thus forming a work based on the Program, and copy and\r
-distribute such modifications or work under the terms of Section 1\r
-above, provided that you also meet all of these conditions:\r
-\r
- a) You must cause the modified files to carry prominent notices\r
- stating that you changed the files and the date of any change.\r
-\r
- b) You must cause any work that you distribute or publish, that in\r
- whole or in part contains or is derived from the Program or any\r
- part thereof, to be licensed as a whole at no charge to all third\r
- parties under the terms of this License.\r
-\r
- c) If the modified program normally reads commands interactively\r
- when run, you must cause it, when started running for such\r
- interactive use in the most ordinary way, to print or display an\r
- announcement including an appropriate copyright notice and a\r
- notice that there is no warranty (or else, saying that you provide\r
- a warranty) and that users may redistribute the program under\r
- these conditions, and telling the user how to view a copy of this\r
- License. (Exception: if the Program itself is interactive but\r
- does not normally print such an announcement, your work based on\r
- the Program is not required to print an announcement.)\r
-\f\r
-These requirements apply to the modified work as a whole. If\r
-identifiable sections of that work are not derived from the Program,\r
-and can be reasonably considered independent and separate works in\r
-themselves, then this License, and its terms, do not apply to those\r
-sections when you distribute them as separate works. But when you\r
-distribute the same sections as part of a whole which is a work based\r
-on the Program, the distribution of the whole must be on the terms of\r
-this License, whose permissions for other licensees extend to the\r
-entire whole, and thus to each and every part regardless of who wrote it.\r
-\r
-Thus, it is not the intent of this section to claim rights or contest\r
-your rights to work written entirely by you; rather, the intent is to\r
-exercise the right to control the distribution of derivative or\r
-collective works based on the Program.\r
-\r
-In addition, mere aggregation of another work not based on the Program\r
-with the Program (or with a work based on the Program) on a volume of\r
-a storage or distribution medium does not bring the other work under\r
-the scope of this License.\r
-\r
- 3. You may copy and distribute the Program (or a work based on it,\r
-under Section 2) in object code or executable form under the terms of\r
-Sections 1 and 2 above provided that you also do one of the following:\r
-\r
- a) Accompany it with the complete corresponding machine-readable\r
- source code, which must be distributed under the terms of Sections\r
- 1 and 2 above on a medium customarily used for software interchange; or,\r
-\r
- b) Accompany it with a written offer, valid for at least three\r
- years, to give any third party, for a charge no more than your\r
- cost of physically performing source distribution, a complete\r
- machine-readable copy of the corresponding source code, to be\r
- distributed under the terms of Sections 1 and 2 above on a medium\r
- customarily used for software interchange; or,\r
-\r
- c) Accompany it with the information you received as to the offer\r
- to distribute corresponding source code. (This alternative is\r
- allowed only for noncommercial distribution and only if you\r
- received the program in object code or executable form with such\r
- an offer, in accord with Subsection b above.)\r
-\r
-The source code for a work means the preferred form of the work for\r
-making modifications to it. For an executable work, complete source\r
-code means all the source code for all modules it contains, plus any\r
-associated interface definition files, plus the scripts used to\r
-control compilation and installation of the executable. However, as a\r
-special exception, the source code distributed need not include\r
-anything that is normally distributed (in either source or binary\r
-form) with the major components (compiler, kernel, and so on) of the\r
-operating system on which the executable runs, unless that component\r
-itself accompanies the executable.\r
-\r
-If distribution of executable or object code is made by offering\r
-access to copy from a designated place, then offering equivalent\r
-access to copy the source code from the same place counts as\r
-distribution of the source code, even though third parties are not\r
-compelled to copy the source along with the object code.\r
-\f\r
- 4. You may not copy, modify, sublicense, or distribute the Program\r
-except as expressly provided under this License. Any attempt\r
-otherwise to copy, modify, sublicense or distribute the Program is\r
-void, and will automatically terminate your rights under this License.\r
-However, parties who have received copies, or rights, from you under\r
-this License will not have their licenses terminated so long as such\r
-parties remain in full compliance.\r
-\r
- 5. You are not required to accept this License, since you have not\r
-signed it. However, nothing else grants you permission to modify or\r
-distribute the Program or its derivative works. These actions are\r
-prohibited by law if you do not accept this License. Therefore, by\r
-modifying or distributing the Program (or any work based on the\r
-Program), you indicate your acceptance of this License to do so, and\r
-all its terms and conditions for copying, distributing or modifying\r
-the Program or works based on it.\r
-\r
- 6. Each time you redistribute the Program (or any work based on the\r
-Program), the recipient automatically receives a license from the\r
-original licensor to copy, distribute or modify the Program subject to\r
-these terms and conditions. You may not impose any further\r
-restrictions on the recipients' exercise of the rights granted herein.\r
-You are not responsible for enforcing compliance by third parties to\r
-this License.\r
-\r
- 7. If, as a consequence of a court judgment or allegation of patent\r
-infringement or for any other reason (not limited to patent issues),\r
-conditions are imposed on you (whether by court order, agreement or\r
-otherwise) that contradict the conditions of this License, they do not\r
-excuse you from the conditions of this License. If you cannot\r
-distribute so as to satisfy simultaneously your obligations under this\r
-License and any other pertinent obligations, then as a consequence you\r
-may not distribute the Program at all. For example, if a patent\r
-license would not permit royalty-free redistribution of the Program by\r
-all those who receive copies directly or indirectly through you, then\r
-the only way you could satisfy both it and this License would be to\r
-refrain entirely from distribution of the Program.\r
-\r
-If any portion of this section is held invalid or unenforceable under\r
-any particular circumstance, the balance of the section is intended to\r
-apply and the section as a whole is intended to apply in other\r
-circumstances.\r
-\r
-It is not the purpose of this section to induce you to infringe any\r
-patents or other property right claims or to contest validity of any\r
-such claims; this section has the sole purpose of protecting the\r
-integrity of the free software distribution system, which is\r
-implemented by public license practices. Many people have made\r
-generous contributions to the wide range of software distributed\r
-through that system in reliance on consistent application of that\r
-system; it is up to the author/donor to decide if he or she is willing\r
-to distribute software through any other system and a licensee cannot\r
-impose that choice.\r
-\r
-This section is intended to make thoroughly clear what is believed to\r
-be a consequence of the rest of this License.\r
-\f\r
- 8. If the distribution and/or use of the Program is restricted in\r
-certain countries either by patents or by copyrighted interfaces, the\r
-original copyright holder who places the Program under this License\r
-may add an explicit geographical distribution limitation excluding\r
-those countries, so that distribution is permitted only in or among\r
-countries not thus excluded. In such case, this License incorporates\r
-the limitation as if written in the body of this License.\r
-\r
- 9. The Free Software Foundation may publish revised and/or new versions\r
-of the General Public License from time to time. Such new versions will\r
-be similar in spirit to the present version, but may differ in detail to\r
-address new problems or concerns.\r
-\r
-Each version is given a distinguishing version number. If the Program\r
-specifies a version number of this License which applies to it and "any\r
-later version", you have the option of following the terms and conditions\r
-either of that version or of any later version published by the Free\r
-Software Foundation. If the Program does not specify a version number of\r
-this License, you may choose any version ever published by the Free Software\r
-Foundation.\r
-\r
- 10. If you wish to incorporate parts of the Program into other free\r
-programs whose distribution conditions are different, write to the author\r
-to ask for permission. For software which is copyrighted by the Free\r
-Software Foundation, write to the Free Software Foundation; we sometimes\r
-make exceptions for this. Our decision will be guided by the two goals\r
-of preserving the free status of all derivatives of our free software and\r
-of promoting the sharing and reuse of software generally.\r
-\r
- NO WARRANTY\r
-\r
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY\r
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN\r
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES\r
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED\r
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF\r
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS\r
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE\r
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,\r
-REPAIR OR CORRECTION.\r
-\r
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING\r
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR\r
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,\r
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING\r
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED\r
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY\r
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER\r
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE\r
-POSSIBILITY OF SUCH DAMAGES.\r
-\r
- END OF TERMS AND CONDITIONS\r
-\f\r
- How to Apply These Terms to Your New Programs\r
-\r
- If you develop a new program, and you want it to be of the greatest\r
-possible use to the public, the best way to achieve this is to make it\r
-free software which everyone can redistribute and change under these terms.\r
-\r
- To do so, attach the following notices to the program. It is safest\r
-to attach them to the start of each source file to most effectively\r
-convey the exclusion of warranty; and each file should have at least\r
-the "copyright" line and a pointer to where the full notice is found.\r
-\r
- <one line to give the program's name and a brief idea of what it does.>\r
- Copyright (C) <year> <name of author>\r
-\r
- This program is free software; you can redistribute it and/or modify\r
- it under the terms of the GNU General Public License as published by\r
- the Free Software Foundation; either version 2 of the License, or\r
- (at your option) any later version.\r
-\r
- This program is distributed in the hope that it will be useful,\r
- but WITHOUT ANY WARRANTY; without even the implied warranty of\r
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
- GNU General Public License for more details.\r
-\r
- You should have received a copy of the GNU General Public License\r
- along with this program; if not, write to the Free Software\r
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA\r
-\r
-\r
-Also add information on how to contact you by electronic and paper mail.\r
-\r
-If the program is interactive, make it output a short notice like this\r
-when it starts in an interactive mode:\r
-\r
- Gnomovision version 69, Copyright (C) year name of author\r
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\r
- This is free software, and you are welcome to redistribute it\r
- under certain conditions; type `show c' for details.\r
-\r
-The hypothetical commands `show w' and `show c' should show the appropriate\r
-parts of the General Public License. Of course, the commands you use may\r
-be called something other than `show w' and `show c'; they could even be\r
-mouse-clicks or menu items--whatever suits your program.\r
-\r
-You should also get your employer (if you work as a programmer) or your\r
-school, if any, to sign a "copyright disclaimer" for the program, if\r
-necessary. Here is a sample; alter the names:\r
-\r
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program\r
- `Gnomovision' (which makes passes at compilers) written by James Hacker.\r
-\r
- <signature of Ty Coon>, 1 April 1989\r
- Ty Coon, President of Vice\r
-\r
-This General Public License does not permit incorporating your program into\r
-proprietary programs. If your program is a subroutine library, you may\r
-consider it more useful to permit linking proprietary applications with the\r
-library. If this is what you want to do, use the GNU Library General\r
-Public License instead of this License.\r
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
-#!/bin/sh\r
-# HTML¥Õ¥¡¥¤¥ë¤ËÊÑ´¹\r
-perl ../../tools/wiki2html.pl "http://fswiki.poi.jp/wiki.cgi/docs?action=SOURCE&page=FSWikiLite%2Freadme" -css=default.css -title=README > readme.html\r
-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\r
+#!/bin/sh
+# HTML¥Õ¥¡¥¤¥ë¤ËÊÑ´¹
+perl ../../tools/wiki2html.pl "http://fswiki.poi.jp/wiki.cgi/docs?action=SOURCE&page=FSWikiLite%2Freadme" -css=default.css -title=README > readme.html
+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
-<html>\r
-<head>\r
- <title>¥×¥é¥°¥¤¥ó³«È¯</title>\r
- <link rel="stylesheet" type="text/css" href="default.css">\r
-</head>\r
-<body>\r
-<h2>¥µ¥Ý¡¼¥È¤¹¤ë¥×¥é¥°¥¤¥ó</h2>\r
-<p>FSWikiLite¤ÏFSWiki¤È¤Ï°ã¤¤¡¢Wiki¥Ú¡¼¥¸¤Ëµ½Ò¤·¤Æ»ÈÍѤ¹¤ë¥¿¥¤¥×¤Î¥×¥é¥°¥¤¥ó¡Ê¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤È¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¡Ë¤·¤«¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤Þ¤»¤ó¡£¤¿¤À¤·¡¢FSWiki¤Ç¥¢¥¯¥·¥ç¥ó¥×¥é¥°¥¤¥ó¤È¸Æ¤Ð¤ì¤Æ¤¤¤ë¤â¤Î¤Ë¤Ä¤¤¤Æ¤ÏÊ̤ÎCGI¥¹¥¯¥ê¥×¥È¤òÍÑ°Õ¤¹¤ë¤³¤È¤ÇÂбþ¤¹¤ë¤³¤È¤¬¤Ç¤¤Þ¤¹¡ÊLite¤Îcategory.cgi¤Ê¤É¤¬¤³¤ì¤Ë¤¢¤¿¤ê¤Þ¤¹¡Ë¡£</p><p>¥×¥é¥°¥¤¥ó¤Ï¡Á.pl¤È¤¤¤¦Ì¾Á°¤òÉÕ¤±¤Æplugin¥Ç¥£¥ì¥¯¥È¥ê¤ËÇÛÃÖ¤·¤Þ¤¹¡£¤½¤·¤Ælib/setup.pl¤Çrequire¤·¤Þ¤¹¡£¥Ç¥Õ¥©¥ë¥È¤Îsetup.pl¤Ç¤Ïcore.pl¤Î¤ßÆɤ߹þ¤à¤è¤¦ÀßÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£</p><pre>require "./plugin/core.pl";\r
-</pre><h2>¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó</h2>\r
-<p>¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤ÏWiki::Plugin¥Ñ¥Ã¥±¡¼¥¸¤ÇÄêµÁ¤µ¤ì¤¿Perl´Ø¿ô¤Î¥ê¥Õ¥¡¥ì¥ó¥¹¤Ç¤¹¡£´Ø¿ô¤Î°ú¿ô¤Ë¤ÏWiki¥½¡¼¥¹¤Çµ½Ò¤·¤¿°ú¿ô¤¬¤½¤Î¤Þ¤ÞÅϤµ¤ì¤Þ¤¹¡£´Ø¿ô¤ÏÌá¤êÃͤȤ·¤ÆHTML¤òÊÖ¤¹¤è¤¦¤Ë¼ÂÁõ¤·¤Þ¤¹¡£¤Þ¤¿¡¢¥¹¥¯¥ê¥×¥È¤ÎBEGINÀá¤Ç´Ø¿ô¤Î¥ê¥Õ¥¡¥ì¥ó¥¹¤ò¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤È¤·¤ÆÅÐÏ¿¤·¤Þ¤¹¡£</p><pre>package Wiki::Plugin;\r
-BEGIN {\r
- $main::I_PLUGIN->{hello} = \&hello;\r
-}\r
-sub hello {\r
- my $name = shift;\r
- if($name eq ''){\r
- return "̾Á°¤òÆþÎϤ·¤Æ¤¯¤À¤µ¤¤¡£";\r
- } else {\r
- return "¤³¤ó¤Ë¤Á¤Ï".&Util::escapeHTML($name)."¤µ¤ó";\r
- }\r
-}\r
-1;\r
-</pre><p>¥Ú¡¼¥¸ÊÔ½¸»þ¤Ë°Ê²¼¤Î½ñ¼°¤Ç»ÈÍѤ¹¤ë¤³¤È¤¬¤Ç¤¤Þ¤¹¡£</p><pre>{{hello ¤¿¤í¤¦}}\r
-</pre><h2>¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó</h2>\r
-<p>¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¤â¼ÂÁõÊýË¡¤Ï¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤ÈƱÍͤǤ¹¡£¥Ö¥í¥Ã¥¯Í×ÁǤò´Þ¤àHTML¤òÊֵѤ¹¤ë¾ì¹ç¤Ë¤Ï¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¤È¤·¤Æ¼ÂÁõ¤·¤Þ¤¹¡£BEGINÀá¤Ç¤ÎÅÐÏ¿ÊýË¡¤Î¤ß¤¬°Û¤Ê¤ê¤Þ¤¹¡£</p><pre>BEGIN {\r
- $main::P_PLUGIN->{hello} = \&hello;\r
-}\r
-</pre><h2>¥ê¥¯¥¨¥¹¥È¥Ñ¥é¥á¡¼¥¿¤Ø¤Î¥¢¥¯¥»¥¹</h2>\r
-<p>¥×¥é¥°¥¤¥óÆâÉô¤«¤é¥ê¥¯¥¨¥¹¥È¥Ñ¥é¥á¡¼¥¿¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤Ë¤Ï%main::in¤È¤¤¤¦ÊÑ¿ô¤òÍøÍѤ·¤Þ¤¹¡£¤³¤ì¤Ïcgi-lib.pl¤Ç¥Ñ¡¼¥¹¤µ¤ì¤¿¥ê¥¯¥¨¥¹¥È¥Ñ¥é¥á¡¼¥¿¤¬³ÊǼ¤µ¤ì¤¿Ï¢ÁÛÇÛÎó¤Ç¤¹¡£</p><pre># ¥Ú¡¼¥¸Ì¾¤ò¼èÆÀ\r
-my $p = $main::in{'p'};\r
-</pre><h2>¥×¥é¥°¥¤¥ó¤«¤éÍøÍѲÄǽ¤Ê¥æ¡¼¥Æ¥£¥ê¥Æ¥£</h2>\r
-<p>¥×¥é¥°¥¤¥óÆâÉô¤Ç¤ÏUtil¥Ñ¥Ã¥±¡¼¥¸¤ËÄêµÁ¤µ¤ì¤¿¥æ¡¼¥Æ¥£¥ê¥Æ¥£´Ø¿ô¤ò»ÈÍѤ¹¤ë¤³¤È¤¬¤Ç¤¤Þ¤¹¡£Util¥Ñ¥Ã¥±¡¼¥¸¤Ë¤Ï°Ê²¼¤Î¤è¤¦¤Ê´Ø¿ô¤¬ÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£</p><table>\r
-<tr><th>´Ø¿ô̾</th><th>ÀâÌÀ</th></tr>\r
-<tr><td>url_encode</td><td>URL¥¨¥ó¥³¡¼¥É¤·¤Þ¤¹¡£</td></tr>\r
-<tr><td>url_decode</td><td>URL¥¨¥ó¥³¡¼¥É¤µ¤ì¤¿Ê¸»úÎó¤ò¥Ç¥³¡¼¥É¤·¤Þ¤¹¡£</td></tr>\r
-<tr><td>escapeHTML</td><td>HTML¤ò¥¨¥¹¥±¡¼¥×¤·¤Þ¤¹¡£</td></tr>\r
-<tr><td>trim</td><td>ʸ»úÎó¤ÎÁ°¸å¤Î¶õÇò¤ò¼è¤ê½ü¤¤Þ¤¹¡£</td></tr>\r
-<tr><td>check_numeric</td><td>ʸ»úÎ󤬿ôÃͤ«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£</td></tr>\r
-<tr><td>handyphone</td><td>·ÈÂÓÅÅÏ䫤ɤ¦¤«¤òȽÃǤ·¤Þ¤¹¡£</td></tr>\r
-</table>\r
-<h2>¥¢¥¯¥·¥ç¥ó¥¹¥¯¥ê¥×¥È</h2>\r
-<p>FSWiki¤Ç¥¢¥¯¥·¥ç¥ó¥×¥é¥°¥¤¥ó¤È¤·¤Æ¼ÂÁõ¤µ¤ì¤Æ¤¤¤ë¥×¥é¥°¥¤¥ó¤ÏÊÌÅÓCGI¥¹¥¯¥ê¥×¥È¤òºîÀ®¤¹¤ë¤³¤È¤ÇÂбþ¤¹¤ë¤³¤È¤¬½ÐÍè¤Þ¤¹¡£action¥Ñ¥é¥á¡¼¥¿¤ÎÂå¤ï¤ê¤Ë¤½¤ÎCGI¥¹¥¯¥ê¥×¥È¤ò¸Æ¤Ó½Ð¤¹¤è¤¦¤Ë¤·¤Þ¤¹¡£CGI¥¹¥¯¥ê¥×¥È¤«¤é¤Ïcommon.pl¤ËÄêµÁ¤µ¤ì¤¿´Ø¿ô·²¤ò»ÈÍѤ·¤Æ¥Ú¡¼¥¸¤Î¼èÆÀ¤äÊݸ¤Ê¤É¤ò¹Ô¤¦¤³¤È¤¬½ÐÍè¤Þ¤¹¡£</p><p>FSWikiLite¤Ç¤Ï¥Ç¥Õ¥©¥ë¥È¤Çedit.cgi¡Ê¥Ú¡¼¥¸¤ÎÊÔ½¸¡Ë¡¢download.cgi¡ÊźÉÕ¥Õ¥¡¥¤¥ë¤Î¥À¥¦¥ó¥í¡¼¥É¡Ë¡¢category.cgi¡Ê¥«¥Æ¥´¥êɽ¼¨¡Ë¤È¤¤¤¦£³¤Ä¤Î¥¢¥¯¥·¥ç¥ó¥¹¥¯¥ê¥×¥È¤¬ÍÑ°Õ¤µ¤ì¤Æ¤¤¤Þ¤¹¤Î¤Ç¡¢¤³¤ì¤é¤ò»²¹Í¤Ë¤·¤Æ¤¯¤À¤µ¤¤¡£</p></body>\r
-</html>\r
+<html>
+<head>
+ <title>¥×¥é¥°¥¤¥ó³«È¯</title>
+ <link rel="stylesheet" type="text/css" href="default.css">
+</head>
+<body>
+<h2>¥µ¥Ý¡¼¥È¤¹¤ë¥×¥é¥°¥¤¥ó</h2>
+<p>FSWikiLite¤ÏFSWiki¤È¤Ï°ã¤¤¡¢Wiki¥Ú¡¼¥¸¤Ëµ½Ò¤·¤Æ»ÈÍѤ¹¤ë¥¿¥¤¥×¤Î¥×¥é¥°¥¤¥ó¡Ê¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤È¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¡Ë¤·¤«¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤Þ¤»¤ó¡£¤¿¤À¤·¡¢FSWiki¤Ç¥¢¥¯¥·¥ç¥ó¥×¥é¥°¥¤¥ó¤È¸Æ¤Ð¤ì¤Æ¤¤¤ë¤â¤Î¤Ë¤Ä¤¤¤Æ¤ÏÊ̤ÎCGI¥¹¥¯¥ê¥×¥È¤òÍÑ°Õ¤¹¤ë¤³¤È¤ÇÂбþ¤¹¤ë¤³¤È¤¬¤Ç¤¤Þ¤¹¡ÊLite¤Îcategory.cgi¤Ê¤É¤¬¤³¤ì¤Ë¤¢¤¿¤ê¤Þ¤¹¡Ë¡£</p><p>¥×¥é¥°¥¤¥ó¤Ï¡Á.pl¤È¤¤¤¦Ì¾Á°¤òÉÕ¤±¤Æplugin¥Ç¥£¥ì¥¯¥È¥ê¤ËÇÛÃÖ¤·¤Þ¤¹¡£¤½¤·¤Ælib/setup.pl¤Çrequire¤·¤Þ¤¹¡£¥Ç¥Õ¥©¥ë¥È¤Îsetup.pl¤Ç¤Ïcore.pl¤Î¤ßÆɤ߹þ¤à¤è¤¦ÀßÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£</p><pre>require "./plugin/core.pl";
+</pre><h2>¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó</h2>
+<p>¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤ÏWiki::Plugin¥Ñ¥Ã¥±¡¼¥¸¤ÇÄêµÁ¤µ¤ì¤¿Perl´Ø¿ô¤Î¥ê¥Õ¥¡¥ì¥ó¥¹¤Ç¤¹¡£´Ø¿ô¤Î°ú¿ô¤Ë¤ÏWiki¥½¡¼¥¹¤Çµ½Ò¤·¤¿°ú¿ô¤¬¤½¤Î¤Þ¤ÞÅϤµ¤ì¤Þ¤¹¡£´Ø¿ô¤ÏÌá¤êÃͤȤ·¤ÆHTML¤òÊÖ¤¹¤è¤¦¤Ë¼ÂÁõ¤·¤Þ¤¹¡£¤Þ¤¿¡¢¥¹¥¯¥ê¥×¥È¤ÎBEGINÀá¤Ç´Ø¿ô¤Î¥ê¥Õ¥¡¥ì¥ó¥¹¤ò¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤È¤·¤ÆÅÐÏ¿¤·¤Þ¤¹¡£</p><pre>package Wiki::Plugin;
+BEGIN {
+ $main::I_PLUGIN->{hello} = \&hello;
+}
+sub hello {
+ my $name = shift;
+ if($name eq ''){
+ return "̾Á°¤òÆþÎϤ·¤Æ¤¯¤À¤µ¤¤¡£";
+ } else {
+ return "¤³¤ó¤Ë¤Á¤Ï".&Util::escapeHTML($name)."¤µ¤ó";
+ }
+}
+1;
+</pre><p>¥Ú¡¼¥¸ÊÔ½¸»þ¤Ë°Ê²¼¤Î½ñ¼°¤Ç»ÈÍѤ¹¤ë¤³¤È¤¬¤Ç¤¤Þ¤¹¡£</p><pre>{{hello ¤¿¤í¤¦}}
+</pre><h2>¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó</h2>
+<p>¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¤â¼ÂÁõÊýË¡¤Ï¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤ÈƱÍͤǤ¹¡£¥Ö¥í¥Ã¥¯Í×ÁǤò´Þ¤àHTML¤òÊֵѤ¹¤ë¾ì¹ç¤Ë¤Ï¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¤È¤·¤Æ¼ÂÁõ¤·¤Þ¤¹¡£BEGINÀá¤Ç¤ÎÅÐÏ¿ÊýË¡¤Î¤ß¤¬°Û¤Ê¤ê¤Þ¤¹¡£</p><pre>BEGIN {
+ $main::P_PLUGIN->{hello} = \&hello;
+}
+</pre><h2>¥ê¥¯¥¨¥¹¥È¥Ñ¥é¥á¡¼¥¿¤Ø¤Î¥¢¥¯¥»¥¹</h2>
+<p>¥×¥é¥°¥¤¥óÆâÉô¤«¤é¥ê¥¯¥¨¥¹¥È¥Ñ¥é¥á¡¼¥¿¤Ë¥¢¥¯¥»¥¹¤¹¤ë¤Ë¤Ï%main::in¤È¤¤¤¦ÊÑ¿ô¤òÍøÍѤ·¤Þ¤¹¡£¤³¤ì¤Ïcgi-lib.pl¤Ç¥Ñ¡¼¥¹¤µ¤ì¤¿¥ê¥¯¥¨¥¹¥È¥Ñ¥é¥á¡¼¥¿¤¬³ÊǼ¤µ¤ì¤¿Ï¢ÁÛÇÛÎó¤Ç¤¹¡£</p><pre># ¥Ú¡¼¥¸Ì¾¤ò¼èÆÀ
+my $p = $main::in{'p'};
+</pre><h2>¥×¥é¥°¥¤¥ó¤«¤éÍøÍѲÄǽ¤Ê¥æ¡¼¥Æ¥£¥ê¥Æ¥£</h2>
+<p>¥×¥é¥°¥¤¥óÆâÉô¤Ç¤ÏUtil¥Ñ¥Ã¥±¡¼¥¸¤ËÄêµÁ¤µ¤ì¤¿¥æ¡¼¥Æ¥£¥ê¥Æ¥£´Ø¿ô¤ò»ÈÍѤ¹¤ë¤³¤È¤¬¤Ç¤¤Þ¤¹¡£Util¥Ñ¥Ã¥±¡¼¥¸¤Ë¤Ï°Ê²¼¤Î¤è¤¦¤Ê´Ø¿ô¤¬ÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£</p><table>
+<tr><th>´Ø¿ô̾</th><th>ÀâÌÀ</th></tr>
+<tr><td>url_encode</td><td>URL¥¨¥ó¥³¡¼¥É¤·¤Þ¤¹¡£</td></tr>
+<tr><td>url_decode</td><td>URL¥¨¥ó¥³¡¼¥É¤µ¤ì¤¿Ê¸»úÎó¤ò¥Ç¥³¡¼¥É¤·¤Þ¤¹¡£</td></tr>
+<tr><td>escapeHTML</td><td>HTML¤ò¥¨¥¹¥±¡¼¥×¤·¤Þ¤¹¡£</td></tr>
+<tr><td>trim</td><td>ʸ»úÎó¤ÎÁ°¸å¤Î¶õÇò¤ò¼è¤ê½ü¤¤Þ¤¹¡£</td></tr>
+<tr><td>check_numeric</td><td>ʸ»úÎ󤬿ôÃͤ«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£</td></tr>
+<tr><td>handyphone</td><td>·ÈÂÓÅÅÏ䫤ɤ¦¤«¤òȽÃǤ·¤Þ¤¹¡£</td></tr>
+</table>
+<h2>¥¢¥¯¥·¥ç¥ó¥¹¥¯¥ê¥×¥È</h2>
+<p>FSWiki¤Ç¥¢¥¯¥·¥ç¥ó¥×¥é¥°¥¤¥ó¤È¤·¤Æ¼ÂÁõ¤µ¤ì¤Æ¤¤¤ë¥×¥é¥°¥¤¥ó¤ÏÊÌÅÓCGI¥¹¥¯¥ê¥×¥È¤òºîÀ®¤¹¤ë¤³¤È¤ÇÂбþ¤¹¤ë¤³¤È¤¬½ÐÍè¤Þ¤¹¡£action¥Ñ¥é¥á¡¼¥¿¤ÎÂå¤ï¤ê¤Ë¤½¤ÎCGI¥¹¥¯¥ê¥×¥È¤ò¸Æ¤Ó½Ð¤¹¤è¤¦¤Ë¤·¤Þ¤¹¡£CGI¥¹¥¯¥ê¥×¥È¤«¤é¤Ïcommon.pl¤ËÄêµÁ¤µ¤ì¤¿´Ø¿ô·²¤ò»ÈÍѤ·¤Æ¥Ú¡¼¥¸¤Î¼èÆÀ¤äÊݸ¤Ê¤É¤ò¹Ô¤¦¤³¤È¤¬½ÐÍè¤Þ¤¹¡£</p><p>FSWikiLite¤Ç¤Ï¥Ç¥Õ¥©¥ë¥È¤Çedit.cgi¡Ê¥Ú¡¼¥¸¤ÎÊÔ½¸¡Ë¡¢download.cgi¡ÊźÉÕ¥Õ¥¡¥¤¥ë¤Î¥À¥¦¥ó¥í¡¼¥É¡Ë¡¢category.cgi¡Ê¥«¥Æ¥´¥êɽ¼¨¡Ë¤È¤¤¤¦£³¤Ä¤Î¥¢¥¯¥·¥ç¥ó¥¹¥¯¥ê¥×¥È¤¬ÍÑ°Õ¤µ¤ì¤Æ¤¤¤Þ¤¹¤Î¤Ç¡¢¤³¤ì¤é¤ò»²¹Í¤Ë¤·¤Æ¤¯¤À¤µ¤¤¡£</p></body>
+</html>
-<html>\r
-<head>\r
- <title>README</title>\r
- <link rel="stylesheet" type="text/css" href="default.css">\r
-</head>\r
-<body>\r
-<h2>FSWikiLite¤È¤Ï¡©</h2>\r
-<p>FSWikiLite¤Î¸µ¤Ë¤Ê¤Ã¤Æ¤¤¤ëFreeStyleWiki¤ÏPerl¤Ë¤è¤ëmodulable¤ÊWiki¥¯¥í¡¼¥ó¤Ç¤¹¡£¥×¥é¥°¥¤¥ó¤Ë¤è¤Ã¤ÆÍÍ¡¹¤Êµ¡Ç½¤òÄɲ乤뤳¤È¤¬¤Ç¤¤Þ¤¹¡£¤¿¤À¤·¡¢¹âµ¡Ç½¤Êʬ¡¢Ä̾ï¤ÎCGI¥¹¥¯¥ê¥×¥È¤ÈÈæ³Ó¤¹¤ë¤ÈÆ°ºî¤¬½Å¤¤¤È¤¤¤¦·çÅÀ¤¬¤¢¤ê¤Þ¤·¤¿¡£</p><p>FSWikiLite¤ÏFSWiki¤Û¤É¹âµ¡Ç½¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¤¬¡¢µ¡Ç½¤ò¸ÂÄꤹ¤ë¤³¤È¤Ç·Ú²÷¤ËÆ°ºî¤·¤Þ¤¹¡£¥×¥é¥°¥¤¥ó¤Ï°ìÉô¤·¤«»ÈÍѤǤ¤Þ¤»¤ó¤¬¡¢Ê¸Ë¡¤ÏFSWiki¤È´°Á´¸ß´¹¤Ç¤¹¡£¤Þ¤¿¡¢FSWiki¤ÈÈæ¤Ù¤ë¤È¹½Â¤¤¬¥·¥ó¥×¥ë¤Êʬ¡¢ÀßÃÖ¤âÍưפǤ¹¡£</p><p>¤½¤Î¾¤ËFSWikiLite¤Ï°Ê²¼¤Î¤è¤¦¤ÊÆÃħ¤¬¤¢¤ê¤Þ¤¹¡£</p><ul>\r
-<li>tDiary¤Î¥Æ¡¼¥Þ¤ò»ÈÍѲÄǽ¡£\r
-</li>\r
-<li>¥µ¥¤¥É¥Ð¡¼¤ä¥Ø¥Ã¥À¡¢¥Õ¥Ã¥¿¤òɽ¼¨²Äǽ¡£\r
-</li>\r
-<li>FSWiki¤È¤Ï°Û¤Ê¤ë¥·¥ó¥×¥ë¤Ê¥×¥é¥°¥¤¥óµ¡¹½¤òÈ÷¤¨¤Æ¤¤¤ë¡£\r
-</li>\r
-<li>.htaccess¤ò»ÈÍѤ¹¤ë¤³¤È¤ÇÊÔ½¸¤ò´ÉÍý¿Í¤Î¤ß¤Ë¸ÂÄꤹ¤ë¤³¤È¤¬²Äǽ¡£\r
-</li>\r
-<li>¥Ú¡¼¥¸¤Î¥«¥Æ¥´¥é¥¤¥º¤¬²Äǽ¡£\r
-</li>\r
-<li>¥Õ¥¡¥¤¥ë¤ÎźÉÕ¤¬²Äǽ¡£\r
-</li>\r
-<li>PDFÀ¸À®¡¢¥¡¼¥ï¡¼¥É¥ê¥ó¥¯¡¢InterWiki¤Ê¤É¤Ï»ÈÍÑÉԲġ£\r
-</li>\r
-</ul><h2>¥¤¥ó¥¹¥È¡¼¥ë</h2>\r
-<p>lib/setup.pl¤òÊÔ½¸¤·¡¢³Æ¼«¤ÎÀßÄê¤ò¹Ô¤¤¤Þ¤¹¡£</p><ul>\r
-<li>$DATA_DIR - ¥Ç¡¼¥¿¥Õ¥¡¥¤¥ë¤Î³ÊǼ¾ì½ê¡£\r
-</li>\r
-<li>$BACKUP_DIR - ¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤Î³ÊǼ¾ì½ê¡£\r
-</li>\r
-<li>$ATTACH_DIR - źÉÕ¥Õ¥¡¥¤¥ë¤Î³ÊǼ¾ì½ê¡£\r
-</li>\r
-<li>$THEME_URL - ¥Æ¡¼¥Þ¡ÊCSS¡Ë¤Î¾ì½ê¡£\r
-</li>\r
-<li>$SEND_MAIL - sendmail¤Î¥Ñ¥¹¡£¹¹¿·ÄÌÃΤò¼õ¤±¼è¤ë¾ì¹ç¤ÏÀßÄꤷ¤Æ¤¯¤À¤µ¤¤¡£\r
-</li>\r
-<li>$ADMIN_MAIL- ´ÉÍý¼Ô¤Î¥á¡¼¥ë¥¢¥É¥ì¥¹¡£¹¹¿·ÄÌÃΤò¼õ¤±¼è¤ë¾ì¹ç¤ÏÀßÄꤷ¤Æ¤¯¤À¤µ¤¤¡£\r
-</li>\r
-<li>$WIKI_NAME - WikiName¤ò»ÈÍѤ¹¤ë¾ì¹ç¤Ï1¡¢»ÈÍѤ·¤Ê¤¤¾ì¹ç¤Ï0¤ò»ØÄꤷ¤Æ¤¯¤À¤µ¤¤¡£\r
-</li>\r
-<li>$MAIN_SCRIPT - ¥á¥¤¥ó¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£\r
-</li>\r
-<li>$EDIT_SCRIPT - ÊÔ½¸ÍÑ¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£\r
-</li>\r
-<li>$DOWNLOAD_SCRIPT - źÉÕ¥Õ¥¡¥¤¥ë¤Î¥À¥¦¥ó¥í¡¼¥ÉÍÑ¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£\r
-</li>\r
-<li>$CATEGORY_SCRIPT - ¥«¥Æ¥´¥êɽ¼¨ÍÑ¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£\r
-</li>\r
-<li>$SITE_TITLE - ¥µ¥¤¥È̾¡£¼«Í³¤ËÊѹ¹¤·¤Æ¤¯¤À¤µ¤¤¡£\r
-</li>\r
-<li>$VERSION - FSWikiLite¤Î¥Ð¡¼¥¸¥ç¥ó¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£\r
-</li>\r
-<li>$SITE_URL - FSWiki¸ø¼°¥µ¥¤¥È¤ÎURL¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£\r
-</li>\r
-</ul><p>FTP¤Ê¤É¤Ç°Ê²¼¤Î¤è¤¦¤Ë¥Õ¥¡¥¤¥ë¤òÇÛÃÖ¤·¤Þ¤¹¡Ê¥Ç¥Õ¥©¥ë¥È¤ÎÀßÄê¤Î¾ì¹ç¡Ë¡£</p><pre>-+- wiki.cgi\r
- |\r
- +- edit.cgi\r
- |\r
- +- category.cgi\r
- |\r
- +- download.cgi\r
- |\r
- +- /lib ¡Ê¥é¥¤¥Ö¥é¥ê¤òÇÛÃÖ¤·¤Þ¤¹¡Ë\r
- | |\r
- | +- jcode.pl\r
- | |\r
- | +- cgi-lib.pl\r
- | |\r
- | +- setup.pl\r
- | |\r
- | +- common.pl\r
- | |\r
- | +- mimew.pl\r
- |\r
- +- /plugin ¡Ê¥×¥é¥°¥¤¥ó¤òÇÛÃÖ¤·¤Þ¤¹¡Ë\r
- | |\r
- | +- core.pl\r
- |\r
- +- /data ¡Ê¥Ú¡¼¥¸¥Ç¡¼¥¿¤¬½ÐÎϤµ¤ì¤Þ¤¹¡Ë\r
- |\r
- +- /backup ¡Ê¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤¬½ÐÎϤµ¤ì¤Þ¤¹¡Ë\r
- |\r
- +- /attach¡ÊźÉÕ¥Õ¥¡¥¤¥ë¤¬½ÐÎϤµ¤ì¤Þ¤¹¡Ë\r
- |\r
- +-/theme ¡Ê¥Æ¡¼¥Þ¤òÇÛÃÖ¤·¤Þ¤¹¡Ë\r
- |\r
- +- /default\r
- |\r
- +- default.css\r
-</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>\r
-<p>.htaccess¤ò»È¤Ã¤Æedit.cgi¤Ë¥¢¥¯¥»¥¹À©¸Â¤ò¤«¤±¤Þ¤¹¡£¾ÜºÙ¤Ë¤Ä¤¤¤Æ¤Ï¤½¤Î¤¦¤Á¡£</p><h2>»ÈÍѲÄǽ¤Ê¥×¥é¥°¥¤¥ó</h2>\r
-<h3>recent</h3>\r
-<p>¹¹¿·Æü»þ½ç¤Ë¥Ú¡¼¥¸Ì¾¤Î°ìÍ÷¤ò½ÐÎϤ·¤Þ¤¹¡£°ú¿ô¤Çɽ¼¨·ï¿ô¤ò»ØÄê¤Ç¤¤Þ¤¹¡£É½¼¨·ï¿ô¤ò¾Êά¤¹¤ë¤ÈÁ´·ï½ÐÎϤ·¤Þ¤¹¡£</p><pre>{{recent 10}}\r
-</pre><h3>recentdays</h3>\r
-<p>ÆüÉÕ¤´¤È¤Ë¹¹¿·¤µ¤ì¤¿¥Ú¡¼¥¸¤ò°ìÍ÷ɽ¼¨¤·¤Þ¤¹¡£°ú¿ô¤Çɽ¼¨Æü¿ô¤ò»ØÄê¤Ç¤¤Þ¤¹¡£É½¼¨Æü¿ô¤ò¾Êά¤¹¤ë¤ÈºÇ¿·¤Î£µÆüʬ¤ò½ÐÎϤ·¤Þ¤¹¡£</p><pre>{{recentdays 10}}\r
-</pre><h3>lastmodified</h3>\r
-<p>¥Ú¡¼¥¸¤ÎºÇ½ª¹¹¿·Æü»þ¤òɽ¼¨¤·¤Þ¤¹¡£</p><pre>{{lastmodified}}\r
-</pre><h3>category</h3>\r
-<p>¥Ú¡¼¥¸¤ò¥«¥Æ¥´¥é¥¤¥º¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¤Ç¤¹¡£°ú¿ô¤Ë¥«¥Æ¥´¥ê̾¤ò»ØÄꤷ¤Þ¤¹¡£</p><pre>{{category ¥«¥Æ¥´¥ê̾}}\r
-</pre><h3>category_list</h3>\r
-<p>¥«¥Æ¥´¥ê¤´¤È¤Î¥Ú¡¼¥¸°ìÍ÷¤òɽ¼¨¤·¤Þ¤¹¡£</p><pre>{{category_list}}\r
-</pre><p>°ú¿ô¤È¤·¤Æɽ¼¨¤¹¤ë¥«¥Æ¥´¥ê¤ò»ØÄꤹ¤ë¤³¤È¤â¤Ç¤¤Þ¤¹¡£</p><pre>{{category_list ¥«¥Æ¥´¥ê̾}}\r
-</pre><h3>ref</h3>\r
-<p>źÉÕ¥Õ¥¡¥¤¥ë¤Ø¤Î¥ê¥ó¥¯¤ò½ÐÎϤ¹¤ë¥×¥é¥°¥¤¥ó¤Ç¤¹¡£</p><pre>{{ref ¥Õ¥¡¥¤¥ë̾}}\r
-</pre><h3>ref_image</h3>\r
-<p>źÉÕ¥Õ¥¡¥¤¥ë¤ò²èÁü¤È¤·¤Æɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¤Ç¤¹¡£</p><pre>{{ref_image ¥Õ¥¡¥¤¥ë̾}}\r
-</pre><h3>ref_text</h3>\r
-<p>źÉÕ¥Õ¥¡¥¤¥ë¤òÀ°·ÁºÑ¥Æ¥¥¹¥È¤È¤·¤Æɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¤Ç¤¹¡£</p><pre>{{ref_text ¥Õ¥¡¥¤¥ë̾}}\r
-</pre><h3>outline</h3>\r
-<p>¥Ú¡¼¥¸¤Î¥¢¥¦¥È¥é¥¤¥ó¤òɽ¼¨¤·¤Þ¤¹¡£¸«½Ð¤·¤¬¥Ä¥ê¡¼·Á¼°¤Çɽ¼¨¤µ¤ì¡¢¥¯¥ê¥Ã¥¯¤¹¤ë¤È¤½¤Î¸«½Ð¤·¤Ë¥¸¥ã¥ó¥×¤·¤Þ¤¹¡£<a href="wiki.cgi?page=Header" class="wikipage">Header</a>¤Ê¤É¤ËÆþ¤ì¤Æ¤ª¤¯¤ÈÊØÍø¤Ç¤¹¡£</p><pre>{{outline}}\r
-</pre><h3>search</h3>\r
-<p>¸¡º÷¥Õ¥©¡¼¥à¤òɽ¼¨¤·¤Þ¤¹¡£¥µ¥¤¥É¥Ð¡¼¤Ê¤É¤ËÆþ¤ì¤Æ¤ª¤¯¤ÈÊØÍø¤Ç¤¹¡£</p><pre>{{search}}\r
-</pre><h2>¥é¥¤¥»¥ó¥¹</h2>\r
-<p>FSWikiLite¤ÏGNUL GPL¥é¥¤¥»¥ó¥¹¤Ë´ð¤Å¤¤¤Æ²þÊÑ¡¢ºÆÇÛÉÛ¤¬²Äǽ¤Ç¤¹¡£</p><h2>ºîÀ®¼Ô</h2>\r
-<p>Naoki Takezoe <<a href="mailto:takezoe@aa.bb-east.ne.jp">mailto:takezoe@aa.bb-east.ne.jp</a>></p></body>\r
-</html>\r
+<html>
+<head>
+ <title>README</title>
+ <link rel="stylesheet" type="text/css" href="default.css">
+</head>
+<body>
+<h2>FSWikiLite¤È¤Ï¡©</h2>
+<p>FSWikiLite¤Î¸µ¤Ë¤Ê¤Ã¤Æ¤¤¤ëFreeStyleWiki¤ÏPerl¤Ë¤è¤ëmodulable¤ÊWiki¥¯¥í¡¼¥ó¤Ç¤¹¡£¥×¥é¥°¥¤¥ó¤Ë¤è¤Ã¤ÆÍÍ¡¹¤Êµ¡Ç½¤òÄɲ乤뤳¤È¤¬¤Ç¤¤Þ¤¹¡£¤¿¤À¤·¡¢¹âµ¡Ç½¤Êʬ¡¢Ä̾ï¤ÎCGI¥¹¥¯¥ê¥×¥È¤ÈÈæ³Ó¤¹¤ë¤ÈÆ°ºî¤¬½Å¤¤¤È¤¤¤¦·çÅÀ¤¬¤¢¤ê¤Þ¤·¤¿¡£</p><p>FSWikiLite¤ÏFSWiki¤Û¤É¹âµ¡Ç½¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¤¬¡¢µ¡Ç½¤ò¸ÂÄꤹ¤ë¤³¤È¤Ç·Ú²÷¤ËÆ°ºî¤·¤Þ¤¹¡£¥×¥é¥°¥¤¥ó¤Ï°ìÉô¤·¤«»ÈÍѤǤ¤Þ¤»¤ó¤¬¡¢Ê¸Ë¡¤ÏFSWiki¤È´°Á´¸ß´¹¤Ç¤¹¡£¤Þ¤¿¡¢FSWiki¤ÈÈæ¤Ù¤ë¤È¹½Â¤¤¬¥·¥ó¥×¥ë¤Êʬ¡¢ÀßÃÖ¤âÍưפǤ¹¡£</p><p>¤½¤Î¾¤ËFSWikiLite¤Ï°Ê²¼¤Î¤è¤¦¤ÊÆÃħ¤¬¤¢¤ê¤Þ¤¹¡£</p><ul>
+<li>tDiary¤Î¥Æ¡¼¥Þ¤ò»ÈÍѲÄǽ¡£
+</li>
+<li>¥µ¥¤¥É¥Ð¡¼¤ä¥Ø¥Ã¥À¡¢¥Õ¥Ã¥¿¤òɽ¼¨²Äǽ¡£
+</li>
+<li>FSWiki¤È¤Ï°Û¤Ê¤ë¥·¥ó¥×¥ë¤Ê¥×¥é¥°¥¤¥óµ¡¹½¤òÈ÷¤¨¤Æ¤¤¤ë¡£
+</li>
+<li>.htaccess¤ò»ÈÍѤ¹¤ë¤³¤È¤ÇÊÔ½¸¤ò´ÉÍý¿Í¤Î¤ß¤Ë¸ÂÄꤹ¤ë¤³¤È¤¬²Äǽ¡£
+</li>
+<li>¥Ú¡¼¥¸¤Î¥«¥Æ¥´¥é¥¤¥º¤¬²Äǽ¡£
+</li>
+<li>¥Õ¥¡¥¤¥ë¤ÎźÉÕ¤¬²Äǽ¡£
+</li>
+<li>PDFÀ¸À®¡¢¥¡¼¥ï¡¼¥É¥ê¥ó¥¯¡¢InterWiki¤Ê¤É¤Ï»ÈÍÑÉԲġ£
+</li>
+</ul><h2>¥¤¥ó¥¹¥È¡¼¥ë</h2>
+<p>lib/setup.pl¤òÊÔ½¸¤·¡¢³Æ¼«¤ÎÀßÄê¤ò¹Ô¤¤¤Þ¤¹¡£</p><ul>
+<li>$DATA_DIR - ¥Ç¡¼¥¿¥Õ¥¡¥¤¥ë¤Î³ÊǼ¾ì½ê¡£
+</li>
+<li>$BACKUP_DIR - ¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤Î³ÊǼ¾ì½ê¡£
+</li>
+<li>$ATTACH_DIR - źÉÕ¥Õ¥¡¥¤¥ë¤Î³ÊǼ¾ì½ê¡£
+</li>
+<li>$THEME_URL - ¥Æ¡¼¥Þ¡ÊCSS¡Ë¤Î¾ì½ê¡£
+</li>
+<li>$SEND_MAIL - sendmail¤Î¥Ñ¥¹¡£¹¹¿·ÄÌÃΤò¼õ¤±¼è¤ë¾ì¹ç¤ÏÀßÄꤷ¤Æ¤¯¤À¤µ¤¤¡£
+</li>
+<li>$ADMIN_MAIL- ´ÉÍý¼Ô¤Î¥á¡¼¥ë¥¢¥É¥ì¥¹¡£¹¹¿·ÄÌÃΤò¼õ¤±¼è¤ë¾ì¹ç¤ÏÀßÄꤷ¤Æ¤¯¤À¤µ¤¤¡£
+</li>
+<li>$WIKI_NAME - WikiName¤ò»ÈÍѤ¹¤ë¾ì¹ç¤Ï1¡¢»ÈÍѤ·¤Ê¤¤¾ì¹ç¤Ï0¤ò»ØÄꤷ¤Æ¤¯¤À¤µ¤¤¡£
+</li>
+<li>$MAIN_SCRIPT - ¥á¥¤¥ó¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£
+</li>
+<li>$EDIT_SCRIPT - ÊÔ½¸ÍÑ¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£
+</li>
+<li>$DOWNLOAD_SCRIPT - źÉÕ¥Õ¥¡¥¤¥ë¤Î¥À¥¦¥ó¥í¡¼¥ÉÍÑ¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£
+</li>
+<li>$CATEGORY_SCRIPT - ¥«¥Æ¥´¥êɽ¼¨ÍÑ¥¹¥¯¥ê¥×¥È¤Î¥Õ¥¡¥¤¥ë̾¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£
+</li>
+<li>$SITE_TITLE - ¥µ¥¤¥È̾¡£¼«Í³¤ËÊѹ¹¤·¤Æ¤¯¤À¤µ¤¤¡£
+</li>
+<li>$VERSION - FSWikiLite¤Î¥Ð¡¼¥¸¥ç¥ó¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£
+</li>
+<li>$SITE_URL - FSWiki¸ø¼°¥µ¥¤¥È¤ÎURL¡£Êѹ¹¤·¤Ê¤¯¤Æ¤â¤¤¤¤¤Ç¤¹¡£
+</li>
+</ul><p>FTP¤Ê¤É¤Ç°Ê²¼¤Î¤è¤¦¤Ë¥Õ¥¡¥¤¥ë¤òÇÛÃÖ¤·¤Þ¤¹¡Ê¥Ç¥Õ¥©¥ë¥È¤ÎÀßÄê¤Î¾ì¹ç¡Ë¡£</p><pre>-+- wiki.cgi
+ |
+ +- edit.cgi
+ |
+ +- category.cgi
+ |
+ +- download.cgi
+ |
+ +- /lib ¡Ê¥é¥¤¥Ö¥é¥ê¤òÇÛÃÖ¤·¤Þ¤¹¡Ë
+ | |
+ | +- jcode.pl
+ | |
+ | +- cgi-lib.pl
+ | |
+ | +- setup.pl
+ | |
+ | +- common.pl
+ | |
+ | +- mimew.pl
+ |
+ +- /plugin ¡Ê¥×¥é¥°¥¤¥ó¤òÇÛÃÖ¤·¤Þ¤¹¡Ë
+ | |
+ | +- core.pl
+ |
+ +- /data ¡Ê¥Ú¡¼¥¸¥Ç¡¼¥¿¤¬½ÐÎϤµ¤ì¤Þ¤¹¡Ë
+ |
+ +- /backup ¡Ê¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤¬½ÐÎϤµ¤ì¤Þ¤¹¡Ë
+ |
+ +- /attach¡ÊźÉÕ¥Õ¥¡¥¤¥ë¤¬½ÐÎϤµ¤ì¤Þ¤¹¡Ë
+ |
+ +-/theme ¡Ê¥Æ¡¼¥Þ¤òÇÛÃÖ¤·¤Þ¤¹¡Ë
+ |
+ +- /default
+ |
+ +- default.css
+</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>
+<p>.htaccess¤ò»È¤Ã¤Æedit.cgi¤Ë¥¢¥¯¥»¥¹À©¸Â¤ò¤«¤±¤Þ¤¹¡£¾ÜºÙ¤Ë¤Ä¤¤¤Æ¤Ï¤½¤Î¤¦¤Á¡£</p><h2>»ÈÍѲÄǽ¤Ê¥×¥é¥°¥¤¥ó</h2>
+<h3>recent</h3>
+<p>¹¹¿·Æü»þ½ç¤Ë¥Ú¡¼¥¸Ì¾¤Î°ìÍ÷¤ò½ÐÎϤ·¤Þ¤¹¡£°ú¿ô¤Çɽ¼¨·ï¿ô¤ò»ØÄê¤Ç¤¤Þ¤¹¡£É½¼¨·ï¿ô¤ò¾Êά¤¹¤ë¤ÈÁ´·ï½ÐÎϤ·¤Þ¤¹¡£</p><pre>{{recent 10}}
+</pre><h3>recentdays</h3>
+<p>ÆüÉÕ¤´¤È¤Ë¹¹¿·¤µ¤ì¤¿¥Ú¡¼¥¸¤ò°ìÍ÷ɽ¼¨¤·¤Þ¤¹¡£°ú¿ô¤Çɽ¼¨Æü¿ô¤ò»ØÄê¤Ç¤¤Þ¤¹¡£É½¼¨Æü¿ô¤ò¾Êά¤¹¤ë¤ÈºÇ¿·¤Î£µÆüʬ¤ò½ÐÎϤ·¤Þ¤¹¡£</p><pre>{{recentdays 10}}
+</pre><h3>lastmodified</h3>
+<p>¥Ú¡¼¥¸¤ÎºÇ½ª¹¹¿·Æü»þ¤òɽ¼¨¤·¤Þ¤¹¡£</p><pre>{{lastmodified}}
+</pre><h3>category</h3>
+<p>¥Ú¡¼¥¸¤ò¥«¥Æ¥´¥é¥¤¥º¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¤Ç¤¹¡£°ú¿ô¤Ë¥«¥Æ¥´¥ê̾¤ò»ØÄꤷ¤Þ¤¹¡£</p><pre>{{category ¥«¥Æ¥´¥ê̾}}
+</pre><h3>category_list</h3>
+<p>¥«¥Æ¥´¥ê¤´¤È¤Î¥Ú¡¼¥¸°ìÍ÷¤òɽ¼¨¤·¤Þ¤¹¡£</p><pre>{{category_list}}
+</pre><p>°ú¿ô¤È¤·¤Æɽ¼¨¤¹¤ë¥«¥Æ¥´¥ê¤ò»ØÄꤹ¤ë¤³¤È¤â¤Ç¤¤Þ¤¹¡£</p><pre>{{category_list ¥«¥Æ¥´¥ê̾}}
+</pre><h3>ref</h3>
+<p>źÉÕ¥Õ¥¡¥¤¥ë¤Ø¤Î¥ê¥ó¥¯¤ò½ÐÎϤ¹¤ë¥×¥é¥°¥¤¥ó¤Ç¤¹¡£</p><pre>{{ref ¥Õ¥¡¥¤¥ë̾}}
+</pre><h3>ref_image</h3>
+<p>źÉÕ¥Õ¥¡¥¤¥ë¤ò²èÁü¤È¤·¤Æɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¤Ç¤¹¡£</p><pre>{{ref_image ¥Õ¥¡¥¤¥ë̾}}
+</pre><h3>ref_text</h3>
+<p>źÉÕ¥Õ¥¡¥¤¥ë¤òÀ°·ÁºÑ¥Æ¥¥¹¥È¤È¤·¤Æɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¤Ç¤¹¡£</p><pre>{{ref_text ¥Õ¥¡¥¤¥ë̾}}
+</pre><h3>outline</h3>
+<p>¥Ú¡¼¥¸¤Î¥¢¥¦¥È¥é¥¤¥ó¤òɽ¼¨¤·¤Þ¤¹¡£¸«½Ð¤·¤¬¥Ä¥ê¡¼·Á¼°¤Çɽ¼¨¤µ¤ì¡¢¥¯¥ê¥Ã¥¯¤¹¤ë¤È¤½¤Î¸«½Ð¤·¤Ë¥¸¥ã¥ó¥×¤·¤Þ¤¹¡£<a href="wiki.cgi?page=Header" class="wikipage">Header</a>¤Ê¤É¤ËÆþ¤ì¤Æ¤ª¤¯¤ÈÊØÍø¤Ç¤¹¡£</p><pre>{{outline}}
+</pre><h3>search</h3>
+<p>¸¡º÷¥Õ¥©¡¼¥à¤òɽ¼¨¤·¤Þ¤¹¡£¥µ¥¤¥É¥Ð¡¼¤Ê¤É¤ËÆþ¤ì¤Æ¤ª¤¯¤ÈÊØÍø¤Ç¤¹¡£</p><pre>{{search}}
+</pre><h2>¥é¥¤¥»¥ó¥¹</h2>
+<p>FSWikiLite¤ÏGNUL GPL¥é¥¤¥»¥ó¥¹¤Ë´ð¤Å¤¤¤Æ²þÊÑ¡¢ºÆÇÛÉÛ¤¬²Äǽ¤Ç¤¹¡£</p><h2>ºîÀ®¼Ô</h2>
+<p>Naoki Takezoe <<a href="mailto:takezoe@aa.bb-east.ne.jp">mailto:takezoe@aa.bb-east.ne.jp</a>></p></body>
+</html>
-#!/usr/bin/perl\r
-################################################################################\r
-#\r
-# FSWiki Lite - źÉÕ¥Õ¥¡¥¤¥ë¤ò¥À¥¦¥ó¥í¡¼¥É¤¹¤ë¤¿¤á¤ÎCGI¥¹¥¯¥ê¥×¥È\r
-#\r
-################################################################################\r
-require "./lib/common.pl";\r
-#==============================================================================\r
-# ¥Ñ¥é¥á¡¼¥¿¤ò¼õ¤±¼è¤ë\r
-#==============================================================================\r
-&ReadParse();\r
-my $page = $in{"p"};\r
-my $file = $in{"f"};\r
-\r
-#==============================================================================\r
-# ¥¨¥é¡¼¥Á¥§¥Ã¥¯\r
-#==============================================================================\r
-if($page eq ""){\r
- &Util::error("¥Ú¡¼¥¸¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");\r
-}\r
-if($file eq ""){\r
- &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");\r
-}\r
-#==============================================================================\r
-# ¥À¥¦¥ó¥í¡¼¥É\r
-#==============================================================================\r
-my $filename = sprintf("$main::ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));\r
-unless(-e $filename){\r
- &Util::error("»ØÄꤵ¤ì¤¿¥Õ¥¡¥¤¥ë¤Ï¸ºß¤·¤Þ¤»¤ó¡£");\r
-}\r
-\r
-my $contenttype = &get_mime_type($file);\r
-my $ua = $ENV{"HTTP_USER_AGENT"};\r
-my $disposition = ($contenttype =~ /^image\// && $ua !~ /MSIE/ ? "inline" : "attachment");\r
-\r
-&jcode::convert(\$file,'sjis');\r
-\r
-print "Content-Type: $contenttype\n";\r
-print "Content-Disposition: $disposition;filename=\"$file\"\n\n";\r
-open(DATA,$filename);\r
-binmode(DATA);\r
-while(<DATA>){\r
- print $_;\r
-}\r
-close(DATA);\r
-\r
-\r
-#==============================================================================\r
-# MIME¥¿¥¤¥×¤ò¼èÆÀ¤·¤Þ¤¹\r
-#==============================================================================\r
-sub get_mime_type {\r
- my $file = shift;\r
- my $type = lc(substr($file,rindex($file,".")));\r
- my $ctype;\r
- \r
- if ($type eq ".gif" ){ $ctype = "image/gif"; }\r
- elsif($type eq ".txt" ){ $ctype = "text/plain"; }\r
- elsif($type eq ".rb" ){ $ctype = "text/plain"; }\r
- elsif($type eq ".pl" ){ $ctype = "text/plain"; }\r
- elsif($type eq ".java"){ $ctype = "text/plain"; }\r
-# elsif($type eq ".html"){ $ctype = "text/html"; }\r
-# elsif($type eq ".htm" ){ $ctype = "text/html"; }\r
- elsif($type eq ".css" ){ $ctype = "text/css"; }\r
- elsif($type eq ".jpeg"){ $ctype = "image/jpeg"; }\r
- elsif($type eq ".jpg" ){ $ctype = "image/jpeg"; }\r
- elsif($type eq ".png" ){ $ctype = "image/png"; }\r
- elsif($type eq ".bmp" ){ $ctype = "image/bmp"; }\r
- elsif($type eq ".doc" ){ $ctype = "application/msword"; }\r
- elsif($type eq ".xls" ){ $ctype = "application/vnd.ms-excel"; }\r
- else { $ctype = "application/octet-stream"; }\r
- \r
- return $ctype;\r
-}\r
+#!/usr/bin/perl
+################################################################################
+#
+# FSWiki Lite - źÉÕ¥Õ¥¡¥¤¥ë¤ò¥À¥¦¥ó¥í¡¼¥É¤¹¤ë¤¿¤á¤ÎCGI¥¹¥¯¥ê¥×¥È
+#
+################################################################################
+require "./lib/common.pl";
+#==============================================================================
+# ¥Ñ¥é¥á¡¼¥¿¤ò¼õ¤±¼è¤ë
+#==============================================================================
+&ReadParse();
+my $page = $in{"p"};
+my $file = $in{"f"};
+
+#==============================================================================
+# ¥¨¥é¡¼¥Á¥§¥Ã¥¯
+#==============================================================================
+if($page eq ""){
+ &Util::error("¥Ú¡¼¥¸¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");
+}
+if($file eq ""){
+ &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");
+}
+#==============================================================================
+# ¥À¥¦¥ó¥í¡¼¥É
+#==============================================================================
+my $filename = sprintf("$main::ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));
+unless(-e $filename){
+ &Util::error("»ØÄꤵ¤ì¤¿¥Õ¥¡¥¤¥ë¤Ï¸ºß¤·¤Þ¤»¤ó¡£");
+}
+
+my $contenttype = &get_mime_type($file);
+my $ua = $ENV{"HTTP_USER_AGENT"};
+my $disposition = ($contenttype =~ /^image\// && $ua !~ /MSIE/ ? "inline" : "attachment");
+
+&jcode::convert(\$file,'sjis');
+
+print "Content-Type: $contenttype\n";
+print "Content-Disposition: $disposition;filename=\"$file\"\n\n";
+open(DATA,$filename);
+binmode(DATA);
+while(<DATA>){
+ print $_;
+}
+close(DATA);
+
+
+#==============================================================================
+# MIME¥¿¥¤¥×¤ò¼èÆÀ¤·¤Þ¤¹
+#==============================================================================
+sub get_mime_type {
+ my $file = shift;
+ my $type = lc(substr($file,rindex($file,".")));
+ my $ctype;
+
+ if ($type eq ".gif" ){ $ctype = "image/gif"; }
+ elsif($type eq ".txt" ){ $ctype = "text/plain"; }
+ elsif($type eq ".rb" ){ $ctype = "text/plain"; }
+ elsif($type eq ".pl" ){ $ctype = "text/plain"; }
+ elsif($type eq ".java"){ $ctype = "text/plain"; }
+# elsif($type eq ".html"){ $ctype = "text/html"; }
+# elsif($type eq ".htm" ){ $ctype = "text/html"; }
+ elsif($type eq ".css" ){ $ctype = "text/css"; }
+ elsif($type eq ".jpeg"){ $ctype = "image/jpeg"; }
+ elsif($type eq ".jpg" ){ $ctype = "image/jpeg"; }
+ elsif($type eq ".png" ){ $ctype = "image/png"; }
+ elsif($type eq ".bmp" ){ $ctype = "image/bmp"; }
+ elsif($type eq ".doc" ){ $ctype = "application/msword"; }
+ elsif($type eq ".xls" ){ $ctype = "application/vnd.ms-excel"; }
+ else { $ctype = "application/octet-stream"; }
+
+ return $ctype;
+}
-#!/usr/bin/perl\r
-################################################################################\r
-#\r
-# FSWiki Lite - ¥Ú¡¼¥¸ºîÀ®¡¢ÊÔ½¸ÍÑ¥¹¥¯¥ê¥×¥È\r
-#\r
-################################################################################\r
-require "./lib/common.pl";\r
-#===============================================================================\r
-# ½èÍý¤Î¿¶¤êʬ¤±\r
-#===============================================================================\r
-&ReadParse();\r
-if($in{"p"} eq ""){\r
- $in{"p"} = "FrontPage";\r
-}\r
-\r
-if($in{"p"}=~ /[\|:\[\]]/){\r
- &Util::error("¥Ú¡¼¥¸Ì¾¤Ë»ÈÍѤǤ¤Ê¤¤Ê¸»ú¤¬´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£");\r
-}\r
-\r
-if($in{"a"} eq "edit"){\r
- &edit_page();\r
-\r
-} elsif($in{"a"} eq "new"){\r
- &new_page();\r
- \r
-} elsif($in{"a"} eq "save"){\r
- &save_page();\r
- \r
-} elsif($in{"a"} eq "attach"){\r
- &attach_file();\r
- \r
-} elsif($in{"a"} eq "delconf"){\r
- &attach_delete_confirm();\r
- \r
-} elsif($in{"a"} eq "delete"){\r
- &attach_delete();\r
- \r
-} else {\r
- redirect("FrontPage");\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤ÎÊÔ½¸\r
-#-------------------------------------------------------------------------------\r
-sub edit_page {\r
- my $source = shift;\r
- my $page = $in{"p"};\r
- my $preview = 0;\r
- my $time = $in{"t"};\r
- \r
- if($source ne ""){\r
- $preview = 1;\r
- } elsif(&Wiki::exists_page($page)){\r
- $source = &Wiki::get_page($page);\r
- $time = &Wiki::get_last_modified($page);\r
- }\r
- \r
- &print_header($in{"p"}."¤ÎÊÔ½¸");\r
- \r
- if($preview==1){\r
- print &Wiki::process_wiki($source);\r
- }\r
- \r
- print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";\r
- print " <textarea name=\"source\" rows=\"20\" cols=\"80\">".&Util::escapeHTML($source)."</textarea><br>\n";\r
- print " <input type=\"submit\" name=\"do_save\" value=\" ÊÝ Â¸ \">\n";\r
- print " <input type=\"submit\" name=\"preview\" value=\"¥×¥ì¥Ó¥å¡¼\">\n";\r
- print " <input type=\"hidden\" name=\"a\" value=\"save\">\n";\r
- print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";\r
- print " <input type=\"hidden\" name=\"t\" value=\"".&Util::escapeHTML($time)."\">\n";\r
- print "</form>\n";\r
- \r
- opendir(DIR, $main::ATTACH_DIR);\r
- my ($attachentry, @attachfiles);\r
- while($attachentry = readdir(DIR)){\r
- my $type = rindex($attachentry,&Util::url_encode($page).".");\r
- if($type eq 0){\r
- push(@attachfiles, "$main::ATTACH_DIR/$attachentry");\r
- }\r
- }\r
- closedir(DIR);\r
- foreach my $attach (@attachfiles){\r
- $attach =~ /^\Q$main::ATTACH_DIR\E\/(.+)\.(.+)$/;\r
- my $pagename = $1;\r
- my $filename = $2;\r
- print &Wiki::Plugin::ref(&Util::url_decode($filename));\r
- printf ("[<a href=\"$EDIT_SCRIPT?a=delconf&p=%s&f=%s\">ºï½ü</a>]\n",$pagename,$filename);\r
- }\r
- \r
- print "<form action=\"$EDIT_SCRIPT\" method=\"post\" enctype=\"multipart/form-data\">\n";\r
- print " <input type=\"file\" name=\"f\">\n";\r
- print " <input type=\"submit\" name=\"do_attach\" value=\" ź ÉÕ \">\n";\r
- print " <input type=\"hidden\" name=\"a\" value=\"attach\">\n";\r
- print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";\r
- print "</form>\n";\r
- \r
- &print_footer();\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤ÎºîÀ®\r
-#-------------------------------------------------------------------------------\r
-sub new_page {\r
- &print_header("¥Ú¡¼¥¸¤ÎºîÀ®");\r
- print "<form action=\"$SCRIPT_NAME\" method=\"POST\">\n";\r
- print " <input type=\"text\" name=\"p\" size=\"40\">\n";\r
- print " <input type=\"submit\" name=\"do_save\" value=\" ºî À® \">\n";\r
- print " <input type=\"hidden\" name=\"a\" value=\"edit\">\n";\r
- print "</form>\n";\r
- &print_footer();\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤ÎÊݸ\r
-#-------------------------------------------------------------------------------\r
-sub save_page {\r
- my $page = $in{"p"};\r
- my $source = $in{"source"};\r
- \r
- if($in{"preview"} ne ""){\r
- &edit_page($source);\r
- \r
- } else {\r
- # ¥Ú¡¼¥¸¤Îºï½ü\r
- if($source eq ""){\r
- # ¹¹¿·¤Î½ÅÊ£¥Á¥§¥Ã¥¯\r
- if(&Wiki::exists_page($page)){\r
- if($in{"t"} != &Wiki::get_last_modified($page)){\r
- &Util::error("¤³¤Î¥Ú¡¼¥¸¤Ï´û¤Ë¹¹¿·¤µ¤ì¤Æ¤¤¤Þ¤¹¡£");\r
- } else {\r
- &Wiki::remove_page($page);\r
- }\r
- }\r
- &redirect("FrontPage");\r
- \r
- # ¥Ú¡¼¥¸¤ÎºîÀ®¤Þ¤¿¤Ï¹¹¿·\r
- } else {\r
- # ¹¹¿·¤Î½ÅÊ£¥Á¥§¥Ã¥¯\r
- if(&Wiki::exists_page($page)){\r
- if($in{"t"} != &Wiki::get_last_modified($page)){\r
- &Util::error("¤³¤Î¥Ú¡¼¥¸¤Ï´û¤Ë¹¹¿·¤µ¤ì¤Æ¤¤¤Þ¤¹¡£");\r
- }\r
- }\r
- &Wiki::save_page($page,$source);\r
- &redirect($page);\r
- }\r
- }\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Õ¥¡¥¤¥ë¤ÎźÉÕ\r
-#-------------------------------------------------------------------------------\r
-sub attach_file {\r
- my $page = $in{"p"};\r
- my $file = $in{"f"}; # ¥Õ¥¡¥¤¥ëÆâÍƤò¼èÆÀ\r
- my $name = $incfn{"f"}; # ¥Õ¥¡¥¤¥ë̾¤ò¼èÆÀ\r
- \r
- if($file eq ""){\r
- &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");\r
- }\r
- \r
- if($name eq ""){\r
- return;\r
- }\r
- \r
- $name =~ s/\\/\//g; # ¥Ñ¥¹¶èÀÚ¤êʸ»ú¤ò/¤ËÊÑ´¹\r
- $name = substr($name,rindex($name,"/")+1); # ¥Õ¥¡¥¤¥ë̾¤Î¤ß¤ò¼èÆÀ\r
- \r
- my $filename = sprintf("%s/%s.%s",$main::ATTACH_DIR,&Util::url_encode($page),&Util::url_encode($name));\r
- open(DATA,">$filename");\r
- binmode(DATA);\r
- print DATA $file;\r
- close(DATA);\r
- \r
- &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# źÉÕ¥Õ¥¡¥¤¥ë¤Îºï½ü³Îǧ\r
-#-------------------------------------------------------------------------------\r
-sub attach_delete_confirm {\r
- my $page = $in{"p"};\r
- my $file = $in{"f"};\r
- \r
- if($file eq ""){\r
- &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");\r
- }\r
- \r
- &print_header("źÉÕ¥Õ¥¡¥¤¥ë¤Îºï½ü");\r
- printf ("<p><a href=\"$MAIN_SCRIPT?p=%s\">%s</a>¤«¤é".\r
- "<a href=\"$DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>¤òºï½ü¤·¤Æ¤è¤í¤·¤¤¤Ç¤¹¤«¡©</p>\n",\r
- &Util::url_encode($page),&Util::escapeHTML($page),\r
- &Util::url_encode($page),&Util::url_encode($file),&Util::escapeHTML($file));\r
- \r
- print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";\r
- print " <input type=\"submit\" name=\"do_delete\" value=\" ºï ½ü \">\n";\r
- print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";\r
- print " <input type=\"hidden\" name=\"f\" value=\"".&Util::escapeHTML($file)."\">\n";\r
- print " <input type=\"hidden\" name=\"a\" value=\"delete\">\n";\r
- print "</form>\n";\r
- &print_footer();\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# źÉÕ¥Õ¥¡¥¤¥ë¤Îºï½ü\r
-#-------------------------------------------------------------------------------\r
-sub attach_delete {\r
- my $page = $in{"p"};\r
- my $file = $in{"f"};\r
- \r
- if($file eq ""){\r
- &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");\r
- }\r
- \r
- my $filename = sprintf("$ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));\r
- unlink($filename);\r
- \r
- &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));\r
-}\r
+#!/usr/bin/perl
+################################################################################
+#
+# FSWiki Lite - ¥Ú¡¼¥¸ºîÀ®¡¢ÊÔ½¸ÍÑ¥¹¥¯¥ê¥×¥È
+#
+################################################################################
+require "./lib/common.pl";
+#===============================================================================
+# ½èÍý¤Î¿¶¤êʬ¤±
+#===============================================================================
+&ReadParse();
+if($in{"p"} eq ""){
+ $in{"p"} = "FrontPage";
+}
+
+if($in{"p"}=~ /[\|:\[\]]/){
+ &Util::error("¥Ú¡¼¥¸Ì¾¤Ë»ÈÍѤǤ¤Ê¤¤Ê¸»ú¤¬´Þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£");
+}
+
+if($in{"a"} eq "edit"){
+ &edit_page();
+
+} elsif($in{"a"} eq "new"){
+ &new_page();
+
+} elsif($in{"a"} eq "save"){
+ &save_page();
+
+} elsif($in{"a"} eq "attach"){
+ &attach_file();
+
+} elsif($in{"a"} eq "delconf"){
+ &attach_delete_confirm();
+
+} elsif($in{"a"} eq "delete"){
+ &attach_delete();
+
+} else {
+ redirect("FrontPage");
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤ÎÊÔ½¸
+#-------------------------------------------------------------------------------
+sub edit_page {
+ my $source = shift;
+ my $page = $in{"p"};
+ my $preview = 0;
+ my $time = $in{"t"};
+
+ if($source ne ""){
+ $preview = 1;
+ } elsif(&Wiki::exists_page($page)){
+ $source = &Wiki::get_page($page);
+ $time = &Wiki::get_last_modified($page);
+ }
+
+ &print_header($in{"p"}."¤ÎÊÔ½¸");
+
+ if($preview==1){
+ print &Wiki::process_wiki($source);
+ }
+
+ print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";
+ print " <textarea name=\"source\" rows=\"20\" cols=\"80\">".&Util::escapeHTML($source)."</textarea><br>\n";
+ print " <input type=\"submit\" name=\"do_save\" value=\" ÊÝ Â¸ \">\n";
+ print " <input type=\"submit\" name=\"preview\" value=\"¥×¥ì¥Ó¥å¡¼\">\n";
+ print " <input type=\"hidden\" name=\"a\" value=\"save\">\n";
+ print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
+ print " <input type=\"hidden\" name=\"t\" value=\"".&Util::escapeHTML($time)."\">\n";
+ print "</form>\n";
+
+ opendir(DIR, $main::ATTACH_DIR);
+ my ($attachentry, @attachfiles);
+ while($attachentry = readdir(DIR)){
+ my $type = rindex($attachentry,&Util::url_encode($page).".");
+ if($type eq 0){
+ push(@attachfiles, "$main::ATTACH_DIR/$attachentry");
+ }
+ }
+ closedir(DIR);
+ foreach my $attach (@attachfiles){
+ $attach =~ /^\Q$main::ATTACH_DIR\E\/(.+)\.(.+)$/;
+ my $pagename = $1;
+ my $filename = $2;
+ print &Wiki::Plugin::ref(&Util::url_decode($filename));
+ printf ("[<a href=\"$EDIT_SCRIPT?a=delconf&p=%s&f=%s\">ºï½ü</a>]\n",$pagename,$filename);
+ }
+
+ print "<form action=\"$EDIT_SCRIPT\" method=\"post\" enctype=\"multipart/form-data\">\n";
+ print " <input type=\"file\" name=\"f\">\n";
+ print " <input type=\"submit\" name=\"do_attach\" value=\" ź ÉÕ \">\n";
+ print " <input type=\"hidden\" name=\"a\" value=\"attach\">\n";
+ print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
+ print "</form>\n";
+
+ &print_footer();
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤ÎºîÀ®
+#-------------------------------------------------------------------------------
+sub new_page {
+ &print_header("¥Ú¡¼¥¸¤ÎºîÀ®");
+ print "<form action=\"$SCRIPT_NAME\" method=\"POST\">\n";
+ print " <input type=\"text\" name=\"p\" size=\"40\">\n";
+ print " <input type=\"submit\" name=\"do_save\" value=\" ºî À® \">\n";
+ print " <input type=\"hidden\" name=\"a\" value=\"edit\">\n";
+ print "</form>\n";
+ &print_footer();
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤ÎÊݸ
+#-------------------------------------------------------------------------------
+sub save_page {
+ my $page = $in{"p"};
+ my $source = $in{"source"};
+
+ if($in{"preview"} ne ""){
+ &edit_page($source);
+
+ } else {
+ # ¥Ú¡¼¥¸¤Îºï½ü
+ if($source eq ""){
+ # ¹¹¿·¤Î½ÅÊ£¥Á¥§¥Ã¥¯
+ if(&Wiki::exists_page($page)){
+ if($in{"t"} != &Wiki::get_last_modified($page)){
+ &Util::error("¤³¤Î¥Ú¡¼¥¸¤Ï´û¤Ë¹¹¿·¤µ¤ì¤Æ¤¤¤Þ¤¹¡£");
+ } else {
+ &Wiki::remove_page($page);
+ }
+ }
+ &redirect("FrontPage");
+
+ # ¥Ú¡¼¥¸¤ÎºîÀ®¤Þ¤¿¤Ï¹¹¿·
+ } else {
+ # ¹¹¿·¤Î½ÅÊ£¥Á¥§¥Ã¥¯
+ if(&Wiki::exists_page($page)){
+ if($in{"t"} != &Wiki::get_last_modified($page)){
+ &Util::error("¤³¤Î¥Ú¡¼¥¸¤Ï´û¤Ë¹¹¿·¤µ¤ì¤Æ¤¤¤Þ¤¹¡£");
+ }
+ }
+ &Wiki::save_page($page,$source);
+ &redirect($page);
+ }
+ }
+}
+
+#-------------------------------------------------------------------------------
+# ¥Õ¥¡¥¤¥ë¤ÎźÉÕ
+#-------------------------------------------------------------------------------
+sub attach_file {
+ my $page = $in{"p"};
+ my $file = $in{"f"}; # ¥Õ¥¡¥¤¥ëÆâÍƤò¼èÆÀ
+ my $name = $incfn{"f"}; # ¥Õ¥¡¥¤¥ë̾¤ò¼èÆÀ
+
+ if($file eq ""){
+ &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");
+ }
+
+ if($name eq ""){
+ return;
+ }
+
+ $name =~ s/\\/\//g; # ¥Ñ¥¹¶èÀÚ¤êʸ»ú¤ò/¤ËÊÑ´¹
+ $name = substr($name,rindex($name,"/")+1); # ¥Õ¥¡¥¤¥ë̾¤Î¤ß¤ò¼èÆÀ
+
+ my $filename = sprintf("%s/%s.%s",$main::ATTACH_DIR,&Util::url_encode($page),&Util::url_encode($name));
+ open(DATA,">$filename");
+ binmode(DATA);
+ print DATA $file;
+ close(DATA);
+
+ &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));
+}
+
+#-------------------------------------------------------------------------------
+# źÉÕ¥Õ¥¡¥¤¥ë¤Îºï½ü³Îǧ
+#-------------------------------------------------------------------------------
+sub attach_delete_confirm {
+ my $page = $in{"p"};
+ my $file = $in{"f"};
+
+ if($file eq ""){
+ &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");
+ }
+
+ &print_header("źÉÕ¥Õ¥¡¥¤¥ë¤Îºï½ü");
+ printf ("<p><a href=\"$MAIN_SCRIPT?p=%s\">%s</a>¤«¤é".
+ "<a href=\"$DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>¤òºï½ü¤·¤Æ¤è¤í¤·¤¤¤Ç¤¹¤«¡©</p>\n",
+ &Util::url_encode($page),&Util::escapeHTML($page),
+ &Util::url_encode($page),&Util::url_encode($file),&Util::escapeHTML($file));
+
+ print "<form action=\"$EDIT_SCRIPT\" method=\"POST\">\n";
+ print " <input type=\"submit\" name=\"do_delete\" value=\" ºï ½ü \">\n";
+ print " <input type=\"hidden\" name=\"p\" value=\"".&Util::escapeHTML($page)."\">\n";
+ print " <input type=\"hidden\" name=\"f\" value=\"".&Util::escapeHTML($file)."\">\n";
+ print " <input type=\"hidden\" name=\"a\" value=\"delete\">\n";
+ print "</form>\n";
+ &print_footer();
+}
+
+#-------------------------------------------------------------------------------
+# źÉÕ¥Õ¥¡¥¤¥ë¤Îºï½ü
+#-------------------------------------------------------------------------------
+sub attach_delete {
+ my $page = $in{"p"};
+ my $file = $in{"f"};
+
+ if($file eq ""){
+ &Util::error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");
+ }
+
+ my $filename = sprintf("$ATTACH_DIR/%s.%s",&Util::url_encode($page),&Util::url_encode($file));
+ unlink($filename);
+
+ &redirectURL("$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($page));
+}
-# Perl Routines to Manipulate CGI input\r
-# S.E.Brenner@bioc.cam.ac.uk\r
-# $Id: cgi-lib.pl,v 1.2 2004/05/24 14:35:08 takezoe Exp $\r
-#\r
-# Copyright (c) 1996 Steven E. Brenner \r
-# Unpublished work.\r
-# Permission granted to use and modify this library so long as the\r
-# copyright above is maintained, modifications are documented, and\r
-# credit is given for any use of the library.\r
-#\r
-# Thanks are due to many people for reporting bugs and suggestions\r
-# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,\r
-# Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews\r
-\r
-# For more information, see:\r
-# http://www.bio.cam.ac.uk/cgi-lib/\r
-\r
-$cgi_lib'version = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);\r
-\r
-\r
-# Parameters affecting cgi-lib behavior\r
-# User-configurable parameters affecting file upload.\r
-$cgi_lib'maxdata = 131072; # maximum bytes to accept via POST - 2^17\r
-$cgi_lib'writefiles = 0; # directory to which to write files, or\r
- # 0 if files should not be written\r
-$cgi_lib'filepre = "cgi-lib"; # Prefix of file names, in directory above\r
-\r
-# Do not change the following parameters unless you have special reasons\r
-$cgi_lib'bufsize = 8192; # default buffer size when reading multipart\r
-$cgi_lib'maxbound = 100; # maximum boundary length to be encounterd\r
-$cgi_lib'headerout = 0; # indicates whether the header has been printed\r
-\r
-\r
-# ReadParse\r
-# Reads in GET or POST data, converts it to unescaped text, and puts\r
-# key/value pairs in %in, using "\0" to separate multiple selections\r
-\r
-# Returns >0 if there was input, 0 if there was no input \r
-# undef indicates some failure.\r
-\r
-# Now that cgi scripts can be put in the normal file space, it is useful\r
-# to combine both the form and the script in one place. If no parameters\r
-# are given (i.e., ReadParse returns FALSE), then a form could be output.\r
-\r
-# If a reference to a hash is given, then the data will be stored in that\r
-# hash, but the data from $in and @in will become inaccessable.\r
-# If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse,\r
-# information is stored there, rather than in $in, @in, and %in.\r
-# Second, third, and fourth parameters fill associative arrays analagous to\r
-# %in with data relevant to file uploads. \r
-\r
-# If no method is given, the script will process both command-line arguments\r
-# of the form: name=value and any text that is in $ENV{'QUERY_STRING'}\r
-# This is intended to aid debugging and may be changed in future releases\r
-\r
-sub ReadParse {\r
- local (*in) = shift if @_; # CGI input\r
- local (*incfn, # Client's filename (may not be provided)\r
- *inct, # Client's content-type (may not be provided)\r
- *insfn) = @_; # Server's filename (for spooled files)\r
- local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn, $got);\r
- \r
- # Disable warnings as this code deliberately uses local and environment\r
- # variables which are preset to undef (i.e., not explicitly initialized)\r
- $perlwarn = $^W;\r
- $^W = 0;\r
-\r
- binmode(STDIN); # we need these for DOS-based systems\r
- binmode(STDOUT); # and they shouldn't hurt anything else \r
- binmode(STDERR);\r
- \r
- # Get several useful env variables\r
- $type = $ENV{'CONTENT_TYPE'};\r
- $len = $ENV{'CONTENT_LENGTH'};\r
- $meth = $ENV{'REQUEST_METHOD'};\r
- \r
- if ($len > $cgi_lib'maxdata) { #'\r
- &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n");\r
- }\r
- \r
- if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD' ||\r
- $type eq 'application/x-www-form-urlencoded') {\r
- local ($key, $val, $i);\r
- \r
- # Read in text\r
- if (!defined $meth || $meth eq '') {\r
- $in = $ENV{'QUERY_STRING'};\r
- $cmdflag = 1; # also use command-line options\r
- } elsif($meth eq 'GET' || $meth eq 'HEAD') {\r
- $in = $ENV{'QUERY_STRING'};\r
- } elsif ($meth eq 'POST') {\r
- if (($got = read(STDIN, $in, $len) != $len))\r
- {$errflag="Short Read: wanted $len, got $got\n";};\r
- } else {\r
- &CgiDie("cgi-lib.pl: Unknown request method: $meth\n");\r
- }\r
-\r
- @in = split(/[&;]/,$in); \r
- push(@in, @ARGV) if $cmdflag; # add command-line parameters\r
-\r
- foreach $i (0 .. $#in) {\r
- # Convert plus to space\r
- $in[$i] =~ s/\+/ /g;\r
-\r
- # Split into key and value. \r
- ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.\r
-\r
- # Convert %XX from hex numbers to alphanumeric\r
- $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;\r
- $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;\r
-\r
- # Associate key and value\r
- $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator\r
- $in{$key} .= $val;\r
- }\r
-\r
- } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {\r
- # for efficiency, compile multipart code only if needed\r
-$errflag = !(eval <<'END_MULTIPART');\r
-\r
- local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);\r
- local ($bpos, $lpos, $left, $amt, $fn, $ser);\r
- local ($bufsize, $maxbound, $writefiles) = \r
- ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);\r
-\r
-\r
- # The following lines exist solely to eliminate spurious warning messages\r
- $buf = ''; \r
-\r
- ($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary\r
- ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;\r
- &CgiDie ("Boundary not provided: probably a bug in your server") \r
- unless $boundary;\r
- $boundary = "--" . $boundary;\r
- $blen = length ($boundary);\r
-\r
- if ($ENV{'REQUEST_METHOD'} ne 'POST') {\r
- &CgiDie("Invalid request method for multipart/form-data: $meth\n");\r
- }\r
-\r
- if ($writefiles) {\r
- local($me);\r
- stat ($writefiles);\r
- $writefiles = "/tmp" unless -d _ && -r _ && -w _;\r
- # ($me) = $0 =~ m#([^/]*)$#;\r
- $writefiles .= "/$cgi_lib'filepre"; \r
- }\r
-\r
- # read in the data and split into parts:\r
- # put headers in @in and data in %in\r
- # General algorithm:\r
- # There are two dividers: the border and the '\r\n\r\n' between\r
- # header and body. Iterate between searching for these\r
- # Retain a buffer of size(bufsize+maxbound); the latter part is\r
- # to ensure that dividers don't get lost by wrapping between two bufs\r
- # Look for a divider in the current batch. If not found, then\r
- # save all of bufsize, move the maxbound extra buffer to the front of\r
- # the buffer, and read in a new bufsize bytes. If a divider is found,\r
- # save everything up to the divider. Then empty the buffer of everything\r
- # up to the end of the divider. Refill buffer to bufsize+maxbound\r
- # Note slightly odd organization. Code before BODY: really goes with\r
- # code following HEAD:, but is put first to 'pre-fill' buffers. BODY:\r
- # is placed before HEAD: because we first need to discard any 'preface,'\r
- # which would be analagous to a body without a preceeding head.\r
-\r
- $left = $len;\r
- PART: # find each part of the multi-part while reading data\r
- while (1) {\r
- die $@ if $errflag;\r
-\r
- $amt = ($left > $bufsize+$maxbound-length($buf) \r
- ? $bufsize+$maxbound-length($buf): $left);\r
- $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);\r
- die "Short Read: wanted $amt, got $got\n" if $errflag;\r
- $left -= $amt;\r
-\r
- $in{$name} .= "\0" if defined $in{$name}; \r
- $in{$name} .= $fn if $fn;\r
-\r
- $name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted\r
- if (defined $1) {\r
- $insfn{$1} .= "\0" if defined $insfn{$1}; \r
- $insfn{$1} .= $fn if $fn;\r
- }\r
- \r
- BODY: \r
- while (($bpos = index($buf, $boundary)) == -1) {\r
- die $@ if $errflag;\r
- if ($name) { # if no $name, then it's the prologue -- discard\r
- if ($fn) { print FILE substr($buf, 0, $bufsize); }\r
- else { $in{$name} .= substr($buf, 0, $bufsize); }\r
- }\r
- $buf = substr($buf, $bufsize);\r
- $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);\r
- $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt); \r
- die "Short Read: wanted $amt, got $got\n" if $errflag;\r
- $left -= $amt;\r
- }\r
- if (defined $name) { # if no $name, then it's the prologue -- discard\r
- if ($fn) { print FILE substr($buf, 0, $bpos-2); }\r
- else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n\r
- }\r
- close (FILE);\r
- last PART if substr($buf, $bpos + $blen, 4) eq "--\r\n";\r
- substr($buf, 0, $bpos+$blen+2) = '';\r
- $amt = ($left > $bufsize+$maxbound-length($buf) \r
- ? $bufsize+$maxbound-length($buf) : $left);\r
- $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);\r
- die "Short Read: wanted $amt, got $got\n" if $errflag;\r
- $left -= $amt;\r
-\r
-\r
- undef $head; undef $fn;\r
- HEAD:\r
- while (($lpos = index($buf, "\r\n\r\n")) == -1) { \r
- die $@ if $errflag;\r
- $head .= substr($buf, 0, $bufsize);\r
- $buf = substr($buf, $bufsize);\r
- $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);\r
- $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt); \r
- die "Short Read: wanted $amt, got $got\n" if $errflag;\r
- $left -= $amt;\r
- }\r
- $head .= substr($buf, 0, $lpos+2);\r
- push (@in, $head);\r
- @heads = split("\r\n", $head);\r
- ($cd) = grep (/^\s*Content-Disposition:/i, @heads);\r
- ($ct) = grep (/^\s*Content-Type:/i, @heads);\r
-\r
- ($name) = $cd =~ /\bname="([^"]+)"/i; #"; \r
- ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name; \r
-\r
- ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str\r
- ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;\r
- $incfn{$name} .= (defined $in{$name} ? "\0" : "") . \r
- (defined $fname ? $fname : "");\r
-\r
- ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #";\r
- ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;\r
- $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;\r
-\r
- if ($writefiles && defined $fname) {\r
- $ser++;\r
- $fn = $writefiles . ".$$.$ser";\r
- open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");\r
- binmode (FILE); # write files accurately\r
- }\r
- substr($buf, 0, $lpos+4) = '';\r
- undef $fname;\r
- undef $ctype;\r
- }\r
-\r
-1;\r
-END_MULTIPART\r
- if ($errflag) {\r
- local ($errmsg, $value);\r
- $errmsg = $@ || $errflag;\r
- foreach $value (values %insfn) {\r
- unlink(split("\0",$value));\r
- }\r
- &CgiDie($errmsg);\r
- } else {\r
- # everything's ok.\r
- }\r
- } else {\r
- &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");\r
- }\r
-\r
- # no-ops to avoid warnings\r
- $insfn = $insfn;\r
- $incfn = $incfn;\r
- $inct = $inct;\r
-\r
- $^W = $perlwarn;\r
-\r
- return ($errflag ? undef : scalar(@in)); \r
-}\r
-\r
-\r
-# PrintHeader\r
-# Returns the magic line which tells WWW that we're an HTML document\r
-\r
-sub PrintHeader {\r
- return "Content-type: text/html\n\n";\r
-}\r
-\r
-\r
-# HtmlTop\r
-# Returns the <head> of a document and the beginning of the body\r
-# with the title and a body <h1> header as specified by the parameter\r
-\r
-sub HtmlTop\r
-{\r
- local ($title) = @_;\r
-\r
- return <<END_OF_TEXT;\r
-<html>\r
-<head>\r
-<title>$title</title>\r
-</head>\r
-<body>\r
-<h1>$title</h1>\r
-END_OF_TEXT\r
-}\r
-\r
-\r
-# HtmlBot\r
-# Returns the </body>, </html> codes for the bottom of every HTML page\r
-\r
-sub HtmlBot\r
-{\r
- return "</body>\n</html>\n";\r
-}\r
-\r
-\r
-# SplitParam\r
-# Splits a multi-valued parameter into a list of the constituent parameters\r
-\r
-sub SplitParam\r
-{\r
- local ($param) = @_;\r
- local (@params) = split ("\0", $param);\r
- return (wantarray ? @params : $params[0]);\r
-}\r
-\r
-\r
-# MethGet\r
-# Return true if this cgi call was using the GET request, false otherwise\r
-\r
-sub MethGet {\r
- return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "GET");\r
-}\r
-\r
-\r
-# MethPost\r
-# Return true if this cgi call was using the POST request, false otherwise\r
-\r
-sub MethPost {\r
- return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "POST");\r
-}\r
-\r
-\r
-# MyBaseUrl\r
-# Returns the base URL to the script (i.e., no extra path or query string)\r
-sub MyBaseUrl {\r
- local ($ret, $perlwarn);\r
- $perlwarn = $^W; $^W = 0;\r
- $ret = 'http://' . $ENV{'SERVER_NAME'} . \r
- ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .\r
- $ENV{'SCRIPT_NAME'};\r
- $^W = $perlwarn;\r
- return $ret;\r
-}\r
-\r
-\r
-# MyFullUrl\r
-# Returns the full URL to the script (i.e., with extra path or query string)\r
-sub MyFullUrl {\r
- local ($ret, $perlwarn);\r
- $perlwarn = $^W; $^W = 0;\r
- $ret = 'http://' . $ENV{'SERVER_NAME'} . \r
- ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .\r
- $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .\r
- (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');\r
- $^W = $perlwarn;\r
- return $ret;\r
-}\r
-\r
-\r
-# MyURL\r
-# Returns the base URL to the script (i.e., no extra path or query string)\r
-# This is obsolete and will be removed in later versions\r
-sub MyURL {\r
- return &MyBaseUrl;\r
-}\r
-\r
-\r
-# CgiError\r
-# Prints out an error message which which containes appropriate headers,\r
-# markup, etcetera.\r
-# Parameters:\r
-# If no parameters, gives a generic error message\r
-# Otherwise, the first parameter will be the title and the rest will \r
-# be given as different paragraphs of the body\r
-\r
-sub CgiError {\r
- local (@msg) = @_;\r
- local ($i,$name);\r
-\r
- if (!@msg) {\r
- $name = &MyFullUrl;\r
- @msg = ("Error: script $name encountered fatal error\n");\r
- };\r
-\r
- if (!$cgi_lib'headerout) { #')\r
- print &PrintHeader; \r
- print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";\r
- }\r
- print "<h1>$msg[0]</h1>\n";\r
- foreach $i (1 .. $#msg) {\r
- print "<p>$msg[$i]</p>\n";\r
- }\r
-\r
- $cgi_lib'headerout++;\r
-}\r
-\r
-\r
-# CgiDie\r
-# Identical to CgiError, but also quits with the passed error message.\r
-\r
-sub CgiDie {\r
- local (@msg) = @_;\r
- &CgiError (@msg);\r
- die @msg;\r
-}\r
-\r
-\r
-# PrintVariables\r
-# Nicely formats variables. Three calling options:\r
-# A non-null associative array - prints the items in that array\r
-# A type-glob - prints the items in the associated assoc array\r
-# nothing - defaults to use %in\r
-# Typical use: &PrintVariables()\r
-\r
-sub PrintVariables {\r
- local (*in) = @_ if @_ == 1;\r
- local (%in) = @_ if @_ > 1;\r
- local ($out, $key, $output);\r
-\r
- $output = "\n<dl compact>\n";\r
- foreach $key (sort keys(%in)) {\r
- foreach (split("\0", $in{$key})) {\r
- ($out = $_) =~ s/\n/<br>\n/g;\r
- $output .= "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";\r
- }\r
- }\r
- $output .= "</dl>\n";\r
-\r
- return $output;\r
-}\r
-\r
-# PrintEnv\r
-# Nicely formats all environment variables and returns HTML string\r
-sub PrintEnv {\r
- &PrintVariables(*ENV);\r
-}\r
-\r
-\r
-# The following lines exist only to avoid warning messages\r
-$cgi_lib'writefiles = $cgi_lib'writefiles;\r
-$cgi_lib'bufsize = $cgi_lib'bufsize ;\r
-$cgi_lib'maxbound = $cgi_lib'maxbound;\r
-$cgi_lib'version = $cgi_lib'version;\r
-$cgi_lib'filepre = $cgi_lib'filepre;\r
-\r
+# Perl Routines to Manipulate CGI input
+# S.E.Brenner@bioc.cam.ac.uk
+# $Id: cgi-lib.pl,v 1.2 2004/05/24 14:35:08 takezoe Exp $
+#
+# Copyright (c) 1996 Steven E. Brenner
+# Unpublished work.
+# Permission granted to use and modify this library so long as the
+# copyright above is maintained, modifications are documented, and
+# credit is given for any use of the library.
+#
+# Thanks are due to many people for reporting bugs and suggestions
+# especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen,
+# Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews
+
+# For more information, see:
+# http://www.bio.cam.ac.uk/cgi-lib/
+
+$cgi_lib'version = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
+
+
+# Parameters affecting cgi-lib behavior
+# User-configurable parameters affecting file upload.
+$cgi_lib'maxdata = 131072; # maximum bytes to accept via POST - 2^17
+$cgi_lib'writefiles = 0; # directory to which to write files, or
+ # 0 if files should not be written
+$cgi_lib'filepre = "cgi-lib"; # Prefix of file names, in directory above
+
+# Do not change the following parameters unless you have special reasons
+$cgi_lib'bufsize = 8192; # default buffer size when reading multipart
+$cgi_lib'maxbound = 100; # maximum boundary length to be encounterd
+$cgi_lib'headerout = 0; # indicates whether the header has been printed
+
+
+# ReadParse
+# Reads in GET or POST data, converts it to unescaped text, and puts
+# key/value pairs in %in, using "\0" to separate multiple selections
+
+# Returns >0 if there was input, 0 if there was no input
+# undef indicates some failure.
+
+# Now that cgi scripts can be put in the normal file space, it is useful
+# to combine both the form and the script in one place. If no parameters
+# are given (i.e., ReadParse returns FALSE), then a form could be output.
+
+# If a reference to a hash is given, then the data will be stored in that
+# hash, but the data from $in and @in will become inaccessable.
+# If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse,
+# information is stored there, rather than in $in, @in, and %in.
+# Second, third, and fourth parameters fill associative arrays analagous to
+# %in with data relevant to file uploads.
+
+# If no method is given, the script will process both command-line arguments
+# of the form: name=value and any text that is in $ENV{'QUERY_STRING'}
+# This is intended to aid debugging and may be changed in future releases
+
+sub ReadParse {
+ local (*in) = shift if @_; # CGI input
+ local (*incfn, # Client's filename (may not be provided)
+ *inct, # Client's content-type (may not be provided)
+ *insfn) = @_; # Server's filename (for spooled files)
+ local ($len, $type, $meth, $errflag, $cmdflag, $perlwarn, $got);
+
+ # Disable warnings as this code deliberately uses local and environment
+ # variables which are preset to undef (i.e., not explicitly initialized)
+ $perlwarn = $^W;
+ $^W = 0;
+
+ binmode(STDIN); # we need these for DOS-based systems
+ binmode(STDOUT); # and they shouldn't hurt anything else
+ binmode(STDERR);
+
+ # Get several useful env variables
+ $type = $ENV{'CONTENT_TYPE'};
+ $len = $ENV{'CONTENT_LENGTH'};
+ $meth = $ENV{'REQUEST_METHOD'};
+
+ if ($len > $cgi_lib'maxdata) { #'
+ &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n");
+ }
+
+ if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD' ||
+ $type eq 'application/x-www-form-urlencoded') {
+ local ($key, $val, $i);
+
+ # Read in text
+ if (!defined $meth || $meth eq '') {
+ $in = $ENV{'QUERY_STRING'};
+ $cmdflag = 1; # also use command-line options
+ } elsif($meth eq 'GET' || $meth eq 'HEAD') {
+ $in = $ENV{'QUERY_STRING'};
+ } elsif ($meth eq 'POST') {
+ if (($got = read(STDIN, $in, $len) != $len))
+ {$errflag="Short Read: wanted $len, got $got\n";};
+ } else {
+ &CgiDie("cgi-lib.pl: Unknown request method: $meth\n");
+ }
+
+ @in = split(/[&;]/,$in);
+ push(@in, @ARGV) if $cmdflag; # add command-line parameters
+
+ foreach $i (0 .. $#in) {
+ # Convert plus to space
+ $in[$i] =~ s/\+/ /g;
+
+ # Split into key and value.
+ ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
+
+ # Convert %XX from hex numbers to alphanumeric
+ $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
+ $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
+
+ # Associate key and value
+ $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
+ $in{$key} .= $val;
+ }
+
+ } elsif ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
+ # for efficiency, compile multipart code only if needed
+$errflag = !(eval <<'END_MULTIPART');
+
+ local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
+ local ($bpos, $lpos, $left, $amt, $fn, $ser);
+ local ($bufsize, $maxbound, $writefiles) =
+ ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);
+
+
+ # The following lines exist solely to eliminate spurious warning messages
+ $buf = '';
+
+ ($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary
+ ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
+ &CgiDie ("Boundary not provided: probably a bug in your server")
+ unless $boundary;
+ $boundary = "--" . $boundary;
+ $blen = length ($boundary);
+
+ if ($ENV{'REQUEST_METHOD'} ne 'POST') {
+ &CgiDie("Invalid request method for multipart/form-data: $meth\n");
+ }
+
+ if ($writefiles) {
+ local($me);
+ stat ($writefiles);
+ $writefiles = "/tmp" unless -d _ && -r _ && -w _;
+ # ($me) = $0 =~ m#([^/]*)$#;
+ $writefiles .= "/$cgi_lib'filepre";
+ }
+
+ # read in the data and split into parts:
+ # put headers in @in and data in %in
+ # General algorithm:
+ # There are two dividers: the border and the '\r\n\r\n' between
+ # header and body. Iterate between searching for these
+ # Retain a buffer of size(bufsize+maxbound); the latter part is
+ # to ensure that dividers don't get lost by wrapping between two bufs
+ # Look for a divider in the current batch. If not found, then
+ # save all of bufsize, move the maxbound extra buffer to the front of
+ # the buffer, and read in a new bufsize bytes. If a divider is found,
+ # save everything up to the divider. Then empty the buffer of everything
+ # up to the end of the divider. Refill buffer to bufsize+maxbound
+ # Note slightly odd organization. Code before BODY: really goes with
+ # code following HEAD:, but is put first to 'pre-fill' buffers. BODY:
+ # is placed before HEAD: because we first need to discard any 'preface,'
+ # which would be analagous to a body without a preceeding head.
+
+ $left = $len;
+ PART: # find each part of the multi-part while reading data
+ while (1) {
+ die $@ if $errflag;
+
+ $amt = ($left > $bufsize+$maxbound-length($buf)
+ ? $bufsize+$maxbound-length($buf): $left);
+ $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
+ die "Short Read: wanted $amt, got $got\n" if $errflag;
+ $left -= $amt;
+
+ $in{$name} .= "\0" if defined $in{$name};
+ $in{$name} .= $fn if $fn;
+
+ $name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted
+ if (defined $1) {
+ $insfn{$1} .= "\0" if defined $insfn{$1};
+ $insfn{$1} .= $fn if $fn;
+ }
+
+ BODY:
+ while (($bpos = index($buf, $boundary)) == -1) {
+ die $@ if $errflag;
+ if ($name) { # if no $name, then it's the prologue -- discard
+ if ($fn) { print FILE substr($buf, 0, $bufsize); }
+ else { $in{$name} .= substr($buf, 0, $bufsize); }
+ }
+ $buf = substr($buf, $bufsize);
+ $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
+ $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt);
+ die "Short Read: wanted $amt, got $got\n" if $errflag;
+ $left -= $amt;
+ }
+ if (defined $name) { # if no $name, then it's the prologue -- discard
+ if ($fn) { print FILE substr($buf, 0, $bpos-2); }
+ else { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
+ }
+ close (FILE);
+ last PART if substr($buf, $bpos + $blen, 4) eq "--\r\n";
+ substr($buf, 0, $bpos+$blen+2) = '';
+ $amt = ($left > $bufsize+$maxbound-length($buf)
+ ? $bufsize+$maxbound-length($buf) : $left);
+ $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
+ die "Short Read: wanted $amt, got $got\n" if $errflag;
+ $left -= $amt;
+
+
+ undef $head; undef $fn;
+ HEAD:
+ while (($lpos = index($buf, "\r\n\r\n")) == -1) {
+ die $@ if $errflag;
+ $head .= substr($buf, 0, $bufsize);
+ $buf = substr($buf, $bufsize);
+ $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
+ $errflag = (($got = read(STDIN, $buf, $amt, $maxbound)) != $amt);
+ die "Short Read: wanted $amt, got $got\n" if $errflag;
+ $left -= $amt;
+ }
+ $head .= substr($buf, 0, $lpos+2);
+ push (@in, $head);
+ @heads = split("\r\n", $head);
+ ($cd) = grep (/^\s*Content-Disposition:/i, @heads);
+ ($ct) = grep (/^\s*Content-Type:/i, @heads);
+
+ ($name) = $cd =~ /\bname="([^"]+)"/i; #";
+ ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
+
+ ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str
+ ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
+ $incfn{$name} .= (defined $in{$name} ? "\0" : "") .
+ (defined $fname ? $fname : "");
+
+ ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #";
+ ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;
+ $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;
+
+ if ($writefiles && defined $fname) {
+ $ser++;
+ $fn = $writefiles . ".$$.$ser";
+ open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
+ binmode (FILE); # write files accurately
+ }
+ substr($buf, 0, $lpos+4) = '';
+ undef $fname;
+ undef $ctype;
+ }
+
+1;
+END_MULTIPART
+ if ($errflag) {
+ local ($errmsg, $value);
+ $errmsg = $@ || $errflag;
+ foreach $value (values %insfn) {
+ unlink(split("\0",$value));
+ }
+ &CgiDie($errmsg);
+ } else {
+ # everything's ok.
+ }
+ } else {
+ &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");
+ }
+
+ # no-ops to avoid warnings
+ $insfn = $insfn;
+ $incfn = $incfn;
+ $inct = $inct;
+
+ $^W = $perlwarn;
+
+ return ($errflag ? undef : scalar(@in));
+}
+
+
+# PrintHeader
+# Returns the magic line which tells WWW that we're an HTML document
+
+sub PrintHeader {
+ return "Content-type: text/html\n\n";
+}
+
+
+# HtmlTop
+# Returns the <head> of a document and the beginning of the body
+# with the title and a body <h1> header as specified by the parameter
+
+sub HtmlTop
+{
+ local ($title) = @_;
+
+ return <<END_OF_TEXT;
+<html>
+<head>
+<title>$title</title>
+</head>
+<body>
+<h1>$title</h1>
+END_OF_TEXT
+}
+
+
+# HtmlBot
+# Returns the </body>, </html> codes for the bottom of every HTML page
+
+sub HtmlBot
+{
+ return "</body>\n</html>\n";
+}
+
+
+# SplitParam
+# Splits a multi-valued parameter into a list of the constituent parameters
+
+sub SplitParam
+{
+ local ($param) = @_;
+ local (@params) = split ("\0", $param);
+ return (wantarray ? @params : $params[0]);
+}
+
+
+# MethGet
+# Return true if this cgi call was using the GET request, false otherwise
+
+sub MethGet {
+ return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "GET");
+}
+
+
+# MethPost
+# Return true if this cgi call was using the POST request, false otherwise
+
+sub MethPost {
+ return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "POST");
+}
+
+
+# MyBaseUrl
+# Returns the base URL to the script (i.e., no extra path or query string)
+sub MyBaseUrl {
+ local ($ret, $perlwarn);
+ $perlwarn = $^W; $^W = 0;
+ $ret = 'http://' . $ENV{'SERVER_NAME'} .
+ ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
+ $ENV{'SCRIPT_NAME'};
+ $^W = $perlwarn;
+ return $ret;
+}
+
+
+# MyFullUrl
+# Returns the full URL to the script (i.e., with extra path or query string)
+sub MyFullUrl {
+ local ($ret, $perlwarn);
+ $perlwarn = $^W; $^W = 0;
+ $ret = 'http://' . $ENV{'SERVER_NAME'} .
+ ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
+ $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
+ (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');
+ $^W = $perlwarn;
+ return $ret;
+}
+
+
+# MyURL
+# Returns the base URL to the script (i.e., no extra path or query string)
+# This is obsolete and will be removed in later versions
+sub MyURL {
+ return &MyBaseUrl;
+}
+
+
+# CgiError
+# Prints out an error message which which containes appropriate headers,
+# markup, etcetera.
+# Parameters:
+# If no parameters, gives a generic error message
+# Otherwise, the first parameter will be the title and the rest will
+# be given as different paragraphs of the body
+
+sub CgiError {
+ local (@msg) = @_;
+ local ($i,$name);
+
+ if (!@msg) {
+ $name = &MyFullUrl;
+ @msg = ("Error: script $name encountered fatal error\n");
+ };
+
+ if (!$cgi_lib'headerout) { #')
+ print &PrintHeader;
+ print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";
+ }
+ print "<h1>$msg[0]</h1>\n";
+ foreach $i (1 .. $#msg) {
+ print "<p>$msg[$i]</p>\n";
+ }
+
+ $cgi_lib'headerout++;
+}
+
+
+# CgiDie
+# Identical to CgiError, but also quits with the passed error message.
+
+sub CgiDie {
+ local (@msg) = @_;
+ &CgiError (@msg);
+ die @msg;
+}
+
+
+# PrintVariables
+# Nicely formats variables. Three calling options:
+# A non-null associative array - prints the items in that array
+# A type-glob - prints the items in the associated assoc array
+# nothing - defaults to use %in
+# Typical use: &PrintVariables()
+
+sub PrintVariables {
+ local (*in) = @_ if @_ == 1;
+ local (%in) = @_ if @_ > 1;
+ local ($out, $key, $output);
+
+ $output = "\n<dl compact>\n";
+ foreach $key (sort keys(%in)) {
+ foreach (split("\0", $in{$key})) {
+ ($out = $_) =~ s/\n/<br>\n/g;
+ $output .= "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";
+ }
+ }
+ $output .= "</dl>\n";
+
+ return $output;
+}
+
+# PrintEnv
+# Nicely formats all environment variables and returns HTML string
+sub PrintEnv {
+ &PrintVariables(*ENV);
+}
+
+
+# The following lines exist only to avoid warning messages
+$cgi_lib'writefiles = $cgi_lib'writefiles;
+$cgi_lib'bufsize = $cgi_lib'bufsize ;
+$cgi_lib'maxbound = $cgi_lib'maxbound;
+$cgi_lib'version = $cgi_lib'version;
+$cgi_lib'filepre = $cgi_lib'filepre;
+
1; #return true
\ No newline at end of file
-################################################################################\r
-#\r
-# FSWikiLite ¶¦ÄÌ´Ø¿ô¥Õ¥¡¥¤¥ë\r
-#\r
-################################################################################\r
-require "./lib/cgi-lib.pl";\r
-require "./lib/jcode.pl";\r
-require "./lib/mimew.pl";\r
-require "./lib/setup.pl";\r
-#-------------------------------------------------------------------------------\r
-# °ú¿ô¤ÇÅϤ·¤¿¥Ú¡¼¥¸¤ËÁ«°Ü\r
-#-------------------------------------------------------------------------------\r
-sub redirect {\r
- my $page = shift;\r
- my $url = "$MAIN_SCRIPT?p=".&Util::url_encode($page);\r
- &redirectURL($url);\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# °ú¿ô¤ÇÅϤ·¤¿URL¤ËÁ«°Ü\r
-#-------------------------------------------------------------------------------\r
-sub redirectURL {\r
- my $url = shift;\r
- \r
- print "Content-Type: text/html;charset=EUC-JP\n";\r
- print "Pragma: no-cache\n";\r
- print "Cache-Control: no-cache\n\n";\r
- print "<html>\n";\r
- print " <head>\n";\r
- print " <title>moving...</title>\n";\r
- print " <meta http-equiv=\"Refresh\" content=\"0;URL=$url\">\n";\r
- print " </head>\n";\r
- print " <body>\n";\r
- print " Wait or <a href=\"$url\">Click Here!!</a>\n";\r
- print " </body>\n";\r
- print "</html>\n";\r
- \r
- exit;\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ø¥Ã¥À¤òɽ¼¨\r
-#-------------------------------------------------------------------------------\r
-sub print_header {\r
- my $title = shift;\r
- my $show = shift;\r
- \r
- print "Content-Type: text/html;charset=EUC-JP\n";\r
- print "Pragma: no-cache\n";\r
- print "Cache-Control: no-cache\n\n";\r
- print "<html>\n";\r
- print "<head>\n";\r
- print "<title>".&Util::escapeHTML($title)." - $SITE_TITLE</title>\n";\r
- print "<link rel=\"stylesheet\" type=\"text/css\" href=\"$THEME_URL\">\n";\r
- print "</head>\n";\r
- print "<body>\n";\r
- \r
- print "<div class=\"adminmenu\">\n";\r
- print " <span class=\"adminmenu\">\n";\r
- print " <a href=\"$MAIN_SCRIPT?p=FrontPage\">FrontPage</a>\n";\r
- print " <a href=\"$EDIT_SCRIPT?a=new\">¿·µ¬</a>\n";\r
- if($show==1){\r
- print " <a href=\"$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($in{"p"})."\">ÊÔ½¸</a>\n";\r
- }\r
- print " <a href=\"$MAIN_SCRIPT?a=search\">¸¡º÷</a>\n";\r
- print " <a href=\"$MAIN_SCRIPT?a=list\">°ìÍ÷</a>\n";\r
- print " <a href=\"$MAIN_SCRIPT?p=Help\">¥Ø¥ë¥×</a>\n";\r
- print " </span>\n";\r
- print "</div>\n";\r
- \r
- print "<h1>".&Util::escapeHTML($title)."</h1>\n";\r
- if(&Wiki::exists_page("Menu")){\r
- print "<div class=\"main\">\n";\r
- }\r
- \r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Õ¥Ã¥¿¤òɽ¼¨\r
-#-------------------------------------------------------------------------------\r
-sub print_footer {\r
- if(&Wiki::exists_page("Menu")){\r
- print "</div>\n";\r
- print "<div class=\"sidebar\">\n";\r
- print &Wiki::process_wiki(&Wiki::get_page("Menu"));\r
- print "</div>\n";\r
- }\r
- print "<div class=\"footer\">Powered by <a href=\"$main::SITE_URL\">FreeStyleWikiLite $main::VERSION</a></div>\n";\r
- print "</body></html>\n";\r
-}\r
-\r
-###############################################################################\r
-#\r
-# Wiki´ØÏ¢¤Î´Ø¿ô¤òÄ󶡤¹¤ë¥Ñ¥Ã¥±¡¼¥¸\r
-#\r
-###############################################################################\r
-package Wiki;\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤ò¼èÆÀ\r
-#-------------------------------------------------------------------------------\r
-sub get_page {\r
- my $page = &Util::url_encode(shift);\r
- \r
- open(DATA,"$main::DATA_DIR/$page.wiki") or &Util::error("$main::DATA_DIR/$page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");\r
- my $content = "";\r
- while(<DATA>){\r
- $content .= $_;\r
- }\r
- close(DATA);\r
- \r
- return $content;\r
-}\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤òÊݸ\r
-#-------------------------------------------------------------------------------\r
-sub save_page {\r
- my $page = shift;\r
- my $source = shift;\r
- \r
- $page = &Util::trim($page);\r
- $source =~ s/\r\n/\n/g;\r
- $source =~ s/\r/\n/g;\r
- \r
- my $enc_page = &Util::url_encode($page);\r
- my $action = 'MODIFY';\r
- unless(-e "$main::DATA_DIR/$enc_page.wiki"){\r
- $action = 'CREATE';\r
- }\r
- \r
- # ¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤òºîÀ®\r
- if(-e "$main::DATA_DIR/$enc_page.wiki"){\r
- open(BACKUP,">$main::BACKUP_DIR/$enc_page.bak") or &Util::error("$main::BACKUP_DIR/$enc_page.bak¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");\r
- open(DATA ,"$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");\r
- while(<DATA>){\r
- print BACKUP $_;\r
- }\r
- close(DATA);\r
- close(BACKUP);\r
- }\r
- \r
- # ÆþÎÏÆâÍƤòÊݸ\r
- open(DATA,">$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");\r
- print DATA $source;\r
- close(DATA);\r
- \r
- &send_mail($action,$page);\r
-}\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤òºï½ü\r
-#-------------------------------------------------------------------------------\r
-sub remove_page {\r
- my $page = shift;\r
- my $enc_page = &Util::url_encode($page);\r
- unlink("$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Îºï½ü¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");\r
- \r
- &send_mail('DELETE',$page);\r
-}\r
-#-------------------------------------------------------------------------------\r
-# ¥á¡¼¥ëÁ÷¿®\r
-#-------------------------------------------------------------------------------\r
-sub send_mail {\r
- my $action = shift;\r
- my $page = shift;\r
- my $enc_page = &Util::url_encode($page);\r
- \r
- if($main::ADMIN_MAIL eq "" || $main::SEND_MAIL eq ""){\r
- return;\r
- }\r
- \r
- my $subject = "";\r
- if($action eq 'CREATE'){\r
- $subject = "[FSWikiLite]$page¤¬ºîÀ®¤µ¤ì¤Þ¤·¤¿";\r
- \r
- } elsif($action eq 'MODIFY'){\r
- $subject = "[FSWikiLite]$page¤¬¹¹¿·¤µ¤ì¤Þ¤·¤¿";\r
- \r
- } elsif($action eq 'DELETE'){\r
- $subject = "[FSWikiLite]$page¤¬ºï½ü¤µ¤ì¤Þ¤·¤¿";\r
- }\r
- \r
- # MIME¥¨¥ó¥³¡¼¥É\r
- $subject = &main::mimeencode($subject);\r
- \r
- my $head = "Subject: $subject\n".\r
- "From: $main::ADMIN_MAIL\n".\r
- "Content-Transfer-Encoding: 7bit\n".\r
- "Content-Type: text/plain; charset=\"ISO-2022-JP\"\n".\r
- "Reply-To: $main::ADMIN_MAIL\n".\r
- "\n";\r
- \r
- my $body = "IP:".$ENV{'REMOTE_ADDR'}."\n".\r
- "UA:".$ENV{'HTTP_USER_AGENT'}."\n";\r
- \r
- if($action eq 'MODIFY' || $action eq 'DELETE'){\r
- if(-e "$main::BACKUP_DIR/$enc_page.bak"){\r
- $body .= "°Ê²¼¤ÏÊѹ¹Á°¤Î¥½¡¼¥¹¤Ç¤¹¡£\n".\r
- "-----------------------------------------------------\n";\r
- open(BACKUP,"$main::BACKUP_DIR/$enc_page.bak");\r
- while(my $line = <BACKUP>){\r
- $body .= $line;\r
- }\r
- close(BACKUP);\r
- }\r
- }\r
- \r
- # ʸ»ú¥³¡¼¥É¤ÎÊÑ´¹(jcode.pl¤ò»ÈÍѤ¹¤ë)\r
- &jcode::convert(\$body,'jis');\r
- \r
- open(MAIL,"| $main::SEND_MAIL $main::ADMIN_MAIL");\r
- print MAIL $head;\r
- print MAIL $body;\r
- close(MAIL);\r
-}\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤Î°ìÍ÷¤ò¼èÆÀ\r
-#-------------------------------------------------------------------------------\r
-sub get_page_list {\r
- opendir(DIR, $main::DATA_DIR);\r
- my ($fileentry, @files);\r
- while($fileentry = readdir(DIR)){\r
- my $type = substr($fileentry,rindex($fileentry,"."));\r
- if($type eq ".wiki"){\r
- push(@files, "$main::DATA_DIR/$fileentry");\r
- }\r
- }\r
- closedir(DIR);\r
-\r
- my @pages; \r
- foreach my $entry (@files){\r
- my @stat = stat($entry);\r
- my $time = $stat[9];\r
- \r
- $entry = substr($entry,length($main::DATA_DIR)+1);\r
- $entry =~ /(.+?)\.wiki/;\r
- my $page = &Util::url_decode($1);\r
- push(@pages,{NAME=>$page,TIME=>$time});\r
- }\r
- \r
- @pages = sort { $b->{TIME}<=>$a->{TIME} } @pages;\r
- return @pages;\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤Î¹¹¿·Æü»þ¤ò¼èÆÀ\r
-#-------------------------------------------------------------------------------\r
-sub get_last_modified {\r
- my $page = shift;\r
- if(&exists_page($page)){\r
- my $file = sprintf("%s/%s.wiki",$main::DATA_DIR,&Util::url_encode($page));\r
- my @stat = stat($file);\r
- return $stat[9];\r
- } else {\r
- return undef;\r
- }\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤¬Â¸ºß¤¹¤ë¤«¤É¤¦¤«\r
-#-------------------------------------------------------------------------------\r
-sub exists_page {\r
- my $page = &Util::url_encode(shift);\r
- if(-e "$main::DATA_DIR/$page.wiki"){\r
- return 1;\r
- } else {\r
- return 0;\r
- }\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# Wiki¥½¡¼¥¹¤òÅϤ·¤ÆHTML¤ò¼èÆÀ¤·¤Þ¤¹\r
-#-------------------------------------------------------------------------------\r
-sub process_wiki {\r
- my $source = shift;\r
- my $main = shift;\r
- my $parser = HTMLParser->new($main);\r
- $parser->parse($source);\r
- \r
- return $parser->{html};\r
-}\r
-\r
-###############################################################################\r
-#\r
-# HTML¥Ñ¡¼¥µ\r
-#\r
-###############################################################################\r
-package HTMLParser;\r
-#==============================================================================\r
-# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
-#==============================================================================\r
-sub new {\r
- my $class = shift;\r
- my $mainflg = shift;\r
- my $self = {};\r
- \r
- if(!defined($mainflg) || $mainflg eq ""){ $mainflg = 0; }\r
- \r
- $self->{html} = "";\r
- $self->{pre} = "";\r
- $self->{quote} = "";\r
- $self->{table} = 0;\r
- $self->{level} = 0;\r
- $self->{para} = 0;\r
- $self->{p_cnt} = 0;\r
- $self->{explan} = 0;\r
- $self->{main} = $mainflg;\r
- return bless $self,$class;\r
-}\r
-\r
-#===============================================================================\r
-# ¥Ñ¡¼¥¹\r
-#===============================================================================\r
-sub parse {\r
- my $self = shift;\r
- my $source = shift;\r
- \r
- $source =~ s/\r//g;\r
- my @lines = split(/\n/,$source);\r
- \r
- foreach my $line (@lines){\r
- chomp $line;\r
- \r
- # Ê£¿ô¹Ô¤ÎÀâÌÀ\r
- $self->multi_explanation($line);\r
- \r
- my $word1 = substr($line,0,1);\r
- my $word2 = substr($line,0,2);\r
- my $word3 = substr($line,0,3);\r
- \r
- # ¶õ¹Ô\r
- if($line eq ""){\r
- $self->l_paragraph();\r
- next;\r
- }\r
- \r
- # ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó\r
- if($line =~ /^{{((.|\s)+?)}}$/){\r
- my $plugin = &Util::parse_plugin($1);\r
- my $class = $main::P_PLUGIN->{$plugin->{command}};\r
- if(defined($class)){\r
- $self->l_plugin($plugin);\r
- } else {\r
- my @obj = $self->parse_line($line);\r
- $self->l_text(\@obj);\r
- }\r
- next;\r
- }\r
- \r
- # PRE\r
- if($word1 eq " " || $word1 eq "\t"){\r
- $self->l_verbatim($line);\r
- \r
- # ¸«½Ð¤·\r
- } elsif($word3 eq "!!!"){\r
- my @obj = $self->parse_line(substr($line,3));\r
- $self->l_headline(1,\@obj);\r
- \r
- } elsif($word2 eq "!!"){\r
- my @obj = $self->parse_line(substr($line,2));\r
- $self->l_headline(2,\@obj);\r
- \r
- } elsif($word1 eq "!"){\r
- my @obj = $self->parse_line(substr($line,1));\r
- $self->l_headline(3,\@obj);\r
-\r
- # ¹àÌÜ\r
- } elsif($word3 eq "***"){\r
- my @obj = $self->parse_line(substr($line,3));\r
- $self->l_list(3,\@obj);\r
- \r
- } elsif($word2 eq "**"){\r
- my @obj = $self->parse_line(substr($line,2));\r
- $self->l_list(2,\@obj);\r
- \r
- } elsif($word1 eq "*"){\r
- my @obj = $self->parse_line(substr($line,1));\r
- $self->l_list(1,\@obj);\r
- \r
- # ÈÖ¹æÉÕ¤¹àÌÜ\r
- } elsif($word3 eq "+++"){\r
- my @obj = $self->parse_line(substr($line,3));\r
- $self->l_numlist(3,\@obj);\r
- \r
- } elsif($word2 eq "++"){\r
- my @obj = $self->parse_line(substr($line,2));\r
- $self->l_numlist(2,\@obj);\r
- \r
- } elsif($word1 eq "+"){\r
- my @obj = $self->parse_line(substr($line,1));\r
- $self->l_numlist(1,\@obj);\r
- \r
- # ¿åÊ¿Àþ\r
- } elsif($line eq "----"){\r
- $self->l_line();\r
- \r
- # °úÍÑ\r
- } elsif($word2 eq '""'){\r
- my @obj = $self->parse_line(substr($line,2));\r
- $self->l_quotation(\@obj);\r
- \r
- # ÀâÌÀ\r
- } elsif(index($line,":")==0 && index($line,":",1)!=-1){\r
- if(index($line,":::")==0){\r
- $self->{dd} .= substr($line,3);\r
- next;\r
- }\r
- if(index($line,"::")==0){\r
- if($self->{dt} ne "" || $self->{dd} ne ""){\r
- $self->multi_explanation;\r
- }\r
- $self->{dt} = substr($line,2);\r
- $self->{dl_flag} = 1;\r
- next;\r
- }\r
- my $dt = substr($line,1,index($line,":",1)-1);\r
- my $dd = substr($line,index($line,":",1)+1);\r
- my @obj1 = $self->parse_line($dt);\r
- my @obj2 = $self->parse_line($dd);\r
- $self->l_explanation(\@obj1,\@obj2);\r
- \r
- # ¥Æ¡¼¥Ö¥ë\r
- } elsif($word1 eq ","){\r
- if($line =~ /,$/){\r
- $line .= " ";\r
- }\r
- my @spl = map {/^"(.*)"$/ ? scalar($_ = $1, s/\"\"/\"/g, $_) : $_}\r
- ($line =~ /,\s*(\"[^\"]*(?:\"\"[^\"]*)*\"|[^,]*)/g);\r
- my @array;\r
- foreach my $value (@spl){\r
- my @cell = $self->parse_line($value);\r
- push @array,\@cell;\r
- }\r
- $self->l_table(\@array);\r
- \r
- # ¥³¥á¥ó¥È\r
- } elsif($word2 eq "//"){\r
- \r
- # ²¿¤â¤Ê¤¤¹Ô\r
- } else {\r
- my @obj = $self->parse_line($line);\r
- $self->l_text(\@obj);\r
- }\r
- }\r
- \r
- # Ê£¿ô¹Ô¤ÎÀâÌÀ\r
- $self->multi_explanation;\r
- \r
- $self->end_parse;\r
-}\r
-\r
-#===============================================================================\r
-# Ê£¿ô¹Ô¤ÎÀâÌÀ\r
-#===============================================================================\r
-sub multi_explanation {\r
- my $self = shift;\r
- my $line = shift;\r
- if($self->{dl_flag}==1 && (index($line,":")!=0 || !defined($line))){\r
- my @obj1 = $self->parse_line($self->{dt});\r
- my @obj2 = $self->parse_line($self->{dd});\r
- $self->l_explanation(\@obj1,\@obj2);\r
- $self->{dl_flag} = 0;\r
- $self->{dt} = "";\r
- $self->{dd} = "";\r
- }\r
-}\r
-\r
-#===============================================================================\r
-# £±¹Ôʬ¤ò¥Ñ¡¼¥¹\r
-#===============================================================================\r
-sub parse_line {\r
- my $self = shift;\r
- my $source = shift;\r
- my @array = ();\r
- \r
- # ¥×¥é¥°¥¤¥ó\r
- if($source =~ /{{((.|\s)+?)}}/){\r
- my $pre = $`;\r
- my $post = $';\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- my $plugin = &Util::parse_plugin($1);\r
- my $class = $main::I_PLUGIN->{$plugin->{command}};\r
- if(defined($class)){\r
- push @array,$self->plugin($plugin);\r
- } else {\r
- push @array,$self->text("{{$1}}");\r
- }\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
- \r
- # ¥Ü¡¼¥ë¥É¡¢¥¤¥¿¥ê¥Ã¥¯¡¢¼è¤ê¾Ã¤·Àþ¡¢²¼Àþ\r
- } elsif($source =~ /((''')|('')|(==)|(__))(.+?)(\1)/){\r
- my $pre = $`;\r
- my $post = $';\r
- my $type = $1;\r
- my $label = $6;\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- if($type eq "'''"){\r
- push @array,$self->bold($label);\r
- } elsif($type eq "__"){\r
- push @array,$self->underline($label);\r
- } elsif($type eq "''"){\r
- push @array,$self->italic($label);\r
- } elsif($type eq "=="){\r
- push @array,$self->denialline($label);\r
- }\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
- \r
- # ¥Ú¡¼¥¸ÊÌ̾¥ê¥ó¥¯\r
- } elsif($source =~ /\[\[([^\[]+?)\|(.+?)\]\]/){\r
- my $pre = $`;\r
- my $post = $';\r
- my $label = $1;\r
- my $page = $2;\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- push @array,$self->wiki_anchor($page,$label);\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
-\r
- # URLÊÌ̾¥ê¥ó¥¯\r
- } elsif($source =~ /\[([^\[]+?)\|((http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/\r
- || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/\r
- || $source =~ /\[([^\[]+?)\|((\/|\.\/|\.\.\/)+[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/){\r
- my $pre = $`;\r
- my $post = $';\r
- my $label = $1;\r
- my $url = $2;\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){\r
- push @array,"<span class=\"error\">ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£</span>";\r
- } else {\r
- push @array,$self->url_anchor($url,$label);\r
- }\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
- \r
- # URL¥ê¥ó¥¯\r
- } elsif($source =~ /(http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*/\r
- || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/){\r
- my $pre = $`;\r
- my $post = $';\r
- my $url = $&;\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){\r
- push @array,"<span class=\"error\">ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£</span>";\r
- } else {\r
- push @array,$self->url_anchor($url);\r
- }\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
- \r
- # ¥Ú¡¼¥¸¥ê¥ó¥¯\r
- } elsif($source =~ /\[\[([^\|]+?)\]\]/){\r
- my $pre = $`;\r
- my $post = $';\r
- my $page = $1;\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- push @array,$self->wiki_anchor($page);\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
-\r
- # Ǥ°Õ¤ÎURL¥ê¥ó¥¯\r
- } elsif($source =~ /\[([^\[]+?)\|(.+?)\]/){\r
- my $pre = $`;\r
- my $post = $';\r
- my $label = $1;\r
- my $url = $2;\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){\r
- push @array,"<span class=\"error\">ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£</span>";\r
- } else {\r
- push @array,$self->url_anchor($url,$label);\r
- }\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
- \r
- # WikiName\r
- } elsif($main::WIKI_NAME==1 && $source =~ /[A-Z]+?[a-z]+?([A-Z]+?[a-z]+)+/){\r
- my $pre = $`;\r
- my $post = $';\r
- my $page = $&;\r
- if($pre ne ""){ push(@array,$self->parse_line($pre)); }\r
- push @array,$self->wiki_anchor($page);\r
- if($post ne ""){ push(@array,$self->parse_line($post)); }\r
- \r
- } else {\r
- push @array,$self->text($source);\r
- }\r
- \r
- return @array;\r
-}\r
-\r
-#==============================================================================\r
-# ¥ê¥¹¥È\r
-#==============================================================================\r
-sub l_list {\r
- my $self = shift;\r
- my $level = shift;\r
- my $obj = shift;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>\n";\r
- $self->{para} = 0;\r
- }\r
- \r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- my $html = join("",@$obj);\r
- my $plus = 1;\r
- \r
- if($level < $self->{level}){ $plus = -1; }\r
- if($level==$self->{level}){\r
- $self->{html} .= "</li>\n";\r
- }\r
- while($level != $self->{level}){\r
- if($plus==1){\r
- $self->{html} .= "<ul>\n";\r
- push(@{$self->{close_list}},"</ul>\n");\r
- } else {\r
- $self->{html} .= "</li>\n";\r
- $self->{html} .= pop(@{$self->{close_list}});\r
- }\r
- $self->{level} += $plus;\r
- }\r
- \r
- $self->{html} .= "<li>".$html;\r
-}\r
-\r
-#==============================================================================\r
-# ÈÖ¹æÉÕ¤¥ê¥¹¥È\r
-#==============================================================================\r
-sub l_numlist {\r
- my $self = shift;\r
- my $level = shift;\r
- my $obj = shift;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>\n";\r
- $self->{para} = 0;\r
- }\r
- \r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- my $html = join("",@$obj);\r
- my $plus = 1;\r
- \r
- if($level < $self->{level}){ $plus = -1; }\r
- if($level==$self->{level}){\r
- $self->{html} .= "</li>\n";\r
- }\r
- while($level != $self->{level}){\r
- if($plus==1){\r
- $self->{html} .= "<ol>\n";\r
- push(@{$self->{close_list}},"</ol>\n");\r
- } else {\r
- $self->{html} .= "</li>\n";\r
- $self->{html} .= pop(@{$self->{close_list}});\r
- }\r
- $self->{level} += $plus;\r
- }\r
- $self->{html} .= "<li>".$html;\r
-}\r
-\r
-#==============================================================================\r
-# ¥ê¥¹¥È¤Î½ªÎ»\r
-#==============================================================================\r
-sub end_list {\r
- my $self = shift;\r
- if ($self->{level}!=0) {\r
- $self->{html} .= "</li>\n";\r
- while($self->{level}!=0){\r
- $self->{html} .= pop(@{$self->{close_list}});\r
- $self->{level} += -1;\r
- }\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ¥Ø¥Ã¥É¥é¥¤¥ó\r
-#==============================================================================\r
-sub l_headline {\r
- my $self = shift;\r
- my $level = shift;\r
- my $obj = shift;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>\n";\r
- $self->{para} = 0;\r
- }\r
- \r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- my $html = join("",@$obj);\r
- \r
- if(!$self->{main}){\r
- $self->{html} .= "<h".($level+1).">".$html."</h".($level+1).">\n";\r
- } else {\r
- if($level==2){\r
- $self->{html} .= "<h".($level+1)."><a name=\"p".$self->{p_cnt}."\">".\r
- "<span class=\"sanchor\">_</span></a>".$html."</h".($level+1).">\n";\r
- } else {\r
- $self->{html} .= "<h".($level+1).">".\r
- "<a name=\"p".$self->{p_cnt}."\">".$html."</a>".\r
- "</h".($level+1).">\n";\r
- }\r
- }\r
- $self->{p_cnt}++;\r
-}\r
-\r
-#==============================================================================\r
-# ¿åÊ¿Àþ\r
-#==============================================================================\r
-sub l_line {\r
- my $self = shift;\r
- \r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- $self->{html} .= "<hr>\n";\r
-}\r
-\r
-#==============================================================================\r
-# ÃÊÍî¶èÀÚ¤ê\r
-#==============================================================================\r
-sub l_paragraph {\r
- my $self = shift;\r
- \r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>\n";\r
- $self->{para} = 0;\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# À°·ÁºÑ¥Æ¥¥¹¥È\r
-#==============================================================================\r
-sub l_verbatim {\r
- my $self = shift;\r
- my $text = shift;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>\n";\r
- $self->{para} = 0;\r
- }\r
- \r
- $self->end_list;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- $self->{pre} .= Util::escapeHTML($text)."\n";\r
-}\r
-\r
-sub end_verbatim {\r
- my $self = shift;\r
- if($self->{pre} ne ""){\r
- $self->{html} .= "<pre>".$self->{pre}."</pre>";\r
- $self->{pre} = "";\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ¥Æ¡¼¥Ö¥ë\r
-#==============================================================================\r
-sub l_table {\r
- my $self = shift;\r
- my $row = shift;\r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- if($self->{table}==0){\r
- $self->{table}=1;\r
- $self->{html} .= "<table>\n";\r
- $self->{html} .= "<tr>\n";\r
- foreach(@$row){\r
- my $html = join("",@$_);\r
- $self->{html} .= "<th>".$html."</th>\n";\r
- }\r
- $self->{html} .= "</tr>\n";\r
- } else {\r
- $self->{table}=2;\r
- $self->{html} .= "<tr>\n";\r
- foreach(@$row){\r
- my $html = join("",@$_);\r
- $self->{html} .= "<td>".$html."</td>\n";\r
- }\r
- $self->{html} .= "</tr>\n";\r
- }\r
-}\r
-\r
-sub end_table {\r
- my $self = shift;\r
- if($self->{table}!=0){\r
- $self->{table} = 0;\r
- $self->{html} .= "</table>\n";\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ¥Ñ¡¼¥¹½ªÎ»»þ¤Î½èÍý\r
-#==============================================================================\r
-sub end_parse {\r
- my $self = shift;\r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>\n";\r
- $self->{para} = 0;\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ¹Ô½ñ¼°¤Ë³ºÅö¤·¤Ê¤¤¹Ô\r
-#==============================================================================\r
-sub l_text {\r
- my $self = shift;\r
- my $obj = shift;\r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- my $html = join("",@$obj);\r
- \r
- if($self->{para}==0){\r
- $self->{html} .= "<p>";\r
- $self->{para} = 1;\r
- }\r
- $self->{html} .= $html;\r
-}\r
-\r
-#==============================================================================\r
-# °úÍÑ\r
-#==============================================================================\r
-sub l_quotation {\r
- my $self = shift;\r
- my $obj = shift;\r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_explan;\r
- my $html = join("",@$obj);\r
- $self->{quote} .= "<p>".$html."</p>\n";\r
-}\r
-\r
-sub end_quote {\r
- my $self = shift;\r
- if($self->{quote} ne ""){\r
- $self->{html} .= "<blockquote>".$self->{quote}."</blockquote>\n";\r
- $self->{quote} = "";\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ÀâÌÀ\r
-#==============================================================================\r
-sub l_explanation {\r
- my $self = shift;\r
- my $obj1 = shift;\r
- my $obj2 = shift;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>";\r
- $self->{para} = 0;\r
- }\r
-\r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- \r
- if($self->{explan}==0){\r
- $self->{explan}=1;\r
- $self->{html} .= "<dl>\n";\r
- }\r
- \r
- my $html1 = join("",@$obj1);\r
- my $html2 = join("",@$obj2);\r
- \r
- $self->{html} .= "<dt>".$html1."</dt>\n<dd>".$html2."</dd>\n";\r
-}\r
-\r
-sub end_explan {\r
- my $self = shift;\r
- if($self->{explan}!=0){\r
- $self->{explan} = 0;\r
- $self->{html} .= "</dl>\n";\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ¥Ü¡¼¥ë¥É\r
-#==============================================================================\r
-sub bold {\r
- my $self = shift;\r
- my $text = shift;\r
- return "<strong>".join("",$self->parse_line($text))."</strong>";\r
-}\r
-\r
-#==============================================================================\r
-# ¥¤¥¿¥ê¥Ã¥¯\r
-#==============================================================================\r
-sub italic {\r
- my $self = shift;\r
- my $text = shift;\r
- return "<em>".join("",$self->parse_line($text))."</em>";\r
-}\r
-\r
-#==============================================================================\r
-# ²¼Àþ\r
-#==============================================================================\r
-sub underline {\r
- my $self = shift;\r
- my $text = shift;\r
- return "<ins>".join("",$self->parse_line($text))."</ins>";\r
-}\r
-\r
-#==============================================================================\r
-# ÂǤÁ¾Ã¤·Àþ\r
-#==============================================================================\r
-sub denialline {\r
- my $self = shift;\r
- my $text = shift;\r
- return "<del>".join("",$self->parse_line($text))."</del>";\r
-}\r
-\r
-#==============================================================================\r
-# URL¥¢¥ó¥«\r
-#==============================================================================\r
-sub url_anchor {\r
- my $self = shift;\r
- my $url = shift;\r
- my $name = shift;\r
- \r
- if($name eq ""){\r
- $name = $url;\r
- }\r
- \r
- if($url eq $name && $url=~/\.(gif|jpg|jpeg|bmp|png)$/i){\r
- return "<img src=\"".$url."\">";\r
- } else {\r
- return "<a href=\"$url\">".Util::escapeHTML($name)."</a>";\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# Wiki¥Ú¡¼¥¸¤Ø¤Î¥¢¥ó¥«\r
-#==============================================================================\r
-sub wiki_anchor {\r
- my $self = shift;\r
- my $page = shift;\r
- my $name = shift;\r
- \r
- if(!defined($name) || $name eq ""){\r
- $name = $page;\r
- }\r
- \r
- if(&Wiki::exists_page($page)){\r
- return "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\" class=\"wikipage\">".\r
- &Util::escapeHTML($name)."</a>";\r
- } else {\r
- return "<span class=\"nopage\">".&Util::escapeHTML($name)."</span>".\r
- "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">?</a>";\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ¤¿¤À¤Î¥Æ¥¥¹¥È\r
-#==============================================================================\r
-sub text {\r
- my $self = shift;\r
- my $text = shift;\r
- return &Util::escapeHTML($text);\r
-}\r
-\r
-#==============================================================================\r
-# ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó\r
-#==============================================================================\r
-sub plugin {\r
- my $self = shift;\r
- my $plugin = shift;\r
- \r
- my $func_ref = $main::I_PLUGIN->{$plugin->{command}};\r
- my $result = &$func_ref(@{$plugin->{args}});\r
- if(defined($result) && $result ne ""){\r
- return ($result);\r
- }\r
- \r
- return undef;\r
-}\r
-\r
-#==============================================================================\r
-# ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó\r
-#==============================================================================\r
-sub l_plugin {\r
- my $self = shift;\r
- my $plugin = shift;\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>\n";\r
- $self->{para} = 0;\r
- }\r
- \r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- my $func_ref = $main::P_PLUGIN->{$plugin->{command}};\r
- my $result = &$func_ref(@{$plugin->{args}});\r
- if(defined($result) && $result ne ""){\r
- $self->{html} .= $result;\r
- }\r
-}\r
-\r
-#==============================================================================\r
-# ¥¤¥á¡¼¥¸\r
-#==============================================================================\r
-sub l_image {\r
- my $self = shift;\r
- my $page = shift;\r
- my $file = shift;\r
- my $wiki = $self->{wiki};\r
- \r
- if($self->{para}==1){\r
- $self->{html} .= "</p>";\r
- $self->{para} = 0;\r
- }\r
- \r
- $self->end_list;\r
- $self->end_verbatim;\r
- $self->end_table;\r
- $self->end_quote;\r
- $self->end_explan;\r
- \r
- $self->{html} .= "<img src=\"".$wiki->config('script_name')."?action=ATTACH&".\r
- "page=".&Util::url_encode($page)."&file=".&Util::url_encode($file)."\">";\r
-}\r
-\r
-\r
-################################################################################\r
-#\r
-# ¥æ¡¼¥Æ¥£¥ê¥Æ¥£´Ø¿ô¤òÄ󶡤¹¤ë¥Ñ¥Ã¥±¡¼¥¸\r
-#\r
-################################################################################\r
-package Util;\r
-#===============================================================================\r
-# °ú¿ô¤ÇÅϤµ¤ì¤¿Ê¸»úÎó¤òURL¥¨¥ó¥³¡¼¥É¤·¤ÆÊÖ¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub url_encode {\r
- my $retstr = shift;\r
- $retstr =~ s/([^ 0-9A-Za-z])/sprintf("%%%.2X", ord($1))/eg;\r
- $retstr =~ tr/ /+/;\r
- return $retstr;\r
-}\r
-\r
-#===============================================================================\r
-# °ú¿ô¤ÇÅϤµ¤ì¤¿Ê¸»úÎó¤òURL¥Ç¥³¡¼¥É¤·¤ÆÊÖ¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub url_decode{\r
- my $retstr = shift;\r
- $retstr =~ tr/+/ /;\r
- $retstr =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;\r
- return $retstr;\r
-}\r
-\r
-#===============================================================================\r
-# °ú¿ô¤ÇÅϤµ¤ì¤¿Ê¸»úÎó¤ÎHTML¥¿¥°¤ò¥¨¥¹¥±¡¼¥×¤·¤ÆÊÖ¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub escapeHTML {\r
- my($retstr) = shift;\r
- my %table = (\r
- '&' => '&',\r
- '"' => '"',\r
- '<' => '<',\r
- '>' => '>',\r
- );\r
- $retstr =~ s/([&\"<>])/$table{$1}/go;\r
- return $retstr;\r
-}\r
-\r
-\r
-#===============================================================================\r
-# ÆüÉÕ¤ò¥Õ¥©¡¼¥Þ¥Ã¥È¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub format_date {\r
- my $t = shift;\r
- my ($sec, $min, $hour, $mday, $mon, $year) = localtime($t);\r
- return sprintf("%04dǯ%02d·î%02dÆü %02d»þ%02dʬ%02dÉÃ",\r
- $year+1900,$mon+1,$mday,$hour,$min,$sec);\r
-}\r
-\r
-#===============================================================================\r
-# ʸ»úÎó¤Îξü¤Î¶õÇò¤òÀÚ¤êÍî¤È¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub trim {\r
- my $text = shift;\r
- if(!defined($text)){\r
- return "";\r
- }\r
- $text =~ s/^(?:\s)+//o;\r
- $text =~ s/(?:\s)+$//o;\r
- return $text;\r
-}\r
-\r
-\r
-#===============================================================================\r
-# ¥¿¥°¤òºï½ü¤·¤Æʸ»úÎó¤Î¤ß¤ò¼èÆÀ¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub delete_tag {\r
- my $text = shift;\r
- $text =~ s/<(.|\s)+?>//g;\r
- return $text;\r
-}\r
-\r
-#===============================================================================\r
-# ¿ôÃͤ«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub check_numeric {\r
- my $text = shift;\r
- if($text =~ /^[0-9]+$/){\r
- return 1;\r
- } else {\r
- return 0;\r
- }\r
-}\r
-\r
-#===============================================================================\r
-# ¥¨¥é¡¼¤òÄÌÃÎ\r
-#===============================================================================\r
-sub error {\r
- my $error = shift;\r
- \r
- print "Content-Type: text/html;charset=EUC-JP\n\n";\r
- print "<html>\n";\r
- print "<head><title>¥¨¥é¡¼ - FSWikiLite</title></head>\n";\r
- print "<body>\n";\r
- print "<h1>¥¨¥é¡¼¤¬È¯À¸¤·¤Þ¤·¤¿</h1>\n";\r
- print "<pre>\n";\r
- print &Util::escapeHTML($error);\r
- print "</pre>\n";\r
- print "</body><html>\n";\r
- \r
- exit;\r
-}\r
-\r
-#===============================================================================\r
-# ·ÈÂÓÅÅÏ䫤ɤ¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£\r
-#===============================================================================\r
-sub handyphone {\r
- my $ua = $ENV{'HTTP_USER_AGENT'};\r
- if(!defined($ua)){\r
- return 0;\r
- }\r
- if($ua=~/^DoCoMo\// || $ua=~ /^J-PHONE\// || $ua=~ /UP\.Browser/){\r
- return 1;\r
- } else {\r
- return 0;\r
- }\r
-}\r
-\r
-#===============================================================================\r
-# ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤ò¥Ñ¡¼¥¹¤·¤Æ¥³¥Þ¥ó¥É¤È°ú¿ô¤Ëʬ³ä\r
-#===============================================================================\r
-sub parse_plugin {\r
- my $text = shift;\r
- my ($cmd,@args_tmp) = split(/ /,$text);\r
- my $args_txt = &Util::trim(join(" ",@args_tmp));\r
- \r
- my @ret_args;\r
- my $tmp = "";\r
- my $escape = 0;\r
- my $quote = 0;\r
- \r
- for(my $i=0;$i<length($args_txt);$i++){\r
- my $c = substr($args_txt,$i,1);\r
- \r
- if($quote!=1 && $c eq ","){\r
- if($tmp ne ""){\r
- push(@ret_args,$tmp);\r
- $tmp = "";\r
- $quote = 0;\r
- }\r
- } elsif($quote==1 && $c eq "\\"){\r
- if($escape==0){\r
- $escape = 1;\r
- } else {\r
- $tmp .= $c;\r
- $escape = 0;\r
- }\r
- } elsif($quote==0 && $c eq '"'){\r
- if($tmp eq ""){\r
- $quote = 1;\r
- } else {\r
- $tmp .= $c;\r
- }\r
- } elsif($quote==1 && $c eq '"'){\r
- if($escape==1){\r
- $tmp .= $c;\r
- $escape = 0;\r
- } else {\r
- $quote = 2;\r
- }\r
- } elsif($quote==2){\r
- return {error=>"¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤Î¹½Ê¸¤¬ÉÔÀµ¤Ç¤¹¡£"};\r
- } else {\r
- $tmp .= $c;\r
- }\r
- }\r
- \r
- if($tmp ne ""){\r
- push(@ret_args,$tmp);\r
- }\r
- \r
- return {command=>$cmd,args=>\@ret_args};\r
-}\r
-\r
-1;\r
+################################################################################
+#
+# FSWikiLite ¶¦ÄÌ´Ø¿ô¥Õ¥¡¥¤¥ë
+#
+################################################################################
+require "./lib/cgi-lib.pl";
+require "./lib/jcode.pl";
+require "./lib/mimew.pl";
+require "./lib/setup.pl";
+#-------------------------------------------------------------------------------
+# °ú¿ô¤ÇÅϤ·¤¿¥Ú¡¼¥¸¤ËÁ«°Ü
+#-------------------------------------------------------------------------------
+sub redirect {
+ my $page = shift;
+ my $url = "$MAIN_SCRIPT?p=".&Util::url_encode($page);
+ &redirectURL($url);
+}
+
+#-------------------------------------------------------------------------------
+# °ú¿ô¤ÇÅϤ·¤¿URL¤ËÁ«°Ü
+#-------------------------------------------------------------------------------
+sub redirectURL {
+ my $url = shift;
+
+ print "Content-Type: text/html;charset=EUC-JP\n";
+ print "Pragma: no-cache\n";
+ print "Cache-Control: no-cache\n\n";
+ print "<html>\n";
+ print " <head>\n";
+ print " <title>moving...</title>\n";
+ print " <meta http-equiv=\"Refresh\" content=\"0;URL=$url\">\n";
+ print " </head>\n";
+ print " <body>\n";
+ print " Wait or <a href=\"$url\">Click Here!!</a>\n";
+ print " </body>\n";
+ print "</html>\n";
+
+ exit;
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ø¥Ã¥À¤òɽ¼¨
+#-------------------------------------------------------------------------------
+sub print_header {
+ my $title = shift;
+ my $show = shift;
+
+ print "Content-Type: text/html;charset=EUC-JP\n";
+ print "Pragma: no-cache\n";
+ print "Cache-Control: no-cache\n\n";
+ print "<html>\n";
+ print "<head>\n";
+ print "<title>".&Util::escapeHTML($title)." - $SITE_TITLE</title>\n";
+ print "<link rel=\"stylesheet\" type=\"text/css\" href=\"$THEME_URL\">\n";
+ print "</head>\n";
+ print "<body>\n";
+
+ print "<div class=\"adminmenu\">\n";
+ print " <span class=\"adminmenu\">\n";
+ print " <a href=\"$MAIN_SCRIPT?p=FrontPage\">FrontPage</a>\n";
+ print " <a href=\"$EDIT_SCRIPT?a=new\">¿·µ¬</a>\n";
+ if($show==1){
+ print " <a href=\"$EDIT_SCRIPT?a=edit&p=".&Util::url_encode($in{"p"})."\">ÊÔ½¸</a>\n";
+ }
+ print " <a href=\"$MAIN_SCRIPT?a=search\">¸¡º÷</a>\n";
+ print " <a href=\"$MAIN_SCRIPT?a=list\">°ìÍ÷</a>\n";
+ print " <a href=\"$MAIN_SCRIPT?p=Help\">¥Ø¥ë¥×</a>\n";
+ print " </span>\n";
+ print "</div>\n";
+
+ print "<h1>".&Util::escapeHTML($title)."</h1>\n";
+ if(&Wiki::exists_page("Menu")){
+ print "<div class=\"main\">\n";
+ }
+
+}
+
+#-------------------------------------------------------------------------------
+# ¥Õ¥Ã¥¿¤òɽ¼¨
+#-------------------------------------------------------------------------------
+sub print_footer {
+ if(&Wiki::exists_page("Menu")){
+ print "</div>\n";
+ print "<div class=\"sidebar\">\n";
+ print &Wiki::process_wiki(&Wiki::get_page("Menu"));
+ print "</div>\n";
+ }
+ print "<div class=\"footer\">Powered by <a href=\"$main::SITE_URL\">FreeStyleWikiLite $main::VERSION</a></div>\n";
+ print "</body></html>\n";
+}
+
+###############################################################################
+#
+# Wiki´ØÏ¢¤Î´Ø¿ô¤òÄ󶡤¹¤ë¥Ñ¥Ã¥±¡¼¥¸
+#
+###############################################################################
+package Wiki;
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤ò¼èÆÀ
+#-------------------------------------------------------------------------------
+sub get_page {
+ my $page = &Util::url_encode(shift);
+
+ open(DATA,"$main::DATA_DIR/$page.wiki") or &Util::error("$main::DATA_DIR/$page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
+ my $content = "";
+ while(<DATA>){
+ $content .= $_;
+ }
+ close(DATA);
+
+ return $content;
+}
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤òÊݸ
+#-------------------------------------------------------------------------------
+sub save_page {
+ my $page = shift;
+ my $source = shift;
+
+ $page = &Util::trim($page);
+ $source =~ s/\r\n/\n/g;
+ $source =~ s/\r/\n/g;
+
+ my $enc_page = &Util::url_encode($page);
+ my $action = 'MODIFY';
+ unless(-e "$main::DATA_DIR/$enc_page.wiki"){
+ $action = 'CREATE';
+ }
+
+ # ¥Ð¥Ã¥¯¥¢¥Ã¥×¥Õ¥¡¥¤¥ë¤òºîÀ®
+ if(-e "$main::DATA_DIR/$enc_page.wiki"){
+ open(BACKUP,">$main::BACKUP_DIR/$enc_page.bak") or &Util::error("$main::BACKUP_DIR/$enc_page.bak¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
+ open(DATA ,"$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
+ while(<DATA>){
+ print BACKUP $_;
+ }
+ close(DATA);
+ close(BACKUP);
+ }
+
+ # ÆþÎÏÆâÍƤòÊݸ
+ open(DATA,">$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Î¥ª¡¼¥×¥ó¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
+ print DATA $source;
+ close(DATA);
+
+ &send_mail($action,$page);
+}
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤òºï½ü
+#-------------------------------------------------------------------------------
+sub remove_page {
+ my $page = shift;
+ my $enc_page = &Util::url_encode($page);
+ unlink("$main::DATA_DIR/$enc_page.wiki") or &Util::error("$main::DATA_DIR/$enc_page.wiki¤Îºï½ü¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£");
+
+ &send_mail('DELETE',$page);
+}
+#-------------------------------------------------------------------------------
+# ¥á¡¼¥ëÁ÷¿®
+#-------------------------------------------------------------------------------
+sub send_mail {
+ my $action = shift;
+ my $page = shift;
+ my $enc_page = &Util::url_encode($page);
+
+ if($main::ADMIN_MAIL eq "" || $main::SEND_MAIL eq ""){
+ return;
+ }
+
+ my $subject = "";
+ if($action eq 'CREATE'){
+ $subject = "[FSWikiLite]$page¤¬ºîÀ®¤µ¤ì¤Þ¤·¤¿";
+
+ } elsif($action eq 'MODIFY'){
+ $subject = "[FSWikiLite]$page¤¬¹¹¿·¤µ¤ì¤Þ¤·¤¿";
+
+ } elsif($action eq 'DELETE'){
+ $subject = "[FSWikiLite]$page¤¬ºï½ü¤µ¤ì¤Þ¤·¤¿";
+ }
+
+ # MIME¥¨¥ó¥³¡¼¥É
+ $subject = &main::mimeencode($subject);
+
+ my $head = "Subject: $subject\n".
+ "From: $main::ADMIN_MAIL\n".
+ "Content-Transfer-Encoding: 7bit\n".
+ "Content-Type: text/plain; charset=\"ISO-2022-JP\"\n".
+ "Reply-To: $main::ADMIN_MAIL\n".
+ "\n";
+
+ my $body = "IP:".$ENV{'REMOTE_ADDR'}."\n".
+ "UA:".$ENV{'HTTP_USER_AGENT'}."\n";
+
+ if($action eq 'MODIFY' || $action eq 'DELETE'){
+ if(-e "$main::BACKUP_DIR/$enc_page.bak"){
+ $body .= "°Ê²¼¤ÏÊѹ¹Á°¤Î¥½¡¼¥¹¤Ç¤¹¡£\n".
+ "-----------------------------------------------------\n";
+ open(BACKUP,"$main::BACKUP_DIR/$enc_page.bak");
+ while(my $line = <BACKUP>){
+ $body .= $line;
+ }
+ close(BACKUP);
+ }
+ }
+
+ # ʸ»ú¥³¡¼¥É¤ÎÊÑ´¹(jcode.pl¤ò»ÈÍѤ¹¤ë)
+ &jcode::convert(\$body,'jis');
+
+ open(MAIL,"| $main::SEND_MAIL $main::ADMIN_MAIL");
+ print MAIL $head;
+ print MAIL $body;
+ close(MAIL);
+}
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤Î°ìÍ÷¤ò¼èÆÀ
+#-------------------------------------------------------------------------------
+sub get_page_list {
+ opendir(DIR, $main::DATA_DIR);
+ my ($fileentry, @files);
+ while($fileentry = readdir(DIR)){
+ my $type = substr($fileentry,rindex($fileentry,"."));
+ if($type eq ".wiki"){
+ push(@files, "$main::DATA_DIR/$fileentry");
+ }
+ }
+ closedir(DIR);
+
+ my @pages;
+ foreach my $entry (@files){
+ my @stat = stat($entry);
+ my $time = $stat[9];
+
+ $entry = substr($entry,length($main::DATA_DIR)+1);
+ $entry =~ /(.+?)\.wiki/;
+ my $page = &Util::url_decode($1);
+ push(@pages,{NAME=>$page,TIME=>$time});
+ }
+
+ @pages = sort { $b->{TIME}<=>$a->{TIME} } @pages;
+ return @pages;
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤Î¹¹¿·Æü»þ¤ò¼èÆÀ
+#-------------------------------------------------------------------------------
+sub get_last_modified {
+ my $page = shift;
+ if(&exists_page($page)){
+ my $file = sprintf("%s/%s.wiki",$main::DATA_DIR,&Util::url_encode($page));
+ my @stat = stat($file);
+ return $stat[9];
+ } else {
+ return undef;
+ }
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤¬Â¸ºß¤¹¤ë¤«¤É¤¦¤«
+#-------------------------------------------------------------------------------
+sub exists_page {
+ my $page = &Util::url_encode(shift);
+ if(-e "$main::DATA_DIR/$page.wiki"){
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+#-------------------------------------------------------------------------------
+# Wiki¥½¡¼¥¹¤òÅϤ·¤ÆHTML¤ò¼èÆÀ¤·¤Þ¤¹
+#-------------------------------------------------------------------------------
+sub process_wiki {
+ my $source = shift;
+ my $main = shift;
+ my $parser = HTMLParser->new($main);
+ $parser->parse($source);
+
+ return $parser->{html};
+}
+
+###############################################################################
+#
+# HTML¥Ñ¡¼¥µ
+#
+###############################################################################
+package HTMLParser;
+#==============================================================================
+# ¥³¥ó¥¹¥È¥é¥¯¥¿
+#==============================================================================
+sub new {
+ my $class = shift;
+ my $mainflg = shift;
+ my $self = {};
+
+ if(!defined($mainflg) || $mainflg eq ""){ $mainflg = 0; }
+
+ $self->{html} = "";
+ $self->{pre} = "";
+ $self->{quote} = "";
+ $self->{table} = 0;
+ $self->{level} = 0;
+ $self->{para} = 0;
+ $self->{p_cnt} = 0;
+ $self->{explan} = 0;
+ $self->{main} = $mainflg;
+ return bless $self,$class;
+}
+
+#===============================================================================
+# ¥Ñ¡¼¥¹
+#===============================================================================
+sub parse {
+ my $self = shift;
+ my $source = shift;
+
+ $source =~ s/\r//g;
+ my @lines = split(/\n/,$source);
+
+ foreach my $line (@lines){
+ chomp $line;
+
+ # Ê£¿ô¹Ô¤ÎÀâÌÀ
+ $self->multi_explanation($line);
+
+ my $word1 = substr($line,0,1);
+ my $word2 = substr($line,0,2);
+ my $word3 = substr($line,0,3);
+
+ # ¶õ¹Ô
+ if($line eq ""){
+ $self->l_paragraph();
+ next;
+ }
+
+ # ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó
+ if($line =~ /^{{((.|\s)+?)}}$/){
+ my $plugin = &Util::parse_plugin($1);
+ my $class = $main::P_PLUGIN->{$plugin->{command}};
+ if(defined($class)){
+ $self->l_plugin($plugin);
+ } else {
+ my @obj = $self->parse_line($line);
+ $self->l_text(\@obj);
+ }
+ next;
+ }
+
+ # PRE
+ if($word1 eq " " || $word1 eq "\t"){
+ $self->l_verbatim($line);
+
+ # ¸«½Ð¤·
+ } elsif($word3 eq "!!!"){
+ my @obj = $self->parse_line(substr($line,3));
+ $self->l_headline(1,\@obj);
+
+ } elsif($word2 eq "!!"){
+ my @obj = $self->parse_line(substr($line,2));
+ $self->l_headline(2,\@obj);
+
+ } elsif($word1 eq "!"){
+ my @obj = $self->parse_line(substr($line,1));
+ $self->l_headline(3,\@obj);
+
+ # ¹àÌÜ
+ } elsif($word3 eq "***"){
+ my @obj = $self->parse_line(substr($line,3));
+ $self->l_list(3,\@obj);
+
+ } elsif($word2 eq "**"){
+ my @obj = $self->parse_line(substr($line,2));
+ $self->l_list(2,\@obj);
+
+ } elsif($word1 eq "*"){
+ my @obj = $self->parse_line(substr($line,1));
+ $self->l_list(1,\@obj);
+
+ # ÈÖ¹æÉÕ¤¹àÌÜ
+ } elsif($word3 eq "+++"){
+ my @obj = $self->parse_line(substr($line,3));
+ $self->l_numlist(3,\@obj);
+
+ } elsif($word2 eq "++"){
+ my @obj = $self->parse_line(substr($line,2));
+ $self->l_numlist(2,\@obj);
+
+ } elsif($word1 eq "+"){
+ my @obj = $self->parse_line(substr($line,1));
+ $self->l_numlist(1,\@obj);
+
+ # ¿åÊ¿Àþ
+ } elsif($line eq "----"){
+ $self->l_line();
+
+ # °úÍÑ
+ } elsif($word2 eq '""'){
+ my @obj = $self->parse_line(substr($line,2));
+ $self->l_quotation(\@obj);
+
+ # ÀâÌÀ
+ } elsif(index($line,":")==0 && index($line,":",1)!=-1){
+ if(index($line,":::")==0){
+ $self->{dd} .= substr($line,3);
+ next;
+ }
+ if(index($line,"::")==0){
+ if($self->{dt} ne "" || $self->{dd} ne ""){
+ $self->multi_explanation;
+ }
+ $self->{dt} = substr($line,2);
+ $self->{dl_flag} = 1;
+ next;
+ }
+ my $dt = substr($line,1,index($line,":",1)-1);
+ my $dd = substr($line,index($line,":",1)+1);
+ my @obj1 = $self->parse_line($dt);
+ my @obj2 = $self->parse_line($dd);
+ $self->l_explanation(\@obj1,\@obj2);
+
+ # ¥Æ¡¼¥Ö¥ë
+ } elsif($word1 eq ","){
+ if($line =~ /,$/){
+ $line .= " ";
+ }
+ my @spl = map {/^"(.*)"$/ ? scalar($_ = $1, s/\"\"/\"/g, $_) : $_}
+ ($line =~ /,\s*(\"[^\"]*(?:\"\"[^\"]*)*\"|[^,]*)/g);
+ my @array;
+ foreach my $value (@spl){
+ my @cell = $self->parse_line($value);
+ push @array,\@cell;
+ }
+ $self->l_table(\@array);
+
+ # ¥³¥á¥ó¥È
+ } elsif($word2 eq "//"){
+
+ # ²¿¤â¤Ê¤¤¹Ô
+ } else {
+ my @obj = $self->parse_line($line);
+ $self->l_text(\@obj);
+ }
+ }
+
+ # Ê£¿ô¹Ô¤ÎÀâÌÀ
+ $self->multi_explanation;
+
+ $self->end_parse;
+}
+
+#===============================================================================
+# Ê£¿ô¹Ô¤ÎÀâÌÀ
+#===============================================================================
+sub multi_explanation {
+ my $self = shift;
+ my $line = shift;
+ if($self->{dl_flag}==1 && (index($line,":")!=0 || !defined($line))){
+ my @obj1 = $self->parse_line($self->{dt});
+ my @obj2 = $self->parse_line($self->{dd});
+ $self->l_explanation(\@obj1,\@obj2);
+ $self->{dl_flag} = 0;
+ $self->{dt} = "";
+ $self->{dd} = "";
+ }
+}
+
+#===============================================================================
+# £±¹Ôʬ¤ò¥Ñ¡¼¥¹
+#===============================================================================
+sub parse_line {
+ my $self = shift;
+ my $source = shift;
+ my @array = ();
+
+ # ¥×¥é¥°¥¤¥ó
+ if($source =~ /{{((.|\s)+?)}}/){
+ my $pre = $`;
+ my $post = $';
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ my $plugin = &Util::parse_plugin($1);
+ my $class = $main::I_PLUGIN->{$plugin->{command}};
+ if(defined($class)){
+ push @array,$self->plugin($plugin);
+ } else {
+ push @array,$self->text("{{$1}}");
+ }
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ # ¥Ü¡¼¥ë¥É¡¢¥¤¥¿¥ê¥Ã¥¯¡¢¼è¤ê¾Ã¤·Àþ¡¢²¼Àþ
+ } elsif($source =~ /((''')|('')|(==)|(__))(.+?)(\1)/){
+ my $pre = $`;
+ my $post = $';
+ my $type = $1;
+ my $label = $6;
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ if($type eq "'''"){
+ push @array,$self->bold($label);
+ } elsif($type eq "__"){
+ push @array,$self->underline($label);
+ } elsif($type eq "''"){
+ push @array,$self->italic($label);
+ } elsif($type eq "=="){
+ push @array,$self->denialline($label);
+ }
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ # ¥Ú¡¼¥¸ÊÌ̾¥ê¥ó¥¯
+ } elsif($source =~ /\[\[([^\[]+?)\|(.+?)\]\]/){
+ my $pre = $`;
+ my $post = $';
+ my $label = $1;
+ my $page = $2;
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ push @array,$self->wiki_anchor($page,$label);
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ # URLÊÌ̾¥ê¥ó¥¯
+ } elsif($source =~ /\[([^\[]+?)\|((http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/
+ || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/
+ || $source =~ /\[([^\[]+?)\|((\/|\.\/|\.\.\/)+[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)\]/){
+ my $pre = $`;
+ my $post = $';
+ my $label = $1;
+ my $url = $2;
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
+ push @array,"<span class=\"error\">ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£</span>";
+ } else {
+ push @array,$self->url_anchor($url,$label);
+ }
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ # URL¥ê¥ó¥¯
+ } elsif($source =~ /(http|https|ftp|mailto):[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*/
+ || $source =~ /\[([^\[]+?)\|(file:[^\[\]]*)\]/){
+ my $pre = $`;
+ my $post = $';
+ my $url = $&;
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
+ push @array,"<span class=\"error\">ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£</span>";
+ } else {
+ push @array,$self->url_anchor($url);
+ }
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ # ¥Ú¡¼¥¸¥ê¥ó¥¯
+ } elsif($source =~ /\[\[([^\|]+?)\]\]/){
+ my $pre = $`;
+ my $post = $';
+ my $page = $1;
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ push @array,$self->wiki_anchor($page);
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ # Ǥ°Õ¤ÎURL¥ê¥ó¥¯
+ } elsif($source =~ /\[([^\[]+?)\|(.+?)\]/){
+ my $pre = $`;
+ my $post = $';
+ my $label = $1;
+ my $url = $2;
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ if(index($url,'"') >= 0 || index($url,'><') >= 0 || index($url, 'javascript:') >= 0){
+ push @array,"<span class=\"error\">ÉÔÀµ¤Ê¥ê¥ó¥¯¤Ç¤¹¡£</span>";
+ } else {
+ push @array,$self->url_anchor($url,$label);
+ }
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ # WikiName
+ } elsif($main::WIKI_NAME==1 && $source =~ /[A-Z]+?[a-z]+?([A-Z]+?[a-z]+)+/){
+ my $pre = $`;
+ my $post = $';
+ my $page = $&;
+ if($pre ne ""){ push(@array,$self->parse_line($pre)); }
+ push @array,$self->wiki_anchor($page);
+ if($post ne ""){ push(@array,$self->parse_line($post)); }
+
+ } else {
+ push @array,$self->text($source);
+ }
+
+ return @array;
+}
+
+#==============================================================================
+# ¥ê¥¹¥È
+#==============================================================================
+sub l_list {
+ my $self = shift;
+ my $level = shift;
+ my $obj = shift;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>\n";
+ $self->{para} = 0;
+ }
+
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ my $html = join("",@$obj);
+ my $plus = 1;
+
+ if($level < $self->{level}){ $plus = -1; }
+ if($level==$self->{level}){
+ $self->{html} .= "</li>\n";
+ }
+ while($level != $self->{level}){
+ if($plus==1){
+ $self->{html} .= "<ul>\n";
+ push(@{$self->{close_list}},"</ul>\n");
+ } else {
+ $self->{html} .= "</li>\n";
+ $self->{html} .= pop(@{$self->{close_list}});
+ }
+ $self->{level} += $plus;
+ }
+
+ $self->{html} .= "<li>".$html;
+}
+
+#==============================================================================
+# ÈÖ¹æÉÕ¤¥ê¥¹¥È
+#==============================================================================
+sub l_numlist {
+ my $self = shift;
+ my $level = shift;
+ my $obj = shift;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>\n";
+ $self->{para} = 0;
+ }
+
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ my $html = join("",@$obj);
+ my $plus = 1;
+
+ if($level < $self->{level}){ $plus = -1; }
+ if($level==$self->{level}){
+ $self->{html} .= "</li>\n";
+ }
+ while($level != $self->{level}){
+ if($plus==1){
+ $self->{html} .= "<ol>\n";
+ push(@{$self->{close_list}},"</ol>\n");
+ } else {
+ $self->{html} .= "</li>\n";
+ $self->{html} .= pop(@{$self->{close_list}});
+ }
+ $self->{level} += $plus;
+ }
+ $self->{html} .= "<li>".$html;
+}
+
+#==============================================================================
+# ¥ê¥¹¥È¤Î½ªÎ»
+#==============================================================================
+sub end_list {
+ my $self = shift;
+ if ($self->{level}!=0) {
+ $self->{html} .= "</li>\n";
+ while($self->{level}!=0){
+ $self->{html} .= pop(@{$self->{close_list}});
+ $self->{level} += -1;
+ }
+ }
+}
+
+#==============================================================================
+# ¥Ø¥Ã¥É¥é¥¤¥ó
+#==============================================================================
+sub l_headline {
+ my $self = shift;
+ my $level = shift;
+ my $obj = shift;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>\n";
+ $self->{para} = 0;
+ }
+
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ my $html = join("",@$obj);
+
+ if(!$self->{main}){
+ $self->{html} .= "<h".($level+1).">".$html."</h".($level+1).">\n";
+ } else {
+ if($level==2){
+ $self->{html} .= "<h".($level+1)."><a name=\"p".$self->{p_cnt}."\">".
+ "<span class=\"sanchor\">_</span></a>".$html."</h".($level+1).">\n";
+ } else {
+ $self->{html} .= "<h".($level+1).">".
+ "<a name=\"p".$self->{p_cnt}."\">".$html."</a>".
+ "</h".($level+1).">\n";
+ }
+ }
+ $self->{p_cnt}++;
+}
+
+#==============================================================================
+# ¿åÊ¿Àþ
+#==============================================================================
+sub l_line {
+ my $self = shift;
+
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ $self->{html} .= "<hr>\n";
+}
+
+#==============================================================================
+# ÃÊÍî¶èÀÚ¤ê
+#==============================================================================
+sub l_paragraph {
+ my $self = shift;
+
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>\n";
+ $self->{para} = 0;
+ }
+}
+
+#==============================================================================
+# À°·ÁºÑ¥Æ¥¥¹¥È
+#==============================================================================
+sub l_verbatim {
+ my $self = shift;
+ my $text = shift;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>\n";
+ $self->{para} = 0;
+ }
+
+ $self->end_list;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ $self->{pre} .= Util::escapeHTML($text)."\n";
+}
+
+sub end_verbatim {
+ my $self = shift;
+ if($self->{pre} ne ""){
+ $self->{html} .= "<pre>".$self->{pre}."</pre>";
+ $self->{pre} = "";
+ }
+}
+
+#==============================================================================
+# ¥Æ¡¼¥Ö¥ë
+#==============================================================================
+sub l_table {
+ my $self = shift;
+ my $row = shift;
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_quote;
+ $self->end_explan;
+
+ if($self->{table}==0){
+ $self->{table}=1;
+ $self->{html} .= "<table>\n";
+ $self->{html} .= "<tr>\n";
+ foreach(@$row){
+ my $html = join("",@$_);
+ $self->{html} .= "<th>".$html."</th>\n";
+ }
+ $self->{html} .= "</tr>\n";
+ } else {
+ $self->{table}=2;
+ $self->{html} .= "<tr>\n";
+ foreach(@$row){
+ my $html = join("",@$_);
+ $self->{html} .= "<td>".$html."</td>\n";
+ }
+ $self->{html} .= "</tr>\n";
+ }
+}
+
+sub end_table {
+ my $self = shift;
+ if($self->{table}!=0){
+ $self->{table} = 0;
+ $self->{html} .= "</table>\n";
+ }
+}
+
+#==============================================================================
+# ¥Ñ¡¼¥¹½ªÎ»»þ¤Î½èÍý
+#==============================================================================
+sub end_parse {
+ my $self = shift;
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>\n";
+ $self->{para} = 0;
+ }
+}
+
+#==============================================================================
+# ¹Ô½ñ¼°¤Ë³ºÅö¤·¤Ê¤¤¹Ô
+#==============================================================================
+sub l_text {
+ my $self = shift;
+ my $obj = shift;
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+ my $html = join("",@$obj);
+
+ if($self->{para}==0){
+ $self->{html} .= "<p>";
+ $self->{para} = 1;
+ }
+ $self->{html} .= $html;
+}
+
+#==============================================================================
+# °úÍÑ
+#==============================================================================
+sub l_quotation {
+ my $self = shift;
+ my $obj = shift;
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_explan;
+ my $html = join("",@$obj);
+ $self->{quote} .= "<p>".$html."</p>\n";
+}
+
+sub end_quote {
+ my $self = shift;
+ if($self->{quote} ne ""){
+ $self->{html} .= "<blockquote>".$self->{quote}."</blockquote>\n";
+ $self->{quote} = "";
+ }
+}
+
+#==============================================================================
+# ÀâÌÀ
+#==============================================================================
+sub l_explanation {
+ my $self = shift;
+ my $obj1 = shift;
+ my $obj2 = shift;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>";
+ $self->{para} = 0;
+ }
+
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+
+ if($self->{explan}==0){
+ $self->{explan}=1;
+ $self->{html} .= "<dl>\n";
+ }
+
+ my $html1 = join("",@$obj1);
+ my $html2 = join("",@$obj2);
+
+ $self->{html} .= "<dt>".$html1."</dt>\n<dd>".$html2."</dd>\n";
+}
+
+sub end_explan {
+ my $self = shift;
+ if($self->{explan}!=0){
+ $self->{explan} = 0;
+ $self->{html} .= "</dl>\n";
+ }
+}
+
+#==============================================================================
+# ¥Ü¡¼¥ë¥É
+#==============================================================================
+sub bold {
+ my $self = shift;
+ my $text = shift;
+ return "<strong>".join("",$self->parse_line($text))."</strong>";
+}
+
+#==============================================================================
+# ¥¤¥¿¥ê¥Ã¥¯
+#==============================================================================
+sub italic {
+ my $self = shift;
+ my $text = shift;
+ return "<em>".join("",$self->parse_line($text))."</em>";
+}
+
+#==============================================================================
+# ²¼Àþ
+#==============================================================================
+sub underline {
+ my $self = shift;
+ my $text = shift;
+ return "<ins>".join("",$self->parse_line($text))."</ins>";
+}
+
+#==============================================================================
+# ÂǤÁ¾Ã¤·Àþ
+#==============================================================================
+sub denialline {
+ my $self = shift;
+ my $text = shift;
+ return "<del>".join("",$self->parse_line($text))."</del>";
+}
+
+#==============================================================================
+# URL¥¢¥ó¥«
+#==============================================================================
+sub url_anchor {
+ my $self = shift;
+ my $url = shift;
+ my $name = shift;
+
+ if($name eq ""){
+ $name = $url;
+ }
+
+ if($url eq $name && $url=~/\.(gif|jpg|jpeg|bmp|png)$/i){
+ return "<img src=\"".$url."\">";
+ } else {
+ return "<a href=\"$url\">".Util::escapeHTML($name)."</a>";
+ }
+}
+
+#==============================================================================
+# Wiki¥Ú¡¼¥¸¤Ø¤Î¥¢¥ó¥«
+#==============================================================================
+sub wiki_anchor {
+ my $self = shift;
+ my $page = shift;
+ my $name = shift;
+
+ if(!defined($name) || $name eq ""){
+ $name = $page;
+ }
+
+ if(&Wiki::exists_page($page)){
+ return "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\" class=\"wikipage\">".
+ &Util::escapeHTML($name)."</a>";
+ } else {
+ return "<span class=\"nopage\">".&Util::escapeHTML($name)."</span>".
+ "<a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">?</a>";
+ }
+}
+
+#==============================================================================
+# ¤¿¤À¤Î¥Æ¥¥¹¥È
+#==============================================================================
+sub text {
+ my $self = shift;
+ my $text = shift;
+ return &Util::escapeHTML($text);
+}
+
+#==============================================================================
+# ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó
+#==============================================================================
+sub plugin {
+ my $self = shift;
+ my $plugin = shift;
+
+ my $func_ref = $main::I_PLUGIN->{$plugin->{command}};
+ my $result = &$func_ref(@{$plugin->{args}});
+ if(defined($result) && $result ne ""){
+ return ($result);
+ }
+
+ return undef;
+}
+
+#==============================================================================
+# ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó
+#==============================================================================
+sub l_plugin {
+ my $self = shift;
+ my $plugin = shift;
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>\n";
+ $self->{para} = 0;
+ }
+
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ my $func_ref = $main::P_PLUGIN->{$plugin->{command}};
+ my $result = &$func_ref(@{$plugin->{args}});
+ if(defined($result) && $result ne ""){
+ $self->{html} .= $result;
+ }
+}
+
+#==============================================================================
+# ¥¤¥á¡¼¥¸
+#==============================================================================
+sub l_image {
+ my $self = shift;
+ my $page = shift;
+ my $file = shift;
+ my $wiki = $self->{wiki};
+
+ if($self->{para}==1){
+ $self->{html} .= "</p>";
+ $self->{para} = 0;
+ }
+
+ $self->end_list;
+ $self->end_verbatim;
+ $self->end_table;
+ $self->end_quote;
+ $self->end_explan;
+
+ $self->{html} .= "<img src=\"".$wiki->config('script_name')."?action=ATTACH&".
+ "page=".&Util::url_encode($page)."&file=".&Util::url_encode($file)."\">";
+}
+
+
+################################################################################
+#
+# ¥æ¡¼¥Æ¥£¥ê¥Æ¥£´Ø¿ô¤òÄ󶡤¹¤ë¥Ñ¥Ã¥±¡¼¥¸
+#
+################################################################################
+package Util;
+#===============================================================================
+# °ú¿ô¤ÇÅϤµ¤ì¤¿Ê¸»úÎó¤òURL¥¨¥ó¥³¡¼¥É¤·¤ÆÊÖ¤·¤Þ¤¹¡£
+#===============================================================================
+sub url_encode {
+ my $retstr = shift;
+ $retstr =~ s/([^ 0-9A-Za-z])/sprintf("%%%.2X", ord($1))/eg;
+ $retstr =~ tr/ /+/;
+ return $retstr;
+}
+
+#===============================================================================
+# °ú¿ô¤ÇÅϤµ¤ì¤¿Ê¸»úÎó¤òURL¥Ç¥³¡¼¥É¤·¤ÆÊÖ¤·¤Þ¤¹¡£
+#===============================================================================
+sub url_decode{
+ my $retstr = shift;
+ $retstr =~ tr/+/ /;
+ $retstr =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
+ return $retstr;
+}
+
+#===============================================================================
+# °ú¿ô¤ÇÅϤµ¤ì¤¿Ê¸»úÎó¤ÎHTML¥¿¥°¤ò¥¨¥¹¥±¡¼¥×¤·¤ÆÊÖ¤·¤Þ¤¹¡£
+#===============================================================================
+sub escapeHTML {
+ my($retstr) = shift;
+ my %table = (
+ '&' => '&',
+ '"' => '"',
+ '<' => '<',
+ '>' => '>',
+ );
+ $retstr =~ s/([&\"<>])/$table{$1}/go;
+ return $retstr;
+}
+
+
+#===============================================================================
+# ÆüÉÕ¤ò¥Õ¥©¡¼¥Þ¥Ã¥È¤·¤Þ¤¹¡£
+#===============================================================================
+sub format_date {
+ my $t = shift;
+ my ($sec, $min, $hour, $mday, $mon, $year) = localtime($t);
+ return sprintf("%04dǯ%02d·î%02dÆü %02d»þ%02dʬ%02dÉÃ",
+ $year+1900,$mon+1,$mday,$hour,$min,$sec);
+}
+
+#===============================================================================
+# ʸ»úÎó¤Îξü¤Î¶õÇò¤òÀÚ¤êÍî¤È¤·¤Þ¤¹¡£
+#===============================================================================
+sub trim {
+ my $text = shift;
+ if(!defined($text)){
+ return "";
+ }
+ $text =~ s/^(?:\s)+//o;
+ $text =~ s/(?:\s)+$//o;
+ return $text;
+}
+
+
+#===============================================================================
+# ¥¿¥°¤òºï½ü¤·¤Æʸ»úÎó¤Î¤ß¤ò¼èÆÀ¤·¤Þ¤¹¡£
+#===============================================================================
+sub delete_tag {
+ my $text = shift;
+ $text =~ s/<(.|\s)+?>//g;
+ return $text;
+}
+
+#===============================================================================
+# ¿ôÃͤ«¤É¤¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£
+#===============================================================================
+sub check_numeric {
+ my $text = shift;
+ if($text =~ /^[0-9]+$/){
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+#===============================================================================
+# ¥¨¥é¡¼¤òÄÌÃÎ
+#===============================================================================
+sub error {
+ my $error = shift;
+
+ print "Content-Type: text/html;charset=EUC-JP\n\n";
+ print "<html>\n";
+ print "<head><title>¥¨¥é¡¼ - FSWikiLite</title></head>\n";
+ print "<body>\n";
+ print "<h1>¥¨¥é¡¼¤¬È¯À¸¤·¤Þ¤·¤¿</h1>\n";
+ print "<pre>\n";
+ print &Util::escapeHTML($error);
+ print "</pre>\n";
+ print "</body><html>\n";
+
+ exit;
+}
+
+#===============================================================================
+# ·ÈÂÓÅÅÏ䫤ɤ¦¤«¥Á¥§¥Ã¥¯¤·¤Þ¤¹¡£
+#===============================================================================
+sub handyphone {
+ my $ua = $ENV{'HTTP_USER_AGENT'};
+ if(!defined($ua)){
+ return 0;
+ }
+ if($ua=~/^DoCoMo\// || $ua=~ /^J-PHONE\// || $ua=~ /UP\.Browser/){
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+#===============================================================================
+# ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤ò¥Ñ¡¼¥¹¤·¤Æ¥³¥Þ¥ó¥É¤È°ú¿ô¤Ëʬ³ä
+#===============================================================================
+sub parse_plugin {
+ my $text = shift;
+ my ($cmd,@args_tmp) = split(/ /,$text);
+ my $args_txt = &Util::trim(join(" ",@args_tmp));
+
+ my @ret_args;
+ my $tmp = "";
+ my $escape = 0;
+ my $quote = 0;
+
+ for(my $i=0;$i<length($args_txt);$i++){
+ my $c = substr($args_txt,$i,1);
+
+ if($quote!=1 && $c eq ","){
+ if($tmp ne ""){
+ push(@ret_args,$tmp);
+ $tmp = "";
+ $quote = 0;
+ }
+ } elsif($quote==1 && $c eq "\\"){
+ if($escape==0){
+ $escape = 1;
+ } else {
+ $tmp .= $c;
+ $escape = 0;
+ }
+ } elsif($quote==0 && $c eq '"'){
+ if($tmp eq ""){
+ $quote = 1;
+ } else {
+ $tmp .= $c;
+ }
+ } elsif($quote==1 && $c eq '"'){
+ if($escape==1){
+ $tmp .= $c;
+ $escape = 0;
+ } else {
+ $quote = 2;
+ }
+ } elsif($quote==2){
+ return {error=>"¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤Î¹½Ê¸¤¬ÉÔÀµ¤Ç¤¹¡£"};
+ } else {
+ $tmp .= $c;
+ }
+ }
+
+ if($tmp ne ""){
+ push(@ret_args,$tmp);
+ }
+
+ return {command=>$cmd,args=>\@ret_args};
+}
+
+1;
-package jcode;\r
-;######################################################################\r
-;#\r
-;# jcode.pl: Perl library for Japanese character code conversion\r
-;#\r
-;# Copyright (c) 1995-1999 Kazumasa Utashiro <utashiro@iij.ad.jp>\r
-;# Internet Initiative Japan Inc.\r
-;# 3-13 Kanda Nishiki-cho, Chiyoda-ku, Tokyo 101-0054, Japan\r
-;#\r
-;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro\r
-;# Software Research Associates, Inc.\r
-;#\r
-;# Use and redistribution for ANY PURPOSE are granted as long as all\r
-;# copyright notices are retained. Redistribution with modification\r
-;# is allowed provided that you make your modified version obviously\r
-;# distinguishable from the original one. THIS SOFTWARE IS PROVIDED\r
-;# BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE\r
-;# DISCLAIMED.\r
-;#\r
-;# Original version was developed under the name of srekcah@sra.co.jp\r
-;# February 1992 and it was called kconv.pl at the beginning. This\r
-;# address was a pen name for group of individuals and it is no longer\r
-;# valid.\r
-;#\r
-;# The latest version is available here:\r
-;#\r
-;# ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/\r
-;#\r
-;; $rcsid = q$Id: jcode.pl,v 1.1 2003/09/18 15:35:28 takezoe Exp $;\r
-;#\r
-;######################################################################\r
-;#\r
-;# PERL4 INTERFACE:\r
-;#\r
-;# &jcode'getcode(*line)\r
-;# Return 'jis', 'sjis', 'euc' or undef according to\r
-;# Japanese character code in $line. Return 'binary' if\r
-;# the data has non-character code.\r
-;#\r
-;# When evaluated in array context, it returns a list\r
-;# contains two items. First value is the number of\r
-;# characters which matched to the expected code, and\r
-;# second value is the code name. It is useful if and\r
-;# only if the number is not 0 and the code is undef;\r
-;# that case means it couldn't tell 'euc' or 'sjis'\r
-;# because the evaluation score was exactly same. This\r
-;# interface is too tricky, though.\r
-;#\r
-;# Code detection between euc and sjis is very difficult\r
-;# or sometimes impossible or even lead to wrong result\r
-;# when it includes JIS X0201 KANA characters. So JIS\r
-;# X0201 KANA is ignored for automatic code detection.\r
-;#\r
-;# &jcode'convert(*line, $ocode [, $icode [, $option]])\r
-;# Convert the contents of $line to the specified\r
-;# Japanese code given in the second argument $ocode.\r
-;# $ocode can be any of "jis", "sjis" or "euc", or use\r
-;# "noconv" when you don't want the code conversion.\r
-;# Input code is recognized automatically from the line\r
-;# itself when $icode is not supplied (JIS X0201 KANA is\r
-;# ignored in code detection. See the above descripton\r
-;# of &getcode). $icode also can be specified, but\r
-;# xxx2yyy routine is more efficient when both codes are\r
-;# known.\r
-;#\r
-;# It returns the code of input string in scalar context,\r
-;# and a list of pointer of convert subroutine and the\r
-;# input code in array context.\r
-;#\r
-;# Japanese character code JIS X0201, X0208, X0212 and\r
-;# ASCII code are supported. X0212 characters can not be\r
-;# represented in SJIS and they will be replased by\r
-;# "geta" character when converted to SJIS.\r
-;#\r
-;# See next paragraph for $option parameter.\r
-;#\r
-;# &jcode'xxx2yyy(*line [, $option])\r
-;# Convert the Japanese code from xxx to yyy. String xxx\r
-;# and yyy are any convination from "jis", "euc" or\r
-;# "sjis". They return *approximate* number of converted\r
-;# bytes. So return value 0 means the line was not\r
-;# converted at all.\r
-;#\r
-;# Optional parameter $option is used to specify optional\r
-;# conversion method. String "z" is for JIS X0201 KANA\r
-;# to X0208 KANA, and "h" is for reverse.\r
-;#\r
-;# $jcode'convf{'xxx', 'yyy'}\r
-;# The value of this associative array is pointer to the\r
-;# subroutine jcode'xxx2yyy().\r
-;#\r
-;# &jcode'to($ocode, $line [, $icode [, $option]])\r
-;# &jcode'jis($line [, $icode [, $option]])\r
-;# &jcode'euc($line [, $icode [, $option]])\r
-;# &jcode'sjis($line [, $icode [, $option]])\r
-;# These functions are prepared for easy use of\r
-;# call/return-by-value interface. You can use these\r
-;# funcitons in s///e operation or any other place for\r
-;# convenience.\r
-;#\r
-;# &jcode'jis_inout($in, $out)\r
-;# Set or inquire JIS start and end sequences. Default\r
-;# is "ESC-$-B" and "ESC-(-B". If you supplied only one\r
-;# character, "ESC-$" or "ESC-(" is prepended for each\r
-;# character respectively. Acutually "ESC-(-B" is not a\r
-;# sequence to end JIS code but a sequence to start ASCII\r
-;# code set. So `in' and `out' are somewhat misleading.\r
-;#\r
-;# &jcode'get_inout($string)\r
-;# Get JIS start and end sequences from $string.\r
-;#\r
-;# &jcode'cache()\r
-;# &jcode'nocache()\r
-;# &jcode'flush()\r
-;# Usually, converted character is cached in memory to\r
-;# avoid same calculations have to be done many times.\r
-;# To disable this caching, call &jcode'nocache(). It\r
-;# can be revived by &jcode'cache() and cache is flushed\r
-;# by calling &jcode'flush(). &cache() and &nocache()\r
-;# functions return previous caching state.\r
-;#\r
-;# ---------------------------------------------------------------\r
-;#\r
-;# &jcode'h2z_xxx(*line)\r
-;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA\r
-;# (Zenkaku-KANA) code conversion routine. String xxx is\r
-;# any of "jis", "sjis" and "euc". From the difficulty\r
-;# of recognizing code set from 1-byte KATAKANA string,\r
-;# automatic code recognition is not supported.\r
-;#\r
-;# &jcode'z2h_xxx(*line)\r
-;# X0208 to X0201 KANA code conversion routine. String\r
-;# xxx is any of "jis", "sjis" and "euc".\r
-;#\r
-;# $jcode'z2hf{'xxx'}\r
-;# $jcode'h2zf{'xxx'}\r
-;# These are pointer to the corresponding function just\r
-;# as $jcode'convf.\r
-;#\r
-;# ---------------------------------------------------------------\r
-;#\r
-;# &jcode'tr(*line, $from, $to [, $option])\r
-;# &jcode'tr emulates tr operator for 2 byte code. Only 'd'\r
-;# is interpreted as an option.\r
-;#\r
-;# Range operator like `A-Z' for 2 byte code is partially\r
-;# supported. Code must be JIS or EUC, and first byte\r
-;# have to be same on first and last character.\r
-;#\r
-;# CAUTION: Handling range operator is a kind of trick\r
-;# and it is not perfect. So if you need to transfer `-' \r
-;# character, please be sure to put it at the beginning\r
-;# or the end of $from and $to strings.\r
-;#\r
-;# &jcode'trans($line, $from, $to [, $option)\r
-;# Same as &jcode'tr but accept string and return string\r
-;# after translation.\r
-;#\r
-;# ---------------------------------------------------------------\r
-;#\r
-;# &jcode'init()\r
-;# Initialize the variables used in this package. You\r
-;# don't have to call this when using jocde.pl by `do' or\r
-;# `require' interface. Call it first if you embedded\r
-;# the jcode.pl at the end of your script.\r
-;#\r
-;######################################################################\r
-;#\r
-;# PERL5 INTERFACE:\r
-;#\r
-;# Current jcode.pl is written in Perl 4 but it is possible to use\r
-;# from Perl 5 using `references'. Fully perl5 capable version is\r
-;# future issue.\r
-;#\r
-;# Since lexical variable is not a subject of typeglob, *string style\r
-;# call doesn't work if the variable is declared as `my'. Same thing\r
-;# happens to special variable $_ if the perl is compiled to use\r
-;# thread capability. So using reference is generally recommented to\r
-;# avoid the mysterious error.\r
-;#\r
-;# jcode::getcode(\$line)\r
-;# jcode::convert(\$line, $ocode [, $icode [, $option]])\r
-;# jcode::xxx2yyy(\$line [, $option])\r
-;# &{$jcode::convf{'xxx', 'yyy'}}(\$line)\r
-;# jcode::to($ocode, $line [, $icode [, $option]])\r
-;# jcode::jis($line [, $icode [, $option]])\r
-;# jcode::euc($line [, $icode [, $option]])\r
-;# jcode::sjis($line [, $icode [, $option]])\r
-;# jcode::jis_inout($in, $out)\r
-;# jcode::get_inout($string)\r
-;# jcode::cache()\r
-;# jcode::nocache()\r
-;# jcode::flush()\r
-;# jcode::h2z_xxx(\$line)\r
-;# jcode::z2h_xxx(\$line)\r
-;# &{$jcode::z2hf{'xxx'}}(\$line)\r
-;# &{$jcode::h2zf{'xxx'}}(\$line)\r
-;# jcode::tr(\$line, $from, $to [, $option])\r
-;# jcode::trans($line, $from, $to [, $option)\r
-;# jcode::init()\r
-;#\r
-;######################################################################\r
-;#\r
-;# SAMPLES\r
-;#\r
-;# Convert any Kanji code to JIS and print each line with code name.\r
-;#\r
-;# while (defined($s = <>)) {\r
-;# $code = &jcode'convert(*s, 'jis');\r
-;# print $code, "\t", $s;\r
-;# }\r
-;# \r
-;# Convert all lines to JIS according to the first recognized line.\r
-;#\r
-;# while (defined($s = <>)) {\r
-;# print, next unless $s =~ /[\033\200-\377]/;\r
-;# (*f, $icode) = &jcode'convert(*s, 'jis');\r
-;# print;\r
-;# defined(&f) || next;\r
-;# while (<>) { &f(*s); print; }\r
-;# last;\r
-;# }\r
-;#\r
-;# The safest way of JIS conversion.\r
-;#\r
-;# while (defined($s = <>)) {\r
-;# ($matched, $icode) = &jcode'getcode(*s);\r
-;# if (@buf == 0 && $matched == 0) {\r
-;# print $s;\r
-;# next;\r
-;# }\r
-;# push(@buf, $s);\r
-;# next unless $icode;\r
-;# while (defined($s = shift(@buf))) {\r
-;# &jcode'convert(*s, 'jis', $icode);\r
-;# print $s;\r
-;# }\r
-;# while (defined($s = <>)) {\r
-;# &jcode'convert(*s, 'jis', $icode);\r
-;# print $s;\r
-;# }\r
-;# last;\r
-;# }\r
-;# print @buf if @buf;\r
-;# \r
-;######################################################################\r
-\r
-;#\r
-;# Call initialize function if it is not called yet. This may sound\r
-;# strange but it makes easy to embed the jcode.pl at the end of\r
-;# script. Call &jcode'init at the beginning of the script in that\r
-;# case.\r
-;#\r
-&init unless defined $version;\r
-\r
-;#\r
-;# Initialize variables.\r
-;#\r
-sub init {\r
- $version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';\r
-\r
- $re_bin = '[\000-\006\177\377]';\r
-\r
- $re_jis0208_1978 = '\e\$\@';\r
- $re_jis0208_1983 = '\e\$B';\r
- $re_jis0208_1990 = '\e&\@\e\$B';\r
- $re_jis0208 = "$re_jis0208_1978|$re_jis0208_1983|$re_jis0208_1990";\r
- $re_jis0212 = '\e\$\(D';\r
- $re_jp = "$re_jis0208|$re_jis0212";\r
- $re_asc = '\e\([BJ]';\r
- $re_kana = '\e\(I';\r
-\r
- $esc_0208 = "\e\$B";\r
- $esc_0212 = "\e\$(D";\r
- $esc_asc = "\e(B";\r
- $esc_kana = "\e(I";\r
-\r
- $re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';\r
- $re_sjis_kana = '[\241-\337]';\r
-\r
- $re_euc_c = '[\241-\376][\241-\376]';\r
- $re_euc_kana = '\216[\241-\337]';\r
- $re_euc_0212 = '\217[\241-\376][\241-\376]';\r
-\r
- # Use `geta' for undefined character code\r
- $undef_sjis = "\x81\xac";\r
-\r
- $cache = 1;\r
-\r
- # X0201 -> X0208 KANA conversion table. Looks weird? Not that\r
- # much. This is simply JIS text without escape sequences.\r
- ($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\041-\176/\241-\376/;\r
-! !# $ !" % !& " !V # !W\r
-^ !+ _ !, 0 !<\r
-' %! ( %# ) %% * %' + %)\r
-, %c - %e . %g / %C\r
-1 %" 2 %$ 3 %& 4 %( 5 %*\r
-6 %+ 7 %- 8 %/ 9 %1 : %3\r
-6^ %, 7^ %. 8^ %0 9^ %2 :^ %4\r
-; %5 < %7 = %9 > %; ? %=\r
-;^ %6 <^ %8 =^ %: >^ %< ?^ %>\r
-@ %? A %A B %D C %F D %H\r
-@^ %@ A^ %B B^ %E C^ %G D^ %I\r
-E %J F %K G %L H %M I %N\r
-J %O K %R L %U M %X N %[\r
-J^ %P K^ %S L^ %V M^ %Y N^ %\\r
-J_ %Q K_ %T L_ %W M_ %Z N_ %]\r
-O %^ P %_ Q %` R %a S %b\r
-T %d U %f V %h\r
-W %i X %j Y %k Z %l [ %m\r
-\ %o ] %s & %r 3^ %t\r
-__TABLE_END__\r
- %h2z = split(/\s+/, $h2z . $h2z_high);\r
- %z2h = reverse %h2z;\r
-\r
- $convf{'jis' , 'jis' } = *jis2jis;\r
- $convf{'jis' , 'sjis'} = *jis2sjis;\r
- $convf{'jis' , 'euc' } = *jis2euc;\r
- $convf{'euc' , 'jis' } = *euc2jis;\r
- $convf{'euc' , 'sjis'} = *euc2sjis;\r
- $convf{'euc' , 'euc' } = *euc2euc;\r
- $convf{'sjis' , 'jis' } = *sjis2jis;\r
- $convf{'sjis' , 'sjis'} = *sjis2sjis;\r
- $convf{'sjis' , 'euc' } = *sjis2euc;\r
- $h2zf{'jis' } = *h2z_jis;\r
- $z2hf{'jis' } = *z2h_jis;\r
- $h2zf{'euc' } = *h2z_euc;\r
- $z2hf{'euc' } = *z2h_euc;\r
- $h2zf{'sjis'} = *h2z_sjis;\r
- $z2hf{'sjis'} = *z2h_sjis;\r
-}\r
-\r
-;#\r
-;# Set escape sequences which should be put before and after Japanese\r
-;# (JIS X0208) string.\r
-;#\r
-sub jis_inout {\r
- $esc_0208 = shift || $esc_0208;\r
- $esc_0208 = "\e\$$esc_0208" if length($esc_0208) == 1;\r
- $esc_asc = shift || $esc_asc;\r
- $esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;\r
- ($esc_0208, $esc_asc);\r
-}\r
-\r
-;#\r
-;# Get JIS in and out sequences from the string.\r
-;#\r
-sub get_inout {\r
- local($esc_0208, $esc_asc);\r
- $_[$[] =~ /($re_jis0208)/o && ($esc_0208 = $1);\r
- $_[$[] =~ /($re_asc)/o && ($esc_asc = $1);\r
- ($esc_0208, $esc_asc);\r
-}\r
-\r
-;#\r
-;# Recognize character code.\r
-;#\r
-sub getcode {\r
- local(*s) = @_;\r
- local($matched, $code);\r
-\r
- if ($s !~ /[\e\200-\377]/) { # not Japanese\r
- $matched = 0;\r
- $code = undef;\r
- } # 'jis'\r
- elsif ($s =~ /$re_jp|$re_asc|$re_kana/o) {\r
- $matched = 1;\r
- $code = 'jis';\r
- }\r
- elsif ($s =~ /$re_bin/o) { # 'binary'\r
- $matched = 0;\r
- $code = 'binary';\r
- }\r
- else { # should be 'euc' or 'sjis'\r
- local($sjis, $euc) = (0, 0);\r
-\r
- while ($s =~ /(($re_sjis_c)+)/go) {\r
- $sjis += length($1);\r
- }\r
- while ($s =~ /(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/go) {\r
- $euc += length($1);\r
- }\r
- $matched = &max($sjis, $euc);\r
- $code = ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1];\r
- }\r
- wantarray ? ($matched, $code) : $code;\r
-}\r
-sub max { $_[ $[ + ($_[ $[ ] < $_[ $[ + 1 ]) ]; }\r
-\r
-;#\r
-;# Convert any code to specified code.\r
-;#\r
-sub convert {\r
- local(*s, $ocode, $icode, $opt) = @_;\r
- return (undef, undef) unless $icode = $icode || &getcode(*s);\r
- return (undef, $icode) if $icode eq 'binary';\r
- $ocode = 'jis' unless $ocode;\r
- $ocode = $icode if $ocode eq 'noconv';\r
- local(*f) = $convf{$icode, $ocode};\r
- &f(*s, $opt);\r
- wantarray ? (*f, $icode) : $icode;\r
-}\r
-\r
-;#\r
-;# Easy return-by-value interfaces.\r
-;#\r
-sub jis { &to('jis', @_); }\r
-sub euc { &to('euc', @_); }\r
-sub sjis { &to('sjis', @_); }\r
-sub to {\r
- local($ocode, $s, $icode, $opt) = @_;\r
- &convert(*s, $ocode, $icode, $opt);\r
- $s;\r
-}\r
-sub what {\r
- local($s) = @_;\r
- &getcode(*s);\r
-}\r
-sub trans {\r
- local($s) = shift;\r
- &tr(*s, @_);\r
- $s;\r
-}\r
-\r
-;#\r
-;# SJIS to JIS\r
-;#\r
-sub sjis2jis {\r
- local(*s, $opt, $n) = @_;\r
- &sjis2sjis(*s, $opt) if $opt;\r
- $s =~ s/(($re_sjis_c|$re_sjis_kana)+)/&_sjis2jis($1) . $esc_asc/geo;\r
- $n;\r
-}\r
-sub _sjis2jis {\r
- local($s) = shift;\r
- $s =~ s/(($re_sjis_c)+|($re_sjis_kana)+)/&__sjis2jis($1)/geo;\r
- $s;\r
-}\r
-sub __sjis2jis {\r
- local($s) = shift;\r
- if ($s =~ /^$re_sjis_kana/o) {\r
- $n += $s =~ tr/\241-\337/\041-\137/;\r
- $esc_kana . $s;\r
- } else {\r
- $n += $s =~ s/($re_sjis_c)/$s2e{$1}||&s2e($1)/geo;\r
- $s =~ tr/\241-\376/\041-\176/;\r
- $esc_0208 . $s;\r
- }\r
-}\r
-\r
-;#\r
-;# EUC to JIS\r
-;#\r
-sub euc2jis {\r
- local(*s, $opt, $n) = @_;\r
- &euc2euc(*s, $opt) if $opt;\r
- $s =~ s/(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/\r
- &_euc2jis($1) . $esc_asc\r
- /geo;\r
- $n;\r
-}\r
-sub _euc2jis {\r
- local($s) = shift;\r
- $s =~ s/(($re_euc_c)+|($re_euc_kana)+|($re_euc_0212)+)/&__euc2jis($1)/geo;\r
- $s;\r
-}\r
-sub __euc2jis {\r
- local($s) = shift;\r
- local($esc);\r
-\r
- if ($s =~ tr/\216//d) {\r
- $esc = $esc_kana;\r
- } elsif ($s =~ tr/\217//d) {\r
- $esc = $esc_0212;\r
- } else {\r
- $esc = $esc_0208;\r
- }\r
-\r
- $n += $s =~ tr/\241-\376/\041-\176/;\r
- $esc . $s;\r
-}\r
-\r
-;#\r
-;# JIS to EUC\r
-;#\r
-sub jis2euc {\r
- local(*s, $opt, $n) = @_;\r
- $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;\r
- &euc2euc(*s, $opt) if $opt;\r
- $n;\r
-}\r
-sub _jis2euc {\r
- local($esc, $s) = @_;\r
- if ($esc !~ /^$re_asc/o) {\r
- $n += $s =~ tr/\041-\176/\241-\376/;\r
- if ($esc =~ /^$re_kana/o) {\r
- $s =~ s/([\241-\337])/\216$1/g;\r
- }\r
- elsif ($esc =~ /^$re_jis0212/o) {\r
- $s =~ s/([\241-\376][\241-\376])/\217$1/g;\r
- }\r
- }\r
- $s;\r
-}\r
-\r
-;#\r
-;# JIS to SJIS\r
-;#\r
-sub jis2sjis {\r
- local(*s, $opt, $n) = @_;\r
- &jis2jis(*s, $opt) if $opt;\r
- $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;\r
- $n;\r
-}\r
-sub _jis2sjis {\r
- local($esc, $s) = @_;\r
- if ($esc =~ /^$re_jis0212/o) {\r
- $s =~ s/../$undef_sjis/g;\r
- $n = length;\r
- }\r
- elsif ($esc !~ /^$re_asc/o) {\r
- $n += $s =~ tr/\041-\176/\241-\376/;\r
- if ($esc =~ /^$re_jp/o) {\r
- $s =~ s/($re_euc_c)/$e2s{$1}||&e2s($1)/geo;\r
- }\r
- }\r
- $s;\r
-}\r
-\r
-;#\r
-;# SJIS to EUC\r
-;#\r
-sub sjis2euc {\r
- local(*s, $opt,$n) = @_;\r
- $n = $s =~ s/($re_sjis_c|$re_sjis_kana)/$s2e{$1}||&s2e($1)/geo;\r
- &euc2euc(*s, $opt) if $opt;\r
- $n;\r
-}\r
-sub s2e {\r
- local($c1, $c2, $code);\r
- ($c1, $c2) = unpack('CC', $code = shift);\r
-\r
- if (0xa1 <= $c1 && $c1 <= 0xdf) {\r
- $c2 = $c1;\r
- $c1 = 0x8e;\r
- } elsif (0x9f <= $c2) {\r
- $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);\r
- $c2 += 2;\r
- } else {\r
- $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);\r
- $c2 += 0x60 + ($c2 < 0x7f);\r
- }\r
- if ($cache) {\r
- $s2e{$code} = pack('CC', $c1, $c2);\r
- } else {\r
- pack('CC', $c1, $c2);\r
- }\r
-}\r
-\r
-;#\r
-;# EUC to SJIS\r
-;#\r
-sub euc2sjis {\r
- local(*s, $opt,$n) = @_;\r
- &euc2euc(*s, $opt) if $opt;\r
- $n = $s =~ s/($re_euc_c|$re_euc_kana|$re_euc_0212)/$e2s{$1}||&e2s($1)/geo;\r
-}\r
-sub e2s {\r
- local($c1, $c2, $code);\r
- ($c1, $c2) = unpack('CC', $code = shift);\r
-\r
- if ($c1 == 0x8e) { # SS2\r
- return substr($code, 1, 1);\r
- } elsif ($c1 == 0x8f) { # SS3\r
- return $undef_sjis;\r
- } elsif ($c1 % 2) {\r
- $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);\r
- $c2 -= 0x60 + ($c2 < 0xe0);\r
- } else {\r
- $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);\r
- $c2 -= 2;\r
- }\r
- if ($cache) {\r
- $e2s{$code} = pack('CC', $c1, $c2);\r
- } else {\r
- pack('CC', $c1, $c2);\r
- }\r
-}\r
-\r
-;#\r
-;# JIS to JIS, SJIS to SJIS, EUC to EUC\r
-;#\r
-sub jis2jis {\r
- local(*s, $opt) = @_;\r
- $s =~ s/$re_jis0208/$esc_0208/go;\r
- $s =~ s/$re_asc/$esc_asc/go;\r
- &h2z_jis(*s) if $opt =~ /z/;\r
- &z2h_jis(*s) if $opt =~ /h/;\r
-}\r
-sub sjis2sjis {\r
- local(*s, $opt) = @_;\r
- &h2z_sjis(*s) if $opt =~ /z/;\r
- &z2h_sjis(*s) if $opt =~ /h/;\r
-}\r
-sub euc2euc {\r
- local(*s, $opt) = @_;\r
- &h2z_euc(*s) if $opt =~ /z/;\r
- &z2h_euc(*s) if $opt =~ /h/;\r
-}\r
-\r
-;#\r
-;# Cache control functions\r
-;#\r
-sub cache {\r
- ($cache, $cache = 1)[$[];\r
-}\r
-sub nocache {\r
- ($cache, $cache = 0)[$[];\r
-}\r
-sub flushcache {\r
- undef %e2s;\r
- undef %s2e;\r
-}\r
-\r
-;#\r
-;# X0201 -> X0208 KANA conversion routine\r
-;#\r
-sub h2z_jis {\r
- local(*s, $n) = @_;\r
- if ($s =~ s/$re_kana([^\e]*)/$esc_0208 . &_h2z_jis($1)/geo) {\r
- 1 while $s =~ s/(($re_jis0208)[^\e]*)($re_jis0208)/$1/o;\r
- }\r
- $n;\r
-}\r
-sub _h2z_jis {\r
- local($s) = @_;\r
- $n += $s =~ s/([\41-\137]([\136\137])?)/$h2z{$1}/g;\r
- $s;\r
-}\r
-\r
-sub h2z_euc {\r
- local(*s) = @_;\r
- $s =~ s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;\r
-}\r
-\r
-sub h2z_sjis {\r
- local(*s, $n) = @_;\r
- $s =~ s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/\r
- $1 || ($n++, $e2s{$h2z{$3}} || &e2s($h2z{$3}))\r
- /geo;\r
- $n;\r
-}\r
-\r
-;#\r
-;# X0208 -> X0201 KANA conversion routine\r
-;#\r
-sub z2h_jis {\r
- local(*s, $n) = @_;\r
- $s =~ s/($re_jis0208)([^\e]+)/&_z2h_jis($2)/geo;\r
- $n;\r
-}\r
-sub _z2h_jis {\r
- local($s) = @_;\r
- $s =~ s/((\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+)/\r
- &__z2h_jis($1)\r
- /ge;\r
- $s;\r
-}\r
-sub __z2h_jis {\r
- local($s) = @_;\r
- return $esc_0208 . $s unless /^%/ || $s =~ /^![\#\"&VW+,<]/;\r
- $n += length($s) / 2;\r
- $s =~ s/(..)/$z2h{$1}/g;\r
- $esc_kana . $s;\r
-}\r
-\r
-sub z2h_euc {\r
- local(*s, $n) = @_;\r
- &init_z2h_euc unless defined %z2h_euc;\r
- $s =~ s/($re_euc_c|$re_euc_kana)/\r
- $z2h_euc{$1} ? ($n++, $z2h_euc{$1}) : $1\r
- /geo;\r
- $n;\r
-}\r
-\r
-sub z2h_sjis {\r
- local(*s, $n) = @_;\r
- &init_z2h_sjis unless defined %z2h_sjis;\r
- $s =~ s/($re_sjis_c)/$z2h_sjis{$1} ? ($n++, $z2h_sjis{$1}) : $1/geo;\r
- $n;\r
-}\r
-\r
-;#\r
-;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This\r
-;# can be done in &init but it's not worth doing. Similarly,\r
-;# precalculated table is not worth to occupy the file space and\r
-;# reduce the readability. The author personnaly discourages to use\r
-;# X0201 Kana character in the any situation.\r
-;#\r
-sub init_z2h_euc {\r
- local($k, $s);\r
- while (($k, $s) = each %z2h) {\r
- $s =~ s/([\241-\337])/\216$1/g && ($z2h_euc{$k} = $s);\r
- }\r
-}\r
-sub init_z2h_sjis {\r
- local($s, $v);\r
- while (($s, $v) = each %z2h) {\r
- $s =~ /[\200-\377]/ && ($z2h_sjis{&e2s($s)} = $v);\r
- }\r
-}\r
-\r
-;#\r
-;# TR function for 2-byte code\r
-;#\r
-sub tr {\r
- # $prev_from, $prev_to, %table are persistent variables\r
- local(*s, $from, $to, $opt) = @_;\r
- local(@from, @to);\r
- local($jis, $n) = (0, 0);\r
- \r
- $jis++, &jis2euc(*s) if $s =~ /$re_jp|$re_asc|$re_kana/o;\r
- $jis++ if $to =~ /$re_jp|$re_asc|$re_kana/o;\r
-\r
- if (!defined($prev_from) || $from ne $prev_from || $to ne $prev_to) {\r
- ($prev_from, $prev_to) = ($from, $to);\r
- undef %table;\r
- &_maketable;\r
- }\r
-\r
- $s =~ s/([\200-\377][\000-\377]|[\000-\377])/\r
- defined($table{$1}) && ++$n ? $table{$1} : $1\r
- /ge;\r
-\r
- &euc2jis(*s) if $jis;\r
-\r
- $n;\r
-}\r
-\r
-sub _maketable {\r
- local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';\r
-\r
- &jis2euc(*to) if $to =~ /$re_jp|$re_asc|$re_kana/o;\r
- &jis2euc(*from) if $from =~ /$re_jp|$re_asc|$re_kana/o;\r
-\r
- grep(s/(([\200-\377])[\200-\377]-\2[\200-\377])/&_expnd2($1)/ge,\r
- $from, $to);\r
- grep(s/($ascii-$ascii)/&_expnd1($1)/geo,\r
- $from, $to);\r
-\r
- @to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;\r
- @from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;\r
- push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;\r
- @table{@from} = @to;\r
-}\r
-\r
-sub _expnd1 {\r
- local($s) = @_;\r
- $s =~ s/\\(.)/$1/g;\r
- local($c1, $c2) = unpack('CxC', $s);\r
- if ($c1 <= $c2) {\r
- for ($s = ''; $c1 <= $c2; $c1++) {\r
- $s .= pack('C', $c1);\r
- }\r
- }\r
- $s;\r
-}\r
-\r
-sub _expnd2 {\r
- local($s) = @_;\r
- local($c1, $c2, $c3, $c4) = unpack('CCxCC', $s);\r
- if ($c1 == $c3 && $c2 <= $c4) {\r
- for ($s = ''; $c2 <= $c4; $c2++) {\r
- $s .= pack('CC', $c1, $c2);\r
- }\r
- }\r
- $s;\r
-}\r
-\r
-1;\r
+package jcode;
+;######################################################################
+;#
+;# jcode.pl: Perl library for Japanese character code conversion
+;#
+;# Copyright (c) 1995-1999 Kazumasa Utashiro <utashiro@iij.ad.jp>
+;# Internet Initiative Japan Inc.
+;# 3-13 Kanda Nishiki-cho, Chiyoda-ku, Tokyo 101-0054, Japan
+;#
+;# Copyright (c) 1992,1993,1994 Kazumasa Utashiro
+;# Software Research Associates, Inc.
+;#
+;# Use and redistribution for ANY PURPOSE are granted as long as all
+;# copyright notices are retained. Redistribution with modification
+;# is allowed provided that you make your modified version obviously
+;# distinguishable from the original one. THIS SOFTWARE IS PROVIDED
+;# BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES ARE
+;# DISCLAIMED.
+;#
+;# Original version was developed under the name of srekcah@sra.co.jp
+;# February 1992 and it was called kconv.pl at the beginning. This
+;# address was a pen name for group of individuals and it is no longer
+;# valid.
+;#
+;# The latest version is available here:
+;#
+;# ftp://ftp.iij.ad.jp/pub/IIJ/dist/utashiro/perl/
+;#
+;; $rcsid = q$Id: jcode.pl,v 1.1 2003/09/18 15:35:28 takezoe Exp $;
+;#
+;######################################################################
+;#
+;# PERL4 INTERFACE:
+;#
+;# &jcode'getcode(*line)
+;# Return 'jis', 'sjis', 'euc' or undef according to
+;# Japanese character code in $line. Return 'binary' if
+;# the data has non-character code.
+;#
+;# When evaluated in array context, it returns a list
+;# contains two items. First value is the number of
+;# characters which matched to the expected code, and
+;# second value is the code name. It is useful if and
+;# only if the number is not 0 and the code is undef;
+;# that case means it couldn't tell 'euc' or 'sjis'
+;# because the evaluation score was exactly same. This
+;# interface is too tricky, though.
+;#
+;# Code detection between euc and sjis is very difficult
+;# or sometimes impossible or even lead to wrong result
+;# when it includes JIS X0201 KANA characters. So JIS
+;# X0201 KANA is ignored for automatic code detection.
+;#
+;# &jcode'convert(*line, $ocode [, $icode [, $option]])
+;# Convert the contents of $line to the specified
+;# Japanese code given in the second argument $ocode.
+;# $ocode can be any of "jis", "sjis" or "euc", or use
+;# "noconv" when you don't want the code conversion.
+;# Input code is recognized automatically from the line
+;# itself when $icode is not supplied (JIS X0201 KANA is
+;# ignored in code detection. See the above descripton
+;# of &getcode). $icode also can be specified, but
+;# xxx2yyy routine is more efficient when both codes are
+;# known.
+;#
+;# It returns the code of input string in scalar context,
+;# and a list of pointer of convert subroutine and the
+;# input code in array context.
+;#
+;# Japanese character code JIS X0201, X0208, X0212 and
+;# ASCII code are supported. X0212 characters can not be
+;# represented in SJIS and they will be replased by
+;# "geta" character when converted to SJIS.
+;#
+;# See next paragraph for $option parameter.
+;#
+;# &jcode'xxx2yyy(*line [, $option])
+;# Convert the Japanese code from xxx to yyy. String xxx
+;# and yyy are any convination from "jis", "euc" or
+;# "sjis". They return *approximate* number of converted
+;# bytes. So return value 0 means the line was not
+;# converted at all.
+;#
+;# Optional parameter $option is used to specify optional
+;# conversion method. String "z" is for JIS X0201 KANA
+;# to X0208 KANA, and "h" is for reverse.
+;#
+;# $jcode'convf{'xxx', 'yyy'}
+;# The value of this associative array is pointer to the
+;# subroutine jcode'xxx2yyy().
+;#
+;# &jcode'to($ocode, $line [, $icode [, $option]])
+;# &jcode'jis($line [, $icode [, $option]])
+;# &jcode'euc($line [, $icode [, $option]])
+;# &jcode'sjis($line [, $icode [, $option]])
+;# These functions are prepared for easy use of
+;# call/return-by-value interface. You can use these
+;# funcitons in s///e operation or any other place for
+;# convenience.
+;#
+;# &jcode'jis_inout($in, $out)
+;# Set or inquire JIS start and end sequences. Default
+;# is "ESC-$-B" and "ESC-(-B". If you supplied only one
+;# character, "ESC-$" or "ESC-(" is prepended for each
+;# character respectively. Acutually "ESC-(-B" is not a
+;# sequence to end JIS code but a sequence to start ASCII
+;# code set. So `in' and `out' are somewhat misleading.
+;#
+;# &jcode'get_inout($string)
+;# Get JIS start and end sequences from $string.
+;#
+;# &jcode'cache()
+;# &jcode'nocache()
+;# &jcode'flush()
+;# Usually, converted character is cached in memory to
+;# avoid same calculations have to be done many times.
+;# To disable this caching, call &jcode'nocache(). It
+;# can be revived by &jcode'cache() and cache is flushed
+;# by calling &jcode'flush(). &cache() and &nocache()
+;# functions return previous caching state.
+;#
+;# ---------------------------------------------------------------
+;#
+;# &jcode'h2z_xxx(*line)
+;# JIS X0201 KANA (so-called Hankaku-KANA) to X0208 KANA
+;# (Zenkaku-KANA) code conversion routine. String xxx is
+;# any of "jis", "sjis" and "euc". From the difficulty
+;# of recognizing code set from 1-byte KATAKANA string,
+;# automatic code recognition is not supported.
+;#
+;# &jcode'z2h_xxx(*line)
+;# X0208 to X0201 KANA code conversion routine. String
+;# xxx is any of "jis", "sjis" and "euc".
+;#
+;# $jcode'z2hf{'xxx'}
+;# $jcode'h2zf{'xxx'}
+;# These are pointer to the corresponding function just
+;# as $jcode'convf.
+;#
+;# ---------------------------------------------------------------
+;#
+;# &jcode'tr(*line, $from, $to [, $option])
+;# &jcode'tr emulates tr operator for 2 byte code. Only 'd'
+;# is interpreted as an option.
+;#
+;# Range operator like `A-Z' for 2 byte code is partially
+;# supported. Code must be JIS or EUC, and first byte
+;# have to be same on first and last character.
+;#
+;# CAUTION: Handling range operator is a kind of trick
+;# and it is not perfect. So if you need to transfer `-'
+;# character, please be sure to put it at the beginning
+;# or the end of $from and $to strings.
+;#
+;# &jcode'trans($line, $from, $to [, $option)
+;# Same as &jcode'tr but accept string and return string
+;# after translation.
+;#
+;# ---------------------------------------------------------------
+;#
+;# &jcode'init()
+;# Initialize the variables used in this package. You
+;# don't have to call this when using jocde.pl by `do' or
+;# `require' interface. Call it first if you embedded
+;# the jcode.pl at the end of your script.
+;#
+;######################################################################
+;#
+;# PERL5 INTERFACE:
+;#
+;# Current jcode.pl is written in Perl 4 but it is possible to use
+;# from Perl 5 using `references'. Fully perl5 capable version is
+;# future issue.
+;#
+;# Since lexical variable is not a subject of typeglob, *string style
+;# call doesn't work if the variable is declared as `my'. Same thing
+;# happens to special variable $_ if the perl is compiled to use
+;# thread capability. So using reference is generally recommented to
+;# avoid the mysterious error.
+;#
+;# jcode::getcode(\$line)
+;# jcode::convert(\$line, $ocode [, $icode [, $option]])
+;# jcode::xxx2yyy(\$line [, $option])
+;# &{$jcode::convf{'xxx', 'yyy'}}(\$line)
+;# jcode::to($ocode, $line [, $icode [, $option]])
+;# jcode::jis($line [, $icode [, $option]])
+;# jcode::euc($line [, $icode [, $option]])
+;# jcode::sjis($line [, $icode [, $option]])
+;# jcode::jis_inout($in, $out)
+;# jcode::get_inout($string)
+;# jcode::cache()
+;# jcode::nocache()
+;# jcode::flush()
+;# jcode::h2z_xxx(\$line)
+;# jcode::z2h_xxx(\$line)
+;# &{$jcode::z2hf{'xxx'}}(\$line)
+;# &{$jcode::h2zf{'xxx'}}(\$line)
+;# jcode::tr(\$line, $from, $to [, $option])
+;# jcode::trans($line, $from, $to [, $option)
+;# jcode::init()
+;#
+;######################################################################
+;#
+;# SAMPLES
+;#
+;# Convert any Kanji code to JIS and print each line with code name.
+;#
+;# while (defined($s = <>)) {
+;# $code = &jcode'convert(*s, 'jis');
+;# print $code, "\t", $s;
+;# }
+;#
+;# Convert all lines to JIS according to the first recognized line.
+;#
+;# while (defined($s = <>)) {
+;# print, next unless $s =~ /[\033\200-\377]/;
+;# (*f, $icode) = &jcode'convert(*s, 'jis');
+;# print;
+;# defined(&f) || next;
+;# while (<>) { &f(*s); print; }
+;# last;
+;# }
+;#
+;# The safest way of JIS conversion.
+;#
+;# while (defined($s = <>)) {
+;# ($matched, $icode) = &jcode'getcode(*s);
+;# if (@buf == 0 && $matched == 0) {
+;# print $s;
+;# next;
+;# }
+;# push(@buf, $s);
+;# next unless $icode;
+;# while (defined($s = shift(@buf))) {
+;# &jcode'convert(*s, 'jis', $icode);
+;# print $s;
+;# }
+;# while (defined($s = <>)) {
+;# &jcode'convert(*s, 'jis', $icode);
+;# print $s;
+;# }
+;# last;
+;# }
+;# print @buf if @buf;
+;#
+;######################################################################
+
+;#
+;# Call initialize function if it is not called yet. This may sound
+;# strange but it makes easy to embed the jcode.pl at the end of
+;# script. Call &jcode'init at the beginning of the script in that
+;# case.
+;#
+&init unless defined $version;
+
+;#
+;# Initialize variables.
+;#
+sub init {
+ $version = $rcsid =~ /,v ([\d.]+)/ ? $1 : 'unkown';
+
+ $re_bin = '[\000-\006\177\377]';
+
+ $re_jis0208_1978 = '\e\$\@';
+ $re_jis0208_1983 = '\e\$B';
+ $re_jis0208_1990 = '\e&\@\e\$B';
+ $re_jis0208 = "$re_jis0208_1978|$re_jis0208_1983|$re_jis0208_1990";
+ $re_jis0212 = '\e\$\(D';
+ $re_jp = "$re_jis0208|$re_jis0212";
+ $re_asc = '\e\([BJ]';
+ $re_kana = '\e\(I';
+
+ $esc_0208 = "\e\$B";
+ $esc_0212 = "\e\$(D";
+ $esc_asc = "\e(B";
+ $esc_kana = "\e(I";
+
+ $re_sjis_c = '[\201-\237\340-\374][\100-\176\200-\374]';
+ $re_sjis_kana = '[\241-\337]';
+
+ $re_euc_c = '[\241-\376][\241-\376]';
+ $re_euc_kana = '\216[\241-\337]';
+ $re_euc_0212 = '\217[\241-\376][\241-\376]';
+
+ # Use `geta' for undefined character code
+ $undef_sjis = "\x81\xac";
+
+ $cache = 1;
+
+ # X0201 -> X0208 KANA conversion table. Looks weird? Not that
+ # much. This is simply JIS text without escape sequences.
+ ($h2z_high = $h2z = <<'__TABLE_END__') =~ tr/\041-\176/\241-\376/;
+! !# $ !" % !& " !V # !W
+^ !+ _ !, 0 !<
+' %! ( %# ) %% * %' + %)
+, %c - %e . %g / %C
+1 %" 2 %$ 3 %& 4 %( 5 %*
+6 %+ 7 %- 8 %/ 9 %1 : %3
+6^ %, 7^ %. 8^ %0 9^ %2 :^ %4
+; %5 < %7 = %9 > %; ? %=
+;^ %6 <^ %8 =^ %: >^ %< ?^ %>
+@ %? A %A B %D C %F D %H
+@^ %@ A^ %B B^ %E C^ %G D^ %I
+E %J F %K G %L H %M I %N
+J %O K %R L %U M %X N %[
+J^ %P K^ %S L^ %V M^ %Y N^ %\
+J_ %Q K_ %T L_ %W M_ %Z N_ %]
+O %^ P %_ Q %` R %a S %b
+T %d U %f V %h
+W %i X %j Y %k Z %l [ %m
+\ %o ] %s & %r 3^ %t
+__TABLE_END__
+ %h2z = split(/\s+/, $h2z . $h2z_high);
+ %z2h = reverse %h2z;
+
+ $convf{'jis' , 'jis' } = *jis2jis;
+ $convf{'jis' , 'sjis'} = *jis2sjis;
+ $convf{'jis' , 'euc' } = *jis2euc;
+ $convf{'euc' , 'jis' } = *euc2jis;
+ $convf{'euc' , 'sjis'} = *euc2sjis;
+ $convf{'euc' , 'euc' } = *euc2euc;
+ $convf{'sjis' , 'jis' } = *sjis2jis;
+ $convf{'sjis' , 'sjis'} = *sjis2sjis;
+ $convf{'sjis' , 'euc' } = *sjis2euc;
+ $h2zf{'jis' } = *h2z_jis;
+ $z2hf{'jis' } = *z2h_jis;
+ $h2zf{'euc' } = *h2z_euc;
+ $z2hf{'euc' } = *z2h_euc;
+ $h2zf{'sjis'} = *h2z_sjis;
+ $z2hf{'sjis'} = *z2h_sjis;
+}
+
+;#
+;# Set escape sequences which should be put before and after Japanese
+;# (JIS X0208) string.
+;#
+sub jis_inout {
+ $esc_0208 = shift || $esc_0208;
+ $esc_0208 = "\e\$$esc_0208" if length($esc_0208) == 1;
+ $esc_asc = shift || $esc_asc;
+ $esc_asc = "\e\($esc_asc" if length($esc_asc) == 1;
+ ($esc_0208, $esc_asc);
+}
+
+;#
+;# Get JIS in and out sequences from the string.
+;#
+sub get_inout {
+ local($esc_0208, $esc_asc);
+ $_[$[] =~ /($re_jis0208)/o && ($esc_0208 = $1);
+ $_[$[] =~ /($re_asc)/o && ($esc_asc = $1);
+ ($esc_0208, $esc_asc);
+}
+
+;#
+;# Recognize character code.
+;#
+sub getcode {
+ local(*s) = @_;
+ local($matched, $code);
+
+ if ($s !~ /[\e\200-\377]/) { # not Japanese
+ $matched = 0;
+ $code = undef;
+ } # 'jis'
+ elsif ($s =~ /$re_jp|$re_asc|$re_kana/o) {
+ $matched = 1;
+ $code = 'jis';
+ }
+ elsif ($s =~ /$re_bin/o) { # 'binary'
+ $matched = 0;
+ $code = 'binary';
+ }
+ else { # should be 'euc' or 'sjis'
+ local($sjis, $euc) = (0, 0);
+
+ while ($s =~ /(($re_sjis_c)+)/go) {
+ $sjis += length($1);
+ }
+ while ($s =~ /(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/go) {
+ $euc += length($1);
+ }
+ $matched = &max($sjis, $euc);
+ $code = ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1];
+ }
+ wantarray ? ($matched, $code) : $code;
+}
+sub max { $_[ $[ + ($_[ $[ ] < $_[ $[ + 1 ]) ]; }
+
+;#
+;# Convert any code to specified code.
+;#
+sub convert {
+ local(*s, $ocode, $icode, $opt) = @_;
+ return (undef, undef) unless $icode = $icode || &getcode(*s);
+ return (undef, $icode) if $icode eq 'binary';
+ $ocode = 'jis' unless $ocode;
+ $ocode = $icode if $ocode eq 'noconv';
+ local(*f) = $convf{$icode, $ocode};
+ &f(*s, $opt);
+ wantarray ? (*f, $icode) : $icode;
+}
+
+;#
+;# Easy return-by-value interfaces.
+;#
+sub jis { &to('jis', @_); }
+sub euc { &to('euc', @_); }
+sub sjis { &to('sjis', @_); }
+sub to {
+ local($ocode, $s, $icode, $opt) = @_;
+ &convert(*s, $ocode, $icode, $opt);
+ $s;
+}
+sub what {
+ local($s) = @_;
+ &getcode(*s);
+}
+sub trans {
+ local($s) = shift;
+ &tr(*s, @_);
+ $s;
+}
+
+;#
+;# SJIS to JIS
+;#
+sub sjis2jis {
+ local(*s, $opt, $n) = @_;
+ &sjis2sjis(*s, $opt) if $opt;
+ $s =~ s/(($re_sjis_c|$re_sjis_kana)+)/&_sjis2jis($1) . $esc_asc/geo;
+ $n;
+}
+sub _sjis2jis {
+ local($s) = shift;
+ $s =~ s/(($re_sjis_c)+|($re_sjis_kana)+)/&__sjis2jis($1)/geo;
+ $s;
+}
+sub __sjis2jis {
+ local($s) = shift;
+ if ($s =~ /^$re_sjis_kana/o) {
+ $n += $s =~ tr/\241-\337/\041-\137/;
+ $esc_kana . $s;
+ } else {
+ $n += $s =~ s/($re_sjis_c)/$s2e{$1}||&s2e($1)/geo;
+ $s =~ tr/\241-\376/\041-\176/;
+ $esc_0208 . $s;
+ }
+}
+
+;#
+;# EUC to JIS
+;#
+sub euc2jis {
+ local(*s, $opt, $n) = @_;
+ &euc2euc(*s, $opt) if $opt;
+ $s =~ s/(($re_euc_c|$re_euc_kana|$re_euc_0212)+)/
+ &_euc2jis($1) . $esc_asc
+ /geo;
+ $n;
+}
+sub _euc2jis {
+ local($s) = shift;
+ $s =~ s/(($re_euc_c)+|($re_euc_kana)+|($re_euc_0212)+)/&__euc2jis($1)/geo;
+ $s;
+}
+sub __euc2jis {
+ local($s) = shift;
+ local($esc);
+
+ if ($s =~ tr/\216//d) {
+ $esc = $esc_kana;
+ } elsif ($s =~ tr/\217//d) {
+ $esc = $esc_0212;
+ } else {
+ $esc = $esc_0208;
+ }
+
+ $n += $s =~ tr/\241-\376/\041-\176/;
+ $esc . $s;
+}
+
+;#
+;# JIS to EUC
+;#
+sub jis2euc {
+ local(*s, $opt, $n) = @_;
+ $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2euc($1,$2)/geo;
+ &euc2euc(*s, $opt) if $opt;
+ $n;
+}
+sub _jis2euc {
+ local($esc, $s) = @_;
+ if ($esc !~ /^$re_asc/o) {
+ $n += $s =~ tr/\041-\176/\241-\376/;
+ if ($esc =~ /^$re_kana/o) {
+ $s =~ s/([\241-\337])/\216$1/g;
+ }
+ elsif ($esc =~ /^$re_jis0212/o) {
+ $s =~ s/([\241-\376][\241-\376])/\217$1/g;
+ }
+ }
+ $s;
+}
+
+;#
+;# JIS to SJIS
+;#
+sub jis2sjis {
+ local(*s, $opt, $n) = @_;
+ &jis2jis(*s, $opt) if $opt;
+ $s =~ s/($re_jp|$re_asc|$re_kana)([^\e]*)/&_jis2sjis($1,$2)/geo;
+ $n;
+}
+sub _jis2sjis {
+ local($esc, $s) = @_;
+ if ($esc =~ /^$re_jis0212/o) {
+ $s =~ s/../$undef_sjis/g;
+ $n = length;
+ }
+ elsif ($esc !~ /^$re_asc/o) {
+ $n += $s =~ tr/\041-\176/\241-\376/;
+ if ($esc =~ /^$re_jp/o) {
+ $s =~ s/($re_euc_c)/$e2s{$1}||&e2s($1)/geo;
+ }
+ }
+ $s;
+}
+
+;#
+;# SJIS to EUC
+;#
+sub sjis2euc {
+ local(*s, $opt,$n) = @_;
+ $n = $s =~ s/($re_sjis_c|$re_sjis_kana)/$s2e{$1}||&s2e($1)/geo;
+ &euc2euc(*s, $opt) if $opt;
+ $n;
+}
+sub s2e {
+ local($c1, $c2, $code);
+ ($c1, $c2) = unpack('CC', $code = shift);
+
+ if (0xa1 <= $c1 && $c1 <= 0xdf) {
+ $c2 = $c1;
+ $c1 = 0x8e;
+ } elsif (0x9f <= $c2) {
+ $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe0 : 0x60);
+ $c2 += 2;
+ } else {
+ $c1 = $c1 * 2 - ($c1 >= 0xe0 ? 0xe1 : 0x61);
+ $c2 += 0x60 + ($c2 < 0x7f);
+ }
+ if ($cache) {
+ $s2e{$code} = pack('CC', $c1, $c2);
+ } else {
+ pack('CC', $c1, $c2);
+ }
+}
+
+;#
+;# EUC to SJIS
+;#
+sub euc2sjis {
+ local(*s, $opt,$n) = @_;
+ &euc2euc(*s, $opt) if $opt;
+ $n = $s =~ s/($re_euc_c|$re_euc_kana|$re_euc_0212)/$e2s{$1}||&e2s($1)/geo;
+}
+sub e2s {
+ local($c1, $c2, $code);
+ ($c1, $c2) = unpack('CC', $code = shift);
+
+ if ($c1 == 0x8e) { # SS2
+ return substr($code, 1, 1);
+ } elsif ($c1 == 0x8f) { # SS3
+ return $undef_sjis;
+ } elsif ($c1 % 2) {
+ $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x31 : 0x71);
+ $c2 -= 0x60 + ($c2 < 0xe0);
+ } else {
+ $c1 = ($c1>>1) + ($c1 < 0xdf ? 0x30 : 0x70);
+ $c2 -= 2;
+ }
+ if ($cache) {
+ $e2s{$code} = pack('CC', $c1, $c2);
+ } else {
+ pack('CC', $c1, $c2);
+ }
+}
+
+;#
+;# JIS to JIS, SJIS to SJIS, EUC to EUC
+;#
+sub jis2jis {
+ local(*s, $opt) = @_;
+ $s =~ s/$re_jis0208/$esc_0208/go;
+ $s =~ s/$re_asc/$esc_asc/go;
+ &h2z_jis(*s) if $opt =~ /z/;
+ &z2h_jis(*s) if $opt =~ /h/;
+}
+sub sjis2sjis {
+ local(*s, $opt) = @_;
+ &h2z_sjis(*s) if $opt =~ /z/;
+ &z2h_sjis(*s) if $opt =~ /h/;
+}
+sub euc2euc {
+ local(*s, $opt) = @_;
+ &h2z_euc(*s) if $opt =~ /z/;
+ &z2h_euc(*s) if $opt =~ /h/;
+}
+
+;#
+;# Cache control functions
+;#
+sub cache {
+ ($cache, $cache = 1)[$[];
+}
+sub nocache {
+ ($cache, $cache = 0)[$[];
+}
+sub flushcache {
+ undef %e2s;
+ undef %s2e;
+}
+
+;#
+;# X0201 -> X0208 KANA conversion routine
+;#
+sub h2z_jis {
+ local(*s, $n) = @_;
+ if ($s =~ s/$re_kana([^\e]*)/$esc_0208 . &_h2z_jis($1)/geo) {
+ 1 while $s =~ s/(($re_jis0208)[^\e]*)($re_jis0208)/$1/o;
+ }
+ $n;
+}
+sub _h2z_jis {
+ local($s) = @_;
+ $n += $s =~ s/([\41-\137]([\136\137])?)/$h2z{$1}/g;
+ $s;
+}
+
+sub h2z_euc {
+ local(*s) = @_;
+ $s =~ s/\216([\241-\337])(\216([\336\337]))?/$h2z{"$1$3"}/g;
+}
+
+sub h2z_sjis {
+ local(*s, $n) = @_;
+ $s =~ s/(($re_sjis_c)+)|(([\241-\337])([\336\337])?)/
+ $1 || ($n++, $e2s{$h2z{$3}} || &e2s($h2z{$3}))
+ /geo;
+ $n;
+}
+
+;#
+;# X0208 -> X0201 KANA conversion routine
+;#
+sub z2h_jis {
+ local(*s, $n) = @_;
+ $s =~ s/($re_jis0208)([^\e]+)/&_z2h_jis($2)/geo;
+ $n;
+}
+sub _z2h_jis {
+ local($s) = @_;
+ $s =~ s/((\%[!-~]|![\#\"&VW+,<])+|([^!%][!-~]|![^\#\"&VW+,<])+)/
+ &__z2h_jis($1)
+ /ge;
+ $s;
+}
+sub __z2h_jis {
+ local($s) = @_;
+ return $esc_0208 . $s unless /^%/ || $s =~ /^![\#\"&VW+,<]/;
+ $n += length($s) / 2;
+ $s =~ s/(..)/$z2h{$1}/g;
+ $esc_kana . $s;
+}
+
+sub z2h_euc {
+ local(*s, $n) = @_;
+ &init_z2h_euc unless defined %z2h_euc;
+ $s =~ s/($re_euc_c|$re_euc_kana)/
+ $z2h_euc{$1} ? ($n++, $z2h_euc{$1}) : $1
+ /geo;
+ $n;
+}
+
+sub z2h_sjis {
+ local(*s, $n) = @_;
+ &init_z2h_sjis unless defined %z2h_sjis;
+ $s =~ s/($re_sjis_c)/$z2h_sjis{$1} ? ($n++, $z2h_sjis{$1}) : $1/geo;
+ $n;
+}
+
+;#
+;# Initializing JIS X0208 to X0201 KANA table for EUC and SJIS. This
+;# can be done in &init but it's not worth doing. Similarly,
+;# precalculated table is not worth to occupy the file space and
+;# reduce the readability. The author personnaly discourages to use
+;# X0201 Kana character in the any situation.
+;#
+sub init_z2h_euc {
+ local($k, $s);
+ while (($k, $s) = each %z2h) {
+ $s =~ s/([\241-\337])/\216$1/g && ($z2h_euc{$k} = $s);
+ }
+}
+sub init_z2h_sjis {
+ local($s, $v);
+ while (($s, $v) = each %z2h) {
+ $s =~ /[\200-\377]/ && ($z2h_sjis{&e2s($s)} = $v);
+ }
+}
+
+;#
+;# TR function for 2-byte code
+;#
+sub tr {
+ # $prev_from, $prev_to, %table are persistent variables
+ local(*s, $from, $to, $opt) = @_;
+ local(@from, @to);
+ local($jis, $n) = (0, 0);
+
+ $jis++, &jis2euc(*s) if $s =~ /$re_jp|$re_asc|$re_kana/o;
+ $jis++ if $to =~ /$re_jp|$re_asc|$re_kana/o;
+
+ if (!defined($prev_from) || $from ne $prev_from || $to ne $prev_to) {
+ ($prev_from, $prev_to) = ($from, $to);
+ undef %table;
+ &_maketable;
+ }
+
+ $s =~ s/([\200-\377][\000-\377]|[\000-\377])/
+ defined($table{$1}) && ++$n ? $table{$1} : $1
+ /ge;
+
+ &euc2jis(*s) if $jis;
+
+ $n;
+}
+
+sub _maketable {
+ local($ascii) = '(\\\\[\\-\\\\]|[\0-\133\135-\177])';
+
+ &jis2euc(*to) if $to =~ /$re_jp|$re_asc|$re_kana/o;
+ &jis2euc(*from) if $from =~ /$re_jp|$re_asc|$re_kana/o;
+
+ grep(s/(([\200-\377])[\200-\377]-\2[\200-\377])/&_expnd2($1)/ge,
+ $from, $to);
+ grep(s/($ascii-$ascii)/&_expnd1($1)/geo,
+ $from, $to);
+
+ @to = $to =~ /[\200-\377][\000-\377]|[\000-\377]/g;
+ @from = $from =~ /[\200-\377][\000-\377]|[\000-\377]/g;
+ push(@to, ($opt =~ /d/ ? '' : $to[$#to]) x (@from - @to)) if @to < @from;
+ @table{@from} = @to;
+}
+
+sub _expnd1 {
+ local($s) = @_;
+ $s =~ s/\\(.)/$1/g;
+ local($c1, $c2) = unpack('CxC', $s);
+ if ($c1 <= $c2) {
+ for ($s = ''; $c1 <= $c2; $c1++) {
+ $s .= pack('C', $c1);
+ }
+ }
+ $s;
+}
+
+sub _expnd2 {
+ local($s) = @_;
+ local($c1, $c2, $c3, $c4) = unpack('CCxCC', $s);
+ if ($c1 == $c3 && $c2 <= $c4) {
+ for ($s = ''; $c2 <= $c4; $c2++) {
+ $s .= pack('CC', $c1, $c2);
+ }
+ }
+ $s;
+}
+
+1;
-package MIME;\r
-# Copyright (C) 1993-94,1997 Noboru Ikuta <noboru@ikuta.ichihara.chiba.jp>\r
-#\r
-# mimew.pl: MIME encoder library Ver.2.02 (1997/12/30)\r
-\r
-$main'mimew_version = "2.02";\r
-\r
-# \e$B%$%s%9%H!<%k\e(B : @INC \e$B$N%G%#%l%/%H%j!JDL>o$O\e(B /usr/local/lib/perl\e$B!K$K%3%T!<\e(B\r
-# \e$B$7$F2<$5$$!#\e(B\r
-#\r
-# \e$B;HMQNc\e(B1 : require 'mimew.pl';\r
-# $from = "From: \e$B@8ED\e(B \e$B>:\e(B <noboru\@ikuta.ichihara.chiba.jp>";\r
-# print &mimeencode($from);\r
-#\r
-# \e$B;HMQNc\e(B2 : # UNIX\e$B$G\e(BBase64\e$B%(%s%3!<%I$9$k>l9g\e(B\r
-# require 'mimew.pl';\r
-# undef $/;\r
-# $body = <>;\r
-# print &bodyencode($body);\r
-# print &benflush;\r
-#\r
-# &bodyencode($data,$coding):\r
-# \e$B%G!<%?$r\e(BBase64\e$B7A<0$^$?$O\e(BQuoted-Printable\e$B7A<0$G%(%s%3!<%I$9$k!#\e(B\r
-# \e$BBh\e(B2\e$B%Q%i%a!<%?$K\e(B"qp"\e$B$^$?$O\e(B"b64"\e$B$r;XDj$9$k$3$H$K$h$j%3!<%G%#%s%07A<0\e(B\r
-# \e$B$r;X<($9$k$3$H$,$G$-$k!#Bh\e(B2\e$B%Q%i%a!<%?$r>JN,$9$k$H\e(BBase64\e$B7A<0$G%(%s\e(B\r
-# \e$B%3!<%I$9$k!#\e(B\r
-# Base64\e$B7A<0$N%(%s%3!<%I$N>l9g$O!"\e(B$foldcol*3/4 \e$B%P%$%HC10L$GJQ49$9$k\e(B\r
-# \e$B$N$G!"EO$5$l$?%G!<%?$N$&$AH>C<$JItJ,$O%P%C%U%!$KJ]B8$5$l<!$K8F$P$l\e(B\r
-# \e$B$?$H$-$K=hM}$5$l$k!#:G8e$K%P%C%U%!$K;D$C$?%G!<%?$O\e(B&benflush\e$B$r8F$V\e(B\r
-# \e$B$3$H$K$h$j=hM}$5$l%P%C%U%!$+$i%/%j%"$5$l$k!#\e(B\r
-# Quoted-Printable\e$B7A<0$N%(%s%3!<%I$N>l9g$O!"9TC10L$GJQ49$9$k$?$a!"\e(B\r
-# \e$B%G!<%?$N:G8e$K2~9TJ8;z$,L5$$>l9g!":G8e$N2~9TJ8;z$N8e$m$N%G!<%?$O\e(B\r
-# \e$B%P%C%U%!$KJ]B8$5$l!"<!$K8F$P$l$?$H$-$K=hM}$5$l$k!#:G8e$K%P%C%U%!\e(B\r
-# \e$B$K;D$C$?%G!<%?$O\e(B&benflush("qp")\e$B$r8F$V$3$H$K$h$j=hM}$5$l%P%C%U%!\e(B\r
-# \e$B$+$i%/%j%"$5$l$k!#\e(B\r
-#\r
-# &benflush($coding):\r
-# \e$BBh\e(B1\e$B%Q%i%a!<%?$K\e(B"b64"\e$B$^$?$O\e(B"qp"\e$B$r;XDj$9$k$3$H$K$h$j!"$=$l$>$l\e(BBase64\r
-# \e$B7A<0$^$?$O\e(BQuoted-Printable\e$B7A<0$N%(%s%3!<%I$r;XDj$9$k$3$H$,$G$-$k!#\e(B\r
-# \e$BBh\e(B1\e$B%Q%i%a!<%?$K2?$b;XDj$7$J$1$l$P\e(BBase64\e$B7A<0$G%(%s%3!<%I$5$l$k!#\e(B\r
-# Base64\e$B$N%(%s%3!<%I$N>l9g!"\e(B&bodyencode\e$B$,=hM}$7;D$7$?%G!<%?$r=hM}$7\e(B\r
-# pad\e$BJ8;z$r=PNO$9$k!#\e(BQuoted-Printable\e$B$N>l9g!"9TC10L$G$J$/%V%m%C%/C1\e(B\r
-# \e$B0L$G\e(B&bodyencode\e$B$r8F$V>l9g!"\e(B&bodyencode\e$B$,=hM}$7;D$7$?%G!<%?$,$b$7\e(B\r
-# \e$B%P%C%U%!$K;D$C$F$$$l$P$=$l$r=hM}$9$k!#\e(B\r
-# \e$B0l$D$N%G!<%?$r\e(B(1\e$B2s$^$?$O2?2s$+$KJ,$1$F\e(B)&bodyencode\e$B$7$?8e$KI,$:\e(B1\e$B2s\e(B\r
-# \e$B8F$VI,MW$,$"$k!#\e(B\r
-#\r
-# &mimeencode($text):\r
-# \e$BBh\e(B1\e$B%Q%i%a!<%?$,F|K\8lJ8;zNs$r4^$s$G$$$l$P!"$=$NItJ,$r\e(BISO-2022-JP\e$B$K\e(B\r
-# \e$BJQ49$7$?$"$H!"\e(BMIME encoded-word(RFC2047\e$B;2>H\e(B)\e$B$KJQ49$9$k!#I,MW$K1~$8\e(B\r
-# \e$B$F\e(Bencoded-word\e$B$NJ,3d$H\e(Bencoded-word\e$B$NA08e$G$N9TJ,3d$r9T$&!#\e(B\r
-#\r
-# \e$BJ8;z%3!<%I$N<+F0H=Dj$O!"F10l9T$K\e(BShiftJIS\e$B$H\e(BEUC\e$B$,:.:_$7$F$$$k>l9g$r\e(B\r
-# \e$B=|$$$F4A;z%3!<%I$N:.:_$K$bBP1~$7$F$$$k!#\e(BShiftJIS\e$B$+\e(BEUC\e$B$+$I$&$7$F$b\e(B\r
-# \e$BH=CG$G$-$J$$$H$-$O\e(B$often_use_kanji\e$B$K@_Dj$5$l$F$$$k%3!<%I$HH=Dj$9$k!#\e(B\r
-# ISO-2022-JP\e$B$N%(%9%1!<%W%7!<%1%s%9$O\e(B$jis_in\e$B$H\e(B$jis_out\e$B$K@_Dj$9$k$3$H\e(B\r
-# \e$B$K$h$jJQ992DG=$G$"$k!#\e(B\r
-\r
-$often_use_kanji = 'EUC'; # or 'SJIS'\r
-\r
-$jis_in = "\x1b\$B"; # ESC-$-B ( or ESC-$-@ )\r
-$jis_out = "\x1b\(B"; # ESC-(-B ( or ESC-(-J )\r
-\r
-# \e$BG[I[>r7o\e(B : \e$BCx:n8"$OJ|4~$7$^$;$s$,!"G[I[!&2~JQ$O<+M3$H$7$^$9!#2~JQ$7$F\e(B\r
-# \e$BG[I[$9$k>l9g$O!"%*%j%8%J%k$H0[$J$k$3$H$rL@5-$7!"%*%j%8%J%k\e(B\r
-# \e$B$N%P!<%8%g%s%J%s%P!<$K2~JQHG%P!<%8%g%s%J%s%P!<$rIU2C$7$?7A\e(B\r
-# \e$BNc$($P\e(B Ver.2.02-XXXXX \e$B$N$h$&$J%P!<%8%g%s%J%s%P!<$rIU$1$F2<\e(B\r
-# \e$B$5$$!#$J$*!"\e(BCopyright\e$BI=<($OJQ99$7$J$$$G$/$@$5$$!#\e(B\r
-#\r
-# \e$BCm0U\e(B : &mimeencode\e$B$r\e(Bjperl1.X(\e$B$N\e(B2\e$B%P%$%HJ8;zBP1~%b!<%I\e(B)\e$B$G;HMQ$9$k$H!"\e(BSJIS\r
-# \e$B$H\e(BEUC\e$B$r$&$^$/\e(B7bit JIS(ISO-2022-JP)\e$B$KJQ49$G$-$^$;$s!#\e(B\r
-# \e$BF~NO$K4^$^$l$kJ8;z$,\e(B7bit JIS(ISO-2022-JP)\e$B$H\e(BASCII\e$B$N$_$G$"$k$3$H\e(B\r
-# \e$B$,J]>Z$5$l$F$$$k>l9g$r=|$-!"I,$:\e(Boriginal\e$B$N1Q8lHG$N\e(Bperl\e$B!J$^$?$O\e(B\r
-# jperl1.4\e$B0J>e$r\e(B -Llatin \e$B%*%W%7%g%sIU$-!K$GF0$+$7$F$/$@$5$$!#\e(B\r
-# \e$B$J$*!"\e(BPerl5\e$BBP1~$N\e(Bjperl\e$B$O;n$7$?$3$H$,$J$$$N$G$I$N$h$&$JF0:n$K$J$k\e(B\r
-# \e$B$+$o$+$j$^$;$s!#\e(B\r
-#\r
-# \e$B;2>H\e(B : RFC1468, RFC2045, RFC2047\r
-\r
-## MIME base64 \e$B%"%k%U%!%Y%C%H%F!<%V%k!J\e(BRFC2045\e$B$h$j!K\e(B\r
-%mime = (\r
-"000000", "A", "000001", "B", "000010", "C", "000011", "D",\r
-"000100", "E", "000101", "F", "000110", "G", "000111", "H",\r
-"001000", "I", "001001", "J", "001010", "K", "001011", "L",\r
-"001100", "M", "001101", "N", "001110", "O", "001111", "P",\r
-"010000", "Q", "010001", "R", "010010", "S", "010011", "T",\r
-"010100", "U", "010101", "V", "010110", "W", "010111", "X",\r
-"011000", "Y", "011001", "Z", "011010", "a", "011011", "b",\r
-"011100", "c", "011101", "d", "011110", "e", "011111", "f",\r
-"100000", "g", "100001", "h", "100010", "i", "100011", "j",\r
-"100100", "k", "100101", "l", "100110", "m", "100111", "n",\r
-"101000", "o", "101001", "p", "101010", "q", "101011", "r",\r
-"101100", "s", "101101", "t", "101110", "u", "101111", "v",\r
-"110000", "w", "110001", "x", "110010", "y", "110011", "z",\r
-"110100", "0", "110101", "1", "110110", "2", "110111", "3",\r
-"111000", "4", "111001", "5", "111010", "6", "111011", "7",\r
-"111100", "8", "111101", "9", "111110", "+", "111111", "/",\r
-);\r
-\r
-## JIS\e$B%3!<%I\e(B(byte\e$B?t\e(B)\e$B"*\e(Bencoded-word \e$B$NJ8;z?tBP1~\e(B\r
-%mimelen = (\r
- 8,30, 10,34, 12,34, 14,38, 16,42,\r
-18,42, 20,46, 22,50, 24,50, 26,54,\r
-28,58, 30,58, 32,62, 34,66, 36,66,\r
-38,70, 40,74, 42,74,\r
-);\r
-\r
-## \e$B%X%C%@%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B\r
-$limit=74; ## \e$B!vCm0U!v\e(B $limit\e$B$r\e(B75\e$B$h$jBg$-$$?t;z$K@_Dj$7$F$O$$$1$J$$!#\e(B\r
-\r
-## \e$B%\%G%#\e(Bbase64\e$B%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B\r
-$foldcol=72; ## \e$B!vCm0U!v\e(B $foldcol\e$B$O\e(B76\e$B0J2<$N\e(B4\e$B$NG\?t$K@_Dj$9$k$3$H!#\e(B\r
-\r
-## \e$B%\%G%#\e(BQuoted-Printable\e$B%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B\r
-$qfoldcol=75; ## \e$B!vCm0U!v\e(B $foldcol\e$B$O\e(B76\e$B0J2<$K@_Dj$9$k$3$H!#\e(B\r
-\r
-## null bit\e$B$NA^F~$H\e(B pad\e$BJ8;z$NA^F~$N$?$a$N%F!<%V%k\e(B\r
-@zero = ( "", "00000", "0000", "000", "00", "0" );\r
-@pad = ( "", "===", "==", "=" );\r
-\r
-## ASCII, 7bit JIS, Shift-JIS \e$B5Z$S\e(B EUC \e$B$N3F!9$K%^%C%A$9$k%Q%?!<%s\e(B\r
-$match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)';\r
-$match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)';\r
-$match_sjis = '([\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])+';\r
-$match_euc = '([\xa1-\xfe]{2})+';\r
-\r
-## MIME Part 2(charset=`ISO-2022-JP',encoding=`B') \e$B$N\e(B head \e$B$H\e(B tail\r
-$mime_head = '=?ISO-2022-JP?B?';\r
-$mime_tail = '?=';\r
-\r
-## &bodyencode \e$B$,;H$&=hM};D$7%G!<%?MQ%P%C%U%!\e(B\r
-$benbuf = "";\r
-\r
-## &bodyencode \e$B$N=hM}C10L!J%P%$%H!K\e(B\r
-$bensize = int($foldcol/4)*3;\r
-\r
-## &mimeencode interface ##\r
-sub main'mimeencode {\r
- local($_) = @_;\r
- s/$match_jis/$jis_in$1/go;\r
- s/$match_ascii/$jis_out$1/go;\r
- $kanji = &checkkanji;\r
- s/$match_sjis/&s2j($&)/geo if ($kanji eq 'SJIS');\r
- s/$match_euc/&e2j($&)/geo if ($kanji eq 'EUC');\r
- s/(\x1b[\$\(][BHJ@])+/$1/g;\r
- 1 while s/(\x1b\$[B@][\x21-\x7e]+)\x1b\$[B@]/$1/;\r
- 1 while s/$match_jis/&mimeencode($&,$`,$')/eo;\r
- s/$match_ascii/$1/go;\r
- $_;\r
-}\r
-\r
-## &bodyencode interface ##\r
-sub main'bodyencode {\r
- local($_,$coding) = @_;\r
- if (!defined($coding) || $coding eq "" || $coding eq "b64"){\r
- $_ = $benbuf . $_;\r
- local($cut) = int((length)/$bensize)*$bensize;\r
- $benbuf = substr($_, $cut+$[);\r
- $_ = substr($_, $[, $cut);\r
- $_ = &base64encode($_);\r
- s/.{$foldcol}/$&\n/g;\r
- }elsif ($coding eq "qp"){\r
- # $benbuf \e$B$,6u$G$J$1$l$P%G!<%?$N:G=i$KDI2C$9$k\e(B\r
- $_ = $benbuf . $_;\r
-\r
- # \e$B2~9TJ8;z$r@55,2=$9$k\e(B\r
- s/\r\n/\n/g;\r
- s/\r/\n/g;\r
-\r
- # \e$B%G!<%?$r9TC10L$KJ,3d$9$k\e(B(\e$B:G8e$N2~9TJ8;z0J9_$r\e(B $benbuf \e$B$KJ]B8$9$k\e(B)\r
- @line = split(/\n/,$_,-1);\r
- $benbuf = pop(@line);\r
-\r
- local($result) = "";\r
- foreach (@line){\r
- $_ = &qpencode($_);\r
- $result .= $_ . "\n";\r
- }\r
- $_ = $result;\r
- }\r
- $_;\r
-}\r
-\r
-## &benflush interface ##\r
-sub main'benflush {\r
- local($coding) = @_;\r
- local($ret) = "";\r
- if ((!defined($coding) || $coding eq "" || $coding eq "b64")\r
- && $benbuf ne ""){\r
- $ret = &base64encode($benbuf) . "\n";\r
- $benbuf = "";\r
- }elsif ($coding eq "qp" && $benbuf ne ""){\r
- $ret = &qpencode($benbuf) . "\n";\r
- $benbuf = "";\r
- }\r
- $ret;\r
-}\r
-\r
-## MIME \e$B%X%C%@%(%s%3!<%G%#%s%0\e(B\r
-sub mimeencode {\r
- local($_, $befor, $after) = @_;\r
- local($back, $forw, $blen, $len, $flen, $str);\r
- $befor = substr($befor, rindex($befor, "\n")+1);\r
- $after = substr($after, 0, index($after, "\n")-$[);\r
- $back = " " unless ($befor eq ""\r
- || $befor =~ /[ \t\(]$/);\r
- $forw = " " unless ($after =~ /^\x1b\([BHJ]$/\r
- || $after =~ /^\x1b\([BHJ][ \t\)]/);\r
- $blen = length($befor);\r
- $flen = length($forw)+length($&)-3 if ($after =~ /^$match_ascii/o);\r
- $len = length($_);\r
- return "" if ($len <= 3);\r
- if ($len > 39 || $blen + $mimelen{$len+3} > $limit){\r
- if ($limit-$blen < 30){\r
- $len = 0;\r
- }else{\r
- $len = int(($limit-$blen-26)/4)*2+3;\r
- }\r
- if ($len >= 5){\r
- $str = substr($_, 0, $len).$jis_out;\r
- $str = &base64encode($str);\r
- $str = $mime_head.$str.$mime_tail;\r
- $back.$str."\n ".$jis_in.substr($_, $len);\r
- }else{\r
- "\n ".$_;\r
- }\r
- }else{\r
- $_ .= $jis_out;\r
- $_ = &base64encode($_);\r
- $_ = $back.$mime_head.$_.$mime_tail;\r
- if ($blen + (length) + $flen > $limit){\r
- $_."\n ";\r
- }else{\r
- $_.$forw;\r
- }\r
- }\r
-}\r
-\r
-## MIME base64 \e$B%(%s%3!<%G%#%s%0\e(B\r
-sub base64encode {\r
- local($_) = @_;\r
- $_ = unpack("B".((length)<<3), $_);\r
- $_ .= $zero[(length)%6];\r
- s/.{6}/$mime{$&}/go;\r
- $_.$pad[(length)%4];\r
-}\r
-\r
-## Quoted-Printable \e$B%(%s%3!<%G%#%s%0\e(B\r
-sub qpencode {\r
- local($_) = @_;\r
-\r
- # `=' \e$BJ8;z$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B\r
- s/=/=3D/g;\r
-\r
- # \e$B9TKv$N%?%V$H%9%Z!<%9$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B\r
- s/\t$/=09/;\r
- s/ $/=20/;\r
-\r
- # \e$B0u;z2DG=J8;z\e(B(`!'\e$B!A\e(B`~')\e$B0J30$NJ8;z$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B\r
- s/([^!-~ \t])/&qphex($1)/ge;\r
-\r
- # 1\e$B9T$,\e(B$qfoldcol\e$BJ8;z0J2<$K$J$k$h$&$K%=%U%H2~9T$r$$$l$k\e(B\r
- local($folded, $line) = "";\r
- while (length($_) > $qfoldcol){\r
- $line = substr($_, 0, $qfoldcol-1);\r
- if ($line =~ /=$/){\r
- $line = substr($_, 0, $qfoldcol-2);\r
- $_ = substr($_, $qfoldcol-2);\r
- }elsif ($line =~ /=[0-9A-Fa-f]$/){\r
- $line = substr($_, 0, $qfoldcol-3);\r
- $_ = substr($_, $qfoldcol-3);\r
- }else{\r
- $_ = substr($_, $qfoldcol-1);\r
- }\r
- $folded .= $line . "=\n";\r
- }\r
- $folded . $_;\r
-}\r
-\r
-sub qphex {\r
- local($_) = @_;\r
- $_ = '=' . unpack("H2", $_);\r
- tr/a-f/A-F/;\r
- $_;\r
-}\r
-\r
-## Shift-JIS \e$B$H\e(B EUC \e$B$N$I$A$i$N4A;z%3!<%I$,4^$^$l$k$+$r%A%'%C%/\e(B\r
-sub checkkanji {\r
- local($sjis,$euc);\r
- $sjis += length($&) while(/$match_sjis/go);\r
- $euc += length($&) while(/$match_euc/go);\r
- return 'NONE' if ($sjis == 0 && $euc == 0);\r
- return 'SJIS' if ($sjis > $euc);\r
- return 'EUC' if ($sjis < $euc);\r
- $often_use_kanji;\r
-}\r
-\r
-## EUC \e$B$r\e(B 7bit JIS \e$B$KJQ49\e(B\r
-sub e2j {\r
- local($_) = @_;\r
- tr/\xa1-\xfe/\x21-\x7e/;\r
- $jis_in.$_.$jis_out;\r
-}\r
-\r
-## Shift-JIS \e$B$r\e(B 7bit JIS \e$B$KJQ49\e(B\r
-sub s2j {\r
- local($string);\r
- local(@ch) = split(//, $_[0]);\r
- while(($j1,$j2)=unpack("CC",shift(@ch).shift(@ch))){\r
- if ($j2 > 0x9e){\r
- $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+2;\r
- $j2 -= 0x7e;\r
- }\r
- else{\r
- $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+1;\r
- $j2 -= ($j2>0x7e ? 0x20 : 0x1f);\r
- }\r
- $string .= pack("CC", $j1, $j2);\r
- }\r
- $jis_in.$string.$jis_out;\r
-}\r
-1;\r
+package MIME;
+# Copyright (C) 1993-94,1997 Noboru Ikuta <noboru@ikuta.ichihara.chiba.jp>
+#
+# mimew.pl: MIME encoder library Ver.2.02 (1997/12/30)
+
+$main'mimew_version = "2.02";
+
+# \e$B%$%s%9%H!<%k\e(B : @INC \e$B$N%G%#%l%/%H%j!JDL>o$O\e(B /usr/local/lib/perl\e$B!K$K%3%T!<\e(B
+# \e$B$7$F2<$5$$!#\e(B
+#
+# \e$B;HMQNc\e(B1 : require 'mimew.pl';
+# $from = "From: \e$B@8ED\e(B \e$B>:\e(B <noboru\@ikuta.ichihara.chiba.jp>";
+# print &mimeencode($from);
+#
+# \e$B;HMQNc\e(B2 : # UNIX\e$B$G\e(BBase64\e$B%(%s%3!<%I$9$k>l9g\e(B
+# require 'mimew.pl';
+# undef $/;
+# $body = <>;
+# print &bodyencode($body);
+# print &benflush;
+#
+# &bodyencode($data,$coding):
+# \e$B%G!<%?$r\e(BBase64\e$B7A<0$^$?$O\e(BQuoted-Printable\e$B7A<0$G%(%s%3!<%I$9$k!#\e(B
+# \e$BBh\e(B2\e$B%Q%i%a!<%?$K\e(B"qp"\e$B$^$?$O\e(B"b64"\e$B$r;XDj$9$k$3$H$K$h$j%3!<%G%#%s%07A<0\e(B
+# \e$B$r;X<($9$k$3$H$,$G$-$k!#Bh\e(B2\e$B%Q%i%a!<%?$r>JN,$9$k$H\e(BBase64\e$B7A<0$G%(%s\e(B
+# \e$B%3!<%I$9$k!#\e(B
+# Base64\e$B7A<0$N%(%s%3!<%I$N>l9g$O!"\e(B$foldcol*3/4 \e$B%P%$%HC10L$GJQ49$9$k\e(B
+# \e$B$N$G!"EO$5$l$?%G!<%?$N$&$AH>C<$JItJ,$O%P%C%U%!$KJ]B8$5$l<!$K8F$P$l\e(B
+# \e$B$?$H$-$K=hM}$5$l$k!#:G8e$K%P%C%U%!$K;D$C$?%G!<%?$O\e(B&benflush\e$B$r8F$V\e(B
+# \e$B$3$H$K$h$j=hM}$5$l%P%C%U%!$+$i%/%j%"$5$l$k!#\e(B
+# Quoted-Printable\e$B7A<0$N%(%s%3!<%I$N>l9g$O!"9TC10L$GJQ49$9$k$?$a!"\e(B
+# \e$B%G!<%?$N:G8e$K2~9TJ8;z$,L5$$>l9g!":G8e$N2~9TJ8;z$N8e$m$N%G!<%?$O\e(B
+# \e$B%P%C%U%!$KJ]B8$5$l!"<!$K8F$P$l$?$H$-$K=hM}$5$l$k!#:G8e$K%P%C%U%!\e(B
+# \e$B$K;D$C$?%G!<%?$O\e(B&benflush("qp")\e$B$r8F$V$3$H$K$h$j=hM}$5$l%P%C%U%!\e(B
+# \e$B$+$i%/%j%"$5$l$k!#\e(B
+#
+# &benflush($coding):
+# \e$BBh\e(B1\e$B%Q%i%a!<%?$K\e(B"b64"\e$B$^$?$O\e(B"qp"\e$B$r;XDj$9$k$3$H$K$h$j!"$=$l$>$l\e(BBase64
+# \e$B7A<0$^$?$O\e(BQuoted-Printable\e$B7A<0$N%(%s%3!<%I$r;XDj$9$k$3$H$,$G$-$k!#\e(B
+# \e$BBh\e(B1\e$B%Q%i%a!<%?$K2?$b;XDj$7$J$1$l$P\e(BBase64\e$B7A<0$G%(%s%3!<%I$5$l$k!#\e(B
+# Base64\e$B$N%(%s%3!<%I$N>l9g!"\e(B&bodyencode\e$B$,=hM}$7;D$7$?%G!<%?$r=hM}$7\e(B
+# pad\e$BJ8;z$r=PNO$9$k!#\e(BQuoted-Printable\e$B$N>l9g!"9TC10L$G$J$/%V%m%C%/C1\e(B
+# \e$B0L$G\e(B&bodyencode\e$B$r8F$V>l9g!"\e(B&bodyencode\e$B$,=hM}$7;D$7$?%G!<%?$,$b$7\e(B
+# \e$B%P%C%U%!$K;D$C$F$$$l$P$=$l$r=hM}$9$k!#\e(B
+# \e$B0l$D$N%G!<%?$r\e(B(1\e$B2s$^$?$O2?2s$+$KJ,$1$F\e(B)&bodyencode\e$B$7$?8e$KI,$:\e(B1\e$B2s\e(B
+# \e$B8F$VI,MW$,$"$k!#\e(B
+#
+# &mimeencode($text):
+# \e$BBh\e(B1\e$B%Q%i%a!<%?$,F|K\8lJ8;zNs$r4^$s$G$$$l$P!"$=$NItJ,$r\e(BISO-2022-JP\e$B$K\e(B
+# \e$BJQ49$7$?$"$H!"\e(BMIME encoded-word(RFC2047\e$B;2>H\e(B)\e$B$KJQ49$9$k!#I,MW$K1~$8\e(B
+# \e$B$F\e(Bencoded-word\e$B$NJ,3d$H\e(Bencoded-word\e$B$NA08e$G$N9TJ,3d$r9T$&!#\e(B
+#
+# \e$BJ8;z%3!<%I$N<+F0H=Dj$O!"F10l9T$K\e(BShiftJIS\e$B$H\e(BEUC\e$B$,:.:_$7$F$$$k>l9g$r\e(B
+# \e$B=|$$$F4A;z%3!<%I$N:.:_$K$bBP1~$7$F$$$k!#\e(BShiftJIS\e$B$+\e(BEUC\e$B$+$I$&$7$F$b\e(B
+# \e$BH=CG$G$-$J$$$H$-$O\e(B$often_use_kanji\e$B$K@_Dj$5$l$F$$$k%3!<%I$HH=Dj$9$k!#\e(B
+# ISO-2022-JP\e$B$N%(%9%1!<%W%7!<%1%s%9$O\e(B$jis_in\e$B$H\e(B$jis_out\e$B$K@_Dj$9$k$3$H\e(B
+# \e$B$K$h$jJQ992DG=$G$"$k!#\e(B
+
+$often_use_kanji = 'EUC'; # or 'SJIS'
+
+$jis_in = "\x1b\$B"; # ESC-$-B ( or ESC-$-@ )
+$jis_out = "\x1b\(B"; # ESC-(-B ( or ESC-(-J )
+
+# \e$BG[I[>r7o\e(B : \e$BCx:n8"$OJ|4~$7$^$;$s$,!"G[I[!&2~JQ$O<+M3$H$7$^$9!#2~JQ$7$F\e(B
+# \e$BG[I[$9$k>l9g$O!"%*%j%8%J%k$H0[$J$k$3$H$rL@5-$7!"%*%j%8%J%k\e(B
+# \e$B$N%P!<%8%g%s%J%s%P!<$K2~JQHG%P!<%8%g%s%J%s%P!<$rIU2C$7$?7A\e(B
+# \e$BNc$($P\e(B Ver.2.02-XXXXX \e$B$N$h$&$J%P!<%8%g%s%J%s%P!<$rIU$1$F2<\e(B
+# \e$B$5$$!#$J$*!"\e(BCopyright\e$BI=<($OJQ99$7$J$$$G$/$@$5$$!#\e(B
+#
+# \e$BCm0U\e(B : &mimeencode\e$B$r\e(Bjperl1.X(\e$B$N\e(B2\e$B%P%$%HJ8;zBP1~%b!<%I\e(B)\e$B$G;HMQ$9$k$H!"\e(BSJIS
+# \e$B$H\e(BEUC\e$B$r$&$^$/\e(B7bit JIS(ISO-2022-JP)\e$B$KJQ49$G$-$^$;$s!#\e(B
+# \e$BF~NO$K4^$^$l$kJ8;z$,\e(B7bit JIS(ISO-2022-JP)\e$B$H\e(BASCII\e$B$N$_$G$"$k$3$H\e(B
+# \e$B$,J]>Z$5$l$F$$$k>l9g$r=|$-!"I,$:\e(Boriginal\e$B$N1Q8lHG$N\e(Bperl\e$B!J$^$?$O\e(B
+# jperl1.4\e$B0J>e$r\e(B -Llatin \e$B%*%W%7%g%sIU$-!K$GF0$+$7$F$/$@$5$$!#\e(B
+# \e$B$J$*!"\e(BPerl5\e$BBP1~$N\e(Bjperl\e$B$O;n$7$?$3$H$,$J$$$N$G$I$N$h$&$JF0:n$K$J$k\e(B
+# \e$B$+$o$+$j$^$;$s!#\e(B
+#
+# \e$B;2>H\e(B : RFC1468, RFC2045, RFC2047
+
+## MIME base64 \e$B%"%k%U%!%Y%C%H%F!<%V%k!J\e(BRFC2045\e$B$h$j!K\e(B
+%mime = (
+"000000", "A", "000001", "B", "000010", "C", "000011", "D",
+"000100", "E", "000101", "F", "000110", "G", "000111", "H",
+"001000", "I", "001001", "J", "001010", "K", "001011", "L",
+"001100", "M", "001101", "N", "001110", "O", "001111", "P",
+"010000", "Q", "010001", "R", "010010", "S", "010011", "T",
+"010100", "U", "010101", "V", "010110", "W", "010111", "X",
+"011000", "Y", "011001", "Z", "011010", "a", "011011", "b",
+"011100", "c", "011101", "d", "011110", "e", "011111", "f",
+"100000", "g", "100001", "h", "100010", "i", "100011", "j",
+"100100", "k", "100101", "l", "100110", "m", "100111", "n",
+"101000", "o", "101001", "p", "101010", "q", "101011", "r",
+"101100", "s", "101101", "t", "101110", "u", "101111", "v",
+"110000", "w", "110001", "x", "110010", "y", "110011", "z",
+"110100", "0", "110101", "1", "110110", "2", "110111", "3",
+"111000", "4", "111001", "5", "111010", "6", "111011", "7",
+"111100", "8", "111101", "9", "111110", "+", "111111", "/",
+);
+
+## JIS\e$B%3!<%I\e(B(byte\e$B?t\e(B)\e$B"*\e(Bencoded-word \e$B$NJ8;z?tBP1~\e(B
+%mimelen = (
+ 8,30, 10,34, 12,34, 14,38, 16,42,
+18,42, 20,46, 22,50, 24,50, 26,54,
+28,58, 30,58, 32,62, 34,66, 36,66,
+38,70, 40,74, 42,74,
+);
+
+## \e$B%X%C%@%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B
+$limit=74; ## \e$B!vCm0U!v\e(B $limit\e$B$r\e(B75\e$B$h$jBg$-$$?t;z$K@_Dj$7$F$O$$$1$J$$!#\e(B
+
+## \e$B%\%G%#\e(Bbase64\e$B%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B
+$foldcol=72; ## \e$B!vCm0U!v\e(B $foldcol\e$B$O\e(B76\e$B0J2<$N\e(B4\e$B$NG\?t$K@_Dj$9$k$3$H!#\e(B
+
+## \e$B%\%G%#\e(BQuoted-Printable\e$B%(%s%3!<%I;~$N9T$ND9$5$N@)8B\e(B
+$qfoldcol=75; ## \e$B!vCm0U!v\e(B $foldcol\e$B$O\e(B76\e$B0J2<$K@_Dj$9$k$3$H!#\e(B
+
+## null bit\e$B$NA^F~$H\e(B pad\e$BJ8;z$NA^F~$N$?$a$N%F!<%V%k\e(B
+@zero = ( "", "00000", "0000", "000", "00", "0" );
+@pad = ( "", "===", "==", "=" );
+
+## ASCII, 7bit JIS, Shift-JIS \e$B5Z$S\e(B EUC \e$B$N3F!9$K%^%C%A$9$k%Q%?!<%s\e(B
+$match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)';
+$match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)';
+$match_sjis = '([\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])+';
+$match_euc = '([\xa1-\xfe]{2})+';
+
+## MIME Part 2(charset=`ISO-2022-JP',encoding=`B') \e$B$N\e(B head \e$B$H\e(B tail
+$mime_head = '=?ISO-2022-JP?B?';
+$mime_tail = '?=';
+
+## &bodyencode \e$B$,;H$&=hM};D$7%G!<%?MQ%P%C%U%!\e(B
+$benbuf = "";
+
+## &bodyencode \e$B$N=hM}C10L!J%P%$%H!K\e(B
+$bensize = int($foldcol/4)*3;
+
+## &mimeencode interface ##
+sub main'mimeencode {
+ local($_) = @_;
+ s/$match_jis/$jis_in$1/go;
+ s/$match_ascii/$jis_out$1/go;
+ $kanji = &checkkanji;
+ s/$match_sjis/&s2j($&)/geo if ($kanji eq 'SJIS');
+ s/$match_euc/&e2j($&)/geo if ($kanji eq 'EUC');
+ s/(\x1b[\$\(][BHJ@])+/$1/g;
+ 1 while s/(\x1b\$[B@][\x21-\x7e]+)\x1b\$[B@]/$1/;
+ 1 while s/$match_jis/&mimeencode($&,$`,$')/eo;
+ s/$match_ascii/$1/go;
+ $_;
+}
+
+## &bodyencode interface ##
+sub main'bodyencode {
+ local($_,$coding) = @_;
+ if (!defined($coding) || $coding eq "" || $coding eq "b64"){
+ $_ = $benbuf . $_;
+ local($cut) = int((length)/$bensize)*$bensize;
+ $benbuf = substr($_, $cut+$[);
+ $_ = substr($_, $[, $cut);
+ $_ = &base64encode($_);
+ s/.{$foldcol}/$&\n/g;
+ }elsif ($coding eq "qp"){
+ # $benbuf \e$B$,6u$G$J$1$l$P%G!<%?$N:G=i$KDI2C$9$k\e(B
+ $_ = $benbuf . $_;
+
+ # \e$B2~9TJ8;z$r@55,2=$9$k\e(B
+ s/\r\n/\n/g;
+ s/\r/\n/g;
+
+ # \e$B%G!<%?$r9TC10L$KJ,3d$9$k\e(B(\e$B:G8e$N2~9TJ8;z0J9_$r\e(B $benbuf \e$B$KJ]B8$9$k\e(B)
+ @line = split(/\n/,$_,-1);
+ $benbuf = pop(@line);
+
+ local($result) = "";
+ foreach (@line){
+ $_ = &qpencode($_);
+ $result .= $_ . "\n";
+ }
+ $_ = $result;
+ }
+ $_;
+}
+
+## &benflush interface ##
+sub main'benflush {
+ local($coding) = @_;
+ local($ret) = "";
+ if ((!defined($coding) || $coding eq "" || $coding eq "b64")
+ && $benbuf ne ""){
+ $ret = &base64encode($benbuf) . "\n";
+ $benbuf = "";
+ }elsif ($coding eq "qp" && $benbuf ne ""){
+ $ret = &qpencode($benbuf) . "\n";
+ $benbuf = "";
+ }
+ $ret;
+}
+
+## MIME \e$B%X%C%@%(%s%3!<%G%#%s%0\e(B
+sub mimeencode {
+ local($_, $befor, $after) = @_;
+ local($back, $forw, $blen, $len, $flen, $str);
+ $befor = substr($befor, rindex($befor, "\n")+1);
+ $after = substr($after, 0, index($after, "\n")-$[);
+ $back = " " unless ($befor eq ""
+ || $befor =~ /[ \t\(]$/);
+ $forw = " " unless ($after =~ /^\x1b\([BHJ]$/
+ || $after =~ /^\x1b\([BHJ][ \t\)]/);
+ $blen = length($befor);
+ $flen = length($forw)+length($&)-3 if ($after =~ /^$match_ascii/o);
+ $len = length($_);
+ return "" if ($len <= 3);
+ if ($len > 39 || $blen + $mimelen{$len+3} > $limit){
+ if ($limit-$blen < 30){
+ $len = 0;
+ }else{
+ $len = int(($limit-$blen-26)/4)*2+3;
+ }
+ if ($len >= 5){
+ $str = substr($_, 0, $len).$jis_out;
+ $str = &base64encode($str);
+ $str = $mime_head.$str.$mime_tail;
+ $back.$str."\n ".$jis_in.substr($_, $len);
+ }else{
+ "\n ".$_;
+ }
+ }else{
+ $_ .= $jis_out;
+ $_ = &base64encode($_);
+ $_ = $back.$mime_head.$_.$mime_tail;
+ if ($blen + (length) + $flen > $limit){
+ $_."\n ";
+ }else{
+ $_.$forw;
+ }
+ }
+}
+
+## MIME base64 \e$B%(%s%3!<%G%#%s%0\e(B
+sub base64encode {
+ local($_) = @_;
+ $_ = unpack("B".((length)<<3), $_);
+ $_ .= $zero[(length)%6];
+ s/.{6}/$mime{$&}/go;
+ $_.$pad[(length)%4];
+}
+
+## Quoted-Printable \e$B%(%s%3!<%G%#%s%0\e(B
+sub qpencode {
+ local($_) = @_;
+
+ # `=' \e$BJ8;z$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B
+ s/=/=3D/g;
+
+ # \e$B9TKv$N%?%V$H%9%Z!<%9$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B
+ s/\t$/=09/;
+ s/ $/=20/;
+
+ # \e$B0u;z2DG=J8;z\e(B(`!'\e$B!A\e(B`~')\e$B0J30$NJ8;z$r\e(B16\e$B?JI=8=$KJQ49$9$k\e(B
+ s/([^!-~ \t])/&qphex($1)/ge;
+
+ # 1\e$B9T$,\e(B$qfoldcol\e$BJ8;z0J2<$K$J$k$h$&$K%=%U%H2~9T$r$$$l$k\e(B
+ local($folded, $line) = "";
+ while (length($_) > $qfoldcol){
+ $line = substr($_, 0, $qfoldcol-1);
+ if ($line =~ /=$/){
+ $line = substr($_, 0, $qfoldcol-2);
+ $_ = substr($_, $qfoldcol-2);
+ }elsif ($line =~ /=[0-9A-Fa-f]$/){
+ $line = substr($_, 0, $qfoldcol-3);
+ $_ = substr($_, $qfoldcol-3);
+ }else{
+ $_ = substr($_, $qfoldcol-1);
+ }
+ $folded .= $line . "=\n";
+ }
+ $folded . $_;
+}
+
+sub qphex {
+ local($_) = @_;
+ $_ = '=' . unpack("H2", $_);
+ tr/a-f/A-F/;
+ $_;
+}
+
+## Shift-JIS \e$B$H\e(B EUC \e$B$N$I$A$i$N4A;z%3!<%I$,4^$^$l$k$+$r%A%'%C%/\e(B
+sub checkkanji {
+ local($sjis,$euc);
+ $sjis += length($&) while(/$match_sjis/go);
+ $euc += length($&) while(/$match_euc/go);
+ return 'NONE' if ($sjis == 0 && $euc == 0);
+ return 'SJIS' if ($sjis > $euc);
+ return 'EUC' if ($sjis < $euc);
+ $often_use_kanji;
+}
+
+## EUC \e$B$r\e(B 7bit JIS \e$B$KJQ49\e(B
+sub e2j {
+ local($_) = @_;
+ tr/\xa1-\xfe/\x21-\x7e/;
+ $jis_in.$_.$jis_out;
+}
+
+## Shift-JIS \e$B$r\e(B 7bit JIS \e$B$KJQ49\e(B
+sub s2j {
+ local($string);
+ local(@ch) = split(//, $_[0]);
+ while(($j1,$j2)=unpack("CC",shift(@ch).shift(@ch))){
+ if ($j2 > 0x9e){
+ $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+2;
+ $j2 -= 0x7e;
+ }
+ else{
+ $j1 = (($j1>0x9f ? $j1-0xb1 : $j1-0x71)<<1)+1;
+ $j2 -= ($j2>0x7e ? 0x20 : 0x1f);
+ }
+ $string .= pack("CC", $j1, $j2);
+ }
+ $jis_in.$string.$jis_out;
+}
+1;
-################################################################################\r
-#\r
-# ÀßÄê¥Õ¥¡¥¤¥ë\r
-#\r
-################################################################################\r
-#===============================================================================\r
-# ½é´üÀßÄê\r
-#===============================================================================\r
-$DATA_DIR = './data';\r
-$BACKUP_DIR = './backup';\r
-$ATTACH_DIR = './attach';\r
-$THEME_URL = './theme/default/default.css';\r
-$ADMIN_MAIL = '';\r
-$SEND_MAIL = '';\r
-$WIKI_NAME = 0;\r
-$MAIN_SCRIPT = 'wiki.cgi';\r
-$EDIT_SCRIPT = 'edit.cgi';\r
-$CATEGORY_SCRIPT = 'category.cgi';\r
-$DOWNLOAD_SCRIPT = 'download.cgi';\r
-$SITE_TITLE = 'FSWikiLite';\r
-\r
-#===============================================================================\r
-# ¥×¥í¥À¥¯¥È¾ðÊó\r
-#===============================================================================\r
-$VERSION = '0.0.12';\r
-$SITE_URL = 'http://fswiki.poi.jp/';\r
-\r
-#===============================================================================\r
-# ¥×¥é¥°¥¤¥ó¤ÎÀßÄê\r
-#===============================================================================\r
-require "./plugin/core.pl";\r
-\r
-1;\r
+################################################################################
+#
+# ÀßÄê¥Õ¥¡¥¤¥ë
+#
+################################################################################
+#===============================================================================
+# ½é´üÀßÄê
+#===============================================================================
+$DATA_DIR = './data';
+$BACKUP_DIR = './backup';
+$ATTACH_DIR = './attach';
+$THEME_URL = './theme/default/default.css';
+$ADMIN_MAIL = '';
+$SEND_MAIL = '';
+$WIKI_NAME = 0;
+$MAIN_SCRIPT = 'wiki.cgi';
+$EDIT_SCRIPT = 'edit.cgi';
+$CATEGORY_SCRIPT = 'category.cgi';
+$DOWNLOAD_SCRIPT = 'download.cgi';
+$SITE_TITLE = 'FSWikiLite';
+
+#===============================================================================
+# ¥×¥í¥À¥¯¥È¾ðÊó
+#===============================================================================
+$VERSION = '0.0.12';
+$SITE_URL = 'http://fswiki.osdn.jp/cgi-bin/wiki.cgi';
+
+#===============================================================================
+# ¥×¥é¥°¥¤¥ó¤ÎÀßÄê
+#===============================================================================
+require "./plugin/core.pl";
+
+1;
-################################################################################\r
-#\r
-# ¥³¥¢¥×¥é¥°¥¤¥ó¤Î¼ÂÁõ\r
-#\r
-################################################################################\r
-package Wiki::Plugin;\r
-\r
-BEGIN {\r
- # ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¤Î¥¨¥ó¥È¥ê\r
- $main::P_PLUGIN->{recent} = \&Wiki::Plugin::recent;\r
- $main::P_PLUGIN->{recentdays} = \&Wiki::Plugin::recentdays;\r
- $main::P_PLUGIN->{category_list} = \&Wiki::Plugin::category_list;\r
- $main::P_PLUGIN->{ref_image} = \&Wiki::Plugin::ref_image;\r
- $main::P_PLUGIN->{ref_text} = \&Wiki::Plugin::ref_text;\r
- $main::P_PLUGIN->{outline} = \&Wiki::Plugin::outline;\r
- $main::P_PLUGIN->{search} = \&Wiki::Plugin::search;\r
- \r
- # ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤Î¥¨¥ó¥È¥ê\r
- $main::I_PLUGIN->{category} = \&Wiki::Plugin::category;\r
- $main::I_PLUGIN->{lastmodified} = \&Wiki::Plugin::lastmodified;\r
- $main::I_PLUGIN->{ref} = \&Wiki::Plugin::ref;\r
-}\r
-\r
-#==============================================================================\r
-# ¥Ú¡¼¥¸¤Î°ìÍ÷¤ò¹¹¿·Æü»þ½ç¤Ëɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£\r
-#==============================================================================\r
-sub recent {\r
- my $max = shift;\r
- $max = 0 if($max eq "");\r
- my $buf = "";\r
- \r
- my @pages = &Wiki::get_page_list();\r
- my $count = 0;\r
- \r
- $buf .= "<ul>\n";\r
- foreach my $page (@pages){\r
- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".\r
- &Util::escapeHTML($page->{NAME})."</a></li>\n";\r
- $count++;\r
- last if($count==$max && $max!=0);\r
- }\r
- $buf .= "</ul>\n";\r
- \r
- return $buf;\r
-}\r
-\r
-#==============================================================================\r
-# ÆüÉÕ¤´¤È¤Ë¹¹¿·¤µ¤ì¤¿¥Ú¡¼¥¸¤ò°ìÍ÷ɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£\r
-#==============================================================================\r
-sub recentdays {\r
- my $max = shift;\r
- $max = 5 if($max eq "");\r
- my $buf = "";\r
- \r
- my @pages = &Wiki::get_page_list();\r
- my $count = 0;\r
- \r
- my $last_year = 0;\r
- my $last_mon = 0;\r
- my $last_day = 0;\r
- \r
- foreach my $page (@pages){\r
- my ($sec, $min, $hour, $day, $mon, $year) = localtime($page->{TIME});\r
- \r
- $year += 1900;\r
- $mon += 1;\r
- \r
- if($last_year!=$year || $last_mon!=$mon || $last_day!=$day){\r
- \r
- $count++;\r
- last if($count == $max+1);\r
- \r
- $last_year = $year;\r
- $last_mon = $mon;\r
- $last_day = $day;\r
- \r
- $buf .= "</ul>\n" if($buf ne "");\r
- $buf .= sprintf("<b>%04d/%02d/%02d</b>\n",$year,$mon,$day);\r
- $buf .= "<ul>\n";\r
- }\r
- \r
- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".\r
- &Util::escapeHTML($page->{NAME})."</a></li>\n";\r
- }\r
- \r
- if($buf ne ""){\r
- $buf .= "</UL>\n";\r
- }\r
- \r
- return $buf;\r
-}\r
-\r
-#==============================================================================\r
-# ¥Ú¡¼¥¸¤ò¥«¥Æ¥´¥é¥¤¥º¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£\r
-#==============================================================================\r
-sub category {\r
- my $category = shift;\r
- if($category eq ""){\r
- return "¥«¥Æ¥´¥ê¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";\r
- } else {\r
- return "[<a href=\"$main::CATEGORY_SCRIPT?c=".&Util::url_encode($category)."\">".\r
- "¥«¥Æ¥´¥ê:".&Util::escapeHTML($category)."</a>]";\r
- }\r
-}\r
-\r
-#=============================================================================\r
-# ¥Ú¡¼¥¸¤ÎºÇ½ª¹¹¿·Æü»þ¤òɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£\r
-#=============================================================================\r
-sub lastmodified {\r
- my $page = $main::in{"p"};\r
- if(&Wiki::exists_page($page)){\r
- return "ºÇ½ª¹¹¿·»þ´Ö¡§".&Util::format_date(&Wiki::get_last_modified($page));\r
- } else {\r
- return undef;\r
- }\r
-}\r
-\r
-#=============================================================================\r
-# ¥«¥Æ¥´¥ê¤´¤È¤Î¥Ú¡¼¥¸°ìÍ÷¤òɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£\r
-#=============================================================================\r
-sub category_list {\r
- my $category = shift;\r
- my $buf = "";\r
- \r
- # »ØÄꤵ¤ì¤¿¥«¥Æ¥´¥ê¤òɽ¼¨\r
- if($category ne ""){\r
- my @pages = &Wiki::get_page_list();\r
- $buf .= "<h2>".&Util::escapeHTML($category)."</h2>\n";\r
- $buf .= "<ul>\n";\r
- #foreach my $page (sort(@pages)){\r
- foreach my $page (sort {$a->{NAME} cmp $b->{NAME}} @pages){\r
- my $source = &Wiki::get_page($page->{NAME});\r
- foreach my $line (split(/\n/,$source)){\r
- # ¥³¥á¥ó¥È¤«À°·ÁºÑ¥Æ¥¥¹¥È¤Î¾ì¹ç¤ÏÈô¤Ð¤¹\r
- next if($line =~ /^(\t| |\/\/)/);\r
- \r
- # ¥«¥Æ¥´¥ê¤Ë¥Þ¥Ã¥Á¤·¤¿¤é¥ê¥¹¥Æ¥£¥ó¥°\r
- if($line =~ /{{category\s+$category}}/){\r
- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".\r
- &Util::escapeHTML($page->{NAME})."</a></li>";\r
- last;\r
- }\r
- }\r
- }\r
- $buf .= "</ul>\n";\r
- \r
- # Á´¤Æ¤Î¥«¥Æ¥´¥ê¤òɽ¼¨\r
- } else {\r
- my $category = {};\r
- my @pages = &Wiki::get_page_list();\r
- \r
- foreach my $page (@pages){\r
- my $source = &Wiki::get_page($page->{NAME});\r
- foreach my $line (split(/\n/,$source)){\r
- # ¥³¥á¥ó¥È¤«À°·ÁºÑ¥Æ¥¥¹¥È¤Î¾ì¹ç¤ÏÈô¤Ð¤¹\r
- next if($line =~ /^(\t| |\/\/)/);\r
- \r
- # ¥«¥Æ¥´¥ê¤Ë¥Þ¥Ã¥Á¤·¤¿¤é¥ê¥¹¥Æ¥£¥ó¥°\r
- while($line =~ /{{category\s+(.+?)}}/g){\r
- $category->{$1}->{$page->{NAME}} = 1;\r
- }\r
- }\r
- }\r
- \r
- foreach my $name (sort(keys(%$category))){\r
- $buf .= "<h2>".&Util::escapeHTML($name)."</h2>\n";\r
- $buf .= "<ul>\n";\r
- foreach my $page (sort(keys(%{$category->{$name}}))){\r
- $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">".\r
- &Util::escapeHTML($page)."</a></li>\n";\r
- }\r
- $buf .= "</ul>\n";\r
- }\r
- }\r
- return $buf;\r
-}\r
-\r
-#=============================================================================\r
-# źÉÕ¥Õ¥¡¥¤¥ë¤Ø¤Î¥ê¥ó¥¯¤òɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£\r
-#=============================================================================\r
-sub ref {\r
- my $page = $main::in{"p"};\r
- my $file = shift;\r
- \r
- if($file eq ""){\r
- return "¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";\r
- }\r
- \r
- my $filename = sprintf("$main::ATTACH_DIR/%s.%s",\r
- &Util::url_encode($page),&Util::url_encode($file));\r
- unless(-e $filename){\r
- return "¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Þ¤»¤ó¡£";\r
- }\r
- \r
- return sprintf("<a href=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>",\r
- &Util::url_encode($page),&Util::url_encode($file),$file);\r
-}\r
-\r
-#=============================================================================\r
-# źÉÕ¥Õ¥¡¥¤¥ë¤ò²èÁü¤È¤·¤Æɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£\r
-#=============================================================================\r
-sub ref_image {\r
- my $page = $main::in{"p"};\r
- my $file = shift;\r
- \r
- if($file eq ""){\r
- return "¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";\r
- }\r
- \r
- my $filename = sprintf("$main::ATTACH_DIR/%s.%s",\r
- &Util::url_encode($page),&Util::url_encode($file));\r
- unless(-e $filename){\r
- return "<p>¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Þ¤»¤ó¡£</p>\n";\r
- }\r
- \r
- return sprintf("<div><img src=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\"></div>",\r
- &Util::url_encode($page),&Util::url_encode($file));\r
-}\r
-\r
-#=============================================================================\r
-# źÉÕ¥Õ¥¡¥¤¥ë¤ò²èÁü¤È¤·¤Æɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£\r
-#=============================================================================\r
-sub ref_text {\r
- my $page = $main::in{"p"};\r
- my $file = shift;\r
- \r
- if($file eq ""){\r
- return "¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";\r
- }\r
- \r
- my $filename = sprintf("$main::ATTACH_DIR/%s.%s",\r
- &Util::url_encode($page),&Util::url_encode($file));\r
- unless(-e $filename){\r
- return "<p>¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Þ¤»¤ó¡£</p>\n";\r
- }\r
- \r
- my $text = "";\r
- open(DATA,$filename);\r
- while(<DATA>){\r
- $text .= $_;\r
- }\r
- close(DATA);\r
- \r
- # ²þ¹Ô¥³¡¼¥É¤òÊÑ´¹\r
- $text =~ s/\r\n/\n/g;\r
- $text =~ s/\r/\n/g;\r
- # ʸ»ú¥³¡¼¥É¤òÊÑ´¹\r
- &jcode::convert(\$text,"euc");\r
- \r
- # pre¥¿¥°¤ò¤Ä¤±¤ÆÊÖµÑ\r
- return "<pre>".&Util::escapeHTML($text)."</pre>\n";\r
-}\r
-\r
-#=============================================================================\r
-# ¥¢¥¦¥È¥é¥¤¥ó¤òɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó\r
-# ½ÐÎϤµ¤ì¤ëHTML¤Ï¤Á¤ç¤Ã¤È¼êÈ´¤¤Ç¤¹¡Ä\r
-#=============================================================================\r
-sub outline {\r
- my $page = $main::in{'p'};\r
- my $source = &Wiki::get_page($page);\r
- my $level = 0;\r
- my $count = 0;\r
- my $buf = "";\r
- foreach my $line (split(/\n/,$source)){\r
- if($line=~/^(!{1,3})(.+)$/){\r
- my $find_level = 4 - length($1);\r
- \r
- while($level < $find_level){\r
- $buf .= "<ul>\n";\r
- $level++;\r
- }\r
- \r
- while($level > $find_level){\r
- $buf .= "</ul>\n";\r
- $level--;\r
- }\r
- my $section = &Util::delete_tag(&Wiki::process_wiki($2));\r
- \r
- $buf .= "<li><a href=\"#p$count\">$section</a></li>\n";\r
- $count++;\r
- }\r
- }\r
- while($level > 0){\r
- $buf .= "</ul>\n";\r
- $level--;\r
- }\r
- return $buf;\r
-}\r
-\r
-#=============================================================================\r
-# ¸¡º÷¥Õ¥©¡¼¥à¤òɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó\r
-#=============================================================================\r
-sub search {\r
- return "<form action=\"$main::MAIN_SCRIPT\" method=\"GET\">\n".\r
- " ¥¡¼¥ï¡¼¥É <input type=\"text\" name=\"w\" size=\"20\" value=\"".&Util::escapeHTML($main::in{'w'})."\">\n".\r
- " <input type=\"submit\" value=\" ¸¡ º÷ \">\n".\r
- " <input type=\"hidden\" name=\"a\" value=\"search\">\n".\r
- "</form>\n";\r
-}\r
-\r
-1;\r
+################################################################################
+#
+# ¥³¥¢¥×¥é¥°¥¤¥ó¤Î¼ÂÁõ
+#
+################################################################################
+package Wiki::Plugin;
+
+BEGIN {
+ # ¥Ñ¥é¥°¥é¥Õ¥×¥é¥°¥¤¥ó¤Î¥¨¥ó¥È¥ê
+ $main::P_PLUGIN->{recent} = \&Wiki::Plugin::recent;
+ $main::P_PLUGIN->{recentdays} = \&Wiki::Plugin::recentdays;
+ $main::P_PLUGIN->{category_list} = \&Wiki::Plugin::category_list;
+ $main::P_PLUGIN->{ref_image} = \&Wiki::Plugin::ref_image;
+ $main::P_PLUGIN->{ref_text} = \&Wiki::Plugin::ref_text;
+ $main::P_PLUGIN->{outline} = \&Wiki::Plugin::outline;
+ $main::P_PLUGIN->{search} = \&Wiki::Plugin::search;
+
+ # ¥¤¥ó¥é¥¤¥ó¥×¥é¥°¥¤¥ó¤Î¥¨¥ó¥È¥ê
+ $main::I_PLUGIN->{category} = \&Wiki::Plugin::category;
+ $main::I_PLUGIN->{lastmodified} = \&Wiki::Plugin::lastmodified;
+ $main::I_PLUGIN->{ref} = \&Wiki::Plugin::ref;
+}
+
+#==============================================================================
+# ¥Ú¡¼¥¸¤Î°ìÍ÷¤ò¹¹¿·Æü»þ½ç¤Ëɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£
+#==============================================================================
+sub recent {
+ my $max = shift;
+ $max = 0 if($max eq "");
+ my $buf = "";
+
+ my @pages = &Wiki::get_page_list();
+ my $count = 0;
+
+ $buf .= "<ul>\n";
+ foreach my $page (@pages){
+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
+ &Util::escapeHTML($page->{NAME})."</a></li>\n";
+ $count++;
+ last if($count==$max && $max!=0);
+ }
+ $buf .= "</ul>\n";
+
+ return $buf;
+}
+
+#==============================================================================
+# ÆüÉÕ¤´¤È¤Ë¹¹¿·¤µ¤ì¤¿¥Ú¡¼¥¸¤ò°ìÍ÷ɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£
+#==============================================================================
+sub recentdays {
+ my $max = shift;
+ $max = 5 if($max eq "");
+ my $buf = "";
+
+ my @pages = &Wiki::get_page_list();
+ my $count = 0;
+
+ my $last_year = 0;
+ my $last_mon = 0;
+ my $last_day = 0;
+
+ foreach my $page (@pages){
+ my ($sec, $min, $hour, $day, $mon, $year) = localtime($page->{TIME});
+
+ $year += 1900;
+ $mon += 1;
+
+ if($last_year!=$year || $last_mon!=$mon || $last_day!=$day){
+
+ $count++;
+ last if($count == $max+1);
+
+ $last_year = $year;
+ $last_mon = $mon;
+ $last_day = $day;
+
+ $buf .= "</ul>\n" if($buf ne "");
+ $buf .= sprintf("<b>%04d/%02d/%02d</b>\n",$year,$mon,$day);
+ $buf .= "<ul>\n";
+ }
+
+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
+ &Util::escapeHTML($page->{NAME})."</a></li>\n";
+ }
+
+ if($buf ne ""){
+ $buf .= "</UL>\n";
+ }
+
+ return $buf;
+}
+
+#==============================================================================
+# ¥Ú¡¼¥¸¤ò¥«¥Æ¥´¥é¥¤¥º¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£
+#==============================================================================
+sub category {
+ my $category = shift;
+ if($category eq ""){
+ return "¥«¥Æ¥´¥ê¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";
+ } else {
+ return "[<a href=\"$main::CATEGORY_SCRIPT?c=".&Util::url_encode($category)."\">".
+ "¥«¥Æ¥´¥ê:".&Util::escapeHTML($category)."</a>]";
+ }
+}
+
+#=============================================================================
+# ¥Ú¡¼¥¸¤ÎºÇ½ª¹¹¿·Æü»þ¤òɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£
+#=============================================================================
+sub lastmodified {
+ my $page = $main::in{"p"};
+ if(&Wiki::exists_page($page)){
+ return "ºÇ½ª¹¹¿·»þ´Ö¡§".&Util::format_date(&Wiki::get_last_modified($page));
+ } else {
+ return undef;
+ }
+}
+
+#=============================================================================
+# ¥«¥Æ¥´¥ê¤´¤È¤Î¥Ú¡¼¥¸°ìÍ÷¤òɽ¼¨¤¹¤ë¥×¥é¥°¥¤¥ó¡£
+#=============================================================================
+sub category_list {
+ my $category = shift;
+ my $buf = "";
+
+ # »ØÄꤵ¤ì¤¿¥«¥Æ¥´¥ê¤òɽ¼¨
+ if($category ne ""){
+ my @pages = &Wiki::get_page_list();
+ $buf .= "<h2>".&Util::escapeHTML($category)."</h2>\n";
+ $buf .= "<ul>\n";
+ #foreach my $page (sort(@pages)){
+ foreach my $page (sort {$a->{NAME} cmp $b->{NAME}} @pages){
+ my $source = &Wiki::get_page($page->{NAME});
+ foreach my $line (split(/\n/,$source)){
+ # ¥³¥á¥ó¥È¤«À°·ÁºÑ¥Æ¥¥¹¥È¤Î¾ì¹ç¤ÏÈô¤Ð¤¹
+ next if($line =~ /^(\t| |\/\/)/);
+
+ # ¥«¥Æ¥´¥ê¤Ë¥Þ¥Ã¥Á¤·¤¿¤é¥ê¥¹¥Æ¥£¥ó¥°
+ if($line =~ /{{category\s+$category}}/){
+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
+ &Util::escapeHTML($page->{NAME})."</a></li>";
+ last;
+ }
+ }
+ }
+ $buf .= "</ul>\n";
+
+ # Á´¤Æ¤Î¥«¥Æ¥´¥ê¤òɽ¼¨
+ } else {
+ my $category = {};
+ my @pages = &Wiki::get_page_list();
+
+ foreach my $page (@pages){
+ my $source = &Wiki::get_page($page->{NAME});
+ foreach my $line (split(/\n/,$source)){
+ # ¥³¥á¥ó¥È¤«À°·ÁºÑ¥Æ¥¥¹¥È¤Î¾ì¹ç¤ÏÈô¤Ð¤¹
+ next if($line =~ /^(\t| |\/\/)/);
+
+ # ¥«¥Æ¥´¥ê¤Ë¥Þ¥Ã¥Á¤·¤¿¤é¥ê¥¹¥Æ¥£¥ó¥°
+ while($line =~ /{{category\s+(.+?)}}/g){
+ $category->{$1}->{$page->{NAME}} = 1;
+ }
+ }
+ }
+
+ foreach my $name (sort(keys(%$category))){
+ $buf .= "<h2>".&Util::escapeHTML($name)."</h2>\n";
+ $buf .= "<ul>\n";
+ foreach my $page (sort(keys(%{$category->{$name}}))){
+ $buf .= "<li><a href=\"$main::MAIN_SCRIPT?p=".&Util::url_encode($page)."\">".
+ &Util::escapeHTML($page)."</a></li>\n";
+ }
+ $buf .= "</ul>\n";
+ }
+ }
+ return $buf;
+}
+
+#=============================================================================
+# źÉÕ¥Õ¥¡¥¤¥ë¤Ø¤Î¥ê¥ó¥¯¤òɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£
+#=============================================================================
+sub ref {
+ my $page = $main::in{"p"};
+ my $file = shift;
+
+ if($file eq ""){
+ return "¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";
+ }
+
+ my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
+ &Util::url_encode($page),&Util::url_encode($file));
+ unless(-e $filename){
+ return "¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Þ¤»¤ó¡£";
+ }
+
+ return sprintf("<a href=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\">%s</a>",
+ &Util::url_encode($page),&Util::url_encode($file),$file);
+}
+
+#=============================================================================
+# źÉÕ¥Õ¥¡¥¤¥ë¤ò²èÁü¤È¤·¤Æɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£
+#=============================================================================
+sub ref_image {
+ my $page = $main::in{"p"};
+ my $file = shift;
+
+ if($file eq ""){
+ return "¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";
+ }
+
+ my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
+ &Util::url_encode($page),&Util::url_encode($file));
+ unless(-e $filename){
+ return "<p>¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Þ¤»¤ó¡£</p>\n";
+ }
+
+ return sprintf("<div><img src=\"$main::DOWNLOAD_SCRIPT?p=%s&f=%s\"></div>",
+ &Util::url_encode($page),&Util::url_encode($file));
+}
+
+#=============================================================================
+# źÉÕ¥Õ¥¡¥¤¥ë¤ò²èÁü¤È¤·¤Æɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¡£
+#=============================================================================
+sub ref_text {
+ my $page = $main::in{"p"};
+ my $file = shift;
+
+ if($file eq ""){
+ return "¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£";
+ }
+
+ my $filename = sprintf("$main::ATTACH_DIR/%s.%s",
+ &Util::url_encode($page),&Util::url_encode($file));
+ unless(-e $filename){
+ return "<p>¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Þ¤»¤ó¡£</p>\n";
+ }
+
+ my $text = "";
+ open(DATA,$filename);
+ while(<DATA>){
+ $text .= $_;
+ }
+ close(DATA);
+
+ # ²þ¹Ô¥³¡¼¥É¤òÊÑ´¹
+ $text =~ s/\r\n/\n/g;
+ $text =~ s/\r/\n/g;
+ # ʸ»ú¥³¡¼¥É¤òÊÑ´¹
+ &jcode::convert(\$text,"euc");
+
+ # pre¥¿¥°¤ò¤Ä¤±¤ÆÊÖµÑ
+ return "<pre>".&Util::escapeHTML($text)."</pre>\n";
+}
+
+#=============================================================================
+# ¥¢¥¦¥È¥é¥¤¥ó¤òɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó
+# ½ÐÎϤµ¤ì¤ëHTML¤Ï¤Á¤ç¤Ã¤È¼êÈ´¤¤Ç¤¹¡Ä
+#=============================================================================
+sub outline {
+ my $page = $main::in{'p'};
+ my $source = &Wiki::get_page($page);
+ my $level = 0;
+ my $count = 0;
+ my $buf = "";
+ foreach my $line (split(/\n/,$source)){
+ if($line=~/^(!{1,3})(.+)$/){
+ my $find_level = 4 - length($1);
+
+ while($level < $find_level){
+ $buf .= "<ul>\n";
+ $level++;
+ }
+
+ while($level > $find_level){
+ $buf .= "</ul>\n";
+ $level--;
+ }
+ my $section = &Util::delete_tag(&Wiki::process_wiki($2));
+
+ $buf .= "<li><a href=\"#p$count\">$section</a></li>\n";
+ $count++;
+ }
+ }
+ while($level > 0){
+ $buf .= "</ul>\n";
+ $level--;
+ }
+ return $buf;
+}
+
+#=============================================================================
+# ¸¡º÷¥Õ¥©¡¼¥à¤òɽ¼¨¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó
+#=============================================================================
+sub search {
+ return "<form action=\"$main::MAIN_SCRIPT\" method=\"GET\">\n".
+ " ¥¡¼¥ï¡¼¥É <input type=\"text\" name=\"w\" size=\"20\" value=\"".&Util::escapeHTML($main::in{'w'})."\">\n".
+ " <input type=\"submit\" value=\" ¸¡ º÷ \">\n".
+ " <input type=\"hidden\" name=\"a\" value=\"search\">\n".
+ "</form>\n";
+}
+
+1;
-#!/bin/sh\r
-##########################################################################\r
-#\r
-# FSWikiLite¥ê¥ê¡¼¥¹ÍÑ¥·¥§¥ë¥¹¥¯¥ê¥×¥È\r
-#\r
-##########################################################################\r
-#=========================================================================\r
-# °ú¿ô¤Î¥Á¥§¥Ã¥¯\r
-#=========================================================================\r
-if [ $# -lt 1 ]\r
-then\r
- echo "./release.sh version"\r
- exit 1\r
-fi\r
-\r
-#=========================================================================\r
-# ¥Ð¡¼¥¸¥ç¥ó¾ðÊó\r
-#=========================================================================\r
-VERSION=$1\r
-RELEASE="fswiki_lite_$VERSION"\r
-\r
-#=========================================================================\r
-# ¥Æ¥ó¥Ý¥é¥ê¥Ç¥£¥ì¥¯¥È¥ê¤¬¤¢¤ë¾ì¹ç¤Ïºï½ü\r
-#=========================================================================\r
-if [ -e $RELEASE ]; then\r
- echo "delete temp directory..."\r
- rm -rf $RELEASE\r
-fi\r
-\r
-#=========================================================================\r
-# zip¥Õ¥¡¥¤¥ë¤¬¤¢¤ë¾ì¹ç¤Ïºï½ü\r
-#=========================================================================\r
-if [ -e $RELEASE.zip ]; then\r
- echo "delete zip file..."\r
- rm -f $RELEASE.zip\r
-fi\r
-\r
-#=========================================================================\r
-# ¥Æ¥ó¥Ý¥é¥ê¥Ç¥£¥ì¥¯¥È¥ê¤ÎºîÀ®\r
-#=========================================================================\r
-echo "create temp directory..."\r
-mkdir $RELEASE\r
-\r
-#=========================================================================\r
-# ¥Õ¥¡¥¤¥ë¤Î¥³¥Ô¡¼\r
-#=========================================================================\r
-echo "copy to temp directory..."\r
-cp ./*.cgi $RELEASE\r
-cp -r ./docs $RELEASE\r
-cp -r ./lib $RELEASE\r
-cp -r ./plugin $RELEASE\r
-\r
-#=========================================================================\r
-# zip¥Õ¥¡¥¤¥ë¤ÎºîÀ®\r
-#=========================================================================\r
-echo "create zip file..."\r
-find ./$RELEASE \! -path '*/CVS*' -exec zip $RELEASE.zip {} \;\r
-\r
-#=========================================================================\r
-# ¥Æ¥ó¥Ý¥é¥ê¥Ç¥£¥ì¥¯¥È¥ê¤òºï½ü\r
-#=========================================================================\r
-echo "remove temp directory..."\r
-rm -rf $RELEASE\r
-\r
-#=========================================================================\r
-# ½ªÎ»\r
-#=========================================================================\r
-echo "complete."\r
+#!/bin/sh
+##########################################################################
+#
+# FSWikiLite¥ê¥ê¡¼¥¹ÍÑ¥·¥§¥ë¥¹¥¯¥ê¥×¥È
+#
+##########################################################################
+#=========================================================================
+# °ú¿ô¤Î¥Á¥§¥Ã¥¯
+#=========================================================================
+if [ $# -lt 1 ]
+then
+ echo "./release.sh version"
+ exit 1
+fi
+
+#=========================================================================
+# ¥Ð¡¼¥¸¥ç¥ó¾ðÊó
+#=========================================================================
+VERSION=$1
+RELEASE="fswiki_lite_$VERSION"
+
+#=========================================================================
+# ¥Æ¥ó¥Ý¥é¥ê¥Ç¥£¥ì¥¯¥È¥ê¤¬¤¢¤ë¾ì¹ç¤Ïºï½ü
+#=========================================================================
+if [ -e $RELEASE ]; then
+ echo "delete temp directory..."
+ rm -rf $RELEASE
+fi
+
+#=========================================================================
+# zip¥Õ¥¡¥¤¥ë¤¬¤¢¤ë¾ì¹ç¤Ïºï½ü
+#=========================================================================
+if [ -e $RELEASE.zip ]; then
+ echo "delete zip file..."
+ rm -f $RELEASE.zip
+fi
+
+#=========================================================================
+# ¥Æ¥ó¥Ý¥é¥ê¥Ç¥£¥ì¥¯¥È¥ê¤ÎºîÀ®
+#=========================================================================
+echo "create temp directory..."
+mkdir $RELEASE
+
+#=========================================================================
+# ¥Õ¥¡¥¤¥ë¤Î¥³¥Ô¡¼
+#=========================================================================
+echo "copy to temp directory..."
+cp ./*.cgi $RELEASE
+cp -r ./docs $RELEASE
+cp -r ./lib $RELEASE
+cp -r ./plugin $RELEASE
+
+#=========================================================================
+# zip¥Õ¥¡¥¤¥ë¤ÎºîÀ®
+#=========================================================================
+echo "create zip file..."
+find ./$RELEASE \! -path '*/CVS*' -exec zip $RELEASE.zip {} \;
+
+#=========================================================================
+# ¥Æ¥ó¥Ý¥é¥ê¥Ç¥£¥ì¥¯¥È¥ê¤òºï½ü
+#=========================================================================
+echo "remove temp directory..."
+rm -rf $RELEASE
+
+#=========================================================================
+# ½ªÎ»
+#=========================================================================
+echo "complete."
-#!/usr/bin/perl\r
-################################################################################\r
-#\r
-# FSWiki Lite\r
-#\r
-################################################################################\r
-require "./lib/common.pl";\r
-#===============================================================================\r
-# ½èÍý¤Î¿¶¤êʬ¤±\r
-#===============================================================================\r
-&ReadParse();\r
-if($in{"p"} eq ""){\r
- $in{"p"} = "FrontPage";\r
-}\r
-\r
-if($in{"a"} eq "list"){\r
- &list_page();\r
- \r
-} elsif($in{"a"} eq "search"){\r
- &search_page();\r
- \r
-} else {\r
- &show_page();\r
- \r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤Î°ìÍ÷\r
-#-------------------------------------------------------------------------------\r
-sub list_page {\r
- my @pages = &Wiki::get_page_list();\r
- \r
- &print_header("°ìÍ÷");\r
- print "<ul>\n";\r
- foreach my $page (@pages){\r
- print "<li><a href=\"$MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".\r
- &Util::escapeHTML($page->{NAME})."</a>".\r
- " - ".&Util::format_date($page->{TIME})."</li>\n";\r
- }\r
- print "</ul>\n";\r
- &print_footer();\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤òɽ¼¨\r
-#-------------------------------------------------------------------------------\r
-sub show_page {\r
- \r
- unless(&Wiki::exists_page($in{"p"})){\r
- undef %in;\r
- $in{"a"} = "edit";\r
- require $EDIT_SCRIPT;\r
- return;\r
- }\r
- \r
- my $source = &Wiki::get_page($in{"p"});\r
- my $html = &Wiki::process_wiki($source,1);\r
- \r
- &print_header($in{"p"},1);\r
- \r
- if(&Wiki::exists_page("Header")){\r
- print "<div class=\"header\">\n";\r
- print &Wiki::process_wiki(&Wiki::get_page("Header"));\r
- print "</div>\n";\r
- }\r
-\r
- print "<div class=\"day body section\">\n";\r
- print $html;\r
- print "</div>\n";\r
- \r
- if(&Wiki::exists_page("Footer")){\r
- print "<div class=\"comment\">\n";\r
- print &Wiki::process_wiki(&Wiki::get_page("Footer"));\r
- print "</div>\n";\r
- }\r
- \r
- &print_footer();\r
-}\r
-\r
-#-------------------------------------------------------------------------------\r
-# ¥Ú¡¼¥¸¤Î¸¡º÷\r
-#-------------------------------------------------------------------------------\r
-sub search_page {\r
- \r
- &print_header("¸¡º÷");\r
- print "<form action=\"$MAIN_SCRIPT\" method=\"GET\">\n";\r
- print " ¥¡¼¥ï¡¼¥É <input type=\"text\" name=\"w\" size=\"20\" value=\"".&Util::escapeHTML($in{'w'})."\">\n";\r
- print " <input type=\"submit\" value=\" ¸¡ º÷ \">\n";\r
- print " <input type=\"hidden\" name=\"a\" value=\"search\">\n";\r
- print "</form>\n";\r
- \r
- if($in{'w'} ne ""){\r
- my @pages = &Wiki::get_page_list();\r
- my $find = 0;\r
- print "<ul>\n";\r
- foreach my $page (@pages){\r
- my $source = $page->{NAME}."\n".&Wiki::get_page($page->{NAME});\r
- if(index($source,$in{'w'})!=-1){\r
- print " <li><a href=\"$MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".&Util::escapeHTML($page->{NAME})."</a></li>\n";\r
- $find = 1;\r
- }\r
- }\r
- if($find==0){\r
- print "<li>³ºÅö¤¹¤ë¥Ú¡¼¥¸¤Ï¸ºß¤·¤Þ¤»¤ó¡£</li>\n";\r
- }\r
- print "</ul>\n";\r
- }\r
- \r
- &print_footer();\r
-}\r
-\r
+#!/usr/bin/perl
+################################################################################
+#
+# FSWiki Lite
+#
+################################################################################
+require "./lib/common.pl";
+#===============================================================================
+# ½èÍý¤Î¿¶¤êʬ¤±
+#===============================================================================
+&ReadParse();
+if($in{"p"} eq ""){
+ $in{"p"} = "FrontPage";
+}
+
+if($in{"a"} eq "list"){
+ &list_page();
+
+} elsif($in{"a"} eq "search"){
+ &search_page();
+
+} else {
+ &show_page();
+
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤Î°ìÍ÷
+#-------------------------------------------------------------------------------
+sub list_page {
+ my @pages = &Wiki::get_page_list();
+
+ &print_header("°ìÍ÷");
+ print "<ul>\n";
+ foreach my $page (@pages){
+ print "<li><a href=\"$MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".
+ &Util::escapeHTML($page->{NAME})."</a>".
+ " - ".&Util::format_date($page->{TIME})."</li>\n";
+ }
+ print "</ul>\n";
+ &print_footer();
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤òɽ¼¨
+#-------------------------------------------------------------------------------
+sub show_page {
+
+ unless(&Wiki::exists_page($in{"p"})){
+ undef %in;
+ $in{"a"} = "edit";
+ require $EDIT_SCRIPT;
+ return;
+ }
+
+ my $source = &Wiki::get_page($in{"p"});
+ my $html = &Wiki::process_wiki($source,1);
+
+ &print_header($in{"p"},1);
+
+ if(&Wiki::exists_page("Header")){
+ print "<div class=\"header\">\n";
+ print &Wiki::process_wiki(&Wiki::get_page("Header"));
+ print "</div>\n";
+ }
+
+ print "<div class=\"day body section\">\n";
+ print $html;
+ print "</div>\n";
+
+ if(&Wiki::exists_page("Footer")){
+ print "<div class=\"comment\">\n";
+ print &Wiki::process_wiki(&Wiki::get_page("Footer"));
+ print "</div>\n";
+ }
+
+ &print_footer();
+}
+
+#-------------------------------------------------------------------------------
+# ¥Ú¡¼¥¸¤Î¸¡º÷
+#-------------------------------------------------------------------------------
+sub search_page {
+
+ &print_header("¸¡º÷");
+ print "<form action=\"$MAIN_SCRIPT\" method=\"GET\">\n";
+ print " ¥¡¼¥ï¡¼¥É <input type=\"text\" name=\"w\" size=\"20\" value=\"".&Util::escapeHTML($in{'w'})."\">\n";
+ print " <input type=\"submit\" value=\" ¸¡ º÷ \">\n";
+ print " <input type=\"hidden\" name=\"a\" value=\"search\">\n";
+ print "</form>\n";
+
+ if($in{'w'} ne ""){
+ my @pages = &Wiki::get_page_list();
+ my $find = 0;
+ print "<ul>\n";
+ foreach my $page (@pages){
+ my $source = $page->{NAME}."\n".&Wiki::get_page($page->{NAME});
+ if(index($source,$in{'w'})!=-1){
+ print " <li><a href=\"$MAIN_SCRIPT?p=".&Util::url_encode($page->{NAME})."\">".&Util::escapeHTML($page->{NAME})."</a></li>\n";
+ $find = 1;
+ }
+ }
+ if($find==0){
+ print "<li>³ºÅö¤¹¤ë¥Ú¡¼¥¸¤Ï¸ºß¤·¤Þ¤»¤ó¡£</li>\n";
+ }
+ print "</ul>\n";
+ }
+
+ &print_footer();
+}
+
OSDN Git Service
