File Coverage

lib/Authen/Quiz/Plugin/JS.pm
Criterion Covered Total %
statement 27 28 96.4
branch n/a
condition 4 10 40.0
subroutine 5 5 100.0
pod 2 2 100.0
total 38 45 84.4


line stmt bran cond sub pod time code
1             package Authen::Quiz::Plugin::JS;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: JS.pm 361 2008-08-18 18:29:46Z lushe $
6             #
7 2     2   873 use strict;
  2         4  
  2         91  
8 2     2   11 use warnings;
  2         6  
  2         78  
9 2     2   65 use Carp qw/ croak /;
  2         4  
  2         1094  
10              
11             our $VERSION= '0.01';
12              
13             sub question2js {
14 1     1 1 3 my $self = shift;
15 1   33     20 my $boxid= shift || croak __PACKAGE__. q{ - I want element id.};
16 1   50     8 my $separ= shift || ' ';
17 1         26 my @array= split /$separ/, $self->question;
18 1         3 <<END_JS;
19 1         3 var aquiz_dat= new Array('@{[ join "','", map{quotemeta($_)}@array ]}');
  3         16  
20             var aquiz_obj= document.getElementById("$boxid");
21             aquiz_obj.innerHTML= aquiz_dat.join(' ');
22             END_JS
23             }
24             sub question2js_multibyte {
25 1     1 1 11 require Jcode;
26 1         2 my $self = shift;
27 1   33     5 my $boxid= shift || croak __PACKAGE__. q{ - I want element id.};
28 1   50     9 my $separ= shift || ' ';
29 3         85 my @array= map{ ## no critic.
30 1         23 $_= Jcode->new(\$_)->utf8;
31 3         351 s/([^\w ])/ '%'. unpack('H2', $1) /eg;
  0         0  
32 3         5 tr/ /+/;
33 3         9 $_;
34             } split /${separ}+/, $self->question;
35 1         3 <<END_JS;
36 1         13 var aquiz_dat= new Array('@{[ join "','", @array ]}');
37             var aquiz_obj= document.getElementById("$boxid");
38             aquiz_obj.innerHTML= decodeURI(aquiz_dat.join(' '));
39             END_JS
40             }
41              
42             1;
43              
44             __END__
45              
46             =head1 NAME
47              
48             Authen::Quiz::Plugin::JS - JAVA script making of setting Authen::Quiz.
49              
50             =head1 SYNOPSIS
51              
52             use Authen::Quiz::FW qw/ JS /;
53            
54             my $q= Authen::Quiz::FW->new( data_folder => '/path/to/authen_quiz' );
55            
56             my $js_source= $q->question2js('boxid');
57            
58             ## And, it buries it under the HTML source. ( For the Mason template. )
59             <html>
60             <body>
61             <form method="POST" action=".....">
62             <input type="hidden" name="quiz_session" value="<% $q->session_id %>" />
63             ...
64             ...
65             ...
66             <div>* quiz attestation.</div>
67             <div id="boxid">...</div>
68             <input type="text" name="answer" ..... />
69             <script type="text/javascript"><!-- //
70             <% $js_source %>
71             // --></script>
72             ...
73             ...
74             ...
75             </body>
76             </html>
77              
78             =head1 DESCRIPTION
79              
80             After all, the thing that the spammer analyzes it even if it drinks and setting
81             questions obtained by Jo and L<Authen::Quiz> is buried under HTML simply might
82             be not difficult the easy specification of the answer.
83              
84             This module is made easy not to be analyzed by burying the setting questions
85             under the code of the JAVA script.
86              
87             The method of this module is called reading by way of L<Authen::Quiz::FW> to use
88             it and setting questions is acquired.
89              
90             Then, if it is buried under the HTML source, it is completion because the code
91             of the JAVA script returns.
92              
93             * Because the SCRIPT tag is not contained in the output code, it is necessary to
94             write it in independence.
95              
96              
97             =head1 METHODS
98              
99             =head2 question2js ([ELEMENT_ID], [SEPARATOR])
100              
101             The question method is called internally, the setting questions is buried under
102             the code of the JAVA script, and it returns it.
103              
104             ELEMENT_ID is burial previous element ID.
105              
106             SEPARATOR is a character to make setting questions divide into parts. Default
107             is a blank.
108              
109             In a word, data of setting questions should make it moderately make to dividing
110             into parts beforehand with this separator.
111              
112             my $js_source= $q->$q->question2js('question_disp', ':');
113              
114             =head2 question2js_multibyte ([ELEMENT_ID], [SEPARATOR])
115              
116             When multi byte character is included in the problem data, URI is encoded though
117             the done thing is quite the same as question2js.
118              
119             * The JAVA script error occurs including the sign of ASKII.
120             It is safe to make the problem data only from multi byte character.
121              
122             my $js_source= $q->$q->question2js('question_disp', '#');
123              
124             =head1 SEE ALSO
125              
126             L<Authen::Quiz>,
127             L<Authen::Quiz::FW>,
128             L<Jcode>,
129              
130             L<http://egg.bomcity.com/wiki?Authen%3a%3aQuiz>,
131              
132             =head1 AUTHOR
133              
134             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
135              
136             =head1 COPYRIGHT AND LICENSE
137              
138             Copyright (C) 2008 by Bee Flag, Corp. E<lt>http://egg.bomcity.com/E<gt>.
139              
140             This library is free software; you can redistribute it and/or modify
141             it under the same terms as Perl itself, either Perl version 5.8.8 or,
142             at your option, any later version of Perl 5 you may have available.
143              
144             =cut