Diff for /loncom/interface/lonparmset.pm between versions 1.195 and 1.203

version 1.195, 2005/05/30 17:58:51 version 1.203, 2005/06/03 14:25:49
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 @ids;  my $parmhashid;
 my %symbp;  my %parmhash;
 my %mapp;  my $symbsid;
 my %typep;  my %symbs;
 my %keyp;  
   
 my %maptitles;  # --- end local caches
   
 ##################################################  ##################################################
 ##################################################  ##################################################
Line 105  Returns:  A list, the first item is the Line 103  Returns:  A list, the first item is the
 =cut  =cut
   
 ##################################################  ##################################################
 ##################################################  
 sub parmval {  sub parmval {
     my ($what,$id,$def,$uname,$udom,$csec)=@_;      my ($what,$id,$def,$uname,$udom,$csec)=@_;
       return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec);
   }
   
   sub parmval_by_symb {
       my ($what,$symb,$def,$uname,$udom,$csec)=@_;
   # load caches
   
       &cacheparmhash();
   
       my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
       my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
       my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
       my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
   
   
     my $result='';      my $result='';
     my @outpar=();      my @outpar=();
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
       my $map=(&Apache::lonnet::decode_symb($symb))[0];    
   
     my $symbparm=$symbp{$id}.'.'.$what;      my $symbparm=$symb.'.'.$what;
     my $mapparm=$mapp{$id}.'___(all).'.$what;      my $mapparm=$map.'___(all).'.$what;
   
     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;      my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;      my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
Line 127  sub parmval { Line 140  sub parmval {
   
 # --------------------------------------------------------- first, check course  # --------------------------------------------------------- first, check course
   
     if (defined($courseopt{$courselevel})) {      if (defined($$courseopt{$courselevel})) {
  $outpar[11]=$courseopt{$courselevel};   $outpar[11]=$$courseopt{$courselevel};
  $result=11;   $result=11;
     }      }
   
     if (defined($courseopt{$courselevelm})) {      if (defined($$courseopt{$courselevelm})) {
  $outpar[10]=$courseopt{$courselevelm};   $outpar[10]=$$courseopt{$courselevelm};
  $result=10;   $result=10;
     }      }
   
Line 146  sub parmval { Line 159  sub parmval {
     my $thisparm=$parmhash{$symbparm};      my $thisparm=$parmhash{$symbparm};
     if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }      if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }
   
     if (defined($courseopt{$courselevelr})) {      if (defined($$courseopt{$courselevelr})) {
  $outpar[7]=$courseopt{$courselevelr};   $outpar[7]=$$courseopt{$courselevelr};
  $result=7;   $result=7;
     }      }
   
 # ------------------------------------------------------ fourth, back to course  # ------------------------------------------------------ fourth, back to course
     if (defined($csec)) {      if (defined($csec)) {
         if (defined($courseopt{$seclevel})) {          if (defined($$courseopt{$seclevel})) {
     $outpar[6]=$courseopt{$seclevel};      $outpar[6]=$$courseopt{$seclevel};
     $result=6;      $result=6;
  }   }
         if (defined($courseopt{$seclevelm})) {          if (defined($$courseopt{$seclevelm})) {
     $outpar[5]=$courseopt{$seclevelm};      $outpar[5]=$$courseopt{$seclevelm};
     $result=5;      $result=5;
  }   }
   
         if (defined($courseopt{$seclevelr})) {          if (defined($$courseopt{$seclevelr})) {
     $outpar[4]=$courseopt{$seclevelr};      $outpar[4]=$$courseopt{$seclevelr};
     $result=4;      $result=4;
  }   }
     }      }
Line 171  sub parmval { Line 184  sub parmval {
 # ---------------------------------------------------------- fifth, check user  # ---------------------------------------------------------- fifth, check user
   
     if (defined($uname)) {      if (defined($uname)) {
  if (defined($useropt{$courselevel})) {   if (defined($$useropt{$courselevel})) {
     $outpar[3]=$useropt{$courselevel};      $outpar[3]=$$useropt{$courselevel};
     $result=3;      $result=3;
  }   }
   
  if (defined($useropt{$courselevelm})) {   if (defined($$useropt{$courselevelm})) {
     $outpar[2]=$useropt{$courselevelm};      $outpar[2]=$$useropt{$courselevelm};
     $result=2;      $result=2;
  }   }
   
  if (defined($useropt{$courselevelr})) {   if (defined($$useropt{$courselevelr})) {
     $outpar[1]=$useropt{$courselevelr};      $outpar[1]=$$useropt{$courselevelr};
     $result=1;      $result=1;
  }   }
     }      }
     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 resetsymbcache {
       $symbsid='';
   }
   
   sub symbcache {
       my $id=shift;
       if ($symbsid ne $env{'request.course.id'}) {
    %symbs=();
       }
       unless ($symbs{$id}) {
    my $navmap = Apache::lonnavmaps::navmap->new();
    if ($id=~/\./) {
       my $resource=$navmap->getById($id);
       $symbs{$id}=$resource->symb();
    } else {
       my $resource=$navmap->getByMapPc($id);
       $symbs{$id}=&Apache::lonnet::declutter($resource->src());
    }
    $symbsid=$env{'request.course.id'};
       }
       return $symbs{$id};
   }
   
 ##################################################  ##################################################
 ##################################################  ##################################################
 #  #
 # Store a parameter  # Store a parameter by ID
 #  #
 # Takes  # Takes
 # - resource id  # - resource id
Line 206  sub parmval { Line 256  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/;      &storeparm_by_symb(&symbcache($sresid),$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 236  sub storeparm { Line 304  sub storeparm {
     if ($snum>3) {      if ($snum>3) {
 # ---------------------------------------------------------------- Store Course  # ---------------------------------------------------------------- Store Course
 #  #
    my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
 # 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');
  }   }
 # Store parameter  # Store parameter
  if ($delete) {   if ($delete) {
     $reply=&Apache::lonnet::del      $reply=&Apache::lonnet::del
  ('resourcedata',[keys(%storecontent)],   ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
  $env{'course.'.$env{'request.course.id'}.'.domain'},  
  $env{'course.'.$env{'request.course.id'}.'.num'});  
  } else {   } else {
     $reply=&Apache::lonnet::cput      $reply=&Apache::lonnet::cput
  ('resourcedata',\%storecontent,   ('resourcedata',\%storecontent,$cdom,$cnum);
  $env{'course.'.$env{'request.course.id'}.'.domain'},  
  $env{'course.'.$env{'request.course.id'}.'.num'});  
  }   }
    &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
     } else {      } else {
 # ------------------------------------------------------------------ Store User  # ------------------------------------------------------------------ Store User
 #  #
Line 264  sub storeparm { Line 331  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 379  sub plink { Line 446  sub plink {
  &valout($value,$type).'</a><a name="'.$marker.'"></a>';   &valout($value,$type).'</a><a name="'.$marker.'"></a>';
 }  }
   
   
 sub startpage {  sub startpage {
     my ($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader)=@_;      my ($r,$id,$udom,$csec,$uname,$have_assessments)=@_;
   
     my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',      my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
                                             'onUnload="pclose()"');                                              'onUnload="pclose()"');
Line 391  sub startpage { Line 457  sub startpage {
     my $selscript=&Apache::loncommon::studentbrowser_javascript();      my $selscript=&Apache::loncommon::studentbrowser_javascript();
     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();      my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
     my %lt=&Apache::lonlocal::texthash(      my %lt=&Apache::lonlocal::texthash(
     'cep'   => "Course Environment Parameters",  
     'scep'  => "Set Course Environment Parameters",  
     'smcap' => "Set/Modify Course Assessment Parameter",  
     'mcap'  => "Modify Course Assessment Parameters",  
     'caphm' => "Course Assessment Parameter - Helper Mode",  
     'capom' => "Course Assessment Parameters - Overview Mode",  
                     'captm' => "Course Assessments Parameters - Table Mode",                      'captm' => "Course Assessments Parameters - Table Mode",
     'sg'    => "Section/Group",      'sg'    => "Section/Group",
     'fu'    => "For User",      'fu'    => "For User",
Line 458  $bodytag Line 518  $bodytag
 $breadcrumbs  $breadcrumbs
 $overallhelp  $overallhelp
 ENDHEAD  ENDHEAD
   
     unless ($trimheader) {$r->print(<<ENDHEAD2);  
 <form method="post" action="/adm/parmset" name="envform">  
 <h4>$lt{'cep'}</h4>  
 <input type="submit" name="crsenv" value="$lt{'scep'}" />  
 </form>  
 <hr />  
 $assessparmhelp  
 <form method="post" action="/adm/helper/parameter.helper" name="helpform">  
 <h4>$lt{'caphm'}</h4>  
 <input type="submit" value="$lt{'smcap'}" />  
 </form>  
 <hr />  
 <form method="post" action="/adm/parmset" name="overview">  
 <h4>$lt{'capom'}</h4>  
 <input type="submit" name="overview" value="$lt{'mcap'}" />  
 </form>  
 <hr />  
 ENDHEAD2  
     }  
     my %sectionhash=();      my %sectionhash=();
     my $sections='';      my $sections='';
     if (&Apache::loncommon::get_sections(      if (&Apache::loncommon::get_sections(
Line 496  ENDHEAD2 Line 536  ENDHEAD2
 <h4>$lt{'captm'}</h4>  <h4>$lt{'captm'}</h4>
 ENDHEAD3  ENDHEAD3
   
     if (!$have_assesments) {      if (!$have_assessments) {
  $r->print('<font color="red">'.&mt('There are no assesment parameters in this course to set.').'</font><br />');   $r->print('<font color="red">'.&mt('There are no assessment parameters in this course to set.').'</font><br />');
     } else {      } else {
  $r->print(<<ENDHEAD);   $r->print(<<ENDHEAD);
 <b>  <b>
Line 518  ENDHEAD Line 558  ENDHEAD
 }  }
   
 sub print_row {  sub print_row {
     my ($r,$which,$part,$name,$rid,$default,$defaulttype,$display,$defbgone,      my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
  $defbgtwo,$parmlev,$uname,$udom,$csec)=@_;   $defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
 # get the values for the parameter in cascading order  # get the values for the parameter in cascading order
 # empty levels will remain empty  # empty levels will remain empty
Line 540  sub print_row { Line 580  sub print_row {
     }      }
     my $parm=$$display{$which};      my $parm=$$display{$which};
   
     if ($parmlev eq 'full' || $parmlev eq 'brief') {      if ($parmlev eq 'full') {
         $r->print('<td bgcolor='.$defbgtwo.' align="center">'          $r->print('<td bgcolor='.$defbgtwo.' align="center">'
                   .$$part{$which}.'</td>');                    .$$part{$which}.'</td>');
     } else {          } else {    
Line 575  sub print_row { Line 615  sub print_row {
   
         &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);          &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
   
         if ($parmlev eq 'brief') {   &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
    &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);   &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
    &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
            if ($csec) {  
                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);   if ($csec) {
            }      &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
            if ($uname) {      &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);      &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
            }   }
         } else {   if ($uname) {
       &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
            &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);      &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
            &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);      &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
            &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);   }
            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);  
   
            if ($csec) {  
                &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);  
                &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);  
                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);  
            }  
            if ($uname) {  
                &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);  
                &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);  
                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);  
            }  
         } # end of $brief if/else  
     } # end of $parmlev if/else      } # end of $parmlev if/else
   
     $r->print('<td bgcolor=#CCCCFF align="center">'.      $r->print('<td bgcolor=#CCCCFF align="center">'.
                   &valout($outpar[$result],$typeoutpar[$result]).'</td>');                    &valout($outpar[$result],$typeoutpar[$result]).'</td>');
   
     if ($parmlev eq 'full' || $parmlev eq 'brief') {      if ($parmlev eq 'full') {
         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.          my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
                                         '.'.$$name{$which},$symbp{$rid});                                          '.'.$$name{$which},$$symbp{$rid});
   
 # this doesn't seem to work, and I don't think is correct  # this doesn't seem to work, and I don't think is correct
 #    my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}.  #    my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}.
Line 640  sub print_td { Line 668  sub print_td {
     $r->print('</td>'."\n");      $r->print('</td>'."\n");
 }  }
   
   
 =pod  =pod
   
 =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.  =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
Line 675  Input: See list below: Line 704  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 716  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) {      my $navmap = Apache::lonnavmaps::navmap->new();
  if ($_=~/^src\_(\d+)\.(\d+)$/) {      my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
     # there are no resources in the 0 level      foreach my $resource (@allres) {
     if ($1 eq '0') { next; }   my $id=$resource->id();
     my $mapid=$1;          my ($mapid,$resid)=split(/\./,$id);
     my $resid=$2;   if ($mapid eq '0') { next; }
     my $id=$mapid.'.'.$resid;   $$ids[$#$ids+1]=$id;
     my $srcf=$$bighash{$_};   my $srcf=$resource->src();
     if (1) {   $srcf=~/\.(\w+)$/;
  $srcf=~/\.(\w+)$/;   $$typep{$id}=$1;
  $$ids[$#$ids+1]=$id;   $$keyp{$id}='';
  $$typep{$id}=$1;          $$uris{$id}=$srcf;
  $$keyp{$id}='';   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 781  Variables used (guessed by Jeremy): Line 808  Variables used (guessed by Jeremy):
 sub assessparms {  sub assessparms {
   
     my $r=shift;      my $r=shift;
   
       my @ids=();
       my %symbp=();
       my %mapp=();
       my %typep=();
       my %keyp=();
       my %uris=();
       my %maptitles=();
   
 # -------------------------------------------------------- Variable declaration  # -------------------------------------------------------- Variable declaration
     my %allkeys=();      my %allkeys=();
     my %allmaps=();      my %allmaps=();
Line 801  sub assessparms { Line 837  sub assessparms {
     my %allparts;      my %allparts;
   
     my %defp;      my %defp;
     %courseopt=();  
     %useropt=();  
     my %bighash=();  
   
     @ids=();      @ids=();
     %symbp=();      %symbp=();
Line 828  sub assessparms { Line 861  sub assessparms {
   
     my $pssymb='';      my $pssymb='';
     my $parmlev='';      my $parmlev='';
     my $trimheader='';  
     my $prevvisit=$env{'form.prevvisit'};      my $prevvisit=$env{'form.prevvisit'};
     
     unless ($env{'form.parmlev'}) {      unless ($env{'form.parmlev'}) {
Line 847  sub assessparms { Line 879  sub assessparms {
  if (!@pscat) { @pscat=('all'); }   if (!@pscat) { @pscat=('all'); }
  $pschp='';   $pschp='';
         $parmlev = 'full';          $parmlev = 'full';
         $trimheader='yes';  
     } elsif ($env{'form.symb'}) {      } elsif ($env{'form.symb'}) {
  $pssymb=$env{'form.symb'};   $pssymb=$env{'form.symb'};
  if (!@pscat) { @pscat=('all'); }   if (!@pscat) { @pscat=('all'); }
  $pschp='';   $pschp='';
         $parmlev = 'full';          $parmlev = 'full';
         $trimheader='yes';  
     } else {      } else {
  $env{'form.url'}='';   $env{'form.url'}='';
     }      }
Line 905  sub assessparms { Line 935  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 932  sub assessparms { Line 950  sub assessparms {
 # ---------------------------------------------------------------- Done storing  # ---------------------------------------------------------------- Done storing
  $message.='<h3>'.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'</h3>';   $message.='<h3>'.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'</h3>';
     }      }
 # --------------------------------------------- Devalidate cache for this child  
     &Apache::lonnet::devalidatecourseresdata(  
                  $env{'course.'.$env{'request.course.id'}.'.num'},  
                  $env{'course.'.$env{'request.course.id'}.'.domain'});  
     #&Apache::lonnet::clear_EXT_cache_status();  
 # -------------------------------------------------------------- Get coursedata  
     %courseopt = &Apache::lonnet::dump  
         ('resourcedata',  
          $env{'course.'.$env{'request.course.id'}.'.domain'},  
          $env{'course.'.$env{'request.course.id'}.'.num'});  
 # --------------------------------------------------- Get userdata (if present)  
     if ($uname) {  
         %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);  
     }  
   
 # ------------------------------------------------------------------- Sort this  # ------------------------------------------------------------------- Sort this
   
     @ids=sort  {      @ids=sort  {
Line 965  sub assessparms { Line 968  sub assessparms {
     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}      if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
 # ------------------------------------------------------------------ Start page  # ------------------------------------------------------------------ Start page
   
     my $have_assesments=1;      &startpage($r,$id,$udom,$csec,$uname,scalar(keys(%allkeys)));
     if (scalar(keys(%allkeys)) eq 0) { $have_assesments=0; }  
   
     $trimheader = 'yes';  
     &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 1154  sub assessparms { Line 1148  sub assessparms {
         my $csuname=$env{'user.name'};          my $csuname=$env{'user.name'};
         my $csudom=$env{'user.domain'};          my $csudom=$env{'user.domain'};
   
         if ($parmlev eq 'full' || $parmlev eq 'brief') {          if ($parmlev eq 'full') {
            my $coursespan=$csec?8:5;             my $coursespan=$csec?8:5;
            $r->print('<p><table border=2>');             $r->print('<p><table border=2>');
            $r->print('<tr><td colspan=5></td>');             $r->print('<tr><td colspan=5></td>');
Line 1238  ENDTABLEHEADFOUR Line 1232  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 1291  ENDTABLEHEADFOUR Line 1285  ENDTABLEHEADFOUR
                                 undef $firstrow;                                  undef $firstrow;
                             }                              }
   
                             &print_row($r,$_,\%part,\%name,$rid,\%default,                              &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
                                        \%type,\%display,$defbgone,$defbgtwo,                                         \%type,\%display,$defbgone,$defbgtwo,
                                        $parmlev,$uname,$udom,$csec);                                         $parmlev,$uname,$udom,$csec);
                         }                          }
Line 1300  ENDTABLEHEADFOUR Line 1294  ENDTABLEHEADFOUR
             } # end foreach ids              } # end foreach ids
 # -------------------------------------------------- End entry for one resource  # -------------------------------------------------- End entry for one resource
             $r->print('</table>');              $r->print('</table>');
         } # end of  brief/full          } # end of  full
 #--------------------------------------------------- Entry for parm level map  #--------------------------------------------------- Entry for parm level map
         if ($parmlev eq 'map') {          if ($parmlev eq 'map') {
             my $defbgone = '"E0E099"';              my $defbgone = '"E0E099"';
Line 1337  ENDTABLEHEADFOUR Line 1331  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 1399  ENDMAPONE Line 1393  ENDMAPONE
   
         foreach (sort keys %name) {          foreach (sort keys %name) {
                     $r->print('<tr>');                      $r->print('<tr>');
                     &print_row($r,$_,\%part,\%name,$mapid,\%default,                      &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
                            \%type,\%display,$defbgone,$defbgtwo,                             \%type,\%display,$defbgone,$defbgtwo,
                            $parmlev,$uname,$udom,$csec);                             $parmlev,$uname,$udom,$csec);
 #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");  #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
Line 1425  ENDMAPONE Line 1419  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 1477  ENDMAPONE Line 1471  ENDMAPONE
   
     foreach (sort keys %name) {      foreach (sort keys %name) {
                 $r->print('<tr>');                  $r->print('<tr>');
                 &print_row($r,$_,\%part,\%name,$mapid,\%default,                  &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
                        \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);                         \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);
 #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");  #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
             }              }
Line 1485  ENDMAPONE Line 1479  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 2167  sub handler { Line 2159  sub handler {
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
     ['action','state']);      ['action','state']);
   
 # ----------------------------------------------------------- Clear out garbage  
   
     %courseopt=();  
     %useropt=();  
     %parmhash=();  
   
     @ids=();  
     %symbp=();  
     %mapp=();  
     %typep=();  
     %keyp=();  
   
     %maptitles=();  
   
     &Apache::lonhtmlcommon::clear_breadcrumbs();      &Apache::lonhtmlcommon::clear_breadcrumbs();
     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",      &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
     text=>"Parameter Manager",      text=>"Parameter Manager",
     faq=>9,      faq=>9,
     bug=>'Instructor Interface'});      bug=>'Instructor Interface'});
   
 # ----------------------------------------------------- Needs to be in a course  # ----------------------------------------------------- Needs to be in a course
     my $parm_permission =      my $parm_permission =
  (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||   (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
Line 2197  sub handler { Line 2177  sub handler {
         &Apache::loncommon::content_type($r,'text/html');          &Apache::loncommon::content_type($r,'text/html');
         $r->send_http_header;          $r->send_http_header;
   
   
           # id numbers can change on re-ordering of folders
   
           &resetsymbcache();
   
         #          #
         # Main switch on form.action and form.state, as appropriate          # Main switch on form.action and form.state, as appropriate
         #          #

Removed from v.1.195  
changed lines
  Added in v.1.203


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