[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.639 and 1.647

version 1.639, 2005/06/17 16:48:13 version 1.647, 2005/07/25 18:47:38
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 1379  sub extract_embedded_items { Line 1379  sub extract_embedded_items {
                       src => '',                        src => '',
                       movie => '',                        movie => '',
                      );                       );
     my $p = HTML::Parser->new      my $p = HTML::LCParser->new($filepath.'/'.$file);
     (      while (my $t=$p->get_token()) {
         start_h =>   if ($t->[0] eq 'S') {
             [sub {      my ($tagname, $attr) = ($t->[1],$t->[2]);
                  my ($tagname, $attr) = @_;      push (@state, $tagname);
                  push (@state, $tagname);      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 (lc($tagname) eq 'object' ||                  if ($attr->{'archive'} =~ /\.jar$/i) {
      (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) {                      &add_filetype($allfiles,$attr->{'archive'},'archive');
                      foreach my $item (keys(%javafiles)) {                  } else {
                          $javafiles{$item} = '';                      &add_filetype($allfiles,$attr->{'src'},'src');
                      }                  }
                  }              }
                  if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') {              if (lc($tagname) eq 'link') {
      my $name = lc($attr->{'name'});                  if (lc($attr->{'rel'}) eq 'stylesheet') { 
      foreach my $item (keys(%javafiles)) {                      &add_filetype($allfiles,$attr->{'href'},'href');
  if ($name eq $item) {                  }
      $javafiles{$item} = $attr->{'value'};              }
      last;      if (lc($tagname) eq 'object' ||
  }   (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) {
      }   foreach my $item (keys(%javafiles)) {
      foreach my $item (keys(%mediafiles)) {      $javafiles{$item} = '';
  if ($name eq $item) {   }
      &add_filetype($allfiles, $attr->{'value'}, 'value');      }
      last;      if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') {
  }   my $name = lc($attr->{'name'});
      }   foreach my $item (keys(%javafiles)) {
  }      if ($name eq $item) {
                  if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') {   $javafiles{$item} = $attr->{'value'};
      foreach my $item (keys(%javafiles)) {   last;
                          if ($attr->{$item}) {      }
                              $javafiles{$item} = $attr->{$item};   }
                              last;   foreach my $item (keys(%mediafiles)) {
                          }      if ($name eq $item) {
                      }   &add_filetype($allfiles, $attr->{'value'}, 'value');
                      foreach my $item (keys(%mediafiles)) {   last;
                          if ($attr->{$item}) {      }
      &add_filetype($allfiles,$attr->{$item},$item);   }
                              last;      }
                          }      if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') {
                      }   foreach my $item (keys(%javafiles)) {
                  }      if ($attr->{$item}) {
             }, "tagname, attr"],   $javafiles{$item} = $attr->{$item};
         end_h =>   last;
                [sub {      }
                    my ($tagname) = @_;   }
                    if ($javafiles{'codebase'} ne '') {   foreach my $item (keys(%mediafiles)) {
                        $javafiles{'codebase'} .= '/';      if ($attr->{$item}) {
                    }     &add_filetype($allfiles,$attr->{$item},$item);
                    if (lc($tagname) eq 'applet' ||   last;
        lc($tagname) eq 'object' ||      }
        (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')   }
        ) {      }
        foreach my $item (keys(%javafiles)) {   } elsif ($t->[0] eq 'E') {
    if ($item ne 'codebase' &&       my ($tagname) = ($t->[1]);
        $javafiles{$item} ne '') {      if ($javafiles{'codebase'} ne '') {
        my $file=$javafiles{'codebase'}.   $javafiles{'codebase'} .= '/';
    $javafiles{$item};      }  
        &add_filetype($allfiles,$file,$item);      if (lc($tagname) eq 'applet' ||
    }   lc($tagname) eq 'object' ||
        }   (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')
                    }    ) {
                    pop @state;   foreach my $item (keys(%javafiles)) {
                 }, "tagname"],      if ($item ne 'codebase' && $javafiles{$item} ne '') {
     );   my $file=$javafiles{'codebase'}.$javafiles{$item};
     $p->parse_file($filepath.'/'.$file);   &add_filetype($allfiles,$file,$item);
     $p->eof;      }
    }
       } 
       pop @state;
    }
       }
     return 'ok';      return 'ok';
 }  }
   
Line 2888  sub allowed { Line 2893  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 2975  sub allowed { Line 2980  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') || ($priv eq 'caa')) {
       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\./) ||
    (($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) &&
    ($audom ne $env{'request.role.domain'}))) { return ''; }
    }
  return $thisallowed;   return $thisallowed;
     }      }
 #  #
Line 4883  sub metadata_generate_part0 { Line 4897  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 4988  sub symbverify { Line 5002  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) { 
Removed from v.1.639  
changed lines
  Added in v.1.647

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>