File Coverage

blib/lib/CAS/Apache/UserForms.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package CAS::Apache::UserForms;
2              
3 1     1   1576 use warnings FATAL => 'all', NONFATAL => 'redefine';
  1         2  
  1         45  
4 1     1   10 use strict;
  1         2  
  1         55  
5              
6             =head1 NAME
7              
8             CAS::Apache::UserForms - The great new CAS::Apache::UserForms!
9              
10             =head1 VERSION
11              
12             Version 0.01
13              
14             =cut
15              
16             our $VERSION = '0.01';
17 1     1   542 use Apache2::Const qw(OK SERVER_ERROR REDIRECT);
  0            
  0            
18             use base qw(CAS::Apache);
19             use CAS::Apache::Auth ();
20              
21             =head1 SYNOPSIS
22              
23             Quick summary of what the module does.
24              
25             Perhaps a little code snippet.
26              
27             use CAS::Apache::UserForms;
28              
29             my $foo = CAS::Apache::UserForms->new();
30             ...
31              
32             =head1 EXPORT
33              
34             A list of functions that can be exported. You can delete this section
35             if you don't export anything, such as for a purely object-oriented module.
36              
37             =head1 FUNCTIONS
38              
39             =head2 function1
40              
41             =cut
42              
43              
44             sub handler {
45             my $apache2 = shift;
46             die unless ref $apache2;
47            
48             my $request = $apache2->uri();
49             die unless $request;
50            
51             $request =~ m{/(\w+)$};
52             my $page = $1;
53             unless ($page) {
54             die "Unable to determine page requested in $request";
55             } # unless it's a CAS page
56             my $CR_gen_response = \&{$page};
57             unless (defined &$CR_gen_response) {
58             die "$page is not available through __PACKAGE__";
59             } # see if method is defined in this namespace
60            
61             # $apache2->unparsed_uri to find args
62             $apache2->content_type('text/html');
63            
64             my ($status, $html) = &$CR_gen_response($apache2);
65             return $status unless $status == OK;
66            
67             print $html;
68             # warn "HTML printed\n";
69             return OK;
70             } # handler
71              
72              
73             sub welcome {
74             my $apache2 = shift || die 'Request object required';
75             my $cgi = CGI->new;
76            
77             my $html = $cgi->start_html("CAS default welcome page");
78             $html .= <
79            

Welcome to the Central Authorization Server
80             HTML
81            
82             $html .= $cgi->end_html;
83             return (OK, $html);
84             } # welcome
85              
86              
87             sub preferences {
88             my $apache2 = shift || die 'Request object required';
89             my $cgi = CGI->new;
90            
91             my $html = $cgi->start_html("Foo");
92             $html .= <
93            

Bar
94             HTML
95            
96             $html .= $cgi->end_html;
97             return (OK, $html);
98             } # preferences
99              
100              
101             sub forgot_password {
102             my $apache2 = shift || die 'Request object required';
103             my $cgi = CGI->new;
104            
105             my $html = $cgi->start_html("Foo");
106             $html .= <
107            

Bar
108             HTML
109            
110             $html .= $cgi->end_html;
111             return (OK, $html);
112             } # forgot_password
113              
114             sub edit_account {
115             my $apache2 = shift || die 'Request object required';
116             my $cgi = CGI->new;
117            
118             my $user_table = _gen_user_table($cgi);
119            
120             my $html = $cgi->start_html("Foo");
121             $html .= <
122            

Bar
123             HTML
124            
125             $html .= $cgi->end_html;
126             return (OK, $html);
127             } # edit_account
128              
129              
130             ##
131             ## Support functions
132             ##
133              
134             sub _gen_user_table {
135             my $cgi = shift;
136            
137             my $username = $cgi->textfield(-name => 'Username', -size => 12,
138             -maxlength => 12);
139             my $password = $cgi->textfield(-name => 'Username', -size => 12,
140             -maxlength => 12);
141             my $check_pass = $cgi->textfield(-name => 'Username', -size => 12,
142             -maxlength => 12);
143             my $table = <
144            
145            
146             Choose Your Username:
147             (5-12 characters)
148            
149             $username
150            
151            
152            
153             HTML
154            
155            
156             } # _gen_user_table
157              
158              
159              
160             =head1 AUTHOR
161              
162             Sean P. Quinlan, C<< >>
163              
164             =head1 BUGS
165              
166             Please report any bugs or feature requests to
167             C, or through the web interface at
168             L.
169             I will be notified, and then you'll automatically be notified of progress on
170             your bug as I make changes.
171              
172             =head1 SUPPORT
173              
174             You can find documentation for this module with the perldoc command.
175              
176             perldoc CAS::Apache
177              
178             You can also look for information at:
179              
180             =over 4
181              
182             =item * AnnoCPAN: Annotated CPAN documentation
183              
184             L
185              
186             =item * CPAN Ratings
187              
188             L
189              
190             =item * RT: CPAN's request tracker
191              
192             L
193              
194             =item * Search CPAN
195              
196             L
197              
198             =back
199              
200             =head1 ACKNOWLEDGEMENTS
201              
202             =head1 COPYRIGHT & LICENSE
203              
204             Copyright 2006 Sean P. Quinlan, all rights reserved.
205              
206             This program is free software; you can redistribute it and/or modify it
207             under the same terms as Perl itself.
208              
209             =cut
210              
211             1; # End of CAS::Apache::UserForms