View of /trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Options.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader$
    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::Options;
   18 use base qw(WeBWorK::ContentGenerator);
   19 
   20 =head1 NAME
   21 
   22 WeBWorK::ContentGenerator::Options - Change user options.
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 use CGI qw();
   29 use WeBWorK::Utils qw(cryptPassword);
   30 
   31 sub initialize {
   32   my $self = shift;
   33   my $r = $self->{r};
   34   my $ce = $self->{ce};
   35   my $db = $self->{db};
   36 
   37   $self->{effectiveUser} = $db->getUser($r->param('effectiveUser')); # checked
   38   die "record not found for user ", $r->param('effectiveUser'), " (effective user)."
   39     unless defined $self->{effectiveUser};
   40 }
   41 
   42 sub path {
   43   my ($self, $args) = @_;
   44 
   45   my $ce = $self->{ce};
   46   my $root = $ce->{webworkURLs}->{root};
   47   my $courseName = $ce->{courseName};
   48   return $self->pathMacro($args,
   49     "Home" => "$root",
   50     $courseName => "$root/$courseName",
   51     "User Options" => "",
   52   );
   53 }
   54 
   55 sub title {
   56   my $self = shift;
   57 
   58   return "User Options for " . $self->{effectiveUser}->first_name
   59     . " " . $self->{effectiveUser}->last_name;
   60 }
   61 
   62 sub body {
   63   my $self = shift;
   64   my $r = $self->{r};
   65   my $db = $self->{db};
   66   my $effectiveUser = $self->{effectiveUser};
   67 
   68   my $changeOptions = $r->param("changeOptions");
   69   my $newP = $r->param("newPassword");
   70   my $confirmP = $r->param("confirmPassword");
   71   my $newA = $r->param("newAddress");
   72 
   73   print CGI::start_form(-method=>"POST", -action=>$r->uri);
   74   print $self->hidden_authen_fields;
   75   print CGI::h2("Change Password");
   76   if ($changeOptions) {
   77     if ($newP or $confirmP) {
   78       if ($newP eq $confirmP) {
   79         my $passwordRecord = eval {$db->getPassword($effectiveUser->user_id)}; # checked
   80         warn "Can't get password for user |$effectiveUser| $@" if $@ or not defined($passwordRecord);
   81         my $cryptedPassword = cryptPassword($newP);
   82         $passwordRecord->password($cryptedPassword);
   83 
   84         # possibly do some format checking?
   85         eval { $db->putPassword($passwordRecord) };
   86         if ($@) {
   87           print CGI::p("Couldn't change your
   88           password: $@");
   89         } else {
   90           print CGI::p("Your password has been
   91           changed.");
   92         }
   93       } else {
   94         print CGI::p("The passwords you entered in the
   95         New Password and Confirm Password fields don't
   96         match. Please retype your new password and try
   97         again.");
   98       }
   99     }
  100   }
  101   print CGI::table(
  102     CGI::Tr(
  103       CGI::td("New Password"),
  104       CGI::td(CGI::password_field("newPassword")),
  105     ),
  106     CGI::Tr(
  107       CGI::td("Confirm Password"),
  108       CGI::td(CGI::password_field("confirmPassword")),
  109     ),
  110   );
  111   print CGI::h2("Change Email Address");
  112   if ($changeOptions) {
  113     if ($newA) {
  114       # possibly do some format checking?
  115       my $oldA = $effectiveUser->email_address;
  116       $effectiveUser->email_address($newA);
  117       eval { $db->putUser($effectiveUser) };
  118       if ($@) {
  119         $effectiveUser->email_address($oldA);
  120         print CGI::p("Couldn't change your
  121         email address: $@");
  122       } else {
  123         print CGI::p("Your email address has
  124         been changed.");
  125         $newA = "";
  126       }
  127     }
  128   }
  129   print CGI::table(
  130     CGI::Tr(
  131       CGI::td("Current Address"),
  132       CGI::td($effectiveUser->email_address),
  133     ),
  134     CGI::Tr(
  135       CGI::td("New Address"),
  136       CGI::td(CGI::textfield("newAddress", $newA)),
  137     ),
  138   );
  139   print CGI::br();
  140   print CGI::submit("changeOptions", "Change User Options");
  141   print CGI::end_form();
  142 
  143   return "";
  144 }
  145 
  146 1;