[BACK]Return to lonparmset.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonparmset.pm between versions 1.194 and 1.198

version 1.194, 2005/05/30 17:56:39 version 1.198, 2005/06/02 13:15:05
Line 62  use GDBM_File; Line 62  use GDBM_File;
 use Apache::lonhomework;  use Apache::lonhomework;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::lonlocal;  use Apache::lonlocal;
   use Apache::lonnavmaps;
   
 my %courseopt;  # --- Caches local to lonparmset
 my %useropt;  
 my %parmhash;  
   
   my $courseoptid='';
   my %courseopt=();
   my $useroptid='';
   my %useropt=();
   my $parmhashid='';
   my %parmhash=();
   
   # --- end local caches
   
   #
   # FIXME: get rid of items below
   #
 my @ids;  my @ids;
 my %symbp;  my %symbp;
 my %mapp;  my %mapp;
 my %typep;  my %typep;
 my %keyp;  my %keyp;
   my %uris;
 my %maptitles;  my %maptitles;
   
 ##################################################  ##################################################
Line 108  Returns:  A list, the first item is the Line 119  Returns:  A list, the first item is the
 ##################################################  ##################################################
 sub parmval {  sub parmval {
     my ($what,$id,$def,$uname,$udom,$csec)=@_;      my ($what,$id,$def,$uname,$udom,$csec)=@_;
   # load caches
       &cacheparmhash();
   
     my $result='';      my $result='';
     my @outpar=();      my @outpar=();
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
Line 189  sub parmval { Line 203  sub parmval {
     return ($result,@outpar);      return ($result,@outpar);
 }  }
   
   sub resetparmhash {
       $parmhashid='';
   }
   
   sub cacheparmhash {
       if ($parmhashid eq  $env{'request.course.fn'}) { return; }
       my %parmhashfile;
       if (tie(%parmhashfile,'GDBM_File',
         $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
    %parmhash=%parmhashfile;
    untie %parmhashfile;
    $parmhashid=$env{'request.course.fn'};
       }
   }
   
   sub cacheuseropt {
       my ($uname,$udom)=@_;
   }
   
   sub cachecourseopt {
   }
   
 ##################################################  ##################################################
 ##################################################  ##################################################
 #  #
 # Store a parameter  # Store a parameter by ID
 #  #
 # Takes  # Takes
 # - resource id  # - resource id
Line 206  sub parmval { Line 241  sub parmval {
   
 sub storeparm {  sub storeparm {
     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;      my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
     $spnam=~s/\_([^\_]+)$/\.$1/;      my $navmap = Apache::lonnavmaps::navmap->new();
       if ($sresid=~/\./) {
    my $resource=$navmap->getById($sresid);
    &storeparm_by_symb($resource->symb(),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
       } else {
           my $resource=$navmap->getByMapPc($sresid);
    &storeparm_by_symb(&Apache::lonnet::declutter($resource->src()),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
       }
   }
   
   #
   # Store a parameter by symb
   #
   # Takes
   # - symb
   # - name of parameter
   # - level
   # - new value
   # - new type
   # - username
   # - userdomain
   
   sub storeparm_by_symb {
   # ---------------------------------------------------------- Get symb, map, etc
       my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
 # ---------------------------------------------------------- Construct prefixes  # ---------------------------------------------------------- Construct prefixes
           $spnam=~s/\_([^\_]+)$/\.$1/;
     my $symbparm=$symbp{$sresid}.'.'.$spnam;      my $map=(&Apache::lonnet::decode_symb($symb))[0];    
     my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;      my $symbparm=$symb.'.'.$spnam;
           my $mapparm=$map.'___(all).'.$spnam;
   
     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;      my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;      my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;      my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
Line 239  sub storeparm { Line 299  sub storeparm {
 # Expire sheets  # Expire sheets
  &Apache::lonnet::expirespread('','','studentcalc');   &Apache::lonnet::expirespread('','','studentcalc');
  if (($snum==7) || ($snum==4)) {   if (($snum==7) || ($snum==4)) {
     &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});      &Apache::lonnet::expirespread('','','assesscalc',$symb);
  } elsif (($snum==8) || ($snum==5)) {   } elsif (($snum==8) || ($snum==5)) {
     &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});      &Apache::lonnet::expirespread('','','assesscalc',$map);
  } else {   } else {
     &Apache::lonnet::expirespread('','','assesscalc');      &Apache::lonnet::expirespread('','','assesscalc');
  }   }
Line 264  sub storeparm { Line 324  sub storeparm {
  &Apache::lonnet::expirespread($uname,$udom,'studentcalc');   &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
  if ($snum==1) {   if ($snum==1) {
     &Apache::lonnet::expirespread      &Apache::lonnet::expirespread
  ($uname,$udom,'assesscalc',$symbp{$sresid});   ($uname,$udom,'assesscalc',$symb);
  } elsif ($snum==2) {   } elsif ($snum==2) {
     &Apache::lonnet::expirespread      &Apache::lonnet::expirespread
  ($uname,$udom,'assesscalc',$mapp{$sresid});   ($uname,$udom,'assesscalc',$map);
  } else {   } else {
     &Apache::lonnet::expirespread($uname,$udom,'assesscalc');      &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
  }   }
Line 675  Input: See list below: Line 735  Input: See list below:
 =cut  =cut
   
 sub extractResourceInformation {  sub extractResourceInformation {
     my $bighash = shift;  
     my $ids = shift;      my $ids = shift;
     my $typep = shift;      my $typep = shift;
     my $keyp = shift;      my $keyp = shift;
Line 688  sub extractResourceInformation { Line 747  sub extractResourceInformation {
     my $mapp = shift;      my $mapp = shift;
     my $symbp = shift;      my $symbp = shift;
     my $maptitles=shift;      my $maptitles=shift;
       my $uris=shift;
   
     foreach (keys %$bighash) {  
  if ($_=~/^src\_(\d+)\.(\d+)$/) {      my $navmap = Apache::lonnavmaps::navmap->new();
     # there are no resources in the 0 level      my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
     if ($1 eq '0') { next; }      foreach my $resource (@allres) {
     my $mapid=$1;   my $id=$resource->id();
     my $resid=$2;          my ($mapid,$resid)=split(/\./,$id);
     my $id=$mapid.'.'.$resid;   if ($mapid eq '0') { next; }
     my $srcf=$$bighash{$_};   $$ids[$#$ids+1]=$id;
     if (1) {   my $srcf=$resource->src();
  $srcf=~/\.(\w+)$/;   $srcf=~/\.(\w+)$/;
  $$ids[$#$ids+1]=$id;   $$typep{$id}=$1;
  $$typep{$id}=$1;   $$keyp{$id}='';
  $$keyp{$id}='';          $$uris{$id}=$srcf;
  foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {   foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
   if ($_=~/^parameter\_(.*)/) {      if ($_=~/^parameter\_(.*)/) {
                     my $key=$_;   my $key=$_;
                     my $allkey=$1;   my $allkey=$1;
                     $allkey=~s/\_/\./g;   $allkey=~s/\_/\./g;
     if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq    if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 
  'parm') {      'parm') {
  next; #hide hidden things      next; #hide hidden things
     }   }
                     my $display= &Apache::lonnet::metadata($srcf,$key.'.display');   my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                     my $name=&Apache::lonnet::metadata($srcf,$key.'.name');   my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                     my $part= &Apache::lonnet::metadata($srcf,$key.'.part');   my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                     my $parmdis = $display;   my $parmdis = $display;
                     $parmdis =~ s|(\[Part.*)$||g;   $parmdis =~ s|(\[Part.*)$||g;
                     my $partkey = $part;   my $partkey = $part;
                     $partkey =~ tr|_|.|;   $partkey =~ tr|_|.|;
                     $$allparms{$name} = $parmdis;   $$allparms{$name} = $parmdis;
                     $$allparts{$part} = "[Part $part]";   $$allparts{$part} = "[Part $part]";
                     $$allkeys{$allkey}=$display;   $$allkeys{$allkey}=$display;
                     if ($allkey eq $fcat) {   if ($allkey eq $fcat) {
         $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);      $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
     }  
     if ($$keyp{$id}) {  
         $$keyp{$id}.=','.$key;  
     } else {  
         $$keyp{$id}=$key;  
     }  
   }  
  }   }
  $$mapp{$id}=   if ($$keyp{$id}) {
     &Apache::lonnet::declutter($$bighash{'map_id_'.$mapid});      $$keyp{$id}.=','.$key;
                 $$mapp{$mapid}=$$mapp{$id};  
  $$allmaps{$mapid}=$$mapp{$id};  
  if ($mapid eq '1') {  
     $$maptitles{$mapid}='Main Course Documents';  
  } else {   } else {
     $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));      $$keyp{$id}=$key;
  }   }
  $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};  
  $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);  
                 $$symbp{$mapid}=$$mapp{$id}.'___(all)';  
     }      }
  }   }
    $$mapp{$id}=
       &Apache::lonnet::declutter($resource->enclosing_map_src());
    $$mapp{$mapid}=$$mapp{$id};
    $$allmaps{$mapid}=$$mapp{$id};
    if ($mapid eq '1') {
       $$maptitles{$mapid}='Main Course Documents';
    } else {
       $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
    }
    $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
    $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
    $$symbp{$mapid}=$$mapp{$id}.'___(all)';
     }      }
 }  }
   
Line 803  sub assessparms { Line 861  sub assessparms {
     my %defp;      my %defp;
     %courseopt=();      %courseopt=();
     %useropt=();      %useropt=();
     my %bighash=();  
   
     @ids=();      @ids=();
     %symbp=();      %symbp=();
Line 905  sub assessparms { Line 962  sub assessparms {
     my $fcat=$env{'form.fcat'};      my $fcat=$env{'form.fcat'};
     unless ($fcat) { $fcat=''; }      unless ($fcat) { $fcat=''; }
   
 # ------------------------------------------------------------------- Tie hashs  
     if (!(tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',  
       &GDBM_READER(),0640))) {  
  $r->print("Unable to access course data. (File $env{'request.course.fn'}.db not tieable)");  
  return ;  
     }  
     if (!(tie(%parmhash,'GDBM_File',  
       $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {  
  $r->print("Unable to access parameter data. (File $env{'request.course.fn'}_parms.db not tieable)");  
  return ;  
     }  
   
 # --------------------------------------------------------- Get all assessments  # --------------------------------------------------------- Get all assessments
     &extractResourceInformation(\%bighash, \@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles);      &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles,\%uris);
   
     $mapp{'0.0'} = '';      $mapp{'0.0'} = '';
     $symbp{'0.0'} = '';      $symbp{'0.0'} = '';
Line 971  sub assessparms { Line 1016  sub assessparms {
     $trimheader = 'yes';      $trimheader = 'yes';
     &startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader);      &startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader);
   
     if (!$have_assesments) {  
  untie(%bighash);  
  untie(%parmhash);  
  return '';  
     }  
 #    if ($env{'form.url'}) {  #    if ($env{'form.url'}) {
 # $r->print('<input type="hidden" value="'.$env{'form.url'}.  # $r->print('<input type="hidden" value="'.$env{'form.url'}.
 #  '" name="url"><input type="hidden" name="command" value="set">');  #  '" name="url"><input type="hidden" name="command" value="set">');
Line 1238  ENDTABLEHEADFOUR Line 1278  ENDTABLEHEADFOUR
                     my %display=();                      my %display=();
                     my %type=   ();                      my %type=   ();
                     my %default=();                      my %default=();
                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});                      my $uri=&Apache::lonnet::declutter($uris{$rid});
   
                     foreach (split(/\,/,$keyp{$rid})) {                      foreach (split(/\,/,$keyp{$rid})) {
                         my $tempkeyp = $_;                          my $tempkeyp = $_;
Line 1337  ENDTABLEHEADFOUR Line 1377  ENDTABLEHEADFOUR
 #                  $r->print("$mapid:$map:   $rid <br /> \n");  #                  $r->print("$mapid:$map:   $rid <br /> \n");
   
                   if ($map eq $mapid) {                    if ($map eq $mapid) {
                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});                      my $uri=&Apache::lonnet::declutter($uris{$rid});
 #                    $r->print("Keys: $keyp{$rid} <br />\n");  #                    $r->print("Keys: $keyp{$rid} <br />\n");
   
 #--------------------------------------------------------------------  #--------------------------------------------------------------------
Line 1425  ENDMAPONE Line 1465  ENDMAPONE
             foreach (@ids) {              foreach (@ids) {
                 my $rid = $_;                  my $rid = $_;
                   
                 my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});                  my $uri=&Apache::lonnet::declutter($uris{$rid});
   
 #--------------------------------------------------------------------  #--------------------------------------------------------------------
 # @catmarker contains list of all possible parameters including part #s  # @catmarker contains list of all possible parameters including part #s
Line 1485  ENDMAPONE Line 1525  ENDMAPONE
         } # end of $parmlev eq general          } # end of $parmlev eq general
     }      }
     $r->print('</form></body></html>');      $r->print('</form></body></html>');
     untie(%bighash);  
     untie(%parmhash);  
 } # end sub assessparms  } # end sub assessparms
   
   
Line 2091  sub print_main_menu { Line 2129  sub print_main_menu {
       action="/adm/parmset" name="studentform">        action="/adm/parmset" name="studentform">
 ENDMAINFORMHEAD  ENDMAINFORMHEAD
 #  #
     my ($cdom,$cnum) = split/_/,$env{'request.course.id'};      my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     my @menu =      my @menu =
         (          (
           { text => 'Set Course Environment Parameters',            { text => 'Set Course Environment Parameters',
Removed from v.1.194  
changed lines
  Added in v.1.198

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>