|
version 1.649, 2008/03/24 01:11:36
|
version 1.692.2.6, 2008/12/18 17:30:36
|
|
Line 61 use POSIX qw(strftime mktime);
|
Line 61 use POSIX qw(strftime mktime);
|
| use Apache::lonmenu(); |
use Apache::lonmenu(); |
| use Apache::lonenc(); |
use Apache::lonenc(); |
| use Apache::lonlocal; |
use Apache::lonlocal; |
| |
use Apache::lonnet(); |
| use HTML::Entities; |
use HTML::Entities; |
| use Apache::lonhtmlcommon(); |
use Apache::lonhtmlcommon(); |
| use Apache::loncoursedata(); |
use Apache::loncoursedata(); |
| use Apache::lontexconvert(); |
use Apache::lontexconvert(); |
| use Apache::lonclonecourse(); |
use Apache::lonclonecourse(); |
| use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
| |
use DateTime::TimeZone; |
| |
use DateTime::Locale::Catalog; |
| |
|
| # ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
| use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
|
Line 133 sub ssi_with_retries {
|
Line 136 sub ssi_with_retries {
|
| do { |
do { |
| ($content, $response) = &Apache::lonnet::ssi($resource, %form); |
($content, $response) = &Apache::lonnet::ssi($resource, %form); |
| $ok = $response->is_success; |
$ok = $response->is_success; |
| |
if (!$ok) { |
| |
&Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message); |
| |
} |
| $retries--; |
$retries--; |
| } while (!$ok && ($retries > 0)); |
} while (!$ok && ($retries > 0)); |
| |
|
|
Line 444 sub selectstudent_link {
|
Line 450 sub selectstudent_link {
|
| return ''; |
return ''; |
| } |
} |
| |
|
| |
sub authorbrowser_javascript { |
| |
return <<"ENDAUTHORBRW"; |
| |
<script type="text/javascript"> |
| |
var stdeditbrowser; |
| |
|
| |
function openauthorbrowser(formname,udom) { |
| |
var url = '/adm/pickauthor?'; |
| |
url += 'form='+formname+'&roledom='+udom; |
| |
var title = 'Author_Browser'; |
| |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
| |
options += ',width=700,height=600'; |
| |
stdeditbrowser = open(url,title,options,'1'); |
| |
stdeditbrowser.focus(); |
| |
} |
| |
|
| |
</script> |
| |
ENDAUTHORBRW |
| |
} |
| |
|
| sub coursebrowser_javascript { |
sub coursebrowser_javascript { |
| my ($domainfilter,$sec_element,$formname)=@_; |
my ($domainfilter,$sec_element,$formname)=@_; |
| my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); |
my $crs_or_grp_alert = &mt('Please select the type of LON-CAPA entity - Course or Group - for which you wish to add/modify a user role'); |
|
Line 581 sub selectcourse_link {
|
Line 606 sub selectcourse_link {
|
| '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>"; |
'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'","'.$selecttype.'");'."'>".&mt('Select Course')."</a>"; |
| } |
} |
| |
|
| |
sub selectauthor_link { |
| |
my ($form,$udom)=@_; |
| |
return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'. |
| |
&mt('Select Author').'</a>'; |
| |
} |
| |
|
| sub check_uncheck_jscript { |
sub check_uncheck_jscript { |
| my $jscript = <<"ENDSCRT"; |
my $jscript = <<"ENDSCRT"; |
| function checkAll(field) { |
function checkAll(field) { |
|
Line 606 ENDSCRT
|
Line 637 ENDSCRT
|
| return $jscript; |
return $jscript; |
| } |
} |
| |
|
| |
sub select_timezone { |
| |
my ($name,$selected,$onchange,$includeempty)=@_; |
| |
my $output='<select name="'.$name.'" '.$onchange.'>'."\n"; |
| |
if ($includeempty) { |
| |
$output .= '<option value=""'; |
| |
if (($selected eq '') || ($selected eq 'local')) { |
| |
$output .= ' selected="selected" '; |
| |
} |
| |
$output .= '> </option>'; |
| |
} |
| |
my @timezones = DateTime::TimeZone->all_names; |
| |
foreach my $tzone (@timezones) { |
| |
$output.= '<option value="'.$tzone.'"'; |
| |
if ($tzone eq $selected) { |
| |
$output.=' selected="selected"'; |
| |
} |
| |
$output.=">$tzone</option>\n"; |
| |
} |
| |
$output.="</select>"; |
| |
return $output; |
| |
} |
| |
|
| |
sub select_datelocale { |
| |
my ($name,$selected,$onchange,$includeempty)=@_; |
| |
my $output='<select name="'.$name.'" '.$onchange.'>'."\n"; |
| |
if ($includeempty) { |
| |
$output .= '<option value=""'; |
| |
if ($selected eq '') { |
| |
$output .= ' selected="selected" '; |
| |
} |
| |
$output .= '> </option>'; |
| |
} |
| |
my (@possibles,%locale_names); |
| |
my @locales = DateTime::Locale::Catalog::Locales; |
| |
foreach my $locale (@locales) { |
| |
if (ref($locale) eq 'HASH') { |
| |
my $id = $locale->{'id'}; |
| |
if ($id ne '') { |
| |
my $en_terr = $locale->{'en_territory'}; |
| |
my $native_terr = $locale->{'native_territory'}; |
| |
my @languages = &Apache::lonlocal::preferred_languages(); |
| |
if (grep(/^en$/,@languages) || !@languages) { |
| |
if ($en_terr ne '') { |
| |
$locale_names{$id} = '('.$en_terr.')'; |
| |
} elsif ($native_terr ne '') { |
| |
$locale_names{$id} = $native_terr; |
| |
} |
| |
} else { |
| |
if ($native_terr ne '') { |
| |
$locale_names{$id} = $native_terr.' '; |
| |
} elsif ($en_terr ne '') { |
| |
$locale_names{$id} = '('.$en_terr.')'; |
| |
} |
| |
} |
| |
push (@possibles,$id); |
| |
} |
| |
} |
| |
} |
| |
foreach my $item (sort(@possibles)) { |
| |
$output.= '<option value="'.$item.'"'; |
| |
if ($item eq $selected) { |
| |
$output.=' selected="selected"'; |
| |
} |
| |
$output.=">$item"; |
| |
if ($locale_names{$item} ne '') { |
| |
$output.=" $locale_names{$item}</option>\n"; |
| |
} |
| |
$output.="</option>\n"; |
| |
} |
| |
$output.="</select>"; |
| |
return $output; |
| |
} |
| |
|
| =pod |
=pod |
| |
|
|
Line 823 sub help_open_topic {
|
Line 926 sub help_open_topic {
|
| if ($text ne "") { |
if ($text ne "") { |
| $template .= |
$template .= |
| "<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>". |
"<table bgcolor='#3333AA' cellspacing='1' cellpadding='1' border='0'><tr>". |
| "<td bgcolor='#5555FF'><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>"; |
"<td bgcolor='#5555FF'><span class=\"LC_nobreak\"><a target=\"_top\" href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>"; |
| } |
} |
| |
|
| # Add the graphic |
# Add the graphic |
| my $title = &mt('Online Help'); |
my $title = &mt('Online Help'); |
| my $helpicon=&lonhttpdurl("/res/adm/pages/help.png"); |
my $helpicon=&lonhttpdurl("/adm/help/help.png"); |
| $template .= <<"ENDTEMPLATE"; |
$template .= <<"ENDTEMPLATE"; |
| <a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a> |
<a target="_top" href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a> |
| ENDTEMPLATE |
ENDTEMPLATE |
| if ($text ne '') { $template.='</td></tr></table>' }; |
if ($text ne '') { $template.='</span></td></tr></table>' }; |
| return $template; |
return $template; |
| |
|
| } |
} |
|
Line 854 sub helpLatexCheatsheet {
|
Line 957 sub helpLatexCheatsheet {
|
| .'</td><td>'. |
.'</td><td>'. |
| &Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'), |
&Apache::loncommon::help_open_topic("Other_Symbols",&mt('Other Symbols'), |
| undef,undef,600) |
undef,undef,600) |
| |
.'</td><td>'. |
| |
&Apache::loncommon::help_open_topic("Authoring_Output_Tags",&mt('Output Tags'), |
| |
undef,undef,600) |
| .'</td></tr></table>'; |
.'</td></tr></table>'; |
| } |
} |
| |
|
|
Line 863 sub general_help {
|
Line 969 sub general_help {
|
| $helptopic='Authoring_Intro'; |
$helptopic='Authoring_Intro'; |
| } elsif ($env{'request.role'}=~/^cc/) { |
} elsif ($env{'request.role'}=~/^cc/) { |
| $helptopic='Course_Coordination_Intro'; |
$helptopic='Course_Coordination_Intro'; |
| |
} elsif ($env{'request.role'}=~/^dc/) { |
| |
$helptopic='Domain_Coordination_Intro'; |
| } |
} |
| return $helptopic; |
return $helptopic; |
| } |
} |
|
Line 1452 sub create_text_file {
|
Line 1560 sub create_text_file {
|
| $fh = Apache::File->new('>/home/httpd'.$filename); |
$fh = Apache::File->new('>/home/httpd'.$filename); |
| if (! defined($fh)) { |
if (! defined($fh)) { |
| $r->log_error("Couldn't open $filename for output $!"); |
$r->log_error("Couldn't open $filename for output $!"); |
| $r->print("Problems occured in creating the output file. ". |
$r->print(&mt('Problems occurred in creating the output file. ' |
| "This error has been logged. ". |
.'This error has been logged. ' |
| "Please alert your LON-CAPA administrator."); |
.'Please alert your LON-CAPA administrator.')); |
| } |
} |
| return ($fh,$filename) |
return ($fh,$filename) |
| } |
} |
|
Line 2890 sub fileextensions {
|
Line 2998 sub fileextensions {
|
| |
|
| sub display_languages { |
sub display_languages { |
| my %languages=(); |
my %languages=(); |
| foreach my $lang (&preferred_languages()) { |
foreach my $lang (&Apache::lonlocal::preferred_languages()) { |
| $languages{$lang}=1; |
$languages{$lang}=1; |
| } |
} |
| &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); |
&get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']); |
|
Line 2902 sub display_languages {
|
Line 3010 sub display_languages {
|
| return %languages; |
return %languages; |
| } |
} |
| |
|
| sub preferred_languages { |
|
| my @languages=(); |
|
| if ($env{'course.'.$env{'request.course.id'}.'.languages'}) { |
|
| @languages=(@languages,split(/\s*(\,|\;|\:)\s*/, |
|
| $env{'course.'.$env{'request.course.id'}.'.languages'})); |
|
| } |
|
| if ($env{'environment.languages'}) { |
|
| @languages=(@languages, |
|
| split(/\s*(\,|\;|\:)\s*/,$env{'environment.languages'})); |
|
| } |
|
| my $browser=$ENV{'HTTP_ACCEPT_LANGUAGE'}; |
|
| if ($browser) { |
|
| my @browser = |
|
| map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); |
|
| push(@languages,@browser); |
|
| } |
|
| |
|
| foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'}, |
|
| $Apache::lonnet::perlvar{'lonDefDomain'}) { |
|
| if ($domtype ne '') { |
|
| my %domdefs = &Apache::lonnet::get_domain_defaults($domtype); |
|
| if ($domdefs{'lang_def'} ne '') { |
|
| push(@languages,$domdefs{'lang_def'}); |
|
| } |
|
| } |
|
| } |
|
| # turn "en-ca" into "en-ca,en" |
|
| my @genlanguages; |
|
| foreach my $lang (@languages) { |
|
| unless ($lang=~/\w/) { next; } |
|
| push(@genlanguages,$lang); |
|
| if ($lang=~/(\-|\_)/) { |
|
| push(@genlanguages,(split(/(\-|\_)/,$lang))[0]); |
|
| } |
|
| } |
|
| #uniqueify the languages list |
|
| my %count; |
|
| @genlanguages = map { $count{$_}++ == 0 ? $_ : () } @genlanguages; |
|
| return @genlanguages; |
|
| } |
|
| |
|
| sub languages { |
sub languages { |
| my ($possible_langs) = @_; |
my ($possible_langs) = @_; |
| my @preferred_langs = &preferred_languages(); |
my @preferred_langs = &Apache::lonlocal::preferred_languages(); |
| if (!ref($possible_langs)) { |
if (!ref($possible_langs)) { |
| if( wantarray ) { |
if( wantarray ) { |
| return @preferred_langs; |
return @preferred_langs; |
|
Line 3139 sub get_student_view {
|
Line 3206 sub get_student_view {
|
| } |
} |
| if (defined($target)) { $form{'grade_target'} = $target; } |
if (defined($target)) { $form{'grade_target'} = $target; } |
| $feedurl=&Apache::lonnet::clutter($feedurl); |
$feedurl=&Apache::lonnet::clutter($feedurl); |
| my $userview=&Apache::lonnet::ssi_body($feedurl,%form); |
my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form); |
| $userview=~s/\<body[^\>]*\>//gi; |
$userview=~s/\<body[^\>]*\>//gi; |
| $userview=~s/\<\/body\>//gi; |
$userview=~s/\<\/body\>//gi; |
| $userview=~s/\<html\>//gi; |
$userview=~s/\<html\>//gi; |
|
Line 3148 sub get_student_view {
|
Line 3215 sub get_student_view {
|
| $userview=~s/\<\/head\>//gi; |
$userview=~s/\<\/head\>//gi; |
| $userview=~s/action\s*\=/would_be_action\=/gi; |
$userview=~s/action\s*\=/would_be_action\=/gi; |
| $userview=&relative_to_absolute($feedurl,$userview); |
$userview=&relative_to_absolute($feedurl,$userview); |
| return $userview; |
if (wantarray) { |
| |
return ($userview,$response); |
| |
} else { |
| |
return $userview; |
| |
} |
| |
} |
| |
|
| |
sub get_student_view_with_retries { |
| |
my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_; |
| |
|
| |
my $ok = 0; # True if we got a good response. |
| |
my $content; |
| |
my $response; |
| |
|
| |
# Try to get the student_view done. within the retries count: |
| |
|
| |
do { |
| |
($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv); |
| |
$ok = $response->is_success; |
| |
if (!$ok) { |
| |
&Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message); |
| |
} |
| |
$retries--; |
| |
} while (!$ok && ($retries > 0)); |
| |
|
| |
if (!$ok) { |
| |
$content = ''; # On error return an empty content. |
| |
} |
| |
if (wantarray) { |
| |
return ($content, $response); |
| |
} else { |
| |
return $content; |
| |
} |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 3257 sub pprmlink {
|
Line 3356 sub pprmlink {
|
| |
|
| |
|
| sub timehash { |
sub timehash { |
| my @ltime=localtime(shift); |
my ($thistime) = @_; |
| return ( 'seconds' => $ltime[0], |
my $timezone = &Apache::lonlocal::gettimezone(); |
| 'minutes' => $ltime[1], |
my $dt = DateTime->from_epoch(epoch => $thistime) |
| 'hours' => $ltime[2], |
->set_time_zone($timezone); |
| 'day' => $ltime[3], |
my $wday = $dt->day_of_week(); |
| 'month' => $ltime[4]+1, |
if ($wday == 7) { $wday = 0; } |
| 'year' => $ltime[5]+1900, |
return ( 'second' => $dt->second(), |
| 'weekday' => $ltime[6], |
'minute' => $dt->minute(), |
| 'dayyear' => $ltime[7]+1, |
'hour' => $dt->hour(), |
| 'dlsav' => $ltime[8] ); |
'day' => $dt->day_of_month(), |
| |
'month' => $dt->month(), |
| |
'year' => $dt->year(), |
| |
'weekday' => $wday, |
| |
'dayyear' => $dt->day_of_year(), |
| |
'dlsav' => $dt->is_dst() ); |
| } |
} |
| |
|
| sub utc_string { |
sub utc_string { |
|
Line 3276 sub utc_string {
|
Line 3380 sub utc_string {
|
| |
|
| sub maketime { |
sub maketime { |
| my %th=@_; |
my %th=@_; |
| |
my ($epoch_time,$timezone,$dt); |
| |
$timezone = &Apache::lonlocal::gettimezone(); |
| |
eval { |
| |
$dt = DateTime->new( year => $th{'year'}, |
| |
month => $th{'month'}, |
| |
day => $th{'day'}, |
| |
hour => $th{'hour'}, |
| |
minute => $th{'minute'}, |
| |
second => $th{'second'}, |
| |
time_zone => $timezone, |
| |
); |
| |
}; |
| |
if (!$@) { |
| |
$epoch_time = $dt->epoch; |
| |
if ($epoch_time) { |
| |
return $epoch_time; |
| |
} |
| |
} |
| return POSIX::mktime( |
return POSIX::mktime( |
| ($th{'seconds'},$th{'minutes'},$th{'hours'}, |
($th{'seconds'},$th{'minutes'},$th{'hours'}, |
| $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1)); |
$th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1)); |
|
Line 3656 sub blocking_status {
|
Line 3778 sub blocking_status {
|
| |
|
| ############################################### |
############################################### |
| |
|
| |
sub check_ip_acc { |
| |
my ($acc)=@_; |
| |
&Apache::lonxml::debug("acc is $acc"); |
| |
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
| |
return 1; |
| |
} |
| |
my $allowed=0; |
| |
my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'}; |
| |
|
| |
my $name; |
| |
foreach my $pattern (split(',',$acc)) { |
| |
$pattern =~ s/^\s*//; |
| |
$pattern =~ s/\s*$//; |
| |
if ($pattern =~ /\*$/) { |
| |
#35.8.* |
| |
$pattern=~s/\*//; |
| |
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
| |
} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
| |
#35.8.3.[34-56] |
| |
my $low=$2; |
| |
my $high=$3; |
| |
$pattern=$1; |
| |
if ($ip =~ /^\Q$pattern\E/) { |
| |
my $last=(split(/\./,$ip))[3]; |
| |
if ($last <=$high && $last >=$low) { $allowed=1; } |
| |
} |
| |
} elsif ($pattern =~ /^\*/) { |
| |
#*.msu.edu |
| |
$pattern=~s/\*//; |
| |
if (!defined($name)) { |
| |
use Socket; |
| |
my $netaddr=inet_aton($ip); |
| |
($name)=gethostbyaddr($netaddr,AF_INET); |
| |
} |
| |
if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } |
| |
} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
| |
#127.0.0.1 |
| |
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
| |
} else { |
| |
#some.name.com |
| |
if (!defined($name)) { |
| |
use Socket; |
| |
my $netaddr=inet_aton($ip); |
| |
($name)=gethostbyaddr($netaddr,AF_INET); |
| |
} |
| |
if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } |
| |
} |
| |
if ($allowed) { last; } |
| |
} |
| |
return $allowed; |
| |
} |
| |
|
| |
############################################### |
| |
|
| =pod |
=pod |
| |
|
| =head1 Domain Template Functions |
=head1 Domain Template Functions |
|
Line 3704 sub get_domainconf {
|
Line 3880 sub get_domainconf {
|
| if (ref($domconfig{'login'}) eq 'HASH') { |
if (ref($domconfig{'login'}) eq 'HASH') { |
| if (keys(%{$domconfig{'login'}})) { |
if (keys(%{$domconfig{'login'}})) { |
| foreach my $key (keys(%{$domconfig{'login'}})) { |
foreach my $key (keys(%{$domconfig{'login'}})) { |
| $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; |
if (ref($domconfig{'login'}{$key}) eq 'HASH') { |
| |
foreach my $img (keys(%{$domconfig{'login'}{$key}})) { |
| |
$designhash{$udom.'.login.'.$key.'_'.$img} = |
| |
$domconfig{'login'}{$key}{$img}; |
| |
} |
| |
} else { |
| |
$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; |
| |
} |
| } |
} |
| } else { |
} else { |
| $legacy{'login'} = 1; |
$legacy{'login'} = 1; |
|
Line 4402 table.LC_docs_path td.LC_docs_path_compo
|
Line 4585 table.LC_docs_path td.LC_docs_path_compo
|
| td.LC_table_cell_checkbox { |
td.LC_table_cell_checkbox { |
| text-align: center; |
text-align: center; |
| } |
} |
| |
|
| table#LC_mainmenu td.LC_mainmenu_column { |
table#LC_mainmenu td.LC_mainmenu_column { |
| vertical-align: top; |
vertical-align: top; |
| } |
} |
|
Line 4416 table#LC_mainmenu td.LC_mainmenu_column
|
Line 4598 table#LC_mainmenu td.LC_mainmenu_column
|
| .LC_menubuttons_link { |
.LC_menubuttons_link { |
| text-decoration: none; |
text-decoration: none; |
| } |
} |
| |
#2008--9-5: new menu style sheet.Changed category |
| .LC_menubuttons_category { |
.LC_menubuttons_category { |
| color: $font; |
color: $font; |
| background: $pgbg; |
background: $pgbg; |
|
Line 4483 td.LC_menubuttons_img {
|
Line 4665 td.LC_menubuttons_img {
|
| text-align: right; |
text-align: right; |
| } |
} |
| |
|
| |
.LC_roleslog_note { |
| |
font-size: smaller; |
| |
} |
| |
|
| |
.LC_mail_functions { |
| |
font-weight: bold; |
| |
} |
| |
|
| table.LC_aboutme_port { |
table.LC_aboutme_port { |
| border: 0px; |
border: 0px; |
| border-collapse: collapse; |
border-collapse: collapse; |
|
Line 4515 table.LC_prior_tries tr th {
|
Line 4705 table.LC_prior_tries tr th {
|
| background-color: $data_table_head; |
background-color: $data_table_head; |
| font-size: smaller; |
font-size: smaller; |
| } |
} |
| |
table.LC_data_table tr.LC_info_row > td { |
| |
background-color: #CCC; |
| |
font-weight: bold; |
| |
text-align: left; |
| |
} |
| table.LC_data_table tr.LC_odd_row > td, |
table.LC_data_table tr.LC_odd_row > td, |
| table.LC_aboutme_port tr td { |
table.LC_aboutme_port tr td { |
| background-color: $data_table_light; |
background-color: $data_table_light; |
|
Line 5265 hr.LC_edit_problem_divide {
|
Line 5460 hr.LC_edit_problem_divide {
|
| height: 3px; |
height: 3px; |
| border: 0px; |
border: 0px; |
| } |
} |
| |
img.stift{ |
| |
border-width:0; |
| |
vertical-align:middle; |
| |
} |
| |
|
| |
table#LC_mainmenu{ |
| |
margin-top:10px; |
| |
width:80%; |
| |
|
| |
} |
| |
|
| |
table#LC_mainmenu td.LC_mainmenu_col_fieldset{ |
| |
vertical-align: top; |
| |
width: 45%; |
| |
} |
| |
.LC_mainmenu_fieldset_category { |
| |
color: $font; |
| |
background: $pgbg; |
| |
font-family: $sans; |
| |
font-size: small; |
| |
font-weight: bold; |
| |
} |
| |
fieldset#LC_mainmenu_fieldset { |
| |
margin:0px 10px 10px 0px; |
| |
|
| |
} |
| |
|
| |
div.LC_createcourse { |
| |
margin: 10px 10px 10px 10px; |
| |
} |
| |
|
| END |
END |
| } |
} |
| |
|
|
Line 6295 sub default_quota {
|
Line 6521 sub default_quota {
|
| if ($inststatus ne '') { |
if ($inststatus ne '') { |
| my @statuses = split(/:/,$inststatus); |
my @statuses = split(/:/,$inststatus); |
| foreach my $item (@statuses) { |
foreach my $item (@statuses) { |
| if ($quotahash{'quotas'}{$item} ne '') { |
if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') { |
| if ($defquota eq '') { |
if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') { |
| $defquota = $quotahash{'quotas'}{$item}; |
if ($defquota eq '') { |
| $settingstatus = $item; |
$defquota = $quotahash{'quotas'}{'defaultquota'}{$item}; |
| } elsif ($quotahash{'quotas'}{$item} > $defquota) { |
$settingstatus = $item; |
| $defquota = $quotahash{'quotas'}{$item}; |
} elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) { |
| $settingstatus = $item; |
$defquota = $quotahash{'quotas'}{'defaultquota'}{$item}; |
| |
$settingstatus = $item; |
| |
} |
| |
} |
| |
} else { |
| |
if ($quotahash{'quotas'}{$item} ne '') { |
| |
if ($defquota eq '') { |
| |
$defquota = $quotahash{'quotas'}{$item}; |
| |
$settingstatus = $item; |
| |
} elsif ($quotahash{'quotas'}{$item} > $defquota) { |
| |
$defquota = $quotahash{'quotas'}{$item}; |
| |
$settingstatus = $item; |
| |
} |
| } |
} |
| } |
} |
| } |
} |
| } |
} |
| if ($defquota eq '') { |
if ($defquota eq '') { |
| $defquota = $quotahash{'quotas'}{'default'}; |
if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') { |
| |
$defquota = $quotahash{'quotas'}{'defaultquota'}{'default'}; |
| |
} else { |
| |
$defquota = $quotahash{'quotas'}{'default'}; |
| |
} |
| $settingstatus = 'default'; |
$settingstatus = 'default'; |
| } |
} |
| } else { |
} else { |
|
Line 6713 sub instrule_disallow_msg {
|
Line 6955 sub instrule_disallow_msg {
|
| $text{'action'} = 'IDs'; |
$text{'action'} = 'IDs'; |
| } |
} |
| } |
} |
| $response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for <span class=\"LC_cusr_emph\">[_1]</span>, but the $text{'item'} $text{'do'} not exist in the institutional directory.",$domdesc).'<br />'; |
$response = &mt("The $text{'item'} you chose $text{'match'} the format of $text{'items'} defined for [_1], but the $text{'item'} $text{'do'} not exist in the institutional directory.",'<span class="LC_cusr_emph">'.$domdesc.'</span>').'<br />'; |
| if ($mode eq 'upload') { |
if ($mode eq 'upload') { |
| if ($checkitem eq 'username') { |
if ($checkitem eq 'username') { |
| $response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}."); |
$response .= &mt("You will need to modify your upload file so it will include $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}."); |
| } elsif ($checkitem eq 'id') { |
} elsif ($checkitem eq 'id') { |
| $response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the ID/Student Number field."); |
$response .= &mt("Either upload a file which includes $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or when associating fields with data columns, omit an association for the Student/Employee ID field."); |
| |
} |
| |
} elsif ($mode eq 'selfcreate') { |
| |
if ($checkitem eq 'id') { |
| |
$response .= &mt("You must either choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}, or leave the ID field blank."); |
| } |
} |
| } else { |
} else { |
| if ($checkitem eq 'username') { |
if ($checkitem eq 'username') { |
|
Line 6748 sub sorted_inst_types {
|
Line 6994 sub sorted_inst_types {
|
| my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); |
my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); |
| my $othertitle = &mt('All users'); |
my $othertitle = &mt('All users'); |
| if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
| $othertitle = 'any'; |
$othertitle = &mt('Any users'); |
| } |
} |
| my @types; |
my @types; |
| if (ref($order) eq 'ARRAY') { |
if (ref($order) eq 'ARRAY') { |
|
Line 6761 sub sorted_inst_types {
|
Line 7007 sub sorted_inst_types {
|
| } |
} |
| if (keys(%{$usertypes}) > 0) { |
if (keys(%{$usertypes}) > 0) { |
| $othertitle = &mt('Other users'); |
$othertitle = &mt('Other users'); |
| if ($env{'request.course.id'}) { |
|
| $othertitle = 'other'; |
|
| } |
|
| } |
} |
| return ($othertitle,$usertypes,\@types); |
return ($othertitle,$usertypes,\@types); |
| } |
} |
|
Line 6949 sub get_env_multiple {
|
Line 7192 sub get_env_multiple {
|
| return(@values); |
return(@values); |
| } |
} |
| |
|
| |
sub ask_for_embedded_content { |
| |
my ($actionurl,$state,$allfiles,$codebase,$args)=@_; |
| |
my $upload_output = ' |
| |
<form name="upload_embedded" action="'.$actionurl.'" |
| |
method="post" enctype="multipart/form-data">'; |
| |
$upload_output .= $state; |
| |
$upload_output .= '<b>Upload embedded files</b>:<br />'.&start_data_table(); |
| |
|
| |
my $num = 0; |
| |
foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%{$allfiles})) { |
| |
$upload_output .= &start_data_table_row(). |
| |
'<td>'.$embed_file.'</td><td>'; |
| |
if ($args->{'ignore_remote_references'} |
| |
&& $embed_file =~ m{^\w+://}) { |
| |
$upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>'; |
| |
} elsif ($args->{'error_on_invalid_names'} |
| |
&& $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) { |
| |
|
| |
$upload_output.='<span class="LC_warning">'.&mt("Invalid characters").'</span>'; |
| |
|
| |
} else { |
| |
$upload_output .=' |
| |
<input name="embedded_item_'.$num.'" type="file" value="" /> |
| |
<input name="embedded_orig_'.$num.'" type="hidden" value="'.&escape($embed_file).'" />'; |
| |
my $attrib = join(':',@{$$allfiles{$embed_file}}); |
| |
$upload_output .= |
| |
"\n\t\t". |
| |
'<input name="embedded_attrib_'.$num.'" type="hidden" value="'. |
| |
$attrib.'" />'; |
| |
if (exists($$codebase{$embed_file})) { |
| |
$upload_output .= |
| |
"\n\t\t". |
| |
'<input name="codebase_'.$num.'" type="hidden" value="'. |
| |
&escape($$codebase{$embed_file}).'" />'; |
| |
} |
| |
} |
| |
$upload_output .= '</td>'.&Apache::loncommon::end_data_table_row(); |
| |
$num++; |
| |
} |
| |
$upload_output .= &Apache::loncommon::end_data_table().'<br /> |
| |
<input type ="hidden" name="number_embedded_items" value="'.$num.'" /> |
| |
<input type ="submit" value="'.&mt('Upload Listed Files').'" /> |
| |
'.&mt('(only files for which a location has been provided will be uploaded)').' |
| |
</form>'; |
| |
return $upload_output; |
| |
} |
| |
|
| |
sub upload_embedded { |
| |
my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota, |
| |
$current_disk_usage) = @_; |
| |
my $output; |
| |
for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) { |
| |
next if (!exists($env{'form.embedded_item_'.$i.'.filename'})); |
| |
my $orig_uploaded_filename = |
| |
$env{'form.embedded_item_'.$i.'.filename'}; |
| |
|
| |
$env{'form.embedded_orig_'.$i} = |
| |
&unescape($env{'form.embedded_orig_'.$i}); |
| |
my ($path,$fname) = |
| |
($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)}); |
| |
# no path, whole string is fname |
| |
if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} }; |
| |
|
| |
$path = $env{'form.currentpath'}.$path; |
| |
$fname = &Apache::lonnet::clean_filename($fname); |
| |
# See if there is anything left |
| |
next if ($fname eq ''); |
| |
|
| |
# Check if file already exists as a file or directory. |
| |
my ($state,$msg); |
| |
if ($context eq 'portfolio') { |
| |
my $port_path = $dirpath; |
| |
if ($group ne '') { |
| |
$port_path = "groups/$group/$port_path"; |
| |
} |
| |
($state,$msg) = &check_for_upload($path,$fname,$group,'embedded_item_'.$i, |
| |
$dir_root,$port_path,$disk_quota, |
| |
$current_disk_usage,$uname,$udom); |
| |
if ($state eq 'will_exceed_quota' |
| |
|| $state eq 'file_locked' |
| |
|| $state eq 'file_exists' ) { |
| |
$output .= $msg; |
| |
next; |
| |
} |
| |
} elsif (($context eq 'author') || ($context eq 'testbank')) { |
| |
($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i); |
| |
if ($state eq 'exists') { |
| |
$output .= $msg; |
| |
next; |
| |
} |
| |
} |
| |
# Check if extension is valid |
| |
if (($fname =~ /\.(\w+)$/) && |
| |
(&Apache::loncommon::fileembstyle($1) eq 'hdn')) { |
| |
$output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1); |
| |
next; |
| |
} elsif (($fname =~ /\.(\w+)$/) && |
| |
(!defined(&Apache::loncommon::fileembstyle($1)))) { |
| |
$output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1); |
| |
next; |
| |
} elsif ($fname=~/\.(\d+)\.(\w+)$/) { |
| |
$output .= &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2); |
| |
next; |
| |
} |
| |
|
| |
$env{'form.embedded_item_'.$i.'.filename'}=$fname; |
| |
if ($context eq 'portfolio') { |
| |
my $result= |
| |
&Apache::lonnet::userfileupload('embedded_item_'.$i,'', |
| |
$dirpath.$path); |
| |
if ($result !~ m|^/uploaded/|) { |
| |
$output .= '<span class="LC_error">' |
| |
.&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].' |
| |
,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}) |
| |
.'</span><br />'; |
| |
next; |
| |
} else { |
| |
$output .= '<p>'.&mt('Uploaded [_1]','<span class="LC_filename">'. |
| |
$path.$fname.'</span>').'</p>'; |
| |
} |
| |
} else { |
| |
# Save the file |
| |
my $target = $env{'form.embedded_item_'.$i}; |
| |
my $fullpath = $dir_root.$dirpath.'/'.$path; |
| |
my $dest = $fullpath.$fname; |
| |
my $url = $url_root.$dirpath.'/'.$path.$fname; |
| |
my @parts=split(/\//,$fullpath); |
| |
my $count; |
| |
my $filepath = $dir_root; |
| |
for ($count=4;$count<=$#parts;$count++) { |
| |
$filepath .= "/$parts[$count]"; |
| |
if ((-e $filepath)!=1) { |
| |
mkdir($filepath,0770); |
| |
} |
| |
} |
| |
my $fh; |
| |
if (!open($fh,'>'.$dest)) { |
| |
&Apache::lonnet::logthis('Failed to create '.$dest); |
| |
$output .= '<span class="LC_error">'. |
| |
&mt('An error occurred while trying to upload [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). |
| |
'</span><br />'; |
| |
} else { |
| |
if (!print $fh $env{'form.embedded_item_'.$i}) { |
| |
&Apache::lonnet::logthis('Failed to write to '.$dest); |
| |
$output .= '<span class="LC_error">'. |
| |
&mt('An error occurred while writing the file [_1] for embedded element [_2].',$orig_uploaded_filename,$env{'form.embedded_orig_'.$i}). |
| |
'</span><br />'; |
| |
} else { |
| |
if ($context eq 'testbank') { |
| |
$output .= &mt('Embedded file uploaded successfully:'). |
| |
' <a href="'.$url.'">'. |
| |
$orig_uploaded_filename.'</a><br />'; |
| |
} else { |
| |
$output .= '<font size="+2">'. |
| |
&mt('View embedded file: [_1]','<a href="'.$url.'">'. |
| |
$orig_uploaded_filename.'</a>').'</font><br />'; |
| |
} |
| |
} |
| |
close($fh); |
| |
} |
| |
} |
| |
} |
| |
return $output; |
| |
} |
| |
|
| |
sub check_for_existing { |
| |
my ($path,$fname,$element) = @_; |
| |
my ($state,$msg); |
| |
if (-d $path.'/'.$fname) { |
| |
$state = 'exists'; |
| |
$msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path); |
| |
} elsif (-e $path.'/'.$fname) { |
| |
$state = 'exists'; |
| |
$msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path); |
| |
} |
| |
if ($state eq 'exists') { |
| |
$msg = '<span class="LC_error">'.$msg.'</span><br />'; |
| |
} |
| |
return ($state,$msg); |
| |
} |
| |
|
| |
sub check_for_upload { |
| |
my ($path,$fname,$group,$element,$portfolio_root,$port_path, |
| |
$disk_quota,$current_disk_usage,$uname,$udom) = @_; |
| |
my $filesize = (length($env{'form.'.$element})) / 1000; #express in k (1024?) |
| |
my $getpropath = 1; |
| |
my @dir_list = &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname, |
| |
$getpropath); |
| |
my $found_file = 0; |
| |
my $locked_file = 0; |
| |
foreach my $line (@dir_list) { |
| |
my ($file_name)=split(/\&/,$line,2); |
| |
if ($file_name eq $fname){ |
| |
$file_name = $path.$file_name; |
| |
if ($group ne '') { |
| |
$file_name = $group.$file_name; |
| |
} |
| |
$found_file = 1; |
| |
if (&Apache::lonnet::is_locked($file_name,$udom,$uname) eq 'true') { |
| |
$locked_file = 1; |
| |
} |
| |
} |
| |
} |
| |
if (($current_disk_usage + $filesize) > $disk_quota){ |
| |
my $msg = '<span class="LC_error">'. |
| |
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'. |
| |
'<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage); |
| |
return ('will_exceed_quota',$msg); |
| |
} elsif ($found_file) { |
| |
if ($locked_file) { |
| |
my $msg = '<span class="LC_error">'; |
| |
$msg .= &mt('Unable to upload [_1]. A locked file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>','<span class="LC_filename">'.$port_path.$env{'form.currentpath'}.'</span>'); |
| |
$msg .= '</span><br />'; |
| |
$msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>'); |
| |
return ('file_locked',$msg); |
| |
} else { |
| |
my $msg = '<span class="LC_error">'; |
| |
$msg .= &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'}); |
| |
$msg .= '</span>'; |
| |
$msg .= '<br />'; |
| |
$msg .= &mt('To upload, rename or delete existing [_1] in [_2].','<span class="LC_filename">'.$fname.'</span>', $port_path.$env{'form.currentpath'}); |
| |
return ('file_exists',$msg); |
| |
} |
| |
} |
| |
} |
| |
|
| |
|
| =pod |
=pod |
| |
|
|
Line 7178 Apache Request ref, $records is an array
|
Line 7647 Apache Request ref, $records is an array
|
| ###################################################### |
###################################################### |
| sub csv_print_samples { |
sub csv_print_samples { |
| my ($r,$records) = @_; |
my ($r,$records) = @_; |
| my $samples = &get_samples($records,3); |
my $samples = &get_samples($records,5); |
| |
|
| $r->print(&mt('Samples').'<br />'.&start_data_table(). |
$r->print(&mt('Samples').'<br />'.&start_data_table(). |
| &start_data_table_header_row()); |
&start_data_table_header_row()); |
|
Line 7225 sub csv_print_select_table {
|
Line 7694 sub csv_print_select_table {
|
| &end_data_table_header_row()."\n"); |
&end_data_table_header_row()."\n"); |
| foreach my $array_ref (@$d) { |
foreach my $array_ref (@$d) { |
| my ($value,$display,$defaultcol)=@{ $array_ref }; |
my ($value,$display,$defaultcol)=@{ $array_ref }; |
| $r->print(&start_data_table_row().'<tr><td>'.$display.'</td>'); |
$r->print(&start_data_table_row().'<td>'.$display.'</td>'); |
| |
|
| $r->print('<td><select name=f'.$i. |
$r->print('<td><select name=f'.$i. |
| ' onchange="javascript:flip(this.form,'.$i.');">'); |
' onchange="javascript:flip(this.form,'.$i.');">'); |
|
Line 7233 sub csv_print_select_table {
|
Line 7702 sub csv_print_select_table {
|
| foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<option value="'.$sample.'"'. |
$r->print('<option value="'.$sample.'"'. |
| ($sample eq $defaultcol ? ' selected="selected" ' : ''). |
($sample eq $defaultcol ? ' selected="selected" ' : ''). |
| '>Column '.($sample+1).'</option>'); |
'>'.&mt('Column [_1]',($sample+1)).'</option>'); |
| } |
} |
| $r->print('</select></td>'.&end_data_table_row()."\n"); |
$r->print('</select></td>'.&end_data_table_row()."\n"); |
| $i++; |
$i++; |
|
Line 7264 sub csv_samples_select_table {
|
Line 7733 sub csv_samples_select_table {
|
| my ($r,$records,$d) = @_; |
my ($r,$records,$d) = @_; |
| my $i=0; |
my $i=0; |
| # |
# |
| my $samples = &get_samples($records,3); |
my $max_samples = 5; |
| |
my $samples = &get_samples($records,$max_samples); |
| $r->print(&start_data_table(). |
$r->print(&start_data_table(). |
| &start_data_table_header_row().'<th>'. |
&start_data_table_header_row().'<th>'. |
| &mt('Field').'</th><th>'.&mt('Samples').'</th>'. |
&mt('Field').'</th><th>'.&mt('Samples').'</th>'. |
|
Line 7280 sub csv_samples_select_table {
|
Line 7750 sub csv_samples_select_table {
|
| $display.'</option>'); |
$display.'</option>'); |
| } |
} |
| $r->print('</select></td><td>'); |
$r->print('</select></td><td>'); |
| foreach my $line (0..2) { |
foreach my $line (0..($max_samples-1)) { |
| if (defined($samples->[$line]{$key})) { |
if (defined($samples->[$line]{$key})) { |
| $r->print($samples->[$line]{$key}."<br />\n"); |
$r->print($samples->[$line]{$key}."<br />\n"); |
| } |
} |
|
Line 7891 defdom (domain for which to retrieve con
|
Line 8361 defdom (domain for which to retrieve con
|
| origmail (scalar - email address of recipient from loncapa.conf, |
origmail (scalar - email address of recipient from loncapa.conf, |
| i.e., predates configuration by DC via domainprefs.pm |
i.e., predates configuration by DC via domainprefs.pm |
| |
|
| Returns: comma separated list of addresses to which to send e-mail. |
Returns: comma separated list of addresses to which to send e-mail. |
| |
|
| |
=back |
| |
|
| =cut |
=cut |
| |
|
|
Line 7919 sub build_recipient_list {
|
Line 8391 sub build_recipient_list {
|
| } elsif ($origmail ne '') { |
} elsif ($origmail ne '') { |
| push(@recipients,$origmail); |
push(@recipients,$origmail); |
| } |
} |
| if ($defmail ne '') { |
if (defined($defmail)) { |
| push(@recipients,$defmail); |
if ($defmail ne '') { |
| |
push(@recipients,$defmail); |
| |
} |
| } |
} |
| if ($otheremails) { |
if ($otheremails) { |
| my @others; |
my @others; |
|
Line 7942 sub build_recipient_list {
|
Line 8416 sub build_recipient_list {
|
| ############################################################ |
############################################################ |
| ############################################################ |
############################################################ |
| |
|
| |
=pod |
| |
|
| |
=head1 Course Catalog Routines |
| |
|
| |
=over 4 |
| |
|
| |
=item * &gather_categories() |
| |
|
| |
Converts category definitions - keys of categories hash stored in |
| |
coursecategories in configuration.db on the primary library server in a |
| |
domain - to an array. Also generates javascript and idx hash used to |
| |
generate Domain Coordinator interface for editing Course Categories. |
| |
|
| |
Inputs: |
| |
|
| |
categories (reference to hash of category definitions). |
| |
|
| |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories). |
| |
|
| |
idx (reference to hash of counters used in Domain Coordinator interface for |
| |
editing Course Categories). |
| |
|
| |
jsarray (reference to array of categories used to create Javascript arrays for |
| |
Domain Coordinator interface for editing Course Categories). |
| |
|
| |
Returns: nothing |
| |
|
| |
Side effects: populates cats, idx and jsarray. |
| |
|
| |
=cut |
| |
|
| |
sub gather_categories { |
| |
my ($categories,$cats,$idx,$jsarray) = @_; |
| |
my %counters; |
| |
my $num = 0; |
| |
foreach my $item (keys(%{$categories})) { |
| |
my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item); |
| |
if ($container eq '' && $depth == 0) { |
| |
$cats->[$depth][$categories->{$item}] = $cat; |
| |
} else { |
| |
$cats->[$depth]{$container}[$categories->{$item}] = $cat; |
| |
} |
| |
my ($escitem,$tail) = split(/:/,$item,2); |
| |
if ($counters{$tail} eq '') { |
| |
$counters{$tail} = $num; |
| |
$num ++; |
| |
} |
| |
if (ref($idx) eq 'HASH') { |
| |
$idx->{$item} = $counters{$tail}; |
| |
} |
| |
if (ref($jsarray) eq 'ARRAY') { |
| |
push(@{$jsarray->[$counters{$tail}]},$item); |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item * &extract_categories() |
| |
|
| |
Used to generate breadcrumb trails for course categories. |
| |
|
| |
Inputs: |
| |
|
| |
categories (reference to hash of category definitions). |
| |
|
| |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories). |
| |
|
| |
trails (reference to array of breacrumb trails for each category). |
| |
|
| |
allitems (reference to hash - key is category key |
| |
(format: escaped(name):escaped(parent category):depth in hierarchy). |
| |
|
| |
idx (reference to hash of counters used in Domain Coordinator interface for |
| |
editing Course Categories). |
| |
|
| |
jsarray (reference to array of categories used to create Javascript arrays for |
| |
Domain Coordinator interface for editing Course Categories). |
| |
|
| |
subcats (reference to hash of arrays containing all subcategories within each |
| |
category, -recursive) |
| |
|
| |
Returns: nothing |
| |
|
| |
Side effects: populates trails and allitems hash references. |
| |
|
| |
=cut |
| |
|
| |
sub extract_categories { |
| |
my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_; |
| |
if (ref($categories) eq 'HASH') { |
| |
&gather_categories($categories,$cats,$idx,$jsarray); |
| |
if (ref($cats->[0]) eq 'ARRAY') { |
| |
for (my $i=0; $i<@{$cats->[0]}; $i++) { |
| |
my $name = $cats->[0][$i]; |
| |
my $item = &escape($name).'::0'; |
| |
my $trailstr; |
| |
if ($name eq 'instcode') { |
| |
$trailstr = &mt('Official courses (with institutional codes)'); |
| |
} else { |
| |
$trailstr = $name; |
| |
} |
| |
if ($allitems->{$item} eq '') { |
| |
push(@{$trails},$trailstr); |
| |
$allitems->{$item} = scalar(@{$trails})-1; |
| |
} |
| |
my @parents = ($name); |
| |
if (ref($cats->[1]{$name}) eq 'ARRAY') { |
| |
for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) { |
| |
my $category = $cats->[1]{$name}[$j]; |
| |
if (ref($subcats) eq 'HASH') { |
| |
push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1'); |
| |
} |
| |
&recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats); |
| |
} |
| |
} else { |
| |
if (ref($subcats) eq 'HASH') { |
| |
$subcats->{$item} = []; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item *&recurse_categories() |
| |
|
| |
Recursively used to generate breadcrumb trails for course categories. |
| |
|
| |
Inputs: |
| |
|
| |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories). |
| |
|
| |
depth (current depth in hierarchy of categories and sub-categories - 0 indexed). |
| |
|
| |
category (current course category, for which breadcrumb trail is being generated). |
| |
|
| |
trails (reference to array of breadcrumb trails for each category). |
| |
|
| |
allitems (reference to hash - key is category key |
| |
(format: escaped(name):escaped(parent category):depth in hierarchy). |
| |
|
| |
parents (array containing containers directories for current category, |
| |
back to top level). |
| |
|
| |
Returns: nothing |
| |
|
| |
Side effects: populates trails and allitems hash references |
| |
|
| |
=cut |
| |
|
| |
sub recurse_categories { |
| |
my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_; |
| |
my $shallower = $depth - 1; |
| |
if (ref($cats->[$depth]{$category}) eq 'ARRAY') { |
| |
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
| |
my $name = $cats->[$depth]{$category}[$k]; |
| |
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
| |
my $trailstr = join(' -> ',(@{$parents},$category)); |
| |
if ($allitems->{$item} eq '') { |
| |
push(@{$trails},$trailstr); |
| |
$allitems->{$item} = scalar(@{$trails})-1; |
| |
} |
| |
my $deeper = $depth+1; |
| |
push(@{$parents},$category); |
| |
if (ref($subcats) eq 'HASH') { |
| |
my $subcat = &escape($name).':'.$category.':'.$depth; |
| |
for (my $j=@{$parents}; $j>=0; $j--) { |
| |
my $higher; |
| |
if ($j > 0) { |
| |
$higher = &escape($parents->[$j]).':'. |
| |
&escape($parents->[$j-1]).':'.$j; |
| |
} else { |
| |
$higher = &escape($parents->[$j]).'::'.$j; |
| |
} |
| |
push(@{$subcats->{$higher}},$subcat); |
| |
} |
| |
} |
| |
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents, |
| |
$subcats); |
| |
pop(@{$parents}); |
| |
} |
| |
} else { |
| |
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
| |
my $trailstr = join(' -> ',(@{$parents},$category)); |
| |
if ($allitems->{$item} eq '') { |
| |
push(@{$trails},$trailstr); |
| |
$allitems->{$item} = scalar(@{$trails})-1; |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item *&assign_categories_table() |
| |
|
| |
Create a datatable for display of hierarchical categories in a domain, |
| |
with checkboxes to allow a course to be categorized. |
| |
|
| |
Inputs: |
| |
|
| |
cathash - reference to hash of categories defined for the domain (from |
| |
configuration.db) |
| |
|
| |
currcat - scalar with an & separated list of categories assigned to a course. |
| |
|
| |
Returns: $output (markup to be displayed) |
| |
|
| |
=cut |
| |
|
| |
sub assign_categories_table { |
| |
my ($cathash,$currcat) = @_; |
| |
my $output; |
| |
if (ref($cathash) eq 'HASH') { |
| |
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); |
| |
&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray); |
| |
$maxdepth = scalar(@cats); |
| |
if (@cats > 0) { |
| |
my $itemcount = 0; |
| |
if (ref($cats[0]) eq 'ARRAY') { |
| |
$output = &Apache::loncommon::start_data_table(); |
| |
my @currcategories; |
| |
if ($currcat ne '') { |
| |
@currcategories = split('&',$currcat); |
| |
} |
| |
for (my $i=0; $i<@{$cats[0]}; $i++) { |
| |
my $parent = $cats[0][$i]; |
| |
my $css_class = $itemcount%2?' class="LC_odd_row"':''; |
| |
next if ($parent eq 'instcode'); |
| |
my $item = &escape($parent).'::0'; |
| |
my $checked = ''; |
| |
if (@currcategories > 0) { |
| |
if (grep(/^\Q$item\E$/,@currcategories)) { |
| |
$checked = ' checked="checked" '; |
| |
} |
| |
} |
| |
$output .= '<tr '.$css_class.'><td><span class="LC_nobreak">'. |
| |
'<input type="checkbox" name="usecategory" value="'. |
| |
$item.'"'.$checked.' />'.$parent.'</span>'. |
| |
'<input type="hidden" name="catname" value="'.$parent.'" /></td>'; |
| |
my $depth = 1; |
| |
push(@path,$parent); |
| |
$output .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories); |
| |
pop(@path); |
| |
$output .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>'; |
| |
$itemcount ++; |
| |
} |
| |
$output .= &Apache::loncommon::end_data_table(); |
| |
} |
| |
} |
| |
} |
| |
return $output; |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item *&assign_category_rows() |
| |
|
| |
Create a datatable row for display of nested categories in a domain, |
| |
with checkboxes to allow a course to be categorized,called recursively. |
| |
|
| |
Inputs: |
| |
|
| |
itemcount - track row number for alternating colors |
| |
|
| |
cats - reference to array of arrays/hashes which encapsulates hierarchy of |
| |
categories and subcategories. |
| |
|
| |
depth - current depth in hierarchy of categories and sub-categories - 0 indexed. |
| |
|
| |
parent - parent of current category item |
| |
|
| |
path - Array containing all categories back up through the hierarchy from the |
| |
current category to the top level. |
| |
|
| |
currcategories - reference to array of current categories assigned to the course |
| |
|
| |
Returns: $output (markup to be displayed). |
| |
|
| |
=cut |
| |
|
| |
sub assign_category_rows { |
| |
my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_; |
| |
my ($text,$name,$item,$chgstr); |
| |
if (ref($cats) eq 'ARRAY') { |
| |
my $maxdepth = scalar(@{$cats}); |
| |
if (ref($cats->[$depth]) eq 'HASH') { |
| |
if (ref($cats->[$depth]{$parent}) eq 'ARRAY') { |
| |
my $numchildren = @{$cats->[$depth]{$parent}}; |
| |
my $css_class = $itemcount%2?' class="LC_odd_row"':''; |
| |
$text .= '<td><table class="LC_datatable">'; |
| |
for (my $j=0; $j<$numchildren; $j++) { |
| |
$name = $cats->[$depth]{$parent}[$j]; |
| |
$item = &escape($name).':'.&escape($parent).':'.$depth; |
| |
my $deeper = $depth+1; |
| |
my $checked = ''; |
| |
if (ref($currcategories) eq 'ARRAY') { |
| |
if (@{$currcategories} > 0) { |
| |
if (grep(/^\Q$item\E$/,@{$currcategories})) { |
| |
$checked = ' checked="checked" '; |
| |
} |
| |
} |
| |
} |
| |
$text .= '<tr><td><span class="LC_nobreak"><label>'. |
| |
'<input type="checkbox" name="usecategory" value="'. |
| |
$item.'"'.$checked.' />'.$name.'</label></span>'. |
| |
'<input type="hidden" name="catname" value="'.$name.'" />'. |
| |
'</td><td>'; |
| |
if (ref($path) eq 'ARRAY') { |
| |
push(@{$path},$name); |
| |
$text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories); |
| |
pop(@{$path}); |
| |
} |
| |
$text .= '</td></tr>'; |
| |
} |
| |
$text .= '</table></td>'; |
| |
} |
| |
} |
| |
} |
| |
return $text; |
| |
} |
| |
|
| |
############################################################ |
| |
############################################################ |
| |
|
| |
|
| sub commit_customrole { |
sub commit_customrole { |
| my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_; |
my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_; |
| my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url. |
my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url. |
| ($start?', '.&mt('starting').' '.localtime($start):''). |
($start?', '.&mt('starting').' '.localtime($start):''). |
| ($end?', ending '.localtime($end):'').': <b>'. |
($end?', ending '.localtime($end):'').': <b>'. |
| &Apache::lonnet::assigncustomrole( |
&Apache::lonnet::assigncustomrole( |
| $udom,$uname,$url,$three,$four,$five,$end,$start). |
$udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context). |
| '</b><br />'; |
'</b><br />'; |
| return $output; |
return $output; |
| } |
} |
|
Line 7983 sub commit_standardrole {
|
Line 8791 sub commit_standardrole {
|
| $output = &mt('Assigning').' '.$three.' in '.$url. |
$output = &mt('Assigning').' '.$three.' in '.$url. |
| ($start?', '.&mt('starting').' '.localtime($start):''). |
($start?', '.&mt('starting').' '.localtime($start):''). |
| ($end?', '.&mt('ending').' '.localtime($end):'').': '; |
($end?', '.&mt('ending').' '.localtime($end):'').': '; |
| my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start); |
my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context); |
| if ($context eq 'auto') { |
if ($context eq 'auto') { |
| $output .= $result.$linefeed; |
$output .= $result.$linefeed; |
| } else { |
} else { |
|
Line 8018 sub commit_studentrole {
|
Line 8826 sub commit_studentrole {
|
| } |
} |
| $oldsecurl = $uurl; |
$oldsecurl = $uurl; |
| $expire_role_result = |
$expire_role_result = |
| &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now); |
&Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context); |
| if ($env{'request.course.sec'} ne '') { |
if ($env{'request.course.sec'} ne '') { |
| if ($expire_role_result eq 'refused') { |
if ($expire_role_result eq 'refused') { |
| my @roles = ('st'); |
my @roles = ('st'); |
|
Line 8041 sub commit_studentrole {
|
Line 8849 sub commit_studentrole {
|
| } |
} |
| } |
} |
| if (($expire_role_result eq 'ok') || ($secchange == 0)) { |
if (($expire_role_result eq 'ok') || ($secchange == 0)) { |
| $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid); |
$modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context); |
| if ($modify_section_result =~ /^ok/) { |
if ($modify_section_result =~ /^ok/) { |
| if ($secchange == 1) { |
if ($secchange == 1) { |
| if ($sec eq '') { |
if ($sec eq '') { |
|
Line 8450 sub construct_course {
|
Line 9258 sub construct_course {
|
| $outcome .= ($fatal?$errtext:'read ok').' - '; |
$outcome .= ($fatal?$errtext:'read ok').' - '; |
| my $title; my $url; |
my $title; my $url; |
| if ($args->{'firstres'} eq 'syl') { |
if ($args->{'firstres'} eq 'syl') { |
| $title='Syllabus'; |
$title=&mt('Syllabus'); |
| $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus'; |
$url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus'; |
| } else { |
} else { |
| $title='Navigate Contents'; |
$title=&mt('Navigate Contents'); |
| $url='/adm/navmaps'; |
$url='/adm/navmaps'; |
| } |
} |
| |
|
|
Line 8507 sub icon {
|
Line 9315 sub icon {
|
| return &lonhttpdurl($iconname); |
return &lonhttpdurl($iconname); |
| } |
} |
| |
|
| sub lonhttpd_port { |
|
| my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
|
| if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; } |
|
| # IE doesn't like a secure page getting images from a non-secure |
|
| # port (when logging we haven't parsed the browser type so default |
|
| # back to secure |
|
| if ((!exists($env{'browser.type'}) || $env{'browser.type'} eq 'explorer') |
|
| && $ENV{'SERVER_PORT'} == 443) { |
|
| return 443; |
|
| } |
|
| return $lonhttpd_port; |
|
| |
|
| } |
|
| |
|
| sub lonhttpdurl { |
sub lonhttpdurl { |
| |
# |
| |
# Had been used for "small fry" static images on separate port 8080. |
| |
# Modify here if lightweight http functionality desired again. |
| |
# Currently eliminated due to increasing firewall issues. |
| |
# |
| my ($url)=@_; |
my ($url)=@_; |
| |
return $url; |
| my $lonhttpd_port = &lonhttpd_port(); |
|
| if ($lonhttpd_port == 443) { |
|
| return 'https://'.$ENV{'SERVER_NAME'}.$url; |
|
| } |
|
| return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url; |
|
| } |
} |
| |
|
| sub connection_aborted { |
sub connection_aborted { |
|
Line 8606 sub init_user_environment {
|
Line 9400 sub init_user_environment {
|
| } |
} |
| # Give them a new cookie |
# Give them a new cookie |
| my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'} |
my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'} |
| : $now); |
: $now.$$.int(rand(10000))); |
| $cookie="$username\_$id\_$domain\_$authhost"; |
$cookie="$username\_$id\_$domain\_$authhost"; |
| |
|
| # Initialize roles |
# Initialize roles |
|
Line 8694 sub init_user_environment {
|
Line 9488 sub init_user_environment {
|
| } |
} |
| } |
} |
| |
|
| |
foreach my $tool ('aboutme','blog','portfolio') { |
| |
$userenv{'availabletools.'.$tool} = |
| |
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload'); |
| |
} |
| |
|
| $env{'user.environment'} = "$lonids/$cookie.id"; |
$env{'user.environment'} = "$lonids/$cookie.id"; |
| |
|
| if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", |
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", |
|
Line 8721 sub init_user_environment {
|
Line 9520 sub init_user_environment {
|
| |
|
| sub _add_to_env { |
sub _add_to_env { |
| my ($idf,$env_data,$prefix) = @_; |
my ($idf,$env_data,$prefix) = @_; |
| while (my ($key,$value) = each(%$env_data)) { |
if (ref($env_data) eq 'HASH') { |
| $idf->{$prefix.$key} = $value; |
while (my ($key,$value) = each(%$env_data)) { |
| $env{$prefix.$key} = $value; |
$idf->{$prefix.$key} = $value; |
| |
$env{$prefix.$key} = $value; |
| |
} |
| |
} |
| |
} |
| |
|
| |
# --- Get the symbolic name of a problem and the url |
| |
sub get_symb { |
| |
my ($request,$silent) = @_; |
| |
(my $url=$env{'form.url'}) =~ s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; |
| |
my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url))); |
| |
if ($symb eq '') { |
| |
if (!$silent) { |
| |
$request->print("Unable to handle ambiguous references:$url:."); |
| |
return (); |
| |
} |
| } |
} |
| |
&Apache::lonenc::check_decrypt(\$symb); |
| |
return ($symb); |
| } |
} |
| |
|
| |
# --------------------------------------------------------------Get annotation |
| |
|
| |
sub get_annotation { |
| |
my ($symb,$enc) = @_; |
| |
|
| |
my $key = $symb; |
| |
if (!$enc) { |
| |
$key = |
| |
&Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]); |
| |
} |
| |
my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]); |
| |
return $annotation{$key}; |
| |
} |
| |
|
| |
sub clean_symb { |
| |
my ($symb) = @_; |
| |
|
| |
&Apache::lonenc::check_decrypt(\$symb); |
| |
my $enc = $env{'request.enc'}; |
| |
delete($env{'request.enc'}); |
| |
|
| |
return ($symb,$enc); |
| |
} |
| |
|
| =pod |
=pod |
| |
|
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface