├── .gitignore ├── LICENSE ├── Makefile.PL ├── README.md ├── app.psgi ├── config.pl ├── data ├── add-to-items.pod ├── array-and-hash.pod ├── author.pod ├── decl-var.pod ├── default-value.pod ├── diamond-operator.pod ├── each-array.pod ├── extention.pod ├── find-a-value.pod ├── hellox3.pod ├── list-to-scalar.pod ├── listx3.pod ├── localtime.pod ├── number-variation.pod ├── oop-feature.pod ├── open-scalar.pod ├── perl-catchword.pod ├── perl-command.pod ├── perldoc-x.pod ├── perlop-precedence.pod ├── plackup-default-server.pod ├── read-whole-data.pod ├── regexploop.pod ├── remove-array.pod ├── remove-hash-element.pod ├── special-blocks.pod ├── subst-string.pod ├── switch.pod ├── unambiguous-hashref.pod ├── uniq-subroutine.pod ├── use-require.pod ├── utf8-encode-judge.pod ├── utf8-function.pod ├── utf8-length.pod ├── what-is-cpanm.pod └── win32-osname.pod ├── lib ├── Dojo.pm └── Dojo │ ├── Controller.pm │ ├── Controller │ ├── API.pm │ ├── Question.pm │ ├── Result.pm │ └── Update.pm │ ├── Model │ ├── AnswerSheet.pm │ ├── Gravatar.pm │ ├── Question.pm │ ├── Questions.pm │ ├── Storage.pm │ └── Storage │ │ └── DBI.pm │ ├── Models.pm │ └── View │ └── MT.pm ├── prod.psgi ├── root ├── common │ └── base.mt ├── css │ ├── common.css │ ├── smartphone.css │ └── style.css ├── favicon.ico ├── img │ ├── backGround.gif │ ├── backGroundBrack.gif │ ├── btn_entry_01.png │ ├── btn_entry_01_o.png │ ├── btn_entry_02.png │ ├── btn_entry_02_o.gif │ ├── common │ │ ├── blank.gif │ │ ├── ico_arrow_01.png │ │ ├── ico_bullet_01.png │ │ └── ico_exwin.png │ ├── exam │ │ ├── bg_01.png │ │ ├── btn_plus_01.png │ │ ├── ico_plus_01.png │ │ ├── img_correct_01.png │ │ ├── img_header_01.png │ │ ├── img_hr_01.png │ │ ├── img_hr_02.png │ │ ├── img_incorrect_01.png │ │ ├── img_meter.png │ │ ├── img_rank_01.png │ │ ├── img_rank_02.png │ │ ├── img_rank_03.png │ │ ├── img_rank_04.png │ │ └── img_rank_05.png │ ├── headerBackGround.gif │ ├── perl_test_title.gif │ ├── ranking.png │ ├── ranking_1.gif │ ├── ranking_2.gif │ ├── ranking_3.gif │ ├── ranking_4.gif │ ├── ranking_5.gif │ └── userIcon.jpg ├── index.mt ├── js │ ├── lib │ │ ├── DD_belatedPNG.js │ │ ├── jquery.js │ │ ├── meca.js │ │ ├── sisso.js │ │ └── swfobject.js │ └── main.js ├── question │ ├── answer.mt │ ├── question.mt │ └── result.mt └── result │ └── index.mt ├── t ├── 001_load.t ├── 002_api.t ├── 003_webapp.t ├── Utils.pm ├── data │ ├── pod.t │ └── pod_requirements.t └── model │ ├── answer_sheet.t │ ├── questions.t │ ├── questions │ ├── bar.pod │ ├── baz.pod │ ├── foo.pod │ ├── foo.txt │ └── foo │ │ └── bar.pod │ ├── storage.t │ └── storage_dbi.t └── tools └── new-question.pl /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | .DS_Store 3 | inc/ 4 | blib/ 5 | pm_to_blib 6 | action.cache 7 | config_local.pl 8 | MYMETA.* 9 | META.* 10 | Makefile 11 | 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Terms of Perl itself 2 | 3 | a) the GNU General Public License as published by the Free 4 | Software Foundation; either version 1, or (at your option) any 5 | later version, or 6 | b) the "Artistic License" 7 | 8 | --------------------------------------------------------------------------- 9 | 10 | The General Public License (GPL) 11 | Version 2, June 1991 12 | 13 | Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, 14 | Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute 15 | verbatim copies of this license document, but changing it is not allowed. 16 | 17 | Preamble 18 | 19 | The licenses for most software are designed to take away your freedom to share 20 | and change it. By contrast, the GNU General Public License is intended to 21 | guarantee your freedom to share and change free software--to make sure the 22 | software is free for all its users. This General Public License applies to most of 23 | the Free Software Foundation's software and to any other program whose 24 | authors commit to using it. (Some other Free Software Foundation software is 25 | covered by the GNU Library General Public License instead.) You can apply it to 26 | your programs, too. 27 | 28 | When we speak of free software, we are referring to freedom, not price. Our 29 | General Public Licenses are designed to make sure that you have the freedom 30 | to distribute copies of free software (and charge for this service if you wish), that 31 | you receive source code or can get it if you want it, that you can change the 32 | software or use pieces of it in new free programs; and that you know you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid anyone to deny 36 | you these rights or to ask you to surrender the rights. These restrictions 37 | translate to certain responsibilities for you if you distribute copies of the 38 | software, or if you modify it. 39 | 40 | For example, if you distribute copies of such a program, whether gratis or for a 41 | fee, you must give the recipients all the rights that you have. You must make 42 | sure that they, too, receive or can get the source code. And you must show 43 | them these terms so they know their rights. 44 | 45 | We protect your rights with two steps: (1) copyright the software, and (2) offer 46 | you this license which gives you legal permission to copy, distribute and/or 47 | modify the software. 48 | 49 | Also, for each author's protection and ours, we want to make certain that 50 | everyone understands that there is no warranty for this free software. If the 51 | software is modified by someone else and passed on, we want its recipients to 52 | know that what they have is not the original, so that any problems introduced by 53 | others will not reflect on the original authors' reputations. 54 | 55 | Finally, any free program is threatened constantly by software patents. We wish 56 | to avoid the danger that redistributors of a free program will individually obtain 57 | patent licenses, in effect making the program proprietary. To prevent this, we 58 | have made it clear that any patent must be licensed for everyone's free use or 59 | not licensed at all. 60 | 61 | The precise terms and conditions for copying, distribution and modification 62 | follow. 63 | 64 | GNU GENERAL PUBLIC LICENSE 65 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND 66 | MODIFICATION 67 | 68 | 0. This License applies to any program or other work which contains a notice 69 | placed by the copyright holder saying it may be distributed under the terms of 70 | this General Public License. The "Program", below, refers to any such program 71 | or work, and a "work based on the Program" means either the Program or any 72 | derivative work under copyright law: that is to say, a work containing the 73 | Program or a portion of it, either verbatim or with modifications and/or translated 74 | into another language. (Hereinafter, translation is included without limitation in 75 | the term "modification".) Each licensee is addressed as "you". 76 | 77 | Activities other than copying, distribution and modification are not covered by 78 | this License; they are outside its scope. The act of running the Program is not 79 | restricted, and the output from the Program is covered only if its contents 80 | constitute a work based on the Program (independent of having been made by 81 | running the Program). Whether that is true depends on what the Program does. 82 | 83 | 1. You may copy and distribute verbatim copies of the Program's source code as 84 | you receive it, in any medium, provided that you conspicuously and appropriately 85 | publish on each copy an appropriate copyright notice and disclaimer of warranty; 86 | keep intact all the notices that refer to this License and to the absence of any 87 | warranty; and give any other recipients of the Program a copy of this License 88 | along with the Program. 89 | 90 | You may charge a fee for the physical act of transferring a copy, and you may at 91 | your option offer warranty protection in exchange for a fee. 92 | 93 | 2. You may modify your copy or copies of the Program or any portion of it, thus 94 | forming a work based on the Program, and copy and distribute such 95 | modifications or work under the terms of Section 1 above, provided that you also 96 | meet all of these conditions: 97 | 98 | a) You must cause the modified files to carry prominent notices stating that you 99 | changed the files and the date of any change. 100 | 101 | b) You must cause any work that you distribute or publish, that in whole or in 102 | part contains or is derived from the Program or any part thereof, to be licensed 103 | as a whole at no charge to all third parties under the terms of this License. 104 | 105 | c) If the modified program normally reads commands interactively when run, you 106 | must cause it, when started running for such interactive use in the most ordinary 107 | way, to print or display an announcement including an appropriate copyright 108 | notice and a notice that there is no warranty (or else, saying that you provide a 109 | warranty) and that users may redistribute the program under these conditions, 110 | and telling the user how to view a copy of this License. (Exception: if the 111 | Program itself is interactive but does not normally print such an announcement, 112 | your work based on the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If identifiable 115 | sections of that work are not derived from the Program, and can be reasonably 116 | considered independent and separate works in themselves, then this License, 117 | and its terms, do not apply to those sections when you distribute them as 118 | separate works. But when you distribute the same sections as part of a whole 119 | which is a work based on the Program, the distribution of the whole must be on 120 | the terms of this License, whose permissions for other licensees extend to the 121 | entire whole, and thus to each and every part regardless of who wrote it. 122 | 123 | Thus, it is not the intent of this section to claim rights or contest your rights to 124 | work written entirely by you; rather, the intent is to exercise the right to control 125 | the distribution of derivative or collective works based on the Program. 126 | 127 | In addition, mere aggregation of another work not based on the Program with the 128 | Program (or with a work based on the Program) on a volume of a storage or 129 | distribution medium does not bring the other work under the scope of this 130 | License. 131 | 132 | 3. You may copy and distribute the Program (or a work based on it, under 133 | Section 2) in object code or executable form under the terms of Sections 1 and 2 134 | above provided that you also do one of the following: 135 | 136 | a) Accompany it with the complete corresponding machine-readable source 137 | code, which must be distributed under the terms of Sections 1 and 2 above on a 138 | medium customarily used for software interchange; or, 139 | 140 | b) Accompany it with a written offer, valid for at least three years, to give any 141 | third party, for a charge no more than your cost of physically performing source 142 | distribution, a complete machine-readable copy of the corresponding source 143 | code, to be distributed under the terms of Sections 1 and 2 above on a medium 144 | customarily used for software interchange; or, 145 | 146 | c) Accompany it with the information you received as to the offer to distribute 147 | corresponding source code. (This alternative is allowed only for noncommercial 148 | distribution and only if you received the program in object code or executable 149 | form with such an offer, in accord with Subsection b above.) 150 | 151 | The source code for a work means the preferred form of the work for making 152 | modifications to it. For an executable work, complete source code means all the 153 | source code for all modules it contains, plus any associated interface definition 154 | files, plus the scripts used to control compilation and installation of the 155 | executable. However, as a special exception, the source code distributed need 156 | not include anything that is normally distributed (in either source or binary form) 157 | with the major components (compiler, kernel, and so on) of the operating system 158 | on which the executable runs, unless that component itself accompanies the 159 | executable. 160 | 161 | If distribution of executable or object code is made by offering access to copy 162 | from a designated place, then offering equivalent access to copy the source 163 | code from the same place counts as distribution of the source code, even though 164 | third parties are not compelled to copy the source along with the object code. 165 | 166 | 4. You may not copy, modify, sublicense, or distribute the Program except as 167 | expressly provided under this License. Any attempt otherwise to copy, modify, 168 | sublicense or distribute the Program is void, and will automatically terminate 169 | your rights under this License. However, parties who have received copies, or 170 | rights, from you under this License will not have their licenses terminated so long 171 | as such parties remain in full compliance. 172 | 173 | 5. You are not required to accept this License, since you have not signed it. 174 | However, nothing else grants you permission to modify or distribute the Program 175 | or its derivative works. These actions are prohibited by law if you do not accept 176 | this License. Therefore, by modifying or distributing the Program (or any work 177 | based on the Program), you indicate your acceptance of this License to do so, 178 | and all its terms and conditions for copying, distributing or modifying the 179 | Program or works based on it. 180 | 181 | 6. Each time you redistribute the Program (or any work based on the Program), 182 | the recipient automatically receives a license from the original licensor to copy, 183 | distribute or modify the Program subject to these terms and conditions. You 184 | may not impose any further restrictions on the recipients' exercise of the rights 185 | granted herein. You are not responsible for enforcing compliance by third parties 186 | to this License. 187 | 188 | 7. If, as a consequence of a court judgment or allegation of patent infringement 189 | or for any other reason (not limited to patent issues), conditions are imposed on 190 | you (whether by court order, agreement or otherwise) that contradict the 191 | conditions of this License, they do not excuse you from the conditions of this 192 | License. If you cannot distribute so as to satisfy simultaneously your obligations 193 | under this License and any other pertinent obligations, then as a consequence 194 | you may not distribute the Program at all. For example, if a patent license would 195 | not permit royalty-free redistribution of the Program by all those who receive 196 | copies directly or indirectly through you, then the only way you could satisfy 197 | both it and this License would be to refrain entirely from distribution of the 198 | Program. 199 | 200 | If any portion of this section is held invalid or unenforceable under any particular 201 | circumstance, the balance of the section is intended to apply and the section as 202 | a whole is intended to apply in other circumstances. 203 | 204 | It is not the purpose of this section to induce you to infringe any patents or other 205 | property right claims or to contest validity of any such claims; this section has 206 | the sole purpose of protecting the integrity of the free software distribution 207 | system, which is implemented by public license practices. Many people have 208 | made generous contributions to the wide range of software distributed through 209 | that system in reliance on consistent application of that system; it is up to the 210 | author/donor to decide if he or she is willing to distribute software through any 211 | other system and a licensee cannot impose that choice. 212 | 213 | This section is intended to make thoroughly clear what is believed to be a 214 | consequence of the rest of this License. 215 | 216 | 8. If the distribution and/or use of the Program is restricted in certain countries 217 | either by patents or by copyrighted interfaces, the original copyright holder who 218 | places the Program under this License may add an explicit geographical 219 | distribution limitation excluding those countries, so that distribution is permitted 220 | only in or among countries not thus excluded. In such case, this License 221 | incorporates the limitation as if written in the body of this License. 222 | 223 | 9. The Free Software Foundation may publish revised and/or new versions of the 224 | General Public License from time to time. Such new versions will be similar in 225 | spirit to the present version, but may differ in detail to address new problems or 226 | concerns. 227 | 228 | Each version is given a distinguishing version number. If the Program specifies a 229 | version number of this License which applies to it and "any later version", you 230 | have the option of following the terms and conditions either of that version or of 231 | any later version published by the Free Software Foundation. If the Program does 232 | not specify a version number of this License, you may choose any version ever 233 | published by the Free Software Foundation. 234 | 235 | 10. If you wish to incorporate parts of the Program into other free programs 236 | whose distribution conditions are different, write to the author to ask for 237 | permission. For software which is copyrighted by the Free Software Foundation, 238 | write to the Free Software Foundation; we sometimes make exceptions for this. 239 | Our decision will be guided by the two goals of preserving the free status of all 240 | derivatives of our free software and of promoting the sharing and reuse of 241 | software generally. 242 | 243 | NO WARRANTY 244 | 245 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS 246 | NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 247 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE 248 | COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM 249 | "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR 250 | IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 251 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE 252 | ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 253 | PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, 254 | YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR 255 | CORRECTION. 256 | 257 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED 258 | TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY 259 | WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS 260 | PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 261 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES 262 | ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM 263 | (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 264 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 265 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY 266 | OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS 267 | BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 268 | 269 | END OF TERMS AND CONDITIONS 270 | 271 | 272 | --------------------------------------------------------------------------- 273 | 274 | The Artistic License 275 | 276 | Preamble 277 | 278 | The intent of this document is to state the conditions under which a Package 279 | may be copied, such that the Copyright Holder maintains some semblance of 280 | artistic control over the development of the package, while giving the users of the 281 | package the right to use and distribute the Package in a more-or-less customary 282 | fashion, plus the right to make reasonable modifications. 283 | 284 | Definitions: 285 | 286 | - "Package" refers to the collection of files distributed by the Copyright 287 | Holder, and derivatives of that collection of files created through textual 288 | modification. 289 | - "Standard Version" refers to such a Package if it has not been modified, 290 | or has been modified in accordance with the wishes of the Copyright 291 | Holder. 292 | - "Copyright Holder" is whoever is named in the copyright or copyrights for 293 | the package. 294 | - "You" is you, if you're thinking about copying or distributing this Package. 295 | - "Reasonable copying fee" is whatever you can justify on the basis of 296 | media cost, duplication charges, time of people involved, and so on. (You 297 | will not be required to justify it to the Copyright Holder, but only to the 298 | computing community at large as a market that must bear the fee.) 299 | - "Freely Available" means that no fee is charged for the item itself, though 300 | there may be fees involved in handling the item. It also means that 301 | recipients of the item may redistribute it under the same conditions they 302 | received it. 303 | 304 | 1. You may make and give away verbatim copies of the source form of the 305 | Standard Version of this Package without restriction, provided that you duplicate 306 | all of the original copyright notices and associated disclaimers. 307 | 308 | 2. You may apply bug fixes, portability fixes and other modifications derived from 309 | the Public Domain or from the Copyright Holder. A Package modified in such a 310 | way shall still be considered the Standard Version. 311 | 312 | 3. You may otherwise modify your copy of this Package in any way, provided 313 | that you insert a prominent notice in each changed file stating how and when 314 | you changed that file, and provided that you do at least ONE of the following: 315 | 316 | a) place your modifications in the Public Domain or otherwise 317 | make them Freely Available, such as by posting said modifications 318 | to Usenet or an equivalent medium, or placing the modifications on 319 | a major archive site such as ftp.uu.net, or by allowing the 320 | Copyright Holder to include your modifications in the Standard 321 | Version of the Package. 322 | 323 | b) use the modified Package only within your corporation or 324 | organization. 325 | 326 | c) rename any non-standard executables so the names do not 327 | conflict with standard executables, which must also be provided, 328 | and provide a separate manual page for each non-standard 329 | executable that clearly documents how it differs from the Standard 330 | Version. 331 | 332 | d) make other distribution arrangements with the Copyright Holder. 333 | 334 | 4. You may distribute the programs of this Package in object code or executable 335 | form, provided that you do at least ONE of the following: 336 | 337 | a) distribute a Standard Version of the executables and library 338 | files, together with instructions (in the manual page or equivalent) 339 | on where to get the Standard Version. 340 | 341 | b) accompany the distribution with the machine-readable source of 342 | the Package with your modifications. 343 | 344 | c) accompany any non-standard executables with their 345 | corresponding Standard Version executables, giving the 346 | non-standard executables non-standard names, and clearly 347 | documenting the differences in manual pages (or equivalent), 348 | together with instructions on where to get the Standard Version. 349 | 350 | d) make other distribution arrangements with the Copyright Holder. 351 | 352 | 5. You may charge a reasonable copying fee for any distribution of this Package. 353 | You may charge any fee you choose for support of this Package. You may not 354 | charge a fee for this Package itself. However, you may distribute this Package in 355 | aggregate with other (possibly commercial) programs as part of a larger 356 | (possibly commercial) software distribution provided that you do not advertise 357 | this Package as a product of your own. 358 | 359 | 6. The scripts and library files supplied as input to or produced as output from 360 | the programs of this Package do not automatically fall under the copyright of this 361 | Package, but belong to whomever generated them, and may be sold 362 | commercially, and may be aggregated with this Package. 363 | 364 | 7. C or perl subroutines supplied by you and linked into this Package shall not 365 | be considered part of this Package. 366 | 367 | 8. Aggregation of this Package with a commercial distribution is always permitted 368 | provided that the use of this Package is embedded; that is, when no overt attempt 369 | is made to make this Package's interfaces visible to the end user of the 370 | commercial distribution. Such use shall not be construed as a distribution of 371 | this Package. 372 | 373 | 9. The name of the Copyright Holder may not be used to endorse or promote 374 | products derived from this software without specific prior written permission. 375 | 376 | 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR 377 | IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 378 | WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR 379 | PURPOSE. 380 | 381 | The End 382 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use inc::Module::Install; 2 | name 'Dojo'; 3 | all_from 'lib/Dojo.pm'; 4 | #readme_from 'lib/Dojo.pm'; 5 | 6 | perl_version '5.008'; 7 | 8 | requires 'parent'; 9 | requires 'Try::Tiny'; 10 | 11 | requires 'Ark' => '0.2'; 12 | 13 | requires 'Pod::HTMLEmbed' => '0.04'; 14 | requires 'MIME::Base64' => '3.11'; 15 | requires 'Cache::Memcached::Fast'; 16 | requires 'List::Util'; 17 | requires 'Furl'; 18 | requires 'Digest::MD5'; 19 | requires 'Email::Valid::Loose'; 20 | 21 | test_requires 'Test::More' => '0.88'; 22 | test_requires 'Test::TCP'; 23 | test_requires 'Test::mysqld'; 24 | test_requires 'pQuery'; 25 | 26 | tests 't/*.t t/*/*.t'; 27 | 28 | WriteAll; 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Perl道場 2 | ==================== 3 | 4 | 問題作成方法 5 | -------------------- 6 | 7 | https://github.com/kayac/perldojo 8 | 9 | を fork し問題定義ファイルを追加後、 pull request を送信してください。 10 | 11 | 12 | 問題定義ファイル 13 | -------------------- 14 | 15 | 問題定義ファイルは `data` ディレクトリ以下に `.pod` 形式で記述します。 16 | 17 | また、 `=head1` として決まった要素を定義する必要があります。以下の要素はすべて必須項目です。 18 | 19 | * =head1 QUESTION 20 | * =head1 CHOICES 21 | * =head1 ANSWER 22 | * =head1 EXPLANATION 23 | * =head1 AUTHOR 24 | 25 | その他の要素（たとえば LICENSE や SEE ALSO 等）は自由に記述していただいてかまいません。 26 | 27 | 問題はすべて選択肢形式で、回答を一つ選ばせるタイプにする必要があります。 28 | 29 | なお、`tools/new-question.pl` コマンドを使って新しい問題を作成することができます。 30 | 31 | # data/foo.podを作成する 32 | $ tools/new-question.pl foo 33 | 34 | このとき作者名とgithubのアドレスが自動で埋めこまれますが、これは `git config user.name` と `git config github.user` から自動で取得されるほか、`--author` と `--github` オプションで設定することも出来ます。 35 | 36 | $ tools/new-question.pl --author 'My Name' --github 'myaccount' 37 | 38 | ### QUESTION 39 | 40 | 問題文を記述します。 41 | 42 | 内容に制約はありませんので、`.pod` の形式に沿っていればどのような記述でもかまいません 43 | 44 | 45 | ### CHOICES 46 | 47 | 回答の選択肢を記述します。これは、 48 | 49 | =head1 CHOICES 50 | 51 | =over 52 | 53 | =item 1. 54 | 55 | 回答1 56 | 57 | =item 2. 58 | 59 | 回答2 60 | 61 | =item 3. 62 | 63 | 回答3 64 | 65 | =item 4. 66 | 67 | 回答4 68 | 69 | =back 70 | 71 | というリスト形式である必要があります。回答の個数には制限はありません。 72 | 73 | また、各回答の文章は単語である必要はなく、複数行にまたがっていたり、コードブロックが含まれていても許容します。 74 | 75 | 76 | ### ANSWER 77 | 78 | CHOICES で指定した選択肢のうち、正解である選択肢の数値を記述します。 79 | 80 | =head1 ANSWER 81 | 82 | 3 83 | 84 | 85 | ### EXPLANATION 86 | 87 | 問題の解説文です。問題に答えたあとに表示されます。 88 | 89 | QUESTION 同様、フォーマットは自由です。 90 | 91 | 92 | ### AUTHOR 93 | 94 | 問題の作者を記述します。 95 | 将来的にここは自由に記述できるようにしたいですが、いまのところ下記のような、 96 | 97 | =head1 AUTHOR 98 | 99 | Daisuke Murase 100 | http://github.com/typester 101 | 102 | 一行目に名前、二行目にgithubのURLというような感じで記述します。 103 | 104 | 105 | 問題のシンタックスチェック 106 | ---------------------- 107 | 108 | $ prove -l t/data 109 | 110 | というコマンドで問題定義ファイルのシンタックスチェックを行うことができます。 111 | 112 | pull request を送信する前に実行してエラーにならないかを確認するようにしてください。 113 | 114 | 115 | 問題のライセンスについて 116 | -------------------- 117 | 118 | 問題定義ファイル自体にライセンスの記述がない場合は、[CC-by](http://creativecommons.org/licenses/by/2.1/jp/) ライセンスであると見なし、 119 | また、問題の著作権は問題作成者に帰属するとします。 120 | 121 | -------------------------------------------------------------------------------- /app.psgi: -------------------------------------------------------------------------------- 1 | use lib 'lib'; 2 | 3 | use Dojo; 4 | use Dojo::Models; 5 | 6 | use Plack::App::Directory; 7 | 8 | my $root = models('home')->subdir('root'); 9 | my $static = Plack::App::Directory->new({ 10 | root => $root->stringify 11 | })->to_app; 12 | 13 | my $app = sub { 14 | my ($env) = @_; 15 | 16 | my $f = $root->file($env->{PATH_INFO}); 17 | if (-f $f && -r _) { 18 | return $static->(@_); 19 | } 20 | else { 21 | # lazy build 22 | my $app = Dojo->new; 23 | $app->setup_minimal; 24 | 25 | $app->handler->(@_); 26 | } 27 | }; 28 | -------------------------------------------------------------------------------- /config.pl: -------------------------------------------------------------------------------- 1 | use utf8; 2 | 3 | return +{ 4 | cookie_name => "dojostate", 5 | storage => { 6 | backend => { 7 | class => "Cache::Memcached::Fast", 8 | }, 9 | }, 10 | }; 11 | 12 | -------------------------------------------------------------------------------- /data/add-to-items.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | 配列要素すべてにある値を加算する C を実装するとき、以下のうち正しいものはどれでしょう。なお、 C は値を返さず、引数の配列の要素を直接変更するものとします。 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | sub add_to_items { 15 | my($value, $array_ref) = @_; 16 | @{$array_ref} += $value; 17 | return; 18 | } 19 | 20 | =item 2. 21 | 22 | sub add_to_items { 23 | my($value, $array_ref) = @_; 24 | $_[1] = [ map { $_ + $value } @{$array_ref} ]; 25 | return; 26 | } 27 | 28 | =item 3. 29 | 30 | sub add_to_items { 31 | my($value, $array_ref) = @_; 32 | foreach my $item(@{$array_ref}) { 33 | $item += $value; 34 | } 35 | return; 36 | } 37 | 38 | =item 4. 39 | 40 | use List::Util qw(reduce); 41 | sub add_to_items { 42 | my($value, $array_ref) = @_; 43 | @{$array_ref} = reduce { $_ + $value } @{$array_ref}; 44 | return; 45 | } 46 | 47 | =item 5. 48 | 49 | sub add_to_items { 50 | my($value, $array_ref) = @_; 51 | 52 | my @new_items; 53 | foreach my $item(@{$array_ref}) { 54 | push @new_items, $item + $value; 55 | } 56 | $array_ref = \@new_items; 57 | return; 58 | } 59 | 60 | =back 61 | 62 | =head1 ANSWER 63 | 64 | 3 65 | 66 | =head1 EXPLANATION 67 | 68 | 3番が正解です。C で参照する要素はエイリアスになっているので、直接変更できるのです。 69 | 70 | その他の不正解の選択肢については以下のように修正すれば正しくなります。ただし効率の面では C を使用する3番がベストです。 71 | 72 | =over 73 | 74 | =item 1. 75 | 76 | sub add_to_items { 77 | my($value, $array_ref) = @_; 78 | # WRONG: @{$array_ref} += $value; 79 | # 一つ一つ加算する以外の方法はない 80 | $_ += $value for @{$array_ref}; # OK 81 | return; 82 | } 83 | 84 | =item 2. 85 | 86 | sub add_to_items { 87 | my($value, $array_ref) = @_; 88 | # WRONG: $_[1] = [ map { $_ + $value } @{$array_ref} ]; 89 | # $_[1]を直接書き換えても引数の配列は変更されない 90 | # 但し、add_to_items($value, $array_ref); のように、配列リファレンスを渡した場合は $array_ref 自体が変更される 91 | @{$array_ref} = map { $_ + $value } @{$array_ref}; # OK 92 | return; 93 | } 94 | 95 | =item 3. 96 | 97 | # 正解 98 | sub add_to_items { 99 | my($value, $array_ref) = @_; 100 | foreach my $item(@{$array_ref}) { 101 | $item += $value; 102 | } 103 | return; 104 | } 105 | 106 | =item 4. 107 | 108 | use List::Util qw(reduce); 109 | sub add_to_items { 110 | my($value, $array_ref) = @_; 111 | # WRONG: @{$array_ref} = reduce { $_ + $value } @{$array_ref}; 112 | # s/reduce/map/ならば2.と等しくなり正しい 113 | @{$array_ref} = map { $_ + $value } @{$array_ref}; # OK 114 | return; 115 | } 116 | 117 | =item 5. 118 | 119 | sub add_to_items { 120 | my($value, $array_ref) = @_; 121 | 122 | my @new_items; 123 | foreach my $item(@{$array_ref}) { 124 | push @new_items, $item + $value; 125 | } 126 | # $array_refを書き換えても引数の配列は変化しない 127 | # WRONG: $array_ref = \@new_items; 128 | @{$array_ref} = @new_items; # OK 129 | return; 130 | } 131 | 132 | =back 133 | 134 | =head1 AUTHOR 135 | 136 | Fuji Goro 137 | http://github.com/gfx 138 | 139 | =cut 140 | -------------------------------------------------------------------------------- /data/array-and-hash.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | Perlで使用する用語において、２つの用語の組み合わせが同意であるものを選べ。 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | 配列とハッシュ 15 | 16 | =item 2. 17 | 18 | 連想配列とハッシュ 19 | 20 | =item 3. 21 | 22 | 配列とリスト 23 | 24 | =item 4. 25 | 26 | 連想配列とリスト 27 | 28 | =back 29 | 30 | =head1 ANSWER 31 | 32 | 2 33 | 34 | =head1 EXPLANATION 35 | 36 | 配列(array)とリスト(list)は、Perlにおいては精密に意味を持った用語である。 37 | 配列とはデータ構造であり、リストとはスタック上に置かれる一連の値で、リストが配列変数に代入されれば配列になる。 38 | 39 | 配列からpopして値を取り出すことはできるが、リストからpopして値を取り出すことはできない。 40 | 41 | 連想配列とハッシュの関係は、連想配列とはPerl5以前に使用されていた用語であり、 42 | PerlエンジニアはLazyなので、より簡明なハッシュという呼び方に変更された。 43 | 44 | =head1 AUTHOR 45 | 46 | Yusuke Toda 47 | http://github.com/toda 48 | 49 | =cut 50 | -------------------------------------------------------------------------------- /data/author.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | Perl の生みの親、設計者は次のうち誰でしょう。 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | Yukihiro Matsumoto 15 | 16 | =item 2. 17 | 18 | Steve Jobs 19 | 20 | =item 3. 21 | 22 | Larry Wall 23 | 24 | =item 4. 25 | 26 | Guido van Rossum 27 | 28 | =item 5. 29 | 30 | Jesse Vincent 31 | 32 | =back 33 | 34 | =head1 ANSWER 35 | 36 | 3 37 | 38 | =head1 EXPLANATION 39 | 40 | 正解は3の Larry Wall です。 41 | 42 | 1 の Yukihiro Matsumoto と、4 の Guido van Rossum はそれぞれ、Ruby、 Python の作者です。 43 | 44 | 2 の Steve Jobs は Apple Computer の創立者ですね。 45 | 46 | 5 の Jesse Vincent は Perl の開発者の一人で、現在の Perl のメンテナンスを一手に引き受けてくれ、精力的に活動されている方です。 47 | 48 | =head1 AUTHOR 49 | 50 | Daisuke Murase 51 | http://github.com/typester 52 | 53 | =cut 54 | -------------------------------------------------------------------------------- /data/decl-var.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | Perlのサブルーチンは引数を C<@_> で受け取りますが、一般的にはこれをサブルーチン内で名前付き変数に代入してから使います。 7 | このとき、正しい方法はどれでしょう。なお、コードの冒頭で C<< use 5.12.0; >> を宣言しているものとします。 8 | 9 | =head1 CHOICES 10 | 11 | =over 12 | 13 | =item 1. 14 | 15 | use 5.12.0; 16 | sub f { 17 | my($foo, $bar) = @_; 18 | ...; 19 | } 20 | 21 | =item 2. 22 | 23 | use 5.12.0; 24 | sub f { 25 | local($foo, $bar) = @_; 26 | ...; 27 | } 28 | 29 | =item 3. 30 | 31 | use 5.12.0; 32 | sub f { 33 | state($foo, $bar) = @_; 34 | ...; 35 | } 36 | 37 | =item 4. 38 | 39 | use 5.12.0; 40 | sub f { |$foo, $bar| 41 | ...; 42 | } 43 | 44 | =item 5. 45 | 46 | use 5.12.0; 47 | sub f { 48 | var($foo, $bar) = @_; 49 | ...; 50 | } 51 | 52 | =back 53 | 54 | =head1 ANSWER 55 | 56 | 1 57 | 58 | =head1 EXPLANATION 59 | 60 | サブルーチン内で変数を宣言するときは必ず1番の C を使います。 61 | 62 | 2番の C は既に宣言してある変数の値をそのスコープ内でのみ変更するために使うキーワードです。変数を宣言するためのものではありません。 63 | 64 | 3番の C はプログラムのライフサイクル中一度だけ初期化される変数を宣言します。この機能は Perl 5.10.0 で導入されたもので、 C<< use 5.12.0; >> によっても有効になります。 65 | 66 | 4番の C<|...|> はRubyにおいてブロック引数を受け取る構文です。 67 | 68 | 5番の C はJavaScriptで変数を宣言する構文です。 69 | 70 | なお、この最初の引数の代入の意味は命名だけではありません。Perlの引数は参照渡しなので、不用意な引数の変更を避けるために手動で値渡しにするという意味もあります。 71 | 72 | =head1 AUTHOR 73 | 74 | Fuji Goro 75 | http://github.com/gfx 76 | 77 | =cut 78 | -------------------------------------------------------------------------------- /data/default-value.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | my $obj = Class->new(%options); 7 | 8 | などのようにオブジェクトを生成する際にオプションをわたすようになっているモジュールがあるとします。 9 | このようなモジュールのコンストラクタでは、C<%options> に何も渡されたなかった場合、以下のようにデフォルト値を使用するようにコーディングするのが一般的です。 10 | 11 | sub new { 12 | my ($class, %options) = @_; 13 | 14 | # 値がなかったらデフォルト値でうめる 15 | # ... 16 | 17 | return bless \%options, $class; 18 | } 19 | 20 | このデフォルト値を埋める処理で正しくないものは以下のうちどれか。 21 | 22 | =head1 CHOICES 23 | 24 | =over 25 | 26 | =item 1. 27 | 28 | $options{foo} ||= 'default value'; 29 | 30 | =item 2. 31 | 32 | $options{foo} //= 'default value'; 33 | 34 | =item 3. 35 | 36 | $options{foo} = defined $options{foo} ? $options{foo} : 'default value'; 37 | 38 | =item 4. 39 | 40 | $options{foo} = 'default value' 41 | unless defined $options{foo}; 42 | 43 | =back 44 | 45 | =head1 ANSWER 46 | 47 | 1 48 | 49 | =head1 EXPLANATION 50 | 51 | $options{foo} ||= 'default value'; 52 | 53 | は、書き直すと 54 | 55 | $options{foo} = $options{foo} || 'default value'; 56 | 57 | となりますが、これは真偽チェックしかしていないため、たとえば、 58 | 59 | Class->new( foo => 0 ); 60 | 61 | とか 62 | 63 | Class->new( foo => '' ); 64 | 65 | とか、偽になるようなオプションを渡したときに無視されてしまいます。 66 | 67 | 残りの選択肢は defined チェックをしているので正しく動作します。 68 | 69 | Perl 5.10 以降であれば選択肢 2 で使用している defined-or 演算子 C を使うのがスマートでしょう。 70 | 71 | =head1 AUTHOR 72 | 73 | Daisuke Murase 74 | http://github.com/typester 75 | 76 | =cut 77 | -------------------------------------------------------------------------------- /data/diamond-operator.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | while (defined(my $line = <>)) { 7 | print $line; 8 | } 9 | 10 | このスクリプトを 11 | 12 | perl script.pl foo bar buzz 13 | 14 | という引数とともに実行した。スクリプトの挙動として正しいものを選べ。 15 | 16 | =head1 CHOICES 17 | 18 | =over 19 | 20 | =item 1. 21 | 22 | foo, bar, buzz という3ファイルの中身をすべて表示する 23 | 24 | =item 2. 25 | 26 | foo, bar, buzz という3ファイルのそれぞれの1行目だけが表示される 27 | 28 | =item 3. 29 | 30 | foo bar buzz という文字列が表示される。 31 | 32 | =back 33 | 34 | =head1 ANSWER 35 | 36 | 1 37 | 38 | =head1 EXPLANATION 39 | 40 | C<< <> >> はダイヤモンド演算子と呼ばれ、cat、sed、awk などのような Unix ユーティリティと同じような挙動のスクリプトを書くときに便利に使うことができます。 41 | 42 | ダイヤモンド演算子はコマンドライン引数で指定されたファイルをすべて連結した1つの大きなファイルを読み込んでいるように振る舞う特殊な演算子です。 43 | したがって、foo, bar, buzz という3ファイルの中身をすべて表示する、が正解です。 44 | 45 | =head1 AUTHOR 46 | 47 | Daisuke Murase 48 | http://github.com/typester 49 | 50 | =cut 51 | -------------------------------------------------------------------------------- /data/each-array.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | この問題はPerl 5.14.0 以上の機能を扱っています。 7 | 8 | Perl 5.12.0 から、組み込み関数 C に配列を渡すことができるようになりました。また、Perl 5.14.0 から C にリファレンスを渡すことができるようになりました。したがって、 C はポリモーフィックに動作するようになっています。 9 | さて、それでは以下のコードはどんな結果になるでしょうか。 10 | 11 | use 5.14.0; 12 | 13 | sub f { 14 | my($thing) = @_; 15 | while( my($key, $value) = each $thing ) { 16 | print "$key=$value\n"; 17 | } 18 | } 19 | 20 | f([ 21 | foo => 'bar', 22 | hoge => 'fuga', 23 | ]); 24 | 25 | =head1 CHOICES 26 | 27 | =over 28 | 29 | =item 1. 30 | 31 | foo=bar 32 | hoge=fuga 33 | 34 | =item 2. 35 | 36 | 0=foo 37 | 1=bar 38 | 2=hoge 39 | 3=fuga 40 | 41 | =item 3. 42 | 43 | foo=0 44 | bar=1 45 | hoge=2 46 | fuga=3 47 | 48 | =item 4. 49 | 50 | ARRAY(0x100803b00)= 51 | 52 | =item 5. 53 | 54 | なにも表示されない。 55 | 56 | =back 57 | 58 | =head1 ANSWER 59 | 60 | 2 61 | 62 | =head1 EXPLANATION 63 | 64 | C は C<(index, value)> という値をペアで返します。同様に C と C 前述のコードでは C と C はそれぞれ C<(0, 1, 2, 3)> と C<('foo', 'bar', 'hoge', 'fuga')> というリストを返します。 65 | 66 | =head1 AUTHOR 67 | 68 | Fuji Goro 69 | http://github.com/gfx 70 | 71 | =cut 72 | -------------------------------------------------------------------------------- /data/extention.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | Perl を C 言語などで拡張するモジュールを書くための機構は何？ 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | XS 14 | 15 | =item 2. 16 | 17 | XL 18 | 19 | =item 3. 20 | 21 | SS 22 | 23 | =item 4. 24 | 25 | XSS 26 | 27 | =back 28 | 29 | =head1 ANSWER 30 | 31 | 1 32 | 33 | =head1 EXPLANATION 34 | 35 | XS は Perl と(Perl と一緒に使いたい)C のコード(または C ライブラリ)との 間の拡張インターフェースを作るのに使われるインターフェース記述 ファイルフォーマットです。 36 | 37 | XS インターフェースはライブラリと動的または静的にリンクされて、 Perl とリンクすることのできる新しいライブラリを生成します。 XS インターフェース記述はは XS 言語で書かれており、 Perl 拡張インターフェースのコアコンポーネントです。 38 | 39 | =head1 AUTHOR 40 | 41 | fujiwara 42 | https://github.com/fujiwara 43 | -------------------------------------------------------------------------------- /data/find-a-value.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | あなたは配列の中にある値があるかどうかの真偽値を返す C を実装することにしました。 6 | あなたはこのサブルーチンを様々なところで使いたいので、一般的なものにしたいと考え幾つか実装してみました。以下のサブルーチンのうちB<間違っている>実装はどれでしょう。 7 | なお、「ある値があるかどうか」を調べる比較演算子としてはスマートマッチ演算子C<~~>を使うものとします。 8 | 9 | =head1 CHOICES 10 | 11 | =over 12 | 13 | =item 1. 14 | 15 | use List::Util qw(first); 16 | sub in { 17 | my $value = shift; 18 | return first { $_ ~~ $value } @_; 19 | } 20 | 21 | =item 2. 22 | 23 | sub in { 24 | my $value = shift; 25 | return scalar grep { $_ ~~ $value } @_; 26 | } 27 | 28 | =item 3. 29 | 30 | sub in { 31 | my $value = shift; 32 | foreach my $item(@_) { 33 | return 1 if $item ~~ $value; 34 | } 35 | return 0; 36 | } 37 | 38 | =item 4. 39 | 40 | sub in { 41 | my $value = shift; 42 | return scalar map { $_ ~~ $value || () } @_; 43 | } 44 | 45 | =back 46 | 47 | =head1 ANSWER 48 | 49 | 1 50 | 51 | =head1 EXPLANATION 52 | 53 | 1は C を使っていますが、この関数はリストの中の特定の値そのものを返します。つまり、 C や C として呼び出すと0とundefをそれぞれ返すため、真偽値としては偽になります。 54 | 55 | 4はわかりにくいのですが、 C ブロックの評価値はリストコンテキストで評価されるので、値の数を増やしたり減らしたりできるのです。つまり C< map { expr || () } ... > は C と同じ意味になります。 56 | 57 | ところで、Perl 5.10から導入されたスマートマッチ演算子は C かどうかを調べることもできます。スマートマッチ演算子の仕様は複雑ですが、スカラー値だけで考えると C を事前に検査しなくていい分 C よりも使い勝手がいいといえるでしょう。 58 | 59 | =head1 AUTHOR 60 | 61 | Fuji Goro 62 | http://github.com/gfx 63 | 64 | =cut 65 | -------------------------------------------------------------------------------- /data/hellox3.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | 以下のスクリプトの出力はどのようになるでしょう。 7 | 8 | print "100" x 3; 9 | 10 | =head1 CHOICES 11 | 12 | =over 13 | 14 | =item 1. 15 | 16 | シンタックスエラー 17 | 18 | =item 2. 19 | 20 | 100100100 21 | 22 | =item 3. 23 | 24 | 300 25 | 26 | =item 4. 27 | 28 | 1003 29 | 30 | =item 5. 31 | 32 | 1000000 33 | 34 | =back 35 | 36 | =head1 ANSWER 37 | 38 | 2 39 | 40 | =head1 EXPLANATION 41 | 42 | C 演算子は文字列の繰り返し演算子と呼ばれ、与えられた文字列を指定した回数分繰り返した文字列を返します。 43 | 44 | "Hello" x 3 # => "HelloHelloHello" 45 | 46 | したがって、C<"100"> が3度繰り返された C<"100100100"> が正解です。 47 | 48 | =head1 AUTHOR 49 | 50 | Daisuke Murase 51 | http://github.com/typester 52 | 53 | =cut 54 | -------------------------------------------------------------------------------- /data/list-to-scalar.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | C<$item = ('a', 'b', 'c')> を実行すると、$item には以下のどの値が入るでしょう。 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | 3 14 | 15 | =item 2. 16 | 17 | 'a' 18 | 19 | =item 3. 20 | 21 | 'b' 22 | 23 | =item 4. 24 | 25 | 'c' 26 | 27 | =back 28 | 29 | =head1 ANSWER 30 | 31 | 4 32 | 33 | =head1 EXPLANATION 34 | 35 | 4番が正解です。リストをスカラコンテキストで受けた場合、最後の値が戻ります。 36 | 37 | 38 | =head1 AUTHOR 39 | 40 | Kato Atsushi 41 | http://github.com/ktat 42 | 43 | =cut 44 | -------------------------------------------------------------------------------- /data/listx3.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | 以下のスクリプトで、@arrayの内容はどのようになるでしょう。 7 | 8 | my @array = ("100") x 3; 9 | 10 | =head1 CHOICES 11 | 12 | =over 13 | 14 | =item 1. 15 | 16 | シンタックスエラー 17 | 18 | =item 2. 19 | 20 | ('100100100') 21 | 22 | =item 3. 23 | 24 | (100, 100, 100) 25 | 26 | =back 27 | 28 | =head1 ANSWER 29 | 30 | 3 31 | 32 | =head1 EXPLANATION 33 | 34 | C 演算子は文字列の繰り返し演算子ですが、リストに対して使われた場合、リストを繰り返します。 35 | 36 | ("Hello", "World") x 3 # => ("Hello", "World", "Hello", "World", "Hello", "World") 37 | 38 | したがって、C<(100)> が3度繰り返された C<(100, 100, 100)> が正解です。 39 | 40 | =head1 AUTHOR 41 | 42 | Kato Atsushi 43 | http://github.com/ktat 44 | 45 | =cut 46 | -------------------------------------------------------------------------------- /data/localtime.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | my $t = localtime(); 6 | print $t; 7 | 8 | を実行すると、 C と出力された。このコードがもし、 9 | 10 | my ($t) = localtime(); 11 | print $t; 12 | 13 | だったときの出力は次のうちどれか。 14 | 15 | =head1 CHOICES 16 | 17 | =over 18 | 19 | =item 1. 20 | 21 | Tue Oct 11 17:38:53 2011 22 | 23 | =item 2. 24 | 25 | 1318322333 26 | 27 | =item 3. 28 | 29 | 53 30 | 31 | =item 4. 32 | 33 | 53381711911122830 34 | 35 | =back 36 | 37 | =head1 ANSWER 38 | 39 | 3 40 | 41 | =head1 EXPLANATION 42 | 43 | Perl は空気を読む言語として有名です。日常会話では、同じ単語が話のコンテキストによって違う意味になったりしますが、Perl でもそのように使うコンテキストによって異なる動作をする関数があります。 44 | 45 | ビルドインの C 関数もそのように動作をする関数の一つで、これはスカラーコンテキストで呼ばれると C の出力を返します。（これがこの問題では Tue Oct 11 17:38:53 2011 となります） 46 | 47 | しかし、リストコンテキストで呼ぶと、 48 | 49 | my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(); 50 | 51 | というように時刻を9つのエレメントに分けた配列を返します。 52 | この問題では C というように配列の先頭だけをうけとっていますから、C<$sec> だけをうけとっていることになるので、秒数である 53 が出力されます。 53 | 54 | =head1 AUTHOR 55 | 56 | Daisuke Murase 57 | http://github.com/typester 58 | 59 | =cut 60 | -------------------------------------------------------------------------------- /data/number-variation.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | 以下のうち、数値 C<255> を表していないものはどれか。 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | 0xff 15 | 16 | =item 2. 17 | 18 | 0255 19 | 20 | =item 3. 21 | 22 | 2_5_5 23 | 24 | =item 4. 25 | 26 | 0b11111111 27 | 28 | =back 29 | 30 | =head1 ANSWER 31 | 32 | 2 33 | 34 | =head1 EXPLANATION 35 | 36 | 多くのプログラミング言語と同様に、Perl でも10進数以外の数値を記述することができます。 37 | 38 | C<0> で始まるものは8進数、C<0x> ではじまるものは16進数、C<0b> ではじまるものは二進数として扱われます。 39 | 40 | したがって C<0xff>、C<0b11111111>、はどちらも 255 を表します。 41 | 42 | 0255 は8進数で 173 を表しているので、これが正解です。 43 | 44 | また、Perl では整数リテラルにアンダーバーをいれることで大きな数値を読みやすくするという機能があります。 45 | その機能により、C<2_5_5> というのは 255 を意味します。 46 | このような小さな数値で使われることはあまりありませんが、 47 | 48 | 1_000_000_000 49 | 50 | などの大きな数値を扱う場合に使用すると、視認性をよくすることができます。 51 | 52 | 53 | =head1 AUTHOR 54 | 55 | Daisuke Murase 56 | http://github.com/typester 57 | 58 | =cut 59 | -------------------------------------------------------------------------------- /data/oop-feature.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | Perlのオブジェクト指向プログラミング (OOP) 機能について、以下の選択肢から正しいものを選んでください。 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | PerlのOOP機能は貧弱であり、コンストラクタもデストラクタも組み込みでは存在しない。 15 | 16 | =item 2. 17 | 18 | Perlでは、以下のように組み込み関数 C によってプロパティを宣言できる。このとき、アクセサも生成される。 19 | 20 | has foo => ( 21 | is => 'rw', 22 | isa => 'Int', 23 | default => 42, 24 | ); 25 | 26 | =item 3. 27 | 28 | Perlでは多重継承が可能であるが、下記に示すような2つ以上の基底クラスが更に共通の基底クラスを持つ形になる継承、いわゆる「ダイヤモンド継承」は許可されておらず、そのようなケースではエラーになる。 29 | 30 | # ダイヤモンド継承 31 | use 5.14.0; 32 | package A { } 33 | package B { 34 | use base qw(A); 35 | } 36 | package C { 37 | use base qw(A); 38 | } 39 | package D { 40 | use base qw(B C); # エラー！ 41 | } 42 | 43 | =item 4. 44 | 45 | Perlのメソッドの実体はただのサブルーチンであり、サブルーチンをメソッドとして呼び出すと最初の引数にクラスまたはオブジェクトが渡されるだけである。つまり以下の２つの文a, bは同じ意味である。 46 | 47 | Foo::bar('Foo', 42); # (a) 48 | Foo->bar(42); # (b) 49 | 50 | =item 5. 51 | 52 | Perlのオブジェクトの実体はなんでもよく、組み込み関数 C によってスカラーやハッシュ、配列など任意のデータ型のリファレンスをオブジェクトにする事ができる。 53 | 54 | =back 55 | 56 | =head1 ANSWER 57 | 58 | 5 59 | 60 | =head1 EXPLANATION 61 | 62 | 5番が正解です。ほとんどのケースではハッシュリファレンスをblessしてオブジェクトを作りますが、実際には型グロブやサブルーチンなど任意のデータ型のリファレンスをblessすることができます。 63 | 64 | 以下、誤った選択肢について解説します。 65 | 66 | =over 67 | 68 | =item 1 69 | 70 | Perlには組み込みのコンストラクタは存在しませんが、DESTROYという名前のサブルーチンを定義するとデストラクタとして振る舞います。 71 | 72 | =item 2 73 | 74 | 組み込み関数の C は存在しません。MooseやMouseなどのOOPサポートモジュールなどが C を提供しています。 75 | 76 | =item 3 77 | 78 | Perlでは多重継承が許可されているのは正しいのですが、ダイヤモンド継承を禁止したりはしていません。ただダイヤモンド継承を行うとメソッドの検索順序で問題が起きることがあります。ダイヤモンド継承時におけるメソッド解決順序については L プラグマも参考にしてください。 79 | 80 | =item 4 81 | 82 | C<< Foo::bar('Foo', 42) >> と C<< Foo->bar(42) >> は等価ではありません。後者はFooにメソッドが見つからないときに基底クラスへメソッドを検索しにいきますが、前者はメソッド呼び出しではないため継承とは関係なく動作します。 83 | 84 | =back 85 | 86 | =head1 SEE ALSO 87 | 88 | L 89 | 90 | =head1 AUTHOR 91 | 92 | Fuji Goro 93 | http://github.com/gfx 94 | 95 | =cut 96 | -------------------------------------------------------------------------------- /data/open-scalar.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | Perlでは以下のようにしてスカラー変数をopenし、ファイルのように読み書きする機能があります。この機能は一体なんという名前でしょうか。 7 | 8 | open my $fh, '>', \my $buff; 9 | print $fh "Hello, world!\n"; 10 | close $fh; 11 | print $buff; # => Hello, world! 12 | 13 | =head1 CHOICES 14 | 15 | =over 16 | 17 | =item 1. 18 | 19 | overload 20 | 21 | =item 2. 22 | 23 | tie handle 24 | 25 | =item 3. 26 | 27 | PerlIO 28 | 29 | =item 4. 30 | 31 | PolymophicIO 32 | 33 | =item 5. 34 | 35 | IO::Handle 36 | 37 | =back 38 | 39 | =head1 ANSWER 40 | 41 | 3 42 | 43 | =head1 EXPLANATION 44 | 45 | これはPerlIOと呼ばれるIOを拡張する機能です。スカラー変数への読み書きは実際にはPerlIO::scalarというモジュールが行なっています。 46 | 47 | tie handleを使ったIO::Scalarというモジュールでも同じことは実現できますが、その場合エントリポイントは C ではなくC になります。 48 | 49 | =head1 AUTHOR 50 | 51 | Fuji Goro 52 | http://github.com/gfx 53 | 54 | =cut 55 | -------------------------------------------------------------------------------- /data/perl-catchword.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | Perlのスローガンは以下のうちどれでしょう？ 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | 「一つのことをうまくやれ」 15 | 16 | =item 2. 17 | 18 | 「驚き最小限の法則」 19 | 20 | =item 3. 21 | 22 | 「正しく、美しく、速く(この順番で)」 23 | 24 | =item 4. 25 | 26 | 「推測するな、測定せよ」 27 | 28 | =item 5. 29 | 30 | 「やりかたは一つではない」 31 | 32 | =back 33 | 34 | =head1 ANSWER 35 | 36 | 5 37 | 38 | =head1 EXPLANATION 39 | 40 | 「やりかたは一つではない」は TMTOWTDI(There's More Than One Way To Do It; ティムトゥーディ) としてよく知られたPerlのスローガンです。 41 | 42 | これに対して「一つのことをうまくやれ」はUNIXのスローガンであり、Pythonのスローガンです。特にPythonはほぼ同じ用途のプログラミング言語ですが、思想はまったく異なるというわけです。 43 | 44 | 「驚き最小の法則」はUIの設計でよく言われる、人間工学における原則です。 45 | 46 | 「正しく、美しく、速く(この順番で)」は、書籍『ビューティフル・コード』第五章(Elliotte Rusty Harold)のタイトルで、ソフトウェアにおいてはこの3つがこの順番で重要であると述べています。 47 | 48 | 「推測するな、測定せよ」は書籍『24時間365日 サーバ/インフラを支える技術』にある言葉で、システムの運用に関して述べています。 49 | 50 | =head1 AUTHOR 51 | 52 | Fuji Goro 53 | http://github.com/gfx 54 | 55 | =cut 56 | -------------------------------------------------------------------------------- /data/perl-command.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | シェル、もしくはコマンドプロンプトで、 7 | 8 | perl 9 | 10 | と入力してリターンキーを押した。そのときの挙動として正しいものはどれか。 11 | 12 | =head1 CHOICES 13 | 14 | =over 15 | 16 | =item 1. 17 | 18 | 何も実行されず、シェルに戻る 19 | 20 | =item 2. 21 | 22 | 入力を待ち受ける状態になる 23 | 24 | =item 3. 25 | 26 | perl のバージョンが表示される 27 | 28 | =item 4. 29 | 30 | エラーが表示され、perlコマンドのhelpが表示される 31 | 32 | =item 5. 33 | 34 | Perlの対話環境であるREPLが起動する 35 | 36 | =back 37 | 38 | =head1 ANSWER 39 | 40 | 2 41 | 42 | =head1 EXPLANATION 43 | 44 | `perl` コマンドは普通、 45 | 46 | perl ./script.pl 47 | 48 | などのように perl スクリプトを引数として指定することで、そのスクリプトを実行しますが、 49 | 引数なしで実行すると perl スクリプトを受け付ける状態になります。 50 | 51 | `cat` コマンドの挙動みたいなものといえばわかりやすいひともいるかもしれませんね。 52 | 53 | `perl` コマンドについての詳細な説明や、その他のオプションについては `perldoc perlrun` を参照ください。 54 | 55 | =head1 AUTHOR 56 | 57 | Daisuke Murase 58 | http://github.com/typester 59 | 60 | =cut 61 | -------------------------------------------------------------------------------- /data/perldoc-x.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | perldocコマンドについて問題です。以下の選択肢のうち、正しい説明を選択してください。ただしperldocのバージョンは5.10.0付属の3.14_02以降であることとします。 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | C とすると、NAMEというドキュメントまたはモジュールのファイルパスを表示してくれる。 14 | 15 | =item 2. 16 | 17 | C は C のキーワードを検索する。 18 | 19 | =item 3. 20 | 21 | C<< perl -wE 'say undef' 2>&1 | perldoc >> のようにしてperlからのエラーメッセージをperldocコマンドに与えると、対応する説明を C から検索してくれる。 22 | 23 | =item 4. 24 | 25 | C は特殊変数VARをCから検索する。 26 | 27 | =back 28 | 29 | =head1 ANSWER 30 | 31 | 4 32 | 33 | =head1 EXPLANATION 34 | 35 | 4が正解です。特殊変数はWebでは検索しにくいため、C と C は覚えておいたほうがいいでしょう。 36 | 37 | 1に相当する機能は C (ドキュメント優先) ないし C (モジュールファイルのみ対象) です。Cの頭文字だと覚えておくといいでしょう。 38 | 39 | 2に相当する機能は C です。ただしあらかじめ定義されたキーワードのみ対象で全文検索ではないため、役に立つケースは限られています。 40 | 41 | 3に相当する機能は C プラグマです。C などとして使います。ただし詳しく説明してくれるのはPerl本体からのメッセージだけです。 42 | 43 | =head1 AUTHOR 44 | 45 | Fuji Goro 46 | http://github.com/gfx 47 | 48 | =cut 49 | -------------------------------------------------------------------------------- /data/perlop-precedence.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | 以下のサブルーチンの戻り値は何か？ 6 | 7 | sub test { 8 | return q{0} or ( q{a} . q{b} =~ /\Aab\z/ ); 9 | } 10 | 11 | =head1 CHOICES 12 | 13 | =over 14 | 15 | =item 1. 16 | 17 | 1 18 | 19 | =item 2. 20 | 21 | a 22 | 23 | =item 3. 24 | 25 | 0 26 | 27 | =back 28 | 29 | =head1 ANSWER 30 | 31 | 3 32 | 33 | =head1 EXPLANATION 34 | 35 | 演算子の優先順位は 36 | リスト演算子 (右方向に対して) > or演算子 37 | のため、return q{0}が先に評価され、戻り値は0になります。 38 | 39 | ちなみにor演算子を||演算子に変えると 40 | ||演算子 > リスト演算子 (右方向に対して) 41 | のため、 ( q{a} . q{b} =~ /\Aab\z/ )の結果が戻り値になります。 42 | .演算子と=~演算子は 43 | =~ > . 44 | のため、( q{a} . q{b} =~ /\Aab\z/ )の評価の結果はaになります。 45 | 詳しくは L を参照してください。 46 | 47 | =head1 AUTHOR 48 | 49 | Takeshi Nakata 50 | https://github.com/nakatakeshi 51 | 52 | =cut 53 | -------------------------------------------------------------------------------- /data/plackup-default-server.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | plackup で -s オプションを指定しない場合に起動されるデフォルトの HTTP サーバは何？ 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | HTTP::Daemon 14 | 15 | =item 2. 16 | 17 | Net::Server::HTTP 18 | 19 | =item 3. 20 | 21 | HTTP::Server::PSGI 22 | 23 | =item 4. 24 | 25 | HTTP::Server::Simple 26 | 27 | =back 28 | 29 | =head1 ANSWER 30 | 31 | 3 32 | 33 | =head1 EXPLANATION 34 | 35 | いずれも Perl で HTTP サーバを動作させるためのモジュールですが、Plack に同梱されていて、plackup が PSGI アプリケーションのためにデフォルトで起動するのは HTTP::Server::PSGI です。 36 | 37 | =head1 AUTHOR 38 | 39 | fujiwara 40 | https://github.com/fujiwara 41 | -------------------------------------------------------------------------------- /data/read-whole-data.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | 以下はファイル内のテキスト全体を読み込む処理ですが 6 | 7 | open my $fh, '<', './inputfile' or die "failed to open: $!"; 8 | my $content = do { HERE }; 9 | print $content; 10 | 11 | C に入るコードは次のうちどれか。 12 | 13 | =head1 CHOICES 14 | 15 | =over 16 | 17 | =item 1. 18 | 19 | <$fh>; 20 | 21 | =item 2. 22 | 23 | local $!; <$fh>; 24 | 25 | =item 3. 26 | 27 | local $/; <$fh>; 28 | 29 | =item 4. 30 | 31 | local $^O = 'MSWin32'; <$fh>; 32 | 33 | =back 34 | 35 | =head1 ANSWER 36 | 37 | 3 38 | 39 | =head1 EXPLANATION 40 | 41 | C<$/> は C<$INPUT_RECORD_SEPARATOR> の別名で、入力レコードのセパレータ文字が指定されます。通常は改行文字になっていますが、これを未指定としファイル全体を1レコードして扱う事でファイル全体を読み込みます。 42 | 43 | =head1 AUTHOR 44 | 45 | Yasuhiro Matsumoto 46 | http://github.com/mattn 47 | 48 | =cut 49 | -------------------------------------------------------------------------------- /data/regexploop.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 |
    6 |
  • foo
    • 7 |
  • bar
    • 8 |
  • buzz
    • 9 |
  • hoge
    • 10 |
  • fuga
    • 11 |
12 | 13 | このような HTML 文字列を含んだ変数 C<$html> から C<<
  • >> で括られたリスト C<@lists> を生成したい。 14 | 15 | 次のコードうち誤りであるものを選べ 16 | 17 | 18 | =head1 CHOICES 19 | 20 | =over 21 | 22 | =item 1. 23 | 24 | my @lists; 25 | push @lists, $1 while $html =~ m!
  • (.*?)
    • !g; 26 | 27 | =item 2. 28 | 29 | my @lists = $html =~ m!
  • (.*?)
    • !g; 30 | 31 | 32 | =item 3. 33 | 34 | my @lists; 35 | while ($html =~ m!
  • (.*?)
    • !) { 36 | push @lists, $1; 37 | } 38 | 39 | =back 40 | 41 | =head1 ANSWER 42 | 43 | 3 44 | 45 | =head1 EXPLANATION 46 | 47 | 正規表現マッチに g 修飾子をつかっていないため、この while は無限ループする。 48 | 49 | =head1 AUTHOR 50 | 51 | Daisuke Murase 52 | http://github.com/typester 53 | -------------------------------------------------------------------------------- /data/remove-array.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | my @people = ('Larry', 'Tatsuhiko'); 7 | $people[0] = undef; 8 | undef $people[1]; 9 | 10 | このコードが実行されたあとの、配列 C<@people> はどのようになっているか、正しいものを選べ。 11 | 12 | =head1 CHOICES 13 | 14 | =over 15 | 16 | =item 1. 17 | 18 | 要素数は1で、最初の要素には undef が入っている。 19 | 20 | =item 2. 21 | 22 | 配列は空である 23 | 24 | =item 3. 25 | 26 | 要素数2で、どちらも undef が入っている 27 | 28 | =item 4. 29 | 30 | 要素数2で、最初の要素に undef、次の要素には Tatsuhiko がそのまま入っている 31 | 32 | =back 33 | 34 | =head1 ANSWER 35 | 36 | 3 37 | 38 | =head1 EXPLANATION 39 | 40 | undef を代入したり、C 関数を使用しても配列の要素は undef にはなりますがなくなりません。 41 | 42 | 配列を空にするには 43 | 44 | @people = (); 45 | 46 | というように空のリストを代入するのが正しい方法です。 47 | 48 | また、 49 | 50 | delete @array; 51 | 52 | という配列に対する C は昔は C と同じように動作しましたが、最近の Perl では一応動くものの deprecated 扱いであり推奨されませんし、将来のバージョンでは使えなくなる可能性もありますので、使用を控えた方がいいでしょう。 53 | 54 | =head1 AUTHOR 55 | 56 | Daisuke Murase 57 | http://github.com/typester 58 | 59 | =cut 60 | -------------------------------------------------------------------------------- /data/remove-hash-element.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | ハッシュの要素はどうやって削除すればいいでしょうか。以下の選択肢から正しいものを選んでください。 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | $hash{$name} = undef; 15 | 16 | =item 2. 17 | 18 | undef $hash{$name}; 19 | 20 | =item 3. 21 | 22 | splice %hash, $name; 23 | 24 | =item 4. 25 | 26 | delete $hash{$name}; 27 | 28 | =item 5. 29 | 30 | unlink $hash{$name}; 31 | 32 | =back 33 | 34 | =head1 ANSWER 35 | 36 | 4 37 | 38 | =head1 EXPLANATION 39 | 40 | ハッシュの要素を削除するには C を使います。C を代入ないし適用しても C<$name> に対応する値がundefになるだけなので注意してください。 41 | 42 | =head1 AUTHOR 43 | 44 | Fuji Goro 45 | http://github.com/gfx 46 | 47 | =cut 48 | -------------------------------------------------------------------------------- /data/special-blocks.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | #!/usr/bin/env perl 7 | use strict; 8 | use v5.10; 9 | say 'main1'; 10 | eval(<<__CODE__); 11 | BEGIN { 12 | say "BEGIN"; 13 | } 14 | UNITCHECK { 15 | say "UNITCHECK"; 16 | } 17 | CHECK { 18 | say "CHECK"; 19 | } 20 | INIT { 21 | say "INIT"; 22 | } 23 | END { 24 | say "END"; 25 | } 26 | __CODE__ 27 | say 'main2'; 28 | 29 | 上記のコードを実行した場合に表示される順番として正しいものは以下のうちどれでしょう。 30 | 31 | =head1 CHOICES 32 | 33 | =over 34 | 35 | =item 1 36 | 37 | BEGIN 38 | UNITCHECK 39 | CHECK 40 | INIT 41 | main1 42 | main2 43 | END 44 | 45 | =item 2 46 | 47 | main1 48 | BEGIN 49 | UNITCHECK 50 | CHECK 51 | INIT 52 | END 53 | main2 54 | 55 | =item 3 56 | 57 | main1 58 | BEGIN 59 | UNITCHECK 60 | main2 61 | END 62 | 63 | =item 4 64 | 65 | main1 66 | BEGIN 67 | UNITCHECK 68 | CHECK 69 | main2 70 | 71 | =item 5 72 | 73 | main1 74 | BEGIN 75 | UNITCHECK 76 | main2 77 | 78 | =back 79 | 80 | =head1 ANSWER 81 | 82 | 3 83 | 84 | =head1 EXPLANATION 85 | 86 | 3番が正解です。evalの中で定義された特殊ブロックは C、C、Cのみが実行されます。また、CブロックはCの最後ではなく、evalの外で定義されたCブロックと同様に、インタプリタが終了する直前にLIFOで実行されます。 87 | 88 | なお、この挙動に関してはCに記載されています。 89 | 90 | =head1 AUTHOR 91 | 92 | Hideaki Ohno 93 | https://github.com/hideo55 94 | 95 | =cut 96 | -------------------------------------------------------------------------------- /data/subst-string.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | 次のコードが標準出力へ出力するものとして、正しいものは以下のうちどれでしょうか。 7 | 8 | sub subst_perl { 9 | map s/(Perl)/$1Dojo/g, @_; 10 | } 11 | 12 | my @a = subst_perl("Perl Monger", "Perl.org", "Pearl"); 13 | print join ", ", @a; 14 | 15 | 16 | =head1 CHOICES 17 | 18 | =over 19 | 20 | =item 1. 21 | 22 | 「PerlDojo Monger, PerlDojo.org, Pearl」と表示される 23 | 24 | =item 2. 25 | 26 | 「1, 1, 」と表示される 27 | 28 | =item 3. 29 | 30 | 「, , 」と表示される 31 | 32 | =item 4. 33 | 34 | 実行時エラーになる 35 | 36 | =back 37 | 38 | =head1 ANSWER 39 | 40 | 4 41 | 42 | =head1 EXPLANATION 43 | 44 | 4番が正解です。 45 | 定数文字列を C などで変更しようとすると、「Modification of a read-only value attempted at - line 2.」と表示されエラーになります。 46 | このエラーは次のように定数文字列を C<@_> 経由で直接書き変えようとした時にも発生します。 47 | 48 | sub subst_perl { 49 | $_[0] = 1; # Modification of a read-only value attempted 50 | } 51 | subst_perl("Perl Monger", "Perl.org", "Pearl"); 52 | 53 | 以下、誤った選択肢について解説します。 54 | 55 | =over 56 | 57 | =item 1 58 | 59 | 「PerlDojo Monger, PerlDojo.org, Pearl」と表示される 60 | 61 | もし C が以下のようであれば1番が正解でした。 62 | 63 | sub subst_perl { 64 | map { my $s = $_; $s =~ s/(Perl)/$1Dojo/g; $s } @_; 65 | } 66 | 67 | Perl 5.13.2以上だと C 修飾子が使えるので以下のように書けます。 68 | 69 | sub subst_perl { 70 | map s/(Perl)/$1Dojo/gr, @_; 71 | } 72 | 73 | =item 2 74 | 75 | 「1, 1, 」と表示される 76 | 77 | もし C が以下のようであれば2番が正解でした。 78 | C はマッチした回数を返すので、 C<$s> を返す必要があります。 79 | 80 | sub subst_perl { 81 | map { my $s = $_; $s =~ s/(Perl)/$1Dojo/g } @_; 82 | } 83 | 84 | =item 3 85 | 86 | 全くの嘘です。すみません。 87 | 88 | =back 89 | 90 | =head1 AUTHOR 91 | 92 | Takuya Fujiwara 93 | http://github.com/tyru 94 | 95 | =cut 96 | -------------------------------------------------------------------------------- /data/switch.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | Perl 5.10 以降で 6 | 7 | use feature "switch"; 8 | 9 | とした場合、使えるようになるキーワードは何か。 10 | 11 | =head1 CHOICES 12 | 13 | =over 14 | 15 | =item 1. 16 | 17 | given 18 | 19 | =item 2. 20 | 21 | switch 22 | 23 | =item 3. 24 | 25 | where 26 | 27 | =back 28 | 29 | =head1 ANSWER 30 | 31 | 1 32 | 33 | =head1 EXPLANATION 34 | 35 | 5.10 から given when 構文がサポートされました。 36 | 37 | 使用するためには C とします。 38 | 39 | キーワード given と when は他の言語での switch および case と 同様のものです。 40 | 41 | given($_) { 42 | when (/^abc/) { $abc = 1; } 43 | when (/^def/) { $def = 1; } 44 | when (/^xyz/) { $xyz = 1; } 45 | default { $nothing = 1; } 46 | } 47 | 48 | Perl-5.8 から 5.12 まで標準モジュールに含まれていた Switch.pm は、5.14 から標準モジュールではなくなっています。 49 | 50 | =head1 AUTHOR 51 | 52 | fujiwara 53 | http://github.com/fujiwara 54 | 55 | =cut 56 | -------------------------------------------------------------------------------- /data/unambiguous-hashref.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | 以下のテストにパスするサブルーチン hashem の実装として間違っているものはどれか。 6 | 7 | use strict; 8 | use warnings; 9 | use Test::More; 10 | 11 | my %hash = ('foo' => 'bar'); 12 | my $hashem = { 'foo' => 'bar' }; 13 | 14 | is_deeply( hashem(%hash), $hashem ); 15 | 16 | done_testing; 17 | 18 | =head1 CHOICES 19 | 20 | =over 21 | 22 | =item 1. 23 | 24 | sub hashem { 25 | { @_ } 26 | } 27 | 28 | =item 2. 29 | 30 | sub hashem { 31 | +{ @_ } 32 | } 33 | 34 | =item 3. 35 | 36 | sub hashem { 37 | return { @_ } 38 | } 39 | 40 | =back 41 | 42 | =head1 ANSWER 43 | 44 | 1 45 | 46 | =head1 EXPLANATION 47 | 48 | Perl では中かっこを使って無名ハッシュのリファレンスをつくることができます。 49 | 50 | $hashref = { 51 | 'Adam' => 'Eve', 52 | 'Clyde' => 'Bonnie', 53 | }; 54 | 55 | 中かっこはブロックを囲うのにも使われるため、中かっこがハッシュリファレンスの開始を意味するのか他の用途で使われているのかが曖昧になってしまう場合があります。中かっこの前に + や return をおくことで、この曖昧さをなくすことができます。 56 | 57 | 詳しくは L リファレンスを作る (3) も参照してください。 L 58 | 59 | =head1 AUTHOR 60 | 61 | Kensuke Nagae 62 | http://github.com/kyanny 63 | 64 | =cut 65 | -------------------------------------------------------------------------------- /data/uniq-subroutine.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | 配列からユニークな値を取得するuniq関数の実装として適切なものを選択して下さい。 7 | 8 | #!/usr/bin/env perl 9 | use strict; 10 | use warnings; 11 | use Test::More; 12 | 13 | my $result = [ uniq('hoge','fuga','fuga','piyo') ]; 14 | is_deeply( $result, ['hoge', 'fuga', 'piyo']); 15 | done_testing; 16 | 17 | sub uniq { ... } 18 | 19 | 20 | =head1 CHOICES 21 | 22 | =over 23 | 24 | =item 1. 25 | 26 | sub uniq { 27 | my %seen = (); 28 | return map { not ++$seen{$_} } @_; 29 | } 30 | 31 | =item 2. 32 | 33 | sub uniq { 34 | my %seen = (); 35 | return map { not $seen{$_}++ } @_; 36 | } 37 | 38 | =item 3. 39 | 40 | sub uniq { 41 | my %seen = (); 42 | return grep { not ++$seen{$_} } @_; 43 | } 44 | 45 | =item 4. 46 | 47 | sub uniq { 48 | my %seen = (); 49 | return grep { not $seen{$_}++ } @_; 50 | } 51 | 52 | =back 53 | 54 | =head1 ANSWER 55 | 56 | 4 57 | 58 | =head1 EXPLANATION 59 | 60 | これはcpanモジュールでもあるLのuniq関数そのものです。 61 | 62 | 条件に一致したものをリストとして返すにはmapとgrepのどちらが適切かを考えると選択肢は3,4に絞られます。 63 | 64 | あとはインクリメント演算子の位置によってgrepの結果が異なる事が分かれば解答できると思います。 65 | 66 | 詳細は以下を参照下さい。 67 | 68 | L 69 | 70 | L 71 | 72 | L 73 | 74 | =head1 AUTHOR 75 | 76 | okamuuu 77 | http://github.com/okamuuu 78 | 79 | =cut 80 | -------------------------------------------------------------------------------- /data/use-require.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | useとrequireの違いについて以下から正しい物を選択せよ。 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | useはランタイムでモジュールを読み込み、requireはコンパイル時に読み込む 14 | 15 | =item 2. 16 | 17 | useはオールナイトでモジュールを読み込み、requireはパイルダーオン時に読み込む 18 | 19 | =item 3. 20 | 21 | useはコンパイル時にモジュールを読み込み、requireはランタイムで読み込む 22 | 23 | =item 4. 24 | 25 | useとrequireに違いはない 26 | 27 | =back 28 | 29 | =head1 ANSWER 30 | 31 | 3 32 | 33 | =head1 EXPLANATION 34 | 35 | useはコンパイル時にモジュールを読み込みます。 36 | 37 | if (0) { 38 | use Foo; 39 | # using Foo 40 | } 41 | 42 | ですので上記の場合、Fooというモジュールが存在しない場合はコンパイル時にエラーとなります。 43 | それに比べてrequireはランタイムでモジュールが読み込まれます。 44 | 45 | if ($^O eq 'MSWin32') { 46 | require Win32::API; 47 | # using Win32::API 48 | } 49 | 50 | よってOSや処理系によって処理を切り替えたい場合に使えます。 51 | なお、useはコンパイル時に読み込みますので特殊ブロックは C C C を実行してから処理が開始されますが、requireは既にそれらは実行済みですので C ブロックのみが実行されます。 52 | 条件に従って、use相当を行う場合は 53 | 54 | BEGIN { 55 | require Foo; 56 | Foo->import(); 57 | } 58 | 59 | とする事で同等の動きとなります。またimportの引数がuseに渡す引数に相当します。 60 | 61 | =head1 AUTHOR 62 | 63 | Yasuhiro Matsumoto 64 | https://github.com/mattn 65 | -------------------------------------------------------------------------------- /data/utf8-encode-judge.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | C<$string>はUTF8フラグ付きの文字列である。この文字列をUTF8を表示できる環境でエラーや warning を出さずに文字化けさせずに表示したい。正しいものを選べ。 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | print utf8::is_utf8($string) ? Encode::encode($string, 'utf8') : $string; 15 | 16 | =item 2. 17 | 18 | if (utf8::is_utf8($string)) { 19 | utf8::encode($string); 20 | } 21 | print $string; 22 | 23 | =item 3. 24 | 25 | if (utf8::is_utf8($string)) { 26 | utf8::downgrade($string); 27 | } 28 | print $string; 29 | 30 | =item 4. 31 | 32 | 該当なし 33 | 34 | =back 35 | 36 | =head1 ANSWER 37 | 38 | 4 39 | 40 | =head1 EXPLANATION 41 | 42 | 貴本的に、 43 | 44 | utf8::is_utf8 で何かしらの判断をするようなコードは書いてはいけません 45 | 46 | C<$string>に、UTF8フラグが付いていても、その文字列が UTF8でデコードされているかは、Cでは、B<判断できません>。 47 | 例えば、次のようなコードの場合(UTF8で書かれているとする): 48 | 49 | use Encode; 50 | no utf8; 51 | my $string = 'こんにちは'; 52 | $string = Encode::decode('latin1', 'こんにちは'); 53 | print utf8::is_utf8($string), "\n"; # 1 54 | print $string, "\n"; # こんにちは (warningはない) 55 | print length($string); # 15 56 | 57 | latin1 でデコードされているため、UTF8フラグは付いている。ただし、latin1なので、Wide Character にはならず、print しても warning は出ない。 58 | UTF8でデコードされていないので、文字列の長さは 15 となる。 59 | 文字列をUTF8フラグがあるからといって、 60 | 61 | Encode::encode('utf8', $string); 62 | 63 | を行うと、B<文字化けしてしまいます>。 64 | 宮川さんの書かれた Lを参考にしてください。 65 | 66 | =head1 AUTHOR 67 | 68 | Kato Atsushi 69 | http://github.com/ktat 70 | 71 | =cut 72 | -------------------------------------------------------------------------------- /data/utf8-function.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | 以下のコードはどのような出力になるでしょうか。 6 | 7 | use utf8; 8 | use Encode; 9 | 10 | sub こんにちは { 11 | print encode_utf8('こんにちは、' . $_[0]); 12 | } 13 | 14 | こんにちは('世界'); 15 | 16 | =head1 CHOICES 17 | 18 | =over 19 | 20 | =item 1. 21 | 22 | こんにちは、世界 23 | 24 | =item 2. 25 | 26 | Illegal declaration of anonymous subroutine 27 | 28 | =item 3. 29 | 30 | Wide character in print 31 | 32 | =back 33 | 34 | =head1 ANSWER 35 | 36 | 1 37 | 38 | =head1 EXPLANATION 39 | 40 | Perl 5.8 以上では C をすることでパッケージ名や関数名などにもマルチバイト文字列が使用できるようになりますので、この C<こんにちは> という関数は期待通り動作します。 41 | 42 | =head1 AUTHOR 43 | 44 | Daisuke Murase 45 | http://github.com/typester 46 | 47 | =cut 48 | -------------------------------------------------------------------------------- /data/utf8-length.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | 次のコードの出力は？ 6 | 7 | use utf8; 8 | 9 | my $hello = 'こんにちは'; 10 | print length($hello); 11 | 12 | =head1 CHOICES 13 | 14 | =over 15 | 16 | =item 1. 17 | 18 | 10 19 | 20 | =item 2. 21 | 22 | 5 23 | 24 | =item 3. 25 | 26 | 15 27 | 28 | =back 29 | 30 | =head1 ANSWER 31 | 32 | 2 33 | 34 | =head1 EXPLANATION 35 | 36 | L プラグマが有効になっていると文字列の長さは utf-8 での文字の数と一致しますから、5 が正解です。 37 | 38 | utf8 プラグマを使用していない場合は C はバイト数を返します。 39 | この場合には 15 (utf-8の場合) になります。 40 | 41 | =head1 AUTHOR 42 | 43 | Daisuke Murase 44 | http://github.com/typester 45 | 46 | =cut 47 | -------------------------------------------------------------------------------- /data/what-is-cpanm.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | B とは何でしょう？ 7 | 8 | =head1 CHOICES 9 | 10 | =over 11 | 12 | =item 1. 13 | 14 | I を意味するユーティリティコマンド。モジュールがインストールされているかどうかや、インストールされているモジュールのバージョンなどを表示する。 15 | 16 | =item 2. 17 | 18 | I を意味するユーティリティコマンド。モジュールのバージョンや作者、リポジトリ、ライセンスなどのメタデータを調べることができる。 19 | 20 | =item 3. 21 | 22 | 複数のバージョンのCPANモジュールをインストールするための I と呼ばれるパッケージマネージャ。バックエンドはCPAN::Multiplexerであり、cpanmコマンドはCPAN::Multiplexerのレイアウトに従ってモジュールをインストールする。 23 | 24 | =item 4. 25 | 26 | CPANPLUSのアンチテーゼとして I から名付けられたCPANモジュールのインストーラコマンド。 27 | cpan (バックエンドはCPAN.pm) コマンドやcpanpコマンド (バックエンドはCPANPLUS.pm) よりも高速かつ省メモリで動作する。 28 | 29 | =item 5. 30 | 31 | TPF(I)が運営する I というウェブサイトの愛称。マーケットという名前ではあるが何かを販売しているわけではなく、 CPAN Author へ寄付するためのシステムである。 32 | 33 | =back 34 | 35 | =head1 ANSWER 36 | 37 | 4 38 | 39 | =head1 EXPLANATION 40 | 41 | L はcpanコマンドの軽量版として2010年の春に開発が開始されたパッケージマネージャで、cpanコマンドと比べて使いやすいことから広く使われるようになりました。 42 | インストールも簡単で、Cというアドレスで実行ファイルを参照できるため C<< curl-L http://cpanmin.us | perl - App::cpanminus >> というコマンドだけですぐ使い始めることができます。また、perlbrew環境では C というコマンドで複数のperl共通のcpanmコマンドをインストールすることができます。「L<モダンな Perl の開発環境の構築方法|http://d.hatena.ne.jp/tokuhirom/20100716/perlenv>」 も参考にするといいでしょう。 43 | 44 | 他の選択肢はすべてデタラメなので間違って覚えないでくださいね。 45 | 46 | public repository: L 47 | 48 | =head1 AUTHOR 49 | 50 | Fuji Goro 51 | http://github.com/gfx 52 | 53 | =cut 54 | -------------------------------------------------------------------------------- /data/win32-osname.pod: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf-8 3 | 4 | =head1 QUESTION 5 | 6 | グローバル変数 $^O から OS の名前を取得することができます。 7 | 8 | windows ではどんな値が設定されているでしょうか？ 9 | 10 | =head1 CHOICES 11 | 12 | =over 13 | 14 | =item 1. 15 | 16 | Windows 17 | 18 | =item 2. 19 | 20 | Win32 21 | 22 | =item 3. 23 | 24 | MSWin32 25 | 26 | =item 4. 27 | 28 | Bill Gates 29 | 30 | =back 31 | 32 | =head1 ANSWER 33 | 34 | 3 35 | 36 | =head1 EXPLANATION 37 | 38 | 選択肢に cygwin がないので、3番の MSWin32 が正解です。モジュールを Windows 対応するときに必ず書くことになる文字なので、しっかり覚えておきましょう。 39 | ちなみに、Mac では C<< darwin >>、Linux では C<< linux >> などが入っています。 40 | 41 | また、C<< use Config >> すれば、C<< $Config{'osname'} >> からも取得できますが、使う機会は少ないでしょう。 42 | 43 | =head1 AUTHOR 44 | 45 | xaicron 46 | http://github.com/xaicron 47 | 48 | =cut 49 | -------------------------------------------------------------------------------- /lib/Dojo.pm: -------------------------------------------------------------------------------- 1 | package Dojo; 2 | use Ark; 3 | 4 | use_model 'Dojo::Models'; 5 | 6 | __PACKAGE__->meta->make_immutable; 7 | -------------------------------------------------------------------------------- /lib/Dojo/Controller.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Controller; 2 | use Ark 'Controller'; 3 | use Dojo::Models; 4 | 5 | sub auto :Private { 6 | my ($self, $c) = @_; 7 | $c->stash->{storage} = models("Storage"); 8 | } 9 | 10 | sub default :Path :Args { 11 | my ($self, $c) = @_; 12 | $c->res->status(404); 13 | $c->res->body('404 Not Found'); 14 | } 15 | 16 | sub index :Path { 17 | my ($self, $c) = @_; 18 | 19 | $c->stash->{by_p} = models("Storage")->get_authors_by_percentage(5); 20 | $c->stash->{by_s} = models("Storage")->get_authors_by_star(5); 21 | } 22 | 23 | sub end :Private { 24 | my ($self, $c) = @_; 25 | 26 | $c->res->content_type('text/html; charset=utf-8') unless $c->res->content_type; 27 | $c->res->header("Cache-Control" => "private") 28 | unless defined $c->res->header("Cache-Control"); 29 | 30 | unless ($c->res->has_body or $c->res->status =~ /^3/) { 31 | $c->forward( $c->view('MT') ); 32 | } 33 | } 34 | 35 | sub icon :Local :Args { 36 | my ($self, $c, @args) = @_; 37 | 38 | my $name = join "/", @args; 39 | my $uri = models("Storage")->get_author_icon($name) 40 | || Dojo::Model::Gravatar->default; 41 | $c->res->header( "Cache-Control" => "max-age=86400" ); 42 | $c->redirect($uri); 43 | } 44 | 45 | 46 | __PACKAGE__->meta->make_immutable; 47 | -------------------------------------------------------------------------------- /lib/Dojo/Controller/API.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Controller::API; 2 | use Ark 'Controller'; 3 | use 5.12.0; 4 | use Try::Tiny; 5 | use Dojo::Models; 6 | 7 | sub ping :Local { 8 | my ($self, $c) = @_; 9 | $c->res->content_type("text/plain; charset=utf-8"); 10 | $c->res->body("ok"); 11 | } 12 | 13 | sub star :Local :Args { 14 | my ($self, $c, @args) = @_; 15 | 16 | my $name = join "/", @args; 17 | my $q = try { 18 | models('Questions')->get($name); 19 | } or $c->detach('/default'); 20 | 21 | my $star = ""; 22 | given ( $c->req->method ) { 23 | when ("POST") { 24 | $star = models("Storage")->add_star($q); 25 | } 26 | when ("GET") { 27 | $star = models("Storage")->get_star($q); 28 | } 29 | when ("HEAD") { 30 | } 31 | default { 32 | $c->log->error("method: %s not allowed", $c->req->method); 33 | $c->res->status(405); 34 | } 35 | } 36 | 37 | $c->res->content_type("text/plain; charset=utf-8"); 38 | $c->res->body($star); 39 | } 40 | 41 | __PACKAGE__->meta->make_immutable; 42 | -------------------------------------------------------------------------------- /lib/Dojo/Controller/Question.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Controller::Question; 2 | use Ark 'Controller'; 3 | 4 | use Try::Tiny; 5 | use Dojo::Models; 6 | use Digest::MD5 qw/ md5_hex /; 7 | 8 | sub auto :Private { 1 } 9 | 10 | sub restore_answer_sheet :Private { 11 | my ($self, $c) = @_; 12 | 13 | my $as; 14 | if ( my $serialized = $c->req->cookies->{ $c->config->{cookie_name} } ) { 15 | $c->log->debug("cookie found. restore answer_sheet from $serialized") 16 | if $c->debug; 17 | try { 18 | $as = models("AnswerSheet")->deserialize( 19 | serialized => $serialized, 20 | questions => models("Questions"), 21 | ); 22 | } catch { 23 | my $e = $_; 24 | $c->log->error("restore failed. $e"); 25 | }; 26 | } 27 | $c->stash->{answer_sheet} = $as; 28 | } 29 | 30 | 31 | sub index :Path { 32 | my ($self, $c) = @_; 33 | 34 | my $as = models("AnswerSheet")->new; 35 | $as->questions([ models("Questions")->get_shuffled(5) ]); 36 | $c->stash->{answer_sheet} = $as; 37 | 38 | $c->forward("keep_session"); 39 | $c->redirect_and_detach( 40 | $c->uri_for('/question/' . $as->current_question->name)->as_string, 41 | ); 42 | } 43 | 44 | sub question :Path :Args { 45 | my ($self, $c, @args) = @_; 46 | 47 | my $as = $c->forward("restore_answer_sheet"); 48 | my $name = join "/", @args; 49 | 50 | my $q; 51 | if ($as) { 52 | $q = $as->set_current_question($name); 53 | } 54 | unless ($q) { 55 | eval { 56 | $q = models('Questions')->get($name); 57 | undef $as; 58 | delete $c->stash->{answer_sheet}; 59 | $c->log->info("remove session."); 60 | }; 61 | } 62 | if (!$q || $@) { 63 | $c->log->error("cannot load question: $name $@"); 64 | $c->stash->{reset} = 1; 65 | $c->detach('/default'); 66 | } 67 | $c->stash->{'q'} = $q; 68 | 69 | if ( $c->req->method eq "POST" ) { 70 | $c->forward("question_POST"); 71 | } 72 | $c->forward("keep_session"); 73 | } 74 | 75 | sub question_POST :Private { 76 | my ($self, $c) = @_; 77 | 78 | my $as = $c->stash->{answer_sheet}; 79 | my $q = $c->stash->{"q"}; 80 | 81 | my $choice = $c->req->param('choice'); 82 | if ( $choice and $choice =~ /^\d+$/ and defined $q->choices->[ $choice - 1 ] ) { 83 | my $right = 0; 84 | if ($choice == $q->answer_number) { 85 | $right = 1; 86 | } 87 | 88 | $c->stash->{right} = $right; 89 | my $r = models("Storage")->set_result( $q => $right ); 90 | $c->stash->{percentage} = sprintf("%.1f", $r->{corrected} / $r->{answered} * 100) 91 | if $r && $r->{answered}; 92 | $c->stash->{star} 93 | = models("Storage")->get_star($q); 94 | 95 | if ($as) { 96 | $as->set_result($right ? 1 : 0); 97 | } 98 | $c->view('MT')->template('question/answer'); 99 | } 100 | else { 101 | $c->stash->{err} = 'Please choice an answer'; 102 | } 103 | } 104 | 105 | sub result :Local :Args(1) { 106 | my ($self, $c, $arg) = @_; 107 | 108 | my $serialized; 109 | if ( $arg =~ /^[0-9a-fA-F]{32}$/ ) { 110 | $c->log->info("get result $arg"); 111 | $serialized = models("Storage")->get("$arg"); 112 | } 113 | else { 114 | my $md5 = md5_hex($arg); 115 | my $set = models("Storage")->set( $md5 => "$arg" ); 116 | if ($set) { 117 | $c->redirect_and_detach( 118 | $c->uri_for("/question/result/", $md5) 119 | ); 120 | } 121 | else { 122 | $c->log->error("Can't set $md5 to storage"); 123 | $serialized = $arg; 124 | } 125 | } 126 | my $as = try { 127 | models("AnswerSheet")->deserialize( 128 | serialized => $serialized, 129 | questions => models("Questions"), 130 | ); 131 | }; 132 | if (!$as || $@) { 133 | $c->log->error("Can't restore answer sheet. $@"); 134 | $c->detach("/default"); 135 | } 136 | $c->stash->{answer_sheet} = $as; 137 | $c->forward("reset_session"); 138 | } 139 | 140 | sub icon :Local :Args { 141 | my ($self, $c, @args) = @_; 142 | 143 | my $name = join "/", @args; 144 | my $q = eval { models('Questions')->get($name) }; 145 | if (!$q || $@) { 146 | $c->log->error("cannot load question: $name $@"); 147 | $c->detach('/default'); 148 | } 149 | 150 | my $uri = models("Storage")->get_icon($q); 151 | unless ($uri) { 152 | $uri = $q->gravatar_uri; 153 | $c->log->info("set gravatar uri: %s", $uri); 154 | models("Storage")->set_icon($q => $uri); 155 | } 156 | $c->res->header( "Cache-Control" => "max-age=86400" ); 157 | $c->redirect($uri); 158 | } 159 | 160 | sub keep_session :Private { 161 | my ($self, $c) = @_; 162 | 163 | my $as = $c->stash->{answer_sheet} 164 | or return; 165 | $c->res->cookies->{ $c->config->{cookie_name} } = { 166 | value => $as->serialize, 167 | }; 168 | } 169 | 170 | sub reset_session :Private { 171 | my ($self, $c) = @_; 172 | 173 | $c->res->cookies->{ $c->config->{cookie_name} } = { 174 | value => "", 175 | expires => "-1y", 176 | }; 177 | } 178 | 179 | 180 | __PACKAGE__->meta->make_immutable; 181 | -------------------------------------------------------------------------------- /lib/Dojo/Controller/Result.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Controller::Result; 2 | use Ark 'Controller'; 3 | 4 | use Try::Tiny; 5 | use Dojo::Models; 6 | 7 | sub index :Path { 8 | my ($self, $c) = @_; 9 | } 10 | 11 | 12 | __PACKAGE__->meta->make_immutable; 13 | -------------------------------------------------------------------------------- /lib/Dojo/Controller/Update.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Controller::Update; 2 | use JSON; 3 | use strict; 4 | use Ark 'Controller'; 5 | 6 | sub index :Path :Args(1) { 7 | my ($self, $c, $key) = @_; 8 | 9 | if ($key ne $c->config->{update_key}) { 10 | $c->res->status(400); 11 | $c->log->error("invalid update_key: $key"); 12 | $c->res->body("error"); 13 | return; 14 | } 15 | 16 | if ($c->req->method ne "POST") { 17 | $c->res->status(405); 18 | $c->res->body("error"); 19 | } 20 | 21 | my $ok = system(qw| git fetch github |) == 0 22 | && system(qw| git merge github/master |) == 0; 23 | 24 | if ($ok) { 25 | $c->log->info("update ok!"); 26 | my $pid = $c->path_to("pid"); 27 | if ($pid && -e $pid) { 28 | $c->log->info("sending HUP..."); 29 | my $pid_number = $pid->slurp; 30 | chomp $pid_number; 31 | system("kill", "-HUP", $pid_number) == 0 32 | or $c->log->error("can't kill ${pid_number}: $!"); 33 | } 34 | $c->res->body("ok"); 35 | } 36 | else { 37 | $c->log->error("error $!"); 38 | $c->res->status(500); 39 | $c->res->body("error"); 40 | } 41 | } 42 | 43 | 1; 44 | -------------------------------------------------------------------------------- /lib/Dojo/Model/AnswerSheet.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Model::AnswerSheet; 2 | use utf8; 3 | use Any::Moose; 4 | use Carp; 5 | use feature "switch"; 6 | 7 | use Clone qw/ clone /; 8 | use Storable; 9 | use MIME::Base64 3.11; 10 | use Digest::SHA qw/ sha1_hex /; 11 | 12 | has questions => ( 13 | is => "rw", 14 | isa => "ArrayRef", 15 | default => sub { [] }, 16 | ); 17 | 18 | has results => ( 19 | is => "rw", 20 | isa => "ArrayRef", 21 | default => sub { [] }, 22 | ); 23 | 24 | has current => ( 25 | is => "rw", 26 | isa => "Int", 27 | default => 1, 28 | ); 29 | 30 | no Any::Moose; 31 | 32 | sub score { 33 | my $self = shift; 34 | int( $self->corrects / $self->total * 100 ); 35 | } 36 | 37 | sub rank { 38 | my $self = shift; 39 | given ($self->score) { 40 | when (100) { 41 | return 1; 42 | } 43 | when ( 80 <= $_ && $_ < 100 ) { 44 | return 2; 45 | } 46 | when ( 60 <= $_ && $_ < 80 ) { 47 | return 3; 48 | } 49 | when ( 39 <= $_ && $_ < 60 ) { 50 | return 4; 51 | } 52 | default { 53 | return 5; 54 | } 55 | } 56 | } 57 | 58 | sub set_result { 59 | my $self = shift; 60 | my $correct = shift; 61 | $self->results->[ $self->current - 1 ] = $correct ? 1 : 0; 62 | } 63 | 64 | sub go_next { 65 | my $self = shift; 66 | $self->current( $self->current + 1 ); 67 | } 68 | 69 | sub total { 70 | my $self = shift; 71 | return scalar @{ $self->questions }; 72 | } 73 | 74 | sub current_question { 75 | my $self = shift; 76 | $self->questions->[ $self->current - 1 ]; 77 | } 78 | 79 | sub next_question { 80 | my $self = shift; 81 | $self->questions->[ $self->current ]; 82 | } 83 | 84 | sub set_current_question { 85 | my $self = shift; 86 | my $name = shift; 87 | my $n = 0; 88 | my $found; 89 | for my $q (@{ $self->questions }) { 90 | $n++; 91 | if ($q->name eq $name) { 92 | $self->current($n); 93 | $found = 1; 94 | last; 95 | } 96 | } 97 | return unless $found; 98 | $self->current_question; 99 | } 100 | 101 | sub serialize { 102 | my $self = shift; 103 | my $r = { 104 | questions => [ map { $_->name } @{ $self->questions } ], 105 | results => clone( $self->results ), 106 | current => $self->current, 107 | }; 108 | MIME::Base64::encode_base64url( Storable::nfreeze($r) ); 109 | } 110 | 111 | sub deserialize { 112 | my $class = shift; 113 | my %args = @_; 114 | 115 | my $r = eval { 116 | Storable::thaw( MIME::Base64::decode_base64url( $args{serialized} ) ); 117 | }; 118 | if ($@) { 119 | die $@; 120 | } 121 | my $self = $class->new($r); 122 | 123 | for my $qname (@{ $r->{questions} }) { 124 | $qname = $args{questions}->get($qname); 125 | } 126 | 127 | $self; 128 | } 129 | 130 | sub digest { 131 | my $self = shift; 132 | sha1_hex( $self->serialize ); 133 | } 134 | 135 | sub corrects { 136 | my $self = shift; 137 | scalar grep { $_ } @{ $self->results }; 138 | } 139 | 140 | 1; 141 | -------------------------------------------------------------------------------- /lib/Dojo/Model/Gravatar.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Model::Gravatar; 2 | 3 | use strict; 4 | use warnings; 5 | use Furl; 6 | use JSON; 7 | use Digest::MD5 qw/ md5_hex /; 8 | 9 | our $UA; 10 | our $Cache; 11 | 12 | sub ua { 13 | $UA ||= Furl->new; 14 | } 15 | 16 | sub default { 17 | "http://www.gravatar.com/avatar/00000000000000000000000000000000?d=mm"; 18 | } 19 | 20 | 21 | sub gravatar_uri { 22 | my $class = shift; 23 | my $author = shift; 24 | 25 | if ($author =~ qr{($Email::Valid::Loose::Addr_spec_re)}) { 26 | return "http://www.gravatar.com/avatar/" . md5_hex($1); 27 | } 28 | elsif ($author =~ m{https?://(?:secure\.)?gravatar\.com/avatar/([0-9a-f]+)}) { 29 | return "http://www.gravatar.com/avatar/$1"; 30 | } 31 | elsif ($author =~ m{https?://github\.com/(\w+)}) { 32 | my $github_id = $1; 33 | my $api = "http://github.com/api/v2/json/user/show/${github_id}"; 34 | my $res = $class->ua->get($api); 35 | if ($res->is_success) { 36 | my $data = decode_json($res->content); 37 | my $id = $data->{user}->{gravatar_id}; 38 | return "http://www.gravatar.com/avatar/${id}"; 39 | } 40 | } 41 | else { 42 | return default(); 43 | } 44 | } 45 | 46 | 1; 47 | -------------------------------------------------------------------------------- /lib/Dojo/Model/Question.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Model::Question; 2 | use utf8; 3 | use Any::Moose; 4 | use Dojo::Model::Gravatar; 5 | use Email::Valid::Loose; 6 | 7 | has name => ( 8 | is => 'ro', 9 | required => 1, 10 | ); 11 | 12 | has data => ( 13 | is => 'ro', 14 | required => 1, 15 | # isa => 'Pod::HTMLEmbed::Entry', 16 | ); 17 | 18 | has question => ( 19 | is => 'ro', 20 | lazy => 1, 21 | default => sub { 22 | my ($self) = @_; 23 | $self->data->section('QUESTION'); 24 | }, 25 | ); 26 | 27 | has explanation => ( 28 | is => 'ro', 29 | lazy => 1, 30 | default => sub { 31 | my ($self) = @_; 32 | $self->data->section('EXPLANATION'); 33 | }, 34 | ); 35 | 36 | has author => ( 37 | is => 'ro', 38 | lazy => 1, 39 | default => sub { 40 | my ($self) = @_; 41 | my $author = $self->data->section('AUTHOR'); 42 | $author =~ s{}{}g; 43 | $author; 44 | }, 45 | ); 46 | 47 | has choices => ( 48 | is => 'ro', 49 | lazy => 1, 50 | default => sub { 51 | my ($self) = @_; 52 | 53 | my $html = $self->data->section('CHOICES'); 54 | my @choices = $html =~ m!
  • (.*?)
    • !gs; 55 | 56 | \@choices; 57 | }, 58 | ); 59 | 60 | has answer_number => ( 61 | is => 'ro', 62 | lazy => 1, 63 | default => sub { 64 | my ($self) = @_; 65 | 66 | my $html = $self->data->section('ANSWER'); 67 | my ($number) = $html =~ m!

    (\d+)

    !; 68 | 69 | $number; 70 | }, 71 | ); 72 | 73 | has answer => ( 74 | is => 'ro', 75 | lazy => 1, 76 | default => sub { 77 | my ($self) = @_; 78 | $self->choices->[ $self->answer_number - 1 ]; 79 | }, 80 | ); 81 | 82 | has gravatar_uri => ( 83 | is => "rw", 84 | lazy => 1, 85 | default => sub { 86 | my $self = shift; 87 | Dojo::Model::Gravatar->gravatar_uri( $self->author ); 88 | }, 89 | ); 90 | 91 | has author_name => ( 92 | is => "rw", 93 | lazy => 1, 94 | default => \&build_author_name, 95 | ); 96 | 97 | has author_uri => ( 98 | is => "rw", 99 | lazy => 1, 100 | default => \&build_author_uri, 101 | ); 102 | 103 | no Any::Moose; 104 | 105 | sub build_author_name { 106 | my $self = shift; 107 | my $author = $self->author; 108 | my $addr_spec_re = $Email::Valid::Loose::Addr_spec_re; 109 | my $uri_re = qr{s?https?://[-_.!~*'()a-zA-Z0-9;/?:\@&=+\$,%#]+}; 110 | my $re = qr{($addr_spec_re|$uri_re)}; 111 | 112 | my $name = (split /$re/, $author)[0]; 113 | $name =~ s{\A\s+}{}mg; 114 | $name =~ s{\s+\z}{}mg; 115 | $name; 116 | } 117 | 118 | sub build_author_uri { 119 | my $self = shift; 120 | my $author = $self->author; 121 | if ($author =~ m{(https?://github\.com/\w+)}) { 122 | return $1; 123 | } 124 | return; 125 | } 126 | 127 | __PACKAGE__->meta->make_immutable; 128 | -------------------------------------------------------------------------------- /lib/Dojo/Model/Questions.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Model::Questions; 2 | use utf8; 3 | use Any::Moose; 4 | use Carp; 5 | 6 | use File::Find (); 7 | use Pod::HTMLEmbed; 8 | 9 | use Dojo::Models; 10 | use Dojo::Model::Question; 11 | use List::Util qw/ shuffle /; 12 | 13 | has data_dir => ( 14 | is => 'ro', 15 | default => sub { 16 | models('home')->subdir('data')->stringify; 17 | }, 18 | ); 19 | 20 | has data => ( 21 | is => 'ro', 22 | default => sub { {} }, 23 | ); 24 | 25 | has _parser => ( 26 | is => 'ro', 27 | lazy => 1, 28 | default => sub { 29 | Pod::HTMLEmbed->new; 30 | }, 31 | ); 32 | 33 | no Any::Moose; 34 | 35 | sub BUILD { 36 | my ($self) = @_; 37 | $self->_load; 38 | } 39 | 40 | sub _load { 41 | my ($self) = @_; 42 | 43 | File::Find::find(sub { 44 | return unless $_ =~ /.+\.pod$/; 45 | 46 | if (my ($key, $obj) = $self->_parse_file($File::Find::name)) { 47 | $self->data->{ $key } = $obj; 48 | } 49 | else { 50 | warn 'Invalid pod: ', $File::Find::name, "\n"; 51 | } 52 | 53 | }, $self->data_dir); 54 | 55 | 1; 56 | } 57 | 58 | sub _parse_file { 59 | my ($self, $file) = @_; 60 | 61 | my $pod = $self->_parser->load($file); 62 | 63 | # check required sections 64 | if ($pod->section('QUESTION') && 65 | $pod->section('CHOICES') && 66 | $pod->section('ANSWER') && 67 | $pod->section('AUTHOR') ) { 68 | 69 | (my $key = $file) =~ s!(^\Q@{[ $self->data_dir ]}\E/|\.pod$)!!g; 70 | return ($key, $pod); 71 | } 72 | 73 | return (); 74 | } 75 | 76 | sub get { 77 | my ($self, $key) = @_; 78 | 79 | my $data = $self->data->{ $key } 80 | or croak "Question: $key is not found"; 81 | 82 | Dojo::Model::Question->new( 83 | name => $key, 84 | data => $self->data->{ $key }, 85 | ); 86 | } 87 | 88 | sub random_next { 89 | my ($self) = @_; 90 | 91 | my @keys = keys %{ $self->data }; 92 | $keys[ int rand scalar @keys ]; 93 | } 94 | 95 | sub get_shuffled { 96 | my ($self, $num) = @_; 97 | 98 | my @data; 99 | my $n = 0; 100 | for my $key ( shuffle keys %{ $self->data } ) { 101 | push @data, Dojo::Model::Question->new( 102 | name => $key, 103 | data => $self->data->{ $key }, 104 | ); 105 | last if ++$n == $num; 106 | } 107 | @data; 108 | } 109 | 110 | __PACKAGE__->meta->make_immutable; 111 | -------------------------------------------------------------------------------- /lib/Dojo/Model/Storage.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Model::Storage; 2 | use utf8; 3 | use Any::Moose; 4 | use Carp; 5 | use Dojo::Models; 6 | use Scalar::Util qw/ blessed /; 7 | 8 | has backend => ( 9 | is => 'rw', 10 | ); 11 | 12 | no Any::Moose; 13 | 14 | sub set_result { 15 | my ($self, $key, $correct) = @_; 16 | 17 | my $author; 18 | if ( ref $key && blessed($key) && $key->can("name") ) { 19 | $author = $key->author_name; 20 | $key = $key->name; 21 | } 22 | 23 | my $backend = $self->backend; 24 | my $answered = $backend->incr("answered:${key}", 1) 25 | || $backend->set("answered:${key}", 1) 26 | || 1; 27 | 28 | my $corrected = $correct ? $backend->incr("corrected:${key}") 29 | || $backend->set("corrected:${key}", 1) 30 | : $backend->get("corrected:${key}"); 31 | my $p = sprintf("%.1f", $corrected / $answered * 100); 32 | $backend->set( "percentage:${key}" => $p ); 33 | 34 | if ($author) { 35 | my $aa = $backend->incr("author_answered:${author}", 1) 36 | || $backend->set("author_answered:${author}", 1) 37 | || 1; 38 | my $ac = $correct ? $backend->incr("author_corrected:${author}", 1) 39 | || $backend->set("author_corrected:${author}", 1) 40 | || 1 41 | : $backend->get("author_corrected:${author}"); 42 | $backend->set( 43 | "author_percentage:${author}" => sprintf("%.1f", $ac / $aa * 100), 44 | ); 45 | } 46 | 47 | return { 48 | answered => $answered || 0, 49 | corrected => $corrected || 0, 50 | }; 51 | } 52 | 53 | sub get_result { 54 | my ($self, $key) = @_; 55 | 56 | $key = $key->name 57 | if blessed $key && $key->can("name"); 58 | 59 | my $result = $self->backend->get_multi("answered:${key}", "corrected:${key}"); 60 | return { 61 | answered => $result->{"answered:${key}"} || 0, 62 | corrected => $result->{"corrected:${key}"} || 0, 63 | }; 64 | } 65 | 66 | sub add_star { 67 | my ($self, $key) = @_; 68 | 69 | my $author; 70 | if ( blessed $key && $key->can("name") ) { 71 | $author = $key->author_name; 72 | $key = $key->name; 73 | } 74 | 75 | if ($author) { 76 | $self->backend->incr("author_star:${author}", 1) 77 | or $self->backend->set("author_star:${author}", 1); 78 | } 79 | 80 | $self->backend->incr("star:${key}", 1) 81 | or $self->backend->set("star:${key}", 1); 82 | 83 | } 84 | 85 | sub get_star { 86 | my ($self, $key) = @_; 87 | 88 | $key = $key->name 89 | if blessed $key && $key->can("name"); 90 | 91 | $self->backend->get("star:${key}") || 0; 92 | } 93 | 94 | sub get_authors_by_percentage { 95 | my $self = shift; 96 | 97 | my $code = $self->backend->can('get_authors_by_percentage'); 98 | $code ? $code->($self->backend, @_) 99 | : []; 100 | } 101 | 102 | sub get_authors_by_star { 103 | my $self = shift; 104 | 105 | my $code = $self->backend->can('get_authors_by_star'); 106 | $code ? $code->($self->backend, @_) 107 | : []; 108 | } 109 | 110 | sub get_icon { 111 | my $self = shift; 112 | my $q = shift; 113 | $self->backend->get("gravatar_uri:" . $q->name); 114 | } 115 | 116 | sub get_author_icon { 117 | my $self = shift; 118 | my $name = shift; 119 | $self->backend->get("author_gravatar_uri:" . $name); 120 | } 121 | 122 | sub get_author_uri { 123 | my $self = shift; 124 | my $name = shift; 125 | $self->backend->get("author_github_uri:" . $name); 126 | } 127 | 128 | sub set_icon { 129 | my $self = shift; 130 | my $q = shift; 131 | my $uri = shift; 132 | 133 | $self->backend->set("gravatar_uri:" . $q->name => $uri); 134 | $self->backend->set("author_gravatar_uri:" . $q->author_name => $uri); 135 | $self->backend->set("author_github_uri:" . $q->author_name => $q->author_uri); 136 | } 137 | 138 | sub set { 139 | my $self = shift; 140 | $self->backend->set(@_); 141 | } 142 | 143 | sub get { 144 | my $self = shift; 145 | $self->backend->get(@_); 146 | } 147 | 148 | 1; 149 | -------------------------------------------------------------------------------- /lib/Dojo/Model/Storage/DBI.pm: -------------------------------------------------------------------------------- 1 | package Dojo::Model::Storage::DBI; 2 | 3 | use strict; 4 | use warnings; 5 | use Any::Moose; 6 | use DBI; 7 | 8 | has connect_info => ( 9 | is => "rw", 10 | isa => "ArrayRef", 11 | ); 12 | 13 | has dbh => ( 14 | is => "rw", 15 | lazy => 1, 16 | default => sub { 17 | my $self = shift; 18 | DBI->connect( @{ $self->connect_info } ); 19 | }, 20 | ); 21 | 22 | sub incr { 23 | my $self = shift; 24 | my $id = shift; 25 | my $sth = $self->dbh->prepare("UPDATE data SET value = value + 1 WHERE id=?"); 26 | my $r = $sth->execute($id); 27 | return if $r == 0; 28 | $self->get($id); 29 | } 30 | 31 | sub get { 32 | my $self = shift; 33 | my $id = shift; 34 | my $sth = $self->dbh->prepare("SELECT value FROM data WHERE id=?"); 35 | $sth->execute($id); 36 | my $r = $sth->fetchrow_arrayref; 37 | return $r->[0] if $r; 38 | return; 39 | } 40 | 41 | sub set { 42 | my $self = shift; 43 | my ($id, $value) = @_; 44 | my $dbh = $self->dbh; 45 | 46 | $dbh->begin_work; 47 | my $sth = $dbh->prepare("UPDATE data SET value = ? WHERE id=?"); 48 | my $r = $sth->execute($value, $id); 49 | if ($r == 0) { 50 | $sth = $dbh->prepare("INSERT INTO data (id, value) VALUES (?, ?)"); 51 | $sth->execute($id, $value); 52 | } 53 | $value = $self->get($id); 54 | $dbh->commit; 55 | 56 | $value; 57 | } 58 | 59 | sub get_multi { 60 | my $self = shift; 61 | my @ids = @_; 62 | 63 | my $sth = $self->dbh->prepare( 64 | "SELECT id, value FROM data WHERE id IN(" . join(",", map {"?"} @ids) . ")" 65 | ); 66 | $sth->execute(@ids); 67 | my $result = {}; 68 | while (my $r = $sth->fetchrow_arrayref) { 69 | $result->{ $r->[0] } = $r->[1]; 70 | } 71 | $result; 72 | } 73 | 74 | sub get_authors_by_star { 75 | my $self = shift; 76 | my $limit = shift; 77 | 78 | $self->_get_authors_by( 79 | order => "value + 0 DESC, id", 80 | key => "author_star:%", 81 | limit => $limit, 82 | ); 83 | } 84 | 85 | sub get_authors_by_percentage { 86 | my $self = shift; 87 | my $limit = shift; 88 | 89 | $self->_get_authors_by( 90 | order => "value + 0, id", 91 | key => "author_percentage:%", 92 | limit => $limit, 93 | ); 94 | } 95 | 96 | sub _get_authors_by { 97 | my $self = shift; 98 | my %args = @_; 99 | 100 | my $sth = $self->dbh->prepare( 101 | "SELECT id, value FROM data WHERE id LIKE ? ORDER BY $args{order} LIMIT ?" 102 | ); 103 | $sth->execute($args{key}, $args{limit}); 104 | my @result; 105 | while ( my $r = $sth->fetchrow_arrayref ) { 106 | my (undef, $name) = split ":", $r->[0], 2; 107 | push @result, { 108 | name => $name, 109 | value => $r->[1], 110 | }; 111 | } 112 | return wantarray ? @result : \@result; 113 | } 114 | 115 | sub schema { 116 | my $class = shift; 117 | my $sql =< sub { 9 | my ($self) = @_; 10 | 11 | $self->ensure_class_loaded('Dojo::Model::Questions'); 12 | Dojo::Model::Questions->new; 13 | }; 14 | 15 | register AnswerSheet => sub { 16 | my ($self) = @_; 17 | 18 | $self->ensure_class_loaded('Dojo::Model::AnswerSheet'); 19 | Dojo::Model::AnswerSheet->new; 20 | }; 21 | 22 | 23 | register Storage => sub { 24 | my ($self) = @_; 25 | $self->ensure_class_loaded("Dojo::Model::Storage"); 26 | 27 | my $args = $self->get('conf')->{storage}->{backend}; 28 | croak "config.storage.backend required" unless $args; 29 | 30 | Dojo::Model::Storage->new( 31 | backend => $self->adaptor($args), 32 | ); 33 | }; 34 | 35 | 1; 36 | 37 | -------------------------------------------------------------------------------- /lib/Dojo/View/MT.pm: -------------------------------------------------------------------------------- 1 | package Dojo::View::MT; 2 | use Ark 'View::MT'; 3 | 4 | use Text::MicroTemplate (); 5 | 6 | has '+macro' => default => sub { 7 | return { 8 | encoded_string => sub { Text::MicroTemplate::encoded_string(@_) }, 9 | }; 10 | }; 11 | 12 | __PACKAGE__->meta->make_immutable; 13 | 14 | -------------------------------------------------------------------------------- /prod.psgi: -------------------------------------------------------------------------------- 1 | use lib 'lib'; 2 | use Dojo; 3 | 4 | my $app = Dojo->new; 5 | $app->setup; 6 | 7 | # preload models 8 | use Dojo::Models; 9 | Dojo::Models->instance->load_all; 10 | 11 | $app->handler; 12 | 13 | -------------------------------------------------------------------------------- /root/common/base.mt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | <? block title => '' ?>Perl道場 PerlエンジニアがつくるPerlエンジニアのための検定試験 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 28 | 41 | 42 | 43 | 44 | ? block content => sub {} 45 | 46 | 47 | -------------------------------------------------------------------------------- /root/css/common.css: -------------------------------------------------------------------------------- 1 | @charset "UTF-8"; 2 | 3 | /* 4 | ##### Perl dojo ##### 5 | Copyright (C) KAYAC Inc. All Rights Reserved. 6 | 7 | [Base] 8 | 0. Resetting default margin and padding 9 | 1. HTML, Body, Anchor 10 | 2. Heading, Paragraph 11 | 3. List 12 | 4. Table 13 | 5. Form 14 | 6. Other 15 | 7. For IE6/7 16 | 17 | [Layout] 18 | 0. Container 19 | 1. Header 20 | 2. Content 21 | 3. Footer 22 | 23 | [Module] 24 | 1. Common Module 25 | 2. ##### SPECIFIC MODULE NAME or SOMETHING ##### 26 | 90. Other 27 | 99. Clearfix 28 | */ 29 | 30 | /* ////////////////////////////////////////////////// 31 | [Base] 32 | ////////////////////////////////////////////////// */ 33 | 34 | /* -------------------------------------------------- 35 | 0. Resetting default margin and padding 36 | -------------------------------------------------- */ 37 | body, div, dl, dt, dd, ul, ol, li, h1, h2, h3, h4, h5, h6, pre, code, p, blockquote, th, td, form, fieldset, legend { 38 | margin: 0; 39 | padding: 0; 40 | } 41 | 42 | /* -------------------------------------------------- 43 | 1. HTML, Body, Anchor 44 | -------------------------------------------------- */ 45 | html { overflow-y: scroll; } /* for mozilla: always display scrollbar */ 46 | 47 | body { 48 | color: #000; 49 | font-family: "メイリオ", Meiryo, sans-serif; 50 | font-size: 13px; 51 | line-height: 1.5; 52 | *font-size: 82%; /* for ie6/7 */ 53 | } 54 | 55 | body.osMac { 56 | font-family: "Hiragino Kaku Gothic ProN","ヒラギノ角ゴ ProN W3",sans-serif; 57 | } 58 | 59 | body.osWin { 60 | font-family: "メイリオ", Meiryo, "ＭＳ Ｐゴシック", sans-serif; 61 | } 62 | 63 | /* 64 | Font-size list (base: 13px) 65 | 62% = 8px 66 | 70% = 9px 67 | 77% = 10px 68 | 85% = 11px 162% = 21px 239% = 31px 69 | 93% = 12px 170% = 22px 247% = 32px 70 | 100% = 13px 177% = 23px 254% = 33px 71 | 108% = 14px 185% = 24px 262% = 34px 72 | 116% = 15px 193% = 25px 270% = 35px 73 | 124% = 16px 200% = 26px 277% = 36px 74 | 131% = 17px 208% = 27px 285% = 37px 75 | 139% = 18px 216% = 28px 293% = 38px 76 | 147% = 19px 224% = 29px 300% = 39px 77 | 154% = 20px 231% = 30px 308% = 40px 78 | */ 79 | 80 | a:link { 81 | color: #330000; 82 | text-decoration: none; 83 | } 84 | a:visited { 85 | color: #330000; 86 | text-decoration: none; 87 | } 88 | a:hover, 89 | a:active { 90 | color: #330000; 91 | text-decoration: underline; 92 | } 93 | 94 | /* -------------------------------------------------- 95 | 2. Heading, Paragraph 96 | -------------------------------------------------- */ 97 | h1, h2, h3, h4, h5, h6 { 98 | font-size: 100%; 99 | line-height: 1.2; 100 | } 101 | /* p {} */ 102 | 103 | /* -------------------------------------------------- 104 | 3. List 105 | -------------------------------------------------- */ 106 | li { list-style: none; } 107 | 108 | /* -------------------------------------------------- 109 | 4. Table 110 | -------------------------------------------------- */ 111 | table { 112 | border-collapse: collapse; 113 | border-spacing: 0; 114 | font-size: 100%; 115 | font-family: inherit; 116 | } 117 | caption, th, td { 118 | text-align: left; 119 | vertical-align: top; 120 | font-weight: normal; 121 | } 122 | 123 | /* -------------------------------------------------- 124 | 5. Form 125 | -------------------------------------------------- */ 126 | fieldset { border: none; } 127 | 128 | input, textarea, select, label { 129 | margin-top: 0; 130 | margin-bottom: 0; 131 | padding-top: 0; 132 | padding-bottom: 0; 133 | font-size: 100%; 134 | font-family: inherit; 135 | vertical-align: middle; 136 | } 137 | label { cursor: pointer; } 138 | 139 | textarea { overflow: auto; } 140 | 141 | /* -------------------------------------------------- 142 | 6. Other 143 | -------------------------------------------------- */ 144 | img { 145 | border: none; 146 | vertical-align: bottom; 147 | } 148 | object { 149 | vertical-align: middle; 150 | outline: none; 151 | } 152 | em, strong { 153 | font-weight: bold; 154 | font-style: normal; 155 | } 156 | abbr, acronym { 157 | border: none; 158 | font-variant: normal; 159 | } 160 | q:before, q:after { content: ''; } 161 | 162 | address, caption, cite, code, dfn, var { 163 | font-weight: normal; 164 | font-style: normal; 165 | } 166 | code, pre { font-family: monospace; } 167 | 168 | sup { vertical-align: text-top; } 169 | sub { vertical-align: text-bottom; } 170 | 171 | hr { display: none; } 172 | 173 | /* ------------------------------------------------------------ 174 | 7. For IE6/7 175 | ------------------------------------------------------------ */ 176 | 177 | /* --- for ie7: page zoom bug fix --- */ 178 | *:first-child+html body, 179 | *:first-child+html br { letter-spacing: 0; } 180 | 181 | /* ////////////////////////////////////////////////// 182 | [Layout] 183 | ////////////////////////////////////////////////// */ 184 | 185 | /* -------------------------------------------------- 186 | 0. Container 187 | -------------------------------------------------- */ 188 | #container { 189 | width: 100%; 190 | margin: 0 auto; 191 | background: url(/img/backGround.gif); 192 | } 193 | 194 | #examContainer { 195 | width: 100%; 196 | margin: 0 auto; 197 | background: url(/img/backGround.gif); 198 | } 199 | 200 | /* -------------------------------------------------- 201 | 1. Header 202 | -------------------------------------------------- */ 203 | #header { 204 | height:572px; 205 | background-image:url(/img/backGroundBrack.gif); 206 | } 207 | 208 | #examHeader { 209 | width: 995px; 210 | margin: 0 auto; 211 | height: 130px; 212 | position: relative; 213 | left: -17px; 214 | z-index: 1; 215 | background: url(/img/exam/img_header_01.png) 0 0 no-repeat; 216 | } 217 | 218 | #examHeader h1 a { 219 | position: absolute; 220 | width: 150px; 221 | height: 40px; 222 | top: 25px; 223 | left: 55px; 224 | opacity: 0; 225 | } 226 | 227 | /* -------------------------------------------------- 228 | 2. Content 229 | -------------------------------------------------- */ 230 | #content { 231 | margin-top:45px; 232 | background-image:url(/img/ranking.png); 233 | background-repeat:no-repeat; 234 | width:960px; 235 | margin-left:auto; 236 | margin-right:auto; 237 | } 238 | 239 | .ranking { 240 | margin-top:85px; 241 | float: left; 242 | width: 450px; 243 | height:300px; 244 | } 245 | .rankingHeader{ 246 | padding-top:15px; 247 | padding-bottom:15px; 248 | padding-left:15px; 249 | background-color:#a09e8e; 250 | font-size: 14px; 251 | font-weight: normal; 252 | } 253 | 254 | .username{ 255 | padding-left:10px; 256 | } 257 | 258 | 259 | /* -------------------------------------------------- 260 | 3. Footer 261 | -------------------------------------------------- */ 262 | #footer { 263 | margin-top: 30px; 264 | padding-top:15px; 265 | padding-bottom:15px; 266 | background-color:#edecde; 267 | } 268 | 269 | /* kayacProject 270 | ----------------------------------- */ 271 | #kayacProject dt { 272 | float: left; 273 | width: 100px; 274 | } 275 | #kayacProject dd { 276 | margin-left: 110px; 277 | } 278 | #kayacProject li { 279 | float: left; 280 | margin: 0 1em 5px 0; 281 | white-space: nowrap; 282 | } 283 | 284 | /* copyright 285 | ----------------------------------- */ 286 | #footer .copyright { 287 | width:960px; 288 | text-align: right; 289 | font-size:11px; 290 | margin: 0 auto; 291 | } 292 | 293 | /* ////////////////////////////////////////////////// 294 | [Module] 295 | ////////////////////////////////////////////////// */ 296 | 297 | /* -------------------------------------------------- 298 | 1. Common Module 299 | -------------------------------------------------- */ 300 | 301 | .btnStyle1{ 302 | background: #211f18; 303 | border: 1px solid #000; 304 | box-shadow: 0 1px rgba(255,255,255,.7) inset; 305 | line-height: 35px; 306 | padding: 0 35px; 307 | min-width: 70px; 308 | display: inline-block; 309 | color: #fff !important; 310 | font-weight: bold; 311 | text-align: center; 312 | border-radius: 3px; 313 | text-shadow: 0 1px 0 #000; 314 | cursor: pointer; 315 | } 316 | 317 | .btnStyle1:hover{ 318 | background: #363129; 319 | text-decoration: none; 320 | } 321 | 322 | .btnStyle1.type2{ 323 | background: #7f2d01; 324 | border: 1px solid #883100; 325 | } 326 | 327 | .btnStyle1.type2:hover{ 328 | background: #913402; 329 | } 330 | 331 | .btnStyle1.type3{ 332 | background: #5e5220; 333 | border: 1px solid #615b39; 334 | } 335 | 336 | .btnStyle1.type3:hover{ 337 | background: #695e2f; 338 | } 339 | 340 | .headerBg{ 341 | height: 545px; 342 | background-image:url(/img/headerBackGround.gif); 343 | background-position:center; 344 | background-repeat:no-repeat; 345 | position: relative; 346 | padding-top: 55px; 347 | } 348 | 349 | 350 | #socialBtn{ 351 | position: absolute; 352 | top: 18px; 353 | right: 0; 354 | } 355 | 356 | #socialBtn li{ 357 | float: left; 358 | margin-left: 10px; 359 | } 360 | 361 | .title{ 362 | width:406px; 363 | margin-left:auto; 364 | margin-right:auto; 365 | text-align:center; 366 | background-image:url(/img/perl_test_title.gif); 367 | background-repeat:no-repeat; 368 | } 369 | 370 | .title p{ 371 | padding-top:110px; 372 | color:#FFF; 373 | text-align:center; 374 | line-height:23px; 375 | } 376 | 377 | .title img{ 378 | padding-top:60px; 379 | } 380 | 381 | .ranking p{ 382 | padding:4px; 383 | padding-left:55px; 384 | margin-bottom: 1px; 385 | background-color:#edecdc; 386 | } 387 | 388 | .entrybtn{ 389 | width:340px; 390 | margin-left:auto; 391 | margin-right:auto; 392 | text-align:center; 393 | } 394 | 395 | .entrybtn img{ 396 | width:340px; 397 | margin-left:auto; 398 | margin-right:auto; 399 | text-align:center; 400 | margin-top:20px; 401 | margin-bottom:20px; 402 | } 403 | 404 | .rank1{ 405 | background-image:url(/img/ranking_1.gif); 406 | background-repeat:no-repeat; 407 | background-position:3px 3px; 408 | line-height: 35px; 409 | } 410 | 411 | 412 | .rank2{ 413 | background-image:url(/img/ranking_2.gif); 414 | background-repeat:no-repeat; 415 | background-position:3px 3px; 416 | line-height: 35px; 417 | } 418 | 419 | .rank3{ 420 | background-image:url(/img/ranking_3.gif); 421 | background-repeat:no-repeat; 422 | background-position:3px 3px; 423 | line-height: 35px; 424 | } 425 | 426 | .rank4{ 427 | background-image:url(/img/ranking_4.gif); 428 | background-repeat:no-repeat; 429 | background-position:3px 3px; 430 | line-height: 35px; 431 | } 432 | 433 | .rank5{ 434 | background-image:url(/img/ranking_5.gif); 435 | background-repeat:no-repeat; 436 | background-position:3px 3px; 437 | line-height: 35px; 438 | } 439 | 440 | .right { 441 | margin-top:85px; 442 | float: right; 443 | width: 450px; 444 | height:300px; 445 | } 446 | 447 | .point{ 448 | float: right; 449 | padding-top: 5px; 450 | padding-left: 10px; 451 | padding-right:10px; 452 | font-size:18px; 453 | line-height: -5px; 454 | } 455 | 456 | .point .pt { 457 | padding-left:5px; 458 | padding-right:10px; 459 | font-size:14px; 460 | line-height: -5px; 461 | } 462 | 463 | .socialTool{ 464 | margin-bottom:30px; 465 | } 466 | 467 | .blockStream .twtr-hd { 468 | background: none repeat scroll 0 0 #FFFFFF !important; 469 | display: none; 470 | padding: 0 !important; 471 | } 472 | .blockStream .twtr-hd h3 { 473 | background: none repeat scroll 0 0 #FFFFFF !important; 474 | border-bottom: 1px solid #AAAAAA !important; 475 | color: #999999 !important; 476 | font-size: 20px !important; 477 | font-weight: bold !important; 478 | line-height: 1 !important; 479 | margin-bottom: 15px !important; 480 | padding: 0 0 5px !important; 481 | } 482 | .blockStream .twtr-bd { 483 | padding: 0 !important; 484 | } 485 | .blockStream .twtr-ft { 486 | display: none; 487 | } 488 | .blockStream .twtr-widget { 489 | font-family: Myriad,Helvetica,Arial,"Meiryo","メイリオ",sans-serif !important; 490 | font-size: 11px !important; 491 | } 492 | 493 | /* examContent 494 | ----------------------------------- */ 495 | .examContent{ 496 | width: 915px; 497 | margin: 0 auto 3px; 498 | background: #edecde; 499 | padding: 20px; 500 | } 501 | 502 | .examContent h2, 503 | .examContent .ttlStyle1{ 504 | font-size: 16px; 505 | color: #000; 506 | font-weight: bold; 507 | background: #e5e3d0; 508 | padding: 10px; 509 | line-height: 1; 510 | margin-bottom: 15px; 511 | } 512 | 513 | .examContent h3, 514 | .examContent .ttlStyle2{ 515 | font-size: 16px; 516 | color: #000; 517 | font-weight: bold; 518 | border-bottom: 1px solid #999370; 519 | padding: 10px; 520 | padding-top: 0; 521 | line-height: 1; 522 | margin-bottom: 15px; 523 | } 524 | 525 | .examContent h4, 526 | .examContent .ttlStyle3{ 527 | font-size: 16px; 528 | color: #000; 529 | font-weight: bold; 530 | padding: 0 10px; 531 | line-height: 1; 532 | margin-bottom: 15px; 533 | } 534 | 535 | .examContent h5, 536 | .examContent .ttlStyle4{ 537 | font-size: 14px; 538 | color: #000; 539 | font-weight: bold; 540 | padding: 0 10px; 541 | line-height: 1; 542 | margin-bottom: 15px; 543 | } 544 | 545 | .examContent ul{ 546 | padding: 0 15px; 547 | margin: 15px 0 10px; 548 | } 549 | 550 | .examContent ul li{ 551 | list-style: disc inside; 552 | margin-bottom: 5px; 553 | } 554 | 555 | .examContent ol{ 556 | padding: 0 15px; 557 | margin: 15px 0 10px; 558 | } 559 | 560 | .examContent ol li{ 561 | list-style: decimal inside; 562 | margin-bottom: 5px; 563 | } 564 | 565 | .examContent p{ 566 | color: #000; 567 | padding: 0 15px; 568 | margin-bottom: 15px; 569 | } 570 | 571 | .examContent p:lsat-child{ 572 | margin-bottom: 0; 573 | } 574 | 575 | .examContent strong{ 576 | color: #cc330a; 577 | } 578 | 579 | .examContent pre{ 580 | display: block; 581 | background: #e5e3d0; 582 | border: 1px solid #cecab9; 583 | border-radius: 3px; 584 | padding: 15px; 585 | font-family: "Courier New", Courier, monospace; 586 | line-height: 1.75; 587 | margin-bottom: 15px; 588 | } 589 | 590 | .examContent p code, 591 | .examContent p span.code{ 592 | padding: 0; 593 | border: none; 594 | display: inline-block; 595 | background: #e5e3d0; 596 | padding: 5px; 597 | border: 1px solid #cecab9; 598 | border-radius: 3px; 599 | margin: 0 5px; 600 | line-height: 1; 601 | } 602 | 603 | .examContent blockquote{ 604 | display: block; 605 | background: #e5e3d0; 606 | border-left: 1px solid #999370; 607 | padding: 15px; 608 | margin-bottom: 15px; 609 | } 610 | 611 | .examContent blockquote p{ 612 | padding: 0; 613 | } 614 | 615 | .examContent blockquote cite:before{ 616 | content: "--"; 617 | margin-right: 10px; 618 | } 619 | 620 | .examContent p.error{ 621 | background: #fff; 622 | border: 1px solid #cc330a; 623 | padding: 15px; 624 | font-weight: bold; 625 | color: #cc330a; 626 | } 627 | 628 | .examContent .listAnswers{ 629 | padding: 0; 630 | margin-bottom: 15px; 631 | } 632 | 633 | .examContent .listAnswers li{ 634 | list-style: none; 635 | } 636 | 637 | .examContent .listAnswers li span{ 638 | display: block; 639 | float: left; 640 | line-height: 24px; 641 | margin-right: 7px; 642 | font-weight: bold; 643 | background: #fff; 644 | width: 24px; 645 | text-align: center; 646 | border: 1px solid #d3d1be; 647 | border-radius: 4px; 648 | color: #72705e; 649 | } 650 | 651 | .examContent .listAnswers li label:hover span{ 652 | background: #a09e8e; 653 | color: #fff; 654 | } 655 | 656 | .examContent .listAnswers li label.selected span{ 657 | background: #a09e8e; 658 | color: #fff; 659 | box-shadow: 2px 2px 0 #73715f inset; 660 | } 661 | 662 | .examContent .listAnswers li div{ 663 | line-height: 2; 664 | margin-left: 35px; 665 | } 666 | 667 | .examContent .listAnswers li p{ 668 | padding-right: 0; 669 | padding-left: 0; 670 | } 671 | 672 | .examContent .boxAnswer{ 673 | margin: 30px 0; 674 | } 675 | 676 | .examContent .boxAnswer .btnAnswer{ 677 | float: left; 678 | } 679 | 680 | .examContent .boxAnswer .counter{ 681 | float: right; 682 | background: #d3d1be; 683 | border: 1px solid #a09e8e; 684 | border-radius: 4px; 685 | font-size: 14px; 686 | padding: 15px 30px; 687 | line-height: 1; 688 | } 689 | 690 | .examContent .boxAnswer .counter span{ 691 | font-size: 24px; 692 | font-weight: normal; 693 | margin-right: 5px; 694 | } 695 | 696 | .examContent .boxAnswer .counter strong{ 697 | font-weight: normal; 698 | } 699 | 700 | .examContent .blockResult{ 701 | border: 1px solid #a09e8e; 702 | padding: 0 15px; 703 | position: relative; 704 | z-index: 1; 705 | } 706 | 707 | .examContent .blockResult .hr1{ 708 | position: absolute; 709 | top: -7px; 710 | left: -3px; 711 | z-index: 1; 712 | padding: 0; 713 | margin: 0; 714 | } 715 | 716 | .examContent .blockResult .hr2{ 717 | position: absolute; 718 | bottom: -7px; 719 | left: 2px; 720 | z-index: 1; 721 | padding: 0; 722 | margin: 0; 723 | } 724 | 725 | .examContent .blockResultHeader{ 726 | position: relative; 727 | font-weight: bold; 728 | z-index:1; 729 | text-align: center; 730 | border-bottom: 1px solid #a09e8e; 731 | font-size: 16px; 732 | padding: 25px 0; 733 | } 734 | 735 | .examContent .blockResultHeader p{ 736 | margin-bottom: 0; 737 | } 738 | 739 | .examContent .blockResultHeader .score{ 740 | font-size: 46px; 741 | line-height: 1; 742 | margin-top: 10px; 743 | } 744 | 745 | .examContent .blockResultHeader .score .unit{ 746 | font-size: 16px; 747 | } 748 | 749 | .examContent .blockResultHeader .rank{ 750 | position: absolute; 751 | top: 5px; 752 | right: 150px; 753 | z-index: 1; 754 | } 755 | 756 | .examContent .blockResultComment{ 757 | margin: 15px 0; 758 | line-height: 1.75; 759 | } 760 | 761 | .examContent .blockResultList{ 762 | } 763 | 764 | .examContent .blockResultList ul{ 765 | padding: 0; 766 | } 767 | 768 | .examContent .blockResultList li{ 769 | list-style: none; 770 | width: 410px; 771 | float: left; 772 | line-height: 50px; 773 | background: #cec9b7; 774 | margin-bottom: 0; 775 | margin-right: 1px; 776 | padding: 0 15px; 777 | } 778 | 779 | .examContent .blockResultList li:nth-child(3), 780 | .examContent .blockResultList li:nth-child(4), 781 | .examContent .blockResultList li:nth-child(7), 782 | .examContent .blockResultList li:nth-child(8){ 783 | background: none; 784 | } 785 | 786 | .examContent .blockResultList li p{ 787 | margin: 0; 788 | padding: 0; 789 | float: left; 790 | } 791 | 792 | .examContent .blockResultList li .number{ 793 | font-size: 16px; 794 | font-weight: bold; 795 | margin-right: 15px; 796 | } 797 | 798 | .examContent .blockResultList li .judge{ 799 | font-size: 16px; 800 | font-weight: bold; 801 | margin-right: 15px; 802 | color: #b23f00; 803 | } 804 | 805 | .examContent .blockResultList li .question{ 806 | font-size: 10px; 807 | } 808 | 809 | .examContent .blockResultList li .author{ 810 | float: right; 811 | padding-right: 15px; 812 | } 813 | 814 | .examContent .blockResultList li .author img{ 815 | vertical-align: middle; 816 | position: relative; 817 | z-index: 1; 818 | top: -1px; 819 | margin: 0 3px; 820 | } 821 | 822 | .examContent .blockResultList .tweet{ 823 | text-align: center; 824 | margin: 30px 0; 825 | } 826 | 827 | .blockAction{ 828 | width: 935px; 829 | margin: 30px auto; 830 | background: url(/img/exam/bg_01.png) 50% 0 repeat-y #edecde; 831 | border: 10px solid #a09e8e; 832 | padding: 15px 0 25px; 833 | } 834 | 835 | .blockAction div{ 836 | width: 467px; 837 | float: left; 838 | text-align: center; 839 | } 840 | 841 | .blockAction .lead{ 842 | margin-bottom: 20px; 843 | } 844 | 845 | .blockAction .btnStyle1{ 846 | min-width: 180px; 847 | } 848 | 849 | .blockJudge{ 850 | text-align: center; 851 | font-weight: bold; 852 | font-size: 16px; 853 | } 854 | 855 | .blockQuestionInformation{ 856 | border: 1px solid #a09e8e; 857 | padding: 20px; 858 | margin-bottom: 30px; 859 | } 860 | 861 | .blockQuestionInformation table{ 862 | width: 100%; 863 | } 864 | 865 | .blockQuestionInformation th{ 866 | width: 105px; 867 | font-weight: bold; 868 | padding: 0 0 5px; 869 | } 870 | 871 | .blockQuestionInformation td{ 872 | padding: 0 0 5px; 873 | } 874 | 875 | .blockQuestionInformation .percent{ 876 | display: inline-block; 877 | padding: 0; 878 | height: 13px; 879 | width: 200px; 880 | background: #d3d1be; 881 | position: relative; 882 | z-index: 1; 883 | margin-right: 10px; 884 | top: 3px; 885 | } 886 | 887 | .blockQuestionInformation .percent img{ 888 | position: absolute; 889 | top: 0; 890 | left: 0; 891 | z-index: 1; 892 | } 893 | 894 | .blockQuestionInformation .btnPlus{ 895 | margin-right: 5px; 896 | cursor: pointer; 897 | } 898 | 899 | .blockQuestionInformation .author{ 900 | padding: 0; 901 | margin-top: 10px; 902 | margin-bottom: 0; 903 | } 904 | 905 | .blockQuestionInformation .author img{ 906 | vertical-align: middle; 907 | margin-right: 10px; 908 | } 909 | 910 | /* -------------------------------------------------- 911 | 90. Other 912 | -------------------------------------------------- */ 913 | .btn { cursor: pointer; } 914 | 915 | /* for Voice Browser */ 916 | .hidden { 917 | position: absolute; 918 | width: 0; 919 | height: 0; 920 | overflow: hidden; 921 | margin: 0; 922 | padding: 0; 923 | opacity: 0; 924 | } 925 | 926 | /* Noscript Message */ 927 | #msgNoscript { 928 | display: block; 929 | position: absolute; 930 | top: 0; 931 | left: 0; 932 | z-index: 9999; 933 | width: 100%; 934 | padding: 5px 0; 935 | border-top: 1px solid #f00; 936 | border-bottom: 1px solid #f00; 937 | background: #fcc; 938 | color: #f00; 939 | line-height: 1.2; 940 | text-align: center; 941 | opacity: 0.7; 942 | } 943 | 944 | /* -------------------------------------------------- 945 | 99. Clearfix 946 | -------------------------------------------------- */ 947 | .group { *zoom: 1; } /* for ie6/7 */ 948 | .group:after { content: ""; display: block; clear: both; } 949 | -------------------------------------------------------------------------------- /root/css/smartphone.css: -------------------------------------------------------------------------------- 1 | body { 2 | font-size: 400%; 3 | } 4 | 5 | form { 6 | font-size: 400%; 7 | } 8 | 9 | form code { 10 | font-size: 50%; 11 | } 12 | -------------------------------------------------------------------------------- /root/css/style.css: -------------------------------------------------------------------------------- 1 | .container .page-header h1 { 2 | padding-top: 1em; 3 | } 4 | 5 | .container .inputs-list li { 6 | margin-bottom: 0.6em; 7 | } 8 | 9 | .container form button { 10 | margin-top: 1em; 11 | } -------------------------------------------------------------------------------- /root/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/favicon.ico -------------------------------------------------------------------------------- /root/img/backGround.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/backGround.gif -------------------------------------------------------------------------------- /root/img/backGroundBrack.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/backGroundBrack.gif -------------------------------------------------------------------------------- /root/img/btn_entry_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/btn_entry_01.png -------------------------------------------------------------------------------- /root/img/btn_entry_01_o.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/btn_entry_01_o.png -------------------------------------------------------------------------------- /root/img/btn_entry_02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/btn_entry_02.png -------------------------------------------------------------------------------- /root/img/btn_entry_02_o.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/btn_entry_02_o.gif -------------------------------------------------------------------------------- /root/img/common/blank.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/common/blank.gif -------------------------------------------------------------------------------- /root/img/common/ico_arrow_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/common/ico_arrow_01.png -------------------------------------------------------------------------------- /root/img/common/ico_bullet_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/common/ico_bullet_01.png -------------------------------------------------------------------------------- /root/img/common/ico_exwin.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/common/ico_exwin.png -------------------------------------------------------------------------------- /root/img/exam/bg_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/bg_01.png -------------------------------------------------------------------------------- /root/img/exam/btn_plus_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/btn_plus_01.png -------------------------------------------------------------------------------- /root/img/exam/ico_plus_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/ico_plus_01.png -------------------------------------------------------------------------------- /root/img/exam/img_correct_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_correct_01.png -------------------------------------------------------------------------------- /root/img/exam/img_header_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_header_01.png -------------------------------------------------------------------------------- /root/img/exam/img_hr_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_hr_01.png -------------------------------------------------------------------------------- /root/img/exam/img_hr_02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_hr_02.png -------------------------------------------------------------------------------- /root/img/exam/img_incorrect_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_incorrect_01.png -------------------------------------------------------------------------------- /root/img/exam/img_meter.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_meter.png -------------------------------------------------------------------------------- /root/img/exam/img_rank_01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_rank_01.png -------------------------------------------------------------------------------- /root/img/exam/img_rank_02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_rank_02.png -------------------------------------------------------------------------------- /root/img/exam/img_rank_03.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_rank_03.png -------------------------------------------------------------------------------- /root/img/exam/img_rank_04.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_rank_04.png -------------------------------------------------------------------------------- /root/img/exam/img_rank_05.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/exam/img_rank_05.png -------------------------------------------------------------------------------- /root/img/headerBackGround.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/headerBackGround.gif -------------------------------------------------------------------------------- /root/img/perl_test_title.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/perl_test_title.gif -------------------------------------------------------------------------------- /root/img/ranking.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/ranking.png -------------------------------------------------------------------------------- /root/img/ranking_1.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/ranking_1.gif -------------------------------------------------------------------------------- /root/img/ranking_2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/ranking_2.gif -------------------------------------------------------------------------------- /root/img/ranking_3.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/ranking_3.gif -------------------------------------------------------------------------------- /root/img/ranking_4.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/ranking_4.gif -------------------------------------------------------------------------------- /root/img/ranking_5.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/ranking_5.gif -------------------------------------------------------------------------------- /root/img/userIcon.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/typester/perldojo/6a41504f4dc96922163cbad7cac084e5fb3fb780/root/img/userIcon.jpg -------------------------------------------------------------------------------- /root/index.mt: -------------------------------------------------------------------------------- 1 | ? extends 'common/base'; 2 | ? my $storage = $c->stash->{storage}; 3 | 4 | ? block content => sub { 5 |
    6 | 7 | 8 | 37 | 38 | 39 | 40 |
    41 | 42 | 43 |
    44 |

    良問出題ランキング

    45 | ? my $n = 0; 46 | ? for my $author (@{ $c->stash->{by_s} }) { 47 | ? $n++; 48 |

    {name} ?>{value} ?>pt

    49 | ? } 50 |
    51 | 52 | 53 | 54 |
    55 |

    難問出題ランキング

    56 | ? $n = 0; 57 | ? for my $author (@{ $c->stash->{by_p} }) { 58 | ? $n++; 59 |

    {name} ?>{value} ?>pt

    60 | ? } 61 |
    62 | 63 | 64 |

    65 | 66 |
    67 |
    68 | 69 | 102 |
    103 |
    104 | 105 | 106 |
    107 |
    108 | 116 | 117 |
    118 |
    119 | 120 |
    121 | 122 | 123 | 124 | 128 | 129 | 130 |
    131 | ? } 132 | 133 | -------------------------------------------------------------------------------- /root/js/lib/DD_belatedPNG.js: -------------------------------------------------------------------------------- 1 | /** 2 | * DD_belatedPNG: Adds IE6 support: PNG images for CSS background-image and HTML . 3 | * Author: Drew Diller 4 | * Email: drew.diller@gmail.com 5 | * URL: http://www.dillerdesign.com/experiment/DD_belatedPNG/ 6 | * Version: 0.0.8a 7 | * Licensed under the MIT License: http://dillerdesign.com/experiment/DD_belatedPNG/#license 8 | * 9 | * Example usage: 10 | * DD_belatedPNG.fix('.png_bg'); // argument is a CSS selector 11 | * DD_belatedPNG.fixPng( someNode ); // argument is an HTMLDomElement 12 | **/ 13 | var DD_belatedPNG={ns:"DD_belatedPNG",imgSize:{},delay:10,nodesFixed:0,createVmlNameSpace:function(){if(document.namespaces&&!document.namespaces[this.ns]){document.namespaces.add(this.ns,"urn:schemas-microsoft-com:vml")}},createVmlStyleSheet:function(){var b,a;b=document.createElement("style");b.setAttribute("media","screen");document.documentElement.firstChild.insertBefore(b,document.documentElement.firstChild.firstChild);if(b.styleSheet){b=b.styleSheet;b.addRule(this.ns+"\\:*","{behavior:url(#default#VML)}");b.addRule(this.ns+"\\:shape","position:absolute;");b.addRule("img."+this.ns+"_sizeFinder","behavior:none; border:none; position:absolute; z-index:-1; top:-10000px; visibility:hidden;");this.screenStyleSheet=b;a=document.createElement("style");a.setAttribute("media","print");document.documentElement.firstChild.insertBefore(a,document.documentElement.firstChild.firstChild);a=a.styleSheet;a.addRule(this.ns+"\\:*","{display: none !important;}");a.addRule("img."+this.ns+"_sizeFinder","{display: none !important;}")}},readPropertyChange:function(){var b,c,a;b=event.srcElement;if(!b.vmlInitiated){return}if(event.propertyName.search("background")!=-1||event.propertyName.search("border")!=-1){DD_belatedPNG.applyVML(b)}if(event.propertyName=="style.display"){c=(b.currentStyle.display=="none")?"none":"block";for(a in b.vml){if(b.vml.hasOwnProperty(a)){b.vml[a].shape.style.display=c}}}if(event.propertyName.search("filter")!=-1){DD_belatedPNG.vmlOpacity(b)}},vmlOpacity:function(b){if(b.currentStyle.filter.search("lpha")!=-1){var a=b.currentStyle.filter;a=parseInt(a.substring(a.lastIndexOf("=")+1,a.lastIndexOf(")")),10)/100;b.vml.color.shape.style.filter=b.currentStyle.filter;b.vml.image.fill.opacity=a}},handlePseudoHover:function(a){setTimeout(function(){DD_belatedPNG.applyVML(a)},1)},fix:function(a){if(this.screenStyleSheet){var c,b;c=a.split(",");for(b=0;bn.H){i.B=n.H}d.vml.image.shape.style.clip="rect("+i.T+"px "+(i.R+a)+"px "+i.B+"px "+(i.L+a)+"px)"}else{d.vml.image.shape.style.clip="rect("+f.T+"px "+f.R+"px "+f.B+"px "+f.L+"px)"}},figurePercentage:function(d,c,f,a){var b,e;e=true;b=(f=="X");switch(a){case"left":case"top":d[f]=0;break;case"center":d[f]=0.5;break;case"right":case"bottom":d[f]=1;break;default:if(a.search("%")!=-1){d[f]=parseInt(a,10)/100}else{e=false}}d[f]=Math.ceil(e?((c[b?"W":"H"]*d[f])-(c[b?"w":"h"]*d[f])):parseInt(a,10));if(d[f]%2===0){d[f]++}return d[f]},fixPng:function(c){c.style.behavior="none";var g,b,f,a,d;if(c.nodeName=="BODY"||c.nodeName=="TD"||c.nodeName=="TR"){return}c.isImg=false;if(c.nodeName=="IMG"){if(c.src.toLowerCase().search(/\.png$/)!=-1){c.isImg=true;c.style.visibility="hidden"}else{return}}else{if(c.currentStyle.backgroundImage.toLowerCase().search(".png")==-1){return}}g=DD_belatedPNG;c.vml={color:{},image:{}};b={shape:{},fill:{}};for(a in c.vml){if(c.vml.hasOwnProperty(a)){for(d in b){if(b.hasOwnProperty(d)){f=g.ns+":"+d;c.vml[a][d]=document.createElement(f)}}c.vml[a].shape.stroked=false;c.vml[a].shape.appendChild(c.vml[a].fill);c.parentNode.insertBefore(c.vml[a].shape,c)}}c.vml.image.shape.fillcolor="none";c.vml.image.fill.type="tile";c.vml.color.fill.on=false;g.attachHandlers(c);g.giveLayout(c);g.giveLayout(c.offsetParent);c.vmlInitiated=true;g.applyVML(c)}};try{document.execCommand("BackgroundImageCache",false,true)}catch(r){}DD_belatedPNG.createVmlNameSpace();DD_belatedPNG.createVmlStyleSheet(); -------------------------------------------------------------------------------- /root/js/lib/meca.js: -------------------------------------------------------------------------------- 1 | (function() { 2 | 3 | $.fn.meca = function(action, conf) { 4 | return this.each(function() { 5 | funcs[action].call(this, conf); 6 | }); 7 | }; 8 | 9 | var is_msie6 = ($.browser.msie && $.browser.version < 7); 10 | 11 | var filterStyle = function(src, sizing) { 12 | var dx = 'DXImageTransform.Microsoft.AlphaImageLoader'; 13 | return 'progid:' + dx + '(src="' + src + '",sizingMethod=' + sizing +')'; 14 | }; 15 | 16 | var funcs = { 17 | hover: function(conf) { 18 | var $elem = $(this); 19 | var conf = $.extend({ postfix: '_o' }, conf); 20 | 21 | var src = $elem.attr('src'); 22 | if (!src) return; 23 | 24 | var src_o = src.replace(/\.\w+$/, conf.postfix + '$&'); 25 | var img = new Image(); 26 | img.src = src_o; 27 | 28 | $elem.hover( 29 | function() { this.src = src_o; }, 30 | function() { this.src = src; } 31 | ); 32 | }, 33 | 34 | external: function() { 35 | $(this).attr('target', '_blank'); 36 | }, 37 | 38 | pngfix: function(conf) { 39 | if (!is_msie6) return; 40 | 41 | var $elem = $(this); 42 | var conf = $.extend({ 43 | hoverSelector: '.btn', 44 | hoverPostfix: '_o', 45 | blankGif: false, 46 | wrapSpanClass: 'imgpngWrapSpan' 47 | }, conf); 48 | 49 | var css = { 50 | 'filter': filterStyle($elem.attr('src'), 'crop'), 51 | 'width': $elem.width(), 52 | 'height': $elem.height(), 53 | 'zoom': '1' 54 | }; 55 | 56 | var apply = function($elem) { 57 | if (conf.blankGif) { 58 | $elem.css(css).attr('src', conf.blankGif); 59 | return $elem; 60 | } 61 | else { 62 | var wrapSpan = $('').addClass(conf.wrapSpanClass).css(css); 63 | $elem.css('visibility', 'hidden').wrap(wrapSpan); 64 | return $elem.parent(); 65 | } 66 | }; 67 | 68 | if ( $elem.is(conf.hoverSelector) ) { 69 | var src = $elem.attr('src'); 70 | var src_o = src.replace(/\.\w+$/, conf.hoverPostfix + '$&'); 71 | var img = new Image(); 72 | img.src = src_o; 73 | 74 | apply($elem).hover( 75 | function() { $(this).css('filter', filterStyle(src_o, 'proc')) }, 76 | function() { $(this).css('filter', filterStyle(src, 'proc')) } 77 | ); 78 | } 79 | else { 80 | apply($elem); 81 | } 82 | }, 83 | 84 | bgpngfix: function() { 85 | if (!is_msie6) return; 86 | 87 | var $elem = $(this); 88 | 89 | var filter = filterStyle( 90 | $elem.css('backgroundImage').slice(5,-2), 91 | ($elem.css('backgroundRepeat') === 'no-repeat') ? 'crop' : 'scale' 92 | ); 93 | 94 | $elem.css({ 95 | 'filter': filter, 96 | 'background-image': 'none', 97 | 'zoom': '1' 98 | }); 99 | }, 100 | 101 | heightAlign: function() { 102 | var maxHeight = 0; 103 | $(this).find('> *').each(function() { 104 | var height = $(this).height(); 105 | if (maxHeight < height) { 106 | maxHeight = height; 107 | } 108 | }).height(maxHeight); 109 | }, 110 | 111 | positionFixed: function() { 112 | if (!is_msie6) return; 113 | 114 | var elem = this; 115 | var $elem = $(elem); 116 | 117 | var baseTop = parseInt($elem.css('top')) || 0; 118 | var baseLeft = parseInt($elem.css('left')) || 0; 119 | 120 | $elem.css({ 121 | position: 'absolute', 122 | top: $(document).scrollTop() + baseTop, 123 | left: $(document).scrollLeft() + baseLeft 124 | }) 125 | .parents().each(function() { 126 | if ($(this).css('position') == 'relative') { 127 | $(this).after($elem); 128 | } 129 | }) 130 | ; 131 | 132 | $('html').css({ 133 | 'background-image': 'url(null)', 134 | 'background-attachment': 'fixed' 135 | }); 136 | 137 | elem['topVal'] = baseTop; 138 | elem.style.setExpression('top', 'documentElement.scrollTop + this.topVal + "px"'); 139 | }, 140 | 141 | smoothScroll: function(conf) { 142 | var conf = $.extend({ 143 | noAddHashList: ['#top'] 144 | }, conf); 145 | 146 | var noAddHashList = conf.noAddHashList || []; 147 | 148 | $(this).click(function() { 149 | var $elem = $(this); 150 | 151 | var target_id = $elem.attr('href'); 152 | try { 153 | var $target = $(target_id); 154 | if (!$target.length) return; 155 | } 156 | catch(e) { 157 | return; 158 | } 159 | 160 | $('html, body').animate( 161 | { scrollTop: $target.offset().top }, 162 | 'normal', 163 | 'swing', 164 | function() { 165 | if ($.inArray(target_id, noAddHashList) == -1) { 166 | location.hash = target_id; 167 | } 168 | } 169 | ); 170 | return false; 171 | }); 172 | }, 173 | 174 | addOsClass: function(conf) { 175 | var $elem = $(this); 176 | var conf = $.extend({ 177 | winClass: 'osWin', 178 | macClass: 'osMac' 179 | }, conf); 180 | 181 | var ua = navigator.userAgent.toLowerCase(); 182 | if (/windows/.test(ua)) { 183 | $elem.addClass(conf.winClass); 184 | } 185 | else if (/mac os x/.test(ua)) { 186 | $elem.addClass(conf.macClass); 187 | } 188 | }, 189 | 190 | labelClickable: function() { 191 | if(!$.browser.msie) return; 192 | 193 | $(this).click(function() { 194 | $('#' + $(this).parents('label').attr('for')).focus().click(); 195 | }); 196 | }, 197 | 198 | active: function(conf) { 199 | var $elem = $(this); 200 | var conf = $.extend({ 201 | postfix: '_a', 202 | hoverSelector: '.btn', 203 | hoverPostfix: '_o' 204 | }, conf); 205 | 206 | if (!$elem.attr('src')) return; 207 | 208 | var src = this.src; 209 | var src_a = this.src.replace(/\.\w+$/, conf.postfix + '$&'); 210 | var src_base = src; 211 | if (conf.hoverSelector && $elem.is(conf.hoverSelector)) { 212 | src_base = src.replace(/\.\w+$/, conf.hoverPostfix + '$&'); 213 | } 214 | 215 | var img = new Image(); 216 | img.src = src_a; 217 | 218 | $elem.mousedown(function() { this.src = src_a; }); 219 | $elem.mouseup(function() { this.src = src_base }); 220 | }, 221 | 222 | placeholder: function(conf) { 223 | var $elem = $(this); 224 | var conf = $.extend({ 225 | placeholderClass: 'hasPlaceholder', 226 | target_attr: 'placeholder' 227 | }, conf); 228 | 229 | var placeholder = $(this).attr(conf.target_attr); 230 | 231 | if ($elem.val() == '' || $elem.val() == placeholder) { 232 | $elem.val(placeholder).addClass(conf.placeholderClass); 233 | } 234 | 235 | $elem 236 | .focus(function() { 237 | if ( $elem.val() == placeholder ) { 238 | $elem.val('').removeClass(conf.placeholderClass) 239 | } 240 | }) 241 | .blur(function() { 242 | if ( $elem.val() == '' ) { 243 | $elem.val(placeholder).addClass(conf.placeholderClass); 244 | } 245 | }) 246 | .parents('form').bind('submit', function() { 247 | if ($elem.val() == placeholder) { 248 | $elem.val('') 249 | } 250 | }); 251 | ; 252 | } 253 | }; 254 | 255 | })(); 256 | -------------------------------------------------------------------------------- /root/js/lib/sisso.js: -------------------------------------------------------------------------------- 1 | /** 2 | * sisso.js - 質素なWeb制作のためのJS 3 | * 4 | * Copyright (C) KAYAC Inc. | http://www.kayac.com/ 5 | * Dual licensed under the MIT 6 | * and GPL licenses. 7 | * Date: 2009-08-21 8 | * @author kyo_ago 9 | * @version 1.1.6 10 | * 11 | * thanks from 12 | * http://www.isella.com/aod2/js/iepngfix.js 13 | * http://jquery.com/ 14 | * http://kyosuke.jp/portfolio/javascript/yuga.html 15 | * http://webtech-walker.com/archive/2008/11/02151611.html 16 | * http://code.google.com/p/uupaa-js/source/browse/trunk/src/ieboost.js 17 | */ 18 | ;new function () { 19 | var name_space = 'Sisso'; 20 | var self = window[name_space] || {}; 21 | window[name_space] = self; 22 | if (window[name_space].is_loaded) return; 23 | window[name_space].is_loaded = true; 24 | 25 | var Event, $ = window.jQuery; 26 | if (!window.jQuery) { 27 | load_lib(); 28 | $ = function () {}; 29 | $.data = function () {}; 30 | $.removeData = function () {}; 31 | self.Event = Event; 32 | }; 33 | 34 | var $d = document; 35 | 36 | new function () { 37 | var scp = $d.getElementsByTagName('script'); 38 | var reg = new RegExp(name_space + '\\.js'); 39 | var i = scp.length; 40 | while (i--) { 41 | if (!reg.test(scp[i].src.toLowerCase())) continue; 42 | var sp = scp[i].src.split('#'); 43 | if (sp.length === 1) return; 44 | var pair = sp.pop().split(/[&;]+/); 45 | var j = pair.length; 46 | while (j--) { 47 | var k_v = pair[j].split('='); 48 | if (self[k_v[0]] === undefined) self[k_v[0]] = k_v[1]; 49 | } 50 | return; 51 | } 52 | }; 53 | 54 | self.blankUrl = self.blankUrl || '/img/common/blank.gif'; 55 | self.rollClass = self.rollClass || 'btn'; 56 | self.rollSetClass = self.rollSetClass || 'btnSet'; 57 | self.externalClass = self.externalClass || 'external'; 58 | self.wordBreakClass = self.wordBreakClass || 'wordBreak'; 59 | self.pngFixSelector = self.pngFixSelector || '.pngfix'; 60 | self.pngFixVersion = self.pngFixVersion || '6,7'; 61 | self.noRoll = self.noRoll || false; 62 | self.noRollSet = self.noRoll || false; 63 | self.noPngFix = self.noPngFix || false; 64 | self.noExternal = self.noExternal || false; 65 | self.noBreakAll = self.noBreakAll || false; 66 | self.noGMap2Error = self.noGMap2Error || false; 67 | 68 | self.get_elems = (function () { 69 | if ($d.getElementsByClassName) return function (cname) { 70 | return $d.getElementsByClassName(cname); 71 | } 72 | if ($d.querySelectorAll) return function (cname) { 73 | return $d.querySelectorAll('*.' + cname); 74 | } 75 | if ($d.evaluate) return function (cname) { 76 | var elems = $d.evaluate("descendant::*[@class=" + cname + " or contains(concat(' ', @class, ' '), ' " + cname + " ')]", $d, null, 7, null); 77 | var result = []; 78 | for (var i = 0, l = elems.snapshotLength; i < l; result.push(elems.snapshotItem(i++))); 79 | return result; 80 | } 81 | return function (cname) { 82 | var reg = new RegExp('(?:^|[ \\n\\r\\t])' + cname + '(?:[ \\n\\r\\t]|$)'); 83 | var elems = $d.body.getElementsByTagName('*'); 84 | var result = []; 85 | for (var i = 0, l = elems.length; i < l; ++i) { 86 | var elem = elems[i]; 87 | if (elem.className.indexOf(cname) === -1) continue; 88 | if (!reg.test(elem.className)) continue; 89 | result.push(elem); 90 | } 91 | return result; 92 | }; 93 | })(); 94 | 95 | self.get_src = function (elem) { 96 | if (elem.src) return elem.src; 97 | try { 98 | var src = (elem.currentStyle || $d.defaultView.getComputedStyle(elem, '')).backgroundImage; 99 | return (src.match(/^url\((["']?)(.*\.png).*?\1\)/i) || [undefined]).pop(); 100 | } catch (e) {} 101 | }; 102 | 103 | self.replace_over = function (src) { 104 | return src.replace(/(?:_o)?(\.\w+)$/, '_o$1'); 105 | }; 106 | 107 | self.hoverSet = function (elem) { 108 | var imgs = elem.getElementsByTagName('img'); 109 | var length = imgs.length; 110 | var cache = {}; 111 | for (var i = 0; i < length; ++i) { 112 | var img = imgs[i]; 113 | var src = self.get_src(img); 114 | if (!src) continue; 115 | var over = self.replace_over(src); 116 | (new Image).src = over; 117 | cache[src] = over; 118 | cache[over] = src; 119 | }; 120 | self.bind(elem, 'mouseover', function () { 121 | for (var i = 0, l = length; i < l; ++i) { 122 | var img = imgs[i]; 123 | var src = self.get_src(img); 124 | if (!src) continue; 125 | if (cache[src]) img.src = cache[src]; 126 | } 127 | }); 128 | self.bind(elem, 'mouseout', function () { 129 | for (var i = 0, l = length; i < l; ++i) { 130 | var img = imgs[i]; 131 | var src = self.get_src(img); 132 | if (!src) continue; 133 | if (cache[src]) img.src = cache[src]; 134 | } 135 | }); 136 | }; 137 | 138 | self.hover = function (elem) { 139 | var src = self.get_src(elem); 140 | if (!src) return; 141 | src = src.replace(/(?:_o)?(\.\w+)$/, '$1'); 142 | var over = self.replace_over(src); 143 | return elem.src ? self.add_src_over(elem, src, over) : self.add_bg_over(elem, src, over); 144 | }; 145 | 146 | new function () { 147 | self.bind = window.jQuery ? _jq : window.addEventListener ? _add : _on; 148 | 149 | function _jq (target, type, listener) { 150 | $(target).bind(type + '.' + name_space, listener); 151 | }; 152 | function _add (target, type, listener) { 153 | target.addEventListener(type, listener, false); 154 | }; 155 | function _on (target, type, listener) { 156 | target.attachEvent('on' + type, listener); 157 | }; 158 | }; 159 | 160 | self.add_over = function (elem, src, over, mouseover, mouseout) { 161 | (new Image).src = over; 162 | self.bind(elem, 'mouseover', mouseover(elem)); 163 | self.bind(elem, 'mouseout', mouseout(elem)); 164 | }; 165 | 166 | self.add_src_over = function (elem, src, over) { 167 | self.add_over(elem, src, over, function (target) { 168 | return function () { 169 | target.src = over; 170 | }; 171 | }, function (target) { 172 | return function () { 173 | target.src = src; 174 | }; 175 | }); 176 | }; 177 | 178 | self.add_bg_over = function (elem, src, over) { 179 | self.add_over(elem, src, over, function (target) { 180 | var st = target.style; 181 | over = 'url(' + over + ')'; 182 | return function () { 183 | st.backgroundImage = over; 184 | }; 185 | }, function (target) { 186 | var st = target.style; 187 | src = 'url(' + src + ')'; 188 | return function () { 189 | st.backgroundImage = src; 190 | }; 191 | }); 192 | }; 193 | 194 | new function () { 195 | var _exec_hover = function () { 196 | var elems = self.get_elems(self.rollClass); 197 | for (var i = 0, l = elems.length; i < l; self.hover(elems[i++])); 198 | if (self.noRollSet) return; 199 | var elems = self.get_elems(self.rollSetClass); 200 | for (var i = 0, l = elems.length; i < l; self.hoverSet(elems[i++])); 201 | }; 202 | var load_after = false; 203 | self.exec_hover = function () { 204 | if (load_after) return _exec_hover(); 205 | self.bind(window, 'load', function () { 206 | load_after = true; 207 | _exec_hover(); 208 | }); 209 | }; 210 | }; 211 | 212 | self.exec_external = function () { 213 | self.bind(window, 'load', function () { 214 | var elems = self.get_elems(self.externalClass); 215 | for (var i = 0, l = elems.length; i < l; elems[i++].target = '_blank'); 216 | }); 217 | }; 218 | 219 | self.exec_break_all = function () { 220 | var userAgent = navigator.userAgent; 221 | var splitter = userAgent.indexOf(' Gecko/') !== -1 && userAgent.indexOf('; rv:1.8.1') !== -1 ? '' : String.fromCharCode(8203); 222 | var split_text_node = function (elem) { 223 | var elems = elem.childNodes; 224 | var child = []; 225 | var i = 0; 226 | var len = elems.length; 227 | while (i < len) { 228 | child[i] = elems[i++]; 229 | } 230 | for (i = 0, len = child.length; i < len; ++i) { 231 | var self = child[i]; 232 | if (self.nodeType === 1) { 233 | if (self.childNodes && self.childNodes.length) arguments.callee(self); 234 | continue; 235 | } 236 | var val = self.nodeValue; 237 | if (!val || /^[ \n\r\t]*$/.test(val)) continue; 238 | var div = $d.createElement('div'); 239 | div.innerHTML = val.split('').join(splitter); 240 | var parent = self.parentNode; 241 | while (div.firstChild) parent.insertBefore(div.removeChild(div.firstChild), self); 242 | parent.removeChild(self); 243 | } 244 | }; 245 | if (userAgent.indexOf('Mozilla/4.0 (compatible; MSIE ') === 0 && userAgent.toLowerCase().indexOf('opera') === -1) { 246 | split_text_node = function (elem) { 247 | elem.style.wordBreak = 'break-all'; 248 | }; 249 | } 250 | 251 | var exec = function () { 252 | var elems = self.get_elems(self.wordBreakClass); 253 | for (var i = 0, l = elems.length; i < l; split_text_node(elems[i++])); 254 | }; 255 | window.jQuery ? $(exec) : Event.domReady.add(exec); 256 | }; 257 | 258 | if (!self.noExternal) self.exec_external(); 259 | if (!self.noBreakAll) self.exec_break_all(); 260 | 261 | var is_ie = new RegExp('^Mozilla\\/4\\.0 \\(compatible; MSIE (?:5\\.5|['+(self.pngFixVersion.replace(/[^0-9]/g, ''))+']\\.)'); 262 | if (!is_ie.test(navigator.userAgent)) { 263 | if (!self.noRoll) self.exec_hover(); 264 | return; 265 | } 266 | 267 | //----------------------------------- 268 | // for old IE only 269 | //----------------------------------- 270 | 271 | self.eid = '_' + name_space + '_src'; 272 | 273 | self.store = function (elem, val) { 274 | return val ? elem[self.eid] = val : elem[self.eid]; 275 | }; 276 | 277 | new function () { 278 | var old_get_src = self.get_src; 279 | self.get_src = function (elem) { 280 | return elem[self.eid] || (elem[self.eid] = old_get_src.call(self, elem)); 281 | }; 282 | }; 283 | 284 | self.set_size = function (elem) { 285 | var cur = elem.currentStyle; 286 | if (cur.width === 'auto' && elem.offsetWidth) elem.style.width = elem.offsetWidth + 'px'; 287 | if (cur.height === 'auto' && elem.offsetHeight) elem.style.height = elem.offsetHeight + 'px'; 288 | }; 289 | 290 | self.fix = function (elem) { 291 | elem.runtimeStyle.behavior = 'none'; 292 | var src = elem[self.eid] || (elem[self.eid] = self.get_src(elem)); 293 | if (!src) src = elem.src; 294 | if (!src || !/\.png/i.test(src.toLowerCase())) return; 295 | self.set_size(elem); 296 | if (elem.src) elem.src = self.blankUrl; 297 | if (!elem.style.zoom && elem.style.zoom !== '0') elem.style.zoom = 1; 298 | self.swap(elem, src); 299 | if (!elem.src) self.fix_bg_elem(elem); 300 | self.bind(elem, 'propertychange', function () { 301 | propertychange.apply(this, arguments); 302 | }); 303 | 304 | function propertychange () { 305 | var env = window.event; 306 | var target = env.srcElement; 307 | if (window.jQuery) target = this; 308 | var tmp = propertychange; 309 | propertychange = function () {}; 310 | new function () { 311 | if (target.src) { 312 | if (target.src === self.blankUrl) return; 313 | self.swap(target, target.src); 314 | target[self.eid] = target.src; 315 | target.src = self.blankUrl; 316 | return; 317 | } 318 | var src = self.get_src(target); 319 | if (!src) return; 320 | self.swap(target, src); 321 | target.style.backgroundImage = 'none'; 322 | target[self.eid] = src; 323 | }; 324 | propertychange = tmp; 325 | }; 326 | }; 327 | 328 | self.fix_bg_elem = function (elem) { 329 | elem.style.backgroundImage = 'none'; 330 | self.set_pos(elem); 331 | (elem.tagName.toUpperCase() === 'A') && (elem.style.cursor = elem.style.cursor || 'pointer'); 332 | var unclickable = ({'relative':1,'absolute':1})[(elem.currentStyle.position || '').toLowerCase()]; 333 | var msg = '\n\n<' + elem.nodeName + (elem.id && ' id="' + elem.id) + '">'; 334 | (function (elems) { 335 | if (!elems.length) return; 336 | if (unclickable) return alert(name_space + ': Unclickable children' + msg); 337 | for (var i = 0, n = elems.length; i < n; ++i) { 338 | var elem = elems[i]; 339 | if (!elem.style) continue; 340 | if (elem.style.position) continue; 341 | elem.style.position = 'relative'; 342 | } 343 | })(elem.getElementsByTagName('a')); 344 | }; 345 | 346 | self.set_pos = function (elem) { 347 | var tags = ['input', 'textarea', 'select']; 348 | var set = function (nodes, cursor) { 349 | for (var i = nodes.length, node; node = nodes[--i];) { 350 | var style = node.style; 351 | !style.position && (style.position = 'relative'); 352 | if (!cursor) continue; 353 | !style.cursor && (style.cursor = cursor); 354 | } 355 | }; 356 | while (tags.length) set(elem.getElementsByTagName(tags.pop())); 357 | set(elem.getElementsByTagName('a'), 'pointer'); 358 | }; 359 | 360 | self.swap = function (elem, src) { 361 | if (src === self.blankUrl) return; 362 | try{ 363 | var sizing = (elem.currentStyle.backgroundRepeat === 'no-repeat') ? 'crop' : 'scale'; 364 | var al = 'DXImageTransform.Microsoft.AlphaImageLoader'; 365 | if (elem.filters.length && al in elem.filters) { 366 | elem.filters[al].enabled = 1; 367 | elem.filters[al].src = src; 368 | return; 369 | } 370 | elem.style.filter = 'progid:' + al + '(src="' + src + '",sizingMethod="' + sizing + '");'; 371 | } catch(e) {}; 372 | }; 373 | 374 | self.exec_pngfix = function () { 375 | if (window.GMap2 && !self.noGMap2Error) alert(name_space + ' : do not read GMap2'); 376 | var exp = 'expression(' + name_space + '.fix(this));'; 377 | var div = $d.createElement('div'); 378 | div.innerHTML = ([ 379 | 'div
    ' 382 | ]).join(''); 383 | $d.getElementsByTagName('head')[0].appendChild(div.getElementsByTagName('style')[0]); 384 | }; 385 | 386 | if (!self.noRoll) self.exec_hover(); 387 | if (!self.noPngFix) self.exec_pngfix(); 388 | 389 | function load_lib () { 390 | /** 391 | * domready.js 392 | * 393 | * Copyright (c) 2007 Takanori Ishikawa. 394 | * License: MIT-style license. 395 | * 396 | * MooTools Copyright: 397 | * copyright (c) 2007 Valerio Proietti, 398 | * http://www.metareal.org/2007/07/10/domready-js-cross-browser-ondomcontentloaded/ 399 | * http://snipplr.com/view/6029/domreadyjs/ 400 | */ 401 | if(typeof Event=="undefined"){Event=new Object()}Event.domReady={add:function(b){if(Event.domReady.loaded){return b()}var e=Event.domReady.observers;if(!e){e=Event.domReady.observers=[]}e[e.length]=b;if(Event.domReady.callback){return}Event.domReady.callback=function(){if(Event.domReady.loaded){return}Event.domReady.loaded=true;if(Event.domReady.timer){clearInterval(Event.domReady.timer);Event.domReady.timer=null}var j=Event.domReady.observers;for(var f=0,h=j.length;f-1;if(document.readyState&&a){Event.domReady.timer=setInterval(function(){var f=document.readyState;if(f=="loaded"||f=="complete"){Event.domReady.callback()}},50)}else{if(document.readyState&&d){var c=(window.location.protocol=="https:")?"://0":"javascript:void(0)";document.write(' 106 | ? }; 107 | -------------------------------------------------------------------------------- /root/question/question.mt: -------------------------------------------------------------------------------- 1 | ? extends 'common/base'; 2 | 3 | ? my $q = $c->stash->{q}; 4 | ? my $as = $c->stash->{answer_sheet}; 5 | 6 | ? block content => sub { 7 | 8 |
    9 | 10 | 11 |
    12 |

    Perl道場

    13 |
    14 | 15 | 16 |
    17 |

    Question

    18 |
    19 |

    question ?>

    20 |
    21 |

    22 | by author_name ?> 23 | 24 |

    25 |
    26 | 27 |
    28 |

    Choice

    29 | ? if (my $err = $c->stash->{err}) { 30 |
    31 |

    32 |
    33 | ? } 34 |
    35 |
      36 | ? my $i = 0; 37 | ? for my $choice (@{ $q->choices }) { 38 | ? ++$i; 39 |
      2. 40 | ? } 41 |
    42 |
    43 |

    44 | ? if ($as) { 45 |

    current ?>問 / total ?>問

    46 | ? } 47 |
    48 |
    49 |
    50 | 51 | 52 | 55 | 56 | 57 |
    58 | 59 | 66 | ? }; 67 | -------------------------------------------------------------------------------- /root/question/result.mt: -------------------------------------------------------------------------------- 1 | ? extends 'common/base'; 2 | ? use List::Util qw/ max /; 3 | ? use URI; 4 | ? my $q = $c->stash->{q}; 5 | ? my $as = $c->stash->{answer_sheet}; 6 | ? my $rank = $as->rank; 7 | ? my $storage = $c->stash->{storage}; 8 | 9 | ? my $tweet_url = URI->new('http://twitter.com/share'); 10 | ? my $tweet_text = [ 11 | ? 'Perl道場の検定で満点獲得。「Perlを制するものは世界を制す」 #perldojo', 12 | ? 'Perl道場の検定で80点獲った！「能ある鷹は爪を隠す」ってやつだな。 #perldojo', 13 | ? 'Perl道場の検定で60点獲った。復習をして目指せ！偉大なるハッカーへの道！ #perldojo', 14 | ? 'Perl道場の検定で40点。あれ？風邪気味かな？もう一度やってみよう #perldojo', 15 | ? 'Perl道場の検定で20点。俺って、Perlエンジニアだよな？ #perldojo', 16 | ? 'Perl道場の検定で、な、な、なんと0点。気にすんな俺！まだまだ伸びシロがあるってことだ！ #perldojo', 17 | ? ]; 18 | ? $tweet_url->query_form( url => $c->req->uri, text => $tweet_text->[ abs(($as->score - 100) / 20) ] ); 19 | 20 | ? block content => sub { 21 | 22 |
    23 | 24 | 25 |
    26 |

    Perl道場

    27 |
    28 | 29 | 30 |
    31 |
    32 |

    33 |

    34 |
    35 |

    total ?>問中corrects ?>問正解

    36 |

    score ?>点

    37 |

    38 |
    39 |
    40 |

    41 | ? if ($rank == 1) { 42 | もしかしてラリー・ウォール・・・さんですか？難問を全て解いてしまったあなたは、すでにPerl界を代表するハッカーに違いない！
    ぜひ出題をお願いします！ 43 | ? } elsif ($rank == 2) { 44 | もう少しで全問正解！今回間違えたところを振り返ってみて、次はパーフェクトを目指してください！
    あなたのレベルなら問題の出題もぜひ挑戦してください！ 45 | ? } elsif ($rank == 3) { 46 | なかなかやりますね！しかしまだPerlには身につける知識がたくさんあるようです。
    解けなかった問題を復習して、偉大なるperlハッカーを目指してください！ 47 | ? } elsif ($rank == 4) { 48 | すこし難しかったでしょうか？しかしこれがPerlを引っ張るトップエンジニアが作った問題です。
    ぜひ繰り返し挑戦して知識を深めていってください！ 49 | ? } elsif ($rank == 5) { 50 | あなたのPerl知識はまだまだこれからのようです。しかし！それだけ伸びしシロがあるということ。
    何度もチャレンジして確実な知識を習得してくださいね！ 51 | ? } 52 | 53 |

    54 |
    55 |
      56 | ? my $n = 0; 57 | ? for my $q (@{ $as->questions }) { 58 | ? $n++; 59 |
    • 60 |

      問目

      61 |

      results->[$n - 1] ? "正解" : "不正解" ?>

      62 |

      【問題を見る】

      63 |

      by 64 | 65 | author_name ?> 66 |

      • 67 | ? } 68 |
    69 |

    結果をtweetする

    70 |
    71 |
    72 |
    73 | 74 |
    75 |
    76 |

    問題は毎回新しくなります。高得点めざしてトライしよう！

    77 |

    もう一度トライする

    78 |
    79 |
    80 |

    もっといい問題を作れる！というあなたはこちら

    81 |

    問題を作成する

    82 |
    83 |
    84 | 85 | 86 | 89 | 90 | 91 |
    92 | 93 | 94 | ? }; 95 | -------------------------------------------------------------------------------- /root/result/index.mt: -------------------------------------------------------------------------------- 1 | ? extends 'common/base'; 2 | 3 | ? my $q = $c->stash->{q}; 4 | 5 | ? block content => sub { 6 | 7 |
    8 | 9 | 10 |
    11 |

    Perl道場

    12 |
    13 | 14 | 15 |
    16 |
    17 |

    18 |

    19 |
    20 |

    10問中10問正解

    21 |

    100点

    22 |

    23 |
    24 |
    25 |

    あなたはもしかしてラリーウォール自身ではないですか？でなければ、生き別れの双子のきょうだい？
    ぜひPerl道場の問題を一緒につくってください。あなたこそPerl界、いや、プログラミング界の希望の星なのですから！

    26 |
    27 |
    28 |
      29 | ? for my $n ( 1 .. 10 ) { 30 |
    • 31 |

      問目

      32 |

      正解

      33 |

      【問題を見る】

      34 |

      by typester

      35 |
      • 36 | ? } 37 |
    38 |

    結果をtweetする

    39 |
    40 |
    41 |
    42 | 43 |
    44 |
    45 |

    問題は毎回新しくなります。高得点めざしてトライしよう！

    46 |

    もう一度トライする

    47 |
    48 |
    49 |

    もっといい問題を作れる！というあなたはこちら

    50 |

    問題を作成する

    51 |
    52 |
    53 | 54 | 55 | 58 | 59 | 60 |
    61 | 62 | 63 | ? }; 64 | -------------------------------------------------------------------------------- /t/001_load.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | use_ok 'Dojo'; 4 | 5 | done_testing; 6 | -------------------------------------------------------------------------------- /t/002_api.t: -------------------------------------------------------------------------------- 1 | # -*- mode:perl -*- 2 | use strict; 3 | use warnings; 4 | use Test::More; 5 | use Plack::Test; 6 | use HTTP::Request::Common; 7 | use t::Utils; 8 | use Path::Class qw/ file dir /; 9 | 10 | my $app = setup_app; 11 | my $pod = [ grep { !$_->is_dir } dir("data")->children ]->[0]; 12 | (my $name = $pod->basename) =~ s/\.pod$//; 13 | note "test pod: $pod"; 14 | 15 | test_psgi $app, sub { 16 | my $cb = shift; 17 | 18 | subtest ping => sub { 19 | my $res = $cb->( GET "http://localhost/api/ping" ); 20 | is $res->code, 200; 21 | is $res->content => "ok"; 22 | }; 23 | 24 | subtest star_404 => sub { 25 | my $res = $cb->( POST "http://localhost/api/star/xxxxx" ); 26 | is $res->code => 404, "not found xxxxx"; 27 | }; 28 | 29 | subtest star_405 => sub { 30 | my $res = $cb->( PUT "http://localhost/api/star/${name}" ); 31 | is $res->code => 405, "method not allowed"; 32 | }; 33 | 34 | subtest star_head => sub { 35 | my $res = $cb->( HEAD "http://localhost/api/star/${name}" ); 36 | is $res->code => 200, "head ok"; 37 | }; 38 | 39 | subtest star_get_before => sub { 40 | my $res = $cb->( GET "http://localhost/api/star/${name}" ); 41 | is $res->code => 200, "method not allowed GET"; 42 | is $res->content_type => "text/plain"; 43 | is $res->content => "0"; 44 | }; 45 | 46 | for my $n ( 1 .. 10 ) { 47 | subtest star_post => sub { 48 | my $res = $cb->( POST "http://localhost/api/star/${name}" ); 49 | is $res->code => 200, "post ok"; 50 | is $res->content => "${n}", "added count ${n}"; 51 | }; 52 | } 53 | 54 | subtest star_get_after => sub { 55 | my $res = $cb->( GET "http://localhost/api/star/${name}" ); 56 | is $res->code => 200, "get ok"; 57 | is $res->content_type => "text/plain"; 58 | is $res->content => "10"; 59 | }; 60 | 61 | }; 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/003_webapp.t: -------------------------------------------------------------------------------- 1 | # -*- mode:perl -*- 2 | use strict; 3 | use warnings; 4 | use Test::More; 5 | use Plack::Test; 6 | use HTTP::Request::Common; 7 | use t::Utils; 8 | use Path::Class qw/ file dir /; 9 | 10 | use_ok "pQuery"; 11 | 12 | my $app = setup_app; 13 | 14 | test_psgi $app, sub { 15 | my $cb = shift; 16 | 17 | subtest index => sub { 18 | my $res = $cb->( GET "http://localhost/" ); 19 | is $res->code, 200; 20 | like $res->content => qr{\A<\!DOCTYPE html>}; 21 | }; 22 | 23 | subtest notfound => sub { 24 | my $res = $cb->( POST "http://localhost/xxxxx" ); 25 | is $res->code => 404, "not found xxxxx"; 26 | }; 27 | 28 | my $sid; 29 | my $next_uri; 30 | subtest start => sub { 31 | my $res = $cb->( GET "http://localhost/question" ); 32 | 33 | is $res->code => 302, "status ok"; 34 | $next_uri = $res->header("Location"); 35 | like $next_uri => qr{^http://.*/question/.+$}; 36 | 37 | $sid = res2sid($res); 38 | ok $sid; 39 | }; 40 | 41 | my $page = 0; 42 | my $break; 43 | QUESTIONS: 44 | while (++$page <= 10) { 45 | my $choices; 46 | subtest question_get => sub { 47 | note "GET $next_uri"; 48 | my $res = $cb->( GET $next_uri, 49 | Cookie => "dojostate=$sid" ); 50 | is $res->code => 200, "status 200"; 51 | $sid = res2sid($res); 52 | 53 | my $pq = pQuery($res->content); 54 | is $pq->find(".counter strong")->html => $page, "counter $page"; 55 | $choices = $pq->find(".choices")->length; 56 | note "choices=$choices"; 57 | }; 58 | 59 | subtest question_icon_get => sub { 60 | (my $uri = $next_uri) =~ s{/question/}{/question/icon/}; 61 | my $res = $cb->( GET $uri, 62 | Cookie => "dojostate=$sid" ); 63 | is $res->code => 302, "status 302"; 64 | like $res->header("Location") => qr{^https?://www\.gravatar\.com}; 65 | note $res->header("Location"); 66 | ok !$res->header("Set-Cookie"); 67 | }; 68 | 69 | subtest question_post_error => sub { 70 | note "POST $next_uri"; 71 | my $res = $cb->( POST $next_uri, 72 | Cookie => "dojostate=$sid" ); 73 | is $res->code => 200, "status 200"; 74 | $sid = res2sid($res); 75 | 76 | my $pq = pQuery($res->content); 77 | ok $pq->find(".error")->html, "error message"; 78 | }; 79 | 80 | subtest question_post => sub { 81 | note "POST $next_uri"; 82 | my $res = $cb->( POST $next_uri, 83 | Cookie => "dojostate=$sid", 84 | Content => [ "choice" => int( rand($choices) ) + 1 ] ); 85 | is $res->code => 200, "status 200"; 86 | $sid = res2sid($res); 87 | 88 | my $pq = pQuery($res->content); 89 | is $pq->find(".counter strong")->html => $page, "counter $page"; 90 | ok ! $pq->find(".error")->get(0), "no error message"; 91 | my $node; 92 | if ( $node = $pq->find(".gotoNext")->get(0) 93 | || $pq->find(".gotoResult")->get(0) ) 94 | { 95 | ok $node; 96 | $next_uri = $node->getAttribute("href"); 97 | ok $next_uri; 98 | } 99 | else { 100 | note $res->content; 101 | fail "no next uri"; 102 | $break = 1; 103 | } 104 | }; 105 | last QUESTIONS if $next_uri =~ /result/ || $break; 106 | } # end of QUESTIONS 107 | 108 | subtest result_get_redirect => sub { 109 | note "GET $next_uri"; 110 | my $res = $cb->( GET $next_uri, 111 | Cookie => "dojostate=$sid" ); 112 | is $res->code => 302, "status 302"; 113 | $next_uri = $res->header("Location") . ""; 114 | like $next_uri => qr{/result/[0-9a-fA-F]{32}$}; 115 | }; 116 | 117 | subtest result_get => sub { 118 | note "GET $next_uri"; 119 | my $res = $cb->( GET $next_uri, 120 | Cookie => "dojostate=$sid" ); 121 | is $res->code => 200, "status 200"; 122 | my $cookie = $res->header("Set-Cookie"); 123 | like $cookie => qr{dojostate=;}, "delete cookie"; 124 | like $cookie => qr{expires=[^;]+}, "delete cookie"; 125 | 126 | my $pq = pQuery($res->content); 127 | for my $query (".blockResultHeader p", ".score", ".rank") { 128 | my $html = $pq->find($query)->html; 129 | ok $html; 130 | note $html; 131 | } 132 | }; 133 | 134 | }; 135 | 136 | done_testing; 137 | 138 | sub res2sid { 139 | my $res = shift; 140 | if ( $res->header("Set-Cookie") =~ m{dojostate=(.+?);} ) { 141 | ok $1; 142 | return $1; 143 | } 144 | return; 145 | } 146 | -------------------------------------------------------------------------------- /t/Utils.pm: -------------------------------------------------------------------------------- 1 | package t::Utils; 2 | use strict; 3 | use warnings; 4 | use Dojo; 5 | use Test::mysqld; 6 | 7 | use Exporter 'import'; 8 | our @EXPORT = qw/ setup_memcached setup_app /; 9 | our @EXPORT_OK = @EXPORT; 10 | 11 | sub setup_app (%) { 12 | my $args = shift || {}; 13 | 14 | my $dojo = Dojo->new; 15 | $dojo->setup; 16 | 17 | my $memcached = setup_memcached(); 18 | 19 | $dojo->config->{storage}->{backend}->{class} = "Cache::Memcached::Fast"; 20 | $dojo->config->{storage}->{backend}->{args}->{servers} 21 | = [ "127.0.0.1:" . $memcached->port ]; 22 | $dojo->config->{storage}->{__backend} = $memcached; # keep instance 23 | 24 | if ($args->{config}) { 25 | $dojo->config->{$_} = clone($args->{config}->{$_}) 26 | for keys %{ $args->{config} }; 27 | } 28 | 29 | sub { $dojo->handler->(@_) }; 30 | } 31 | 32 | sub setup_memcached { 33 | require Test::TCP; 34 | my $bin = $ENV{MEMCACHED} || "memcached"; 35 | my $memcached = Test::TCP->new( 36 | code => sub { 37 | my $port = shift; 38 | exec $bin, '-p' => $port; 39 | die "cannot execute $bin: $!"; 40 | }, 41 | ); 42 | $memcached; 43 | } 44 | 45 | 1; 46 | -------------------------------------------------------------------------------- /t/data/pod.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval "use Test::Pod 1.00"; 3 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 4 | 5 | all_pod_files_ok( all_pod_files(qw/data/) ); 6 | -------------------------------------------------------------------------------- /t/data/pod_requirements.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | use File::Find (); 3 | use Pod::HTMLEmbed; 4 | use FindBin; 5 | 6 | my $parser = Pod::HTMLEmbed->new; 7 | 8 | File::Find::find(sub { 9 | return unless $_ =~ /.+\.pod$/; 10 | 11 | my $pod = $parser->load($File::Find::name); 12 | 13 | ok $pod->section('QUESTION'), "$File::Find::name has QUESTION ok"; 14 | ok $pod->section('CHOICES'), "$File::Find::name has CHOICES ok"; 15 | ok $pod->section('ANSWER'), "$File::Find::name has ANSWER ok"; 16 | ok $pod->section('AUTHOR'), "$File::Find::name has AUTHOR ok"; 17 | }, "$FindBin::Bin/../../data"); 18 | 19 | done_testing; 20 | -------------------------------------------------------------------------------- /t/model/answer_sheet.t: -------------------------------------------------------------------------------- 1 | # -*- mode:perl -*- 2 | use strict; 3 | use warnings; 4 | use utf8; 5 | use FindBin; 6 | 7 | use Test::More; 8 | use t::Utils; 9 | 10 | use_ok 'Dojo::Model::AnswerSheet'; 11 | use_ok 'Dojo::Model::Questions'; 12 | my $qs = Dojo::Model::Questions->new( 13 | data_dir => "$FindBin::Bin/questions", 14 | ); 15 | 16 | my $serialized; 17 | 18 | subtest "create" => sub { 19 | my $as = Dojo::Model::AnswerSheet->new( 20 | questions => [ map { $qs->get($_) } qw/ foo bar baz / ], 21 | ); 22 | 23 | isa_ok $as => "Dojo::Model::AnswerSheet"; 24 | is $as->total => 3, "total questions"; 25 | is $as->current => 1, "default position"; 26 | is $as->current_question->name => "foo", "current_questions 1"; 27 | $as->set_result(1); 28 | is $as->corrects => 1; 29 | 30 | ok $as->go_next; 31 | is $as->current => 2, "next position"; 32 | is $as->current_question->name => "bar", "current_questions 2"; 33 | $as->set_result(0); 34 | is $as->corrects => 1; 35 | 36 | $serialized = $as->serialize; 37 | like $serialized => qr{\A[a-zA-Z0-9_\-]+\z}; 38 | 39 | like $as->digest => qr{\A[0-9a-f]+\z}; 40 | }; 41 | 42 | note "serialized: $serialized"; 43 | 44 | subtest restore => sub { 45 | my $as = Dojo::Model::AnswerSheet->deserialize( 46 | serialized => $serialized, 47 | questions => $qs, 48 | ); 49 | isa_ok $as => "Dojo::Model::AnswerSheet"; 50 | is $as->total => 3, "total questions"; 51 | is $as->current => 2, "restored current"; 52 | is $as->current_question->name => "bar", "current_questions 2"; 53 | $as->go_next; 54 | is $as->current => 3, "next current 3"; 55 | is $as->current_question->name => "baz", "current_questions 3"; 56 | 57 | $as->set_result(1); 58 | is $as->corrects => 2; 59 | 60 | ok $as->set_current_question( $as->questions->[0]->name ); 61 | is $as->current => 1; 62 | 63 | ok $as->set_current_question( $as->questions->[2]->name ); 64 | is $as->current => 3; 65 | }; 66 | 67 | done_testing; 68 | -------------------------------------------------------------------------------- /t/model/questions.t: -------------------------------------------------------------------------------- 1 | # -*- mode:perl -*- 2 | use strict; 3 | use warnings; 4 | use utf8; 5 | use FindBin; 6 | 7 | use Test::More; 8 | 9 | use_ok 'Dojo::Model::Questions'; 10 | 11 | my $qs = Dojo::Model::Questions->new( 12 | data_dir => "$FindBin::Bin/questions", 13 | ); 14 | isa_ok $qs, 'Dojo::Model::Questions'; 15 | 16 | is scalar keys %{$qs->data}, 4, '4 data loaded ok'; 17 | 18 | subtest foo => sub { 19 | ok my $foo = $qs->get('foo'), 'foo loaded ok'; 20 | ok my $foobar = $qs->get('foo/bar'), 'foo/bar loaded ok'; 21 | 22 | like $foo->question, qr!

    test question

    !, 'question ok'; 23 | is_deeply $foo->choices, [qw/foo bar buzz hoge fuga/], 'coices ok'; 24 | is $foo->answer, 'hoge', 'answer ok'; 25 | like $foo->explanation, qr!

    test explanation

    !, 'explanation ok'; 26 | like $foo->gravatar_uri => qr{^http://www\.gravatar\.com/avatar/\w+}; 27 | note $foo->gravatar_uri; 28 | unlike $foo->author_name => qr{\A\s+}; 29 | unlike $foo->author_name => qr{\s+\z}; 30 | }; 31 | 32 | subtest bar => sub { 33 | ok my $bar = $qs->get('bar'), 'bar loaded ok'; 34 | like $bar->gravatar_uri => qr{^http://www\.gravatar\.com/avatar/\w+}; 35 | note $bar->gravatar_uri; 36 | note $bar->author_name; 37 | unlike $bar->author_name => qr{\A\s+}; 38 | unlike $bar->author_name => qr{\s+\z}; 39 | }; 40 | 41 | subtest baz => sub { 42 | ok my $baz = $qs->get('baz'), 'baz loaded ok'; 43 | like $baz->gravatar_uri => qr{^http://www\.gravatar\.com/avatar/0{32}}; 44 | note $baz->gravatar_uri; 45 | note $baz->author_name; 46 | unlike $baz->author_name => qr{\A\s+}; 47 | unlike $baz->author_name => qr{\s+\z}; 48 | }; 49 | 50 | subtest "foo/bar" => sub { 51 | ok my $fb = $qs->get('foo/bar'), 'foo/bar loaded ok'; 52 | like $fb->gravatar_uri => qr{^http://www\.gravatar\.com/avatar/[a-f0-9]{32}}; 53 | note $fb->gravatar_uri; 54 | note $fb->author_name; 55 | unlike $fb->author_name => qr{\A\s+}; 56 | unlike $fb->author_name => qr{\s+\z}; 57 | }; 58 | 59 | subtest shuffled => sub { 60 | my @q = $qs->get_shuffled(3); 61 | is scalar @q => 3, "shuffled 3"; 62 | isa_ok $_ => "Dojo::Model::Question" for @q; 63 | }; 64 | 65 | subtest random => sub { 66 | for (1 .. 10) { 67 | my $key = $qs->random_next; 68 | my $q = $qs->get($key); 69 | isa_ok $q, "Dojo::Model::Question"; 70 | is $q->name => $key; 71 | } 72 | }; 73 | 74 | done_testing; 75 | -------------------------------------------------------------------------------- /t/model/questions/bar.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | test question 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | foo 14 | 15 | =item 2. 16 | 17 | bar 18 | 19 | =item 3. 20 | 21 | buzz 22 | 23 | =item 4. 24 | 25 | hoge 26 | 27 | =item 5. 28 | 29 | fuga 30 | 31 | =back 32 | 33 | =head1 ANSWER 34 | 35 | 4 36 | 37 | =head1 EXPLANATION 38 | 39 | test explanation 40 | 41 | =head1 AUTHOR 42 | 43 | Daisuke Murase 44 | https://github.com/typester 45 | -------------------------------------------------------------------------------- /t/model/questions/baz.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | test question 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | foo 14 | 15 | =item 2. 16 | 17 | bar 18 | 19 | =item 3. 20 | 21 | buzz 22 | 23 | =item 4. 24 | 25 | hoge 26 | 27 | =item 5. 28 | 29 | fuga 30 | 31 | =back 32 | 33 | =head1 ANSWER 34 | 35 | 4 36 | 37 | =head1 EXPLANATION 38 | 39 | test explanation 40 | 41 | =head1 AUTHOR 42 | 43 | Daisuke Murase 44 | -------------------------------------------------------------------------------- /t/model/questions/foo.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | test question 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | foo 14 | 15 | =item 2. 16 | 17 | bar 18 | 19 | =item 3. 20 | 21 | buzz 22 | 23 | =item 4. 24 | 25 | hoge 26 | 27 | =item 5. 28 | 29 | fuga 30 | 31 | =back 32 | 33 | =head1 ANSWER 34 | 35 | 4 36 | 37 | =head1 EXPLANATION 38 | 39 | test explanation 40 | 41 | =head1 AUTHOR 42 | 43 | Daisuke Murase 44 | http://gravatar.com/avatar/fbc6511bcc0649366086c0445fb456d3 45 | -------------------------------------------------------------------------------- /t/model/questions/foo.txt: -------------------------------------------------------------------------------- 1 | wawawa 2 | -------------------------------------------------------------------------------- /t/model/questions/foo/bar.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 QUESTION 4 | 5 | test bar question 6 | 7 | =head1 CHOICES 8 | 9 | =over 10 | 11 | =item 1. 12 | 13 | foo 14 | 15 | =item 2. 16 | 17 | bar 18 | 19 | =item 3. 20 | 21 | buzz 22 | 23 | =item 4. 24 | 25 | hoge 26 | 27 | =item 5. 28 | 29 | fuga 30 | 31 | =back 32 | 33 | =head1 ANSWER 34 | 35 | 2 36 | 37 | =head1 EXPLANATION 38 | 39 | test bar explanation 40 | 41 | =head1 AUTHOR 42 | 43 | Daisuke Murase 44 | typester@cpan.org 45 | -------------------------------------------------------------------------------- /t/model/storage.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use utf8; 4 | use FindBin; 5 | 6 | use Test::More; 7 | use Test::TCP; 8 | use t::Utils; 9 | 10 | my $memcached = setup_memcached; 11 | my $port = $memcached->port; 12 | 13 | use_ok 'Dojo::Model::Storage'; 14 | use_ok 'Cache::Memcached::Fast'; 15 | 16 | my $s = Dojo::Model::Storage->new( 17 | backend => Cache::Memcached::Fast->new({ servers => ["127.0.0.1:$port"] }), 18 | ); 19 | isa_ok $s, 'Dojo::Model::Storage'; 20 | 21 | subtest "result" => sub { 22 | is_deeply $s->set_result( foo => 1 ) => { answered => 1, corrected => 1 }; 23 | is_deeply $s->set_result( foo => 0 ) => { answered => 2, corrected => 1 }; 24 | is_deeply $s->set_result( foo => 1 ) => { answered => 3, corrected => 2 }; 25 | is_deeply $s->set_result( foo => 0 ) => { answered => 4, corrected => 2 }; 26 | is_deeply $s->set_result( foo => 1 ) => { answered => 5, corrected => 3 }; 27 | is_deeply $s->set_result( bar => 1 ) => { answered => 1, corrected => 1 }; 28 | is_deeply $s->set_result( bar => 1 ) => { answered => 2, corrected => 2 }; 29 | is_deeply $s->set_result( bar => 0 ) => { answered => 3, corrected => 2 }; 30 | 31 | my $foo = $s->get_result("foo"); 32 | is_deeply $foo => { answered => 5, corrected => 3 }, "foo result"; 33 | 34 | my $bar = $s->get_result("bar"); 35 | is_deeply $bar => { answered => 3, corrected => 2 }, "foo result"; 36 | 37 | my $no = $s->get_result("no"); 38 | is_deeply $no => { answered => 0, corrected => 0 }, "foo result"; 39 | }; 40 | 41 | subtest "star" => sub { 42 | for ( 1 .. 100 ) { 43 | my $key = join("", map { chr( int rand(26) + 65 ) } (0.. ( 10 + rand(10) ))); 44 | my $n = int rand(30); 45 | $s->add_star($key) for 1 .. $n; 46 | my $star = $s->get_star($key); 47 | 48 | is $star => $n, "star $key = $n"; 49 | } 50 | }; 51 | 52 | done_testing; 53 | -------------------------------------------------------------------------------- /t/model/storage_dbi.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use utf8; 4 | use FindBin; 5 | 6 | use Test::More; 7 | use Test::mysqld; 8 | use t::Utils; 9 | 10 | use_ok 'Dojo::Model::Storage'; 11 | use_ok 'Dojo::Model::Storage::DBI'; 12 | 13 | my $mysqld = Test::mysqld->new( 14 | my_cnf => { 15 | 'skip-networking' => '', # no TCP socket 16 | } 17 | ) or die $Test::mysqld::errstr; 18 | 19 | my $dbh = DBI->connect( $mysqld->dsn( dbname => "test" ) ); 20 | $dbh->do( Dojo::Model::Storage::DBI->schema ); 21 | 22 | my $s = Dojo::Model::Storage->new( 23 | backend => Dojo::Model::Storage::DBI->new( 24 | connect_info => [ $mysqld->dsn( dbname => "test" ) ] 25 | ), 26 | ); 27 | isa_ok $s, 'Dojo::Model::Storage'; 28 | 29 | subtest "result" => sub { 30 | is_deeply $s->set_result( foo => 1 ) => { answered => 1, corrected => 1 }; 31 | is_deeply $s->set_result( foo => 0 ) => { answered => 2, corrected => 1 }; 32 | is_deeply $s->set_result( foo => 1 ) => { answered => 3, corrected => 2 }; 33 | is_deeply $s->set_result( foo => 0 ) => { answered => 4, corrected => 2 }; 34 | is_deeply $s->set_result( foo => 1 ) => { answered => 5, corrected => 3 }; 35 | is_deeply $s->set_result( bar => 1 ) => { answered => 1, corrected => 1 }; 36 | is_deeply $s->set_result( bar => 1 ) => { answered => 2, corrected => 2 }; 37 | is_deeply $s->set_result( bar => 0 ) => { answered => 3, corrected => 2 }; 38 | 39 | my $foo = $s->get_result("foo"); 40 | is_deeply $foo => { answered => 5, corrected => 3 }, "foo result"; 41 | 42 | my $bar = $s->get_result("bar"); 43 | is_deeply $bar => { answered => 3, corrected => 2 }, "foo result"; 44 | 45 | my $no = $s->get_result("no"); 46 | is_deeply $no => { answered => 0, corrected => 0 }, "foo result"; 47 | }; 48 | 49 | subtest "star" => sub { 50 | for ( 1 .. 100 ) { 51 | my $key = join("", map { chr( int rand(26) + 65 ) } (0.. ( 10 + rand(10) ))); 52 | my $n = int rand(30); 53 | $s->add_star($key) for 1 .. $n; 54 | my $star = $s->get_star($key); 55 | 56 | is $star => $n, "star $key = $n"; 57 | } 58 | }; 59 | 60 | done_testing; 61 | -------------------------------------------------------------------------------- /tools/new-question.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use strict; 3 | use warnings; 4 | no warnings 'uninitialized'; 5 | 6 | use Text::MicroTemplate; 7 | use Getopt::Long; 8 | use utf8; 9 | binmode STDOUT, ':utf8'; 10 | binmode STDERR, ':utf8'; 11 | 12 | GetOptions( 13 | '--force|f' => \my $force, 14 | '--author' => \my $author, 15 | '--github' => \my $github, 16 | ) or die "Failed.\n"; 17 | 18 | 19 | chomp($author = `git config user.name`) unless length $author; 20 | chomp($github = `git config github.user`) unless length $github; 21 | 22 | $author = '[AUTHOR NAME HERE]' unless length $author; 23 | $github = '[GITHUB URI HERE]' unless length $author; 24 | 25 | my $renderer = Text::MicroTemplate->new( 26 | template => do { local $/; }, 27 | escape_func => sub { $_[0] }, 28 | )->build(); 29 | 30 | # main 31 | 32 | my($file) = @ARGV; 33 | if(defined $file) { 34 | $file = "data/$file" if $file !~ m{ \A data/ }xms; 35 | $file = "$file.pod" if $file !~ m{ \.pod \z}xms; 36 | 37 | if(not -e $file or $force) { 38 | open my $fh, '>:utf8', $file 39 | or die "Cannot open $file for writing: $!\n"; 40 | select $fh; 41 | print STDERR "create $file\n"; 42 | } 43 | else { 44 | die "File $file exists. Please --force if you are sure.\n"; 45 | } 46 | } 47 | else { 48 | die "Usage: $0 [--force] [--author=AUTHOR] [--github=GITHUB] NAME\n"; 49 | } 50 | 51 | print $renderer->($author, "http://github.com/$github"); 52 | 53 | __DATA__ 54 | ? my($author, $github) = @_; 55 | 56 | =encoding utf-8 57 | 58 | =head1 QUESTION 59 | 60 | [ WRITE QUESTION HERE ] 61 | 62 | =head1 CHOICES 63 | 64 | =over 65 | 66 | =item 1. 67 | 68 | [ CHOISE 1 ] 69 | 70 | =item 2. 71 | 72 | [ CHOISE 2 ] 73 | 74 | =item 3. 75 | 76 | [ CHOISE 3 ] 77 | 78 | =item 4. 79 | 80 | [ CHOISE 4 ] 81 | 82 | =item 5. 83 | 84 | [ CHOISE 5 ] 85 | 86 | =back 87 | 88 | =head1 ANSWER 89 | 90 | N 91 | 92 | =head1 EXPLANATION 93 | 94 | [ EXPLANATION HERE ] 95 | 96 | =head1 AUTHOR 97 | 98 | 99 | 100 | 101 | =cut 102 | --------------------------------------------------------------------------------