Return to londocs.pm CVS log

Up to [LON-CAPA] / modules / gci

- Copying custom londocs.pm for GCI project to gci modules directory.

    1: # The LearningOnline Network
    2: # Documents
    3: # Modified for GCI Concept Inventory Assemby
    4: #
    5: # $Id: londocs.pm,v 1.1 2009/09/11 15:49:11 gci Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: 
   30: 
   31: 
   32: package Apache::londocs;
   33: 
   34: use strict;
   35: 
   36: use Apache::Constants qw(:common :http);
   37: use Apache::imsexport;
   38: use Apache::lonnet;
   39: use Apache::loncommon;
   40: use LONCAPA::map();
   41: use Apache::lonratedt();
   42: use Apache::lonxml;
   43: use Apache::lonclonecourse;
   44: use Apache::lonnavmaps;
   45: use Apache::lonindexer;
   46: use HTML::Entities;
   47: use GDBM_File;
   48: use Apache::lonlocal;
   49: use Cwd;
   50: use LONCAPA qw(:DEFAULT :match);
   51: 
   52: my $iconpath;
   53: 
   54: my %hash;
   55: 
   56: my $hashtied;
   57: my %alreadyseen=();
   58: 
   59: my %help=();
   60: 
   61: 
   62: my $path;
   63: my $version;
   64: my $reqnum;
   65: my @categories;
   66: my @allprobs;
   67: my %probcat;
   68: my %prereqs;
   69: my @defchosen;
   70: my @chosen;
   71: 
   72: sub setdefaults {
   73:    $path='/res/gci/gci';
   74:    $version='GCIv2-1-1';
   75:    $reqnum=15;
   76:    @allprobs=('01','02','03','04','05','06','07',
   77:               '08','10',
   78:               '09',
   79:               '11','12','13','14','15','16','17',
   80:               '18','69',
   81:               '19','20',
   82:               '21','22','23','24','25','26','27','28','29','30',
   83:               '31','32','33','34','35','36','37','38',
   84:               '39A','39B',
   85:               '40',
   86:               '41','42','43','44','45','46','47','48','49','50',
   87:               '51',
   88:               '52','57',
   89:               '53','54','55','56','58',
   90:               '60',
   91:               '61','62','63','64','65','66','67','68','70',
   92:               '71',
   93:               '2004_73');
   94: 
   95:    @categories=('M1','M2','M3','M4',
   96:                 'A','B','C','D','E','F','G','H','I','J','K');
   97:    %probcat =('01' => 'M1','02' => 'M2','03' => 'A' ,'04' => 'A' ,'05' => ''  ,'06' => 'A' ,'07' => 'B' ,'08' => 'B' ,'09' => 'B' ,'10' => 'C' ,
   98:               '11' => ''  ,'12' => 'C' ,'13' => 'C' ,'14' => 'C' ,'15' => 'C' ,'16' => 'C' ,'17' => 'C' ,'18' => 'D' ,'19' => 'D' ,'20' => 'D' ,
   99:               '21' => 'D' ,'22' => 'D' ,'23' => 'D' ,'24' => 'D' ,'25' => 'D' ,'26' => 'E' ,'27' => 'E' ,'28' => 'E' ,'29' => ''  ,'30' => 'E' ,
  100:               '31' => ''  ,'32' => 'F' ,'33' => 'F' ,'34' => 'F' ,'35' => 'F' ,'36' => 'F' ,'37' => 'M3','38' => 'G' ,
  101:               '39A'=> 'G' ,'39B'=> 'G' ,
  102:               '40' => 'G' ,
  103:               '41' => 'G' ,'42' => 'G' ,'43' => 'G' ,'44' => 'G' ,'45' => 'G' ,'46' => 'G' ,'47' => 'H' ,'48' => 'H' ,'49' => 'H' ,'50' => 'H' ,
  104:               '51' => 'H' ,'52' => 'H' ,'53' => 'H' ,'54' => 'I' ,'55' => 'I' ,'56' => 'I' ,'57' => 'I' ,'58' => 'I' ,
  105:               '60' => 'I' ,
  106:               '61' => 'I' ,'62' => 'I' ,'63' => 'J' ,'64' => 'J' ,'65' => 'J' ,'66' => 'K' ,'67' => 'K' ,'68' => 'K' ,'69' => 'K' ,'70' => 'K' ,
  107:               '71' => 'K' ,
  108:               '2004_73' => 'M4');
  109:    %prereqs=('10' => '08', '57' => '52', '69' => '18');
  110:    @defchosen=('01','02','03','07','12','18','26','32','37','38','47','54','63','66','2004_73');
  111: }
  112: 
  113: sub checkvalid {
  114:    my %covered=();
  115:    my %chosenproblems=();
  116:    my @errors=();
  117:    my $num=$#chosen+1;
  118:    if ($num<$reqnum) {
  119:       push(@errors,&mt('Test requires at least [_1] items, but has only [_2].',$reqnum,$num)); 
  120:    }
  121:    foreach my $item (@chosen) {
  122:       $chosenproblems{$item}=1;
  123:       $covered{$probcat{$item}}=1;
  124:    }
  125:    foreach my $cat (@categories) {
  126:       unless ($covered{$cat}) {
  127:          push(@errors,&mt('Category [_1] not covered.',$cat));
  128:       }
  129:    }
  130:    foreach my $item (@chosen) {
  131:        if ($prereqs{$item}) {
  132:           unless ($chosenproblems{$prereqs{$item}}) {
  133:              push(@errors,&mt('Problem [_1] requires problem [_2].',$item,$prereqs{$item}));
  134:           }
  135:        }
  136:    }
  137:    return @errors;
  138: }
  139: 
  140: sub fullurl {
  141:    my ($item)=@_;
  142:    unless ($item=~/\_/) { $item='_'.$item; }
  143:    return $path.'/'.$version.'/GCI'.$item.'.problem';
  144: }
  145: 
  146: sub listresources {
  147:    my ($r)=@_;
  148:    my @errors=&checkvalid();
  149:    if ($#errors>-1) {
  150:       $r->print('<span class="LC_error">'.&mt('Your test is not yet valid.').'</span><p>'.&mt('The following issues must be addressed before you can use the test:').'<ul>');
  151:       foreach my $message (@errors) {
  152:          $r->print('<li>'.$message.'</li>');
  153:       }
  154:       $r->print('</ul></p>');
  155:    }
  156:    my %chosen=();
  157:    foreach my $item (@chosen) {
  158:       $chosen{$item}=1;
  159:    }
  160:    $r->print('<form name="selecteditems" method="post">');
  161:    $r->print('<p>'.&mt('You may select test items from the list below and then press "Store Problem Selection" at the bottom of the screen.').'</p>'); 
  162:    $r->print(&Apache::loncommon::start_data_table().
  163:              &Apache::loncommon::start_data_table_header_row().
  164:              '<th>'.&mt('Select').'</th><th>'.&mt('Problem').'</th><th>'.&mt('Category').'</th><th>'.&mt('Preview').'</th>'.
  165:              &Apache::loncommon::end_data_table_header_row());
  166:    foreach my $item (@allprobs) {
  167:       $r->print(&Apache::loncommon::start_data_table_row());
  168:       $r->print('<td><font size="+3">');
  169:       $r->print('<input type="checkbox" name="item'.$item.'"');
  170:       if ($chosen{$item}) { $r->print(' checked="checked"'); }
  171:       $r->print(' /></font></td>');
  172:       $r->print('<td><font size="+3">'.$item.'</font></td><td><font size="+3">'.$probcat{$item}.'</font></td>');
  173:       my $output=&Apache::lonindexer::showpreview(&fullurl($item));
  174:       $r->print('<td> '.($output eq '' ? '&nbsp;':$output)." </td>\n");
  175: 
  176:       $r->print( &Apache::loncommon::end_data_table_row());
  177:    }
  178:    $r->print(&Apache::loncommon::end_data_table());
  179:    $r->print('<input type="hidden" name="phase" value="storemap" />');
  180:    $r->print('<input type="submit" value="'.&mt('Store Problem Selection').'" /></form>');
  181: }
  182: 
  183: sub evaluate {
  184:    if ($env{'form.phase'} eq 'storemap') {
  185:       @chosen=();
  186:       foreach my $item (@allprobs) {
  187:          if ($env{'form.item'.$item}) {
  188:             push(@chosen,$item);
  189:          }
  190:       }
  191:    }
  192: }
  193: 
  194: sub mapread {
  195:     my $coursedom=$env{'course.'.$env{'request.course.id'}.'.domain'};
  196:     my $coursenum=$env{'course.'.$env{'request.course.id'}.'.num'};
  197:     return
  198:       &LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/default.sequence');
  199: }
  200: 
  201: sub storemap {
  202:     my $coursedom=$env{'course.'.$env{'request.course.id'}.'.domain'};
  203:     my $coursenum=$env{'course.'.$env{'request.course.id'}.'.num'};
  204:     my ($outtext,$errtext)=
  205:       &LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/default.sequence',1);
  206:     if ($errtext) { return ($errtext,2); }
  207:     return ($errtext,0);
  208: }
  209: 
  210: sub chosen_to_map {
  211:    my %chosenproblems=();
  212:    foreach my $item (@chosen) {
  213:       $chosenproblems{$item}=1;
  214:    }
  215:    @LONCAPA::map::order=();
  216:    @LONCAPA::map::resources=();
  217:    for (my $idx=0;$idx<=$#allprobs;$idx++) {
  218:        my $residx=$idx+1;
  219:        if ($chosenproblems{$allprobs[$idx]}) {
  220:           push(@LONCAPA::map::order,$residx);
  221:           my $url  = &LONCAPA::map::qtunescape(&fullurl($allprobs[$idx]));
  222: 	  my $name = &LONCAPA::map::qtunescape('Problem '.$allprobs[$idx]);
  223: 	  $LONCAPA::map::resources[$residx]=join(':', ($name, $url, 'false', 'normal', 'res'));
  224:        }
  225:     }
  226: }
  227: 
  228: sub map_to_chosen {
  229:     @chosen=();
  230:     foreach my $idx (@LONCAPA::map::order) {
  231:        push(@chosen,$allprobs[$idx-1]);
  232:     }
  233: }
  234: 
  235: sub store {
  236:    my ($r)=@_;
  237:    my @errors=&checkvalid();
  238:    if ($#errors>1) { return; }
  239:    &chosen_to_map();
  240:    &storemap();
  241:    unless ($#errors>-1) {
  242:       $r->print('<p>'.&mt('You have successfully assembled a valid test.').
  243:                 '<form name="reinitform" method="post" action="/adm/roles" target="loncapaclient">'.
  244:                 '<input type="hidden" name="orgurl" value="/adm/navmaps" /><input type="hidden" name="selectrole" value="1" />'.
  245:                 '<input type="hidden" name="'.$env{'request.role'}.'" value="1" /><input type="submit" value="'.
  246:                  &mt('Activate Current Test').'" /></form></p>');
  247:    }
  248: }
  249: 
  250: sub load {
  251:    &mapread();
  252:    &map_to_chosen();
  253:    my @errors=&checkvalid();
  254:    if ($#errors>1) { @chosen=@defchosen; }
  255: }
  256: 
  257: # empty cleanup handler
  258: 
  259: sub untiehash {
  260:     return OK;
  261: }
  262: 
  263: 
  264: sub handler {
  265:     my $r = shift;
  266:     &Apache::loncommon::content_type($r,'text/html');
  267:     $r->send_http_header;
  268:     return OK if $r->header_only;
  269: 
  270:     $r->print(&Apache::loncommon::start_page('Assemble Test'));
  271:  
  272:     my $allowed=&Apache::lonnet::allowed('mdc',$env{'request.course.id'});
  273: # graphics settings
  274:     $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/");
  275: 
  276: # initialize default values
  277: 
  278:     &setdefaults();
  279: 
  280: # Only edit stuff if the user is allowed to edit
  281:     if ($allowed) {
  282: # do we need to store something?
  283:        if ($env{'form.phase'} eq 'storemap') {
  284: # see if there is user input that needs to be stored
  285:           &evaluate();
  286:           &store($r);
  287:        }
  288: # load the map
  289:        &load();
  290: # bring up the selection screen
  291:        &listresources($r);
  292:     }
  293:     $r->print(&Apache::loncommon::end_page());
  294:     return OK;
  295: }
  296: 1;
  297: __END__
  298: