tag
=item * $hashref, a reference to a hash containing the data for the menus.
=back
Below is an example of such a hash. Only the 'text', 'default', and
'select2' keys must appear as stated. keys(%menu) are the possible
values for the first select menu. The text that coincides with the
first menu value is given in $menu{$choice1}->{'text'}. The values
and text for the second menu are given in the hash pointed to by
$menu{$choice1}->{'select2'}.
my %menu = ( A1 => { text =>"Choice A1" ,
default => "B3",
select2 => {
B1 => "Choice B1",
B2 => "Choice B2",
B3 => "Choice B3",
B4 => "Choice B4"
}
},
A2 => { text =>"Choice A2" ,
default => "C2",
select2 => {
C1 => "Choice C1",
C2 => "Choice C2",
C3 => "Choice C3"
}
},
A3 => { text =>"Choice A3" ,
default => "D6",
select2 => {
D1 => "Choice D1",
D2 => "Choice D2",
D3 => "Choice D3",
D4 => "Choice D4",
D5 => "Choice D5",
D6 => "Choice D6",
D7 => "Choice D7"
}
}
);
=cut
sub linked_select_forms {
my ($formname,
$middletext,
$firstdefault,
$firstselectname,
$secondselectname,
$hashref
) = @_;
my $second = "document.$formname.$secondselectname";
my $first = "document.$formname.$firstselectname";
# output the javascript to do the changing
my $result = '';
$result.="
END
# output the initial values for the selection lists
$result .= "\n";
foreach my $value (sort(keys(%$hashref))) {
$result.=" ".&mt($hashref->{$value}->{'text'})." \n";
}
$result .= " \n";
my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
$result .= $middletext;
$result .= "\n";
my $seconddefault = $hashref->{$firstdefault}->{'default'};
foreach my $value (sort(keys(%select2))) {
$result.=" ".&mt($select2{$value})." \n";
}
$result .= " \n";
# return $debug;
return $result;
} # end of sub linked_select_forms {
=pod
=item * help_open_topic($topic, $text, $stayOnPage, $width, $height)
Returns a string corresponding to an HTML link to the given help
$topic, where $topic corresponds to the name of a .tex file in
/home/httpd/html/adm/help/tex, with underscores replaced by
spaces.
$text will optionally be linked to the same topic, allowing you to
link text in addition to the graphic. If you do not want to link
text, but wish to specify one of the later parameters, pass an
empty string.
$stayOnPage is a value that will be interpreted as a boolean. If true,
the link will not open a new window. If false, the link will open
a new window using Javascript. (Default is false.)
$width and $height are optional numerical parameters that will
override the width and height of the popped up window, which may
be useful for certain help topics with big pictures included.
=cut
sub help_open_topic {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);
if ($env{'browser.interface'} eq 'textual') {
$stayOnPage=1;
}
$width = 350 if (not defined $width);
$height = 400 if (not defined $height);
my $filename = $topic;
$filename =~ s/ /_/g;
my $template = "";
my $link;
$topic=~s/\W/\_/g;
if (!$stayOnPage) {
$link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
} else {
$link = "/adm/help/${filename}.hlp";
}
# Add the text
if ($text ne "") {
$template .=
"".
"$text ";
}
# Add the graphic
my $title = &mt('Online Help');
my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
$template .= <<"ENDTEMPLATE";
ENDTEMPLATE
if ($text ne '') { $template.='
' };
return $template;
}
# This is a quicky function for Latex cheatsheet editing, since it
# appears in at least four places
sub helpLatexCheatsheet {
my $other = shift;
my $addOther = '';
if ($other) {
$addOther = Apache::loncommon::help_open_topic($other, shift,
undef, undef, 600) .
'';
}
return ''.
$addOther .
&Apache::loncommon::help_open_topic("Greek_Symbols",'Greek Symbols',
undef,undef,600)
.' '.
&Apache::loncommon::help_open_topic("Other_Symbols",'Other Symbols',
undef,undef,600)
.'
';
}
sub general_help {
my $helptopic='Student_Intro';
if ($env{'request.role'}=~/^(ca|au)/) {
$helptopic='Authoring_Intro';
} elsif ($env{'request.role'}=~/^cc/) {
$helptopic='Course_Coordination_Intro';
}
return $helptopic;
}
sub update_help_link {
my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
my $origurl = $ENV{'REQUEST_URI'};
$origurl=~s|^/~|/priv/|;
my $timestamp = time;
foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
$$datum = &escape($$datum);
}
my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
my $output .= <<"ENDOUTPUT";
ENDOUTPUT
return $output;
}
# now just updates the help link and generates a blue icon
sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
= @_;
$stayOnPage = 0 if (not defined $stayOnPage);
# only use pop-up help (stayOnPage == 0)
# if environment.remote is on (using remote control UI)
if ($env{'browser.interface'} eq 'textual' ||
$env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
}
my $output;
if ($component_help) {
if (!$text) {
$output=&help_open_topic($component_help,undef,$stayOnPage,
$width,$height);
} else {
my $help_text;
$help_text=&unescape($topic);
$output=''.
&help_open_topic($component_help,$help_text,$stayOnPage,
$width,$height).'
';
}
}
my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
return $output.$banner_link;
}
sub top_nav_help {
my ($text) = @_;
$text = &mt($text);
my $stay_on_page =
($env{'browser.interface'} eq 'textual' ||
$env{'environment.remote'} eq 'off' );
my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
: "javascript:helpMenu('open')";
my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
my $title = &mt('Get help');
return <<"END";
$banner_link
$text
END
}
sub help_menu_js {
my ($text) = @_;
my $stayOnPage =
($env{'browser.interface'} eq 'textual' ||
$env{'environment.remote'} eq 'off' );
my $width = 620;
my $height = 600;
my $helptopic=&general_help();
my $details_link = '/adm/help/'.$helptopic.'.hlp';
my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
my $start_page =
&Apache::loncommon::start_page('Help Menu', undef,
{'frameset' => 1,
'js_ready' => 1,
'add_entries' => {
'border' => '0',
'rows' => "110,*",},});
my $end_page =
&Apache::loncommon::end_page({'frameset' => 1,
'js_ready' => 1,});
my $template .= <<"ENDTEMPLATE";
ENDTEMPLATE
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='.
&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');
my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
$template .= <<"ENDTEMPLATE";
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');
my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
$template .= <<"ENDTEMPLATE";
ENDTEMPLATE
if ($text ne '') { $template.='
' };
return $template;
}
###############################################################
###############################################################
=pod
=item * change_content_javascript():
This and the next function allow you to create small sections of an
otherwise static HTML page that you can update on the fly with
Javascript, even in Netscape 4.
The Javascript fragment returned by this function (no EscriptE tag)
must be written to the HTML page once. It will prove the Javascript
function "change(name, content)". Calling the change function with the
name of the section
you want to update, matching the name passed to C, and
the new content you want to put in there, will put the content into
that area.
B: Netscape 4 only reserves enough space for the changable area
to contain room for the original contents. You need to "make space"
for whatever changes you wish to make, and be B to check your
code in Netscape 4. This feature in Netscape 4 is B powerful;
it's adequate for updating a one-line status display, but little more.
This script will set the space to 100% width, so you only need to
worry about height in Netscape 4.
Modern browsers are much less limiting, and if you can commit to the
user not using Netscape 4, this feature may be used freely with
pretty much any HTML.
=cut
sub change_content_javascript {
# If we're on Netscape 4, we need to use Layer-based code
if ($env{'browser.type'} eq 'netscape' &&
$env{'browser.version'} =~ /^4\./) {
return (<. $name is
the name you will use to reference the area later; do not repeat the
same name on a given HTML page more then once. $origContent is what
the area will originally contain, which can be left blank.
=cut
sub changable_area {
my ($name, $origContent) = @_;
if ($env{'browser.type'} eq 'netscape' &&
$env{'browser.version'} =~ /^4\./) {
# If this is netscape 4, we need to use the Layer tag
return "$origContent ";
} else {
return "$origContent ";
}
}
=pod
=item * viewport_geometry_js {
Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
=cut
sub viewport_geometry_js {
return <<"GEOMETRY";
var Geometry = {};
function init_geometry() {
if (Geometry.init) { return };
Geometry.init=1;
if (window.innerHeight) {
Geometry.getViewportHeight = function() { return window.innerHeight; };
Geometry.getViewportWidth = function() { return window.innerWidth; };
Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
Geometry.getVerticalScroll = function() { return window.pageYOffset; };
}
else if (document.documentElement && document.documentElement.clientHeight) {
Geometry.getViewportHeight =
function() { return document.documentElement.clientHeight; };
Geometry.getViewportWidth =
function() { return document.documentElement.clientWidth; };
Geometry.getHorizontalScroll =
function() { return document.documentElement.scrollLeft; };
Geometry.getVerticalScroll =
function() { return document.documentElement.scrollTop; };
}
else if (document.body.clientHeight) {
Geometry.getViewportHeight =
function() { return document.body.clientHeight; };
Geometry.getViewportWidth =
function() { return document.body.clientWidth; };
Geometry.getHorizontalScroll =
function() { return document.body.scrollLeft; };
Geometry.getVerticalScroll =
function() { return document.body.scrollTop; };
}
}
GEOMETRY
}
=pod
=item * viewport_size_js {
Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window.
=cut
sub viewport_size_js {
my $geometry = &viewport_geometry_js();
return <<"DIMS";
$geometry
function getViewportDims(width,height) {
init_geometry();
width.value = Geometry.getViewportWidth();
height.value = Geometry.getViewportHeight();
return;
}
DIMS
}
=pod
=item * resize_textarea_js
emits the needed javascript to resize a textarea to be as big as possible
creates a function resize_textrea that takes two IDs first should be
the id of the element to resize, second should be the id of a div that
surrounds everything that comes after the textarea, this routine needs
to be attached to the for the onload and onresize events.
=cut
sub resize_textarea_js {
my $geometry = &viewport_geometry_js();
return <<"RESIZE";
RESIZE
}
=pod
=back
=head1 Excel and CSV file utility routines
=over 4
=cut
###############################################################
###############################################################
=pod
=item * csv_translate($text)
Translate $text to allow it to be output as a 'comma separated values'
format.
=cut
###############################################################
###############################################################
sub csv_translate {
my $text = shift;
$text =~ s/\"/\"\"/g;
$text =~ s/\n/ /g;
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 h4
=item i
=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->{'h4'} = $workbook->add_format(bold=>1, size=>12);
$format->{'i'} = $workbook->add_format(italic=>1);
$format->{'date'} = $workbook->add_format(num_format=>
'mm/dd/yyyy hh:mm:ss');
return $format;
}
###############################################################
###############################################################
=pod
=item * create_workbook
Create an Excel worksheet. If it fails, output message on the
request object and return undefs.
Inputs: Apache request object
Returns (undef) on failure,
Excel worksheet object, scalar with filename, and formats
from &Apache::loncommon::define_excel_formats on success
=cut
###############################################################
###############################################################
sub create_workbook {
my ($r) = @_;
#
# Create the excel spreadsheet
my $filename = '/prtspool/'.
$env{'user.name'}.'_'.$env{'user.domain'}.'_'.
time.'_'.rand(1000000000).'.xls';
my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
if (! defined($workbook)) {
$r->log_error("Error creating excel spreadsheet $filename: $!");
$r->print(''.&mt("Unable to create new Excel file. ".
"This error has been logged. ".
"Please alert your LON-CAPA administrator").
'
');
return (undef);
}
#
$workbook->set_tempdir('/home/httpd/perl/tmp');
#
my $format = &Apache::loncommon::define_excel_formats($workbook);
return ($workbook,$filename,$format);
}
###############################################################
###############################################################
=pod
=item * create_text_file
Create a file to write to and eventually make available to the user.
If file creation fails, outputs an error message on the request object and
return undefs.
Inputs: Apache request object, and file suffix
Returns (undef) on failure,
Filehandle and filename on success.
=cut
###############################################################
###############################################################
sub create_text_file {
my ($r,$suffix) = @_;
if (! defined($suffix)) { $suffix = 'txt'; };
my $fh;
my $filename = '/prtspool/'.
$env{'user.name'}.'_'.$env{'user.domain'}.'_'.
time.'_'.rand(1000000000).'.'.$suffix;
$fh = Apache::File->new('>/home/httpd'.$filename);
if (! defined($fh)) {
$r->log_error("Couldn't open $filename for output $!");
$r->print("Problems occured in creating the output file. ".
"This error has been logged. ".
"Please alert your LON-CAPA administrator.");
}
return ($fh,$filename)
}
=pod
=back
=cut
###############################################################
## Home server list generating code ##
###############################################################
# ------------------------------------------
sub domain_select {
my ($name,$value,$multiple)=@_;
my %domains=map {
$_ => $_.' '. &Apache::lonnet::domain($_,'description')
} &Apache::lonnet::all_domains();
if ($multiple) {
$domains{''}=&mt('Any domain');
$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
return &multiple_select_form($name,$value,4,\%domains);
} else {
$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
return &select_form($name,$value,%domains);
}
}
#-------------------------------------------
=pod
=head1 Routines for form select boxes
=over 4
=item * multiple_select_form($name,$value,$size,$hash,$order)
Returns a string containing a element int multiple mode
Args:
$name - name of the element
$value - scalar or array ref of values that should already be selected
$size - number of rows long the select element is
$hash - the elements should be 'option' => 'shown text'
(shown text should already have been &mt())
$order - (optional) array ref of the order to show the elements in
=cut
#-------------------------------------------
sub multiple_select_form {
my ($name,$value,$size,$hash,$order)=@_;
my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
my $output='';
if (! defined($size)) {
$size = 4;
if (scalar(keys(%$hash))<4) {
$size = scalar(keys(%$hash));
}
}
$output.="\n";
my @order;
if (ref($order) eq 'ARRAY') {
@order = @{$order};
} else {
@order = sort(keys(%$hash));
}
if (exists($$hash{'select_form_order'})) {
@order = @{$$hash{'select_form_order'}};
}
foreach my $key (@order) {
$output.='&').'" ';
$output.='selected="selected" ' if ($selected{$key});
$output.='>'.$hash->{$key}." \n";
}
$output.=" \n";
return $output;
}
#-------------------------------------------
=pod
=item * select_form($defdom,$name,%hash)
Returns a string containing a form to
allow a user to select options from a hash option_name => displayed text.
See lonrights.pm for an example invocation and use.
=cut
#-------------------------------------------
sub select_form {
my ($def,$name,%hash) = @_;
my $selectform = "\n";
my @keys;
if (exists($hash{'select_form_order'})) {
@keys=@{$hash{'select_form_order'}};
} else {
@keys=sort(keys(%hash));
}
foreach my $key (@keys) {
$selectform.=
'&').'" '.
($key eq $def ? 'selected="selected" ' : '').
">".&mt($hash{$key})." \n";
}
$selectform.=" ";
return $selectform;
}
# For display filters
sub display_filter {
if (!$env{'form.show'}) { $env{'form.show'}=10; }
if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
return ''.&mt('Records [_1]',
&Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
(&mt('all'),10,20,50,100,1000,10000))).
' '.
&mt('Filter [_1]',
&select_form($env{'form.displayfilter'},
'displayfilter',
('currentfolder' => 'Current folder/page',
'containing' => 'Containing phrase',
'none' => 'None'))).
' ';
}
sub gradeleveldescription {
my $gradelevel=shift;
my %gradelevels=(0 => 'Not specified',
1 => 'Grade 1',
2 => 'Grade 2',
3 => 'Grade 3',
4 => 'Grade 4',
5 => 'Grade 5',
6 => 'Grade 6',
7 => 'Grade 7',
8 => 'Grade 8',
9 => 'Grade 9',
10 => 'Grade 10',
11 => 'Grade 11',
12 => 'Grade 12',
13 => 'Grade 13',
14 => '100 Level',
15 => '200 Level',
16 => '300 Level',
17 => '400 Level',
18 => 'Graduate Level');
return &mt($gradelevels{$gradelevel});
}
sub select_level_form {
my ($deflevel,$name)=@_;
unless ($deflevel) { $deflevel=0; }
my $selectform = "\n";
for (my $i=0; $i<=18; $i++) {
$selectform.="".&gradeleveldescription($i)." \n";
}
$selectform.=" ";
return $selectform;
}
#-------------------------------------------
=pod
=item * select_dom_form($defdom,$name,$includeempty,$showdomdesc)
Returns a string containing a form to
allow a user to select the domain to preform an operation in.
See loncreateuser.pm for an example invocation and use.
If the $includeempty flag is set, it also includes an empty choice ("no domain
selected");
If the $showdomdesc flag is set, the domain name is followed by the domain description.
=cut
#-------------------------------------------
sub select_dom_form {
my ($defdom,$name,$includeempty,$showdomdesc) = @_;
my @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
if ($includeempty) { @domains=('',@domains); }
my $selectdomain = "\n";
foreach my $dom (@domains) {
$selectdomain.="'.$dom;
if ($showdomdesc) {
if ($dom ne '') {
my $domdesc = &Apache::lonnet::domain($dom,'description');
if ($domdesc ne '') {
$selectdomain .= ' ('.$domdesc.')';
}
}
}
$selectdomain .= " \n";
}
$selectdomain.=" ";
return $selectdomain;
}
#-------------------------------------------
=pod
=item * home_server_form_item($domain,$name,$defaultflag)
input: 4 arguments (two required, two optional) -
$domain - domain of new user
$name - name of form element
$default - Value of 'default' causes a default item to be first
option, and selected by default.
$hide - Value of 'hide' causes hiding of the name of the server,
if 1 server found, or default, if 0 found.
output: returns 2 items:
(a) form element which contains either:
(i)
$hostid $servers{$hostid}
$hostid $servers{$hostid}
form item if there are multiple library servers in $domain, or
(ii) an form item
if there is only one library server in $domain.
(b) number of library servers found.
See loncreateuser.pm for example of use.
=cut
#-------------------------------------------
sub home_server_form_item {
my ($domain,$name,$default,$hide) = @_;
my %servers = &Apache::lonnet::get_servers($domain,'library');
my $result;
my $numlib = keys(%servers);
if ($numlib > 1) {
$result .= ' '."\n";
if ($default) {
$result .= ''.&mt('default').
' '."\n";
}
foreach my $hostid (sort(keys(%servers))) {
$result.= ''.
$hostid.' '.$servers{$hostid}." \n";
}
$result .= ' '."\n";
} elsif ($numlib == 1) {
my $hostid;
foreach my $item (keys(%servers)) {
$hostid = $item;
}
$result .= ' ';
if (!$hide) {
$result .= $hostid.' '.$servers{$hostid};
}
$result .= "\n";
} elsif ($default) {
$result .= ' ';
if (!$hide) {
$result .= &mt('default');
}
$result .= "\n";
}
return ($result,$numlib);
}
=pod
=back
=cut
###############################################################
## Decoding User Agent ##
###############################################################
=pod
=head1 Decoding the User Agent
=over 4
=item * &decode_user_agent()
Inputs: $r
Outputs:
=over 4
=item * $httpbrowser
=item * $clientbrowser
=item * $clientversion
=item * $clientmathml
=item * $clientunicode
=item * $clientos
=back
=back
=cut
###############################################################
###############################################################
sub decode_user_agent {
my ($r)=@_;
my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
my $clientbrowser='unknown';
my $clientversion='0';
my $clientmathml='';
my $clientunicode='0';
for (my $i=0;$i<=$#browsertype;$i++) {
my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
$clientbrowser=$bname;
$httpbrowser=~/$vreg/i;
$clientversion=$1;
$clientmathml=($clientversion>=$minv);
$clientunicode=($clientversion>=$univ);
}
}
my $clientos='unknown';
if (($httpbrowser=~/linux/i) ||
($httpbrowser=~/unix/i) ||
($httpbrowser=~/ux/i) ||
($httpbrowser=~/solaris/i)) { $clientos='unix'; }
if (($httpbrowser=~/vax/i) ||
($httpbrowser=~/vms/i)) { $clientos='vms'; }
if ($httpbrowser=~/next/i) { $clientos='next'; }
if (($httpbrowser=~/mac/i) ||
($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
if ($httpbrowser=~/win/i) { $clientos='win'; }
if ($httpbrowser=~/embed/i) { $clientos='pda'; }
return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
$clientunicode,$clientos,);
}
###############################################################
## Authentication changing form generation subroutines ##
###############################################################
##
## All of the authform_xxxxxxx subroutines take their inputs in a
## hash, and have reasonable default values.
##
## formname = the name given in the
ENDROLE
my $titleinfo = ''.$title.' ';
if ($customtitle) {
$titleinfo = $customtitle;
}
#
# Extra info if you are the DC
my $dc_info = '';
if ($env{'user.adv'} && exists($env{'user.role.dc./'.
$env{'course.'.$env{'request.course.id'}.
'.domain'}.'/'})) {
my $cid = $env{'request.course.id'};
$dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info =~ s/\s+$//;
$dc_info = '('.$dc_info.')';
}
if ($env{'environment.remote'} eq 'off') {
# No Remote
if ($env{'request.state'} eq 'construct') {
$forcereg=1;
}
if (!$customtitle && $env{'request.state'} eq 'construct') {
# this is for resources; directories have customtitle, and crumbs
# and select recent are created in lonpubdir.pm
my ($uname,$thisdisfn)=
($env{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
my $formaction='/priv/'.$uname.'/'.$thisdisfn;
$formaction=~s/\/+/\//g;
my $parentpath = '';
my $lastitem = '';
if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
$parentpath = $1;
$lastitem = $2;
} else {
$lastitem = $thisdisfn;
}
$titleinfo =
&Apache::loncommon::help_open_menu('','',3,'Authoring').
'Construction Space : '.
''
.&Apache::lonmenu::constspaceform();
}
my $titletable;
if (!$notitle) {
$titletable =
''.
" $titleinfo $dc_info ".$roleinfo.
'
';
}
if ($notopbar) {
$bodytag .= $titletable;
} else {
if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg,
$titletable);
} else {
$bodytag .= &Apache::lonmenu::menubuttons($forcereg,$forcereg).
$titletable;
}
}
return $bodytag;
}
#
# Top frame rendering, Remote is up
#
my $imgsrc = $img;
if ($img =~ /^\/adm/) {
$imgsrc = &lonhttpdurl($img);
}
my $upperleft=' ';
# Explicit link to get inline menu
my $menu= ($no_inline_link?''
:''.&mt('Switch to Inline Menu Mode').' ');
#
if ($notitle) {
return $bodytag;
}
return(<
$upperleft
$messages
$titleinfo $dc_info $menu
$roleinfo
ENDBODY
}
sub make_attr_string {
my ($register,$attr_ref) = @_;
if ($attr_ref && !ref($attr_ref)) {
die("addentries Must be a hash ref ".
join(':',caller(1))." ".
join(':',caller(0))." ");
}
if ($register) {
my ($on_load,$on_unload);
foreach my $key (keys(%{$attr_ref})) {
if (lc($key) eq 'onload') {
$on_load.=$attr_ref->{$key}.';';
delete($attr_ref->{$key});
} elsif (lc($key) eq 'onunload') {
$on_unload.=$attr_ref->{$key}.';';
delete($attr_ref->{$key});
}
}
$attr_ref->{'onload'} =
&Apache::lonmenu::loadevents(). $on_load;
$attr_ref->{'onunload'}=
&Apache::lonmenu::unloadevents().$on_unload;
}
# Accessibility font enhance
if ($env{'browser.fontenhance'} eq 'on') {
my $style;
foreach my $key (keys(%{$attr_ref})) {
if (lc($key) eq 'style') {
$style.=$attr_ref->{$key}.';';
delete($attr_ref->{$key});
}
}
$attr_ref->{'style'}=$style.'; font-size: x-large;';
}
if ($env{'browser.blackwhite'} eq 'on') {
delete($attr_ref->{'font'});
delete($attr_ref->{'link'});
delete($attr_ref->{'alink'});
delete($attr_ref->{'vlink'});
delete($attr_ref->{'bgcolor'});
delete($attr_ref->{'background'});
}
my $attr_string;
foreach my $attr (keys(%$attr_ref)) {
$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
}
return $attr_string;
}
###############################################
###############################################
=pod
=item * &endbodytag()
Returns a uniform footer for LON-CAPA web pages.
Inputs: none
=cut
sub endbodytag {
my $endbodytag='';
$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
if ( exists( $env{'internal.head.redirect'} ) ) {
$endbodytag=
"".
&mt('Continue').' '.
$endbodytag;
}
return $endbodytag;
}
=pod
=item * &standard_css()
Returns a style sheet
Inputs: (all optional)
domain -> force to color decorate a page for a specific
domain
function -> force usage of a specific rolish color scheme
bgcolor -> override the default page bgcolor
=cut
sub standard_css {
my ($function,$domain,$bgcolor) = @_;
$function = &get_users_function() if (!$function);
my $img = &designparm($function.'.img', $domain);
my $tabbg = &designparm($function.'.tabbg', $domain);
my $font = &designparm($function.'.font', $domain);
my $sidebg = &designparm($function.'.sidebg',$domain);
my $pgbg_or_bgcolor =
$bgcolor ||
&designparm($function.'.pgbg', $domain);
my $pgbg = &designparm($function.'.pgbg', $domain);
my $alink = &designparm($function.'.alink', $domain);
my $vlink = &designparm($function.'.vlink', $domain);
my $link = &designparm($function.'.link', $domain);
my $sans = 'Arial,Helvetica,sans-serif';
my $mono = 'monospace';
my $data_table_head = $tabbg;
my $data_table_light = '#EEEEEE';
my $data_table_dark = '#DDDDDD';
my $data_table_darker = '#CCCCCC';
my $data_table_highlight = '#FFFF00';
my $mail_new = '#FFBB77';
my $mail_new_hover = '#DD9955';
my $mail_read = '#BBBB77';
my $mail_read_hover = '#999944';
my $mail_replied = '#AAAA88';
my $mail_replied_hover = '#888855';
my $mail_other = '#99BBBB';
my $mail_other_hover = '#669999';
my $table_header = '#DDDDDD';
my $feedback_link_bg = '#BBBBBB';
my $border = ($env{'browser.type'} eq 'explorer') ? '0px 2px 0px 2px'
: '0px 3px 0px 4px';
return <
$args - optional arguments
force_register - if is true call registerurl so the remote is
informed
redirect -> array ref of
1- seconds before redirect occurs
2- url to redirect to
3- whether the side effect should occur
(side effect of setting
$env{'internal.head.redirect'} to the url
redirected too)
domain -> force to color decorate a page for a specific
domain
function -> force usage of a specific rolish color scheme
bgcolor -> override the default page bgcolor
no_auto_mt_title
-> prevent &mt()ing the title arg
=cut
sub headtag {
my ($title,$head_extra,$args) = @_;
my $function = $args->{'function'} || &get_users_function();
my $domain = $args->{'domain'} || &determinedomain();
my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
my $url = join(':',$env{'user.name'},$env{'user.domain'},
$Apache::lonnet::perlvar{'lonVersion'},
#time(),
$env{'environment.color.timestamp'},
$function,$domain,$bgcolor);
$url = '/adm/css/'.&escape($url).'.css';
my $result =
''.
&font_settings();
if (!$args->{'frameset'}) {
$result .= &Apache::lonhtmlcommon::htmlareaheaders();
}
if ($args->{'force_register'}) {
$result .= &Apache::lonmenu::registerurl(1);
}
if (!$args->{'no_nav_bar'}
&& !$args->{'only_body'}
&& !$args->{'frameset'}) {
$result .= &help_menu_js();
}
if (ref($args->{'redirect'})) {
my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
$url = &Apache::lonenc::check_encrypt($url);
if (!$inhibit_continue) {
$env{'internal.head.redirect'} = $url;
}
$result.=<
ADDMETA
}
if (!defined($title)) {
$title = 'The LearningOnline Network with CAPA';
}
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
$result .= ' LON-CAPA '.$title.' '
.' '
.$head_extra;
return $result;
}
=pod
=item * &font_settings()
Returns neccessary to set the proper encoding
Inputs: none
=cut
sub font_settings {
my $headerstring='';
if (($env{'browser.os'} eq 'mac') && (!$env{'browser.mathml'})) {
$headerstring.=
' ';
} elsif (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
$headerstring.=
' ';
}
return $headerstring;
}
=pod
=item * &xml_begin()
Returns the needed doctype and
Inputs: none
=cut
sub xml_begin {
my $output='';
if ($env{'internal.start_page'}==1) {
&Apache::lonhtmlcommon::init_htmlareafields();
}
if ($env{'browser.mathml'}) {
$output=''
#.''."\n"
# .'] >'
.''
.'';
} else {
$output='';
}
return $output;
}
=pod
=item * &endheadtag()
Returns a uniform for LON-CAPA web pages.
Inputs: none
=cut
sub endheadtag {
return '';
}
=pod
=item * &head()
Returns a uniform complete .. section for LON-CAPA web pages.
Inputs: $title - optional title for the page
$head_extra - optional extra HTML to put inside the
=cut
sub head {
my ($title,$head_extra,$args) = @_;
return &headtag($title,$head_extra,$args).&endheadtag();
}
=pod
=item * &start_page()
Returns a complete .. section for LON-CAPA web pages.
Inputs: $title - optional title for the page
$head_extra - optional extra HTML to incude inside the
$args - additional optional args supported are:
only_body -> is true will set &bodytag() onlybodytag
arg on
no_nav_bar -> is true will set &bodytag() notopbar arg on
add_entries -> additional attributes to add to the
domain -> force to color decorate a page for a
specific domain
function -> force usage of a specific rolish color
scheme
redirect -> see &headtag()
bgcolor -> override the default page bg color
js_ready -> return a string ready for being used in
a javascript writeln
html_encode -> return a string ready for being used in
a html attribute
force_register -> if is true will turn on the &bodytag()
$forcereg arg
body_title -> alternate text to use instead of $title
in the title box that appears, this text
is not auto translated like the $title is
frameset -> if true will start with a
rather than
no_title -> if true the title bar won't be shown
skip_phases -> hash ref of
head -> skip the generation
body -> skip all generation
no_inline_link -> if true and in remote mode, don't show the
'Switch To Inline Menu' link
no_auto_mt_title -> prevent &mt()ing the title arg
inherit_jsmath -> when creating popup window in a page,
should it have jsmath forced on by the
current page
=cut
sub start_page {
my ($title,$head_extra,$args) = @_;
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
my %head_args;
foreach my $arg ('redirect','force_register','domain','function',
'bgcolor','frameset','no_nav_bar','only_body',
'no_auto_mt_title') {
if (defined($args->{$arg})) {
$head_args{$arg} = $args->{$arg};
}
}
$env{'internal.start_page'}++;
my $result;
if (! exists($args->{'skip_phases'}{'head'}) ) {
$result.=
&xml_begin().
&headtag($title,$head_extra,\%head_args).&endheadtag();
}
if (! exists($args->{'skip_phases'}{'body'}) ) {
if ($args->{'frameset'}) {
my $attr_string = &make_attr_string($args->{'force_register'},
$args->{'add_entries'});
$result .= "\n\n";
} else {
$result .=
&bodytag($title,
$args->{'function'}, $args->{'add_entries'},
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'body_title'},
$args->{'no_nav_bar'}, $args->{'bgcolor'},
$args->{'no_title'}, $args->{'no_inline_link'},
$args);
}
}
if ($args->{'js_ready'}) {
$result = &js_ready($result);
}
if ($args->{'html_encode'}) {
$result = &html_encode($result);
}
return $result;
}
=pod
=item * &head()
Returns a complete section for LON-CAPA web pages.
Inputs: $args - additional optional args supported are:
js_ready -> return a string ready for being used in
a javascript writeln
html_encode -> return a string ready for being used in
a html attribute
frameset -> if true will start with a
rather than
dicsussion -> if true will get discussion from
lonxml::xmlend
(you can pass the target and parser arguments
through optional 'target' and 'parser' args
to this routine)
=cut
sub end_page {
my ($args) = @_;
$env{'internal.end_page'}++;
my $result;
if ($args->{'discussion'}) {
my ($target,$parser);
if (ref($args->{'discussion'})) {
($target,$parser) =($args->{'discussion'}{'target'},
$args->{'discussion'}{'parser'});
}
$result .= &Apache::lonxml::xmlend($target,$parser);
}
if ($args->{'frameset'}) {
$result .= ' ';
} else {
$result .= &endbodytag();
}
$result .= "\n";
if ($args->{'js_ready'}) {
$result = &js_ready($result);
}
if ($args->{'html_encode'}) {
$result = &html_encode($result);
}
return $result;
}
sub html_encode {
my ($result) = @_;
$result = &HTML::Entities::encode($result,'<>&"');
return $result;
}
sub js_ready {
my ($result) = @_;
$result =~ s/[\n\r]/ /xmsg;
$result =~ s/\\/\\\\/xmsg;
$result =~ s/'/\\'/xmsg;
$result =~ s{}{<\\/}xmsg;
return $result;
}
sub validate_page {
if ( exists($env{'internal.start_page'})
&& $env{'internal.start_page'} > 1) {
&Apache::lonnet::logthis('start_page called multiple times '.
$env{'internal.start_page'}.' '.
$ENV{'request.filename'});
}
if ( exists($env{'internal.end_page'})
&& $env{'internal.end_page'} > 1) {
&Apache::lonnet::logthis('end_page called multiple times '.
$env{'internal.end_page'}.' '.
$env{'request.filename'});
}
if ( exists($env{'internal.start_page'})
&& ! exists($env{'internal.end_page'})) {
&Apache::lonnet::logthis('start_page called without end_page '.
$env{'request.filename'});
}
if ( ! exists($env{'internal.start_page'})
&& exists($env{'internal.end_page'})) {
&Apache::lonnet::logthis('end_page called without start_page'.
$env{'request.filename'});
}
}
sub simple_error_page {
my ($r,$title,$msg) = @_;
my $page =
&Apache::loncommon::start_page($title).
&mt($msg).
&Apache::loncommon::end_page();
if (ref($r)) {
$r->print($page);
return;
}
return $page;
}
{
my $row_count;
sub start_data_table {
my ($add_class) = @_;
my $css_class = (join(' ','LC_data_table',$add_class));
undef($row_count);
return ''."\n";
}
sub end_data_table {
undef($row_count);
return '
'."\n";;
}
sub start_data_table_row {
my ($add_class) = @_;
$row_count++;
my $css_class = ($row_count % 2)?'':'LC_even_row';
$css_class = (join(' ',$css_class,$add_class));
return ''."\n";;
}
sub continue_data_table_row {
my ($add_class) = @_;
my $css_class = ($row_count % 2)?'':'LC_even_row';
$css_class = (join(' ',$css_class,$add_class));
return ' '."\n";;
}
sub end_data_table_row {
return ' '."\n";;
}
sub start_data_table_empty_row {
$row_count++;
return ''."\n";;
}
sub end_data_table_empty_row {
return ' '."\n";;
}
sub start_data_table_header_row {
return ''."\n";;
}
}
=pod
=item * &inhibit_menu_check($arg)
Checks for a inhibitmenu state and generates output to preserve it
Inputs: $arg - can be any of
- undef - in which case the return value is a string
to add into arguments list of a uri
- 'input' - in which case the return value is a HTML