|
version 1.929, 2007/12/05 20:06:34
|
version 1.941.2.1, 2008/03/27 12:51:56
|
|
Line 1635 sub ssi_body {
|
Line 1635 sub ssi_body {
|
| &ssi($filelink,%form)); |
&ssi($filelink,%form)); |
| $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs; |
$output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs; |
| $output=~s/^.*?\<body[^\>]*\>//si; |
$output=~s/^.*?\<body[^\>]*\>//si; |
| $output=~s/(.*)\<\/body\s*\>.*?$/$1/si; |
$output=~s/\<\/body\s*\>.*?$//si; |
| return $output; |
return $output; |
| } |
} |
| |
|
|
Line 1650 sub absolute_url {
|
Line 1650 sub absolute_url {
|
| return $protocol.$host_name; |
return $protocol.$host_name; |
| } |
} |
| |
|
| |
# |
| |
# Server side include. |
| |
# Parameters: |
| |
# fn Possibly encrypted resource name/id. |
| |
# form Hash that describes how the rendering should be done |
| |
# and other things. |
| |
# Returns: |
| |
# Scalar context: The content of the response. |
| |
# Array context: 2 element list of the content and the full response object. |
| |
# |
| sub ssi { |
sub ssi { |
| |
|
| my ($fn,%form)=@_; |
my ($fn,%form)=@_; |
| |
|
| my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
| |
|
| my $request; |
my $request; |
| |
|
| $form{'no_update_last_known'}=1; |
$form{'no_update_last_known'}=1; |
|
Line 1670 sub ssi {
|
Line 1678 sub ssi {
|
| $request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
| my $response=$ua->request($request); |
my $response=$ua->request($request); |
| |
|
| return $response->content; |
if (wantarray) { |
| |
return ($response->content, $response); |
| |
} else { |
| |
return $response->content; |
| |
} |
| } |
} |
| |
|
| sub externalssi { |
sub externalssi { |
|
Line 2200 sub flushcourselogs {
|
Line 2212 sub flushcourselogs {
|
| } |
} |
| } |
} |
| $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = { |
$courseidbuffer{$coursehombuf{$crsid}}{$crsid} = { |
| 'description' => &escape($coursedescrbuf{$crsid}), |
'description' => $coursedescrbuf{$crsid}, |
| 'inst_code' => &escape($courseinstcodebuf{$crsid}), |
'inst_code' => $courseinstcodebuf{$crsid}, |
| 'type' => &escape($coursetypebuf{$crsid}), |
'type' => $coursetypebuf{$crsid}, |
| 'owner' => &escape($courseownerbuf{$crsid}), |
'owner' => $courseownerbuf{$crsid}, |
| }; |
}; |
| } |
} |
| # |
# |
|
Line 2399 sub get_course_adv_roles {
|
Line 2411 sub get_course_adv_roles {
|
| my %coursehash=&coursedescription($cid); |
my %coursehash=&coursedescription($cid); |
| my %nothide=(); |
my %nothide=(); |
| foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { |
foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { |
| $nothide{join(':',split(/[\@\:]/,$user))}=1; |
if ($user !~ /:/) { |
| |
$nothide{join(':',split(/[\@]/,$user))}=1; |
| |
} else { |
| |
$nothide{$user}=1; |
| |
} |
| } |
} |
| my %returnhash=(); |
my %returnhash=(); |
| my %dumphash= |
my %dumphash= |
|
Line 2427 sub get_course_adv_roles {
|
Line 2443 sub get_course_adv_roles {
|
| } |
} |
| |
|
| sub get_my_roles { |
sub get_my_roles { |
| my ($uname,$udom,$context,$types,$roles,$roledoms)=@_; |
my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv)=@_; |
| unless (defined($uname)) { $uname=$env{'user.name'}; } |
unless (defined($uname)) { $uname=$env{'user.name'}; } |
| unless (defined($udom)) { $udom=$env{'user.domain'}; } |
unless (defined($udom)) { $udom=$env{'user.domain'}; } |
| my %dumphash; |
my (%dumphash,%nothide); |
| if ($context eq 'userroles') { |
if ($context eq 'userroles') { |
| %dumphash = &dump('roles',$udom,$uname); |
%dumphash = &dump('roles',$udom,$uname); |
| } else { |
} else { |
| %dumphash= |
%dumphash= |
| &dump('nohist_userroles',$udom,$uname); |
&dump('nohist_userroles',$udom,$uname); |
| |
if ($hidepriv) { |
| |
my %coursehash=&coursedescription($udom.'_'.$uname); |
| |
foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) { |
| |
if ($user !~ /:/) { |
| |
$nothide{join(':',split(/[\@]/,$user))} = 1; |
| |
} else { |
| |
$nothide{$user} = 1; |
| |
} |
| |
} |
| |
} |
| } |
} |
| my %returnhash=(); |
my %returnhash=(); |
| my $now=time; |
my $now=time; |
|
Line 2448 sub get_my_roles {
|
Line 2474 sub get_my_roles {
|
| } |
} |
| if (($tstart) && ($tstart<0)) { next; } |
if (($tstart) && ($tstart<0)) { next; } |
| my $status = 'active'; |
my $status = 'active'; |
| if (($tend) && ($tend<$now)) { |
if (($tend) && ($tend<=$now)) { |
| $status = 'previous'; |
$status = 'previous'; |
| } |
} |
| if (($tstart) && ($now<$tstart)) { |
if (($tstart) && ($now<$tstart)) { |
|
Line 2486 sub get_my_roles {
|
Line 2512 sub get_my_roles {
|
| } |
} |
| } |
} |
| } |
} |
| $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; |
if ($hidepriv) { |
| |
if ((&privileged($username,$domain)) && |
| |
(!$nothide{$username.':'.$domain})) { |
| |
next; |
| |
} |
| |
} |
| |
if ($withsec) { |
| |
$returnhash{$username.':'.$domain.':'.$role.':'.$section} = |
| |
$tstart.':'.$tend; |
| |
} else { |
| |
$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; |
| |
} |
| } |
} |
| return %returnhash; |
return %returnhash; |
| } |
} |
|
Line 2550 sub courseidput {
|
Line 2587 sub courseidput {
|
| foreach my $cid (keys(%$storehash)) { |
foreach my $cid (keys(%$storehash)) { |
| $what .= &escape($cid).'='; |
$what .= &escape($cid).'='; |
| foreach my $item ('description','inst_code','owner','type') { |
foreach my $item ('description','inst_code','owner','type') { |
| $what .= &escape($storehash->{$item}).':'; |
$what .= &escape($storehash->{$cid}{$item}).':'; |
| } |
} |
| $what =~ s/\:$/&/; |
$what =~ s/\:$/&/; |
| } |
} |
|
Line 3502 sub set_userprivs {
|
Line 3539 sub set_userprivs {
|
| } |
} |
| foreach my $role (keys(%{$allroles})) { |
foreach my $role (keys(%{$allroles})) { |
| my %thesepriv; |
my %thesepriv; |
| if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; } |
if (($role=~/^au/) || ($role=~/^ca/) || ($role=~/^aa/)) { $author=1; } |
| foreach my $item (split(/:/,$$allroles{$role})) { |
foreach my $item (split(/:/,$$allroles{$role})) { |
| if ($item ne '') { |
if ($item ne '') { |
| my ($privilege,$restrictions)=split(/&/,$item); |
my ($privilege,$restrictions)=split(/&/,$item); |
|
Line 4843 sub auto_run {
|
Line 4880 sub auto_run {
|
| $response = 1; |
$response = 1; |
| } |
} |
| } else { |
} else { |
| my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver; |
| $response = &reply('autorun:'.$cdom,$homeserver); |
if (&is_course($cdom,$cnum)) { |
| |
$homeserver = &homeserver($cnum,$cdom); |
| |
} else { |
| |
$homeserver = &domain($cdom,'primary'); |
| |
} |
| |
if ($homeserver ne 'no_host') { |
| |
$response = &reply('autorun:'.$cdom,$homeserver); |
| |
} |
| } |
} |
| return $response; |
return $response; |
| } |
} |
|
Line 5250 sub assignrole {
|
Line 5294 sub assignrole {
|
| } else { |
} else { |
| my $cwosec=$url; |
my $cwosec=$url; |
| $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; |
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/; |
| unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { |
if (!(&allowed('c'.$role,$cwosec)) && !(&allowed('c'.$role,$udom))) { |
| &logthis('Refused assignrole: '. |
my $refused; |
| $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '. |
if (($env{'request.course.sec'} ne '') && ($role eq 'st')) { |
| $env{'user.name'}.' at '.$env{'user.domain'}); |
if (!(&allowed('c'.$role,$url))) { |
| return 'refused'; |
$refused = 1; |
| |
} |
| |
} else { |
| |
$refused = 1; |
| |
} |
| |
if ($refused) { |
| |
&logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url. |
| |
' '.$role.' '.$end.' '.$start.' by '. |
| |
$env{'user.name'}.' at '.$env{'user.domain'}); |
| |
return 'refused'; |
| |
} |
| } |
} |
| $mrole=$role; |
$mrole=$role; |
| } |
} |
|
Line 6612 sub EXT {
|
Line 6666 sub EXT {
|
| ([$courselevelr,'resource'], |
([$courselevelr,'resource'], |
| [$courselevelm,'map' ], |
[$courselevelm,'map' ], |
| [$courselevel, 'course' ])); |
[$courselevel, 'course' ])); |
| if (defined($userreply)) { return $userreply; } |
if (defined($userreply)) { return &get_reply($userreply); } |
| |
|
| # ------------------------------------------------ second, check some of course |
# ------------------------------------------------ second, check some of course |
| my $coursereply; |
my $coursereply; |
|
Line 6675 sub EXT {
|
Line 6729 sub EXT {
|
| if ($part eq '') { $part='0'; } |
if ($part eq '') { $part='0'; } |
| my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, |
my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, |
| $symbparm,$udom,$uname,$section,1); |
$symbparm,$udom,$uname,$section,1); |
| if (@partgeneral) { return &get_reply(\@partgeneral); } |
if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); } |
| } |
} |
| if ($recurse) { return undef; } |
if ($recurse) { return undef; } |
| my $pack_def=&packages_tab_default($filename,$varname); |
my $pack_def=&packages_tab_default($filename,$varname); |
|
Line 6709 sub EXT {
|
Line 6763 sub EXT {
|
| |
|
| sub get_reply { |
sub get_reply { |
| my ($reply_value) = @_; |
my ($reply_value) = @_; |
| if (wantarray) { |
if (ref($reply_value) eq 'ARRAY') { |
| return @$reply_value; |
if (wantarray) { |
| |
return @$reply_value; |
| |
} |
| |
return $reply_value->[0]; |
| |
} else { |
| |
return $reply_value; |
| } |
} |
| return $reply_value->[0]; |
|
| } |
} |
| |
|
| sub check_group_parms { |
sub check_group_parms { |
|
Line 7973 sub filelocation {
|
Line 8031 sub filelocation {
|
| } |
} |
| } |
} |
| $location=~s://+:/:g; # remove duplicate / |
$location=~s://+:/:g; # remove duplicate / |
| while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/.. |
while ($location=~m{/\.\./}) { |
| |
if ($location =~ m{/[^/]+/\.\./}) { |
| |
$location=~ s{/[^/]+/\.\./}{/}g; |
| |
} else { |
| |
$location=~ s{/\.\./}{/}g; |
| |
} |
| |
} #remove dir/.. |
| while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./ |
while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./ |
| return $location; |
return $location; |
| } |
} |
|
Line 8839 explanation of a user role term
|
Line 8903 explanation of a user role term
|
| |
|
| =item * |
=item * |
| |
|
| get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) : |
get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) : |
| All arguments are optional. Returns a hash of a roles, either for |
All arguments are optional. Returns a hash of a roles, either for |
| co-author/assistant author roles for a user's Construction Space |
co-author/assistant author roles for a user's Construction Space |
| (default), or if $context is 'userroles', roles for the user himself, |
(default), or if $context is 'userroles', roles for the user himself, |
| In the hash, keys are set to colon-sparated $uname,$udom,and $role, |
In the hash, keys are set to colon-separated $uname,$udom,$role, and |
| and value is set to colon-separated start and end times for the role. |
(optionally) if $withsec is true, a fourth colon-separated item - $section. |
| If no username and domain are specified, will default to current |
For each key, value is set to colon-separated start and end times for |
| user/domain. Types, roles, and roledoms are references to arrays, |
the role. If no username and domain are specified, will default to |
| |
current user/domain. Types, roles, and roledoms are references to arrays |
| of role statuses (active, future or previous), roles |
of role statuses (active, future or previous), roles |
| (e.g., cc,in, st etc.) and domains of the roles which can be used |
(e.g., cc,in, st etc.) and domains of the roles which can be used |
| to restrict the list of roles reported. If no array ref is |
to restrict the list of roles reported. If no array ref is |
![[BACK]](/icons/back.gif){kind=icon}
Return to lonnet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lonnet / perl