--- loncom/interface/lonhtmlcommon.pm 2002/08/21 17:18:08 1.8 +++ loncom/interface/lonhtmlcommon.pm 2004/11/23 14:53:05 1.98 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common html routines # -# $Id: lonhtmlcommon.pm,v 1.8 2002/08/21 17:18:08 www Exp $ +# $Id: lonhtmlcommon.pm,v 1.98 2004/11/23 14:53:05 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,109 +25,588 @@ # # http://www.lon-capa.org/ # +###################################################################### +###################################################################### + +=pod + +=head1 NAME + +Apache::lonhtmlcommon - routines to do common html things + +=head1 SYNOPSIS + +Referenced by other mod_perl Apache modules. + +=head1 INTRODUCTION + +lonhtmlcommon is a collection of subroutines used to present information +in a consistent html format, or provide other functionality related to +html. + +=head2 General Subroutines + +=over 4 + +=cut + +###################################################################### +###################################################################### package Apache::lonhtmlcommon; +use Time::Local; +use Time::HiRes; +use Apache::lonlocal; use strict; -sub AscendOrderOptions { - my ($order, $page, $formName)=@_; +############################################## +############################################## - my $OpSel1 = ''; - my $OpSel2 = ''; +=pod - if($order eq 'Ascending') { - $OpSel1 = ' selected'; - } else { - $OpSel2 = ' selected'; +=item authorbombs + +=cut + +############################################## +############################################## + +sub authorbombs { + my $url=shift; + $url=&Apache::lonnet::declutter($url); + my ($udom,$uname)=($url=~/^(\w+)\/(\w+)\//); + my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom); + foreach (keys %bombs) { + if ($_=~/^$udom\/$uname\//) { + return ''. + &Apache::loncommon::help_open_topic('About_Bombs'); + } } + return ''; +} - my $Str = ''; - $Str .= ''."\n"; +# store new value + &Apache::lonnet::put($file,{ $name => + time.'&'.&Apache::lonnet::escape($value) }); +} - return $Str; +sub remove_recent { + my ($area,$names)=@_; + my $file=&recent_filename($area); + return &Apache::lonnet::del($file,$names); } -sub MapOptions { - my ($data, $page, $formName)=@_; - my $Str = ''; - $Str .= '\n"; + return $return; +} - my $selected = 0; - foreach my $sequence (split(':',$data->{'orderedSequences'})) { - $Str .= '{$page.'Maps'} eq $data->{$sequence.':title'}) { - $Str .= ' selected'; - $selected = 1; - } - $Str .= '>'.$data->{$sequence.':title'}.''."\n"; - } - $Str .= '= $n)) {last;} + } + return %return_hash; +} + + + +=pod + +=item textbox + +=cut + +############################################## +############################################## +sub textbox { + my ($name,$value,$size,$special) = @_; + $size = 40 if (! defined($size)); + my $Str = ''; return $Str; } -sub StudentOptions { - my ($cache, $students, $selectedName, $page, $formName)=@_; +############################################## +############################################## - my $Str = ''; - $Str .= '}; + # Month + my @Months = qw/January February March April May June + July August September October November December/; + # Pad @Months with a bogus value to make indexing easier + unshift(@Months,'If you can read this an error occurred'); + if ($includeempty) { $monthselector.=""; } + for(my $m = 1;$m <=$#Months;$m++) { + $monthselector .= qq{ '."\n"; + $result .= "\n\n"; + return $result; +} - $Str .= ''."\n"; +############################################## +############################################## + +=pod + +=item &get_date_from_form + +get_date_from_form retrieves the date specified in an &date_setter form. + +Inputs: + +=over 4 + +=item $dname + +The name passed to &datesetter, which prefixes the form elements. + +=item $defaulttime + +The unix time to use as the default in case of poor inputs. + +=back + +Returns: Unix time represented in the form. + +=cut +############################################## +############################################## +sub get_date_from_form { + my ($dname) = @_; + my ($sec,$min,$hour,$day,$month,$year); + # + if (defined($ENV{'form.'.$dname.'_second'})) { + my $tmpsec = $ENV{'form.'.$dname.'_second'}; + if (($tmpsec =~ /^\d+$/) && ($tmpsec >= 0) && ($tmpsec < 60)) { + $sec = $tmpsec; + } + if (!defined($tmpsec) || $tmpsec eq '') { $sec = 0; } + } else { + $sec = 0; + } + if (defined($ENV{'form.'.$dname.'_minute'})) { + my $tmpmin = $ENV{'form.'.$dname.'_minute'}; + if (($tmpmin =~ /^\d+$/) && ($tmpmin >= 0) && ($tmpmin < 60)) { + $min = $tmpmin; + } + if (!defined($tmpmin) || $tmpmin eq '') { $min = 0; } + } else { + $min = 0; + } + if (defined($ENV{'form.'.$dname.'_hour'})) { + my $tmphour = $ENV{'form.'.$dname.'_hour'}; + if (($tmphour =~ /^\d+$/) && ($tmphour >= 0) && ($tmphour < 24)) { + $hour = $tmphour; + } + } else { + $hour = 0; + } + if (defined($ENV{'form.'.$dname.'_day'})) { + my $tmpday = $ENV{'form.'.$dname.'_day'}; + if (($tmpday =~ /^\d+$/) && ($tmpday > 0) && ($tmpday < 32)) { + $day = $tmpday; + } + } + if (defined($ENV{'form.'.$dname.'_month'})) { + my $tmpmonth = $ENV{'form.'.$dname.'_month'}; + if (($tmpmonth =~ /^\d+$/) && ($tmpmonth > 0) && ($tmpmonth < 13)) { + $month = $tmpmonth - 1; + } + } + if (defined($ENV{'form.'.$dname.'_year'})) { + my $tmpyear = $ENV{'form.'.$dname.'_year'}; + if (($tmpyear =~ /^\d+$/) && ($tmpyear > 1900)) { + $year = $tmpyear - 1900; + } + } + if (($year<70) || ($year>137)) { return undef; } + if (defined($sec) && defined($min) && defined($hour) && + defined($day) && defined($month) && defined($year) && + eval(&timelocal($sec,$min,$hour,$day,$month,$year))) { + return &timelocal($sec,$min,$hour,$day,$month,$year); + } else { + return undef; + } +} + +############################################## +############################################## + +=pod + +=item &pjump_javascript_definition() + +Returns javascript defining the 'pjump' function, which opens up a +parameter setting wizard. + +=cut + +############################################## +############################################## +sub pjump_javascript_definition { + my $Str = <Active'."\n"; - $Str .= 'Expired'."\n"; - $Str .= 'Any'."\n"; + $Str .= ''."\n"; + $Str .= ''."\n"; + $Str .= ''."\n"; $Str .= ''."\n"; } -sub MultipleSectionSelect { - my ($sections,$selectedSections)=@_; - - my $Str = ''; - $Str .= ''."\n"; +######################################################## +######################################################## - return $Str; -} +=pod -sub Title { - my ($pageName)=@_; +=item Progess Window Handling Routines - my $Str = ''; +These routines handle the creation, update, increment, and closure of +progress windows. The progress window reports to the user the number +of items completed and an estimate of the time required to complete the rest. - $Str .= ''.$pageName.''."\n"; - $Str .= &Apache::loncommon::bodytag($pageName)."\n"; - $Str .= ''."\n"; +=over 4 - return $Str; -} -=pod +=item &Create_PrgWin -=item &CreateTableHeadings() +Writes javascript to the client to open a progress window and returns a +data structure used for bookkeeping. -This function generates the column headings for the chart. +Inputs =over 4 -Inputs: $CacheData, $keyID, $headings, $spacePadding +=item $r Apache request + +=item $title The title of the progress window -$CacheData: pointer to a hash tied to the cached data database +=item $heading A description (usually 1 line) of the process being initiated. -$keyID: a pointer to an array containing the names of the data -held in a column and is used as part of a key into $CacheData +=item $number_to_do The total number of items being processed. -$headings: The names of the headings for the student information +=item $type Either 'popup' or 'inline' (popup is assumed if nothing is + specified) -$spacePadding: The spaces to go between columns +=item $width Specify the width in charaters of the input field. -Output: $Str +=item $formname Only useful in the inline case, if a form already exists, this needs to be used and specfiy the name of the form, otherwise the Progress line will be created in a new form of it's own -$Str: A formatted string of the table column headings. +=item $inputname Only useful in the inline case, if a form and an input of type text exists, use this to specify the name of the input field =back -=cut +Returns a hash containing the progress state data structure. -sub CreateHeadings { - my ($data,$keyID,$headings,$displayString,$format)=@_; - my $Str=''; - my $formatting = ''; - - for(my $index=0; $index<(scalar @$headings); $index++) { - my $currentHeading=$headings->[$index]; - if($format eq 'preformatted') { - my @dataLength=split(//,$currentHeading); - my $length=scalar @dataLength; - $formatting = (' 'x - ($data->{$keyID->[$index].':columnWidth'}-$length)); - } - my $linkdata=$keyID->[$index]; - - my $tempString = $displayString; - $tempString =~ s/LINKDATA/$linkdata/; - $tempString =~ s/DISPLAYDATA/$currentHeading/; - $tempString =~ s/FORMATTING/$formatting/; - $Str .= $tempString; - } +=item &Update_PrgWin - return $Str; -} +Updates the text in the progress indicator. Does not increment the count. +See &Increment_PrgWin. -=pod +Inputs: -=item &FormatStudentInformation() +=over 4 -This function produces a formatted string of the student's information: -username, domain, section, full name, and PID. +=item $r Apache request -=over 4 +=item $prog_state Pointer to the data structure returned by &Create_PrgWin -Input: $cache, $name, $keyID, $spacePadding +=item $displaystring The string to write to the status indicator -$cache: This is a pointer to a hash that is tied to the cached data +=back -$name: The name and domain of the current student in name:domain format +Returns: none -$keyID: A pointer to an array holding the names used to -remove data from the hash. They represent the name of the data to be removed. +=item Increment_PrgWin -$spacePadding: Extra spaces that represent the space between columns +Increment the count of items completed for the progress window by 1. -Output: $Str +Inputs: + +=over 4 -$Str: Formatted string. +=item $r Apache request + +=item $prog_state Pointer to the data structure returned by Create_PrgWin + +=item $extraInfo A description of the items being iterated over. Typically +'student'. =back -=cut +Returns: none -sub FormatStudentInformation { - my ($data,$name,$keyID,$displayString,$format)=@_; - my $Str=''; - my $currentColumn; - for(my $index=0; $index<(scalar @$keyID); $index++) { - $currentColumn=$data->{$name.':'.$keyID->[$index]}; +=item Close_PrgWin - if($format eq 'preformatted') { - my @dataLength=split(//,$currentColumn); - my $length=scalar @dataLength; - $currentColumn.= (' 'x - ($data->{$keyID->[$index].':columnWidth'}-$length)); - } +Closes the progress window. - my $tempString = $displayString; - $tempString =~ s/DISPLAYDATA/$currentColumn/; +Inputs: - $Str .= $tempString; - } +=over 4 - return $Str; +=item $r Apache request + +=item $prog_state Pointer to the data structure returned by Create_PrgWin + +=back + +Returns: none + +=back + +=cut + +######################################################## +######################################################## + +my $uniq=0; +sub get_uniq_name { + $uniq++; + return 'uniquename'.$uniq; } # Create progress sub Create_PrgWin { - my ($r, $title, $heading)=@_; - $r->print('"); + "popwin.document.close();}". + "\nwindow.setTimeout(openpopwin,0)"); + $prog_state{'formname'}='popremain'; + $prog_state{'inputname'}="remaining"; + } elsif ($type eq 'inline') { + $prog_state{'window'}='window'; + if (!$formname) { + $prog_state{'formname'}=&get_uniq_name(); + &r_print($r,'
'); + } else { + $prog_state{'formname'}=$formname; + } + if (!$inputname) { + $prog_state{'inputname'}=&get_uniq_name(); + &r_print($r,$heading.' '); + } else { + $prog_state{'inputname'}=$inputname; + + } + if (!$formname) { &r_print($r,'
'); } + &Update_PrgWin($r,\%prog_state,&mt('Starting')); + } - $r->rflush(); + $prog_state{'done'}=0; + $prog_state{'firststart'}=&Time::HiRes::time(); + $prog_state{'laststart'}=&Time::HiRes::time(); + $prog_state{'max'}=$number_to_do; + + return %prog_state; } # update progress sub Update_PrgWin { - my ($displayString,$r)=@_; - $r->print(''); - $r->rflush(); + my ($r,$prog_state,$displayString)=@_; + &r_print($r,''); + $$prog_state{'laststart'}=&Time::HiRes::time(); +} + +# increment progress state +sub Increment_PrgWin { + my ($r,$prog_state,$extraInfo)=@_; + $$prog_state{'done'}++; + my $time_est= (&Time::HiRes::time() - $$prog_state{'firststart'})/ + $$prog_state{'done'} * + ($$prog_state{'max'}-$$prog_state{'done'}); + $time_est = int($time_est); + # + my $min = int($time_est/60); + my $sec = $time_est % 60; + # + my $str; + if ($min == 0 && $sec > 1) { + $str = '[_2] seconds'; + } elsif ($min == 1 && $sec > 1) { + $str = '1 minute [_2] seconds'; + } elsif ($min == 1 && $sec < 2) { + $str = '1 minute'; + } elsif ($min < 10 && $sec > 1) { + $str = '[_1] minutes, [_2] seconds'; + } elsif ($min >= 10 || $sec < 2) { + $str = '[_1] minutes'; + } + $time_est = &mt($str,$min,$sec); + # + my $lasttime = &Time::HiRes::time()-$$prog_state{'laststart'}; + if ($lasttime > 9) { + $lasttime = int($lasttime); + } elsif ($lasttime < 0.01) { + $lasttime = 0; + } else { + $lasttime = sprintf("%3.2f",$lasttime); + } + if ($lasttime == 1) { + $lasttime = '('.$lasttime.' '.&mt('second for').' '.$extraInfo.')'; + } else { + $lasttime = '('.$lasttime.' '.&mt('seconds for').' '.$extraInfo.')'; + } + # + my $user_browser = $ENV{'browser.type'} if (exists($ENV{'browser.type'})); + my $user_os = $ENV{'browser.os'} if (exists($ENV{'browser.os'})); + if (! defined($user_browser) || ! defined($user_os)) { + (undef,$user_browser,undef,undef,undef,$user_os) = + &Apache::loncommon::decode_user_agent(); + } + if ($user_browser eq 'explorer' && $user_os =~ 'mac') { + $lasttime = ''; + } + &r_print($r,''); + $$prog_state{'laststart'}=&Time::HiRes::time(); } # close Progress Line sub Close_PrgWin { - my ($r)=@_; - $r->print(''."\n"); - $r->rflush(); + my ($r,$prog_state)=@_; + if ($$prog_state{'type'} eq 'popup') { + &r_print($r,''."\n"); + } elsif ($$prog_state{'type'} eq 'inline') { + &Update_PrgWin($r,$prog_state,&mt('Done')); + } + undef(%$prog_state); } +sub r_print { + my ($r,$to_print)=@_; + if ($r) { + $r->print($to_print); + $r->rflush(); + } else { + print($to_print); + } +} + +# ------------------------------------------------------- Puts directory header + +sub crumbs { + my ($uri,$target,$prefix,$form,$size,$noformat)=@_; + if (! defined($size)) { + $size = '+2'; + } + my $output=''; + unless ($noformat) { $output.='
'; } + $output.=''.$prefix.'/'; + if ($ENV{'user.adv'}) { + my $path=$prefix.'/'; + foreach (split('/',$uri)) { + unless ($_) { next; } + $path.=$_; + unless ($path eq $uri) { $path.='/'; } + my $escaped_linkpath = &Apache::loncommon::escape_single($path); + if ($form) { + $escaped_linkpath="javascript:$form.action='". + &Apache::loncommon::escape_single($path). + "';$form.submit();"; + } + my $escaped_target = &Apache::loncommon::escape_single($target); + $output.=''.$_.'/'; + } + } else { + $output.=$uri; + } + unless ($uri=~/\/$/) { $output=~s/\/$//; } + return $output.''.($noformat?'':'
'); +} + +# --------------------- A function that generates a window for the spellchecker + +sub spellheader { + my $nothing = &javascript_nothing(); + return (< +// + +ENDCHECK +} + +# ---------------------------------- Generate link to spell checker for a field + +sub spelllink { + my ($form,$field)=@_; + my $linktext=&mt('Check Spelling'); + return (<$linktext +ENDLINK +} + +# ------------------------------------------------- Output headers for HTMLArea + +sub htmlareaheaders { + if (&htmlareablocked()) { return ''; } + unless (&htmlareabrowser()) { return ''; } + my $lang='en'; + if (&mt('htmlarea_lang') ne 'htmlarea_lang') { + $lang=&mt('htmlarea_lang'); + } + return (< +_editor_url='/htmlarea/'; +_editor_lang='$lang'; + + +ENDHEADERS +} + +# ------------------------------------------------- Activate additional buttons + +sub htmlareaaddbuttons { + if (&htmlareablocked()) { return ''; } + unless (&htmlareabrowser()) { return ''; } + return (<\$','\$ '); + } + ); + config.registerButton('ed_math_eqn','LaTeX Equation', + '/htmlarea/images/ed_math_eqn.gif',false, + function(editor,id) { + editor.surroundHTML( + ' \\n
\\\\[','\\\\]
\\n '); + } + ); + config.toolbar.push(['ed_math','ed_math_eqn']); +ENDADDBUTTON +} + +# ----------------------------------------------------------------- Preferences + +sub disablelink { + my @fields=@_; + if (defined($#fields)) { + unless ($#fields>=0) { return ''; } + } + return ''.&mt('Disable WYSIWYG Editor').''; +} + +sub enablelink { + my @fields=@_; + if (defined($#fields)) { + unless ($#fields>=0) { return ''; } + } + return ''.&mt('Enable WYSIWYG Editor').''; +} + +# ----------------------------------------- Script to activate only some fields + +sub htmlareaselectactive { + my @fields=@_; + unless (&htmlareabrowser()) { return ''; } + if (&htmlareablocked()) { return '
'.&enablelink(@fields); } + my $output='
". + &disablelink(@fields); + return $output; +} + +# --------------------------------------------------------------------- Blocked + +sub htmlareablocked { + unless ($ENV{'environment.wysiwygeditor'} eq 'on') { return 1; } + return 0; +} + +# ---------------------------------------- Browser capable of running HTMLArea? + +sub htmlareabrowser { + return 1; +} + +############################################################ +############################################################ + +=pod + +=item breadcrumbs + +Compiles the previously registered breadcrumbs into an series of links. +FAQ and BUG links will be placed on the left side of the table if they +are defined for the last registered breadcrumb. +Additionally supports a 'component', which will be displayed on the +right side of the table (without a link). +A link to help for the component will be included if one is specified. + +All inputs can be undef without problems. + +Inputs: $color (the background color of the table returned), + $component (the large text on the right side of the table), + $component_help + $function (role to get colors from) + $domain (domian of role) + $menulink (boolean, controls whether to include a link to /adm/menu) + +Returns a string containing breadcrumbs for the current page. + +=item clear_breadcrumbs + +Clears the previously stored breadcrumbs. + +=item add_breadcrumb + +Pushes a breadcrumb on the stack of crumbs. + +input: $breadcrumb, a hash reference. The keys 'href','title', and 'text' +are required. If present the keys 'faq' and 'bug' will be used to provide +links to the FAQ and bug sites. + +returns: nothing + +=cut + +############################################################ +############################################################ +{ + my @Crumbs; + + sub breadcrumbs { + my ($color,$component,$component_help,$function,$domain,$menulink, + $helplink) = @_; + if (! defined($color)) { + if (! defined($function)) { + $function = &Apache::loncommon::get_users_function(); + } + $color = &Apache::loncommon::designparm($function.'.tabbg', + $domain); + } + # + my $Str = "\n". + ''. + ''; + # + if (defined($component)) { + $Str .= ''; + } + $Str .= '
'. + ''; + # + # Make the faq and bug data cascade + my $faq = ''; + my $bug = ''; + # The last breadcrumb does not have a link, so handle it separately. + my $last = pop(@Crumbs); + # + # The first one should be the course or a menu link + if (!defined($menulink)) { $menulink=1; } + if ($menulink) { + my $description = 'Menu'; + if (exists($ENV{'request.course.id'}) && + $ENV{'request.course.id'} ne '') { + $description = + $ENV{'course.'.$ENV{'request.course.id'}.'.description'}; + } + unshift(@Crumbs,{ + href =>'/adm/menu', + title =>'Go to main menu', + target =>'_top', + text =>$description, + }); + } + my $links .= + join('->', + map { + $faq = $_->{'faq'} if (exists($_->{'faq'})); + $bug = $_->{'bug'} if (exists($_->{'bug'})); + my $result = '{'target'}) && $_->{'target'} ne '') { + $result .= 'target="'.$_->{'target'}.'" '; + } + $result .='title="'.&mt($_->{'title'}).'">'. + &mt($_->{'text'}).''; + $result; + } @Crumbs + ); + $links .= '->' if ($links ne ''); + $links .= ''.&mt($last->{'text'}).''; + # + my $icons = ''; + $faq = $last->{'faq'} if (exists($last->{'faq'})); + $bug = $last->{'bug'} if (exists($last->{'bug'})); +# if ($faq ne '') { +# $icons .= &Apache::loncommon::help_open_faq($faq); +# } +# if ($bug ne '') { +# $icons .= &Apache::loncommon::help_open_bug($bug); +# } + if ($helplink ne 'nohelp') { + $icons .= &Apache::loncommon::help_open_menu($color,$component,$component_help,$function,$faq,$bug); + } + if ($icons ne '') { + $Str .= $icons.' '; + } + # + $Str .= $links.''. + ''.&mt($component).'
'."\n"; + # + # Return the @Crumbs stack to what we started with + push(@Crumbs,$last); + shift(@Crumbs); + # + return $Str; + } + + sub clear_breadcrumbs { + undef(@Crumbs); + } + + sub add_breadcrumb { + push (@Crumbs,@_); + } + +} # End of scope for @Crumbs + +############################################################ +############################################################ + + 1; + __END__ 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.