[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.637 and 1.639

version 1.637, 2005/06/11 13:38:47 version 1.639, 2005/06/17 16:48:13
Line 1132  sub allowuploaded { Line 1132  sub allowuploaded {
 }  }
   
 # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course  # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
 # input: action, courseID, current domain, home server for course, intended  # input: action, courseID, current domain, intended
 #        path to file, source of file, instruction to parse file for objects,  #        path to file, source of file, instruction to parse file for objects,
 #        ref to hash for embedded objects,  #        ref to hash for embedded objects,
 #        ref to hash for codebase of java objects.  #        ref to hash for codebase of java objects.
Line 1162  sub allowuploaded { Line 1162  sub allowuploaded {
 #  #
   
 sub process_coursefile {  sub process_coursefile {
     my ($action,$docuname,$docudom,$docuhome,$file,$source,$parser,$allfiles,$codebase)=@_;      my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_;
     my $fetchresult;      my $fetchresult;
       my $home=&homeserver($docuname,$docudom);
     if ($action eq 'propagate') {      if ($action eq 'propagate') {
         $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file          $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                             ,$docuhome);       $home);
     } else {      } else {
         my $fetchresult = '';          my $fetchresult = '';
         my $fpath = '';          my $fpath = '';
Line 1182  sub process_coursefile { Line 1183  sub process_coursefile {
                 my $destination = $filepath.'/'.$fname;                  my $destination = $filepath.'/'.$fname;
                 rename($source,$destination);                  rename($source,$destination);
                 $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,                  $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $docuhome);                                   $home);
             }              }
         } elsif ($action eq 'uploaddoc') {          } elsif ($action eq 'uploaddoc') {
             open(my $fh,'>'.$filepath.'/'.$fname);              open(my $fh,'>'.$filepath.'/'.$fname);
Line 1195  sub process_coursefile { Line 1196  sub process_coursefile {
                 }                  }
             }              }
             $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,              $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $docuhome);                                   $home);
             if ($fetchresult eq 'ok') {              if ($fetchresult eq 'ok') {
                 return '/uploaded/'.$fpath.'/'.$fname;                  return '/uploaded/'.$fpath.'/'.$fname;
             } else {              } else {
                 &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.                  &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
                         ' to host '.$docuhome.': '.$fetchresult);                          ' to host '.$home.': '.$fetchresult);
                 return '/adm/notfound.html';                  return '/adm/notfound.html';
             }              }
         }          }
     }      }
     unless ( $fetchresult eq 'ok') {      unless ( $fetchresult eq 'ok') {
         &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.          &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
              ' to host '.$docuhome.': '.$fetchresult);               ' to host '.$home.': '.$fetchresult);
     }      }
     return $fetchresult;      return $fetchresult;
 }  }
Line 1228  sub build_filepath { Line 1229  sub build_filepath {
 }  }
   
 sub store_edited_file {  sub store_edited_file {
     my ($primary_url,$content,$docudom,$docuname,$docuhome,$fetchresult) = @_;      my ($primary_url,$content,$docudom,$docuname,$fetchresult) = @_;
     my $file = $primary_url;      my $file = $primary_url;
     $file =~ s#^/uploaded/$docudom/$docuname/##;      $file =~ s#^/uploaded/$docudom/$docuname/##;
     my $fpath = '';      my $fpath = '';
Line 1239  sub store_edited_file { Line 1240  sub store_edited_file {
     open(my $fh,'>'.$filepath.'/'.$fname);      open(my $fh,'>'.$filepath.'/'.$fname);
     print $fh $content;      print $fh $content;
     close($fh);      close($fh);
       my $home=&homeserver($docuname,$docudom);
     $$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,      $$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
                                  $docuhome);    $home);
     if ($$fetchresult eq 'ok') {      if ($$fetchresult eq 'ok') {
         return '/uploaded/'.$fpath.'/'.$fname;          return '/uploaded/'.$fpath.'/'.$fname;
     } else {      } else {
         &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.                        ' to host '.$docuhome.': '.$$fetchresult);          &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
    ' to host '.$home.': '.$$fetchresult);
         return '/adm/notfound.html';          return '/adm/notfound.html';
     }      }
 }  }
Line 1295  sub userfileupload { Line 1298  sub userfileupload {
         return $fullpath.'/'.$fname;           return $fullpath.'/'.$fname; 
     }      }
 # Create the directory if not present  # Create the directory if not present
     my $docuname='';  
     my $docudom='';  
     my $docuhome='';  
     $fname="$subdir/$fname";      $fname="$subdir/$fname";
     if ($coursedoc) {      if ($coursedoc) {
  $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};   my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
  $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};   my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
  $docuhome=$env{'course.'.$env{'request.course.id'}.'.home'};  
         if ($env{'form.folder'} =~ m/^default/) {          if ($env{'form.folder'} =~ m/^default/) {
             return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase);              return &finishuserfileupload($docuname,$docudom,
    $formname,$fname,$parser,$allfiles,
    $codebase);
         } else {          } else {
             $fname=$env{'form.folder'}.'/'.$fname;              $fname=$env{'form.folder'}.'/'.$fname;
             return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname,$parser,$allfiles,$codebase);              return &process_coursefile('uploaddoc',$docuname,$docudom,
          $fname,$formname,$parser,
          $allfiles,$codebase);
         }          }
     } else {      } else {
         $docuname=$env{'user.name'};          my $docuname=$env{'user.name'};
         $docudom=$env{'user.domain'};          my $docudom=$env{'user.domain'};
         $docuhome=$env{'user.home'};   return &finishuserfileupload($docuname,$docudom,$formname,
         return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase);       $fname,$parser,$allfiles,$codebase);
     }      }
 }  }
   
 sub finishuserfileupload {  sub finishuserfileupload {
     my ($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase) = @_;      my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase) = @_;
     my $path=$docudom.'/'.$docuname.'/';      my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};      my $filepath=$perlvar{'lonDocRoot'};
     my ($fnamepath,$file);      my ($fnamepath,$file);
Line 1342  sub finishuserfileupload { Line 1345  sub finishuserfileupload {
  close(FH);   close(FH);
     }      }
     if ($parser eq 'parse') {      if ($parser eq 'parse') {
         my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,$codebase);          my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,
      $codebase);
         unless ($parse_result eq 'ok') {          unless ($parse_result eq 'ok') {
             &logthis('Failed to parse '.$filepath.$file.' for embedded media: '.$parse_result);               &logthis('Failed to parse '.$filepath.$file.
        ' for embedded media: '.$parse_result); 
         }          }
     }      }
 # Notify homeserver to grep it  # Notify homeserver to grep it
 #  #
       my $docuhome=&homeserver($docuname,$docudom);
     my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);      my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {      if ($fetchresult eq 'ok') {
 #  #
Line 1375  sub extract_embedded_items { Line 1381  sub extract_embedded_items {
                      );                       );
     my $p = HTML::Parser->new      my $p = HTML::Parser->new
     (      (
         xml_mode => 1,  
         start_h =>          start_h =>
             [sub {              [sub {
                  my ($tagname, $attr) = @_;                   my ($tagname, $attr) = @_;
                  push (@state, $tagname);                   push (@state, $tagname);
                  if (lc($tagname) eq 'img') {                   if (lc($tagname) eq 'img') {
                      if (exists($$allfiles{$attr->{'src'}})) {       &add_filetype($allfiles,$attr->{'src'},'src');
                          unless (grep/^src$/,@{$$allfiles{$attr->{'src'}}}) {  
                              push (@{$$allfiles{$attr->{'src'}}},&escape('src'));  
                          }  
                      } else {  
                          @{$$allfiles{$attr->{'src'}}} = (&escape('src'));  
                      }  
                  }                   }
                  if (lc($tagname) eq 'object') {                   if (lc($tagname) eq 'object' ||
                      foreach my $item (keys (%javafiles)) {       (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) {
                        foreach my $item (keys(%javafiles)) {
                          $javafiles{$item} = '';                           $javafiles{$item} = '';
                      }                       }
                  }                   }
                  if (lc($state[-2]) eq 'object') {                   if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') {
                      if (lc($tagname) eq 'param') {       my $name = lc($attr->{'name'});
                          my $name = lc($attr->{'name'});       foreach my $item (keys(%javafiles)) {
                          foreach my $item (keys (%mediafiles)) {   if ($name eq $item) {
                              if ($name eq $item) {       $javafiles{$item} = $attr->{'value'};
                                  if (exists($$allfiles{$attr->{'value'}})) {       last;
                                      unless(grep/^value$/,@{$$allfiles{$attr->{'value'}}}) {   }
                                          push(@{$$allfiles{$attr->{'value'}}},&escape('value'));       }
                                      }       foreach my $item (keys(%mediafiles)) {
                                  } else {   if ($name eq $item) {
                                      @{$$allfiles{$attr->{'value'}}} = (&escape('value'));       &add_filetype($allfiles, $attr->{'value'}, 'value');
                                  }       last;
                                  last;   }
                              }       }
                          }   }
                          foreach my $item (keys (%javafiles)) {                   if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') {
                              if ($name eq $item) {       foreach my $item (keys(%javafiles)) {
                                  $javafiles{$item} = $attr->{'value'};  
                                  last;  
                              }  
                          }  
                      }  
                  }  
                  if (lc($tagname) eq 'embed') {  
                      unless (lc($state[-2]) eq 'object') {  
                          foreach my $item (keys (%javafiles)) {  
                              $javafiles{$item} = '';  
                          }  
                      }  
                      foreach my $item (keys (%javafiles)) {  
                          if ($attr->{$item}) {                           if ($attr->{$item}) {
                              $javafiles{$item} = $attr->{$item};                               $javafiles{$item} = $attr->{$item};
                              last;                               last;
                          }                           }
                      }                       }
                      foreach my $item (keys (%mediafiles)) {                       foreach my $item (keys(%mediafiles)) {
                          if ($attr->{$item}) {                           if ($attr->{$item}) {
                              if (exists($$allfiles{$attr->{$item}})) {       &add_filetype($allfiles,$attr->{$item},$item);
                                  unless (grep/^$item$/,@{$$allfiles{$item}}) {  
                                      push(@{$$allfiles{$attr->{$item}}},&escape($item));  
                                  }  
                              } else {  
                                  @{$$allfiles{$attr->{$item}}} = (&escape($item));  
                              }  
                              last;                               last;
                          }                           }
                      }                       }
                  }                   }
             }, "tagname, attr"],              }, "tagname, attr"],
         text_h =>  
              [sub {  
                  my ($text) = @_;  
         }, "dtext"],  
         end_h =>          end_h =>
                [sub {                 [sub {
                    my ($tagname) = @_;                     my ($tagname) = @_;
                    unless ($javafiles{'codebase'} eq '') {                     if ($javafiles{'codebase'} ne '') {
                        $javafiles{'codebase'} .= '/';                         $javafiles{'codebase'} .= '/';
                    }                       }  
                    if (lc($tagname) eq 'object') {                     if (lc($tagname) eq 'applet' ||
                        &extract_java_items(\%javafiles,$allfiles,$codebase);         lc($tagname) eq 'object' ||
          (lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')
          ) {
          foreach my $item (keys(%javafiles)) {
      if ($item ne 'codebase' && 
          $javafiles{$item} ne '') {
          my $file=$javafiles{'codebase'}.
      $javafiles{$item};
          &add_filetype($allfiles,$file,$item);
      }
          }
                    }                      } 
                    if (lc($tagname) eq 'embed') {  
                        unless (lc($state[-2]) eq 'object') {  
                            &extract_java_items(\%javafiles,$allfiles,$codebase);  
                        }  
                    }  
                    pop @state;                     pop @state;
                 }, "tagname"],                  }, "tagname"],
     );      );
Line 1469  sub extract_embedded_items { Line 1451  sub extract_embedded_items {
     return 'ok';      return 'ok';
 }  }
   
 sub extract_java_items {  sub add_filetype {
     my ($javafiles,$allfiles,$codebase) = @_;      my ($allfiles,$file,$type)=@_;
     foreach my $item (keys (%{$javafiles})) {      if (exists($allfiles->{$file})) {
         unless ($item eq 'codebase') {   unless (grep/^\Q$type\E$/, @{$allfiles->{$file}}) {
             if ($$javafiles{$item} ne '') {      push(@{$allfiles->{$file}}, &escape($type));
                 if (exists($$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}})) {   }
                     unless (grep/^$item$/,@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}}) {      } else {
                         push(@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}},&escape($item));   @{$allfiles->{$file}} = (&escape($type));
                     }  
                 } else {  
                     @{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}} = (&escape($item));  
                     $$codebase{$$javafiles{'codebase'}.$$javafiles{$item}} = $$javafiles{'codebase'};  
                                                                                   
                 }  
             }  
         }  
     }      }
 }  }
   
Line 3875  sub createcourse { Line 3849  sub createcourse {
 </map>  </map>
 ENDINITMAP  ENDINITMAP
         $topurl=&declutter(          $topurl=&declutter(
         &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')          &finishuserfileupload($uname,$udom,'initmap','default.sequence')
                           );                            );
     }      }
 # ----------------------------------------------------------- Write preferences  # ----------------------------------------------------------- Write preferences
Line 6798  userspace, probably shouldn't be called Line 6772  userspace, probably shouldn't be called
   
   docuname: username or courseid of destination for the file    docuname: username or courseid of destination for the file
   docudom: domain of user/course of destination for the file    docudom: domain of user/course of destination for the file
   docuhome: loncapa id of the library server that is getting the file  
   formname: same as for userfileupload()    formname: same as for userfileupload()
   fname: filename (inculding subdirectories) for the file    fname: filename (inculding subdirectories) for the file
   
Removed from v.1.637  
changed lines
  Added in v.1.639

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