Parent Directory
| 
Revision Log
merged changes from ghe3 development
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/Login.pm,v 1.46 2007/08/13 22:59:55 sh002i Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::Login; 18 use base qw(WeBWorK); 19 use base qw(WeBWorK::ContentGenerator); 20 21 =head1 NAME 22 23 WeBWorK::ContentGenerator::Login - display a login form. 24 25 =cut 26 27 use strict; 28 use warnings; 29 #use CGI qw(-nosticky ); 30 use WeBWorK::CGI; 31 use WeBWorK::Utils qw(readFile dequote); 32 33 use mod_perl; 34 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ); 35 36 # This content generator is NOT logged in. 37 sub if_loggedin { 38 my ($self, $arg) = @_; 39 40 return !$arg; 41 } 42 43 sub info { 44 45 ######### NOTES ON TRANSLATION 46 # -translation of the content found in the info panel. Since most of this content is in fact read from files, a simple use of maketext would be too limited to translate these types of content efficiently. 47 48 my ($self) = @_; 49 my $r = $self->r; 50 my $ce = $r->ce; 51 52 my $result; 53 # This section should be kept in sync with the Home.pm version 54 # list the login info first. 55 56 # FIXME this is basically the same code as below... TIME TO REFACTOR! 57 my $login_info = $ce->{courseFiles}->{login_info}; 58 59 if (defined $login_info and $login_info) { 60 # login info is relative to the templates directory, apparently 61 $login_info = $ce->{courseDirs}->{templates} . "/$login_info"; 62 63 # deal with previewing a temporary file 64 # FIXME: DANGER: this code allows viewing of any file 65 # FIXME: this code is disabled because PGProblemEditor no longer uses editFileSuffix 66 #if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile" 67 # and defined $r->param("editFileSuffix")) { 68 # $login_info .= $r->param("editFileSuffix"); 69 #} 70 71 if (-f $login_info) { 72 my $text = eval { readFile($login_info) }; 73 if ($@) { 74 $result .= CGI::h2($r->maketext("Login Info")); 75 $result .= CGI::div({class=>"ResultsWithError"}, $@); 76 } elsif ($text =~ /\S/) { 77 $result .= CGI::h2($r->maketext("Login Info")); 78 $result .= $text; 79 } 80 } 81 } 82 83 my $site_info = $ce->{webworkFiles}->{site_info}; 84 if (defined $site_info and $site_info) { 85 # deal with previewing a temporary file 86 # FIXME: DANGER: this code allows viewing of any file 87 # FIXME: this code is disabled because PGProblemEditor no longer uses editFileSuffix 88 #if (defined $r->param("editMode") and $r->param("editMode") eq "temporaryFile" 89 # and defined $r->param("editFileSuffix")) { 90 # $site_info .= $r->param("editFileSuffix"); 91 #} 92 93 if (-f $site_info) { 94 my $text = eval { readFile($site_info) }; 95 if ($@) { 96 $result .= CGI::h2($r->maketext("Site Information")); 97 $result .= CGI::div({class=>"ResultsWithError"}, $@); 98 } elsif ($text =~ /\S/) { 99 $result .= CGI::h2($r->maketext("Site Information")); 100 $result .= $text; 101 } 102 } 103 } 104 105 106 107 if (defined $result and $result ne "") { 108 return CGI::div({-class=>"info-wrapper"},CGI::div({class=>"info-box", id=>"InfoPanel"}, $result)); 109 } else { 110 return ""; 111 } 112 } 113 114 sub body { 115 my ($self) = @_; 116 my $r = $self->r; 117 my $ce = $r->ce; 118 my $db = $r->db; 119 my $urlpath = $r->urlpath; 120 121 # get the authen object to make sure that we should print 122 # a login form or not 123 my $auth = $r->authen; 124 my $externalAuth = (defined($auth->{external_auth}) && $auth->{external_auth} ) ? 1 : 0; 125 126 # get some stuff together 127 my $user = $r->param("user") || ""; 128 my $key = $r->param("key"); 129 my $passwd = $r->param("passwd") || ""; 130 my $course = $urlpath->arg("courseID"); 131 my $practiceUserPrefix = $ce->{practiceUserPrefix}; 132 133 # don't fill in the user ID for practice users 134 # (they should use the "Guest Login" button) 135 $user = "" if $user =~ m/^$practiceUserPrefix/; 136 137 # WeBWorK::Authen::verify will set the note "authen_error" 138 # if invalid authentication is found. If this is done, it's a signal to 139 # us to yell at the user for doing that, since Authen isn't a content- 140 # generating module. 141 my $authen_error = MP2 ? $r->notes->get("authen_error") : $r->notes("authen_error"); 142 if ($authen_error) { 143 print CGI::div({class=>"ResultsWithError"}, 144 CGI::p($authen_error) 145 ); 146 } 147 148 if ( $externalAuth ) { 149 print CGI::p({}, $r->maketext("_EXTERNAL_AUTH_MESSAGE", CGI::strong($r->maketext($course)))); 150 151 } else { 152 print CGI::p($r->maketext("Please enter your username and password for [_1] below:", CGI::b($r->maketext($course)))); 153 print CGI::p($r->maketext("_LOGIN_MESSAGE", CGI::b($r->maketext("Remember Me")))); 154 155 print CGI::startform({-method=>"POST", -action=>$r->uri, -id=>"login_form"}); 156 157 158 # preserve the form data posted to the requested URI 159 my @fields_to_print = grep { not m/^(user|passwd|key|force_passwd_authen)$/ } $r->param; 160 161 #FIXME: This next line can be removed in time. MEG 1/27/2005 162 # warn "Error in filtering fields : |", join("|",@fields_to_print),"|" if grep {m/user/} @fields_to_print; 163 # the above test was an attempt to discover why "user" was 164 # being multiply defined. We caught that error, but this 165 # warning causes trouble with UserList.pm which now has 166 # fields visible_users and prev_visible_users 167 168 169 # Important note. If hidden_fields is passed an empty array 170 # it prints ALL parameters as hidden fields. That is not 171 # what we want in this case, so we don't print at all if 172 # @fields_to_print is empty. 173 print $self->hidden_fields(@fields_to_print) if @fields_to_print > 0; 174 175 176 # print CGI::table({class=>"FormLayout"}, 177 # CGI::Tr([ 178 # CGI::td([ 179 # "Username:", 180 # CGI::input({-type=>"text", -name=>"user", -value=>"$user"}), 181 # ]),CGI::br(), 182 # CGI::td([ 183 # "Password:", 184 # CGI::input({-type=>"password", -name=>"passwd", -value=>"$passwd"}), 185 # ]),CGI::br(), 186 # CGI::td([ 187 # "", 188 # CGI::checkbox( 189 # -name=>"send_cookie", 190 # -label=>"Remember Me", 191 # ), 192 # ]), 193 # ]) 194 # ); 195 196 print CGI::br(),CGI::br(); 197 print WeBWorK::CGI_labeled_input(-type=>"text", -id=>"uname", -label_text=>$r->maketext("Username").": ", -input_attr=>{-name=>"user", -value=>"$user"}, -label_attr=>{-id=>"uname_label"}); 198 print CGI::br(); 199 print WeBWorK::CGI_labeled_input(-type=>"password", -id=>"pswd", -label_text=>$r->maketext("Password").": ", -input_attr=>{-name=>"passwd", -value=>"$passwd"}, -label_attr=>{-id=>"pswd_label"}); 200 print CGI::br(); 201 print WeBWorK::CGI_labeled_input(-type=>"checkbox", -id=>"rememberme", -label_text=>$r->maketext("Remember Me"), -input_attr=>{-name=>"send_cookie", -value=>"on"}); 202 print CGI::br(); 203 print WeBWorK::CGI_labeled_input(-type=>"submit", -input_attr=>{-value=>$r->maketext("Continue")}); 204 print CGI::br(); 205 print CGI::endform(); 206 207 # figure out if there are any valid practice users 208 # DBFIXME do this with a WHERE clause 209 my @guestUserIDs = grep m/^$practiceUserPrefix/, $db->listUsers; 210 my @GuestUsers = $db->getUsers(@guestUserIDs); 211 my @allowedGuestUsers; 212 foreach my $GuestUser (@GuestUsers) { 213 next unless defined $GuestUser->status; 214 next unless $GuestUser->status ne ""; 215 push @allowedGuestUsers, $GuestUser 216 if $ce->status_abbrev_has_behavior($GuestUser->status, "allow_course_access"); 217 } 218 219 # form for guest login 220 if (@allowedGuestUsers) { 221 print CGI::startform({-method=>"POST", -action=>$r->uri}); 222 223 # preserve the form data posted to the requested URI 224 my @fields_to_print = grep { not m/^(user|passwd|key|force_passwd_authen)$/ } $r->param; 225 print $self->hidden_fields(@fields_to_print); 226 227 print CGI::p($r->maketext("_GUEST_LOGIN_MESSAGE", CGI::b($r->maketext("Guest Login")))); 228 print CGI::input({-type=>"submit", -name=>"login_practice_user", -value=>$r->maketext("Guest Login")}); 229 230 print CGI::endform(); 231 } 232 } 233 return ""; 234 } 235 236 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |