|
version 1.661, 2008/06/16 23:34:12
|
version 1.690, 2008/10/02 15:38:56
|
|
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(); |
|
Line 68 use Apache::lontexconvert();
|
Line 69 use Apache::lontexconvert();
|
| use Apache::lonclonecourse(); |
use Apache::lonclonecourse(); |
| use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
| use DateTime::TimeZone; |
use DateTime::TimeZone; |
| |
use DateTime::Locale::Catalog; |
| |
|
| # ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
| use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
|
Line 657 sub select_timezone {
|
Line 659 sub select_timezone {
|
| return $output; |
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 = &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 |
| |
|
| =item * &linked_select_forms(...) |
=item * &linked_select_forms(...) |
|
Line 878 sub help_open_topic {
|
Line 931 sub help_open_topic {
|
| |
|
| # 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 |
|
Line 904 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 913 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 1502 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 2982 sub preferred_languages {
|
Line 3040 sub preferred_languages {
|
| } |
} |
| } |
} |
| } |
} |
| |
return &get_genlanguages(@languages); |
| |
} |
| |
|
| |
sub get_genlanguages { |
| |
my (@languages) = @_; |
| # turn "en-ca" into "en-ca,en" |
# turn "en-ca" into "en-ca,en" |
| my @genlanguages; |
my @genlanguages; |
| foreach my $lang (@languages) { |
foreach my $lang (@languages) { |
| unless ($lang=~/\w/) { next; } |
unless ($lang=~/\w/) { next; } |
| push(@genlanguages,$lang); |
push(@genlanguages,$lang); |
| if ($lang=~/(\-|\_)/) { |
if ($lang=~/(\-|\_)/) { |
| push(@genlanguages,(split(/(\-|\_)/,$lang))[0]); |
push(@genlanguages,(split(/(\-|\_)/,$lang))[0]); |
| } |
} |
| } |
} |
| #uniqueify the languages list |
#uniqueify the languages list |
| my %count; |
my %count; |
|
Line 3343 sub pprmlink {
|
Line 3406 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 3362 sub utc_string {
|
Line 3430 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 3742 sub blocking_status {
|
Line 3828 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 4488 table.LC_docs_path td.LC_docs_path_compo
|
Line 4628 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 4502 table#LC_mainmenu td.LC_mainmenu_column
|
Line 4641 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 4569 td.LC_menubuttons_img {
|
Line 4708 td.LC_menubuttons_img {
|
| text-align: right; |
text-align: right; |
| } |
} |
| |
|
| |
.LC_roleslog_note { |
| |
font-size: smaller; |
| |
} |
| |
|
| table.LC_aboutme_port { |
table.LC_aboutme_port { |
| border: 0px; |
border: 0px; |
| border-collapse: collapse; |
border-collapse: collapse; |
|
Line 5351 hr.LC_edit_problem_divide {
|
Line 5494 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; |
| |
|
| |
} |
| END |
END |
| } |
} |
| |
|
|
Line 6799 sub instrule_disallow_msg {
|
Line 6968 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 6834 sub sorted_inst_types {
|
Line 7007 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 6847 sub sorted_inst_types {
|
Line 7020 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 7238 sub check_for_upload {
|
Line 7408 sub check_for_upload {
|
| } |
} |
| } |
} |
| } |
} |
| my $getpropath = 1; |
|
| if (($current_disk_usage + $filesize) > $disk_quota){ |
if (($current_disk_usage + $filesize) > $disk_quota){ |
| my $msg = '<span class="LC_error">'. |
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>'. |
&mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'. |
|
Line 7491 Apache Request ref, $records is an array
|
Line 7660 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 7538 sub csv_print_select_table {
|
Line 7707 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 7546 sub csv_print_select_table {
|
Line 7715 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 7577 sub csv_samples_select_table {
|
Line 7746 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 7593 sub csv_samples_select_table {
|
Line 7763 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 8234 sub build_recipient_list {
|
Line 8404 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 8271 domain - to an array. Also generates ja
|
Line 8443 domain - to an array. Also generates ja
|
| generate Domain Coordinator interface for editing Course Categories. |
generate Domain Coordinator interface for editing Course Categories. |
| |
|
| Inputs: |
Inputs: |
| |
|
| categories (reference to hash of category definitions). |
categories (reference to hash of category definitions). |
| |
|
| cats (reference to array of arrays/hashes which encapsulates hierarchy of |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| categories and subcategories). |
categories and subcategories). |
| |
|
| idx (reference to hash of counters used in Domain Coordinator interface for |
idx (reference to hash of counters used in Domain Coordinator interface for |
| editing Course Categories). |
editing Course Categories). |
| |
|
| jsarray (reference to array of categories used to create Javascript arrays for |
jsarray (reference to array of categories used to create Javascript arrays for |
| Domain Coordinator interface for editing Course Categories). |
Domain Coordinator interface for editing Course Categories). |
| |
|
|
Line 8318 sub gather_categories {
|
Line 8494 sub gather_categories {
|
| Used to generate breadcrumb trails for course categories. |
Used to generate breadcrumb trails for course categories. |
| |
|
| Inputs: |
Inputs: |
| |
|
| categories (reference to hash of category definitions). |
categories (reference to hash of category definitions). |
| |
|
| cats (reference to array of arrays/hashes which encapsulates hierarchy of |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| categories and subcategories). |
categories and subcategories). |
| |
|
| trails (reference to array of breacrumb trails for each category). |
trails (reference to array of breacrumb trails for each category). |
| |
|
| allitems (reference to hash - key is category key |
allitems (reference to hash - key is category key |
| (format: escaped(name):escaped(parent category):depth in hierarchy). |
(format: escaped(name):escaped(parent category):depth in hierarchy). |
| |
|
| idx (reference to hash of counters used in Domain Coordinator interface for |
idx (reference to hash of counters used in Domain Coordinator interface for |
| editing Course Categories). |
editing Course Categories). |
| |
|
| jsarray (reference to array of categories used to create Javascript arrays for |
jsarray (reference to array of categories used to create Javascript arrays for |
| Domain Coordinator interface for editing Course Categories). |
Domain Coordinator interface for editing Course Categories). |
| |
|
| |
subcats (reference to hash of arrays containing all subcategories within each |
| |
category, -recursive) |
| |
|
| Returns: nothing |
Returns: nothing |
| |
|
| Side effects: populates trails and allitems hash references. |
Side effects: populates trails and allitems hash references. |
|
Line 8336 Side effects: populates trails and allit
|
Line 8521 Side effects: populates trails and allit
|
| =cut |
=cut |
| |
|
| sub extract_categories { |
sub extract_categories { |
| my ($categories,$cats,$trails,$allitems,$idx,$jsarray) = @_; |
my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_; |
| if (ref($categories) eq 'HASH') { |
if (ref($categories) eq 'HASH') { |
| &gather_categories($categories,$cats,$idx,$jsarray); |
&gather_categories($categories,$cats,$idx,$jsarray); |
| if (ref($cats->[0]) eq 'ARRAY') { |
if (ref($cats->[0]) eq 'ARRAY') { |
|
Line 8357 sub extract_categories {
|
Line 8542 sub extract_categories {
|
| if (ref($cats->[1]{$name}) eq 'ARRAY') { |
if (ref($cats->[1]{$name}) eq 'ARRAY') { |
| for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) { |
for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) { |
| my $category = $cats->[1]{$name}[$j]; |
my $category = $cats->[1]{$name}[$j]; |
| &recurse_categories($cats,2,$category,$trails,$allitems,\@parents); |
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} = []; |
| } |
} |
| } |
} |
| } |
} |
|
Line 8373 sub extract_categories {
|
Line 8565 sub extract_categories {
|
| Recursively used to generate breadcrumb trails for course categories. |
Recursively used to generate breadcrumb trails for course categories. |
| |
|
| Inputs: |
Inputs: |
| |
|
| cats (reference to array of arrays/hashes which encapsulates hierarchy of |
cats (reference to array of arrays/hashes which encapsulates hierarchy of |
| categories and subcategories). |
categories and subcategories). |
| |
|
| depth (current depth in hierarchy of categories and sub-categories - 0 indexed). |
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 breacrumb trails for each category). |
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 |
allitems (reference to hash - key is category key |
| (format: escaped(name):escaped(parent category):depth in hierarchy). |
(format: escaped(name):escaped(parent category):depth in hierarchy). |
| |
|
| parents (array containing containers directories for current category, |
parents (array containing containers directories for current category, |
| back to top level). |
back to top level). |
| |
|
|
Line 8387 Returns: nothing
|
Line 8585 Returns: nothing
|
| |
|
| Side effects: populates trails and allitems hash references |
Side effects: populates trails and allitems hash references |
| |
|
| =back |
|
| |
|
| =cut |
=cut |
| |
|
| sub recurse_categories { |
sub recurse_categories { |
| my ($cats,$depth,$category,$trails,$allitems,$parents) = @_; |
my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_; |
| my $shallower = $depth - 1; |
my $shallower = $depth - 1; |
| if (ref($cats->[$depth]{$category}) eq 'ARRAY') { |
if (ref($cats->[$depth]{$category}) eq 'ARRAY') { |
| for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
|
Line 8405 sub recurse_categories {
|
Line 8601 sub recurse_categories {
|
| } |
} |
| my $deeper = $depth+1; |
my $deeper = $depth+1; |
| push(@{$parents},$category); |
push(@{$parents},$category); |
| &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents); |
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}); |
pop(@{$parents}); |
| } |
} |
| } else { |
} else { |
|
Line 8419 sub recurse_categories {
|
Line 8629 sub recurse_categories {
|
| return; |
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 8931 sub construct_course {
|
Line 9271 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 9087 sub init_user_environment {
|
Line 9427 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 9202 sub init_user_environment {
|
Line 9542 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