Return to londocs.pm CVS log

Up to [LON-CAPA] / modules / gci

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

# The LearningOnline Network
# Documents
# Modified for GCI Concept Inventory Assemby
#
# $Id: londocs.pm,v 1.1 2009/09/11 15:49:11 gci Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#



package Apache::londocs;

use strict;

use Apache::Constants qw(:common :http);
use Apache::imsexport;
use Apache::lonnet;
use Apache::loncommon;
use LONCAPA::map();
use Apache::lonratedt();
use Apache::lonxml;
use Apache::lonclonecourse;
use Apache::lonnavmaps;
use Apache::lonindexer;
use HTML::Entities;
use GDBM_File;
use Apache::lonlocal;
use Cwd;
use LONCAPA qw(:DEFAULT :match);

my $iconpath;

my %hash;

my $hashtied;
my %alreadyseen=();

my %help=();


my $path;
my $version;
my $reqnum;
my @categories;
my @allprobs;
my %probcat;
my %prereqs;
my @defchosen;
my @chosen;

sub setdefaults {
   $path='/res/gci/gci';
   $version='GCIv2-1-1';
   $reqnum=15;
   @allprobs=('01','02','03','04','05','06','07',
              '08','10',
              '09',
              '11','12','13','14','15','16','17',
              '18','69',
              '19','20',
              '21','22','23','24','25','26','27','28','29','30',
              '31','32','33','34','35','36','37','38',
              '39A','39B',
              '40',
              '41','42','43','44','45','46','47','48','49','50',
              '51',
              '52','57',
              '53','54','55','56','58',
              '60',
              '61','62','63','64','65','66','67','68','70',
              '71',
              '2004_73');

   @categories=('M1','M2','M3','M4',
                'A','B','C','D','E','F','G','H','I','J','K');
   %probcat =('01' => 'M1','02' => 'M2','03' => 'A' ,'04' => 'A' ,'05' => ''  ,'06' => 'A' ,'07' => 'B' ,'08' => 'B' ,'09' => 'B' ,'10' => 'C' ,
              '11' => ''  ,'12' => 'C' ,'13' => 'C' ,'14' => 'C' ,'15' => 'C' ,'16' => 'C' ,'17' => 'C' ,'18' => 'D' ,'19' => 'D' ,'20' => 'D' ,
              '21' => 'D' ,'22' => 'D' ,'23' => 'D' ,'24' => 'D' ,'25' => 'D' ,'26' => 'E' ,'27' => 'E' ,'28' => 'E' ,'29' => ''  ,'30' => 'E' ,
              '31' => ''  ,'32' => 'F' ,'33' => 'F' ,'34' => 'F' ,'35' => 'F' ,'36' => 'F' ,'37' => 'M3','38' => 'G' ,
              '39A'=> 'G' ,'39B'=> 'G' ,
              '40' => 'G' ,
              '41' => 'G' ,'42' => 'G' ,'43' => 'G' ,'44' => 'G' ,'45' => 'G' ,'46' => 'G' ,'47' => 'H' ,'48' => 'H' ,'49' => 'H' ,'50' => 'H' ,
              '51' => 'H' ,'52' => 'H' ,'53' => 'H' ,'54' => 'I' ,'55' => 'I' ,'56' => 'I' ,'57' => 'I' ,'58' => 'I' ,
              '60' => 'I' ,
              '61' => 'I' ,'62' => 'I' ,'63' => 'J' ,'64' => 'J' ,'65' => 'J' ,'66' => 'K' ,'67' => 'K' ,'68' => 'K' ,'69' => 'K' ,'70' => 'K' ,
              '71' => 'K' ,
              '2004_73' => 'M4');
   %prereqs=('10' => '08', '57' => '52', '69' => '18');
   @defchosen=('01','02','03','07','12','18','26','32','37','38','47','54','63','66','2004_73');
}

sub checkvalid {
   my %covered=();
   my %chosenproblems=();
   my @errors=();
   my $num=$#chosen+1;
   if ($num<$reqnum) {
      push(@errors,&mt('Test requires at least [_1] items, but has only [_2].',$reqnum,$num)); 
   }
   foreach my $item (@chosen) {
      $chosenproblems{$item}=1;
      $covered{$probcat{$item}}=1;
   }
   foreach my $cat (@categories) {
      unless ($covered{$cat}) {
         push(@errors,&mt('Category [_1] not covered.',$cat));
      }
   }
   foreach my $item (@chosen) {
       if ($prereqs{$item}) {
          unless ($chosenproblems{$prereqs{$item}}) {
             push(@errors,&mt('Problem [_1] requires problem [_2].',$item,$prereqs{$item}));
          }
       }
   }
   return @errors;
}

sub fullurl {
   my ($item)=@_;
   unless ($item=~/\_/) { $item='_'.$item; }
   return $path.'/'.$version.'/GCI'.$item.'.problem';
}

sub listresources {
   my ($r)=@_;
   my @errors=&checkvalid();
   if ($#errors>-1) {
      $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>');
      foreach my $message (@errors) {
         $r->print('<li>'.$message.'</li>');
      }
      $r->print('</ul></p>');
   }
   my %chosen=();
   foreach my $item (@chosen) {
      $chosen{$item}=1;
   }
   $r->print('<form name="selecteditems" method="post">');
   $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>'); 
   $r->print(&Apache::loncommon::start_data_table().
             &Apache::loncommon::start_data_table_header_row().
             '<th>'.&mt('Select').'</th><th>'.&mt('Problem').'</th><th>'.&mt('Category').'</th><th>'.&mt('Preview').'</th>'.
             &Apache::loncommon::end_data_table_header_row());
   foreach my $item (@allprobs) {
      $r->print(&Apache::loncommon::start_data_table_row());
      $r->print('<td><font size="+3">');
      $r->print('<input type="checkbox" name="item'.$item.'"');
      if ($chosen{$item}) { $r->print(' checked="checked"'); }
      $r->print(' /></font></td>');
      $r->print('<td><font size="+3">'.$item.'</font></td><td><font size="+3">'.$probcat{$item}.'</font></td>');
      my $output=&Apache::lonindexer::showpreview(&fullurl($item));
      $r->print('<td> '.($output eq '' ? '&nbsp;':$output)." </td>\n");

      $r->print( &Apache::loncommon::end_data_table_row());
   }
   $r->print(&Apache::loncommon::end_data_table());
   $r->print('<input type="hidden" name="phase" value="storemap" />');
   $r->print('<input type="submit" value="'.&mt('Store Problem Selection').'" /></form>');
}

sub evaluate {
   if ($env{'form.phase'} eq 'storemap') {
      @chosen=();
      foreach my $item (@allprobs) {
         if ($env{'form.item'.$item}) {
            push(@chosen,$item);
         }
      }
   }
}

sub mapread {
    my $coursedom=$env{'course.'.$env{'request.course.id'}.'.domain'};
    my $coursenum=$env{'course.'.$env{'request.course.id'}.'.num'};
    return
      &LONCAPA::map::mapread('/uploaded/'.$coursedom.'/'.$coursenum.'/default.sequence');
}

sub storemap {
    my $coursedom=$env{'course.'.$env{'request.course.id'}.'.domain'};
    my $coursenum=$env{'course.'.$env{'request.course.id'}.'.num'};
    my ($outtext,$errtext)=
      &LONCAPA::map::storemap('/uploaded/'.$coursedom.'/'.$coursenum.'/default.sequence',1);
    if ($errtext) { return ($errtext,2); }
    return ($errtext,0);
}

sub chosen_to_map {
   my %chosenproblems=();
   foreach my $item (@chosen) {
      $chosenproblems{$item}=1;
   }
   @LONCAPA::map::order=();
   @LONCAPA::map::resources=();
   for (my $idx=0;$idx<=$#allprobs;$idx++) {
       my $residx=$idx+1;
       if ($chosenproblems{$allprobs[$idx]}) {
          push(@LONCAPA::map::order,$residx);
          my $url  = &LONCAPA::map::qtunescape(&fullurl($allprobs[$idx]));
	  my $name = &LONCAPA::map::qtunescape('Problem '.$allprobs[$idx]);
	  $LONCAPA::map::resources[$residx]=join(':', ($name, $url, 'false', 'normal', 'res'));
       }
    }
}

sub map_to_chosen {
    @chosen=();
    foreach my $idx (@LONCAPA::map::order) {
       push(@chosen,$allprobs[$idx-1]);
    }
}

sub store {
   my ($r)=@_;
   my @errors=&checkvalid();
   if ($#errors>1) { return; }
   &chosen_to_map();
   &storemap();
   unless ($#errors>-1) {
      $r->print('<p>'.&mt('You have successfully assembled a valid test.').
                '<form name="reinitform" method="post" action="/adm/roles" target="loncapaclient">'.
                '<input type="hidden" name="orgurl" value="/adm/navmaps" /><input type="hidden" name="selectrole" value="1" />'.
                '<input type="hidden" name="'.$env{'request.role'}.'" value="1" /><input type="submit" value="'.
                 &mt('Activate Current Test').'" /></form></p>');
   }
}

sub load {
   &mapread();
   &map_to_chosen();
   my @errors=&checkvalid();
   if ($#errors>1) { @chosen=@defchosen; }
}

# empty cleanup handler

sub untiehash {
    return OK;
}


sub handler {
    my $r = shift;
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    return OK if $r->header_only;

    $r->print(&Apache::loncommon::start_page('Assemble Test'));
 
    my $allowed=&Apache::lonnet::allowed('mdc',$env{'request.course.id'});
# graphics settings
    $iconpath = &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL') . "/");

# initialize default values

    &setdefaults();

# Only edit stuff if the user is allowed to edit
    if ($allowed) {
# do we need to store something?
       if ($env{'form.phase'} eq 'storemap') {
# see if there is user input that needs to be stored
          &evaluate();
          &store($r);
       }
# load the map
       &load();
# bring up the selection screen
       &listresources($r);
    }
    $r->print(&Apache::loncommon::end_page());
    return OK;
}
1;
__END__