--- loncom/lonnet/perl/lonnet.pm 2007/05/17 09:31:13 1.879 +++ loncom/lonnet/perl/lonnet.pm 2007/06/11 17:13:34 1.886 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.879 2007/05/17 09:31:13 foxr Exp $ +# $Id: lonnet.pm,v 1.886 2007/06/11 17:13:34 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -770,7 +770,7 @@ sub get_dom { } return %returnhash; } else { - &logthis("get_dom failed - no homeserver and/or domain"); + &logthis("get_dom failed - no homeserver and/or domain ($udom) ($uhome)"); } } @@ -1739,13 +1739,16 @@ sub extract_embedded_items { while (my $t=$p->get_token()) { if ($t->[0] eq 'S') { 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') { &add_filetype($allfiles,$attr->{'src'},'src'); } + if (lc($tagname) eq 'a') { + &add_filetype($allfiles,$attr->{'href'},'href'); + } if (lc($tagname) eq 'script') { if ($attr->{'archive'} =~ /\.jar$/i) { &add_filetype($allfiles,$attr->{'archive'},'archive'); @@ -3133,7 +3136,7 @@ sub set_userprivs { if (keys(%{$allgroups}) > 0) { foreach my $role (keys %{$allroles}) { my ($trole,$area,$sec,$extendedarea); - if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)-) { + if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { $trole = $1; $area = $2; $sec = $3; @@ -6338,7 +6341,7 @@ sub packages_tab_default { $do_default=1; } elsif ($pack_type eq 'extension') { push(@extension,[$package,$pack_type,$pack_part]); - } elsif ($pack_part eq $part) { + } elsif ($pack_part eq $part || $pack_type eq 'part') { # only look at packages defaults for packages that this id is push(@specifics,[$package,$pack_type,$pack_part]); } @@ -6555,13 +6558,18 @@ sub metadata { } } my ($extension) = ($uri =~ /\.(\w+)$/); + $extension = lc($extension); + if ($extension eq 'htm') { $extension='html'; } + foreach my $key (keys(%packagetab)) { #no specific packages #how's our extension if ($key!~/^extension_\Q$extension\E&/) { next; } &metadata_create_package_def($uri,$key,'extension_'.$extension, \%metathesekeys); } - if (!exists($metaentry{':packages'})) { + + if (!exists($metaentry{':packages'}) + || $packagetab{"import_defaults&extension_$extension"}) { foreach my $key (keys(%packagetab)) { #no specific packages well let's get default then if ($key!~/^default&/) { next; } @@ -7510,6 +7518,7 @@ sub filelocation { $file=~s-^/adm/wrapper/-/-; $file=~s-^/adm/coursedocs/showdoc/-/-; } + if ($file=~m:^/~:) { # is a contruction space reference $location = $file; $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; @@ -7530,6 +7539,8 @@ sub filelocation { $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. $udom.'/'.$uname.'/'.$filename; } + } elsif ($file =~ m-^/adm/-) { + $location = $perlvar{'lonDocRoot'}.'/'.$file; } else { $file=~s/^\Q$perlvar{'lonDocRoot'}\E//; $file=~s:^/res/:/:; @@ -7640,7 +7651,8 @@ sub declutter { sub clutter { my $thisfn='/'.&declutter(shift); - unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { + if ($thisfn !~ m{^/(uploaded|editupload|userfiles|ext|raw|priv|public)/} + || $thisfn =~ m{^/adm/(includes|pages)} ) { $thisfn='/res'.$thisfn; } if ($thisfn !~m|/adm|) {