--- loncom/interface/lonhtmlcommon.pm 2002/09/17 15:32:46 1.10 +++ loncom/interface/lonhtmlcommon.pm 2007/11/17 01:46:03 1.171 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common html routines # -# $Id: lonhtmlcommon.pm,v 1.10 2002/09/17 15:32:46 matthew Exp $ +# $Id: lonhtmlcommon.pm,v 1.171 2007/11/17 01:46:03 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -55,8 +55,209 @@ html. package Apache::lonhtmlcommon; -use Time::Local; use strict; +use Time::Local; +use Time::HiRes; +use Apache::lonlocal; +use Apache::lonnet; +use LONCAPA; + +############################################## +############################################## + +=pod + +=item authorbombs + +=cut + +############################################## +############################################## + +sub authorbombs { + my $url=shift; + $url=&Apache::lonnet::declutter($url); + my ($udom,$uname)=($url=~m{^($LONCAPA::domain_re)/($LONCAPA::username_re)/}); + 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 ''; +} + +############################################## +############################################## + +sub recent_filename { + my $area=shift; + return 'nohist_recent_'.&escape($area); +} + +sub store_recent { + my ($area,$name,$value,$freeze)=@_; + my $file=&recent_filename($area); + my %recent=&Apache::lonnet::dump($file); + if (scalar(keys(%recent))>20) { +# remove oldest value + my $oldest=time(); + my $delkey=''; + foreach my $item (keys(%recent)) { + my $thistime=(split(/\&/,$recent{$item}))[0]; + if (($thistime ne "always_include") && ($thistime<$oldest)) { + $oldest=$thistime; + $delkey=$item; + } + } + &Apache::lonnet::del($file,[$delkey]); + } +# store new value + my $timestamp; + if ($freeze) { + $timestamp = "always_include"; + } else { + $timestamp = time(); + } + &Apache::lonnet::put($file,{ $name => + $timestamp.'&'.&escape($value) }); +} + +sub remove_recent { + my ($area,$names)=@_; + my $file=&recent_filename($area); + return &Apache::lonnet::del($file,$names); +} + +sub select_recent { + my ($area,$fieldname,$event)=@_; + my %recent=&Apache::lonnet::dump(&recent_filename($area)); + my $return="\n\n"; + return $return; +} + +sub get_recent { + my ($area, $n) = @_; + my %recent=&Apache::lonnet::dump(&recent_filename($area)); + +# Create hash with key as time and recent as value +# Begin filling return_hash with any 'always_include' option + my %time_hash = (); + my %return_hash = (); + foreach my $item (keys %recent) { + my ($thistime,$thisvalue)=(split(/\&/,$recent{$item})); + if ($thistime eq 'always_include') { + $return_hash{$item} = &unescape($thisvalue); + $n--; + } else { + $time_hash{$thistime} = $item; + } + } + +# Sort by decreasing time and return key value pairs + my $idx = 1; + foreach my $item (reverse(sort(keys(%time_hash)))) { + $return_hash{$time_hash{$item}} = + &unescape((split(/\&/,$recent{$time_hash{$item}}))[1]); + if ($n && ($idx++ >= $n)) {last;} + } + + return %return_hash; +} + +sub get_recent_frozen { + my ($area) = @_; + my %recent=&Apache::lonnet::dump(&recent_filename($area)); + +# Create hash with all 'frozen' items + my %return_hash = (); + foreach my $item (keys(%recent)) { + my ($thistime,$thisvalue)=(split(/\&/,$recent{$item})); + if ($thistime eq 'always_include') { + $return_hash{$item} = &unescape($thisvalue); + } + } + return %return_hash; +} + + + +=pod + +=item textbox + +=cut + +############################################## +############################################## +sub textbox { + my ($name,$value,$size,$special) = @_; + $size = 40 if (! defined($size)); + $value = &HTML::Entities::encode($value,'<>&"'); + my $Str = ''; + return $Str; +} + +############################################## +############################################## + +=pod + +=item checkbox + +=cut + +############################################## +############################################## +sub checkbox { + my ($name,$checked,$value) = @_; + my $Str = ' + ENDJS - $result .= " }; + # 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++) { - $result .= " \n"; + } + $hourselector .= " \n"; + my $minuteselector = qq{}; + my $secondselector= qq{}; + my $cal_link; + if (!$nolink) { + $cal_link = qq{}; + } + # + if ($no_hh_mm_ss) { + $result .= &mt('[_1] [_2] [_3] ', + $monthselector,$dayselector,$yearselector); + if (!$nolink) { + $result .= &mt('[_1]Select Date[_2]',$cal_link,''); + } + } else { + $result .= &mt('[_1] [_2] [_3] [_4] [_5]m [_6]s ', + $monthselector,$dayselector,$yearselector, + $hourselector,$minuteselector,$secondselector); + if (!$nolink) { + $result .= &mt('[_1]Select Date[_2]',$cal_link,''); + } + } + $result .= "\n\n"; return $result; } + +sub build_url { + my ($base, $fields)=@_; + my $url; + $url = $base.'?'; + foreach my $key (keys(%$fields)) { + $url.=&escape($key).'='.&escape($$fields{$key}).'&'; + } + $url =~ s/&$//; + return $url; +} + + ############################################## ############################################## +=pod + =item &get_date_from_form +get_date_from_form retrieves the date specified in an &date_setter form. + Inputs: =over 4 @@ -203,43 +527,54 @@ 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 (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 (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 < 32)) { + 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 (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 (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 (defined($env{'form.'.$dname.'_year'})) { + my $tmpyear = $env{'form.'.$dname.'_year'}; if (($tmpyear =~ /^\d+$/) && ($tmpyear > 1900)) { $year = $tmpyear - 1900; } } - if (eval(&timelocal($sec,$min,$hour,$day,$month,$year))) { + 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; @@ -249,365 +584,1308 @@ sub get_date_from_form { ############################################## ############################################## -sub AscendOrderOptions { - my ($order, $page, $formName)=@_; +=pod - my $OpSel1 = ''; - my $OpSel2 = ''; +=item &pjump_javascript_definition() - if($order eq 'Ascending') { - $OpSel1 = ' selected'; - } else { - $OpSel2 = ' selected'; - } +Returns javascript defining the 'pjump' function, which opens up a +parameter setting wizard. - my $Str = ''; - $Str .= ''."\n"; +=cut +############################################## +############################################## +sub pjump_javascript_definition { + my $Str = <{'orderedSequences'})) { - $Str .= '{$page.'Maps'} eq $data->{$sequence.':title'}) { - $Str .= ' selected'; - $selected = 1; - } - $Str .= '>'.$data->{$sequence.':title'}.''."\n"; - } - $Str .= '{'orderedSequences'})) { - if($data->{$sequence.':title'} eq $map || $map eq 'All Maps') { - foreach my $problem (split(':', $data->{$sequence.':problems'})) { - $Str .= '{$page.'ProblemSelect'} eq - $data->{$problem.':title'}) { - $Str .= ' selected'; - $selected = 1; - } - $Str .= '>'.$data->{$problem.':title'}.''."\n"; - } - } +############################################## +############################################## +sub javascript_docopen { + my ($mimetype) = @_; + $mimetype ||= 'text/html'; + # safari does not understand document.open() and loads "text/html" + my $nothing = "''"; + my $user_browser; + my $user_os; + $user_browser = $env{'browser.type'} if (exists($env{'browser.type'})); + $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(); } - $Str .= '{$page.'PartSelect'} eq $part) { - $Str .= ' selected'; - $selected = 1; - } - $Str .= '>'.$part.''."\n"; - } - $Str .= ''."\n"; } - $Str .= '>All Parts'."\n"; $Str .= ''."\n"; - - return $Str; } -sub StudentOptions { - my ($cache, $students, $selectedName, $page, $formName)=@_; +######################################################## +######################################################## - my $Str = ''; - $Str .= '')); + } else { + $prog_state{'inputname'}=$inputname; + + } + if (!$formname) { &r_print($r,''); } + &Update_PrgWin($r,\%prog_state,&mt('Starting')); } - $Str .= '>'."\n"; - my $selected=0; + $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; +} - foreach (@$students) { - $Str .= '{$_.':fullname'}; - $Str .= ''."\n"; +# update progress +sub Update_PrgWin { + 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(); +} - $Str .= 'popwin.close()'."\n"); + } elsif ($$prog_state{'type'} eq 'inline') { + &Update_PrgWin($r,$prog_state,&mt('Done')); } - $Str .= '>No Student Selected'."\n"; + undef(%$prog_state); +} - $Str .= 'print($to_print); + $r->rflush(); + } else { + print($to_print); } - $Str .= '>All Students'."\n"; +} - $Str .= ''."\n"; +# ------------------------------------------------------- Puts directory header - return $Str; +sub crumbs { + my ($uri,$target,$prefix,$form,$size,$noformat,$skiplast)=@_; + if (! defined($size)) { + $size = '+2'; + } + if ($target) { + $target = ' target="'. + &Apache::loncommon::escape_single($target).'"'; + } + my $output=''; + unless ($noformat) { $output.='
'; } + $output.=''.$prefix.'/'; + if ($env{'user.adv'}) { + my $path=$prefix.'/'; + foreach my $dir (split('/',$uri)) { + if (! $dir) { next; } + $path .= $dir; + if ($path eq $uri) { + if ($skiplast) { + $output.=$dir; + last; + } + } else { + $path.='/'; + } + my $href_path = &HTML::Entities::encode($path,'<>&"'); + &Apache::loncommon::inhibit_menu_check(\$href_path); + if ($form) { + my $href = 'javascript:'.$form.".action='".$href_path."';".$form.'.submit();'; + $output.=qq{$dir/}; + } else { + $output.=qq{$dir/}; + } + } + } else { + foreach my $dir (split('/',$uri)) { + if (! $dir) { next; } + $output.=$dir.'/'; + } + } + if ($uri !~ m|/$|) { $output=~s|/$||; } + return $output.''.($noformat?'':'
'); } -sub StatusOptions { - my ($status, $formName)=@_; +# --------------------- A function that generates a window for the spellchecker - my $OpSel1 = ''; - my $OpSel2 = ''; - my $OpSel3 = ''; - - if($status eq 'Any') { $OpSel3 = ' selected'; } - elsif($status eq 'Expired' ) { $OpSel2 = ' selected'; } - else { $OpSel1 = ' selected'; } +sub spellheader { + my $start_page= + &Apache::loncommon::start_page('Speller Suggestions',undef, + {'only_body' => 1, + 'js_ready' => 1, + 'bgcolor' => '#DDDDDD', + 'add_entries' => { + 'onload' => + 'document.forms.spellcheckform.submit()', + } + }); + my $end_page= + &Apache::loncommon::end_page({'js_ready' => 1}); + + my $nothing=&javascript_nothing(); + return (< +// + +ENDCHECK +} - my $Str = ''; - $Str .= ''."\n"; } -sub MultipleSectionSelect { - my ($sections,$selectedSections)=@_; +sub htmlareaheaders { + return if (&htmlareablocked()); + return if (!&htmlareabrowser()); + return (< +ENDHEADERS +} - my $Str = ''; - $Str .= ''."\n"; + return ''.&mt('Disable WYSIWYG Editor').''; +} - return $Str; +sub enablelink { + my @fields=@_; + if (defined($#fields)) { + unless ($#fields>=0) { return ''; } + } + return ''.&mt('Enable WYSIWYG Editor').''; } -sub Title { - my ($pageName)=@_; +# ------------------------------------------------- lang to use in html editor +sub htmlarea_lang { + my $lang='en'; + if (&mt('htmlarea_lang') ne 'htmlarea_lang') { + $lang=&mt('htmlarea_lang'); + } + return $lang; +} - my $Str = ''; +# ----------------------------------------- Script to activate only some fields - $Str .= ''.$pageName.''."\n"; - $Str .= &Apache::loncommon::bodytag($pageName)."\n"; - $Str .= ''."\n"; +sub htmlareaselectactive { + my @fields=@_; + unless (&htmlareabrowser()) { return ''; } + if (&htmlareablocked()) { return '
'.&enablelink(@fields); } + my $output='
". + &disablelink(@fields); + return $output; +} - return $Str; +# --------------------------------------------------------------------- Blocked + +sub htmlareablocked { + unless ($env{'environment.wysiwygeditor'} eq 'on') { return 1; } + return 0; } -=pod +# ---------------------------------------- Browser capable of running HTMLArea? -=item &CreateTableHeadings() +sub htmlareabrowser { + return 1; +} -This function generates the column headings for the chart. +############################################################ +############################################################ -=over 4 +=pod -Inputs: $CacheData, $keyID, $headings, $spacePadding +=item breadcrumbs -$CacheData: pointer to a hash tied to the cached data database +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. -$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 +All inputs can be undef without problems. -$headings: The names of the headings for the student information +Inputs: $component (the large text on the right side of the table), + $component_help + $menulink (boolean, controls whether to include a link to /adm/menu) + $helplink (if 'nohelp' don't include the orange help link) + $css_class (optional name for the class to apply to the table for CSS) +Returns a string containing breadcrumbs for the current page. -$spacePadding: The spaces to go between columns +=item clear_breadcrumbs -Output: $Str +Clears the previously stored breadcrumbs. -$Str: A formatted string of the table column headings. +=item add_breadcrumb -=back +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. If the key 'no_mt' is present the 'title' +and 'text' values won't be sent through &mt() + +returns: nothing =cut -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/; +############################################################ +############################################################ +{ + my @Crumbs; + + sub breadcrumbs { + my ($component,$component_help,$menulink,$helplink,$css_class) = @_; + # + $css_class ||= 'LC_breadcrumbs'; + my $Str = "\n".''; + # + if (defined($component)) { + $Str .= ''; + } + $Str .= '
'; + # + # Make the faq and bug data cascade + my $faq = ''; + my $bug = ''; + my $help=''; + # 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'})); + $help = $_->{'help'} if (exists($_->{'help'})); + my $result = '{'target'}) && $_->{'target'} ne '') { + $result .= 'target="'.$_->{'target'}.'" '; + } + if ($_->{'no_mt'}) { + $result .='title="'.$_->{'title'}.'">'. + $_->{'text'}.''; + } else { + $result .='title="'.&mt($_->{'title'}).'">'. + &mt($_->{'text'}).''; + } + $result; + } @Crumbs + ); + $links .= '->' if ($links ne ''); + if ($last->{'no_mt'}) { + $links .= ''.$last->{'text'}.''; + } else { + $links .= ''.&mt($last->{'text'}).''; + } + # + my $icons = ''; + $faq = $last->{'faq'} if (exists($last->{'faq'})); + $bug = $last->{'bug'} if (exists($last->{'bug'})); + $help = $last->{'help'} if (exists($last->{'help'})); + $component_help=($component_help?$component_help:$help); +# if ($faq ne '') { +# $icons .= &Apache::loncommon::help_open_faq($faq); +# } +# if ($bug ne '') { +# $icons .= &Apache::loncommon::help_open_bug($bug); +# } + if ($faq ne '' || $component_help ne '' || $bug ne '') { + $icons .= &Apache::loncommon::help_open_menu($component, + $component_help, + $faq,$bug); + } + # + $Str .= $links.''. + &mt($component); + if ($icons ne '') { + $Str .= ' '.$icons; + } + $Str .= '
'."\n"; + # + # Return the @Crumbs stack to what we started with + push(@Crumbs,$last); + shift(@Crumbs); + # + return $Str; + } - $Str .= $tempString; + sub clear_breadcrumbs { + undef(@Crumbs); } - return $Str; -} + sub add_breadcrumb { + push (@Crumbs,@_); + } -=pod +} # End of scope for @Crumbs -=item &FormatStudentInformation() +############################################################ +############################################################ -This function produces a formatted string of the student\'s information: -username, domain, section, full name, and PID. +# Nested table routines. +# +# Routines to display form items in a multi-row table with 2 columns. +# Uses nested tables to divide form elements into segments. +# For examples of use see loncom/interface/lonnotify.pm +# +# Can be used in following order: ... +# &start_pick_box() +# row1 +# row2 +# row3 ... etc. +# &submit_row(0 +# &end_pick_box() +# +# where row1, row 2 etc. are chosen from &role_select_row,&course_select_row, +# &status_select_row and &email_default_row +# +# Can also be used in following order: +# +# &start_pick_box() +# &row_title() +# &row_closure() +# &row_title() +# &row_closure() ... etc. +# &submit_row() +# &end_pick_box() +# +# In general a &submit_row() call should proceed the call to &end_pick_box(), +# as this routine adds a button for form submission. +# &submit_row() does not require a &row_closure after it. +# +# &start_pick_box() creates a bounding table with 1-pixel wide black border. +# rows should be placed between calls to &start_pick_box() and &end_pick_box. +# +# &row_title() adds a title in the left column for each segment. +# &row_closure() closes a row with a 1-pixel wide black line. +# +# &role_select_row() provides a select box from which to choose 1 or more roles +# &course_select_row provides ways of picking groups of courses +# radio buttons: all, by category or by picking from a course picker pop-up +# note: by category option is only displayed if a domain has implemented +# selection by year, semester, department, number etc. +# +# &status_select_row() provides a select box from which to choose 1 or more +# access types (current access, prior access, and future access) +# +# &email_default_row() provides text boxes for default e-mail suffixes for +# different authentication types in a domain. +# +# &row_title() and &row_closure() are called internally by the &*_select_row +# routines, but can also be called directly to start and end rows which have +# needs that are not accommodated by the *_select_row() routines. + +sub start_pick_box { + my ($css_class) = @_; + if (defined($css_class)) { + $css_class = 'class="'.$css_class.'"'; + } else { + $css_class= 'class="LC_pick_box"'; + } + my $output = <<"END"; + +END + return $output; +} -=over 4 +sub end_pick_box { + my $output = <<"END"; +
+END + return $output; +} -Input: $cache, $name, $keyID, $spacePadding +sub row_title { + my ($title,$css_title_class,$css_value_class) = @_; + $css_title_class ||= 'LC_pick_box_title'; + $css_title_class = 'class="'.$css_title_class.'"'; + + $css_value_class ||= 'LC_pick_box_value'; + $css_value_class = 'class="'.$css_value_class.'"'; + + my $output = <<"ENDONE"; + + + $title: + + +ENDONE + return $output; +} -$cache: This is a pointer to a hash that is tied to the cached data +sub row_closure { + my ($no_separator) =@_; + my $output = <<"ENDTWO"; + + +ENDTWO + if (!$no_separator) { + $output .= <<"ENDTWO"; + + + + +ENDTWO + } + return $output; +} -$name: The name and domain of the current student in name:domain format +sub role_select_row { + my ($roles,$title,$css_class,$show_separate_custom,$cdom,$cnum) = @_; + my $output; + if (defined($title)) { + $output = &row_title($title,$css_class); + } + $output .= qq| + \n|; + if (defined($title)) { + $output .= &row_closure(); + } + return $output; +} -$keyID: A pointer to an array holding the names used to +sub course_select_row { + my ($title,$formname,$totcodes,$codetitles,$idlist,$idlist_titles, + $css_class) = @_; + my $output = &row_title($title,$css_class); + $output .= &course_selection($formname,$totcodes,$codetitles,$idlist,$idlist_titles); + $output .= &row_closure(); + return $output; +} -remove data from the hash. They represent the name of the data to be removed. +sub course_selection { + my ($formname,$totcodes,$codetitles,$idlist,$idlist_titles) = @_; + my $output = qq| + + |; + my $courseform=''.&Apache::loncommon::selectcourse_link + ($formname,'pickcourse','pickdomain','coursedesc','',1).''; + $output .= ''.&mt('All courses').'
'; + if ($totcodes > 0) { + my $numtitles = @$codetitles; + if ($numtitles > 0) { + $output .= ''.&mt('Pick courses by category:').'
'; + $output .= ''; + for (my $i=1; $i<$numtitles; $i++) { + $output .= ''; + } + $output .= '
'.$$codetitles[0].'
'."\n". + '
'.$$codetitles[$i].'
'."\n". + ''."\n". + '

'; + } + } + $output .= ''.&mt('Pick specific course(s):').' '.$courseform.'  selected.
'."\n"; + return $output; +} -$spacePadding: Extra spaces that represent the space between columns +sub status_select_row { + my ($types,$title,$css_class) = @_; + my $output; + if (defined($title)) { + $output = &row_title($title,$css_class,'LC_pick_box_select'); + } + $output .= qq| + \n|; + if (defined($title)) { + $output .= &row_closure(); + } + return $output; +} -Output: $Str +sub email_default_row { + my ($authtypes,$title,$descrip,$css_class) = @_; + my $output = &row_title($title,$css_class); + $output .= $descrip. + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''.&mt('Authentication Method').''. + ''.&mt('Username -> e-mail conversion').''."\n". + &Apache::loncommon::end_data_table_header_row(); + my $rownum = 0; + foreach my $auth (sort(keys(%{$authtypes}))) { + my ($userentry,$size); + if ($auth =~ /^krb/) { + $userentry = ''; + $size = 25; + } else { + $userentry = 'username@'; + $size = 15; + } + $output .= &Apache::loncommon::start_data_table_row(). + ' '.$$authtypes{$auth}.''. + ''.$userentry. + ''. + &Apache::loncommon::end_data_table_row(); + } + $output .= &Apache::loncommon::end_data_table(); + $output .= &row_closure(); + return $output; +} -$Str: Formatted string. -=back +sub submit_row { + my ($title,$cmd,$submit_text,$css_class) = @_; + my $output = &row_title($title,$css_class,'LC_pick_box_submit'); + $output .= qq| +
+ +   +

+ \n|; + return $output; +} + +sub course_custom_roles { + my ($cdom,$cnum) = @_; + my %returnhash=(); + my %coursepersonnel=&Apache::lonnet::dump('nohist_userroles',$cdom,$cnum); + foreach my $person (sort(keys(%coursepersonnel))) { + my ($role) = ($person =~ /^([^:]+):/); + my ($end,$start) = split(/:/,$coursepersonnel{$person}); + if ($end == -1 && $start == -1) { + next; + } + if ($role =~ m|^cr/[^/]+/[^/]+/[^/]|) { + $returnhash{$role} ++; + } + } + return %returnhash; +} -=cut -sub FormatStudentInformation { - my ($data,$name,$keyID,$displayString,$format)=@_; - my $Str=''; - my $currentColumn; +############################################## +############################################## + +# echo_form_input +# +# Generates html markup to add form elements from the referrer page +# as hidden form elements (values encoded) in the new page. +# +# Intended to support two types of use +# (a) to allow backing up to earlier pages in a multi-page +# form submission process using a breadcrumb trail. +# +# (b) to allow the current page to be reloaded with form elements +# set on previous page to remain unchanged. An example would +# be where the a page containing a dynamically-built table of data is +# is to be redisplayed, with only the sort order of the data changed. +# +# Inputs: +# 1. Reference to array of form elements in the submitted form on +# the referrer page which are to be excluded from the echoed elements. +# +# 2. Reference to array of regular expressions, which if matched in the +# name of the form element n the referrer page will be omitted from echo. +# +# Outputs: A scalar containing the html markup for the echoed form +# elements (all as hidden elements, with values encoded). - for(my $index=0; $index<(scalar @$keyID); $index++) { - $currentColumn=$data->{$name.':'.$keyID->[$index]}; - if($format eq 'preformatted') { - my @dataLength=split(//,$currentColumn); - my $length=scalar @dataLength; - $currentColumn.= (' 'x - ($data->{$keyID->[$index].':columnWidth'}-$length)); +sub echo_form_input { + my ($excluded,$regexps) = @_; + my $output = ''; + foreach my $key (keys(%env)) { + if ($key =~ /^form\.(.+)$/) { + my $name = $1; + my $match = 0; + if ((!@{$excluded}) || (!grep/^$name$/,@{$excluded})) { + if (defined($regexps)) { + if (@{$regexps} > 0) { + foreach my $regexp (@{$regexps}) { + if ($name =~ /\Q$regexp\E/) { + $match = 1; + last; + } + } + } + } + if (!$match) { + if (ref($env{$key})) { + foreach my $value (@{$env{$key}}) { + $value = &HTML::Entities::encode($value,'<>&"'); + $output .= ''."\n"; + } + } else { + my $value = &HTML::Entities::encode($env{$key},'<>&"'); + $output .= ''."\n"; + } + } + } } + } + return $output; +} - my $tempString = $displayString; - $tempString =~ s/DISPLAYDATA/$currentColumn/; +############################################## +############################################## + +# set_form_elements +# +# Generates javascript to set form elements to values based on +# corresponding values for the same form elements when the page was +# previously submitted. +# +# Last submission values are read from hidden form elements in referring +# page which have the same name, i.e., generated by &echo_form_input(). +# +# Intended to be called by onload event. +# +# Inputs: +# (a) Reference to hash of echoed form elements to be set. +# +# In the hash, keys are the form element names, and the values are the +# element type (selectbox, radio, checkbox or text -for textbox, textarea or +# hidden). +# +# (b) Optional reference to hash of stored elements to be set. +# +# If the page being displayed is a page which permits modification of +# previously stored data, e.g., the first page in a multi-page submission, +# then if stored is supplied, form elements will be set to the last stored +# values. If user supplied values are also available for the same elements +# these will replace the stored values. +# +# Output: +# +# javascript function - set_form_elements() which sets form elements, +# expects an argument: formname - the name of the form according to +# the DOM, e.g., document.compose + +sub set_form_elements { + my ($elements,$stored) = @_; + my %values; + my $output .= 'function setFormElements(courseForm) { +'; + if (defined($stored)) { + foreach my $name (keys(%{$stored})) { + if (exists($$elements{$name})) { + if (ref($$stored{$name}) eq 'ARRAY') { + $values{$name} = $$stored{$name}; + } else { + @{$values{$name}} = ($$stored{$name}); + } + } + } + } - $Str .= $tempString; + foreach my $key (keys(%env)) { + if ($key =~ /^form\.(.+)$/) { + my $name = $1; + if (exists($$elements{$name})) { + @{$values{$name}} = &Apache::loncommon::get_env_multiple($key); + } + } } - return $Str; + foreach my $name (keys(%values)) { + for (my $i=0; $i<@{$values{$name}}; $i++) { + $values{$name}[$i] = &HTML::Entities::decode($values{$name}[$i],'<>&"'); + $values{$name}[$i] =~ s/([\r\n\f]+)/\\n/g; + $values{$name}[$i] =~ s/"/\\"/g; + } + if ($$elements{$name} eq 'text') { + my $numvalues = @{$values{$name}}; + if ($numvalues > 1) { + my $valuestring = join('","',@{$values{$name}}); + $output .= qq| + var textvalues = new Array ("$valuestring"); + var total = courseForm.elements['$name'].length; + if (total > $numvalues) { + total = $numvalues; + } + for (var i=0; iprint('"); - - $r->rflush(); -} +############################################## +############################################## -# update progress -sub Update_PrgWin { - my ($displayString,$r)=@_; - $r->print(''); - $r->rflush(); +# javascript_valid_email +# +# Generates javascript to validate an e-mail address. +# Returns a javascript function which accetps a form field as argumnent, and +# returns false if field.value does not satisfy two regular expression matches +# for a valid e-mail address. Backwards compatible with old browsers without +# support for javascript RegExp (just checks for @ in field.value in this case). + +sub javascript_valid_email { + my $scripttag .= <<'END'; +function validmail(field) { + var str = field.value; + if (window.RegExp) { + var reg1str = "(@.*@)|(\\.\\.)|(@\\.)|(\\.@)|(^\\.)"; + var reg2str = "^.+\\@(\\[?)[a-zA-Z0-9\\-\\.]+\\.([a-zA-Z]{2,3}|[0-9]{1,3})(\\]?)$"; //" + var reg1 = new RegExp(reg1str); + var reg2 = new RegExp(reg2str); + if (!reg1.test(str) && reg2.test(str)) { + return true; + } + return false; + } + else + { + if(str.indexOf("@") >= 0) { + return true; + } + return false; + } } - -# close Progress Line -sub Close_PrgWin { - my ($r)=@_; - $r->print(''."\n"); - $r->rflush(); +END + return $scripttag; } 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.