--- loncom/interface/loncommon.pm 2004/01/02 21:00:56 1.170 +++ loncom/interface/loncommon.pm 2004/07/26 21:57:27 1.203 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.170 2004/01/02 21:00:56 www Exp $ +# $Id: loncommon.pm,v 1.203 2004/07/26 21:57:27 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -74,6 +74,7 @@ my $readit; my %language; my %supported_language; my %cprtag; +my %scprtag; my %fe; my %fd; my %category_extensions; @@ -131,6 +132,20 @@ BEGIN { 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 @@ -220,10 +235,10 @@ formname and elementname indicate the na the element that the results of the browsing selection are to be placed in. 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 -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] @@ -235,6 +250,8 @@ of the element the selection from the se =cut sub browser_and_searcher_javascript { + my ($mode)=@_; + if (!defined($mode)) { $mode='edit'; } my $resurl=&lastresurl(); return < var stdeditbrowser; - function opencrsbrowser(formname,uname,udom) { + function opencrsbrowser(formname,uname,udom,desc) { var url = '/adm/pickcourse?'; var filter; if (filter != null) { @@ -368,7 +385,8 @@ sub coursebrowser_javascript { } } url += 'form=' + formname + '&cnumelement='+uname+ - '&cdomelement='+udom; + '&cdomelement='+udom+ + '&cnameelement='+desc; var title = 'Course_Browser'; var options = 'scrollbars=1,resizable=1,menubar=0'; options += ',width=700,height=600'; @@ -380,9 +398,9 @@ ENDSTDBRW } sub selectcourse_link { - my ($form,$unameele,$udomele)=@_; + my ($form,$unameele,$udomele,$desc)=@_; return "".&mt('Select Course').""; + '","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course').""; } =pod @@ -592,8 +610,9 @@ sub help_open_topic { } # Add the graphic + my $title = &mt('Online Help'); $template .= <<"ENDTEMPLATE"; - (Help: $topic) + (Help: $topic) ENDTEMPLATE if ($text ne '') { $template.='' }; return $template; @@ -620,15 +639,176 @@ sub helpLatexCheatsheet { .''; } +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 .= + "". + "
$text"; + } + $template .= <<"ENDTEMPLATE"; + + (Help Menu) +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='
'. + &help_open_topic($component_help,$help_text,$stayOnPage, + $width,$height).''.$template. + '
'; + } + } + if ($text ne '') { $template.='
' }; + return $template; +} + +sub help_open_bug { + my ($topic, $text, $stayOnPage, $width, $height) = @_; + unless ($ENV{'user.adv'}) { return ''; } + unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; } + $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 = 600 if (not defined $width); + $height = 600 if (not defined $height); + + $topic=~s/\W+/\+/g; + my $link=''; + my $template=''; + my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='. + &Apache::lonnet::escape($ENV{'REQUEST_URI'}).'&component='.$topic; + if (!$stayOnPage) + { + $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; + } + else + { + $link = $url; + } + # Add the text + if ($text ne "") + { + $template .= + "". + "
$text"; + } + + # Add the graphic + my $title = &mt('Report a Bug'); + $template .= <<"ENDTEMPLATE"; + (Bug: $topic) +ENDTEMPLATE + if ($text ne '') { $template.='
' }; + return $template; + +} + +sub help_open_faq { + my ($topic, $text, $stayOnPage, $width, $height) = @_; + unless ($ENV{'user.adv'}) { return ''; } + unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; } + $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 = 350 if (not defined $width); + $height = 400 if (not defined $height); + + $topic=~s/\W+/\+/g; + my $link=''; + my $template=''; + my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html'; + if (!$stayOnPage) + { + $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))"; + } + else + { + $link = $url; + } + + # Add the text + if ($text ne "") + { + $template .= + "". + "
$text"; + } + + # Add the graphic + my $title = &mt('View the FAQ'); + $template .= <<"ENDTEMPLATE"; + (FAQ: $topic) +ENDTEMPLATE + if ($text ne '') { $template.='
' }; + return $template; + +} + +############################################################### +############################################################### + =pod =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. =cut +############################################################### +############################################################### sub csv_translate { my $text = shift; $text =~ s/\"/\"\"/g; @@ -636,6 +816,60 @@ sub csv_translate { return $text; } + +############################################################### +############################################################### + +=pod + +=item * define_excel_formats + +Define some commonly used Excel cell formats. + +Currently supported formats: + +=over 4 + +=item header + +=item bold + +=item h1 + +=item h2 + +=item h3 + +=item date + +=back + +Inputs: $workbook + +Returns: $format, a hash reference. + +=cut + +############################################################### +############################################################### +sub define_excel_formats { + my ($workbook) = @_; + my $format; + $format->{'header'} = $workbook->add_format(bold => 1, + bottom => 1, + align => 'center'); + $format->{'bold'} = $workbook->add_format(bold=>1); + $format->{'h1'} = $workbook->add_format(bold=>1, size=>18); + $format->{'h2'} = $workbook->add_format(bold=>1, size=>16); + $format->{'h3'} = $workbook->add_format(bold=>1, size=>14); + $format->{'date'} = $workbook->add_format(num_format=> + 'mmm d yyyy hh:mm AM/PM'); + return $format; +} + +############################################################### +############################################################### + =pod =item * change_content_javascript(): @@ -758,21 +992,27 @@ sub domain_select { } &get_domains; if ($multiple) { $domains{''}=&mt('Any domain'); - return &multiple_select_form($name,$value,%domains); + return &multiple_select_form($name,$value,4,%domains); } else { return &select_form($name,$value,%domains); } } sub multiple_select_form { - my ($name,$value,%hash)=@_; + my ($name,$value,$size,%hash)=@_; my %selected = map { $_ => 1 } ref($value)?@{$value}:($value); 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\n"; return $output; @@ -1071,6 +1311,11 @@ END } my $radioval = "'nochange'"; + if (exists($in{'curr_authtype'}) && + defined($in{'curr_authtype'}) && + $in{'curr_authtype'} ne '') { + $radioval = "'$in{'curr_authtype'}arg'"; + } my $argfield = 'null'; if ( grep/^mode$/,(keys %in) ) { if ($in{'mode'} eq 'modifycourse') { @@ -1497,6 +1742,7 @@ sub plainname { $names{'lastname'}.' '.$names{'generation'}; $name=~s/\s+$//; $name=~s/\s+/ /g; + if ($name !~ /\S/) { $name=$uname.'@'.$udom; } return $name; } @@ -1554,9 +1800,11 @@ sub screenname { # ------------------------------------------------------------- Message Wrapper sub messagewrapper { - my ($link,$un,$do)=@_; + my ($link,$username,$domain)=@_; return -"$link"; + ''.$link.''; } # --------------------------------------------------------------- Notes Wrapper @@ -1569,8 +1817,8 @@ sub noteswrapper { sub aboutmewrapper { my ($link,$username,$domain,$target)=@_; - return "$link"; + return ''.$link.''; } # ------------------------------------------------------------ Syllabus Wrapper @@ -1653,6 +1901,30 @@ sub copyrightdescription { =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() returns list of all file categories @@ -1691,7 +1963,7 @@ sub fileembstyle { sub filecategoryselect { my ($name,$value)=@_; - return &select_form($name,$value, + return &select_form($value,$name, '' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))); } @@ -1705,7 +1977,9 @@ returns description for a specified file =cut sub filedescription { - return &mt($fd{lc(shift(@_))}); + my $file_description = $fd{lc(shift())}; + $file_description =~ s:([\[\]]):~$1:g; + return &mt($file_description); } =pod @@ -1719,7 +1993,9 @@ extra formatting sub filedescriptionex { 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 @@ -1754,13 +2030,13 @@ sub display_languages { sub preferred_languages { my @languages=(); - if ($ENV{'environment.languages'}) { - @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'}); - } if ($ENV{'course.'.$ENV{'request.course.id'}.'.languages'}) { @languages=(@languages,split(/\s*(\,|\;|\:)\s*/, $ENV{'course.'.$ENV{'request.course.id'}.'.languages'})); } + if ($ENV{'environment.languages'}) { + @languages=split(/\s*(\,|\;|\:)\s*/,$ENV{'environment.languages'}); + } my $browser=(split(/\;/,$ENV{'HTTP_ACCEPT_LANGUAGE'}))[0]; if ($browser) { @languages=(@languages,split(/\s*(\,|\;|\:)\s*/,$browser)); @@ -1940,22 +2216,19 @@ show a snapshot of what student was look =cut 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 (%old,%moreenv); + my (%form); my @elements=('symb','courseid','domain','username'); foreach my $element (@elements) { - $old{$element}=$ENV{'form.grade_'.$element}; - $moreenv{'form.grade_'.$element}=eval '$'.$element #' + $form{'grade_'.$element}=eval '$'.$element #' } - if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';} - &Apache::lonnet::appenv(%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 (defined($moreenv)) { + %form=(%form,%{$moreenv}); } + if ($target eq 'tex') {$form{'grade_target'} = 'tex';} + $feedurl=&Apache::lonnet::clutter($feedurl); + my $userview=&Apache::lonnet::ssi_body($feedurl,%form); $userview=~s/\]*\>//gi; $userview=~s/\<\/body\>//gi; $userview=~s/\//gi; @@ -1978,19 +2251,14 @@ show a snapshot of how student was answe sub get_student_answers { my ($symb,$username,$domain,$courseid,%form) = @_; my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb); - my (%old,%moreenv); + my (%moreenv); my @elements=('symb','courseid','domain','username'); foreach my $element (@elements) { - $old{$element}=$ENV{'form.grade_'.$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_'.$element}=eval '$'.$element #' } + $moreenv{'grade_target'}='answer'; + %moreenv=(%form,%moreenv); + my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv); return $userview; } @@ -2206,19 +2474,7 @@ other decorations will be returned. sub bodytag { my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_; $title=&mt($title); - unless ($function) { - $function='student'; - if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { - $function='coordinator'; - } - if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) { - $function='admin'; - } - if (($ENV{'request.role'}=~/^(au|ca)/) || - ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { - $function='author'; - } - } + $function = &get_users_function() if (!$function); my $img=&designparm($function.'.img',$domain); my $pgbg=&designparm($function.'.pgbg',$domain); my $tabbg=&designparm($function.'.tabbg',$domain); @@ -2300,12 +2556,39 @@ $upperleft $realm  -
+
ENDBODY } ############################################### +=pod + +=item get_users_function + +Used by &bodytag to determine the current users primary role. +Returns either 'student','coordinator','admin', or 'author'. + +=cut + +############################################### +sub get_users_function { + my $function = 'student'; + if ($ENV{'request.role'}=~/^(cc|in|ta|ep)/) { + $function='coordinator'; + } + if ($ENV{'request.role'}=~/^(su|dc|ad|li)/) { + $function='admin'; + } + if (($ENV{'request.role'}=~/^(au|ca)/) || + ($ENV{'REQUEST_URI'}=~/^(\/priv|\~)/)) { + $function='author'; + } + return $function; +} + +############################################### + sub get_posted_cgi { my $r=shift; @@ -2440,11 +2723,16 @@ sub no_cache { } sub content_type { - my ($r,$type,$charset) = @_; - unless ($charset) { - $charset=&Apache::lonlocal::current_encoding; - } - $r->content_type($type.($charset?'; charset='.$charset:'')); + my ($r,$type,$charset) = @_; + unless ($charset) { + $charset=&Apache::lonlocal::current_encoding; + } + if ($charset) { $type.='; charset='.$charset; } + if ($r) { + $r->content_type($type); + } else { + print("Content-type: $type\n\n"); + } } =pod @@ -2600,7 +2888,7 @@ sub record_sep { } } elsif ($ENV{'form.upfiletype'} eq 'tab') { my $i=0; - foreach (split(/\t+/,$record)) { + foreach (split(/\t/,$record)) { my $field=$_; $field=~s/^(\"|\')//; $field=~s/(\"|\')$//; @@ -2708,7 +2996,7 @@ Prints a table to create associations be $r is an Apache Request ref, $records is an arrayref from &Apache::loncommon::upfile_record_sep, -$d is an array of 2 element arrays (internal name, displayed name) +$d is an array of 2 element arrays (internal name, displayed name,defaultcol) =cut @@ -2723,14 +3011,16 @@ sub csv_print_select_table { ''.&mt('Attribute').''. ''.&mt('Column').''."\n"); foreach (@$d) { - my ($value,$display)=@{ $_ }; + my ($value,$display,$defaultcol)=@{ $_ }; $r->print(''.$display.''); $r->print(''."\n"); $i++; @@ -2771,8 +3061,10 @@ sub csv_samples_select_table { $r->print(''); if (defined($sone{$_})) { $r->print($sone{$_}."
\n"); } @@ -2897,6 +3189,8 @@ If $Max is < any data point, the graph w =item $colors: array ref holding the colors to be used for the data sets when they are plotted. If undefined, default values will be used. +=item $labels: array ref holding the labels to use on the x-axis for the bars. + =item @Values: An array of array references. Each array reference holds data to be plotted in a stacked bar chart. @@ -2912,7 +3206,7 @@ information for the plot. ############################################################ ############################################################ sub DrawBarGraph { - my ($Title,$xlabel,$ylabel,$Max,$colors,@Values)=@_; + my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_; # if (! defined($colors)) { $colors = ['#33ff00', @@ -2955,8 +3249,12 @@ sub DrawBarGraph { } # my @Labels; - for (my $i=0;$i<@{$Values[0]};$i++) { - push (@Labels,$i+1); + if (defined($labels)) { + @Labels = @$labels; + } else { + for (my $i=0;$i<@{$Values[0]};$i++) { + push (@Labels,$i+1); + } } # $Max = 1 if ($Max < 1); @@ -3015,7 +3313,7 @@ plotted in. If undefined, default value =item $Xlabels: Array ref containing the labels to be used for the X-axis. =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 passed to graph.png. @@ -3263,7 +3561,7 @@ sub store_course_settings { my %SaveHash; my %AppHash; while (my ($setting,$type) = each(%$Settings)) { - my $basename = 'env.internal.'.$prefix.'.'.$setting; + my $basename = 'internal.'.$prefix.'.'.$setting; my $envname = 'course.'.$courseid.'.'.$basename; if (exists($ENV{'form.'.$setting})) { # Save this value away @@ -3308,7 +3606,7 @@ sub restore_course_settings { my ($prefix,$Settings) = @_; while (my ($setting,$type) = each(%$Settings)) { next if (exists($ENV{'form.'.$setting})); - my $envname = 'course.'.$courseid.'.env.internal.'.$prefix. + my $envname = 'course.'.$courseid.'.internal.'.$prefix. '.'.$setting; if (exists($ENV{$envname})) { if ($type eq 'scalar') {