--- loncom/lonnet/perl/lonnet.pm 2007/05/17 09:31:13 1.879 +++ loncom/lonnet/perl/lonnet.pm 2007/06/07 22:09:59 1.885 @@ -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.885 2007/06/07 22:09:59 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)"); } } @@ -3133,7 +3133,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 +6338,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 +6555,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 +7515,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 +7536,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 +7648,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|) {