[system] / trunk / webwork2 / lib / WeBWorK / ContentGenerator / CourseAdmin.pm Repository:
ViewVC logotype

View of /trunk/webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7140 - (download) (as text) (annotate)
Mon May 21 15:25:07 2012 UTC (7 years, 4 months ago) by apizer
File size: 121140 byte(s)
Add methods to list/hide/unhide inactive courses

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/ContentGenerator/CourseAdmin.pm,v 1.91 2010/06/13 02:25:51 gage 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::CourseAdmin;
   18 use base qw(WeBWorK::ContentGenerator);
   19 
   20 =head1 NAME
   21 
   22 WeBWorK::ContentGenerator::CourseAdmin - Add, rename, and delete courses.
   23 
   24 =cut
   25 
   26 use strict;
   27 use warnings;
   28 #use CGI qw(-nosticky );
   29 use WeBWorK::CGI;
   30 use Data::Dumper;
   31 use File::Temp qw/tempfile/;
   32 use WeBWorK::CourseEnvironment;
   33 use IO::File;
   34 use URI::Escape;
   35 use WeBWorK::Debug;
   36 use WeBWorK::Utils qw(cryptPassword writeLog listFilesRecursive trim_spaces);
   37 use WeBWorK::Utils::CourseManagement qw(addCourse renameCourse deleteCourse listCourses archiveCourse
   38                                         listArchivedCourses unarchiveCourse initNonNativeTables);
   39 use WeBWorK::Utils::CourseIntegrityCheck;
   40 #use WeBWorK::Utils::DBImportExport qw(dbExport dbImport);
   41 # needed for location management
   42 use Net::IP;
   43 use File::Path 'remove_tree';
   44 use File::stat;
   45 use Time::localtime;
   46 
   47 use constant IMPORT_EXPORT_WARNING => "The ability to import and export
   48 databases is still under development. It seems to work but it is <b>VERY</b>
   49 slow on large courses.  You may prefer to use webwork2/bin/wwdb  or the mysql
   50 dump facility for archiving large courses. Please send bug reports if you find
   51 errors.";
   52 
   53 sub pre_header_initialize {
   54   my ($self) = @_;
   55   my $r = $self->r;
   56   my $ce = $r->ce;
   57   my $db = $r->db;
   58   my $authz = $r->authz;
   59   my $urlpath = $r->urlpath;
   60   my $user        = $r->param('user');
   61 
   62   # check permissions
   63   unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
   64     $self->addmessage( CGI::div({class=>'ResultsWithError'},"$user is not authorized to create or delete courses") );
   65     return;
   66   }
   67 
   68   # get result and send to message
   69   my $status_message = $r->param("status_message");
   70   $self->addmessage(CGI::p("$status_message")) if $status_message;
   71 
   72 
   73     # Check that the non-native tables are present in the database
   74     # These are the tables which are not course specific
   75 
   76     my $table_update_result = initNonNativeTables($ce, $ce->{dbLayoutName});
   77 
   78     $self->addgoodmessage(CGI::p("$table_update_result")) if $table_update_result;
   79 
   80 
   81   ## if the user is asking for the downloaded database...
   82   #if (defined $r->param("download_exported_database")) {
   83   # my $courseID = $r->param("export_courseID");
   84   # my $random_chars = $r->param("download_exported_database");
   85   #
   86   # die "courseID not specified" unless defined $courseID;
   87   # die "invalid file specification" unless $random_chars =~ m/^\w+$/;
   88   #
   89   # my $tempdir = $ce->{webworkDirs}->{tmp};
   90   # my $export_file = "$tempdir/db_export_$random_chars";
   91   #
   92   # $self->reply_with_file("application/xml", $export_file, "${courseID}_database.xml", 0);
   93   #
   94   # return "";
   95   #}
   96   #
   97   ## otherwise...
   98 
   99   my @errors;
  100   my $method_to_call;
  101 
  102   my $subDisplay = $r->param("subDisplay");
  103   if (defined $subDisplay) {
  104 
  105     if ($subDisplay eq "add_course") {
  106       if (defined $r->param("add_course")) {
  107         @errors = $self->add_course_validate;
  108         if (@errors) {
  109           $method_to_call = "add_course_form";
  110         } else {
  111           $method_to_call = "do_add_course";
  112         }
  113       } else {
  114         $method_to_call = "add_course_form";
  115       }
  116     }
  117 
  118     elsif ($subDisplay eq "rename_course") {
  119       if (defined $r->param("rename_course")) {
  120         @errors = $self->rename_course_validate;
  121         if (@errors) {
  122           $method_to_call = "rename_course_form";
  123         } else {
  124           $method_to_call = "rename_course_confirm";
  125         }
  126       } elsif (defined $r->param("confirm_rename_course")) {
  127         # validate and delete
  128         @errors = $self->rename_course_validate;
  129         if (@errors) {
  130           $method_to_call = "rename_course_form";
  131         } else {
  132           $method_to_call = "do_rename_course";
  133         }
  134       } elsif (defined $r->param("upgrade_course_tables") ){
  135           # upgrade and revalidate
  136           @errors = $self->rename_course_validate;
  137         if (@errors) {
  138           $method_to_call = "rename_course_form";
  139         } else {
  140           $method_to_call = "rename_course_confirm";
  141         }
  142 
  143       } else {
  144         $method_to_call = "rename_course_form";
  145       }
  146     }
  147 
  148     elsif ($subDisplay eq "delete_course") {
  149       if (defined $r->param("delete_course")) {
  150         # validate or confirm
  151         @errors = $self->delete_course_validate;
  152         if (@errors) {
  153           $method_to_call = "delete_course_form";
  154         } else {
  155           $method_to_call = "delete_course_confirm";
  156         }
  157       } elsif (defined $r->param("confirm_delete_course")) {
  158         # validate and delete
  159         @errors = $self->delete_course_validate;
  160         if (@errors) {
  161           $method_to_call = "delete_course_form";
  162         } else {
  163           $method_to_call = "do_delete_course";
  164         }
  165       }
  166       elsif (defined ($r->param("delete_course_refresh"))) {
  167         $method_to_call = "delete_course_form";
  168       } else {
  169         # form only
  170         $method_to_call = "delete_course_form";
  171       }
  172     }
  173 
  174     elsif ($subDisplay eq "export_database") {
  175       if (defined $r->param("export_database")) {
  176         @errors = $self->export_database_validate;
  177         if (@errors) {
  178           $method_to_call = "export_database_form";
  179         } else {
  180           # we have to do something special here, since we're sending
  181           # the database as we export it. $method_to_call still gets
  182           # set here, but it gets caught by header() and content()
  183           # below instead of by body().
  184           $method_to_call = "do_export_database";
  185         }
  186       } else {
  187         $method_to_call = "export_database_form";
  188       }
  189     }
  190 
  191     elsif ($subDisplay eq "import_database") {
  192       if (defined $r->param("import_database")) {
  193         @errors = $self->import_database_validate;
  194         if (@errors) {
  195           $method_to_call = "import_database_form";
  196         } else {
  197           $method_to_call = "do_import_database";
  198         }
  199       } else {
  200         $method_to_call = "import_database_form";
  201       }
  202     }
  203 
  204     elsif ($subDisplay eq "archive_course") {
  205       if (defined $r->param("archive_course")) {
  206         # validate -- if invalid, start over.
  207         # if form is valid a page indicating the status of
  208         # database tables and directories is presented.
  209         # If they are ok, then you can push archive button, otherwise
  210         # you can quit or choose to upgrade the tables
  211         @errors = $self->archive_course_validate;
  212         if (@errors) {
  213           $method_to_call = "archive_course_form";
  214         } else {
  215           $method_to_call = "archive_course_confirm"; #check tables & directories
  216         }
  217       } elsif (defined $r->param("confirm_archive_course")) {
  218         # validate and archive
  219         # the "archive it" button has been pushed and the
  220         # course will be archived
  221         # a report on success or failure will be generated
  222         @errors = $self->archive_course_validate;
  223         if (@errors) {
  224           $method_to_call = "archive_course_form";
  225         } else {
  226           $method_to_call = "do_archive_course";
  227         }
  228       } elsif (defined $r->param("upgrade_course_tables") ){
  229           # upgrade and revalidate
  230           # the "upgrade course" button has been pushed
  231           # after the course has been upgraded you are returned
  232           # to the confirm page.
  233           @errors = $self->archive_course_validate;
  234         if (@errors) {
  235           $method_to_call = "archive_course_form";
  236         } else {
  237           $method_to_call = "archive_course_confirm"; # upgrade and recheck tables & directories.
  238         }
  239       }
  240       elsif (defined ($r->param("archive_course_refresh"))) {
  241         $method_to_call = "archive_course_form";
  242       } else {
  243         # form only
  244         $method_to_call = "archive_course_form";
  245       }
  246     }
  247     elsif ($subDisplay eq "unarchive_course") {
  248       if (defined $r->param("unarchive_course")) {
  249         # validate or confirm
  250         @errors = $self->unarchive_course_validate;
  251         if (@errors) {
  252           $method_to_call = "unarchive_course_form";
  253         } else {
  254           $method_to_call = "unarchive_course_confirm";
  255         }
  256       } elsif (defined $r->param("confirm_unarchive_course")) {
  257         # validate and archive
  258         @errors = $self->unarchive_course_validate;
  259         if (@errors) {
  260           $method_to_call = "unarchive_course_form";
  261         } else {
  262           $method_to_call = "do_unarchive_course";
  263         }
  264       } else {
  265         # form only
  266         # start at the beginning -- get drop down list of courses to unarchive
  267         $method_to_call = "unarchive_course_form";
  268       }
  269     }
  270     elsif ($subDisplay eq "upgrade_course") {
  271       if (defined $r->param("upgrade_course")) {
  272         # validate or confirm
  273         # if form is valid present details of analysis of the course structure
  274         @errors = $self->upgrade_course_validate;
  275         if (@errors) {
  276           $method_to_call = "upgrade_course_form";
  277         } else {
  278           $method_to_call = "upgrade_course_confirm";
  279         }
  280       } elsif (defined $r->param("confirm_upgrade_course")) {
  281         # validate and upgrade
  282         # if form is valid upgrade the courses and present results
  283         @errors = $self->upgrade_course_validate;
  284         if (@errors) {
  285           $method_to_call = "upgrade_course_form";
  286         } else {
  287           $method_to_call = "do_upgrade_course";
  288         }
  289       } else {
  290         # form only
  291         # start at the beginning -- get list of courses and their status
  292         $method_to_call = "upgrade_course_form";
  293       }
  294     }
  295     elsif ($subDisplay eq "manage_locations") {
  296       if (defined ($r->param("manage_location_action"))) {
  297         $method_to_call =
  298             $r->param("manage_location_action");
  299       }
  300       else{
  301         $method_to_call = "manage_location_form";
  302       }
  303     }
  304     elsif ($subDisplay eq "hide_inactive_course") {
  305 #     warn "subDisplay is $subDisplay";
  306       if (defined ($r->param("hide_course"))) {
  307         @errors = $self->hide_course_validate;
  308         if (@errors) {
  309           $method_to_call = "hide_inactive_course_form";
  310         } else {
  311         $method_to_call = "do_hide_inactive_course";
  312         }
  313       }
  314       elsif (defined ($r->param("unhide_course"))) {
  315         @errors = $self->unhide_course_validate;
  316         if (@errors) {
  317           $method_to_call = "hide_inactive_course_form";
  318         } else {
  319         $method_to_call = "do_unhide_inactive_course";
  320         }
  321       }
  322       elsif (defined ($r->param("hide_course_refresh"))) {
  323         $method_to_call = "hide_inactive_course_form";
  324       }
  325       else{
  326         $method_to_call = "hide_inactive_course_form";
  327       }
  328     }
  329     elsif ($subDisplay eq "registration") {
  330       if (defined ($r->param("register_site"))) {
  331         $method_to_call =  "do_registration";
  332       }
  333       else{
  334         $method_to_call = "registration_form";
  335       }
  336     }
  337     else {
  338       @errors = "Unrecognized sub-display @{[ CGI::b($subDisplay) ]}.";
  339     }
  340   }
  341 
  342   $self->{errors} = \@errors;
  343   $self->{method_to_call} = $method_to_call;
  344 }
  345 
  346 sub header {
  347   my ($self) = @_;
  348   my $method_to_call = $self->{method_to_call};
  349 #   if (defined $method_to_call and $method_to_call eq "do_export_database") {
  350 #     my $r = $self->r;
  351 #     my $courseID = $r->param("export_courseID");
  352 #     $r->content_type("application/octet-stream");
  353 #     $r->header_out("Content-Disposition" => "attachment; filename=\"${courseID}_database.xml\"");
  354 #     $r->send_http_header;
  355 #   } else {
  356     $self->SUPER::header;
  357 # }
  358 }
  359 
  360 # sends:
  361 #
  362 # HTTP/1.1 200 OK
  363 # Date: Fri, 09 Jul 2004 19:05:55 GMT
  364 # Server: Apache/1.3.27 (Unix) mod_perl/1.27
  365 # Content-Disposition: attachment; filename="mth143_database.xml"
  366 # Connection: close
  367 # Content-Type: application/octet-stream
  368 
  369 sub content {
  370   my ($self) = @_;
  371   my $method_to_call = $self->{method_to_call};
  372   if (defined $method_to_call and $method_to_call eq "do_export_database") {
  373     #$self->do_export_database;
  374     $self->SUPER::content;
  375   } else {
  376     $self->SUPER::content;
  377   }
  378 }
  379 
  380 sub body {
  381   my ($self) = @_;
  382   my $r = $self->r;
  383   my $ce = $r->ce;
  384   my $db = $r->db;
  385   my $authz = $r->authz;
  386   my $urlpath = $r->urlpath;
  387 
  388   my $user = $r->param('user');
  389 
  390   # check permissions
  391   unless ($authz->hasPermissions($user, "create_and_delete_courses")) {
  392     return "";
  393   }
  394   my $method_to_call = $self->{method_to_call};
  395   my $methodMessage ="";
  396 
  397   (defined($method_to_call) and $method_to_call eq "do_export_database") && do {
  398       my @export_courseID = $r->param("export_courseID");
  399       my $course_ids = join(", ", @export_courseID);
  400     $methodMessage  = CGI::p("Exporting database for course(s) $course_ids").
  401     CGI::p(".... please wait....
  402     If your browser times out you will
  403     still be able to download the exported database using the
  404     file manager.").CGI::hr();
  405   };
  406 
  407 
  408   print CGI::p({style=>"text-align: center"},
  409     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"add_course",add_admin_users=>1,
  410                add_dbLayout=>'sql_single',
  411                add_templates_course => $ce->{siteDefaults}->{default_templates_course} ||""}
  412                )},
  413                "Add Course"
  414     ),
  415     " | ",
  416     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"rename_course"})}, "Rename Course"),
  417     " | ",
  418     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"delete_course"})}, "Delete Course"),
  419     " | ",
  420     # CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"export_database"})}, "Export Database"),
  421     # " | ",
  422     # CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"import_database"})}, "Import Database"),
  423     # " | ",
  424     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"archive_course"})}, "Archive Course"),
  425      "|",
  426     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"unarchive_course"})}, "Unarchive Course"),
  427      "|",
  428     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"upgrade_course"})}, "Upgrade courses"),
  429      "|",
  430     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"manage_locations"})}, "Manage Locations"),
  431      "|",
  432     CGI::a({href=>$self->systemLink($urlpath, params=>{subDisplay=>"hide_inactive_course"})}, "Hide Inactive courses"),
  433     CGI::hr(),
  434     $methodMessage,
  435 
  436   );
  437 
  438   print( CGI::p({style=>"text-align: center"}, $self->display_registration_form() ) ) if $self->display_registration_form();
  439 
  440 
  441   my @errors = @{$self->{errors}};
  442 
  443 
  444   if (@errors) {
  445     print CGI::div({class=>"ResultsWithError"},
  446       CGI::p("Please correct the following errors and try again:"),
  447       CGI::ul(CGI::li(\@errors)),
  448     );
  449   }
  450 
  451   if (defined $method_to_call and $method_to_call ne "") {
  452     $self->$method_to_call;
  453   } else {
  454         my $msg = "";
  455         $msg .= CGI::li("unable to write to directory $ce->{webworkDirs}{logs}")  unless -w $ce->{webworkDirs}{logs};
  456         $msg .=  CGI::li("unable to write to directory $ce->{webworkDirs}{tmp}" )  unless -w $ce->{webworkDirs}{tmp};
  457         $msg .=  CGI::li("unable to write to directory $ce->{webworkDirs}{DATA}")  unless -w $ce->{webworkDirs}{DATA};
  458         if ($msg) {
  459         print CGI::h2("Directory permission errors ").CGI::ul($msg).
  460         CGI::p(" The webwork server must be able to write to these directories. Please correct the permssion errors.") ;
  461       }
  462 
  463     print CGI::h2("Courses");
  464 
  465     print CGI::start_ol();
  466 
  467     my @courseIDs = listCourses($ce);
  468     foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
  469       next if $courseID eq "admin"; # done already above
  470       next if $courseID eq "modelCourse"; # modelCourse isn't a real course so don't create missing directories, etc
  471       my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID);
  472       print CGI::li(CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID));
  473     }
  474 
  475     print CGI::end_ol();
  476 
  477     print CGI::h2("Archived Courses");
  478     print CGI::start_ol();
  479 
  480     @courseIDs = listArchivedCourses($ce);
  481     foreach my $courseID (sort {lc($a) cmp lc($b) } @courseIDs) {
  482       print CGI::li($courseID),
  483     }
  484 
  485     print CGI::end_ol();
  486   }
  487   return "";
  488 }
  489 
  490 ################################################################################
  491 
  492 sub add_course_form {
  493   my ($self) = @_;
  494   my $r = $self->r;
  495   my $ce = $r->ce;
  496   #my $db = $r->db;
  497   #my $authz = $r->authz;
  498   #my $urlpath = $r->urlpath;
  499 
  500   my $add_courseID                     = trim_spaces( $r->param("add_courseID") ) || "";
  501   my $add_courseTitle                  = trim_spaces( $r->param("add_courseTitle") ) || "";
  502   my $add_courseInstitution            = trim_spaces( $r->param("add_courseInstitution") ) || "";
  503 
  504   my $add_admin_users                  = trim_spaces( $r->param("add_admin_users") ) || "";
  505 
  506   my $add_initial_userID               = trim_spaces( $r->param("add_initial_userID") ) || "";
  507   my $add_initial_password             = trim_spaces( $r->param("add_initial_password") ) || "";
  508   my $add_initial_confirmPassword      = trim_spaces( $r->param("add_initial_confirmPassword") ) || "";
  509   my $add_initial_firstName            = trim_spaces( $r->param("add_initial_firstName") ) || "";
  510   my $add_initial_lastName             = trim_spaces( $r->param("add_initial_lastName") ) || "";
  511   my $add_initial_email                = trim_spaces( $r->param("add_initial_email") ) || "";
  512 
  513   my $add_templates_course             = trim_spaces( $r->param("add_templates_course") ) || "";
  514 
  515   my $add_dbLayout                     = trim_spaces( $r->param("add_dbLayout") ) || "";
  516 
  517 
  518 
  519 
  520   my @dbLayouts = do {
  521     my @ordered_layouts;
  522     foreach my $layout (@{$ce->{dbLayout_order}}) {
  523       if (exists $ce->{dbLayouts}->{$layout}) {
  524         push @ordered_layouts, $layout;
  525       }
  526     }
  527 
  528     my %ordered_layouts; @ordered_layouts{@ordered_layouts} = ();
  529     my @other_layouts;
  530     foreach my $layout (keys %{ $ce->{dbLayouts} }) {
  531       unless (exists $ordered_layouts{$layout}) {
  532         push @other_layouts, $layout;
  533       }
  534     }
  535 
  536     (@ordered_layouts, @other_layouts);
  537   };
  538 
  539   # unused...
  540   #my $ce2 = new WeBWorK::CourseEnvironment({
  541   # %WeBWorK::SeedCE,
  542   # courseName => "COURSENAME",
  543   #});
  544 
  545   my @existingCourses = listCourses($ce);
  546   @existingCourses = sort { lc($a) cmp lc ($b) } @existingCourses; #make sort case insensitive
  547 
  548   print CGI::h2("Add Course");
  549 
  550   print CGI::start_form(-method=>"POST", -action=>$r->uri);
  551   print $self->hidden_authen_fields;
  552   print $self->hidden_fields("subDisplay");
  553 
  554   print CGI::p("Specify an ID, title, and institution for the new course. The course ID may contain only letters, numbers, hyphens, and underscores.");
  555 
  556   print CGI::table({class=>"FormLayout"},
  557     CGI::Tr({},
  558       CGI::th({class=>"LeftHeader"}, "Course ID:"),
  559       CGI::td(CGI::textfield(-name=>"add_courseID", -value=>$add_courseID, -size=>25)),
  560     ),
  561     CGI::Tr({},
  562       CGI::th({class=>"LeftHeader"}, "Course Title:"),
  563       CGI::td(CGI::textfield(-name=>"add_courseTitle", -value=>$add_courseTitle, -size=>25)),
  564     ),
  565     CGI::Tr({},
  566       CGI::th({class=>"LeftHeader"}, "Institution:"),
  567       CGI::td(CGI::textfield(-name=>"add_courseInstitution", -value=>$add_courseInstitution, -size=>25)),
  568     ),
  569   );
  570 
  571   print CGI::p("To add the WeBWorK administrators to the new course (as instructors) check the box below.");
  572   my @checked = ($add_admin_users) ?(checked=>1): ();  # workaround because CGI::checkbox seems to have a bug -- it won't default to checked.
  573   print CGI::p({},CGI::input({-type=>'checkbox', -name=>"add_admin_users", @checked }, "Add WeBWorK administrators to new course"));
  574 
  575   print CGI::p("To add an additional instructor to the new course, specify user information below. The user ID may contain only
  576   numbers, letters, hyphens, periods (dots), commas,and underscores.\n");
  577 
  578   print CGI::table({class=>"FormLayout"}, CGI::Tr({},
  579     CGI::td({},
  580       CGI::table({class=>"FormLayout"},
  581         CGI::Tr({},
  582           CGI::th({class=>"LeftHeader"}, "User ID:"),
  583           CGI::td(CGI::textfield(-name=>"add_initial_userID", -value=>$add_initial_userID, -size=>25)),
  584         ),
  585         CGI::Tr({},
  586           CGI::th({class=>"LeftHeader"}, "Password:"),
  587           CGI::td(CGI::password_field(-name=>"add_initial_password", -value=>$add_initial_password, -size=>25)),
  588         ),
  589         CGI::Tr({},
  590           CGI::th({class=>"LeftHeader"}, "Confirm Password:"),
  591           CGI::td(CGI::password_field(-name=>"add_initial_confirmPassword", -value=>$add_initial_confirmPassword, -size=>25)),
  592         ),
  593       ),
  594     ),
  595     CGI::td({},
  596       CGI::table({class=>"FormLayout"},
  597         CGI::Tr({},
  598           CGI::th({class=>"LeftHeader"}, "First Name:"),
  599           CGI::td(CGI::textfield(-name=>"add_initial_firstName", -value=>$add_initial_firstName, -size=>25)),
  600         ),
  601         CGI::Tr({},
  602           CGI::th({class=>"LeftHeader"}, "Last Name:"),
  603           CGI::td(CGI::textfield(-name=>"add_initial_lastName", -value=>$add_initial_lastName, -size=>25)),
  604         ),
  605         CGI::Tr({},
  606           CGI::th({class=>"LeftHeader"}, "Email Address:"),
  607           CGI::td(CGI::textfield(-name=>"add_initial_email", -value=>$add_initial_email, -size=>25)),
  608         ),
  609       ),
  610 
  611     ),
  612   ));
  613 
  614   print CGI::p("To copy problem templates from an existing course, select the course below.");
  615 
  616   print CGI::table({class=>"FormLayout"},
  617     CGI::Tr({},
  618       CGI::th({class=>"LeftHeader"}, "Copy templates from:"),
  619       CGI::td(
  620         CGI::popup_menu(
  621           -name => "add_templates_course",
  622           -values => [ "", @existingCourses ],
  623           -default => $add_templates_course,
  624           #-size => 10,
  625           #-multiple => 0,
  626           #-labels => \%courseLabels,
  627         ),
  628 
  629       ),
  630     ),
  631   );
  632 
  633 
  634 
  635   print CGI::p("Select a database layout below.");
  636   print CGI::start_table({class=>"FormLayout"});
  637 
  638   my %dbLayout_buttons;
  639   my $selected_dbLayout = defined $add_dbLayout ? $add_dbLayout : $ce->{dbLayout_order}[0];
  640   @dbLayout_buttons{@dbLayouts} = CGI::radio_group(-name=>"add_dbLayout",-values=>\@dbLayouts,-default=>$selected_dbLayout);
  641   foreach my $dbLayout (@dbLayouts) {
  642     my $dbLayoutLabel = (defined $ce->{dbLayout_descr}{$dbLayout})
  643       ? "$dbLayout - " . $ce->{dbLayout_descr}{$dbLayout}
  644       : "$dbLayout - no description provided in global.conf";
  645     print CGI::Tr({},
  646       CGI::td({width=>'20%'}, $dbLayout_buttons{$dbLayout}),
  647       CGI::td($dbLayoutLabel),
  648     );
  649   }
  650   print CGI::end_table();
  651   print CGI::p({style=>"text-align: left"}, CGI::submit(-name=>"add_course", -label=>"Add Course"));
  652 
  653   print CGI::end_form();
  654 }
  655 
  656 sub add_course_validate {
  657   my ($self) = @_;
  658   my $r = $self->r;
  659   my $ce = $r->ce;
  660   #my $db = $r->db;
  661   #my $authz = $r->authz;
  662   #my $urlpath = $r->urlpath;
  663 
  664 
  665   my $add_courseID                     = trim_spaces( $r->param("add_courseID") ) || "";
  666   my $add_courseTitle                  = trim_spaces( $r->param("add_courseTitle") ) || "";
  667   my $add_courseInstitution            = trim_spaces( $r->param("add_courseInstitution") ) || "";
  668 
  669   my $add_admin_users                  = trim_spaces( $r->param("add_admin_users") ) || "";
  670 
  671   my $add_initial_userID               = trim_spaces( $r->param("add_initial_userID") ) || "";
  672   my $add_initial_password             = trim_spaces( $r->param("add_initial_password") ) || "";
  673   my $add_initial_confirmPassword      = trim_spaces( $r->param("add_initial_confirmPassword") ) || "";
  674   my $add_initial_firstName            = trim_spaces( $r->param("add_initial_firstName") ) || "";
  675   my $add_initial_lastName             = trim_spaces( $r->param("add_initial_lastName") ) || "";
  676   my $add_initial_email                = trim_spaces( $r->param("add_initial_email") ) || "";
  677   my $add_templates_course             = trim_spaces( $r->param("add_templates_course") ) || "";
  678   my $add_dbLayout                     = trim_spaces( $r->param("add_dbLayout") ) || "";
  679 
  680 
  681 
  682 
  683   ######################
  684 
  685   my @errors;
  686 
  687   if ($add_courseID eq "") {
  688     push @errors, "You must specify a course ID.";
  689   }
  690   unless ($add_courseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
  691     push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
  692   }
  693   if (grep { $add_courseID eq $_ } listCourses($ce)) {
  694     push @errors, "A course with ID $add_courseID already exists.";
  695   }
  696   #if ($add_courseTitle eq "") {
  697   # push @errors, "You must specify a course title.";
  698   #}
  699   #if ($add_courseInstitution eq "") {
  700   # push @errors, "You must specify an institution for this course.";
  701   #}
  702 
  703   if ($add_initial_userID ne "") {
  704     if ($add_initial_password eq "") {
  705       push @errors, "You must specify a password for the initial instructor.";
  706     }
  707     if ($add_initial_confirmPassword eq "") {
  708       push @errors, "You must confirm the password for the initial instructor.";
  709     }
  710     if ($add_initial_password ne $add_initial_confirmPassword) {
  711       push @errors, "The password and password confirmation for the instructor must match.";
  712     }
  713     if ($add_initial_firstName eq "") {
  714       push @errors, "You must specify a first name for the initial instructor.";
  715     }
  716     if ($add_initial_lastName eq "") {
  717       push @errors, "You must specify a last name for the initial instructor.";
  718     }
  719     if ($add_initial_email eq "") {
  720       push @errors, "You must specify an email address for the initial instructor.";
  721     }
  722   }
  723 
  724   if ($add_dbLayout eq "") {
  725     push @errors, "You must select a database layout.";
  726   } else {
  727     if (exists $ce->{dbLayouts}->{$add_dbLayout}) {
  728       # we used to check for layout-specific fields here, but there aren't any layouts that require them
  729       # anymore. (in the future, we'll probably deal with this in layout-specific modules.)
  730     } else {
  731       push @errors, "The database layout $add_dbLayout doesn't exist.";
  732     }
  733   }
  734 
  735   return @errors;
  736 }
  737 
  738 sub do_add_course {
  739   my ($self) = @_;
  740   my $r = $self->r;
  741   my $ce = $r->ce;
  742   my $db = $r->db;
  743   my $authz = $r->authz;
  744   my $urlpath = $r->urlpath;
  745 
  746   my $add_courseID                     = trim_spaces( $r->param("add_courseID") ) || "";
  747   my $add_courseTitle                  = trim_spaces( $r->param("add_courseTitle") ) || "";
  748   my $add_courseInstitution            = trim_spaces( $r->param("add_courseInstitution") ) || "";
  749 
  750   my $add_admin_users                  = trim_spaces( $r->param("add_admin_users") ) || "";
  751 
  752   my $add_initial_userID               = trim_spaces( $r->param("add_initial_userID") ) || "";
  753   my $add_initial_password             = trim_spaces( $r->param("add_initial_password") ) || "";
  754   my $add_initial_confirmPassword      = trim_spaces( $r->param("add_initial_confirmPassword") ) || "";
  755   my $add_initial_firstName            = trim_spaces( $r->param("add_initial_firstName") ) || "";
  756   my $add_initial_lastName             = trim_spaces( $r->param("add_initial_lastName") ) || "";
  757   my $add_initial_email                = trim_spaces( $r->param("add_initial_email") ) || "";
  758 
  759   my $add_templates_course             = trim_spaces( $r->param("add_templates_course") ) || "";
  760 
  761   my $add_dbLayout                     = trim_spaces( $r->param("add_dbLayout") ) || "";
  762 
  763   my $ce2 = new WeBWorK::CourseEnvironment({
  764     %WeBWorK::SeedCE,
  765     courseName => $add_courseID,
  766   });
  767 
  768   my %courseOptions = ( dbLayoutName => $add_dbLayout );
  769 
  770   if ($add_initial_email ne "") {
  771     $courseOptions{allowedRecipients} = [ $add_initial_email ];
  772     # don't set feedbackRecipients -- this just gets in the way of the more
  773     # intelligent "receive_recipients" method.
  774     #$courseOptions{feedbackRecipients} = [ $add_initial_email ];
  775   }
  776 
  777   # this is kinda left over from when we had 'gdbm' and 'sql' database layouts
  778   # below this line, we would grab values from getopt and put them in this hash
  779   # but for now the hash can remain empty
  780   my %dbOptions;
  781 
  782   my @users;
  783 
  784   # copy users from current (admin) course if desired
  785   if ($add_admin_users ne "") {
  786     foreach my $userID ($db->listUsers) {
  787       if ($userID eq $add_initial_userID) {
  788         $self->addbadmessage( "User '$userID' will not be copied from admin course as it is the initial instructor.");
  789         next;
  790       }
  791       my $User            = $db->getUser($userID);
  792       my $Password        = $db->getPassword($userID);
  793       my $PermissionLevel = $db->getPermissionLevel($userID);
  794       push @users, [ $User, $Password, $PermissionLevel ]
  795              if $authz->hasPermissions($userID,"create_and_delete_courses");
  796              #only transfer the "instructors" in the admin course classlist.
  797     }
  798   }
  799 
  800   # add initial instructor if desired
  801   if ($add_initial_userID ne "") {
  802     my $User = $db->newUser(
  803       user_id       => $add_initial_userID,
  804       first_name    => $add_initial_firstName,
  805       last_name     => $add_initial_lastName,
  806       student_id    => $add_initial_userID,
  807       email_address => $add_initial_email,
  808       status        => "C",
  809     );
  810     my $Password = $db->newPassword(
  811       user_id  => $add_initial_userID,
  812       password => cryptPassword($add_initial_password),
  813     );
  814     my $PermissionLevel = $db->newPermissionLevel(
  815       user_id    => $add_initial_userID,
  816       permission => "10",
  817     );
  818     push @users, [ $User, $Password, $PermissionLevel ];
  819   }
  820 
  821   push @{$courseOptions{PRINT_FILE_NAMES_FOR}}, map { $_->[0]->user_id } @users;
  822 
  823   my %optional_arguments;
  824   if ($add_templates_course ne "") {
  825     $optional_arguments{templatesFrom} = $add_templates_course;
  826   }
  827 
  828   eval {
  829     addCourse(
  830       courseID      => $add_courseID,
  831       ce            => $ce2,
  832       courseOptions => \%courseOptions,
  833       dbOptions     => \%dbOptions,
  834       users         => \@users,
  835       %optional_arguments,
  836     );
  837   };
  838   if ($@) {
  839     my $error = $@;
  840     print CGI::div({class=>"ResultsWithError"},
  841       CGI::p("An error occured while creating the course $add_courseID:"),
  842       CGI::tt(CGI::escapeHTML($error)),
  843     );
  844     # get rid of any partially built courses
  845     # FIXME  -- this is too fragile
  846     unless ($error =~ /course exists/) {
  847       eval {
  848         deleteCourse(
  849           courseID   => $add_courseID,
  850           ce         => $ce2,
  851           dbOptions  => \%dbOptions,
  852         );
  853       }
  854     }
  855   } else {
  856       #log the action
  857       writeLog($ce, "hosted_courses", join("\t",
  858         "\tAdded",
  859         ( defined $add_courseInstitution ? $add_courseInstitution : "(no institution specified)" ),
  860         ( defined $add_courseTitle ? $add_courseTitle : "(no title specified)" ),
  861         $add_courseID,
  862         $add_initial_firstName,
  863         $add_initial_lastName,
  864         $add_initial_email,
  865       ));
  866       # add contact to admin course as student?
  867       # FIXME -- should we do this?
  868       if ($add_initial_userID ne "") {
  869           my $composite_id = "${add_initial_userID}_${add_courseID}"; # student id includes school name and contact
  870       my $User = $db->newUser(
  871       user_id       => $composite_id,          # student id includes school name and contact
  872       first_name    => $add_initial_firstName,
  873       last_name     => $add_initial_lastName,
  874       student_id    => $add_initial_userID,
  875       email_address => $add_initial_email,
  876       status        => "C",
  877       );
  878       my $Password = $db->newPassword(
  879         user_id  => $composite_id,
  880         password => cryptPassword($add_initial_password),
  881       );
  882       my $PermissionLevel = $db->newPermissionLevel(
  883         user_id    => $composite_id,
  884         permission => "0",
  885       );
  886       # add contact to admin course as student
  887       # or if this contact and course already exist in a dropped status
  888       # change the student's status to enrolled
  889       if (my $oldUser = $db->getUser($composite_id) ) {
  890         warn "Replacing old data for $composite_id  status: ". $oldUser->status;
  891         $db->deleteUser($composite_id);
  892       }
  893       eval { $db->addUser($User)                       }; warn $@ if $@;
  894       eval { $db->addPassword($Password)               }; warn $@ if $@;
  895       eval { $db->addPermissionLevel($PermissionLevel) }; warn $@ if $@;
  896     }
  897     print CGI::div({class=>"ResultsWithoutError"},
  898       CGI::p("Successfully created the course $add_courseID"),
  899     );
  900     my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r,
  901       courseID => $add_courseID);
  902     my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
  903     print CGI::div({style=>"text-align: center"},
  904       CGI::a({href=>$newCourseURL}, "Log into $add_courseID"),
  905     );
  906   }
  907 
  908 
  909 }
  910 
  911 ################################################################################
  912 
  913 sub rename_course_form {
  914   my ($self) = @_;
  915   my $r = $self->r;
  916   my $ce = $r->ce;
  917   #my $db = $r->db;
  918   #my $authz = $r->authz;
  919   #my $urlpath = $r->urlpath;
  920 
  921   my $rename_oldCourseID     = $r->param("rename_oldCourseID")     || "";
  922   my $rename_newCourseID     = $r->param("rename_newCourseID")     || "";
  923 
  924   my @courseIDs = listCourses($ce);
  925   @courseIDs    = sort {lc($a) cmp lc ($b) } @courseIDs;
  926 
  927   my %courseLabels; # records... heh.
  928   foreach my $courseID (@courseIDs) {
  929 #   my $tempCE = new WeBWorK::CourseEnvironment({
  930 #     %WeBWorK::SeedCE,
  931 #     courseName => $courseID,
  932 #   });
  933 #   $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
  934     $courseLabels{$courseID} = "$courseID";
  935   }
  936 
  937   print CGI::h2("Rename Course");
  938 
  939   print CGI::start_form(-method=>"POST", -action=>$r->uri);
  940   print $self->hidden_authen_fields;
  941   print $self->hidden_fields("subDisplay");
  942 
  943   print CGI::p("Select a course to rename.");
  944 
  945   print CGI::table({class=>"FormLayout"},
  946     CGI::Tr({},
  947       CGI::th({class=>"LeftHeader"}, "Course Name:"),
  948       CGI::td(
  949         CGI::scrolling_list(
  950           -name => "rename_oldCourseID",
  951           -values => \@courseIDs,
  952           -default => $rename_oldCourseID,
  953           -size => 10,
  954           -multiple => 0,
  955           -labels => \%courseLabels,
  956         ),
  957       ),
  958     ),
  959     CGI::Tr({},
  960       CGI::th({class=>"LeftHeader"}, "New Name:"),
  961       CGI::td(CGI::textfield(-name=>"rename_newCourseID", -value=>$rename_newCourseID, -size=>25)),
  962     ),
  963   );
  964 
  965   print CGI::end_table();
  966 
  967   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"rename_course", -label=>"Rename Course"));
  968 
  969   print CGI::end_form();
  970 }
  971 sub rename_course_confirm {
  972 
  973     my ($self) = @_;
  974   my $r = $self->r;
  975   my $ce = $r->ce;
  976   #my $db = $r->db;
  977   #my $authz = $r->authz;
  978   #my $urlpath = $r->urlpath;
  979 
  980     my $rename_oldCourseID     = $r->param("rename_oldCourseID")     || "";
  981   my $rename_newCourseID     = $r->param("rename_newCourseID")     || "";
  982 
  983   my $ce2 = new WeBWorK::CourseEnvironment({
  984     %WeBWorK::SeedCE,
  985     courseName => $rename_oldCourseID,
  986   });
  987 #############################################################################
  988 # Check database
  989 #############################################################################
  990 
  991   my ($tables_ok,$dbStatus);
  992   if ($ce2->{dbLayoutName} ) {
  993        my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2);
  994       ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID);
  995     if ($r->param("upgrade_course_tables")) {
  996       my @schema_table_names = keys %$dbStatus;  # update tables missing from database;
  997       my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names;
  998       my @tables_to_alter  = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names;
  999       my $msg = $CIchecker->updateCourseTables($rename_oldCourseID, [@tables_to_create]);
 1000       foreach my $table_name (@tables_to_alter) {
 1001         $msg .= $CIchecker->updateTableFields($rename_oldCourseID, $table_name);
 1002       }
 1003       print CGI::p({-style=>'color:green; font-weight:bold'}, $msg);
 1004 
 1005     }
 1006     ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($rename_oldCourseID);
 1007 
 1008 
 1009     # print db status
 1010 
 1011     my %msg =(    WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A         => CGI::span({style=>"color:red"}," Table defined in schema but missing in database"),
 1012                   WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B         => CGI::span({style=>"color:red"}," Table defined in database but missing in schema"),
 1013                   WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B   => CGI::span({style=>"color:green"}," Table is ok "),
 1014                   WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database table definitions do not agree "),
 1015     );
 1016     my %msg2 =(    WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A        => CGI::span({style=>"color:red"}," missing in database"),
 1017                   WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B         => CGI::span({style=>"color:red"}," missing in schema"),
 1018                   WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B   => CGI::span({style=>"color:green"}," is ok "),
 1019                   WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database field definitions do not agree "),
 1020     );
 1021     my $all_tables_ok=1;
 1022     my $extra_database_tables=0;
 1023     my $extra_database_fields=0;
 1024     my $str=CGI::h4("Report on database structure for course $rename_oldCourseID:").CGI::br();
 1025     foreach my $table (sort keys %$dbStatus) {
 1026         my $table_status = $dbStatus->{$table}->[0];
 1027       $str .= CGI::b($table) .  $msg{ $table_status } . CGI::br();
 1028 
 1029       CASE: {
 1030         $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B
 1031           && do{ last CASE;
 1032           };
 1033         $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
 1034           && do{
 1035                $all_tables_ok = 0; last CASE;
 1036           };
 1037         $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
 1038           && do{
 1039                $extra_database_tables = 1; last CASE;
 1040           };
 1041         $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B
 1042           && do{
 1043               my %fieldInfo = %{ $dbStatus->{$table}->[1] };
 1044             foreach my $key (keys %fieldInfo) {
 1045                 my $field_status = $fieldInfo{$key}->[0];
 1046                 CASE2: {
 1047                   $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
 1048                     && do{
 1049                        $extra_database_fields = 1; last CASE2;
 1050                     };
 1051                   $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
 1052                     && do{
 1053                        $all_tables_ok=0; last CASE2;
 1054                     };
 1055                 }
 1056               $str .= CGI::br()."\n&nbsp;&nbsp;Field $key => ". $msg2{$field_status };
 1057             }
 1058           };
 1059       }
 1060       $str.=CGI::br();
 1061 
 1062     }
 1063 #############################################################################
 1064 # Report on databases
 1065 #############################################################################
 1066 
 1067     print CGI::p($str);
 1068     if ($extra_database_tables) {
 1069         print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema.
 1070                                                              They can only be removed manually from the database. They will not be renamed.");
 1071     }
 1072     if ($extra_database_fields) {
 1073         print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields  which are not defined in the schema for at least one table.
 1074                                                              They can only be removed manually from the database.");
 1075     }
 1076     if ($all_tables_ok) {
 1077       print CGI::p({-style=>'color:green; font-weight:bold'},"Course $rename_oldCourseID database is in order");
 1078     } else {
 1079       print CGI::p({-style=>'color:red; font-weight:bold'}, "Course $rename_oldCourseID databases must be updated before renaming this course.");
 1080     }
 1081 
 1082 #############################################################################
 1083 # Check directories
 1084 #############################################################################
 1085 
 1086 
 1087       my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories($ce2);
 1088       my $style = ($directories_ok)?"color:green" : "color:red";
 1089       print CGI::h2("Directory structure"), CGI::p($str2),
 1090       ($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") :
 1091               CGI::p({style=>$style},"Directory structure is missing directories
 1092                           or the webserver lacks sufficient privileges.");
 1093 
 1094 #############################################################################
 1095 # Print form for choosing next action.
 1096 #############################################################################
 1097 
 1098 
 1099 
 1100     print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1101     print $self->hidden_authen_fields;
 1102     print $self->hidden_fields("subDisplay");
 1103     print $self->hidden_fields(qw/rename_oldCourseID rename_newCourseID/);
 1104       # grab some values we'll need
 1105         # fail if the source course does not exist
 1106 
 1107 
 1108 
 1109     if ($all_tables_ok && $directories_ok ) { # no missing tables or missing fields or directories
 1110       print CGI::p({style=>"text-align: center"},
 1111         CGI::submit(-name=>"decline_rename_course", -value=>"Don't rename"),
 1112         "&nbsp;",
 1113         CGI::submit(-name=>"confirm_rename_course", -value=>"Rename") ,
 1114       );
 1115     } elsif(  $directories_ok  ) {
 1116       print CGI::p({style=>"text-align: center"},
 1117         CGI::submit(-name => "decline_rename_course", -value => "Don't rename"),
 1118         "&nbsp;",
 1119         CGI::submit(-name=>"upgrade_course_tables", -value=>"upgrade course tables"),
 1120       );
 1121     } else  {
 1122       print CGI::p({style=>"text-align: center"},
 1123         CGI::submit(-name => "decline_rename_course", -value => "Don't rename"),
 1124         CGI::br(),"Directory structure needs to be repaired manually before renaming."
 1125       );
 1126     }
 1127   }
 1128 }
 1129 sub rename_course_validate {
 1130   my ($self) = @_;
 1131   my $r = $self->r;
 1132   my $ce = $r->ce;
 1133   #my $db = $r->db;
 1134   #my $authz = $r->authz;
 1135   #my $urlpath = $r->urlpath;
 1136 
 1137   my $rename_oldCourseID     = $r->param("rename_oldCourseID")     || "";
 1138   my $rename_newCourseID     = $r->param("rename_newCourseID")     || "";
 1139 
 1140   my @errors;
 1141 
 1142   if ($rename_oldCourseID eq "") {
 1143     push @errors, "You must select a course to rename.";
 1144   }
 1145   if ($rename_newCourseID eq "") {
 1146     push @errors, "You must specify a new name for the course.";
 1147   }
 1148   if ($rename_oldCourseID eq $rename_newCourseID) {
 1149     push @errors, "Can't rename to the same name.";
 1150   }
 1151   unless ($rename_newCourseID =~ /^[\w-]*$/) { # regex copied from CourseAdministration.pm
 1152     push @errors, "Course ID may only contain letters, numbers, hyphens, and underscores.";
 1153   }
 1154   if (grep { $rename_newCourseID eq $_ } listCourses($ce)) {
 1155     push @errors, "A course with ID $rename_newCourseID already exists.";
 1156   }
 1157 
 1158   my $ce2 = new WeBWorK::CourseEnvironment({
 1159     %WeBWorK::SeedCE,
 1160     courseName => $rename_oldCourseID,
 1161   });
 1162 
 1163   return @errors;
 1164 }
 1165 
 1166 sub do_rename_course {
 1167   my ($self) = @_;
 1168   my $r = $self->r;
 1169   my $ce = $r->ce;
 1170   my $db = $r->db;
 1171   #my $authz = $r->authz;
 1172   my $urlpath = $r->urlpath;
 1173 
 1174   my $rename_oldCourseID     = $r->param("rename_oldCourseID")     || "";
 1175   my $rename_newCourseID     = $r->param("rename_newCourseID")     || "";
 1176 
 1177   my $ce2 = new WeBWorK::CourseEnvironment({
 1178     %WeBWorK::SeedCE,
 1179     courseName => $rename_oldCourseID,
 1180   });
 1181 
 1182   my $dbLayoutName = $ce->{dbLayoutName};
 1183 
 1184   # this is kinda left over from when we had 'gdbm' and 'sql' database layouts
 1185   # below this line, we would grab values from getopt and put them in this hash
 1186   # but for now the hash can remain empty
 1187   my %dbOptions;
 1188 
 1189   eval {
 1190     renameCourse(
 1191       courseID      => $rename_oldCourseID,
 1192       ce            => $ce2,
 1193       dbOptions     => \%dbOptions,
 1194       newCourseID   => $rename_newCourseID,
 1195     );
 1196   };
 1197   if ($@) {
 1198     my $error = $@;
 1199     print CGI::div({class=>"ResultsWithError"},
 1200       CGI::p("An error occured while renaming the course $rename_oldCourseID to $rename_newCourseID:"),
 1201       CGI::tt(CGI::escapeHTML($error)),
 1202     );
 1203   } else {
 1204     print CGI::div({class=>"ResultsWithoutError"},
 1205       CGI::p("Successfully renamed the course $rename_oldCourseID to $rename_newCourseID"),
 1206     );
 1207      writeLog($ce, "hosted_courses", join("\t",
 1208         "\tRenamed",
 1209         "",
 1210         "",
 1211         "$rename_oldCourseID to $rename_newCourseID",
 1212       ));
 1213     my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r,
 1214       courseID => $rename_newCourseID);
 1215     my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
 1216     print CGI::div({style=>"text-align: center"},
 1217       CGI::a({href=>$newCourseURL}, "Log into $rename_newCourseID"),
 1218     );
 1219   }
 1220 }
 1221 
 1222 ################################################################################
 1223 
 1224 my %coursesData;
 1225 sub byLoginActivity {$coursesData{$a}{'epoch_modify_time'} <=> $coursesData{$b}{'epoch_modify_time'}}
 1226 
 1227 sub delete_course_form {
 1228   my ($self) = @_;
 1229   my $r = $self->r;
 1230   my $ce = $r->ce;
 1231   #my $db = $r->db;
 1232   #my $authz = $r->authz;
 1233   #my $urlpath = $r->urlpath;
 1234 
 1235   my $delete_courseID     = $r->param("delete_courseID")     || "";
 1236 
 1237   my $coursesDir = $ce->{webworkDirs}->{courses};
 1238   my @courseIDs = listCourses($ce);
 1239 # @courseIDs    = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
 1240   my $delete_listing_format   = $r->param("delete_listing_format");
 1241   unless (defined $delete_listing_format) {$delete_listing_format = 'alphabetically';}  #use the default
 1242 
 1243 # my %courseLabels; # records... heh.
 1244 # foreach my $courseID (@courseIDs) {
 1245 #   my $tempCE = new WeBWorK::CourseEnvironment({
 1246 #     %WeBWorK::SeedCE,
 1247 #     courseName => $courseID,
 1248 #   });
 1249 #   $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
 1250 # }
 1251   # Get and store last modify time for login.log for all courses. Also get visibility status.
 1252   my %courseLabels;
 1253   my @noLoginLogIDs = ();
 1254   my @loginLogIDs = ();
 1255 
 1256   my ($loginLogFile, $epoch_modify_time, $courseDir);
 1257   foreach my $courseID (@courseIDs) {
 1258     $loginLogFile = "$coursesDir/$courseID/logs/login.log";
 1259     if (-e $loginLogFile) {                 #this should always exist except for the model course
 1260       $epoch_modify_time = stat($loginLogFile)->mtime;
 1261       $coursesData{$courseID}{'epoch_modify_time'} = $epoch_modify_time;
 1262       $coursesData{$courseID}{'local_modify_time'} = ctime($epoch_modify_time);
 1263       push(@loginLogIDs,$courseID);
 1264     } else {
 1265       $coursesData{$courseID}{'local_modify_time'} = 'no login.log';  #this should never be the case except for the model course
 1266       push(@noLoginLogIDs,$courseID);
 1267     }
 1268     if (-f "$coursesDir/$courseID/hide_directory") {
 1269       $coursesData{$courseID}{'status'} = 'hidden';
 1270     } else {
 1271       $coursesData{$courseID}{'status'} = 'visible';
 1272     }
 1273     $courseLabels{$courseID} = "$courseID  ($coursesData{$courseID}{'status'} :: $coursesData{$courseID}{'local_modify_time'}) ";
 1274   }
 1275   if ($delete_listing_format eq 'last_login') {
 1276     @noLoginLogIDs = sort {lc($a) cmp lc ($b) } @noLoginLogIDs; #this should be an empty arrey except for the model course
 1277     @loginLogIDs = sort byLoginActivity @loginLogIDs;  # oldest first
 1278     @courseIDs = (@noLoginLogIDs,@loginLogIDs);
 1279   } else { # in this case we sort alphabetically
 1280     @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
 1281   }
 1282 
 1283   print CGI::h2("Delete Course");
 1284 
 1285   print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1286   my %list_labels = (
 1287                 alphabetically => 'alphabetically',
 1288                 last_login => 'by last login date',
 1289                 );
 1290   print CGI::p(
 1291     'Courses are listed either alphabetically or in order by the time of most recent login activity, oldest first.
 1292     To change the listing order check the mode you want and click "Refresh Listing".  The listing format is: Course_Name
 1293     (status :: date/time of most recent login) where status is "hidden" or "visible".');
 1294 
 1295   print CGI::table(
 1296       CGI::Tr({},
 1297       CGI::p("Select a listing format:"),
 1298       CGI::radio_group(-name=>'delete_listing_format',
 1299                       -values=>['alphabetically', 'last_login'],
 1300                       -default=>'alphabetically',
 1301                       -labels=>\%list_labels,
 1302                       ),
 1303       ),
 1304     );
 1305   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course_refresh", -value=>"Refresh Listing"),
 1306     CGI::submit(-name=>"delete_course", -value=>"Delete Course"));
 1307   print $self->hidden_authen_fields;
 1308   print $self->hidden_fields("subDisplay");
 1309 
 1310 
 1311   print CGI::p("Select a course to delete.");
 1312   print CGI::table({class=>"FormLayout"},
 1313     CGI::Tr({},
 1314       CGI::th({class=>"LeftHeader"}, "Course Name:"),
 1315       CGI::td(
 1316         CGI::scrolling_list(
 1317           -name => "delete_courseID",
 1318           -values => \@courseIDs,
 1319           -default => $delete_courseID,
 1320           -size => 15,
 1321           -multiple => 0,
 1322           -labels => \%courseLabels,
 1323         ),
 1324       ),
 1325     ),
 1326   );
 1327 
 1328   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"delete_course_refresh", -value=>"Refresh Listing"),
 1329     CGI::submit(-name=>"delete_course", -value=>"Delete Course"));
 1330 
 1331   print CGI::end_form();
 1332 }
 1333 
 1334 sub delete_course_validate {
 1335   my ($self) = @_;
 1336   my $r = $self->r;
 1337   my $ce = $r->ce;
 1338   #my $db = $r->db;
 1339   #my $authz = $r->authz;
 1340   my $urlpath = $r->urlpath;
 1341 
 1342   my $delete_courseID     = $r->param("delete_courseID")     || "";
 1343 
 1344   my @errors;
 1345 
 1346   if ($delete_courseID eq "") {
 1347     push @errors, "You must specify a course name.";
 1348   } elsif ($delete_courseID eq $urlpath->arg("courseID")) {
 1349     push @errors, "You cannot delete the course you are currently using.";
 1350   }
 1351 
 1352   my $ce2 = new WeBWorK::CourseEnvironment({
 1353     %WeBWorK::SeedCE,
 1354     courseName => $delete_courseID,
 1355   });
 1356 
 1357   return @errors;
 1358 }
 1359 
 1360 sub delete_course_confirm {
 1361   my ($self) = @_;
 1362   my $r = $self->r;
 1363   my $ce = $r->ce;
 1364   #my $db = $r->db;
 1365   #my $authz = $r->authz;
 1366   #my $urlpath = $r->urlpath;
 1367 
 1368   print CGI::h2("Delete Course");
 1369 
 1370   my $delete_courseID     = $r->param("delete_courseID")     || "";
 1371 
 1372   my $ce2 = new WeBWorK::CourseEnvironment({
 1373     %WeBWorK::SeedCE,
 1374     courseName => $delete_courseID,
 1375   });
 1376 
 1377   print CGI::p("Are you sure you want to delete the course " . CGI::b($delete_courseID)
 1378     . "? All course files and data will be destroyed. There is no undo available.");
 1379 
 1380   print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1381   print $self->hidden_authen_fields;
 1382   print $self->hidden_fields("subDisplay");
 1383   print $self->hidden_fields(qw/delete_courseID/);
 1384 
 1385   print CGI::p({style=>"text-align: center"},
 1386     CGI::submit(-name=>"decline_delete_course", -label=>"Don't delete"),
 1387     "&nbsp;",
 1388     CGI::submit(-name=>"confirm_delete_course", -label=>"Delete"),
 1389   );
 1390 
 1391   print CGI::end_form();
 1392 }
 1393 
 1394 sub do_delete_course {
 1395   my ($self) = @_;
 1396   my $r = $self->r;
 1397   my $ce = $r->ce;
 1398   my $db = $r->db;
 1399   #my $authz = $r->authz;
 1400   #my $urlpath = $r->urlpath;
 1401 
 1402   my $delete_courseID     = $r->param("delete_courseID")     || "";
 1403 
 1404   my $ce2 = new WeBWorK::CourseEnvironment({
 1405     %WeBWorK::SeedCE,
 1406     courseName => $delete_courseID,
 1407   });
 1408 
 1409   # this is kinda left over from when we had 'gdbm' and 'sql' database layouts
 1410   # below this line, we would grab values from getopt and put them in this hash
 1411   # but for now the hash can remain empty
 1412   my %dbOptions;
 1413 
 1414   eval {
 1415     deleteCourse(
 1416       courseID => $delete_courseID,
 1417       ce => $ce2,
 1418       dbOptions => \%dbOptions,
 1419     );
 1420   };
 1421 
 1422   if ($@) {
 1423     my $error = $@;
 1424     print CGI::div({class=>"ResultsWithError"},
 1425       CGI::p("An error occured while deleting the course $delete_courseID:"),
 1426       CGI::tt(CGI::escapeHTML($error)),
 1427     );
 1428   } else {
 1429       # mark the contact person in the admin course as dropped.
 1430       # find the contact person for the course by searching the admin classlist.
 1431       my @contacts = grep /_$delete_courseID$/,  $db->listUsers;
 1432       if (@contacts) {
 1433       die "Incorrect number of contacts for the course $delete_courseID". join(" ", @contacts) if @contacts !=1;
 1434       #warn "contacts", join(" ", @contacts);
 1435       #my $composite_id = "${add_initial_userID}_${add_courseID}";
 1436       my $composite_id  = $contacts[0];
 1437 
 1438       # mark the contact person as dropped.
 1439       my $User = $db->getUser($composite_id);
 1440       my $status_name = 'Drop';
 1441       my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
 1442       $User->status($status_value);
 1443       $db->putUser($User);
 1444     }
 1445 
 1446     print CGI::div({class=>"ResultsWithoutError"},
 1447       CGI::p("Successfully deleted the course $delete_courseID."),
 1448     );
 1449      writeLog($ce, "hosted_courses", join("\t",
 1450         "\tDeleted",
 1451         "",
 1452         "",
 1453         $delete_courseID,
 1454       ));
 1455     print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1456     print $self->hidden_authen_fields;
 1457     print $self->hidden_fields("subDisplay");
 1458 
 1459     print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_delete_course", -value=>"OK"),);
 1460 
 1461     print CGI::end_form();
 1462   }
 1463 }
 1464 
 1465 sub archive_course_form {
 1466   my ($self) = @_;
 1467   my $r = $self->r;
 1468   my $ce = $r->ce;
 1469   #my $db = $r->db;
 1470   #my $authz = $r->authz;
 1471   #my $urlpath = $r->urlpath;
 1472 
 1473   my $archive_courseID     = $r->param("archive_courseID")     || "";
 1474 
 1475   my $coursesDir = $ce->{webworkDirs}->{courses};
 1476   my @courseIDs = listCourses($ce);
 1477 # @courseIDs    = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
 1478   my $archive_listing_format   = $r->param("archive_listing_format");
 1479   unless (defined $archive_listing_format) {$archive_listing_format = 'alphabetically';}  #use the default
 1480 
 1481 # my %courseLabels; # records... heh.
 1482 # foreach my $courseID (@courseIDs) {
 1483 #   my $tempCE = new WeBWorK::CourseEnvironment({
 1484 #     %WeBWorK::SeedCE,
 1485 #     courseName => $courseID,
 1486 #   });
 1487 #   $courseLabels{$courseID} = "$courseID (" . $tempCE->{dbLayoutName} . ")";
 1488 # }
 1489   # Get and store last modify time for login.log for all courses. Also get visibility status.
 1490   my %courseLabels;
 1491   my @noLoginLogIDs = ();
 1492   my @loginLogIDs = ();
 1493 
 1494   my ($loginLogFile, $epoch_modify_time, $courseDir);
 1495   foreach my $courseID (@courseIDs) {
 1496     $loginLogFile = "$coursesDir/$courseID/logs/login.log";
 1497     if (-e $loginLogFile) {                 #this should always exist except for the model course
 1498       $epoch_modify_time = stat($loginLogFile)->mtime;
 1499       $coursesData{$courseID}{'epoch_modify_time'} = $epoch_modify_time;
 1500       $coursesData{$courseID}{'local_modify_time'} = ctime($epoch_modify_time);
 1501       push(@loginLogIDs,$courseID);
 1502     } else {
 1503       $coursesData{$courseID}{'local_modify_time'} = 'no login.log';  #this should never be the case except for the model course
 1504       push(@noLoginLogIDs,$courseID);
 1505     }
 1506     if (-f "$coursesDir/$courseID/hide_directory") {
 1507       $coursesData{$courseID}{'status'} = 'hidden';
 1508     } else {
 1509       $coursesData{$courseID}{'status'} = 'visible';
 1510     }
 1511     $courseLabels{$courseID} = "$courseID  ($coursesData{$courseID}{'status'} :: $coursesData{$courseID}{'local_modify_time'}) ";
 1512   }
 1513   if ($archive_listing_format eq 'last_login') {
 1514     @noLoginLogIDs = sort {lc($a) cmp lc ($b) } @noLoginLogIDs; #this should be an empty arrey except for the model course
 1515     @loginLogIDs = sort byLoginActivity @loginLogIDs;  # oldest first
 1516     @courseIDs = (@noLoginLogIDs,@loginLogIDs);
 1517   } else { # in this case we sort alphabetically
 1518     @courseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
 1519   }
 1520 
 1521   print CGI::h2("archive Course");
 1522 
 1523   print CGI::p(
 1524     'Creates a gzipped tar archive (.tar.gz) of a course in the WeBWorK
 1525     courses directory. Before archiving, the course database is dumped into
 1526     a subdirectory of the course\'s DATA directory. Currently the archive
 1527     facility is only available for mysql databases. It depends on the
 1528     mysqldump application.'
 1529   );
 1530     print CGI::p(
 1531     'Courses are listed either alphabetically or in order by the time of most recent login activity, oldest first.
 1532     To change the listing order check the mode you want and click "Refresh Listing".  The listing format is: Course_Name
 1533     (status :: date/time of most recent login) where status is "hidden" or "visible".');
 1534 
 1535   print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1536   my %list_labels = (
 1537                 alphabetically => 'alphabetically',
 1538                 last_login => 'by last login date',
 1539                 );
 1540 
 1541   print CGI::table(
 1542       CGI::Tr({},
 1543       CGI::p("Select a listing format:"),
 1544       CGI::radio_group(-name=>'archive_listing_format',
 1545                       -values=>['alphabetically', 'last_login'],
 1546                       -default=>'alphabetically',
 1547                       -labels=>\%list_labels,
 1548                       ),
 1549       ),
 1550     );
 1551   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"archive_course_refresh", -value=>"Refresh Listing"),
 1552     CGI::submit(-name=>"archive_course", -value=>"Archive Courses"));
 1553   print $self->hidden_authen_fields;
 1554   print $self->hidden_fields("subDisplay");
 1555 
 1556   print CGI::p("Select course(s) to archive.");
 1557 
 1558   print CGI::table({class=>"FormLayout"},
 1559     CGI::Tr({},
 1560       CGI::th({class=>"LeftHeader"}, "Course Name:"),
 1561       CGI::td(
 1562         CGI::scrolling_list(
 1563           -name => "archive_courseIDs",
 1564           -values => \@courseIDs,
 1565           -default => $archive_courseID,
 1566           -size => 15,
 1567           -multiple => 1,
 1568           -labels => \%courseLabels,
 1569         ),
 1570       ),
 1571 
 1572     ),
 1573     CGI::Tr({},
 1574       CGI::th({class=>"LeftHeader"}, "Delete course:"),
 1575       CGI::td({-style=>'color:red'}, CGI::checkbox({
 1576                           -name=>'delete_course',
 1577                           -checked=>0,
 1578                           -value => 1,
 1579                           -label =>'Delete course after archiving. Caution there is no undo!',
 1580                          },
 1581              ),
 1582       ),
 1583     )
 1584   );
 1585 
 1586   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"archive_course_refresh", -value=>"Refresh Listing"),
 1587   CGI::submit(-name=>"archive_course", -value=>"Archive Courses"));
 1588 
 1589   print CGI::end_form();
 1590 }
 1591 
 1592 sub archive_course_validate {
 1593   my ($self) = @_;
 1594   my $r = $self->r;
 1595   my $ce = $r->ce;
 1596   #my $db = $r->db;
 1597   #my $authz = $r->authz;
 1598   my $urlpath = $r->urlpath;
 1599 
 1600   my @archive_courseIDs     = $r->param("archive_courseIDs");
 1601   @archive_courseIDs        = () unless @archive_courseIDs;
 1602   my @errors;
 1603   foreach my $archive_courseID (@archive_courseIDs) {
 1604     if ($archive_courseID eq "") {
 1605       push @errors, "You must specify a course name.";
 1606     } elsif ($archive_courseID eq $urlpath->arg("courseID")) {
 1607       push @errors, "You cannot archive the course you are currently using.";
 1608     }
 1609   }
 1610 
 1611   #my $ce2 = new WeBWorK::CourseEnvironment({
 1612   # %WeBWorK::SeedCE,
 1613   # courseName => $archive_courseID,
 1614   #});
 1615 
 1616   return @errors;
 1617 }
 1618 
 1619 sub archive_course_confirm {
 1620   my ($self) = @_;
 1621   my $r = $self->r;
 1622   my $ce = $r->ce;
 1623   #my $db = $r->db;
 1624   #my $authz = $r->authz;
 1625   #my $urlpath = $r->urlpath;
 1626 
 1627   print CGI::h2("archive Course");
 1628 
 1629   my $delete_course_flag   = $r->param("delete_course")        || "";
 1630 
 1631   my @archive_courseIDs     = $r->param("archive_courseIDs");
 1632   @archive_courseIDs        = () unless @archive_courseIDs;
 1633     my $archive_courseID  = $r->param("archive_courseID");
 1634     $archive_courseID  = $archive_courseIDs[0] unless $archive_courseID;
 1635 
 1636 
 1637   my $ce2 = new WeBWorK::CourseEnvironment({
 1638     %WeBWorK::SeedCE,
 1639     courseName => $archive_courseID,
 1640   });
 1641 
 1642 
 1643   my ($tables_ok,$dbStatus);
 1644 #############################################################################
 1645 # Check database
 1646 #############################################################################
 1647   my %missing_fields;
 1648   if ($ce2->{dbLayoutName} ) {
 1649       my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2);
 1650       ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID);
 1651     if ($r->param("upgrade_course_tables")) {
 1652       my @schema_table_names = keys %$dbStatus;  # update tables missing from database;
 1653       my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names;
 1654       my @tables_to_alter  = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names;
 1655       my $msg = $CIchecker->updateCourseTables($archive_courseID, [@tables_to_create]);
 1656       foreach my $table_name (@tables_to_alter) {
 1657         $msg .= $CIchecker->updateTableFields($archive_courseID, $table_name);
 1658       }
 1659       print CGI::p({-style=>'color:green; font-weight:bold'}, $msg);
 1660     }
 1661     if ($r->param("upgrade_course_tables") ) {
 1662 
 1663       $CIchecker -> updateCourseDirectories();   # needs more error messages
 1664 
 1665 
 1666 
 1667     }
 1668     ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($archive_courseID);
 1669 
 1670 
 1671     # print db status
 1672 
 1673     my %msg =(    WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A         => CGI::span({style=>"color:red"}," Table defined in schema but missing in database"),
 1674                   WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B         => CGI::span({style=>"color:red"}," Table defined in database but missing in schema"),
 1675                   WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B   => CGI::span({style=>"color:green"}," Table is ok "),
 1676                   WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database table definitions do not agree "),
 1677     );
 1678     my %msg2 =(    WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A        => CGI::span({style=>"color:red"}," missing in database"),
 1679                   WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B         => CGI::span({style=>"color:red"}," missing in schema"),
 1680                   WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B   => CGI::span({style=>"color:green"}," is ok "),
 1681                   WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database field definitions do not agree "),
 1682     );
 1683     my $all_tables_ok=1;
 1684     my $extra_database_tables=0;
 1685     my $extra_database_fields=0;
 1686     my $str=CGI::h4("Report on database structure for course $archive_courseID:").CGI::br();
 1687     foreach my $table (sort keys %$dbStatus) {
 1688         my $table_status = $dbStatus->{$table}->[0];
 1689       $str .= CGI::b($table) .  $msg{ $table_status } . CGI::br();
 1690 
 1691       CASE: {
 1692         $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B
 1693           && do{ last CASE;
 1694           };
 1695         $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
 1696           && do{
 1697                $all_tables_ok = 0; last CASE;
 1698           };
 1699         $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
 1700           && do{
 1701                $extra_database_tables = 1; last CASE;
 1702           };
 1703         $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B
 1704           && do{
 1705               my %fieldInfo = %{ $dbStatus->{$table}->[1] };
 1706             foreach my $key (keys %fieldInfo) {
 1707                 my $field_status = $fieldInfo{$key}->[0];
 1708                 CASE2: {
 1709                   $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
 1710                     && do{
 1711                        $extra_database_fields = 1; last CASE2;
 1712                     };
 1713                   $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
 1714                     && do{
 1715                        $all_tables_ok=0; last CASE2;
 1716                     };
 1717                 }
 1718               $str .= CGI::br()."\n&nbsp;&nbsp;Field $key => ". $msg2{$field_status };
 1719             }
 1720           };
 1721       }
 1722       $str.=CGI::br();
 1723 
 1724     }
 1725 #############################################################################
 1726 # Report on databases
 1727 #############################################################################
 1728 
 1729     print CGI::p($str);
 1730     if ($extra_database_tables) {
 1731         print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema.
 1732                                                              They can only be removed manually from the database.");
 1733     }
 1734     if ($extra_database_fields) {
 1735         print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields  which are not defined in the schema for at least one table.
 1736                                                              They can only be removed manually from the database.");
 1737     }
 1738     if ($all_tables_ok) {
 1739       print CGI::p({-style=>'color:green; font-weight:bold'},"Course $archive_courseID database is in order");
 1740       print(CGI::p({-style=>'color:red; font-weight:bold'}, "Are you sure that you want to delete the course ".
 1741             CGI::b($archive_courseID). " after archiving?  This cannot be undone!")) if $delete_course_flag;
 1742     } else {
 1743       print CGI::p({-style=>'color:red; font-weight:bold'}, "There are tables or fields missing from the
 1744               database.  The database
 1745               must be upgraded before archiving this course."
 1746       );
 1747     }
 1748 #############################################################################
 1749 # Check directories and report
 1750 #############################################################################
 1751 
 1752 
 1753       my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories();
 1754       my $style = ($directories_ok)?"color:green" : "color:red";
 1755       print CGI::h2("Directory structure"), CGI::p($str2),
 1756       ($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") :
 1757               CGI::p({style=>$style},"Directory structure is missing directories
 1758                           or the webserver lacks sufficient privileges.");
 1759 
 1760 
 1761 
 1762 
 1763 #############################################################################
 1764 # Print form for choosing next action.
 1765 #############################################################################
 1766 
 1767     print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1768     print $self->hidden_authen_fields;
 1769     print $self->hidden_fields("subDisplay");
 1770     print $self->hidden_fields(qw/delete_course/);
 1771     print CGI::hidden('archive_courseID', $archive_courseID);
 1772     print CGI::hidden('archive_courseIDs',@archive_courseIDs);
 1773       # grab some values we'll need
 1774     my $course_dir   = $ce2->{courseDirs}{root};
 1775     my $archive_path = $ce2->{webworkDirs}{courses} . "/$archive_courseID.tar.gz";
 1776         # fail if the source course does not exist
 1777     unless (-e $course_dir) {
 1778       print CGI::p( "$archive_courseID: The directory for the course not found.");
 1779     }
 1780 
 1781     if ($all_tables_ok && $directories_ok ) { # no missing fields
 1782       # Warn about overwriting an existing archive
 1783       if (-e $archive_path and -w $archive_path) {
 1784         print CGI::p({-style=>'color:red; font-weight:bold'},"The course '$archive_courseID' has already been archived at '$archive_path'.
 1785           This earlier archive will be erased.  This cannot be undone.");
 1786       }
 1787       # archive execute button
 1788       print CGI::p({style=>"text-align: center"},
 1789         CGI::submit(-name=>"decline_archive_course", -value=>"Stop archiving"),
 1790         "&nbsp;",
 1791         (@archive_courseIDs)? CGI::submit(-name=>"archive_course", -value=>"Skip archiving this course")."&nbsp;":'',
 1792         CGI::submit(-name=>"confirm_archive_course", -value=>"archive") ,
 1793       );
 1794     } elsif( $directories_ok)  {
 1795       print CGI::p({style=>"text-align: center"},
 1796       CGI::submit(-name => "decline_archive_course", -value => "Don't archive"),
 1797         "&nbsp;",
 1798         CGI::submit(-name=>"upgrade_course_tables", -value=>"upgrade course tables"),
 1799       );
 1800     } else {
 1801       print CGI::p({style=>"text-align: center"},
 1802       CGI::br(),
 1803       "Directory structure needs to be repaired manually before archiving.",CGI::br(),
 1804       CGI::submit(-name => "decline_archive_course", -value => "Don't archive"),
 1805       CGI::submit(-name => "upgrade_course_tables", -value => "Attempt to upgrade directories"),
 1806       );
 1807 
 1808     }
 1809     print CGI::end_form();
 1810   } else {
 1811     print CGI::p({-style=>'color:red; font-weight:bold'},"Unable to find database layout for $archive_courseID");
 1812   }
 1813 }
 1814 
 1815 sub do_archive_course {
 1816   my ($self) = @_;
 1817   my $r = $self->r;
 1818   my $ce = $r->ce;
 1819   my $db = $r->db;
 1820   #my $authz = $r->authz;
 1821   #my $urlpath = $r->urlpath;
 1822 
 1823 
 1824   my $archive_courseID     = $r->param("archive_courseID")     || "";
 1825   my $delete_course_flag   = $r->param("delete_course")        || "";
 1826   my @archive_courseIDs     = $r->param("archive_courseIDs");
 1827   @archive_courseIDs        = () unless @archive_courseIDs;
 1828 
 1829   my $ce2 = new WeBWorK::CourseEnvironment({
 1830     %WeBWorK::SeedCE,
 1831     courseName => $archive_courseID,
 1832   });
 1833 
 1834   # Remove course specific temp files before archiving
 1835   my $courseTempDir = $ce2->{courseDirs}{html_temp};
 1836   remove_tree("$courseTempDir");
 1837   # Remove the original default tmp directory if it exists
 1838   my $orgDefaultCourseTempDir = "$ce2->{courseDirs}{html}/tmp";
 1839   if (-d "$orgDefaultCourseTempDir") {
 1840     remove_tree("$orgDefaultCourseTempDir");
 1841   }
 1842 
 1843   # this is kinda left over from when we had 'gdbm' and 'sql' database layouts
 1844   # below this line, we would grab values from getopt and put them in this hash
 1845   # but for now the hash can remain empty
 1846   my %dbOptions;
 1847 
 1848   eval {
 1849     archiveCourse(
 1850       courseID => $archive_courseID,
 1851       ce => $ce2,
 1852       dbOptions => \%dbOptions,
 1853     );
 1854   };
 1855 
 1856   if ($@) {
 1857     my $error = $@;
 1858     print CGI::div({class=>"ResultsWithError"},
 1859       CGI::p("An error occured while archiving the course $archive_courseID:"),
 1860       CGI::tt(CGI::escapeHTML($error)),
 1861     );
 1862   } else {
 1863     print CGI::div({class=>"ResultsWithoutError"},
 1864       CGI::p("Successfully archived the course $archive_courseID"),
 1865     );
 1866      writeLog($ce, "hosted_courses", join("\t",
 1867         "\tarchived",
 1868         "",
 1869         "",
 1870         $archive_courseID,
 1871       ));
 1872 
 1873     if ($delete_course_flag) {
 1874       eval {
 1875         deleteCourse(
 1876           courseID => $archive_courseID,
 1877           ce => $ce2,
 1878           dbOptions => \%dbOptions,
 1879         );
 1880       };
 1881 
 1882       if ($@) {
 1883         my $error = $@;
 1884         print CGI::div({class=>"ResultsWithError"},
 1885           CGI::p("An error occured while deleting the course $archive_courseID:"),
 1886           CGI::tt(CGI::escapeHTML($error)),
 1887         );
 1888       } else {
 1889         # mark the contact person in the admin course as dropped.
 1890         # find the contact person for the course by searching the admin classlist.
 1891         my @contacts = grep /_$archive_courseID$/,  $db->listUsers;
 1892         if (@contacts) {
 1893           die "Incorrect number of contacts for the course $archive_courseID". join(" ", @contacts) if @contacts !=1;
 1894           #warn "contacts", join(" ", @contacts);
 1895           #my $composite_id = "${add_initial_userID}_${add_courseID}";
 1896           my $composite_id  = $contacts[0];
 1897 
 1898           # mark the contact person as dropped.
 1899           my $User = $db->getUser($composite_id);
 1900           my $status_name = 'Drop';
 1901           my $status_value = ($ce->status_name_to_abbrevs($status_name))[0];
 1902           $User->status($status_value);
 1903           $db->putUser($User);
 1904         }
 1905 
 1906         print CGI::div({class=>"ResultsWithoutError"},
 1907           CGI::p("Successfully deleted the course $archive_courseID."),
 1908         );
 1909       }
 1910 
 1911 
 1912     }
 1913     shift @archive_courseIDs;  # remove the course which has just been archived.
 1914     if (@archive_courseIDs) {
 1915       print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1916       print $self->hidden_authen_fields;
 1917       print $self->hidden_fields("subDisplay");
 1918       print $self->hidden_fields(qw/delete_course/);
 1919 
 1920       print CGI::hidden('archive_courseIDs',@archive_courseIDs);
 1921       print CGI::p({style=>"text-align: center"}, CGI::submit("decline_archive_course", "Stop archiving courses"),
 1922         CGI::submit("archive_course", "archive next course")
 1923       );
 1924       print CGI::end_form();
 1925     } else {
 1926       print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1927       print $self->hidden_authen_fields;
 1928       print $self->hidden_fields("subDisplay");
 1929       print CGI::hidden("archive_courseID",$archive_courseID);
 1930       print CGI::p( CGI::submit("decline_archive_course", "OK")  );
 1931       print CGI::end_form();
 1932     }
 1933   }
 1934 }
 1935 
 1936 ##########################################################################
 1937 
 1938 sub unarchive_course_form {
 1939   my ($self) = @_;
 1940   my $r = $self->r;
 1941   my $ce = $r->ce;
 1942   #my $db = $r->db;
 1943   #my $authz = $r->authz;
 1944   #my $urlpath = $r->urlpath;
 1945 
 1946   my $unarchive_courseID     = $r->param("unarchive_courseID")     || "";
 1947 
 1948   # First find courses which have been archived.
 1949   my @courseIDs = listArchivedCourses($ce);
 1950   @courseIDs    = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
 1951 
 1952   my %courseLabels; # records... heh.
 1953   foreach my $courseID (@courseIDs) {
 1954         $courseLabels{$courseID} = $courseID;
 1955   }
 1956 
 1957   print CGI::h2("Unarchive Course");
 1958 
 1959   print CGI::p(
 1960     "Restores a course from a gzipped tar archive (.tar.gz). After
 1961     unarchiving, the course database is restored from a subdirectory of the
 1962     course's DATA directory. Currently the archive facility is only
 1963     available for mysql databases. It depends on the mysqldump application."
 1964   );
 1965 
 1966   print CGI::start_form(-method=>"POST", -action=>$r->uri);
 1967   print $self->hidden_authen_fields;
 1968   print $self->hidden_fields("subDisplay");
 1969 
 1970   print CGI::p("Select a course to unarchive.");
 1971 
 1972   print CGI::table({class=>"FormLayout"},
 1973     CGI::Tr({},
 1974       CGI::th({class=>"LeftHeader"}, "Course Name:"),
 1975       CGI::td(
 1976         CGI::scrolling_list(
 1977           -name => "unarchive_courseID",
 1978           -values => \@courseIDs,
 1979           -default => $unarchive_courseID,
 1980           -size => 10,
 1981           -multiple => 0,
 1982           -labels => \%courseLabels,
 1983         ),
 1984       ),
 1985     ),
 1986 
 1987     CGI::Tr({},
 1988         CGI::th({class=>"LeftHeader"}, CGI::checkbox(-name => "create_newCourseID",-default=>'',-value=>1, -label=>'New Name:')),
 1989         CGI::td(CGI::textfield(-name=>"new_courseID", -value=>'', -size=>25)),
 1990       ),
 1991   );
 1992 
 1993   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"unarchive_course", -value=>"Unarchive Course"));
 1994 
 1995   print CGI::end_form();
 1996 }
 1997 
 1998 sub unarchive_course_validate {
 1999   my ($self) = @_;
 2000   my $r = $self->r;
 2001   my $ce = $r->ce;
 2002   #my $db = $r->db;
 2003   #my $authz = $r->authz;
 2004   my $urlpath = $r->urlpath;
 2005 
 2006   my $unarchive_courseID                   = $r->param("unarchive_courseID")             || "";
 2007   my $create_newCourseID                   = $r->param("create_newCourseID")      || "";
 2008   my $new_courseID                         = $r->param("new_courseID")    || "";
 2009   my @errors;
 2010   #by default we use the archive name for the course
 2011   my $courseID = $unarchive_courseID;
 2012   $courseID =~ s/\.tar\.gz$//;
 2013 
 2014   if ( $create_newCourseID) {
 2015     $courseID = $new_courseID;
 2016   }
 2017   debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID ");
 2018 
 2019   if ($courseID eq "") {
 2020     push @errors, "You must specify a course name.";
 2021   } elsif ( -d $ce->{webworkDirs}->{courses}."/$courseID" ) {
 2022       #Check that a directory for this course doesn't already exist
 2023     push @errors, "A directory already exists with the name $courseID.
 2024      You must first delete this existing course before you can unarchive.";
 2025   }
 2026 
 2027 
 2028   return @errors;
 2029 }
 2030 
 2031 sub unarchive_course_confirm {
 2032   my ($self) = @_;
 2033   my $r = $self->r;
 2034   my $ce = $r->ce;
 2035   #my $db = $r->db;
 2036   #my $authz = $r->authz;
 2037   #my $urlpath = $r->urlpath;
 2038 
 2039   print CGI::h2("Unarchive Course");
 2040 
 2041   my $unarchive_courseID                    = $r->param("unarchive_courseID")     || "";
 2042   my $create_newCourseID                    = $r->param("create_newCourseID")     || "";
 2043   my $new_courseID                          = $r->param("new_courseID")           || "";
 2044 
 2045   my $courseID = $unarchive_courseID; $courseID =~ s/\.tar\.gz$//;
 2046 
 2047   if ( $create_newCourseID) {
 2048     $courseID = $new_courseID;
 2049   }
 2050 
 2051     debug(" unarchive_courseID $unarchive_courseID new_courseID $new_courseID ");
 2052 
 2053   print CGI::start_form(-method=>"POST", -action=>$r->uri);
 2054     print CGI::p($unarchive_courseID," to course ",
 2055                CGI::input({-name=>'new_courseID', -value=>$courseID})
 2056   );
 2057 
 2058   print $self->hidden_authen_fields;
 2059   print $self->hidden_fields("subDisplay");
 2060   print $self->hidden_fields(qw/unarchive_courseID create_newCourseID/);
 2061 
 2062   print CGI::p({style=>"text-align: center"},
 2063     CGI::submit(-name=>"decline_unarchive_course", -value=>"Don't unarchive"),
 2064     "&nbsp;",
 2065     CGI::submit(-name=>"confirm_unarchive_course", -value=>"unarchive"),
 2066   );
 2067 
 2068   print CGI::end_form();
 2069 }
 2070 
 2071 sub do_unarchive_course {
 2072   my ($self) = @_;
 2073   my $r = $self->r;
 2074   my $ce = $r->ce;
 2075   #my $db = $r->db;
 2076   #my $authz = $r->authz;
 2077   my $urlpath = $r->urlpath;
 2078   my $new_courseID           = $r->param("new_courseID")           || "";
 2079   my $unarchive_courseID     = $r->param("unarchive_courseID")     || "";
 2080 
 2081   my $old_courseID   = $unarchive_courseID;
 2082   $old_courseID =~ s/.tar.gz//;
 2083 
 2084   #eval {
 2085     unarchiveCourse(
 2086       newCourseID => $new_courseID,
 2087       oldCourseID => $old_courseID,
 2088       archivePath =>$ce->{webworkDirs}->{courses}."/$unarchive_courseID",
 2089       ce => $ce,
 2090     );
 2091   #};
 2092 
 2093   if ($@) {
 2094     my $error = $@;
 2095     print CGI::div({class=>"ResultsWithError"},
 2096       CGI::p("An error occured while archiving the course $unarchive_courseID:"),
 2097       CGI::tt(CGI::escapeHTML($error)),
 2098     );
 2099   } else {
 2100     print CGI::div({class=>"ResultsWithoutError"},
 2101       CGI::p("Successfully unarchived  $unarchive_courseID to the course $new_courseID"),
 2102     );
 2103      writeLog($ce, "hosted_courses", join("\t",
 2104         "\tunarchived",
 2105         "",
 2106         "",
 2107         "$unarchive_courseID to $new_courseID",
 2108       ));
 2109 
 2110     my $newCoursePath = $urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r,
 2111       courseID => $new_courseID);
 2112     my $newCourseURL = $self->systemLink($newCoursePath, authen => 0);
 2113     print CGI::div({style=>"text-align: center"},
 2114       CGI::a({href=>$newCourseURL}, "Log into $new_courseID"),
 2115     );
 2116 
 2117     print CGI::start_form(-method=>"POST", -action=>$r->uri);
 2118     print $self->hidden_authen_fields;
 2119     print $self->hidden_fields("subDisplay");
 2120     print CGI::hidden("unarchive_courseID",$unarchive_courseID);
 2121     print CGI::p( CGI::submit("decline_unarchive_course", "unarchive next course")  );
 2122     print CGI::end_form();
 2123 
 2124   }
 2125 }
 2126 
 2127 ##########################################################################
 2128 
 2129 sub upgrade_course_form {
 2130   my ($self) = @_;
 2131   my $r = $self->r;
 2132   my $ce = $r->ce;
 2133   #my $db = $r->db;
 2134   #my $authz = $r->authz;
 2135   #my $urlpath = $r->urlpath;
 2136 
 2137 
 2138   my $selectAll =CGI::input({-type=>'button', -name=>'check_all', -value=>'Select all eligible courses',
 2139          onClick => "for (i in document.courselist.elements)  {
 2140                          if (document.courselist.elements[i].name =='upgrade_courseIDs') {
 2141                              document.courselist.elements[i].checked = true
 2142                          }
 2143                       }" });
 2144     my $selectNone =CGI::input({-type=>'button', -name=>'check_none', -value=>'Unselect all courses',
 2145          onClick => "for (i in document.courselist.elements)  {
 2146                          if (document.courselist.elements[i].name =='upgrade_courseIDs') {
 2147                             document.courselist.elements[i].checked = false
 2148                          }
 2149                       }" });
 2150 
 2151   my @courseIDs = listCourses($ce);
 2152   @courseIDs    = sort {lc($a) cmp lc ($b) } @courseIDs; #make sort case insensitive
 2153 
 2154   print CGI::h2("Upgrade Courses");
 2155 
 2156   print CGI::p(
 2157     "Update the checked directories?"
 2158   );
 2159 
 2160   print CGI::start_form(-method=>"POST", -action=>$r->uri, -id=>"courselist", -name=>"courselist"),
 2161         CGI::p($selectAll, $selectNone);
 2162   print $self->hidden_authen_fields;
 2163   print $self->hidden_fields("subDisplay");
 2164 
 2165     foreach my $courseID ( @courseIDs) {
 2166       next if $courseID eq "admin"; # done already above
 2167       next if $courseID eq "modelCourse"; # modelCourse isn't a real course so don't create missing directories, etc
 2168       next unless $courseID =~/\S/;  # skip empty courseIDs (there shouldn't be any
 2169       my $urlpath = $r->urlpath->newFromModule("WeBWorK::ContentGenerator::ProblemSets", $r, courseID => $courseID);
 2170       my $tempCE;
 2171       eval{ $tempCE = new WeBWorK::CourseEnvironment({
 2172         %WeBWorK::SeedCE,
 2173         courseName => $courseID,
 2174       })};
 2175         print "Can't create course environment for $courseID because $@" if $@;
 2176       my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$tempCE);
 2177       $CIchecker->updateCourseDirectories();  #creates missing html_temp, mailmerge tmpEditFileDir directories;
 2178       my ($tables_ok,$dbStatus)   = $CIchecker->checkCourseTables($courseID);
 2179       my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories();
 2180       my $checked = ($tables_ok && $directories_ok)?0:1;   # don't check if everything is ok
 2181       my $checkbox_spot = "";
 2182       if ($checked) {  # only show checkbox if the course is not up-to-date
 2183             $checkbox_spot = CGI::checkbox({name=>"upgrade_courseIDs", label=>'upgrade', selected=>$checked,value=>$courseID});
 2184           }
 2185       print CGI::li(
 2186           $checkbox_spot,"&nbsp;",
 2187           CGI::a({href=>$self->systemLink($urlpath, authen => 0)}, $courseID),
 2188         CGI::code(
 2189           $tempCE->{dbLayoutName},
 2190         ),
 2191         $directories_ok ? "" : CGI::span({style=>"color:red"},"Directory structure or permissions need to be repaired. "),
 2192         $tables_ok ? CGI::span({style=>"color:green"},"Database tables ok") : CGI::span({style=>"color:red"},"Database tables need updating."),
 2193 
 2194       );
 2195 
 2196     }
 2197 
 2198 
 2199 
 2200   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"upgrade_course", -value=>"Upgrade Courses"));
 2201 
 2202   print CGI::end_form();
 2203 }
 2204 
 2205 sub upgrade_course_validate {
 2206   my ($self) = @_;
 2207   my $r = $self->r;
 2208   my $ce = $r->ce;
 2209   #my $db = $r->db;
 2210   #my $authz = $r->authz;
 2211   my $urlpath = $r->urlpath;
 2212 
 2213   my @upgrade_courseIDs     = $r->param("upgrade_courseIDs") ;
 2214   @upgrade_courseIDs        = () unless  @upgrade_courseIDs;
 2215   #warn "validate: upgrade ids ", join("|",@upgrade_courseIDs);
 2216   my @errors;
 2217   foreach my $upgrade_courseID (@upgrade_courseIDs) {
 2218     if ($upgrade_courseID eq "") {
 2219       push @errors, "You must specify a course name.";
 2220     }
 2221   }
 2222 
 2223 
 2224   return @errors;
 2225 }
 2226 
 2227 sub upgrade_course_confirm {
 2228   my ($self) = @_;
 2229   my $r = $self->r;
 2230   my $ce = $r->ce;
 2231   my $db = $r->db;
 2232 
 2233 
 2234   my @upgrade_courseIDs     = $r->param("upgrade_courseIDs");
 2235   @upgrade_courseIDs        = () unless @upgrade_courseIDs;
 2236     #my $upgrade_courseID      = $upgrade_courseIDs[0];
 2237     my %update_error_msg    = ();
 2238     print CGI::start_form(-method=>"POST", -action=>$r->uri);
 2239     foreach my $upgrade_courseID (@upgrade_courseIDs) {
 2240         next unless $upgrade_courseID =~/\S/;   # skip empty values
 2241       ##########################
 2242     # analyze one course
 2243     ##########################
 2244     my $ce2 = new WeBWorK::CourseEnvironment({
 2245       %WeBWorK::SeedCE,
 2246       courseName => $upgrade_courseID,
 2247     });
 2248     #warn "upgrade_course_confirm: updating |$upgrade_courseID| from course list: " , join("|",@upgrade_courseIDs);
 2249 
 2250     #############################################################################
 2251     # Create integrity checker
 2252     #############################################################################
 2253 
 2254     my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2);
 2255 
 2256     #############################################################################
 2257     # Report on database status
 2258     #############################################################################
 2259 
 2260     my ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID);
 2261     my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $str) = formatReportOnDatabaseTables($tables_ok, $dbStatus);
 2262     # prepend course name
 2263     $str = CGI::checkbox({name=>"upgrade_courseIDs", label=>'upgrade', selected=>1,value=>$upgrade_courseID}).
 2264              "Report for course $upgrade_courseID:".CGI::br()."Database:".CGI::br(). $str;
 2265 
 2266     #############################################################################
 2267     # Report on databases
 2268     #############################################################################
 2269 
 2270     print CGI::p($str);
 2271     if ($extra_database_tables) {
 2272         print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema.
 2273                                    They can only be removed manually from the database.");
 2274     }
 2275     if ($extra_database_fields) {
 2276         print CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields  which are not defined in the schema for at least one table.
 2277                                    They can only be removed manually from the database.");
 2278     }
 2279 
 2280 
 2281     #############################################################################
 2282     # Report on directory status
 2283     #############################################################################
 2284     my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories();
 2285     my $style = ($directories_ok)?"color:green" : "color:red";
 2286     print "Directory structure".CGI::br(), CGI::p($str2),
 2287     ($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") :
 2288         CGI::p({style=>$style},"Directory structure is missing directories
 2289               or the webserver lacks sufficient privileges.");
 2290   }
 2291   #warn "upgrade_course_confirm:  now print form";
 2292   #############################################################################
 2293   # Print form for choosing next action.
 2294   #############################################################################
 2295     print CGI::h3("No course id defined") unless @upgrade_courseIDs;
 2296 
 2297 
 2298   print $self->hidden_authen_fields;
 2299   print $self->hidden_fields("subDisplay");
 2300   #print CGI::hidden('upgrade_courseIDs',@upgrade_courseIDs);
 2301 
 2302   ####################################################################
 2303   # Submit buttons
 2304   # After presenting a detailed summary of status of selected courses the choice is made to
 2305   # upgrade the selected courses (confirm_upgrade_course is set
 2306   # or return to the beginning (decline_upgrade_course   is set
 2307 
 2308   ####################################################################
 2309   print CGI::p({style=>"text-align: center"},
 2310       CGI::submit(-name =>"decline_upgrade_course", -value => "Don't upgrade"),
 2311     CGI::submit(-name=>"confirm_upgrade_course", -value=>"Upgrade") );
 2312 
 2313   print CGI::h3("upgrade_course_confirm subroutine");
 2314 
 2315   print CGI::end_form();
 2316 
 2317 }
 2318 
 2319 sub do_upgrade_course {
 2320   my ($self) = @_;
 2321   my $r = $self->r;
 2322   my $ce = $r->ce;
 2323   my $db = $r->db;
 2324 
 2325 
 2326   my @upgrade_courseIDs     = $r->param("upgrade_courseIDs");
 2327   @upgrade_courseIDs        = () unless @upgrade_courseIDs;
 2328     my %update_error_msg          = ();
 2329     #warn "do_upgrade_course:  upgrade_courseIDs = ", join(" ", @upgrade_courseIDs);
 2330     foreach my $upgrade_courseID (@upgrade_courseIDs) {
 2331       next unless $upgrade_courseID =~ /\S/; # omit blank course IDs
 2332 
 2333     ##########################
 2334     # update one course
 2335     ##########################
 2336     my $ce2 = new WeBWorK::CourseEnvironment({
 2337       %WeBWorK::SeedCE,
 2338       courseName => $upgrade_courseID,
 2339     });
 2340     #warn "do_upgrade_course: updating |$upgrade_courseID| from" , join("|",@upgrade_courseIDs);
 2341     #############################################################################
 2342     # Create integrity checker
 2343     #############################################################################
 2344 
 2345     my $CIchecker = new WeBWorK::Utils::CourseIntegrityCheck(ce=>$ce2);
 2346 
 2347     #############################################################################
 2348     # Add missing tables and missing fields to existing tables
 2349     #############################################################################
 2350 
 2351     my ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID);
 2352     my @schema_table_names = keys %$dbStatus;  # update tables missing from database;
 2353     my @tables_to_create = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A} @schema_table_names;
 2354     my @tables_to_alter  = grep {$dbStatus->{$_}->[0] == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B} @schema_table_names;
 2355     $update_error_msg{$upgrade_courseID} = $CIchecker->updateCourseTables($upgrade_courseID, [@tables_to_create]);
 2356     foreach my $table_name (@tables_to_alter) { #warn "do_upgrade_course: adding new fields to table $table_name in course $upgrade_courseID";
 2357       $update_error_msg{$upgrade_courseID} .= $CIchecker->updateTableFields($upgrade_courseID, $table_name);
 2358     }
 2359     ### $update_error_msg{$upgrade_courseID} is printed below
 2360     #############################################################################
 2361     # Add missing directories when it can be done safely
 2362     ############################################################################# #warn "do_upgrade_course: updating course directories for $upgrade_courseID";
 2363     $CIchecker -> updateCourseDirectories();   # needs more error messages
 2364 
 2365 
 2366     #############################################################################
 2367     # Analyze database status and prepare status report
 2368     #############################################################################
 2369 
 2370     ($tables_ok,$dbStatus) = $CIchecker->checkCourseTables($upgrade_courseID);
 2371 
 2372     my ($all_tables_ok, $extra_database_tables, $extra_database_fields, $str)
 2373           = formatReportOnDatabaseTables($tables_ok, $dbStatus);
 2374     # prepend course name
 2375     $str = CGI::br()."Database:".CGI::br(). $str;
 2376 
 2377     #############################################################################
 2378     # Report on databases and report summary
 2379     #############################################################################
 2380 
 2381 
 2382       if ($extra_database_tables) {
 2383           $str .= CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database tables which are not defined in the schema.
 2384                                      They can only be removed manually from the database.");
 2385       }
 2386       if ($extra_database_fields) {
 2387           $str .= CGI::p({-style=>'color:red; font-weight:bold'},"There are extra database fields  which are not defined in the schema for at least one table.
 2388                                      They can only be removed manually from the database.");
 2389       }
 2390 
 2391     #############################################################################
 2392     # Prepare report on directory status
 2393     #############################################################################
 2394       my ($directories_ok, $str2) = $CIchecker->checkCourseDirectories();
 2395       my $style = ($directories_ok)?"color:green" : "color:red";
 2396       my $dir_msg  = join ('',
 2397         "Directory structure",CGI::br(),
 2398         CGI::p($str2),
 2399         ($directories_ok)? CGI::p({style=>$style},"Directory structure is ok") :
 2400           CGI::p({style=>$style},"Directory structure is missing directories
 2401                 or the webserver lacks sufficient privileges.")
 2402       );
 2403 
 2404     #############################################################################
 2405     # Print status
 2406     #############################################################################
 2407     print " Report for course $upgrade_courseID:".CGI::br();
 2408     print CGI::p({-style=>'color:green; font-weight:bold'}, $update_error_msg{$upgrade_courseID});
 2409 
 2410     print CGI::p($str);     # print message about tables
 2411     print CGI::p($dir_msg); # message about directories
 2412 
 2413   }
 2414   #############################################################################
 2415   # Submit buttons -- return to beginning
 2416   #############################################################################
 2417   print CGI::h3("do_upgrade_course subroutine");
 2418   print CGI::start_form(-method=>"POST", -action=>$r->uri);  #send back to this script
 2419   print $self->hidden_authen_fields;
 2420   print $self->hidden_fields("subDisplay");
 2421   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"decline_upgrade_course", -value=>"Continue") );
 2422   print CGI::end_form();
 2423 }
 2424 
 2425 
 2426 
 2427 ################################################################################
 2428 ## location management routines; added by DG [Danny Ginn] 20070215
 2429 ## revised by glarose
 2430 
 2431 sub manage_location_form {
 2432   my ($self) = @_;
 2433   my $r = $self->r;
 2434   my $ce = $r->ce;
 2435   my $db = $r->db;
 2436   #my $authz = $r->authz;
 2437   my $urlpath = $r->urlpath;
 2438 
 2439   # get a list of all existing locations
 2440   my @locations = sort {lc($a->location_id) cmp lc($b->location_id)}
 2441     $db->getAllLocations();
 2442   my %locAddr = map {$_->location_id => [ $db->listLocationAddresses($_->location_id) ]} @locations;
 2443 
 2444   my @locationIDs = map { $_->location_id } @locations;
 2445 
 2446   print CGI::h2("Manage Locations");
 2447 
 2448   print CGI::p({},CGI::strong("Currently defined locations are listed below."));
 2449 
 2450   print CGI::start_form(-method=>"POST", -action=>$r->uri);
 2451   print $self->hidden_authen_fields;
 2452   print $self->hidden_fields("subDisplay");
 2453 
 2454   # get a list of radio buttons to select an action
 2455   my @actionRadios =
 2456     CGI::radio_group(-name => "manage_location_action",
 2457          -values => ["edit_location_form",
 2458                "add_location_handler",
 2459                "delete_location_handler"],
 2460          -labels => { edit_location_form => "",
 2461                 add_location_handler => "",
 2462                 delete_location_handler => "", },
 2463          -default => $r->param("manage_location_action") ? $r->param("manage_location_action") : 'none');
 2464 
 2465   print CGI::start_table({});
 2466   print CGI::Tr({}, CGI::th({-colspan=>4,-align=>"left"},
 2467           "Select an action to perform:"));
 2468 
 2469   # edit action
 2470   print CGI::Tr({},
 2471     CGI::td({},[ $actionRadios[0], "Edit Location:" ]),
 2472     CGI::td({-colspan=>2, -align=>"left"},
 2473       CGI::div({-style=>"width:25%;"},
 2474           CGI::popup_menu(-name=>"edit_location",
 2475           -values=>[@locationIDs]))) );
 2476   # create action
 2477   print CGI::Tr({},
 2478     CGI::td({-align=>"left"},[ $actionRadios[1],
 2479       "Create Location:" ]),
 2480     CGI::td({-colspan=>2},
 2481       "Location name: " .
 2482       CGI::textfield(-name=>"new_location_name",
 2483                -size=>"10",
 2484                -default=>$r->param("new_location_name")?$r->param("new_location_name"):'')));
 2485   print CGI::Tr({valign=>'top'},
 2486     CGI::td({}, ["&nbsp;", "Location description:"]),
 2487     CGI::td({-colspan=>2},
 2488       CGI::textfield(-name=>"new_location_description",
 2489                -size=>"50",
 2490                -default=>$r->param("new_location_description")?$r->param("new_location_description"):'')) );
 2491   print CGI::Tr({}, CGI::td({},"&nbsp;"),
 2492     CGI::td({-colspan=>3}, "Addresses for new location " .
 2493       "(enter one per line, as single IP addresses " .
 2494       "(e.g., 192.168.1.101), address masks (e.g., " .
 2495       "192.168.1.0/24), or IP ranges (e.g., " .
 2496       "192.168.1.101-192.168.1.150)):"));
 2497   print CGI::Tr({}, CGI::td({}, "&nbsp;"),
 2498     CGI::td({-colspan=>3},
 2499       CGI::textarea({-name=>"new_location_addresses",
 2500                -rows=>5, -columns=>28,
 2501                -default=>$r->param("new_location_addresses")?$r->param("new_location_addresses"):''})));
 2502 
 2503   # delete action
 2504   print CGI::Tr({},
 2505     CGI::td({-colspan=>4},
 2506       CGI::div({-class=>"ResultsWithError"},
 2507          CGI::em({}, "Deletion deletes all location " .
 2508            "data and related addresses, and is" .
 2509 
 2510            " not undoable!"))));
 2511   print CGI::Tr({},
 2512     CGI::td({},
 2513       [ $actionRadios[2],
 2514         CGI::div({-class=>"ResultsWithError"},
 2515            "Delete location:") ]),
 2516     CGI::td({-colspan=>2},
 2517       CGI::popup_menu(-name=>"delete_location",
 2518           -values=>["",
 2519               "selected_locations",
 2520               @locationIDs],
 2521           -labels=>{selected_locations => "locations selected below",
 2522               "" => "no location"}) .
 2523       CGI::span({-style=>"color:#C33;"}, "  Confirm: ") .
 2524       CGI::checkbox({-name=>"delete_confirm",
 2525                -value=>"true",
 2526                -label=>""}) ) );
 2527   print CGI::end_table();
 2528 
 2529   print CGI::p({}, CGI::submit(-name=>"manage_locations", -value=>"Take Action!"));
 2530 
 2531   # existing location table
 2532   # FIXME: the styles for this table should be off in a stylesheet
 2533   #    somewhere
 2534   print CGI::start_div({align=>"center"}),
 2535     CGI::start_table({border=>1, cellpadding=>2});
 2536   print CGI::Tr({style=>"background-color:#e0e0e0;font-size:92%", align=>"left"},
 2537           CGI::th({}, ["Select", "Location", "Description",
 2538            "Addresses"]));
 2539   foreach my $loc ( @locations ) {
 2540     my $editAddr = $self->systemLink($urlpath, params=>{subDisplay=>"manage_locations", manage_location_action=>"edit_location_form", edit_location=>$loc->location_id});
 2541     print CGI::Tr({valign=>'top',style=>"background-color:#eeeeee;"},
 2542             CGI::td({style=>'font-size:85%;'},
 2543               [ CGI::checkbox(-name=>"delete_selected",
 2544                   -value=>$loc->location_id,
 2545                   -label=>''),
 2546           CGI::a({href=>$editAddr}, $loc->location_id),
 2547           $loc->description,
 2548           join(', ', @{$locAddr{$loc->location_id}}) ]));
 2549   }
 2550   print CGI::end_table(), CGI::end_div();
 2551   print CGI::end_form();
 2552 
 2553 
 2554 }
 2555 
 2556 sub add_location_handler {
 2557   my $self = shift();
 2558   my $r = $self->r;
 2559   my $db = $r->db;
 2560 
 2561   # the location data we're to add
 2562   my $locationID = $r->param("new_location_name");
 2563   my $locationDescr = $r->param("new_location_description");
 2564   my $locationAddr = $r->param("new_location_addresses");
 2565   # break the addresses up
 2566   $locationAddr =~ s/\s*-\s*/-/g;
 2567   $locationAddr =~ s/\s*\/\s*/\//g;
 2568   my @addresses = split(/\s+/, $locationAddr);
 2569 
 2570   # sanity checks
 2571   my $badAddr = '';
 2572   foreach my $addr ( @addresses ) {
 2573     unless ( new Net::IP($addr) ) {
 2574       $badAddr .= "$addr, ";
 2575       $locationAddr =~ s/$addr\n//s;
 2576     }
 2577   }
 2578   $badAddr =~ s/, $//;
 2579 
 2580   # a check to be sure that the location addresses don't already
 2581   #    exist
 2582   my $badLocAddr;
 2583   if ( ! $badAddr && $locationID ) {
 2584     if ( $db->countLocationAddresses( $locationID ) ) {
 2585       my @allLocAddr = $db->listLocationAddresses($locationID);
 2586       foreach my $addr ( @addresses ) {
 2587         $badLocAddr .= "$addr, "
 2588           if ( grep {/^$addr$/} @allLocAddr );
 2589       }
 2590       $badLocAddr =~ s/, $//;
 2591     }
 2592   }
 2593 
 2594   if ( ! @addresses || ! $locationID || ! $locationDescr ) {
 2595     print CGI::div({-class=>"ResultsWithError"},
 2596              "Missing required input data. Please check " .
 2597              "that you have filled in all of the create " .
 2598              "location fields and resubmit.");
 2599   } elsif ( $badAddr ) {
 2600     $r->param("new_location_addresses", $locationAddr);
 2601     print CGI::div({-class=>"ResultsWithError"},
 2602              "Address(es) $badAddr is(are) not in a " .
 2603              "recognized form.  Please check your " .
 2604              "data entry and resubmit.");
 2605   } elsif ( $db->existsLocation( $locationID ) ) {
 2606     print CGI::div({-class=>"ResultsWithError"},
 2607              "A location with the name $locationID " .
 2608              "already exists in the database.  Did " .
 2609              "you mean to edit that location instead?");
 2610   } elsif ( $badLocAddr ) {
 2611     print CGI::div({-class=>"ResultsWithError"},
 2612              "Address(es) $badLocAddr already exist " .
 2613              "in the database.  THIS SHOULD NOT HAPPEN!  " .
 2614              "Please double check the integrity of " .
 2615              "the WeBWorK database before continuing.");
 2616   } else {
 2617     # add the location
 2618     my $locationObj = $db->newLocation;
 2619     $locationObj->location_id( $locationID );
 2620     $locationObj->description( $locationDescr );
 2621     $db->addLocation( $locationObj );
 2622 
 2623     # and add the addresses
 2624     foreach my $addr ( @addresses ) {
 2625       my $locationAddress = $db->newLocationAddress;
 2626       $locationAddress->location_id($locationID);
 2627       $locationAddress->ip_mask($addr);
 2628 
 2629       $db->addLocationAddress( $locationAddress );
 2630     }
 2631 
 2632     # we've added the location, so clear those param
 2633     #    entries
 2634     $r->param('manage_location_action','none');
 2635     $r->param('new_location_name','');
 2636     $r->param('new_location_description','');
 2637     $r->param('new_location_addresses','');
 2638 
 2639     print CGI::div({-class=>"ResultsWithoutError"},
 2640              "Location $locationID has been created, " .
 2641              "with addresses " . join(', ', @addresses) .
 2642              ".");
 2643   }
 2644 
 2645   $self->manage_location_form;
 2646 }
 2647 
 2648 sub delete_location_handler {
 2649   my $self = shift;
 2650   my $r = $self->r;
 2651   my $db = $r->db;
 2652 
 2653   # what location are we deleting?
 2654   my $locationID = $r->param("delete_location");
 2655   # check for selected deletions if appropriate
 2656   my @delLocations = ( $locationID );
 2657   if ( $locationID eq 'selected_locations' ) {
 2658     @delLocations = $r->param("delete_selected");
 2659     $locationID = @delLocations;
 2660   }
 2661   # are we sure?
 2662   my $confirm = $r->param("delete_confirm");
 2663 
 2664   my $badID;
 2665   if ( ! $locationID ) {
 2666     print CGI::div({-class=>"ResultsWithError"},
 2667              "Please provide a location name " .
 2668              "to delete.");
 2669 
 2670   } elsif ( $badID = $self->existsLocations_helper( @delLocations ) ) {
 2671     print CGI::div({-class=>"ResultsWithError"},
 2672              "No location with name $badID " .
 2673              "exists in the database.");
 2674 
 2675   } elsif ( ! $confirm || $confirm ne 'true' ) {
 2676     print CGI::div({-class=>"ResultsWithError"},
 2677              "Location deletion requires confirmation.");
 2678   } else {
 2679     foreach ( @delLocations ) {
 2680       $db->deleteLocation( $_ );
 2681     }
 2682     print CGI::div({-class=>"ResultsWithoutError"},
 2683              "Location" . (@delLocations > 1 ? 's ' : ' ') .
 2684              join(', ', @delLocations) .
 2685              (@delLocations > 1 ? ' have ' : ' has ' ) .
 2686              'been deleted.');
 2687     $r->param('manage_location_action','none');
 2688     $r->param('delete_location','');
 2689   }
 2690   $self->manage_location_form;
 2691 }
 2692 sub existsLocations_helper {
 2693   my ($self, @locations) = @_;
 2694   my $db = $self->r->db;
 2695   foreach ( @locations ) {
 2696     return $_ if ( ! $db->existsLocation($_) );
 2697   }
 2698   return 0;
 2699 }
 2700 
 2701 sub edit_location_form {
 2702   my $self = shift;
 2703   my $r = $self->r;
 2704   my $db = $r->db;
 2705 
 2706   my $locationID = $r->param("edit_location");
 2707   if ( $db->existsLocation( $locationID ) ) {
 2708     my $location = $db->getLocation($locationID);
 2709     # this doesn't give that nice a sort for IP addresses,
 2710     #    b/c there's the problem with 192.168.1.168 sorting
 2711     #    ahead of 192.168.1.2.  we could do better if we
 2712     #    either invoked Net::IP in the sort routine, or if
 2713     #    we insisted on dealing only with IPv4.  rather than
 2714     #    deal with either of those, we'll leave this for now
 2715     my @locAddresses = sort { $a cmp $b }
 2716       $db->listLocationAddresses($locationID);
 2717 
 2718     print CGI::h2("Editing location ", $locationID);
 2719 
 2720     print CGI::p({},"Edit the current value of the location ",
 2721            "description, if desired, then add and select ",
 2722            "addresses to delete, and then click the ",
 2723            "\"Take Action\" button to make all of your ",
 2724            "changes.  Or, click \"Manage Locations\" ",
 2725            "above to make no changes and return to the ",
 2726            "Manage Locations page.");
 2727 
 2728     print CGI::start_form(-method=>"POST",
 2729               -action=>$r->uri);
 2730     print $self->hidden_authen_fields;
 2731     print $self->hidden_fields("subDisplay");
 2732     print CGI::hidden(-name=>'edit_location',
 2733           -default=>$locationID);
 2734     print CGI::hidden(-name=>'manage_location_action',
 2735           -default=>'edit_location_handler');
 2736 
 2737     print CGI::start_table();
 2738     print CGI::Tr({-valign=>'top'},
 2739       CGI::td({-colspan=>3},
 2740         "Location description: ", CGI::br(),
 2741         CGI::textfield(-name=>"location_description",
 2742                  -size=>"50",
 2743                  -default=>$location->description)));
 2744     print CGI::Tr({-valign=>'top'},
 2745       CGI::td({-width=>"50%"},
 2746         "Addresses to add to the location " .
 2747         "(enter one per line, as single IP addresses " .
 2748         "(e.g., 192.168.1.101), address masks " .
 2749         "(e.g., 192.168.1.0/24), or IP ranges " .
 2750         "(e.g., 192.168.1.101-192.168.1.150)):" .
 2751         CGI::br() .
 2752         CGI::textarea({-name=>"new_location_addresses",
 2753                  -rows=>5, -columns=>28})),
 2754       CGI::td({}, "&nbsp;"),
 2755       CGI::td({-width=>"50%"},
 2756         "Existing addresses for the location are " .
 2757         "given in the scrolling list below.  Select " .
 2758         "addresses from the list to delete them:" .
 2759         CGI::br() .
 2760         CGI::scrolling_list(-name=>'delete_location_addresses',
 2761                 -values=>[@locAddresses],
 2762                 -size=>8,
 2763                 -multiple=>'multiple') .
 2764         CGI::br() . "or: " .
 2765         CGI::checkbox(-name=>'delete_all_addresses',
 2766                 -value=>'true',
 2767                 -label=>'Delete all existing addresses')
 2768          ));
 2769 
 2770     print CGI::end_table();
 2771 
 2772     print CGI::p({},CGI::submit(-value=>'Take Action!'));
 2773 
 2774   } else {
 2775     print CGI::div({-class=>"ResultsWithError"},
 2776              "Location $locationID does not exist " .
 2777              "in the WeBWorK database.  Please check " .
 2778              "your input (perhaps you need to reload " .
 2779              "the location management page?).");
 2780 
 2781     $self->manage_location_form;
 2782   }
 2783 }
 2784 
 2785 sub edit_location_handler {
 2786   my $self = shift;
 2787   my $r = $self->r;
 2788   my $db = $r->db;
 2789 
 2790   my $locationID = $r->param("edit_location");
 2791   my $locationDesc = $r->param("location_description");
 2792   my $addAddresses = $r->param("new_location_addresses");
 2793   my @delAddresses = $r->param("delete_location_addresses");
 2794   my $deleteAll = $r->param("delete_all_addresses");
 2795 
 2796   # gut check
 2797   if ( ! $locationID ) {
 2798     print CGI::div({-class=>"ResultsWithError"},
 2799              "No location specified to edit?! " .
 2800              "Please check your input data.");
 2801     $self->manage_location_form;
 2802 
 2803   } elsif ( ! $db->existsLocation( $locationID ) ) {
 2804     print CGI::div({-class=>"ResultsWithError"},
 2805              "Location $locationID does not exist " .
 2806              "in the WeBWorK database.  Please check " .
 2807              "your input (perhaps you need to reload " .
 2808              "the location management page?).");
 2809     $self->manage_location_form;
 2810   } else {
 2811     my $location = $db->getLocation($locationID);
 2812 
 2813     # get the current location addresses.  if we're deleting
 2814     #   all of the existing addresses, we don't use this list
 2815     #   to determine which addresses to add, however.
 2816     my @currentAddr = $db->listLocationAddresses($locationID);
 2817     my @compareAddr = ( ! $deleteAll || $deleteAll ne 'true' )
 2818       ? @currentAddr : ();
 2819 
 2820     my $doneMsg = '';
 2821 
 2822     if ($locationDesc && $location->description ne $locationDesc) {
 2823       $location->description($locationDesc);
 2824       $db->putLocation($location);
 2825       $doneMsg .= CGI::p({},"Updated location description.");
 2826     }
 2827     # get the actual addresses to add out of the text field
 2828     $addAddresses =~ s/\s*-\s*/-/g;
 2829     $addAddresses =~ s/\s*\/\s*/\//g;
 2830     my @addAddresses = split(/\s+/, $addAddresses);
 2831 
 2832     # make sure that we're adding and deleting only those
 2833     #    addresses that are not yet/currently in the location
 2834     #    addresses
 2835     my @toAdd = ();  my @noAdd = ();
 2836     my @toDel = ();  my @noDel = ();
 2837     foreach my $addr ( @addAddresses ) {
 2838       if (grep {/^$addr$/} @compareAddr) {push(@noAdd,$addr);}
 2839       else { push(@toAdd, $addr); }
 2840     }
 2841     if ( $deleteAll && $deleteAll eq 'true' ) {
 2842       @toDel = @currentAddr;
 2843     } else {
 2844       foreach my $addr ( @delAddresses ) {
 2845         if (grep {/^$addr$/} @currentAddr) {
 2846           push(@toDel,$addr);
 2847         } else { push(@noDel, $addr); }
 2848       }
 2849     }
 2850 
 2851     # and make sure that all of the addresses we're adding are
 2852     #    a sensible form
 2853     my $badAddr = '';
 2854     foreach my $addr ( @toAdd ) {
 2855       unless ( new Net::IP($addr) ) {
 2856         $badAddr .= "$addr, ";
 2857       }
 2858     }
 2859     $badAddr =~ s/, $//;
 2860 
 2861     # delete addresses first, because we allow deletion of
 2862     #    all existing addresses, then addition of addresses.
 2863     #    note that we don't allow deletion and then addition
 2864     #    of the same address normally, however; in that case
 2865     #    we'll end up just deleting the address.
 2866     foreach ( @toDel ) {
 2867       $db->deleteLocationAddress($locationID, $_);
 2868     }
 2869     foreach ( @toAdd ) {
 2870       my $locAddr = $db->newLocationAddress;
 2871       $locAddr->location_id($locationID);
 2872       $locAddr->ip_mask($_);
 2873 
 2874       $db->addLocationAddress($locAddr);
 2875     }
 2876 
 2877     my $addrMsg = '';
 2878     $addrMsg .= "Deleted addresses " . join(', ', @toDel) .
 2879       " from location." . CGI::br() if ( @toDel );
 2880     $addrMsg .= "Added addresses " . join(', ', @toAdd) .
 2881       " to location $locationID.  " if ( @toAdd );
 2882 
 2883     my $badMsg = '';
 2884     $badMsg .= 'Address(es) ' . join(', ', @noAdd) .
 2885       " in the add list is(are) already in the " .
 2886       "location $locationID, and so were " .
 2887       "skipped." . CGI::br() if ( @noAdd );
 2888     $badMsg .= "Address(es) $badAddr is(are) not in a " .
 2889       "recognized form.  Please check your data " .
 2890       "entry and try again." . CGI::br() if ( $badAddr );
 2891     $badMsg .= 'Address(es) ' . join(', ', @noDel) .
 2892       " in the delete list is(are) not in the " .
 2893       "location $locationID, and so were " .
 2894       "skipped." if ( @noDel );
 2895 
 2896     print CGI::div({-class=>"ResultsWithError"}, $badMsg)
 2897       if ( $badMsg );
 2898     if ( $doneMsg || $addrMsg ) {
 2899       print CGI::div({-class=>"ResultsWithoutError"},
 2900                CGI::p({}, $doneMsg, $addrMsg));
 2901     } else {
 2902       print CGI::div({-class=>"ResultsWithError"},
 2903                "No valid changes submitted for ",
 2904                "location $locationID.");
 2905     }
 2906 
 2907     $self->edit_location_form;
 2908   }
 2909 }
 2910 
 2911 sub hide_inactive_course_form {
 2912   my ($self) = @_;
 2913   my $r = $self->r;
 2914   my $ce = $r->ce;
 2915 
 2916   my $coursesDir = $ce->{webworkDirs}->{courses};
 2917   my @courseIDs = listCourses($ce);
 2918   my $hide_listing_format   = $r->param("hide_listing_format");
 2919   unless (defined $hide_listing_format) {$hide_listing_format = 'last_login';}  #use the default
 2920 # warn "hide_listing_format is $hide_listing_format";
 2921 
 2922   # Get and store last modify time for login.log for all courses. Also get visibility status.
 2923   my %courseLabels;
 2924   my @noLoginLogIDs = ();
 2925   my @loginLogIDs = ();
 2926   my @hideCourseIDs = ();
 2927   my ($loginLogFile, $epoch_modify_time, $courseDir);
 2928   foreach my $courseID (@courseIDs) {
 2929     $loginLogFile = "$coursesDir/$courseID/logs/login.log";
 2930     if (-e $loginLogFile) {                 #this should always exist except for the model course
 2931       $epoch_modify_time = stat($loginLogFile)->mtime;
 2932       $coursesData{$courseID}{'epoch_modify_time'} = $epoch_modify_time;
 2933       $coursesData{$courseID}{'local_modify_time'} = ctime($epoch_modify_time);
 2934       push(@loginLogIDs,$courseID);
 2935     } else {
 2936       $coursesData{$courseID}{'local_modify_time'} = 'no login.log';  #this should never be the case except for the model course
 2937       push(@noLoginLogIDs,$courseID);
 2938     }
 2939     if (-f "$coursesDir/$courseID/hide_directory") {
 2940       $coursesData{$courseID}{'status'} = 'hidden';
 2941     } else {
 2942       $coursesData{$courseID}{'status'} = 'visible';
 2943     }
 2944     $courseLabels{$courseID} = "$courseID  ($coursesData{$courseID}{'status'} :: $coursesData{$courseID}{'local_modify_time'}) ";
 2945   }
 2946   if ($hide_listing_format eq 'last_login') {
 2947     @noLoginLogIDs = sort {lc($a) cmp lc ($b) } @noLoginLogIDs; #this should be an empty arrey except for the model course
 2948     @loginLogIDs = sort byLoginActivity @loginLogIDs;  # oldest first
 2949     @hideCourseIDs = (@noLoginLogIDs,@loginLogIDs);
 2950   } else { # in this case we sort alphabetically
 2951     @hideCourseIDs = sort {lc($a) cmp lc ($b) } @courseIDs;
 2952   }
 2953 
 2954   print CGI::h2("Hide Inactive courses");
 2955 
 2956     print CGI::p(
 2957      'Select the course(s) you want to hide (or unhide) and then click "Hide Courses" (or "Unhide Courses"). Hiding
 2958      a course that is already hidden does no harm (the action is skipped). Likewise unhiding a course that is
 2959      already visible does no harm (the action is skipped).  Hidden courses are still active but are not listed in
 2960      the list of WeBWorK courses on the opening page.  To access the course, an instructor or student must know the
 2961      full URL address for the course.'
 2962   );
 2963 
 2964   print CGI::p(
 2965     'Courses are listed either alphabetically or in order by the time of most recent login activity, oldest first.
 2966     To change the listing order check the mode you want and click "Refresh Listing".  The listing format is:
 2967     Course_Name (status :: date/time of most recent login) where status is "hidden" or "visible".');
 2968 
 2969 
 2970   print CGI::start_form(-method=>"POST", -action=>$r->uri);
 2971 
 2972   my %list_labels = (
 2973                 alphabetically => 'alphabetically',
 2974                 last_login => 'by last login date',
 2975                 );
 2976 
 2977   print CGI::table(
 2978       CGI::Tr({},
 2979       CGI::p("Select a listing format:"),
 2980       CGI::radio_group(-name=>'hide_listing_format',
 2981                       -values=>['alphabetically', 'last_login'],
 2982                       -default=>'last_login',
 2983                       -labels=>\%list_labels,
 2984                       ),
 2985       ),
 2986     );
 2987   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"hide_course_refresh", -value=>"Refresh Listing"), CGI::submit(-name=>"hide_course", -value=>"Hide Courses"),
 2988   CGI::submit(-name=>"unhide_course", -value=>"Unhide Courses"));
 2989   print $self->hidden_authen_fields;
 2990   print $self->hidden_fields("subDisplay");
 2991 
 2992   print CGI::p("Select course(s) to hide or unhide.");
 2993 
 2994   print CGI::table({class=>"FormLayout"},
 2995     CGI::Tr({},
 2996       CGI::td(
 2997         CGI::scrolling_list(
 2998           -name => "hide_courseIDs",
 2999           -values => \@hideCourseIDs,
 3000           -size => 15,
 3001           -multiple => 1,
 3002           -labels => \%courseLabels,
 3003         ),
 3004       ),
 3005 
 3006     ),
 3007   );
 3008 
 3009   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"hide_course_refresh", -value=>"Refresh Listing"), CGI::submit(-name=>"hide_course", -value=>"Hide Courses"),
 3010   CGI::submit(-name=>"unhide_course", -value=>"Unhide Courses"));
 3011 
 3012   print CGI::end_form();
 3013 }
 3014 
 3015 sub hide_course_validate {
 3016   my ($self) = @_;
 3017   my $r = $self->r;
 3018   my $ce = $r->ce;
 3019   #my $db = $r->db;
 3020   #my $authz = $r->authz;
 3021   my $urlpath = $r->urlpath;
 3022 
 3023   my @hide_courseIDs     = $r->param("hide_courseIDs");
 3024   @hide_courseIDs        = () unless @hide_courseIDs;
 3025 
 3026   my @errors;
 3027 
 3028   unless (@hide_courseIDs) {
 3029     push @errors, "You must specify a course name.";
 3030   }
 3031   return @errors;
 3032 }
 3033 
 3034 
 3035 sub do_hide_inactive_course {
 3036   my ($self) = @_;
 3037   my $r = $self->r;
 3038   my $ce = $r->ce;
 3039 
 3040   my $coursesDir = $ce->{webworkDirs}->{courses};
 3041 
 3042   my $hide_courseID;
 3043   my @hide_courseIDs     = $r->param("hide_courseIDs");
 3044   @hide_courseIDs        = () unless @hide_courseIDs;
 3045 
 3046   my $hideDirFileContent = 'Place a file named "hide_directory" in a course or other directory
 3047 and it will not show up in the courses list on the WeBWorK home page.
 3048 It will still appear in the Course Administration listing.';
 3049   my @succeeded_courses = ();
 3050   my $succeeded_count = 0;
 3051   my @failed_courses = ();
 3052   my $already_hidden_count = 0;
 3053 
 3054   foreach $hide_courseID (@hide_courseIDs) {
 3055     my $hideDirFile = "$coursesDir/$hide_courseID/hide_directory";
 3056     if (-f $hideDirFile) {
 3057       $already_hidden_count++;
 3058       next;
 3059     } else {
 3060       local *HIDEFILE;
 3061       if (open (HIDEFILE, ">", $hideDirFile)) {
 3062         print HIDEFILE "$hideDirFileContent";
 3063         close HIDEFILE;
 3064         push @succeeded_courses,$hide_courseID;
 3065         $succeeded_count++;
 3066       } else {
 3067         push @failed_courses,$hide_courseID;
 3068       }
 3069     }
 3070   }
 3071 
 3072   if (@failed_courses) {
 3073     print CGI::div({class=>"ResultsWithError"},
 3074       CGI::p("Errors occured while hiding the courses listed below when attempting to create the file hide_directory in the course's directory.
 3075 Check the ownership and permissions of the course's directory, e.g $coursesDir/$failed_courses[0]/"),
 3076       CGI::p("@failed_courses"),
 3077     );
 3078   }
 3079   my $succeeded_message = '';
 3080 
 3081   if ($succeeded_count < 1 and $already_hidden_count > 0) {
 3082     $succeeded_message = "Except for possible errors listed above, all selected courses are already hidden.";
 3083   }
 3084 
 3085   if ($succeeded_count) {
 3086     if ($succeeded_count < 6) {
 3087       $succeeded_message = "The following courses were successfully hidden: @succeeded_courses";
 3088     } else {
 3089       $succeeded_message = "$succeeded_count courses were successfully hidden.";
 3090     }
 3091   }
 3092   if ($succeeded_count or $already_hidden_count) {
 3093       print CGI::div({class=>"ResultsWithoutError"},
 3094       CGI::p("$succeeded_message"),
 3095     );
 3096   }
 3097 }
 3098 
 3099 sub unhide_course_validate {
 3100   my ($self) = @_;
 3101   my $r = $self->r;
 3102   my $ce = $r->ce;
 3103   #my $db = $r->db;
 3104   #my $authz = $r->authz;
 3105   my $urlpath = $r->urlpath;
 3106 
 3107   my @unhide_courseIDs     = $r->param("hide_courseIDs");
 3108   @unhide_courseIDs        = () unless @unhide_courseIDs;
 3109 
 3110   my @errors;
 3111 
 3112   unless (@unhide_courseIDs) {
 3113     push @errors, "You must specify a course name.";
 3114   }
 3115   return @errors;
 3116 }
 3117 
 3118 
 3119 sub do_unhide_inactive_course {
 3120   my ($self) = @_;
 3121   my $r = $self->r;
 3122   my $ce = $r->ce;
 3123 
 3124   my $coursesDir = $ce->{webworkDirs}->{courses};
 3125 
 3126   my $unhide_courseID;
 3127   my @unhide_courseIDs     = $r->param("hide_courseIDs");
 3128   @unhide_courseIDs        = () unless @unhide_courseIDs;
 3129 
 3130   my @succeeded_courses = ();
 3131   my $succeeded_count = 0;
 3132   my @failed_courses = ();
 3133   my $already_visible_count = 0;
 3134 
 3135   foreach $unhide_courseID (@unhide_courseIDs) {
 3136     my $hideDirFile = "$coursesDir/$unhide_courseID/hide_directory";
 3137     unless (-f $hideDirFile) {
 3138       $already_visible_count++;
 3139       next;
 3140     }
 3141     remove_tree("$hideDirFile", {error => \my $err});
 3142     if (@$err) {
 3143       push @failed_courses,$unhide_courseID;
 3144     } else {
 3145     push @succeeded_courses,$unhide_courseID;
 3146     $succeeded_count++;
 3147     }
 3148   }
 3149   my $succeeded_message = '';
 3150 
 3151   if ($succeeded_count < 1 and $already_visible_count > 0) {
 3152     $succeeded_message = "Except for possible errors listed above, all selected courses are already unhidden.";
 3153   }
 3154 
 3155   if ($succeeded_count) {
 3156     if ($succeeded_count < 6) {
 3157       $succeeded_message = "The following courses were successfully unhidden: @succeeded_courses";
 3158     } else {
 3159       $succeeded_message = "$succeeded_count courses were successfully unhidden.";
 3160     }
 3161   }
 3162   if ($succeeded_count or $already_visible_count) {
 3163     print CGI::div({class=>"ResultsWithoutError"},
 3164     CGI::p("$succeeded_message"),
 3165     );
 3166   }
 3167   if (@failed_courses) {
 3168     print CGI::div({class=>"ResultsWithError"},
 3169       CGI::p("Errors occured while unhiding the courses listed below when attempting delete the file hide_directory in the course's directory.
 3170 Check the ownership and permissions of the course's directory, e.g $coursesDir/$failed_courses[0]/"),
 3171       CGI::p("@failed_courses"),
 3172     );
 3173   }
 3174 }
 3175 
 3176 
 3177 
 3178 ################################################################################
 3179 #   registration forms added by Mike Gage 5-5-2008
 3180 ################################################################################
 3181 
 3182 our $registered_file_name = "registered_$main::VERSION";
 3183 
 3184 sub display_registration_form {
 3185   my $self = shift;
 3186   my $ce   = $self->r->ce;
 3187   my $registeredQ = (-e ($ce->{courseDirs}->{root})."/$registered_file_name")?1:0;
 3188   #my $registration_subDisplay = ( $self->{method_to_call} eq "registration_form") ?  1: 0;
 3189   return 0  if $registeredQ or $self->r->param("register_site");     #otherwise return registration form
 3190   return  q!
 3191   <center>
 3192   <table class="messagebox" style="background-color:#FFFFCC;width:60%">
 3193   <tr><td>
 3194   !,
 3195   CGI::p("If you are using your WeBWorK server for courses please help us out by registering your server."),
 3196   CGI::p("We are often asked how many institutions are using WeBWorK and how many students are using
 3197   WeBWorK  Since WeBWorK is open source and can be freely downloaded from ".
 3198   CGI::a({href=>'http://webwork.maa.org'},'http://webwork.maa.org' ). " and ".
 3199   CGI::a({href=> 'http://www.openwebwork.org'},'http://www.openwebwork.org'). ", it is frequently difficult for us to give a reasonable answer to this
 3200   question."),
 3201   CGI::p("You can help by registering your current version of WeBWorK -- click the button, answer a few
 3202   questions (the ones you can answer easily) and send the email.  It takes less than two minutes.  Thank you!. -- The WeBWorK Team"),
 3203   q!
 3204   </td>
 3205   </tr>
 3206   <tr><td align="center">
 3207   !,
 3208   CGI::a({href=>$self->systemLink($self->r->urlpath, params=>{subDisplay=>"registration"})}, "Register"),
 3209   q!
 3210   </td></tr>
 3211   </table>
 3212   </center>
 3213   !;
 3214 }
 3215 
 3216 sub registration_form {
 3217   my $self = shift;
 3218   my $ce = $self->r->ce;
 3219 
 3220   print "<center>";
 3221   print  "\n",CGI::p({style=>"text-align: left; width:60%"},
 3222   "\nPlease ",
 3223   CGI::a({href=>'mailto:gage@math.rochester.edu?'
 3224   .'subject=WeBWorK%20Server%20Registration'
 3225   .'&body='
 3226   .uri_escape("Thanks for registering your WeBWorK server.  We'd appreciate if you would answer
 3227   as many of these questions as you can conveniently.  We need this data so we can better
 3228   answer questions such as 'How many institutions have webwork servers?' and 'How many students
 3229   use WeBWorK?'.  Your email and contact information  will be kept private.  We will
 3230   list your institution as one that uses WeBWorK unless you tell us to keep that private as well.
 3231   \n\nThank you. \n\n--Mike Gage \n\n
 3232   ")
 3233   .uri_escape("Server URL: ".$ce->{apache_root_url}." \n\n")
 3234   .uri_escape("WeBWorK version: $main::VERSION \n\n")
 3235   .uri_escape("Institution name (e.g. University of Rochester): \n\n")
 3236   .uri_escape("Contact person name: \n\n")
 3237   .uri_escape("Contact email: \n\n")
 3238   .uri_escape("Approximate number of courses run each term: \n\n")
 3239   .uri_escape("Approximate number of students using this server each term: \n\n")
 3240   .uri_escape("Other institutions who use WeBWorK courses hosted on this server: \n\n")
 3241   .uri_escape("Other comments: \n\n")
 3242   },
 3243   'click here'),
 3244   q! to open your email application.  There are a few questions, some of which have already
 3245   been filled in for your installation.  Fill in the other questions which you can answer easily and send
 3246   the email to gage@math.rochester.edu
 3247   !
 3248   );
 3249 
 3250 
 3251 
 3252   print  "\n",CGI::p({style=>"text-align: left; width:60%"},q!Once you have emailed your registration information you can hide the "registration" banner
 3253   for successive visits by clicking
 3254   the button below. It writes an empty file (!.CGI::code('registered_versionNumber').q!) to the directory !.CGI::code('..../courses/admin')
 3255   );
 3256 
 3257   print "</center>";
 3258   print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
 3259   print $self->hidden_authen_fields;
 3260   print $self->hidden_fields("subDisplay");
 3261   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"register_site", -label=>"Site has been registered"));
 3262   print CGI::end_form();
 3263 }
 3264 
 3265 
 3266 
 3267 sub do_registration {
 3268   my $self = shift;
 3269   my $ce   = $self->r->ce;
 3270   my $registered_file_path = $ce->{courseDirs}->{root}."/$registered_file_name";
 3271   # warn qq!`echo "info" >$registered_file_path`!;
 3272   `echo "info" >$registered_file_path`;
 3273 
 3274   print  "\n<center>",CGI::p({style=>"text-align: left; width:60%"},q{Registration action completed.  Thank you very much for registering WeBWorK!"});
 3275 
 3276   print CGI::start_form(-method=>"POST", -action=>$self->r->uri);
 3277   print $self->hidden_authen_fields;
 3278   print CGI::p({style=>"text-align: center"}, CGI::submit(-name=>"registration_completed", -label=>"Continue"));
 3279   print CGI::end_form();
 3280   print "</center>";
 3281 
 3282 }
 3283 ################################################################################
 3284 # Utilities
 3285 ################################################################################
 3286 sub formatReportOnDatabaseTables {
 3287   my ($tables_ok,$dbStatus) =  @_;
 3288 
 3289   # print db status
 3290 
 3291     my %msg =(    WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A         => CGI::span({style=>"color:red"}," Table defined in schema but missing in database"),
 3292             WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B         => CGI::span({style=>"color:red"}," Table defined in database but missing in schema"),
 3293             WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B   => CGI::span({style=>"color:green"}," Table is ok "),
 3294             WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database table definitions do not agree "),
 3295     );
 3296     my %msg2 =(    WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A        => CGI::span({style=>"color:red"}," missing in database"),
 3297             WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B         => CGI::span({style=>"color:red"}," missing in schema"),
 3298             WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B   => CGI::span({style=>"color:green"}," is ok "),
 3299             WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B => CGI::span({style=>"color:red"}," Schema and database field definitions do not agree "),
 3300     );
 3301     my $all_tables_ok=1;
 3302     my $extra_database_tables=0;
 3303     my $extra_database_fields=0;
 3304     my $str ='';
 3305     $str .= CGI::start_ul();
 3306     foreach my $table (sort keys %$dbStatus) {
 3307       my $table_status = $dbStatus->{$table}->[0];
 3308       $str .= CGI::li( CGI::b($table) .  $msg{ $table_status } );
 3309 
 3310       CASE: {
 3311         $table_status == WeBWorK::Utils::CourseIntegrityCheck::SAME_IN_A_AND_B
 3312           && do{ last CASE;
 3313           };
 3314         $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
 3315           && do{
 3316                $all_tables_ok = 0; last CASE;
 3317           };
 3318         $table_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
 3319           && do{
 3320                $extra_database_tables = 1; last CASE;
 3321           };
 3322         $table_status == WeBWorK::Utils::CourseIntegrityCheck::DIFFER_IN_A_AND_B
 3323           && do{
 3324             my %fieldInfo = %{ $dbStatus->{$table}->[1] };
 3325             $str .=CGI::start_ul();
 3326             foreach my $key (keys %fieldInfo) {
 3327               my $field_status = $fieldInfo{$key}->[0];
 3328               CASE2: {
 3329                 $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_B
 3330                   && do{
 3331                      $extra_database_fields = 1; last CASE2;
 3332                   };
 3333                 $field_status == WeBWorK::Utils::CourseIntegrityCheck::ONLY_IN_A
 3334                   && do{
 3335                      $all_tables_ok=0; last CASE2;
 3336                   };
 3337               }
 3338               $str .= CGI::li("Field $key => ". $msg2{$field_status });
 3339             }
 3340             $str .= CGI::end_ul();
 3341           };
 3342       }
 3343 
 3344 
 3345     }
 3346     $str.=CGI::end_ul();
 3347     $str .= ($all_tables_ok)?CGI::p("Database tables are ok") : "";
 3348     return ($all_tables_ok, $extra_database_tables, $extra_database_fields, $str);
 3349 }
 3350 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9