|
version 1.284, 2005/11/08 03:12:35
|
version 1.303, 2006/02/18 01:27:07
|
|
Line 331 sub storeresurl {
|
Line 331 sub storeresurl {
|
| sub studentbrowser_javascript { |
sub studentbrowser_javascript { |
| unless ( |
unless ( |
| (($env{'request.course.id'}) && |
(($env{'request.course.id'}) && |
| (&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) |
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}) |
| |
|| &Apache::lonnet::allowed('srm',$env{'request.course.id'}. |
| |
'/'.$env{'request.course.sec'}) |
| |
)) |
| || ($env{'request.role'}=~/^(au|dc|su)/) |
|| ($env{'request.role'}=~/^(au|dc|su)/) |
| ) { return ''; } |
) { return ''; } |
| return (<<'ENDSTDBRW'); |
return (<<'ENDSTDBRW'); |
|
Line 362 ENDSTDBRW
|
Line 365 ENDSTDBRW
|
| sub selectstudent_link { |
sub selectstudent_link { |
| my ($form,$unameele,$udomele)=@_; |
my ($form,$unameele,$udomele)=@_; |
| if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
| unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { |
if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'}) |
| |
&& !&Apache::lonnet::allowed('srm',$env{'request.course.id'}. |
| |
'/'.$env{'request.course.sec'})) { |
| return ''; |
return ''; |
| } |
} |
| return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele. |
|
Line 380 sub coursebrowser_javascript {
|
Line 385 sub coursebrowser_javascript {
|
| return (<<ENDSTDBRW); |
return (<<ENDSTDBRW); |
| <script type="text/javascript" language="Javascript" > |
<script type="text/javascript" language="Javascript" > |
| var stdeditbrowser; |
var stdeditbrowser; |
| function opencrsbrowser(formname,uname,udom,desc,extra_element) { |
function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) { |
| var url = '/adm/pickcourse?'; |
var url = '/adm/pickcourse?'; |
| var filter; |
var filter; |
| if (filter != null) { |
if (filter != null) { |
|
Line 403 sub coursebrowser_javascript {
|
Line 408 sub coursebrowser_javascript {
|
| url += '&domainfilter='+extra_element; |
url += '&domainfilter='+extra_element; |
| } |
} |
| } |
} |
| |
if (multflag !=null && multflag != '') { |
| |
url += '&multiple='+multflag; |
| |
} |
| var title = 'Course_Browser'; |
var title = 'Course_Browser'; |
| var options = 'scrollbars=1,resizable=1,menubar=0'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
| options += ',width=700,height=600'; |
options += ',width=700,height=600'; |
|
Line 414 ENDSTDBRW
|
Line 422 ENDSTDBRW
|
| } |
} |
| |
|
| sub selectcourse_link { |
sub selectcourse_link { |
| my ($form,$unameele,$udomele,$desc,$extra_element)=@_; |
my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_; |
| return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele. |
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele. |
| '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>"; |
'","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&mt('Select Course')."</a>"; |
| } |
} |
| |
|
| sub check_uncheck_jscript { |
sub check_uncheck_jscript { |
|
Line 1149 sub domain_select {
|
Line 1157 sub domain_select {
|
| } &get_domains; |
} &get_domains; |
| if ($multiple) { |
if ($multiple) { |
| $domains{''}=&mt('Any domain'); |
$domains{''}=&mt('Any domain'); |
| return &multiple_select_form($name,$value,4,%domains); |
return &multiple_select_form($name,$value,4,\%domains); |
| } else { |
} else { |
| return &select_form($name,$value,%domains); |
return &select_form($name,$value,%domains); |
| } |
} |
|
Line 1159 sub domain_select {
|
Line 1167 sub domain_select {
|
| |
|
| =pod |
=pod |
| |
|
| =item * multiple_select_form($name,$value,$size,%hash) |
=item * multiple_select_form($name,$value,$size,$hash,$order) |
| |
|
| Returns a string containing a <select> element int multiple mode |
Returns a string containing a <select> element int multiple mode |
| |
|
|
Line 1186 sub multiple_select_form {
|
Line 1194 sub multiple_select_form {
|
| } |
} |
| } |
} |
| $output.="\n<select name='$name' size='$size' multiple='1'>"; |
$output.="\n<select name='$name' size='$size' multiple='1'>"; |
| my @order = ref($order) ? @{$order} |
my @order = ref($order) ? @$order |
| : sort(keys(%$hash)); |
: sort(keys(%$hash)); |
| foreach my $key (@order) { |
foreach my $key (@order) { |
| $output.='<option value="'.$key.'" '; |
$output.='<option value="'.$key.'" '; |
|
Line 1917 if $first is set to 'lastname' then it r
|
Line 1925 if $first is set to 'lastname' then it r
|
| |
|
| =cut |
=cut |
| |
|
| |
|
| ############################################################### |
############################################################### |
| sub plainname { |
sub plainname { |
| my ($uname,$udom,$first)=@_; |
my ($uname,$udom,$first)=@_; |
| my %names=&Apache::lonnet::get('environment', |
my %names=&getnames($uname,$udom); |
| ['firstname','middlename','lastname','generation'], |
|
| $udom,$uname); |
|
| my $name=&Apache::lonnet::format_name($names{'firstname'}, |
my $name=&Apache::lonnet::format_name($names{'firstname'}, |
| $names{'middlename'}, |
$names{'middlename'}, |
| $names{'lastname'}, |
$names{'lastname'}, |
|
Line 1953 if the user does not
|
Line 1960 if the user does not
|
| |
|
| sub nickname { |
sub nickname { |
| my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
| my %names; |
my %names=&getnames($uname,$udom); |
| if ($uname eq $env{'user.name'} && |
|
| $udom eq $env{'user.domain'}) { |
|
| %names=('nickname' => $env{'environment.nickname'} , |
|
| 'firstname' => $env{'environment.firstname'} , |
|
| 'middlename' => $env{'environment.middlename'}, |
|
| 'lastname' => $env{'environment.lastname'} , |
|
| 'generation' => $env{'environment.generation'}); |
|
| } else { |
|
| %names=&Apache::lonnet::get('environment', |
|
| ['nickname','firstname','middlename', |
|
| 'lastname','generation'],$udom,$uname); |
|
| } |
|
| my $name=$names{'nickname'}; |
my $name=$names{'nickname'}; |
| if ($name) { |
if ($name) { |
| $name='"'.$name.'"'; |
$name='"'.$name.'"'; |
|
Line 1978 sub nickname {
|
Line 1973 sub nickname {
|
| return $name; |
return $name; |
| } |
} |
| |
|
| |
sub getnames { |
| |
my ($uname,$udom)=@_; |
| |
my $id=$uname.':'.$udom; |
| |
my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id); |
| |
if ($cached) { |
| |
return %{$names}; |
| |
} else { |
| |
my %loadnames=&Apache::lonnet::get('environment', |
| |
['firstname','middlename','lastname','generation','nickname'], |
| |
$udom,$uname); |
| |
&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames); |
| |
return %loadnames; |
| |
} |
| |
} |
| |
|
| # ------------------------------------------------------------------ Screenname |
# ------------------------------------------------------------------ Screenname |
| |
|
|
Line 2774 sub bodytag {
|
Line 2783 sub bodytag {
|
| <style type="text/css"> |
<style type="text/css"> |
| h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif } |
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif } |
| a:focus { color: red; background: yellow } |
a:focus { color: red; background: yellow } |
| |
table.thinborder { border-collapse: collapse; } |
| |
table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px} |
| |
form, .inline { display: inline; } |
| |
.center { text-align: center; } |
| </style> |
</style> |
| <body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
| style="margin-top: 0px;$addstyle" $addentries> |
style="margin-top: 0px;$addstyle" $addentries> |
|
Line 3076 sub get_sections {
|
Line 3089 sub get_sections {
|
| } |
} |
| |
|
| ############################################### |
############################################### |
| |
|
| |
=pod |
| |
|
| |
=item coursegroups |
| |
|
| |
Retrieve information about groups in a course, |
| |
|
| |
Input: |
| |
1. Reference to hash to populate with group information. |
| |
2. Optional course domain |
| |
3. Optional course number |
| |
4. Optional group name |
| |
|
| |
Course domain and number will be taken from user's |
| |
environment if not supplied. Optional group name will' |
| |
be passed to lonnet::get_coursegroups() as a regexp to |
| |
use in the call to the dump function. |
| |
|
| |
Output |
| |
Returns number of groups in the course (subject to the |
| |
optional group name filter). |
| |
|
| |
Side effects: |
| |
Populates the referenced curr_groups hash, with key, |
| |
value pairs. Keys are group names, corresponding values |
| |
are scalars containing group information in XML. This |
| |
can be sent to &get_group_settings() to be parsed. |
| |
|
| |
=cut |
| |
|
| |
############################################### |
| |
|
| |
sub coursegroups { |
| |
my ($curr_groups,$cdom,$cnum,$group) = @_; |
| |
my $numgroups; |
| |
if (!defined($cdom) || !defined($cnum)) { |
| |
my $cid = $env{'request.course.id'}; |
| |
$cdom = $env{'course.'.$cid.'.domain'}; |
| |
$cnum = $env{'course.'.$cid.'.num'}; |
| |
} |
| |
%{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group); |
| |
my ($tmp) = keys(%{$curr_groups}); |
| |
if ($tmp=~/^error:/) { |
| |
unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') { |
| |
&logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'. |
| |
$cdom); |
| |
} |
| |
$numgroups = 0; |
| |
} else { |
| |
$numgroups = keys(%{$curr_groups}); |
| |
} |
| |
return $numgroups; |
| |
} |
| |
|
| |
############################################### |
| |
|
| |
=pod |
| |
|
| |
=item get_group_settings |
| |
|
| |
Uses TokeParser to extract group information from the |
| |
XML used to describe course groups. |
| |
|
| |
Input: |
| |
Scalar containing XML - as retrieved from &coursegroups(). |
| |
|
| |
Output: |
| |
Hash containing group information as key=values for (a), and |
| |
hash of hashes for (b) |
| |
|
| |
Keys (in two categories): |
| |
(a) groupname, creator, creation, modified, startdate,enddate. |
| |
Corresponding values are name of the group, creator of the group |
| |
(username:domain), UNIX time for date group was created, and |
| |
settings were last modified, and default start and end access |
| |
times for group members. |
| |
|
| |
(b) functions returned in hash of hashes. |
| |
Outer hash key is functions. |
| |
Inner hash keys are chat,discussion,email,files,homepage,roster. |
| |
Corresponding values are either on or off, depending on |
| |
whether this type of functionality is available for the group. |
| |
|
| |
=cut |
| |
|
| |
############################################### |
| |
|
| |
sub get_group_settings { |
| |
my ($groupinfo)=@_; |
| |
my $parser=HTML::TokeParser->new(\$groupinfo); |
| |
my $token; |
| |
my $tool = ''; |
| |
my $role = ''; |
| |
my %content=(); |
| |
while ($token=$parser->get_token) { |
| |
if ($token->[0] eq 'S') { |
| |
my $entry=$token->[1]; |
| |
if ($entry eq 'functions' || $entry eq 'autosec') { |
| |
%{$content{$entry}} = (); |
| |
$tool = $entry; |
| |
} elsif ($entry eq 'role') { |
| |
if ($tool eq 'autosec') { |
| |
$role = $token->[2]{id}; |
| |
} |
| |
} else { |
| |
my $value=$parser->get_text('/'.$entry); |
| |
if ($entry eq 'name') { |
| |
if ($tool eq 'functions') { |
| |
my $function = $token->[2]{id}; |
| |
$content{$tool}{$function} = $value; |
| |
} |
| |
} elsif ($entry eq 'groupname') { |
| |
$content{$entry}=&Apache::lonnet::unescape($value); |
| |
} elsif (($entry eq 'roles') || ($entry eq 'types') || |
| |
($entry eq 'sectionpick') || ($entry eq 'defpriv')) { |
| |
push(@{$content{$entry}},$value); |
| |
} elsif ($entry eq 'section') { |
| |
if ($tool eq 'autosec' && $role ne '') { |
| |
push(@{$content{$tool}{$role}},$value); |
| |
} |
| |
} else { |
| |
$content{$entry}=$value; |
| |
} |
| |
} |
| |
} elsif ($token->[0] eq 'E') { |
| |
if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') { |
| |
$tool = ''; |
| |
} elsif ($token->[1] eq 'role') { |
| |
$role = ''; |
| |
} |
| |
|
| |
} |
| |
} |
| |
return %content; |
| |
} |
| |
|
| |
sub check_group_access { |
| |
my ($group) = @_; |
| |
my $access = 1; |
| |
my $now = time; |
| |
my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group}); |
| |
if (($end!=0) && ($end<$now)) { $access = 0; } |
| |
if (($start!=0) && ($start>$now)) { $access=0; } |
| |
return $access; |
| |
} |
| |
|
| |
############################################### |
| |
|
| =pod |
=pod |
| |
|
|
Line 3090 Incoming parameters:
|
Line 3250 Incoming parameters:
|
| 3. access status: users must have - either active, |
3. access status: users must have - either active, |
| previous, future, or all. |
previous, future, or all. |
| 4. reference to array of permissible roles |
4. reference to array of permissible roles |
| 5. reference to results object (hash of hashes). |
5. reference to array of section restrictions (optional) |
| |
6. reference to results object (hash of hashes). |
| |
7. reference to optional userdata hash |
| Keys of top level hash are roles. |
Keys of top level hash are roles. |
| Keys of inner hashes are username:domain, with |
Keys of inner hashes are username:domain, with |
| values set to access type. |
values set to access type. |
| |
Optional userdata hash returns an array with arguments in the |
| |
same order as loncoursedata::get_classlist() for student data. |
| |
|
| |
Entries for end, start, section and status are blank because |
| |
of the possibility of multiple values for non-student roles. |
| |
|
| =cut |
=cut |
| |
|
| ############################################### |
############################################### |
| |
|
| sub get_course_users { |
sub get_course_users { |
| my ($cdom,$cnum,$types,$roles,$users) = @_; |
my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_; |
| if (grep/^st$/,@{$roles}) { |
my %idx = (); |
| my $statusidx = &Apache::loncoursedata::CL_STATUS(); |
|
| my $startidx = &Apache::loncoursedata::CL_START(); |
$idx{udom} = &Apache::loncoursedata::CL_SDOM(); |
| my $endidx = &Apache::loncoursedata::CL_END(); |
$idx{uname} = &Apache::loncoursedata::CL_SNAME(); |
| |
$idx{end} = &Apache::loncoursedata::CL_END(); |
| |
$idx{start} = &Apache::loncoursedata::CL_START(); |
| |
$idx{id} = &Apache::loncoursedata::CL_ID(); |
| |
$idx{section} = &Apache::loncoursedata::CL_SECTION(); |
| |
$idx{fullname} = &Apache::loncoursedata::CL_FULLNAME(); |
| |
$idx{status} = &Apache::loncoursedata::CL_STATUS(); |
| |
|
| |
if (grep(/^st$/,@{$roles})) { |
| my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum); |
my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum); |
| my $now = time; |
my $now = time; |
| foreach my $student (keys(%{$classlist})) { |
foreach my $student (keys(%{$classlist})) { |
| |
my $match = 0; |
| |
if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) { |
| |
unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/, |
| |
@{$sections})) { |
| |
next; |
| |
} |
| |
} |
| if (defined($$types{'active'})) { |
if (defined($$types{'active'})) { |
| if ($$classlist{$student}[$statusidx] eq 'Active') { |
if ($$classlist{$student}[$idx{status}] eq 'Active') { |
| push(@{$$users{st}{$student}},'active'); |
push(@{$$users{st}{$student}},'active'); |
| |
$match = 1; |
| } |
} |
| } |
} |
| if (defined($$types{'previous'})) { |
if (defined($$types{'previous'})) { |
| if ($$classlist{$student}[$endidx] <= $now) { |
if ($$classlist{$student}[$idx{end}] <= $now) { |
| push(@{$$users{st}{$student}},'previous'); |
push(@{$$users{st}{$student}},'previous'); |
| |
$match = 1; |
| } |
} |
| } |
} |
| if (defined($$types{'future'})) { |
if (defined($$types{'future'})) { |
| if (($$classlist{$student}[$startidx] > $now) && ($$classlist{$student}[$endidx] > $now) || ($$classlist{$student}[$endidx] == 0) || ($$classlist{$student}[$endidx] eq '')) { |
if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) { |
| push(@{$$users{st}{$student}},'future'); |
push(@{$$users{st}{$student}},'future'); |
| |
$match = 1; |
| } |
} |
| } |
} |
| |
if ($match && defined($userdata)) { |
| |
$$userdata{$student} = $$classlist{$student}; |
| |
} |
| } |
} |
| } |
} |
| if ((@{$roles} > 0) && (@{$roles} ne "st")) { |
if ((@{$roles} > 0) && (@{$roles} ne "st")) { |
| my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum); |
my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum); |
| foreach my $person (@coursepersonnel) { |
foreach my $person (@coursepersonnel) { |
| |
my $match = 0; |
| my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/); |
my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/); |
| $user =~ s/:$//; |
$user =~ s/:$//; |
| if (($role) && (grep(/^$role$/,@{$roles}))) { |
if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) { |
| my ($uname,$udom) = split(/:/,$user); |
my ($uname,$udom,$usec) = split(/:/,$user); |
| |
if ($usec ne '' && (ref($sections) eq 'ARRAY') && |
| |
@{$sections} > 0) { |
| |
unless(grep(/^\Q$usec\E$/,@{$sections})) { |
| |
next; |
| |
} |
| |
} |
| if ($uname ne '' && $udom ne '') { |
if ($uname ne '' && $udom ne '') { |
| my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role); |
my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role); |
| foreach my $type (keys(%{$types})) { |
foreach my $type (keys(%{$types})) { |
| if ($status eq $type) { |
if ($status eq $type) { |
| $$users{$role}{$user} = $type; |
@{$$users{$role}{$user}} = $type; |
| |
$match = 1; |
| } |
} |
| } |
} |
| |
if ($match && defined($userdata) && |
| |
!exists($$userdata{$uname.':'.$udom})) { |
| |
&get_user_info($udom,$uname,\%idx,$userdata); |
| |
} |
| } |
} |
| } |
} |
| } |
} |
| if (grep/^ow$/,@{$roles}) { |
if (grep(/^ow$/,@{$roles})) { |
| if ((defined($cdom)) && (defined($cnum))) { |
if ((defined($cdom)) && (defined($cnum))) { |
| my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum); |
my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum); |
| if ( defined($csettings{'internal.courseowner'}) ) { |
if ( defined($csettings{'internal.courseowner'}) ) { |
| my $owner = $csettings{'internal.courseowner'}; |
my $owner = $csettings{'internal.courseowner'}; |
| $$users{'ow'}{$owner.':'.$cdom} = 'any'; |
@{$$users{'ow'}{$owner.':'.$cdom}} = 'any'; |
| |
if (defined($userdata) && |
| |
!exists($$userdata{$owner.':'.$cdom})) { |
| |
&get_user_info($cdom,$owner,\%idx,$userdata); |
| |
} |
| } |
} |
| } |
} |
| } |
} |
|
Line 3155 sub get_course_users {
|
Line 3359 sub get_course_users {
|
| return; |
return; |
| } |
} |
| |
|
| |
sub get_user_info { |
| |
my ($udom,$uname,$idx,$userdata) = @_; |
| |
$$userdata{$uname.':'.$udom}[$$idx{fullname}] = |
| |
&plainname($uname,$udom,'lastname'); |
| |
$$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname; |
| |
$$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom; |
| |
return; |
| |
} |
| |
|
| ############################################### |
############################################### |
| |
|
|
Line 3295 sub no_cache {
|
Line 3506 sub no_cache {
|
| |
|
| sub content_type { |
sub content_type { |
| my ($r,$type,$charset) = @_; |
my ($r,$type,$charset) = @_; |
| |
if ($r) { |
| |
# Note that printout.pl calls this with undef for $r. |
| |
&no_cache($r); |
| |
} |
| if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } |
if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; } |
| unless ($charset) { |
unless ($charset) { |
| $charset=&Apache::lonlocal::current_encoding; |
$charset=&Apache::lonlocal::current_encoding; |
|
Line 3529 sub upfile_select_html {
|
Line 3744 sub upfile_select_html {
|
| return $Str; |
return $Str; |
| } |
} |
| |
|
| |
sub get_samples { |
| |
my ($records,$toget) = @_; |
| |
my @samples=({}); |
| |
my $got=0; |
| |
foreach my $rec (@$records) { |
| |
my %temp = &record_sep($rec); |
| |
if (! grep(/\S/, values(%temp))) { next; } |
| |
if (%temp) { |
| |
$samples[$got]=\%temp; |
| |
$got++; |
| |
if ($got == $toget) { last; } |
| |
} |
| |
} |
| |
return \@samples; |
| |
} |
| |
|
| ###################################################### |
###################################################### |
| ###################################################### |
###################################################### |
| |
|
|
Line 3546 Apache Request ref, $records is an array
|
Line 3777 Apache Request ref, $records is an array
|
| ###################################################### |
###################################################### |
| sub csv_print_samples { |
sub csv_print_samples { |
| my ($r,$records) = @_; |
my ($r,$records) = @_; |
| my (%sone,%stwo,%sthree); |
my $samples = &get_samples($records,3); |
| %sone=&record_sep($$records[0]); |
|
| if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
|
| if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
|
| # |
|
| $r->print(&mt('Samples').'<br /><table border="2"><tr>'); |
$r->print(&mt('Samples').'<br /><table border="2"><tr>'); |
| foreach (sort({$a <=> $b} keys(%sone))) { |
foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); } |
$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); } |
| $r->print('</tr>'); |
$r->print('</tr>'); |
| foreach my $hash (\%sone,\%stwo,\%sthree) { |
foreach my $hash (@$samples) { |
| $r->print('<tr>'); |
$r->print('<tr>'); |
| foreach (sort({$a <=> $b} keys(%sone))) { |
foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<td>'); |
$r->print('<td>'); |
| if (defined($$hash{$_})) { $r->print($$hash{$_}); } |
if (defined($$hash{$_})) { $r->print($$hash{$_}); } |
| $r->print('</td>'); |
$r->print('</td>'); |
|
Line 3586 $d is an array of 2 element arrays (inte
|
Line 3814 $d is an array of 2 element arrays (inte
|
| ###################################################### |
###################################################### |
| sub csv_print_select_table { |
sub csv_print_select_table { |
| my ($r,$records,$d) = @_; |
my ($r,$records,$d) = @_; |
| my $i=0;my %sone; |
my $i=0; |
| %sone=&record_sep($$records[0]); |
my $samples = &get_samples($records,1); |
| $r->print(&mt('Associate columns with student attributes.')."\n". |
$r->print(&mt('Associate columns with student attributes.')."\n". |
| '<table border="2"><tr>'. |
'<table border="2"><tr>'. |
| '<th>'.&mt('Attribute').'</th>'. |
'<th>'.&mt('Attribute').'</th>'. |
|
Line 3599 sub csv_print_select_table {
|
Line 3827 sub csv_print_select_table {
|
| $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.');">'); |
| $r->print('<option value="none"></option>'); |
$r->print('<option value="none"></option>'); |
| foreach (sort({$a <=> $b} keys(%sone))) { |
foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) { |
| $r->print('<option value="'.$_.'"'. |
$r->print('<option value="'.$_.'"'. |
| ($_ eq $defaultcol ? ' selected="selected" ' : ''). |
($_ eq $defaultcol ? ' selected="selected" ' : ''). |
| '>Column '.($_+1).'</option>'); |
'>Column '.($_+1).'</option>'); |
|
Line 3630 $d is an array of 2 element arrays (inte
|
Line 3858 $d is an array of 2 element arrays (inte
|
| ###################################################### |
###################################################### |
| sub csv_samples_select_table { |
sub csv_samples_select_table { |
| my ($r,$records,$d) = @_; |
my ($r,$records,$d) = @_; |
| my %sone; my %stwo; my %sthree; |
|
| my $i=0; |
my $i=0; |
| # |
# |
| |
my $samples = &get_samples($records,3); |
| $r->print('<table border=2><tr><th>'. |
$r->print('<table border=2><tr><th>'. |
| &mt('Field').'</th><th>'.&mt('Samples').'</th></tr>'); |
&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>'); |
| %sone=&record_sep($$records[0]); |
|
| if (defined($$records[1])) {%stwo=&record_sep($$records[1]);} |
foreach my $key (sort(keys(%{ $samples->[0] }))) { |
| if (defined($$records[2])) {%sthree=&record_sep($$records[2]);} |
|
| # |
|
| foreach (sort keys %sone) { |
|
| $r->print('<tr><td><select name="f'.$i.'"'. |
$r->print('<tr><td><select name="f'.$i.'"'. |
| ' onchange="javascript:flip(this.form,'.$i.');">'); |
' onchange="javascript:flip(this.form,'.$i.');">'); |
| foreach (@$d) { |
foreach my $option (@$d) { |
| my ($value,$display,$defaultcol)=@{ $_ }; |
my ($value,$display,$defaultcol)=@{ $option }; |
| $r->print('<option value="'.$value.'"'. |
$r->print('<option value="'.$value.'"'. |
| ($i eq $defaultcol ? ' selected="selected" ':'').'>'. |
($i eq $defaultcol ? ' selected="selected" ':'').'>'. |
| $display.'</option>'); |
$display.'</option>'); |
| } |
} |
| $r->print('</select></td><td>'); |
$r->print('</select></td><td>'); |
| if (defined($sone{$_})) { $r->print($sone{$_}."<br />\n"); } |
foreach my $line (0..2) { |
| if (defined($stwo{$_})) { $r->print($stwo{$_}."<br />\n"); } |
if (defined($samples->[$line]{$key})) { |
| if (defined($sthree{$_})) { $r->print($sthree{$_}."<br />\n"); } |
$r->print($samples->[$line]{$key}."<br />\n"); |
| |
} |
| |
} |
| $r->print('</td></tr>'); |
$r->print('</td></tr>'); |
| $i++; |
$i++; |
| } |
} |
|
Line 4160 sub store_course_settings {
|
Line 4387 sub store_course_settings {
|
| # save to the environment |
# save to the environment |
| # appenv the same items, just to be safe |
# appenv the same items, just to be safe |
| my $courseid = $env{'request.course.id'}; |
my $courseid = $env{'request.course.id'}; |
| my $coursedom = $env{'course.'.$courseid.'.domain'}; |
my $udom = $env{'user.domain'}; |
| |
my $uname = $env{'user.name'}; |
| my ($prefix,$Settings) = @_; |
my ($prefix,$Settings) = @_; |
| my %SaveHash; |
my %SaveHash; |
| my %AppHash; |
my %AppHash; |
| while (my ($setting,$type) = each(%$Settings)) { |
while (my ($setting,$type) = each(%$Settings)) { |
| my $basename = 'internal.'.$prefix.'.'.$setting; |
my $basename = join('.','internal',$courseid,$prefix,$setting); |
| my $envname = 'course.'.$courseid.'.'.$basename; |
my $envname = 'environment.'.$basename; |
| if (exists($env{'form.'.$setting})) { |
if (exists($env{'form.'.$setting})) { |
| # Save this value away |
# Save this value away |
| if ($type eq 'scalar' && |
if ($type eq 'scalar' && |
|
Line 4194 sub store_course_settings {
|
Line 4422 sub store_course_settings {
|
| } |
} |
| } |
} |
| my $put_result = &Apache::lonnet::put('environment',\%SaveHash, |
my $put_result = &Apache::lonnet::put('environment',\%SaveHash, |
| $coursedom, |
$udom,$uname); |
| $env{'course.'.$courseid.'.num'}); |
|
| if ($put_result !~ /^(ok|delayed)/) { |
if ($put_result !~ /^(ok|delayed)/) { |
| &Apache::lonnet::logthis('unable to save form parameters, '. |
&Apache::lonnet::logthis('unable to save form parameters, '. |
| 'got error:'.$put_result); |
'got error:'.$put_result); |
|
Line 4210 sub restore_course_settings {
|
Line 4437 sub restore_course_settings {
|
| my ($prefix,$Settings) = @_; |
my ($prefix,$Settings) = @_; |
| while (my ($setting,$type) = each(%$Settings)) { |
while (my ($setting,$type) = each(%$Settings)) { |
| next if (exists($env{'form.'.$setting})); |
next if (exists($env{'form.'.$setting})); |
| my $envname = 'course.'.$courseid.'.internal.'.$prefix. |
my $envname = 'environment.internal.'.$courseid.'.'.$prefix. |
| '.'.$setting; |
'.'.$setting; |
| if (exists($env{$envname})) { |
if (exists($env{$envname})) { |
| if ($type eq 'scalar') { |
if ($type eq 'scalar') { |
![[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