version 1.642, 2005/06/17 21:04:40
|
version 1.648, 2005/07/26 13:30:34
|
Line 1302 sub userfileupload {
|
Line 1302 sub userfileupload {
|
if ($coursedoc) { |
if ($coursedoc) { |
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'}; |
my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'}; |
if ($env{'form.folder'} =~ m/^default/) { |
if ($env{'form.folder'} =~ m/^(default|supplemental)/) { |
return &finishuserfileupload($docuname,$docudom, |
return &finishuserfileupload($docuname,$docudom, |
$formname,$fname,$parser,$allfiles, |
$formname,$fname,$parser,$allfiles, |
$codebase); |
$codebase); |
Line 1368 sub finishuserfileupload {
|
Line 1368 sub finishuserfileupload {
|
} |
} |
|
|
sub extract_embedded_items { |
sub extract_embedded_items { |
my ($filepath,$file,$allfiles,$codebase) = @_; |
my ($filepath,$file,$allfiles,$codebase,$content) = @_; |
my @state = (); |
my @state = (); |
my %javafiles = ( |
my %javafiles = ( |
codebase => '', |
codebase => '', |
Line 1379 sub extract_embedded_items {
|
Line 1379 sub extract_embedded_items {
|
src => '', |
src => '', |
movie => '', |
movie => '', |
); |
); |
my $p = HTML::LCParser->new($filepath.'/'.$file); |
my $p; |
|
if ($content) { |
|
$p = HTML::LCParser->new($content); |
|
} else { |
|
$p = HTML::LCParser->new($filepath.'/'.$file); |
|
} |
while (my $t=$p->get_token()) { |
while (my $t=$p->get_token()) { |
if ($t->[0] eq 'S') { |
if ($t->[0] eq 'S') { |
my ($tagname, $attr) = ($t->[1],$t->[2]); |
my ($tagname, $attr) = ($t->[1],$t->[2]); |
push (@state, $tagname); |
push (@state, $tagname); |
|
if (lc($tagname) eq 'allow') { |
|
&add_filetype($allfiles,$attr->{'src'},'src'); |
|
} |
if (lc($tagname) eq 'img') { |
if (lc($tagname) eq 'img') { |
&add_filetype($allfiles,$attr->{'src'},'src'); |
&add_filetype($allfiles,$attr->{'src'},'src'); |
} |
} |
|
if (lc($tagname) eq 'script') { |
|
if ($attr->{'archive'} =~ /\.jar$/i) { |
|
&add_filetype($allfiles,$attr->{'archive'},'archive'); |
|
} else { |
|
&add_filetype($allfiles,$attr->{'src'},'src'); |
|
} |
|
} |
|
if (lc($tagname) eq 'link') { |
|
if (lc($attr->{'rel'}) eq 'stylesheet') { |
|
&add_filetype($allfiles,$attr->{'href'},'href'); |
|
} |
|
} |
if (lc($tagname) eq 'object' || |
if (lc($tagname) eq 'object' || |
(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) { |
(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) { |
foreach my $item (keys(%javafiles)) { |
foreach my $item (keys(%javafiles)) { |
Line 2881 sub allowed {
|
Line 2901 sub allowed {
|
|
|
# Free bre access to user's own portfolio contents |
# Free bre access to user's own portfolio contents |
my ($space,$domain,$name,$dir)=split('/',$uri); |
my ($space,$domain,$name,$dir)=split('/',$uri); |
if (($space=~/^(uploaded|ediupload)$/) && ($env{'user.name'} eq $name) && |
if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && |
($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) { |
($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) { |
return 'F'; |
return 'F'; |
} |
} |
Line 2968 sub allowed {
|
Line 2988 sub allowed {
|
|
|
# If this is generating or modifying users, exit with special codes |
# If this is generating or modifying users, exit with special codes |
|
|
if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:\Q$priv\E\:/) { |
if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) { |
if ($priv eq 'cca') { |
if (($priv eq 'cca') || ($priv eq 'caa')) { |
my ($audom,$auname)=split('/',$uri); |
my ($audom,$auname)=split('/',$uri); |
|
# no author name given, so this just checks on the general right to make a co-author in this domain |
|
unless ($auname) { return $thisallowed; } |
|
# an author name is given, so we are about to actually make a co-author for a certain account |
if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) || |
if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) || |
(($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) && |
(($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) && |
($audom ne $env{'request.role.domain'}))) { return ''; } |
($audom ne $env{'request.role.domain'}))) { return ''; } |
Line 4882 sub metadata_generate_part0 {
|
Line 4905 sub metadata_generate_part0 {
|
'.type'}; |
'.type'}; |
my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name. |
my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name. |
'.display'}; |
'.display'}; |
my $expr='\\[Part: '.$allnames{$name}.'\\]'; |
my $expr='[Part: '.$allnames{$name}.']'; |
$olddis=~s/\Q$expr\E/\[Part: 0\]/; |
$olddis=~s/\Q$expr\E/\[Part: 0\]/; |
$$metacache{"$key.display"}=$olddis; |
$$metacache{"$key.display"}=$olddis; |
} |
} |
Line 4987 sub symbverify {
|
Line 5010 sub symbverify {
|
if ($ids) { |
if ($ids) { |
# ------------------------------------------------------------------- Has ID(s) |
# ------------------------------------------------------------------- Has ID(s) |
foreach (split(/\,/,$ids)) { |
foreach (split(/\,/,$ids)) { |
my ($mapid,$resid)=split(/\./,$_); |
my ($mapid,$resid)=split(/\./,$_); |
if ( |
if ( |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
eq $symb) { |
eq $symb) { |