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

Diff for /loncom/interface/loncommon.pm between versions 1.183 and 1.221

version 1.183, 2004/02/20 17:13:04 version 1.221, 2004/10/21 09:53:44
Line 74  my $readit; Line 74  my $readit;
 my %language;  my %language;
 my %supported_language;  my %supported_language;
 my %cprtag;  my %cprtag;
   my %scprtag;
 my %fe; my %fd;  my %fe; my %fd;
 my %category_extensions;  my %category_extensions;
   
Line 131  BEGIN { Line 132  BEGIN {
             close($fh);              close($fh);
         }          }
     }      }
   # ------------------------------------------------------------------ source copyrights
       {
           my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                                     '/source_copyright.tab';
           if ( open (my $fh,"<$sourcecopyrightfile") ) {
               while (<$fh>) {
                   next if /^\#/;
                   chomp;
                   my ($key,$val)=(split(/\s+/,$_,2));
                   $scprtag{$key}=$val;
               }
               close($fh);
           }
       }
   
 # -------------------------------------------------------------- domain designs  # -------------------------------------------------------------- domain designs
   
Line 220  formname and elementname indicate the na Line 235  formname and elementname indicate the na
 the element that the results of the browsing selection are to be placed in.   the element that the results of the browsing selection are to be placed in. 
   
 Specifying 'only' will restrict the browser to displaying only files  Specifying 'only' will restrict the browser to displaying only files
 with the given extension.  Can be a comma seperated list.  with the given extension.  Can be a comma separated list.
   
 Specifying 'omit' will restrict the browser to NOT displaying files  Specifying 'omit' will restrict the browser to NOT displaying files
 with the given extension.  Can be a comma seperated list.  with the given extension.  Can be a comma separated list.
   
 =item * opensearcher(formname, elementname) [javascript]  =item * opensearcher(formname, elementname) [javascript]
   
Line 235  of the element the selection from the se Line 250  of the element the selection from the se
 =cut  =cut
   
 sub browser_and_searcher_javascript {  sub browser_and_searcher_javascript {
       my ($mode)=@_;
       if (!defined($mode)) { $mode='edit'; }
     my $resurl=&lastresurl();      my $resurl=&lastresurl();
     return <<END;      return <<END;
   // <!-- BEGIN LON-CAPA Internal
     var editbrowser = null;      var editbrowser = null;
     function openbrowser(formname,elementname,only,omit,titleelement) {      function openbrowser(formname,elementname,only,omit,titleelement) {
         var url = '$resurl/?';          var url = '$resurl/?';
Line 244  sub browser_and_searcher_javascript { Line 262  sub browser_and_searcher_javascript {
             url += 'launch=1&';              url += 'launch=1&';
         }          }
         url += 'catalogmode=interactive&';          url += 'catalogmode=interactive&';
         url += 'mode=edit&';          url += 'mode=$mode&';
         url += 'form=' + formname + '&';          url += 'form=' + formname + '&';
         if (only != null) {          if (only != null) {
             url += 'only=' + only + '&';              url += 'only=' + only + '&';
         }           } else {
               url += 'only=&';
    }
         if (omit != null) {          if (omit != null) {
             url += 'omit=' + omit + '&';              url += 'omit=' + omit + '&';
         }          } else {
               url += 'omit=&';
    }
         if (titleelement != null) {          if (titleelement != null) {
             url += 'titleelement=' + titleelement + '&';              url += 'titleelement=' + titleelement + '&';
         }          } else {
       url += 'titleelement=&';
    }
         url += 'element=' + elementname + '';          url += 'element=' + elementname + '';
         var title = 'Browser';          var title = 'Browser';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=1,location=1';
         options += ',width=700,height=600';          options += ',width=700,height=600';
         editbrowser = open(url,title,options,'1');          editbrowser = open(url,title,options,'1');
         editbrowser.focus();          editbrowser.focus();
Line 269  sub browser_and_searcher_javascript { Line 293  sub browser_and_searcher_javascript {
             url += 'launch=1&';              url += 'launch=1&';
         }          }
         url += 'catalogmode=interactive&';          url += 'catalogmode=interactive&';
         url += 'mode=edit&';          url += 'mode=$mode&';
         url += 'form=' + formname + '&';          url += 'form=' + formname + '&';
         if (titleelement != null) {          if (titleelement != null) {
             url += 'titleelement=' + titleelement + '&';              url += 'titleelement=' + titleelement + '&';
         }          } else {
       url += 'titleelement=&';
    }
         url += 'element=' + elementname + '';          url += 'element=' + elementname + '';
         var title = 'Search';          var title = 'Search';
         var options = 'scrollbars=1,resizable=1,menubar=0';          var options = 'scrollbars=1,resizable=1,menubar=0';
Line 281  sub browser_and_searcher_javascript { Line 307  sub browser_and_searcher_javascript {
         editsearcher = open(url,title,options,'1');          editsearcher = open(url,title,options,'1');
         editsearcher.focus();          editsearcher.focus();
     }      }
   // END LON-CAPA Internal -->
 END  END
 }  }
   
Line 353  sub coursebrowser_javascript { Line 380  sub coursebrowser_javascript {
    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) {      function opencrsbrowser(formname,uname,udom,desc) {
         var url = '/adm/pickcourse?';          var url = '/adm/pickcourse?';
         var filter;          var filter;
         if (filter != null) {          if (filter != null) {
Line 368  sub coursebrowser_javascript { Line 395  sub coursebrowser_javascript {
    }     }
         }          }
         url += 'form=' + formname + '&cnumelement='+uname+          url += 'form=' + formname + '&cnumelement='+uname+
                                     '&cdomelement='+udom;                              '&cdomelement='+udom+
                                       '&cnameelement='+desc;
         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 380  ENDSTDBRW Line 408  ENDSTDBRW
 }  }
   
 sub selectcourse_link {  sub selectcourse_link {
    my ($form,$unameele,$udomele)=@_;     my ($form,$unameele,$udomele,$desc)=@_;
     return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.      return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
         '","'.$udomele.'");'."'>".&mt('Select Course')."</a>";          '","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course')."</a>";
 }  }
   
 =pod  =pod
Line 465  sub linked_select_forms { Line 493  sub linked_select_forms {
     my $first = "document.$formname.$firstselectname";      my $first = "document.$formname.$firstselectname";
     # output the javascript to do the changing      # output the javascript to do the changing
     my $result = '';      my $result = '';
     $result.="<script>\n";      $result.="<script type=\"text/javascript\">\n";
     $result.="var select2data = new Object();\n";      $result.="var select2data = new Object();\n";
     $" = '","';      $" = '","';
     my $debug = '';      my $debug = '';
Line 593  sub help_open_topic { Line 621  sub help_open_topic {
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Online Help');      my $title = &mt('Online Help');
       my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link" title="$title"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>   <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 621  sub helpLatexCheatsheet { Line 650  sub helpLatexCheatsheet {
  .'</td></tr></table>';   .'</td></tr></table>';
 }  }
   
   sub help_open_menu {
       my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
       $text = "" if (not defined $text);
       $stayOnPage = 0 if (not defined $stayOnPage);
       if ($ENV{'browser.interface'} eq 'textual' ||
           $ENV{'environment.remote'} eq 'off' ) {
           $stayOnPage=1;
       }
       $width = 620 if (not defined $width);
       $height = 600 if (not defined $height);
       my $link='';
       my $title = &mt('Get help');
       my $origurl = $ENV{'REQUEST_URI'};
       my $timestamp = time;
       foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
           $$_ = &Apache::lonnet::escape($$_);
       }
   
       if (!$stayOnPage) {
            $link = "javascript:helpMenu('open')";
       } else {
           $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 $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 $template;
       if ($text ne "") {
    $template .= 
     "<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".
     "<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
       }
       my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
       $template .= <<"ENDTEMPLATE";
    <script type="text/javascript">
   //<!-- BEGIN LON-CAPA Internal
   function helpMenu(caller) {
       if (caller == 'open') {
           newWindow =  window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )
           caller = newWindow.document
       } else {
           caller = this.document
       }
       caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")
       caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe'  src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
       caller.write("</html>")
       caller.close()
       if (caller == newWindow.document) {
           caller.focus()
       }
   }
   // END LON-CAPA Internal -->
    </script>
    <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
   ENDTEMPLATE
       if ($component_help) {
    if (!$text) {
       $template=&help_open_topic($component_help,undef,$stayOnPage,
          $width,$height).' '.$template;
    } else {
       my $help_text;
       $help_text=&Apache::lonnet::unescape($topic);
       $template='<table><tr><td>'.
    &help_open_topic($component_help,$help_text,$stayOnPage,
    $width,$height).'</td><td>'.$template.
    '</td></tr></table>';
    }
       }
       if ($text ne '') { $template.='</td></tr></table>' };
       return $template;
   }
   
 sub help_open_bug {  sub help_open_bug {
     my ($topic, $text, $stayOnPage, $width, $height) = @_;      my ($topic, $text, $stayOnPage, $width, $height) = @_;
     unless ($ENV{'user.adv'}) { return ''; }      unless ($ENV{'user.adv'}) { return ''; }
Line 631  sub help_open_bug { Line 731  sub help_open_bug {
  $ENV{'environment.remote'} eq 'off' ) {   $ENV{'environment.remote'} eq 'off' ) {
  $stayOnPage=1;   $stayOnPage=1;
     }      }
     $width = 350 if (not defined $width);      $width = 600 if (not defined $width);
     $height = 400 if (not defined $height);      $height = 600 if (not defined $height);
   
     $topic=~s/\W+/\+/g;      $topic=~s/\W+/\+/g;
     my $link='';      my $link='';
Line 657  sub help_open_bug { Line 757  sub help_open_bug {
   
     # Add the graphic      # Add the graphic
     my $title = &mt('Report a Bug');      my $title = &mt('Report a Bug');
       my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link" title="$title"><image src="/adm/lonMisc/smallBug.gif" border="0" alt="(Bug: $topic)" /></a>   <a href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 701  sub help_open_faq { Line 802  sub help_open_faq {
   
     # Add the graphic      # Add the graphic
     my $title = &mt('View the FAQ');      my $title = &mt('View the FAQ');
       my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
     $template .= <<"ENDTEMPLATE";      $template .= <<"ENDTEMPLATE";
  <a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(FAQ: $topic)" /></a>   <a href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
 ENDTEMPLATE  ENDTEMPLATE
     if ($text ne '') { $template.='</td></tr></table>' };      if ($text ne '') { $template.='</td></tr></table>' };
     return $template;      return $template;
Line 716  ENDTEMPLATE Line 818  ENDTEMPLATE
   
 =item * csv_translate($text)   =item * csv_translate($text) 
   
 Translate $text to allow it to be output as a 'comma seperated values'   Translate $text to allow it to be output as a 'comma separated values' 
 format.  format.
   
 =cut  =cut
Line 726  format. Line 828  format.
 sub csv_translate {  sub csv_translate {
     my $text = shift;      my $text = shift;
     $text =~ s/\"/\"\"/g;      $text =~ s/\"/\"\"/g;
     $text =~ s/\n//g;      $text =~ s/\n/ /g;
     return $text;      return $text;
 }  }
   
Line 777  sub define_excel_formats { Line 879  sub define_excel_formats {
     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);      $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);      $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
     $format->{'date'} = $workbook->add_format(num_format=>      $format->{'date'} = $workbook->add_format(num_format=>
                                             'mmm d yyyy hh:mm AM/PM');                                              'mm/dd/yyyy hh:mm:ss');
     return $format;      return $format;
 }  }
   
Line 906  sub domain_select { Line 1008  sub domain_select {
     } &get_domains;      } &get_domains;
     if ($multiple) {      if ($multiple) {
  $domains{''}=&mt('Any domain');   $domains{''}=&mt('Any domain');
  return &multiple_select_form($name,$value,%domains);   return &multiple_select_form($name,$value,4,%domains);
     } else {      } else {
  return &select_form($name,$value,%domains);   return &select_form($name,$value,%domains);
     }      }
 }  }
   
 sub multiple_select_form {  sub multiple_select_form {
     my ($name,$value,%hash)=@_;      my ($name,$value,$size,%hash)=@_;
     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);      my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
     my $output='';      my $output='';
     my $size =(scalar keys %hash<4?scalar keys %hash:4);      if (! defined($size)) {
           $size = 4;
           if (scalar(keys(%hash))<4) {
               $size = scalar(keys(%hash));
           }
       }
     $output.="\n<select name='$name' size='$size' multiple='1'>";      $output.="\n<select name='$name' size='$size' multiple='1'>";
     foreach (sort keys %hash) {      foreach (sort(keys(%hash))) {
         $output.="<option name='$_'".          $output.='<option value="'.$_.'" ';
             ($selected{$_}?' selected="1"' :'').">$hash{$_}</option>\n";          $output.='selected ' if ($selected{$_});
           $output.='>'.$hash{$_}."</option>\n";
     }      }
     $output.="</select>\n";      $output.="</select>\n";
     return $output;      return $output;
Line 1650  sub plainname { Line 1758  sub plainname {
  $names{'lastname'}.' '.$names{'generation'};   $names{'lastname'}.' '.$names{'generation'};
     $name=~s/\s+$//;      $name=~s/\s+$//;
     $name=~s/\s+/ /g;      $name=~s/\s+/ /g;
       if ($name !~ /\S/) { $name=$uname.'@'.$udom; }
     return $name;      return $name;
 }  }
   
Line 1672  if the user does not Line 1781  if the user does not
   
 sub nickname {  sub nickname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names=&Apache::lonnet::get('environment',      my %names;
   ['nickname','firstname','middlename','lastname','generation'],$udom,$uname);      if ($uname eq $ENV{'user.name'} &&
    $udom eq $ENV{'user.domain'}) {
    %names=('nickname'   => $ENV{'environment.nickname'}  ,
    'firstname'  => $ENV{'environment.firstname'} ,
    'middlename' => $ENV{'environment.middlename'},
    'lastname'   => $ENV{'environment.lastname'}  ,
    'generation' => $ENV{'environment.generation'});
       } else {
    %names=&Apache::lonnet::get('environment',
       ['nickname','firstname','middlename',
        'lastname','generation'],$udom,$uname);
       }
     my $name=$names{'nickname'};      my $name=$names{'nickname'};
     if ($name) {      if ($name) {
        $name='&quot;'.$name.'&quot;';          $name='&quot;'.$name.'&quot;'; 
Line 1699  Gets a users screenname and returns it a Line 1819  Gets a users screenname and returns it a
   
 sub screenname {  sub screenname {
     my ($uname,$udom)=@_;      my ($uname,$udom)=@_;
     my %names=      if ($uname eq $ENV{'user.name'} &&
  &Apache::lonnet::get('environment',['screenname'],$udom,$uname);   $udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};}
       my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
     return $names{'screenname'};      return $names{'screenname'};
 }  }
   
   
 # ------------------------------------------------------------- Message Wrapper  # ------------------------------------------------------------- Message Wrapper
   
 sub messagewrapper {  sub messagewrapper {
     my ($link,$un,$do)=@_;      my ($link,$username,$domain)=@_;
     return       return 
 "<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";          '<a href="/adm/email?compose=individual&'.
           'recname='.$username.'&recdom='.$domain.'" '.
           'title="'.&mt('Send message').'">'.$link.'</a>';
 }  }
 # --------------------------------------------------------------- Notes Wrapper  # --------------------------------------------------------------- Notes Wrapper
   
Line 1722  sub noteswrapper { Line 1846  sub noteswrapper {
   
 sub aboutmewrapper {  sub aboutmewrapper {
     my ($link,$username,$domain,$target)=@_;      my ($link,$username,$domain,$target)=@_;
     return "<a href='/adm/$domain/$username/aboutme'".      return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
  ($target?" target='$target'":'').">$link</a>";   ($target?' target="$target"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';
 }  }
   
 # ------------------------------------------------------------ Syllabus Wrapper  # ------------------------------------------------------------ Syllabus Wrapper
Line 1734  sub syllabuswrapper { Line 1858  sub syllabuswrapper {
     if ($fontcolor) {       if ($fontcolor) { 
         $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';           $linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>'; 
     }      }
     return "<a href='/public/$domain/$coursedir/syllabus'>$linktext</a>";      return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
   }
   
   sub track_student_link {
       my ($linktext,$sname,$sdom,$target) = @_;
       my $link ="/adm/trackstudent";
       my $title = 'View recent activity';
       if (defined($sname) && $sname !~ /^\s*$/ &&
           defined($sdom)  && $sdom  !~ /^\s*$/) {
           $link .= "?selected_student=$sname:$sdom";
           $title .= ' of this student';
       }
       if (defined($target) && $target !~ /^\s*$/) {
           $target = qq{target="$target"};
       } else {
           $target = '';
       }
       return qq{<a href="$link" title="$title" $target>$linktext</a>};
 }  }
   
   
   
 =pod  =pod
   
 =back  =back
Line 1806  sub copyrightdescription { Line 1949  sub copyrightdescription {
   
 =pod  =pod
   
   =item * source_copyrightids() 
   
   returns list of all source copyrights
   
   =cut
   
   sub source_copyrightids {
       return sort(keys(%scprtag));
   }
   
   =pod
   
   =item * source_copyrightdescription() 
   
   returns description of a specified source copyright id
   
   =cut
   
   sub source_copyrightdescription {
       return &mt($scprtag{shift(@_)});
   }
   
   =pod
   
 =item * filecategories()   =item * filecategories() 
   
 returns list of all file categories  returns list of all file categories
Line 1844  sub fileembstyle { Line 2011  sub fileembstyle {
   
 sub filecategoryselect {  sub filecategoryselect {
     my ($name,$value)=@_;      my ($name,$value)=@_;
     return &select_form($name,$value,      return &select_form($value,$name,
  '' => &mt('Any category'),   '' => &mt('Any category'),
  map { $_,$_ } sort(keys(%category_extensions)));   map { $_,$_ } sort(keys(%category_extensions)));
 }  }
Line 1858  returns description for a specified file Line 2025  returns description for a specified file
 =cut  =cut
   
 sub filedescription {  sub filedescription {
     return &mt($fd{lc(shift(@_))});      my $file_description = $fd{lc(shift())};
       $file_description =~ s:([\[\]]):~$1:g;
       return &mt($file_description);
 }  }
   
 =pod  =pod
Line 1872  extra formatting Line 2041  extra formatting
   
 sub filedescriptionex {  sub filedescriptionex {
     my $ex=shift;      my $ex=shift;
     return '.'.$ex.' '.&mt($fd{lc($ex)});      my $file_description = $fd{lc($ex)};
       $file_description =~ s:([\[\]]):~$1:g;
       return '.'.$ex.' '.&mt($file_description);
 }  }
   
 # End of .tab access  # End of .tab access
Line 2093  show a snapshot of what student was look Line 2264  show a snapshot of what student was look
 =cut  =cut
   
 sub get_student_view {  sub get_student_view {
   my ($symb,$username,$domain,$courseid,$target) = @_;    my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);    my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
   my (%old,%moreenv);    my (%form);
   my @elements=('symb','courseid','domain','username');    my @elements=('symb','courseid','domain','username');
   foreach my $element (@elements) {    foreach my $element (@elements) {
     $old{$element}=$ENV{'form.grade_'.$element};        $form{'grade_'.$element}=eval '$'.$element #'
     $moreenv{'form.grade_'.$element}=eval '$'.$element #'  
   }    }
   if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}    if (defined($moreenv)) {
   &Apache::lonnet::appenv(%moreenv);        %form=(%form,%{$moreenv});
   $feedurl=&Apache::lonnet::clutter($feedurl);  
   my $userview=&Apache::lonnet::ssi_body($feedurl);  
   &Apache::lonnet::delenv('form.grade_');  
   foreach my $element (@elements) {  
     $ENV{'form.grade_'.$element}=$old{$element};  
   }    }
     if ($target eq 'tex') {$form{'grade_target'} = 'tex';}
     $feedurl=&Apache::lonnet::clutter($feedurl);
     my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
   $userview=~s/\<body[^\>]*\>//gi;    $userview=~s/\<body[^\>]*\>//gi;
   $userview=~s/\<\/body\>//gi;    $userview=~s/\<\/body\>//gi;
   $userview=~s/\<html\>//gi;    $userview=~s/\<html\>//gi;
Line 2131  show a snapshot of how student was answe Line 2299  show a snapshot of how student was answe
 sub get_student_answers {  sub get_student_answers {
   my ($symb,$username,$domain,$courseid,%form) = @_;    my ($symb,$username,$domain,$courseid,%form) = @_;
   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);    my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
   my (%old,%moreenv);    my (%moreenv);
   my @elements=('symb','courseid','domain','username');    my @elements=('symb','courseid','domain','username');
   foreach my $element (@elements) {    foreach my $element (@elements) {
     $old{$element}=$ENV{'form.grade_'.$element};      $moreenv{'grade_'.$element}=eval '$'.$element #'
     $moreenv{'form.grade_'.$element}=eval '$'.$element #'  
   }  
   $moreenv{'form.grade_target'}='answer';  
   &Apache::lonnet::appenv(%moreenv);  
   my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form);  
   &Apache::lonnet::delenv('form.grade_');  
   foreach my $element (@elements) {  
     $ENV{'form.grade_'.$element}=$old{$element};  
   }    }
     $moreenv{'grade_target'}='answer';
     %moreenv=(%form,%moreenv);
     my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv);
   return $userview;    return $userview;
 }  }
   
Line 2197  sub maketime { Line 2360  sub maketime {
     my %th=@_;      my %th=@_;
     return POSIX::mktime(      return POSIX::mktime(
         ($th{'seconds'},$th{'minutes'},$th{'hours'},          ($th{'seconds'},$th{'minutes'},$th{'hours'},
          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'}));           $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
 }  }
   
 #########################################  #########################################
Line 2268  sub domainlogo { Line 2431  sub domainlogo {
     my $domain = &determinedomain(shift);          my $domain = &determinedomain(shift);    
      # See if there is a logo       # See if there is a logo
     if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {      if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
  my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};   my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
  if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }          return '<img src="'.$logo.'" alt="'.$domain.'" />';
         return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.  
     '/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';  
     } elsif(exists($Apache::lonnet::domaindescription{$domain})) {      } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
         return $Apache::lonnet::domaindescription{$domain};          return $Apache::lonnet::domaindescription{$domain};
     } else {      } else {
Line 2408  END Line 2569  END
                '<h1>LON-CAPA: '.$title.'</h1>';                 '<h1>LON-CAPA: '.$title.'</h1>';
     } elsif ($ENV{'environment.remote'} eq 'off') {      } elsif ($ENV{'environment.remote'} eq 'off') {
 # No Remote  # No Remote
    my $roleinfo=(<<ENDROLE);
   <td bgcolor="$tabbg" align="right">
   <p>
   <font size="2" face="Arial, Helvetica, sans-serif">
       $ENV{'environment.firstname'}
       $ENV{'environment.middlename'}
       $ENV{'environment.lastname'}
       $ENV{'environment.generation'}
       </font>&nbsp;
   <br />
   <font size="2" face="Arial, Helvetica, sans-serif">$role</font>&nbsp;
   <br />
   <font size="2" face="Arial, Helvetica, sans-serif">$realm</font>&nbsp;
   </p>
   </td>
   ENDROLE
         return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',          return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
                                                       $forcereg).                                                        $forcereg).
       '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.        '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td rowspan="3" bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.
 '</b></font></td></tr></table>';  '</b></font></td>'.$roleinfo.'</tr></table>';
     }      }
   
 #  #
Line 2441  $upperleft</td> Line 2618  $upperleft</td>
 </td></tr>  </td></tr>
 <tr>  <tr>
 <td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font>&nbsp;</td></tr>  <td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font>&nbsp;</td></tr>
 </table><br>  </table><br />
 ENDBODY  ENDBODY
 }  }
   
Line 2582  returns cache-controlling header code Line 2759  returns cache-controlling header code
 =cut  =cut
   
 sub cacheheader {  sub cacheheader {
   unless ($ENV{'request.method'} eq 'GET') { return ''; }      unless ($ENV{'request.method'} eq 'GET') { return ''; }
   my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
   my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />      my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />                  <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';                  <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
   return $output;      return $output;
 }  }
   
 =pod  =pod
Line 2599  specifies header code to not have cache Line 2776  specifies header code to not have cache
 =cut  =cut
   
 sub no_cache {  sub no_cache {
   my ($r) = @_;      my ($r) = @_;
   unless ($ENV{'request.method'} eq 'GET') { return ''; }      if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
   #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);   $ENV{'request.method'} ne 'GET') { return ''; }
   $r->no_cache(1);      my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
   $r->header_out("Pragma" => "no-cache");      $r->no_cache(1);
   #$r->header_out("Expires" => $date);      $r->header_out("Expires" => $date);
       $r->header_out("Pragma" => "no-cache");
 }  }
   
 sub content_type {  sub content_type {
Line 3115  sub DrawBarGraph { Line 3293  sub DrawBarGraph {
     }      }
     #      #
     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);      my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
     if ($NumBars < 10) {      if ($NumBars < 5) {
           $width = 120+$NumBars*25;
           $xskip = 1;
           $bar_width = 25;
       } elsif ($NumBars < 10) {
         $width = 120+$NumBars*15;          $width = 120+$NumBars*15;
         $xskip = 1;          $xskip = 1;
         $bar_width = 15;          $bar_width = 15;
Line 3198  plotted in.  If undefined, default value Line 3380  plotted in.  If undefined, default value
 =item $Xlabels: Array ref containing the labels to be used for the X-axis.  =item $Xlabels: Array ref containing the labels to be used for the X-axis.
   
 =item $Ydata: Array ref containing Array refs.    =item $Ydata: Array ref containing Array refs.  
 Each of the contained arrays will be plotted as a seperate curve.  Each of the contained arrays will be plotted as a separate curve.
   
 =item %Values: hash indicating or overriding any default values which are   =item %Values: hash indicating or overriding any default values which are 
 passed to graph.png.    passed to graph.png.  
Line 3398  Inputs: Line 3580  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'.
         '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).          '&amp;SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
         '&chartoutputmode='.HTML::Entities::encode('html, with all links').          '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
        '">'.$linktext.'</a>';         '">'.$linktext.'</a>';
 }  }
   
Line 3536  sub icon { Line 3718  sub icon {
     return $iconname;      return $iconname;
 }   } 
   
   sub lonhttpdurl {
       my ($url)=@_;
       my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'};
       if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; }
       return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url;
   }
   
   sub connection_aborted {
       my ($r)=@_;
       $r->print(" ");$r->rflush();
       my $c = $r->connection;
       return $c->aborted();
   }
   
   #
   #    Escapes strings that may have embedded 's that will be put into
   #    javascript strings as 'strings'.
   #    The assumptions are:
   #       There has been no effort to escape ' with \'
   #       Any \'s in the string are intended to be there as part of the URL
   #        and must also be escaped.
   # Parameters:
   #     input     - The string to escape.
   # Returns:
   #     The escaped string (' replaced by \' and \ replaced by \\).
   #
   sub javascript_escape {
       my ($input) = @_;
   
       #  I imagine a regexp wizard could combine the two expressions below.
       #  If you do you might want to comment the result.
   
       $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
       $input =~ s/\'/\\\'/g; # Esacpe the 's....
   
       return $input;
   }
   
   
 =pod  =pod
   
 =back  =back
Removed from v.1.183  
changed lines
  Added in v.1.221

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