Diff for /loncom/interface/loncommon.pm between versions 1.363 and 1.385

version 1.363, 2006/05/08 18:54:00 version 1.385, 2006/06/22 17:34:40
Line 64  use HTML::Entities; Line 64  use HTML::Entities;
 use Apache::lonhtmlcommon();  use Apache::lonhtmlcommon();
 use Apache::loncoursedata();  use Apache::loncoursedata();
 use Apache::lontexconvert();  use Apache::lontexconvert();
   use LONCAPA;
   
 my $readit;  my $readit;
   
Line 385  sub selectstudent_link { Line 386  sub selectstudent_link {
   
 sub coursebrowser_javascript {  sub coursebrowser_javascript {
     my ($domainfilter)=@_;      my ($domainfilter)=@_;
       my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role');
    return (<<ENDSTDBRW);     return (<<ENDSTDBRW);
 <script type="text/javascript" language="Javascript" >  <script type="text/javascript" language="Javascript" >
     var stdeditbrowser;      var stdeditbrowser;
     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) {      function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,crstype) {
         var url = '/adm/pickcourse?';          var url = '/adm/pickcourse?';
         var filter;          var filter;
         if (filter != null) {          if (filter != null) {
Line 414  sub coursebrowser_javascript { Line 416  sub coursebrowser_javascript {
         if (multflag !=null && multflag != '') {          if (multflag !=null && multflag != '') {
             url += '&multiple='+multflag;              url += '&multiple='+multflag;
         }          }
           if (crstype == 'Course/Group') {
               if (formname == 'cu') {
                   crstype = document.cu.crstype.options[document.cu.crstype.selectedIndex].value; 
                   if (crstype == "") {
                       alert("$crs_or_grp_alert");
                       return;
                   }
               }
           }
           if (crstype !=null && crstype != '') {
               url += '&type='+crstype;
           }
         var title = 'Course_Browser';          var title = 'Course_Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
         options += ',width=700,height=600';          options += ',width=700,height=600';
Line 425  ENDSTDBRW Line 439  ENDSTDBRW
 }  }
   
 sub selectcourse_link {  sub selectcourse_link {
    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_;     my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype)=@_;
     return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.      return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&mt('Select Course')."</a>";          '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select [_1]',$selecttype)."</a>";
 }  }
   
 sub check_uncheck_jscript {  sub check_uncheck_jscript {
Line 709  sub help_open_menu { Line 723  sub help_open_menu {
     my $timestamp = time;      my $timestamp = time;
     foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq,      foreach my $datum (\$color,\$function,\$topic,\$component_help,\$faq,
        \$bug,\$origurl) {         \$bug,\$origurl) {
         $$datum = &Apache::lonnet::escape($$datum);          $$datum = &escape($$datum);
     }      }
     if (!$stayOnPage) {      if (!$stayOnPage) {
          $link = "javascript:helpMenu('open')";           $link = "javascript:helpMenu('open')";
     } else {      } else {
         $link = "javascript:helpMenu('display')";          $link = "javascript:helpMenu('display')";
     }      }
     my $banner_link = "/adm/helpmenu?page=banner&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";      my $banner_link = "/adm/helpmenu?page=banner&amp;color=$color&amp;function=$function&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
     my $details_link = "/adm/helpmenu?page=body&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp";      my $details_link = "/adm/helpmenu?page=body&amp;color=$color&amp;function=$function&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp";
     my $template;      my $template;
     if ($text ne "") {      if ($text ne "") {
  $template .=    $template .= 
Line 775  ENDTEMPLATE Line 789  ENDTEMPLATE
        $width,$height).' '.$template;         $width,$height).' '.$template;
  } else {   } else {
     my $help_text;      my $help_text;
     $help_text=&Apache::lonnet::unescape($topic);      $help_text=&unescape($topic);
     $template='<table><tr><td>'.      $template='<table><tr><td>'.
  &help_open_topic($component_help,$help_text,$stayOnPage,   &help_open_topic($component_help,$help_text,$stayOnPage,
  $width,$height).'</td><td>'.$template.   $width,$height).'</td><td>'.$template.
Line 802  sub help_open_bug { Line 816  sub help_open_bug {
     $topic=~s/\W+/\+/g;      $topic=~s/\W+/\+/g;
     my $link='';      my $link='';
     my $template='';      my $template='';
     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.      my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
  &Apache::lonnet::escape($ENV{'REQUEST_URI'}).'&component='.$topic;   &escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
     if (!$stayOnPage)      if (!$stayOnPage)
     {      {
  $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";   $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
Line 2024  sub screenname { Line 2038  sub screenname {
 # ------------------------------------------------------------- Message Wrapper  # ------------------------------------------------------------- Message Wrapper
   
 sub messagewrapper {  sub messagewrapper {
     my ($link,$username,$domain)=@_;      my ($link,$username,$domain,$subject,$text)=@_;
     return       return 
         '<a href="/adm/email?compose=individual&'.          '<a href="/adm/email?compose=individual&'.
         'recname='.$username.'&recdom='.$domain.'" '.          'recname='.$username.'&recdom='.$domain.
    '&subject='.&escape($subject).'&text='.&escape($text).'" '.
         'title="'.&mt('Send message').'">'.$link.'</a>';          'title="'.&mt('Send message').'">'.$link.'</a>';
 }  }
 # --------------------------------------------------------------- Notes Wrapper  # --------------------------------------------------------------- Notes Wrapper
Line 2394  sub get_previous_attempt { Line 2409  sub get_previous_attempt {
        } else {         } else {
   $value=$returnhash{$version.':'.$key};    $value=$returnhash{$version.':'.$key};
        }         }
        $prevattempts.='<td>'.&Apache::lonnet::unescape($value).'&nbsp;</td>';            $prevattempts.='<td>'.&unescape($value).'&nbsp;</td>';   
     }      }
  }   }
       }        }
Line 2406  sub get_previous_attempt { Line 2421  sub get_previous_attempt {
  } else {   } else {
   $value=$lasthash{$key};    $value=$lasthash{$key};
  }   }
  $value=&Apache::lonnet::unescape($value);   $value=&unescape($value);
  if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}   if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
  $prevattempts.='<td>'.$value.'&nbsp;</td>';   $prevattempts.='<td>'.$value.'&nbsp;</td>';
       }        }
Line 2528  sub submlink { Line 2543  sub submlink {
  if (!$symb) { $symb=$cursymb; }   if (!$symb) { $symb=$cursymb; }
     }      }
     if (!$symb) { $symb=&Apache::lonnet::symbread(); }      if (!$symb) { $symb=&Apache::lonnet::symbread(); }
     $symb=&Apache::lonnet::escape($symb);      $symb=&escape($symb);
     if ($target) { $target="target=\"$target\""; }      if ($target) { $target="target=\"$target\""; }
     return '<a href="/adm/grades?&command=submission&'.      return '<a href="/adm/grades?&command=submission&'.
  'symb='.$symb.'&student='.$uname.   'symb='.$symb.'&student='.$uname.
Line 2574  sub pprmlink { Line 2589  sub pprmlink {
  if (!$symb) { $symb=$cursymb; }   if (!$symb) { $symb=$cursymb; }
     }      }
     if (!$symb) { $symb=&Apache::lonnet::symbread(); }      if (!$symb) { $symb=&Apache::lonnet::symbread(); }
     $symb=&Apache::lonnet::escape($symb);      $symb=&escape($symb);
     if ($target) { $target="target=\"$target\""; }      if ($target) { $target="target=\"$target\""; }
     return '<a href="/adm/parmset?&command=set&'.      return '<a href="/adm/parmset?&command=set&'.
  'symb='.$symb.'&uname='.$uname.   'symb='.$symb.'&uname='.$uname.
Line 2604  sub timehash { Line 2619  sub timehash {
              'dlsav'   => $ltime[8] );               'dlsav'   => $ltime[8] );
 }  }
   
   sub utc_string {
       my ($date)=@_;
       return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
   }
   
 sub maketime {  sub maketime {
     my %th=@_;      my %th=@_;
     return POSIX::mktime(      return POSIX::mktime(
Line 2806  sub bodytag { Line 2826  sub bodytag {
     @$addentries{keys(%design)} = @design{keys(%design)};      @$addentries{keys(%design)} = @design{keys(%design)};
   
  # role and realm   # role and realm
     my ($role,$realm) =      my ($role,$realm) = split(/\./,$env{'request.role'},2);
  &Apache::lonnet::plaintext((split(/\./,$env{'request.role'}))[0]);      if ($role  eq 'ca') {
           my ($rdom,$rname) = ($realm =~ m-^/(\w+)/(\w+)$-);
           $realm = &plainname($rname,$rdom).':'.$rdom;
       } 
 # realm  # realm
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
           if ($env{'request.role'} !~ /^cr/) {
               $role = &Apache::lonnet::plaintext($role,&course_type());
           }
  $realm = $env{'course.'.$env{'request.course.id'}.'.description'};   $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
       } else {
           $role = &Apache::lonnet::plaintext($role);
     }      }
     if (!$realm) { $realm='&nbsp;'; }      if (!$realm) { $realm='&nbsp;'; }
 # Set messages  # Set messages
Line 2871  ENDROLE Line 2899  ENDROLE
                                  '.domain'}.'/'})) {                                   '.domain'}.'/'})) {
         my $cid = $env{'request.course.id'};          my $cid = $env{'request.course.id'};
         $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};          $dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
           $dc_info =~ s/\s+$//;
         $dc_info = '('.$dc_info.')';          $dc_info = '('.$dc_info.')';
     }      }
   
Line 2945  ENDROLE Line 2974  ENDROLE
     return(<<ENDBODY);      return(<<ENDBODY);
 $bodytag  $bodytag
 <table id="LC_title_bar" class="LC_with_remote">  <table id="LC_title_bar" class="LC_with_remote">
 <tr><td>$upperleft</td>  <tr><td class="LC_title_bar_role_logo">$upperleft</td>
     <td class="LC_title_bar_domain_logo">$messages&nbsp;</td>      <td class="LC_title_bar_domain_logo">$messages&nbsp;</td>
 </tr>  </tr>
 <tr><td>$titleinfo $dc_info $menu</td>  <tr><td>$titleinfo $dc_info $menu</td>
 $roleinfo  $roleinfo
   </tr>
 </table>  </table>
 ENDBODY  ENDBODY
 }  }
Line 3068  sub standard_css { Line 3098  sub standard_css {
     my $tabbg  = &designparm($function.'.tabbg', $domain);      my $tabbg  = &designparm($function.'.tabbg', $domain);
     my $font   = &designparm($function.'.font',  $domain);      my $font   = &designparm($function.'.font',  $domain);
     my $sidebg = &designparm($function.'.sidebg',$domain);      my $sidebg = &designparm($function.'.sidebg',$domain);
     my $pgbg   = $bgcolor ||      my $pgbg_or_bgcolor =
            $bgcolor ||
          &designparm($function.'.pgbg',  $domain);           &designparm($function.'.pgbg',  $domain);
       my $pgbg   = &designparm($function.'.pgbg',  $domain);
     my $alink  = &designparm($function.'.alink', $domain);      my $alink  = &designparm($function.'.alink', $domain);
     my $vlink  = &designparm($function.'.vlink', $domain);      my $vlink  = &designparm($function.'.vlink', $domain);
     my $link   = &designparm($function.'.link',  $domain);      my $link   = &designparm($function.'.link',  $domain);
Line 3095  table.thinborder { border-collapse: coll Line 3127  table.thinborder { border-collapse: coll
 table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}  table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
 form, .inline { display: inline; }  form, .inline { display: inline; }
 .center { text-align: center; }  .center { text-align: center; }
 .filename {font-family: monospace;}  .LC_filename {font-family: monospace;}
 .LC_error {  .LC_error {
   color: red;    color: red;
   font-size: larger;    font-size: larger;
Line 3104  form, .inline { display: inline; } Line 3136  form, .inline { display: inline; }
   color: green;    color: green;
 }  }
   
 table#LC_top_nav, table#LC_menubuttons, table#LC_nav_location, table#LC_breadcrumbs {  table#LC_top_nav, table#LC_menubuttons, table#LC_nav_location {
   width: 100%;    width: 100%;
   background: $pgbg;    background: $pgbg;
   border: 0px;    border: 0px;
   border-spacing: 2px 1px;    border-spacing: 2px 2px;
   padding: 0px;    padding: 0px;
   margin: 0px;    margin: 0px;
   border-collapse: separate;    border-collapse: separate;
Line 3116  table#LC_top_nav, table#LC_menubuttons, Line 3148  table#LC_top_nav, table#LC_menubuttons,
 table#LC_title_bar {  table#LC_title_bar {
   width: 100%;    width: 100%;
   border: 0;    border: 0;
   border-spacing: 0px 1px;    border-spacing: 0px 0px;
     padding: 0px 2px 0px 2px;
   background: $pgbg;    background: $pgbg;
   font-family: $sans;    font-family: $sans;
   border-collapse: collapse;    border-collapse: separate;
   }
   table#LC_breadcrumbs {
     width: 100%;
     border: 0;
     border-spacing: 0px;
     padding: 0px 2px 0px 2px;
     background: $pgbg;
     font-family: $sans;
     border-collapse: separate;
 }  }
 table#LC_title_bar.LC_with_remote {  table#LC_title_bar.LC_with_remote {
   width: 100%;    width: 100%;
Line 3145  span.LC_title_bar_title { Line 3187  span.LC_title_bar_title {
 table#LC_title_bar td.LC_title_bar_domain_logo {  table#LC_title_bar td.LC_title_bar_domain_logo {
   background: $sidebg;    background: $sidebg;
   text-align: right;    text-align: right;
     padding: 0px;
   }
   table#LC_title_bar td.LC_title_bar_role_logo {
     background: $sidebg;
     padding: 0px;
 }  }
   
 table#LC_menubuttons_mainmenu {  table#LC_menubuttons_mainmenu {
   background: $pgbg;    background: $pgbg;
   border: 0px;    border: 0px;
   border-spacing: 1px;    border-spacing: 1px;
   padding: 0px;    padding: 0px 1px;
   margin: 0px;    margin: 0px;
   border-collapse: separate;    border-collapse: separate;
 }  }
Line 3165  table#LC_top_nav td a, div#LC_top_nav a Line 3212  table#LC_top_nav td a, div#LC_top_nav a
   color: $font;    color: $font;
   font-family: $sans;    font-family: $sans;
 }  }
   table#LC_top_nav td.LC_top_nav_logo {
     background: $tabbg;
     text-align: right;
   }
 table#LC_breadcrumbs td {  table#LC_breadcrumbs td {
   background: $tabbg;    background: $tabbg;
   color: $font;    color: $font;
Line 3178  table#LC_breadcrumbs td.LC_breadcrumb_co Line 3229  table#LC_breadcrumbs td.LC_breadcrumb_co
   font-size: larger;    font-size: larger;
   text-align: right;    text-align: right;
 }  }
   td.LC_table_cell_checkbox {
     text-align: center;
   }
   
 .LC_menubuttons_inline_text {  .LC_menubuttons_inline_text {
   color: $font;    color: $font;
   font-family: $sans;    font-family: $sans;
Line 3260  table.LC_mail_list tr.LC_mail_other { Line 3315  table.LC_mail_list tr.LC_mail_other {
 table.LC_mail_list tr.LC_mail_other:hover {  table.LC_mail_list tr.LC_mail_other:hover {
   background-color: $mail_other_hover;    background-color: $mail_other_hover;
 }  }
   
   
 END  END
 }  }
   
Line 3300  sub headtag { Line 3357  sub headtag {
    $env{'environment.color.timestamp'},     $env{'environment.color.timestamp'},
    $function,$domain,$bgcolor);     $function,$domain,$bgcolor);
   
     $url = '/adm/css/'.&Apache::lonnet::escape($url).'.css';      $url = '/adm/css/'.&escape($url).'.css';
   
     my $result =      my $result =
  '<head>'.   '<head>'.
Line 3536  Inputs:         $args - additional optio Line 3593  Inputs:         $args - additional optio
   
 sub end_page {  sub end_page {
     my ($args) = @_;      my ($args) = @_;
     #&Apache::lonnet::logthis("end_page ".join(':',caller(0)));  
     $env{'internal.end_page'}++;      $env{'internal.end_page'}++;
     my $result;      my $result;
     if ($args->{'discussion'}) {      if ($args->{'discussion'}) {
Line 3579  sub js_ready { Line 3635  sub js_ready {
     $result =~ s/[\n\r]/ /xmsg;      $result =~ s/[\n\r]/ /xmsg;
     $result =~ s/\\/\\\\/xmsg;      $result =~ s/\\/\\\\/xmsg;
     $result =~ s/'/\\'/xmsg;      $result =~ s/'/\\'/xmsg;
     $result =~ s{</script>}{</scrip'+'t>}xmsg;      $result =~ s{</}{<\\/}xmsg;
           
     return $result;      return $result;
 }  }
Line 3642  sub simple_error_page { Line 3698  sub simple_error_page {
     sub end_data_table_row {      sub end_data_table_row {
  return '</tr>';   return '</tr>';
     }      }
   
       sub start_data_table_header_row {
    return  '<tr class="LC_header_row">';
       }
   
       sub end_data_table_header_row {
    return '</tr>';
       }
 }  }
   
 ###############################################  ###############################################
Line 3684  specific user. Roles can be active, prev Line 3748  specific user. Roles can be active, prev
   
 Inputs:   Inputs: 
 user's domain, user's username, course's domain,  user's domain, user's username, course's domain,
 course's number, optional section/group.  course's number, optional section ID.
   
 Outputs:  Outputs:
 role status: active, previous or future.   role status: active, previous or future. 
Line 3735  sub check_user_status { Line 3799  sub check_user_status {
   
 Determines all the sections for a course including  Determines all the sections for a course including
 sections with students and sections containing other roles.  sections with students and sections containing other roles.
 Incoming parameters: domain, course number, reference to   Incoming parameters: domain, course number, 
 section hash (keys to be section/group IDs), reference to   reference to array containing roles for which sections should 
 array containing roles for which sections should be gathered  be gathered (optional). If the third argument is undefined,
 (optional). If the fourth argument is undefined, sections  sections are gathered for any role.
 are gathered for any role.  
     
 Returns number of sections.  Returns section hash (keys are section IDs, values are
   number of users in each section), subject to the
   optional roles filter.
   
 =cut  =cut
   
 ###############################################  ###############################################
 sub get_sections {  sub get_sections {
     my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;      my ($cdom,$cnum,$possible_roles) = @_;
     if (!($cdom && $cnum)) { return 0; }      if (!defined($cdom) || !defined($cnum)) {
     my $numsections = 0;          my $cid =  $env{'request.course.id'};
   
    return if (!defined($cid));
   
           $cdom = $env{'course.'.$cid.'.domain'};
           $cnum = $env{'course.'.$cid.'.num'};
       }
   
       my %sectioncount;
   
     if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) {      if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
  my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);   my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  my $sec_index = &Apache::loncoursedata::CL_SECTION();   my $sec_index = &Apache::loncoursedata::CL_SECTION();
  my $status_index = &Apache::loncoursedata::CL_STATUS();   my $status_index = &Apache::loncoursedata::CL_STATUS();
  while (my ($student,$data) = each %$classlist) {   while (my ($student,$data) = each(%$classlist)) {
     my ($section,$status) = ($data->[$sec_index],      my ($section,$status) = ($data->[$sec_index],
      $data->[$status_index]);       $data->[$status_index]);
     unless ($section eq '-1' || $section =~ /^\s*$/) {      unless ($section eq '-1' || $section =~ /^\s*$/) {
  if (!defined($$sectioncount{$section})) { $numsections++; }   $sectioncount{$section}++;
  $$sectioncount{$section}++;  
     }      }
  }   }
     }      }
Line 3776  sub get_sections { Line 3848  sub get_sections {
  }   }
  if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }   if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
  if (!defined($section) || $section eq '-1') { next; }   if (!defined($section) || $section eq '-1') { next; }
  if (!defined($$sectioncount{$section})) { $numsections++; }    $sectioncount{$section}++;
  $$sectioncount{$section}++;  
     }  
     return $numsections;  
 }  
   
 ###############################################  
                                                                                     
 =pod  
                                                                                     
 =item coursegroups  
   
 Retrieve information about groups in a course,  
   
 Input:  
 1. Reference to hash to populate with group information.   
 2. Optional course domain  
 3. Optional course number  
 4. Optional group name  
   
 Course domain and number will be taken from user's  
 environment if not supplied. Optional group name will'  
 be passed to lonnet::get_coursegroups() as a regexp to  
 use in the call to the dump function.  
   
 Output  
 Returns number of groups in the course (subject to the  
 optional group name filter).  
   
 Side effects:  
 Populates the referenced curr_groups hash, with key,  
 value pairs. Keys are group names, corresponding values  
 are scalars containing group information in XML. This  
 can be sent to &get_group_settings() to be parsed.       
   
 =cut   
   
 ###############################################  
   
 sub coursegroups {  
     my ($curr_groups,$cdom,$cnum,$group) = @_;  
     my $numgroups;  
     if (!defined($cdom) || !defined($cnum)) {  
         my $cid =  $env{'request.course.id'};  
         $cdom = $env{'course.'.$cid.'.domain'};  
         $cnum = $env{'course.'.$cid.'.num'};  
     }  
     %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);  
     my ($tmp) = keys(%{$curr_groups});  
     if ($tmp=~/^error:/) {  
         unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {  
             &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.  
                                                                    $cdom);  
         }  
         $numgroups = 0;  
     } else {  
         $numgroups = keys(%{$curr_groups});  
     }  
     return $numgroups;  
 }  
   
 ###############################################  
   
 =pod  
   
 =item get_group_settings  
   
 Uses TokeParser to extract group information from the  
 XML used to describe course groups.  
   
 Input:  
 Scalar containing XML  - as retrieved from &coursegroups().  
   
 Output:  
 Hash containing group information as key=values for (a), and  
 hash of hashes for (b)  
   
 Keys (in two categories):  
 (a) groupname, creator, creation, modified, startdate,enddate.  
 Corresponding values are name of the group, creator of the group  
 (username:domain), UNIX time for date group was created, and  
 settings were last modified, and default start and end access  
 times for group members.  
   
 (b) functions returned in hash of hashes.  
 Outer hash key is functions.  
 Inner hash keys are chat,discussion,email,files,homepage,roster.  
 Corresponding values are either on or off, depending on  
 whether this type of functionality is available for the group.  
   
 =cut  
                                                                                    
 ###############################################  
   
 sub get_group_settings {  
     my ($groupinfo)=@_;  
     my $parser=HTML::TokeParser->new(\$groupinfo);  
     my $token;  
     my $tool = '';  
     my $role = '';  
     my %content=();  
     while ($token=$parser->get_token) {  
         if ($token->[0] eq 'S')  {  
             my $entry=$token->[1];  
             if ($entry eq 'functions' || $entry eq 'autosec') {  
                 %{$content{$entry}} = ();  
                 $tool = $entry;  
             } elsif ($entry eq 'role') {  
                 if ($tool eq 'autosec') {  
                     $role = $token->[2]{id};  
                 }  
             } else {  
                 my $value=$parser->get_text('/'.$entry);  
                 if ($entry eq 'name') {  
                     if ($tool eq 'functions') {  
                         my $function = $token->[2]{id};  
                         $content{$tool}{$function} = $value;  
                     }  
                 } elsif ($entry eq 'groupname') {  
                     $content{$entry}=&Apache::lonnet::unescape($value);  
                 } elsif (($entry eq 'roles') || ($entry eq 'types') ||  
                          ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {  
                     push(@{$content{$entry}},$value);  
                 } elsif ($entry eq 'section') {  
                     if ($tool eq 'autosec'  && $role ne '') {  
                         push(@{$content{$tool}{$role}},$value);  
                     }  
                 } else {  
                     $content{$entry}=$value;  
                 }  
             }  
         } elsif ($token->[0] eq 'E') {  
             if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {  
                 $tool = '';  
             } elsif ($token->[1] eq 'role') {  
                 $role = '';  
             }  
   
         }  
     }      }
     return %content;      return %sectioncount;
 }  
   
 sub check_group_access {  
     my ($group) = @_;  
     my $access = 1;  
     my $now = time;  
     my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});  
     if (($end!=0) && ($end<$now)) { $access = 0; }  
     if (($start!=0) && ($start>$now)) { $access=0; }  
     return $access;  
 }  }
   
 ###############################################  ###############################################
Line 4062  sub get_user_info { Line 3986  sub get_user_info {
     return;      return;
 }  }
   
   sub get_secgrprole_info {
       my ($cdom,$cnum,$needroles,$type)  = @_;
       my %sections_count = &get_sections($cdom,$cnum);
       my @sections =  (sort {$a <=> $b} keys(%sections_count));
       my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
       my @groups = sort(keys(%curr_groups));
       my $allroles = [];
       my $rolehash;
       my $accesshash = {
                        active => 'Currently has access',
                        future => 'Will have future access',
                        previous => 'Previously had access',
                     };
       if ($needroles) {
           $rolehash = {'all' => 'all'};
           my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
    if (&Apache::lonnet::error(%user_roles)) {
       undef(%user_roles);
    }
           foreach my $item (keys(%user_roles)) {
               my ($role)=split(/\:/,$item,2);
               if ($role eq 'cr') { next; }
               if ($role =~ /^cr/) {
                   $$rolehash{$role} = (split('/',$role))[3];
               } else {
                   $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
               }
           }
           foreach my $key (sort(keys(%{$rolehash}))) {
               push(@{$allroles},$key);
           }
           push (@{$allroles},'st');
           $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
       }
       return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
   }
   
 =pod  =pod
   
 =item * get_unprocessed_cgi($query,$possible_names)  =item * get_unprocessed_cgi($query,$possible_names)
Line 4082  sub get_unprocessed_cgi { Line 4043  sub get_unprocessed_cgi {
   # $Apache::lonxml::debug=1;    # $Apache::lonxml::debug=1;
   foreach my $pair (split(/&/,$query)) {    foreach my $pair (split(/&/,$query)) {
     my ($name, $value) = split(/=/,$pair);      my ($name, $value) = split(/=/,$pair);
     $name = &Apache::lonnet::unescape($name);      $name = &unescape($name);
     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {      if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
       $value =~ tr/+/ /;        $value =~ tr/+/ /;
       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Line 4711  sub DrawBarGraph { Line 4672  sub DrawBarGraph {
     $Title  = '' if (! defined($Title));      $Title  = '' if (! defined($Title));
     $xlabel = '' if (! defined($xlabel));      $xlabel = '' if (! defined($xlabel));
     $ylabel = '' if (! defined($ylabel));      $ylabel = '' if (! defined($ylabel));
     $ValuesHash{$id.'.title'}    = &Apache::lonnet::escape($Title);      $ValuesHash{$id.'.title'}    = &escape($Title);
     $ValuesHash{$id.'.xlabel'}   = &Apache::lonnet::escape($xlabel);      $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
     $ValuesHash{$id.'.ylabel'}   = &Apache::lonnet::escape($ylabel);      $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
     $ValuesHash{$id.'.y_max_value'} = $Max;      $ValuesHash{$id.'.y_max_value'} = $Max;
     $ValuesHash{$id.'.NumBars'}  = $NumBars;      $ValuesHash{$id.'.NumBars'}  = $NumBars;
     $ValuesHash{$id.'.NumSets'}  = $NumSets;      $ValuesHash{$id.'.NumSets'}  = $NumSets;
Line 4793  sub DrawXYGraph { Line 4754  sub DrawXYGraph {
     $ylabel = '' if (! defined($ylabel));      $ylabel = '' if (! defined($ylabel));
     my %ValuesHash =       my %ValuesHash = 
         (          (
          $id.'.title'  => &Apache::lonnet::escape($Title),           $id.'.title'  => &escape($Title),
          $id.'.xlabel' => &Apache::lonnet::escape($xlabel),           $id.'.xlabel' => &escape($xlabel),
          $id.'.ylabel' => &Apache::lonnet::escape($ylabel),           $id.'.ylabel' => &escape($ylabel),
          $id.'.y_max_value'=> $Max,           $id.'.y_max_value'=> $Max,
          $id.'.labels'     => join(',',@$Xlabels),           $id.'.labels'     => join(',',@$Xlabels),
          $id.'.PlotType'   => 'XY',           $id.'.PlotType'   => 'XY',
Line 4890  sub DrawXYYGraph { Line 4851  sub DrawXYYGraph {
     $ylabel = '' if (! defined($ylabel));      $ylabel = '' if (! defined($ylabel));
     my %ValuesHash =       my %ValuesHash = 
         (          (
          $id.'.title'  => &Apache::lonnet::escape($Title),           $id.'.title'  => &escape($Title),
          $id.'.xlabel' => &Apache::lonnet::escape($xlabel),           $id.'.xlabel' => &escape($xlabel),
          $id.'.ylabel' => &Apache::lonnet::escape($ylabel),           $id.'.ylabel' => &escape($ylabel),
          $id.'.labels' => join(',',@$Xlabels),           $id.'.labels' => join(',',@$Xlabels),
          $id.'.PlotType' => 'XY',           $id.'.PlotType' => 'XY',
          $id.'.NumSets' => 2,           $id.'.NumSets' => 2,
Line 4964  Inputs: Line 4925  Inputs:
 sub chartlink {  sub chartlink {
     my ($linktext, $sname, $sdomain) = @_;      my ($linktext, $sname, $sdomain) = @_;
     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.      my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
         '&amp;SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).          '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').          '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
        '">'.$linktext.'</a>';         '">'.$linktext.'</a>';
 }  }
Line 4994  a hash ref describing the data to be sto Line 4955  a hash ref describing the data to be sto
     'chartoutputmode' => 'scalar',      'chartoutputmode' => 'scalar',
     'chartoutputdata' => 'scalar',      'chartoutputdata' => 'scalar',
     'Section' => 'array',      'Section' => 'array',
       'Group' => 'array',
     'StudentData' => 'array',      'StudentData' => 'array',
     'Maps' => 'array');      'Maps' => 'array');
   
Line 5027  sub store_course_settings { Line 4989  sub store_course_settings {
                 if (ref($env{'form.'.$setting})) {                  if (ref($env{'form.'.$setting})) {
                     $stored_form = join(',',                      $stored_form = join(',',
                                         map {                                          map {
                                             &Apache::lonnet::escape($_);                                              &escape($_);
                                         } sort(@{$env{'form.'.$setting}}));                                          } sort(@{$env{'form.'.$setting}}));
                 } else {                  } else {
                     $stored_form =                       $stored_form = 
                         &Apache::lonnet::escape($env{'form.'.$setting});                          &escape($env{'form.'.$setting});
                 }                  }
                 # Determine if the array contents are the same.                  # Determine if the array contents are the same.
                 if ($stored_form ne $env{$envname}) {                  if ($stored_form ne $env{$envname}) {
Line 5065  sub restore_course_settings { Line 5027  sub restore_course_settings {
             } elsif ($type eq 'array') {              } elsif ($type eq 'array') {
                 $env{'form.'.$setting} = [                   $env{'form.'.$setting} = [ 
                                            map {                                              map { 
                                                &Apache::lonnet::unescape($_);                                                  &unescape($_); 
                                            } split(',',$env{$envname})                                             } split(',',$env{$envname})
                                            ];                                             ];
             }              }
Line 5076  sub restore_course_settings { Line 5038  sub restore_course_settings {
 ############################################################  ############################################################
 ############################################################  ############################################################
   
 sub propath {  sub course_type {
     my ($udom,$uname)=@_;      my ($cid) = @_;
     $udom=~s/\W//g;      if (!defined($cid)) {
     $uname=~s/\W//g;          $cid = $env{'request.course.id'};
     my $subdir=$uname.'__';      }
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      if (defined($env{'course.'.$cid.'type'})) {
     my $proname="$Apache::lonnet::perlvar{'lonUsersDir'}/$udom/$subdir/$uname";          return $env{'course.'.$cid.'type'};
     return $proname;      } else {
 }           return 'Course';
       }
   }
   
 sub icon {  sub icon {
     my ($file)=@_;      my ($file)=@_;
Line 5138  sub escape_double { Line 5102  sub escape_double {
 sub escape_url {  sub escape_url {
     my ($url)   = @_;      my ($url)   = @_;
     my @urlslices = split(/\//, $url,-1);      my @urlslices = split(/\//, $url,-1);
     my $lastitem = &Apache::lonnet::escape(pop(@urlslices));      my $lastitem = &escape(pop(@urlslices));
     return join('/',@urlslices).'/'.$lastitem;      return join('/',@urlslices).'/'.$lastitem;
 }  }
 =pod  =pod

Removed from v.1.363  
changed lines
  Added in v.1.385


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