[LON-CAPA-cvs] cvs: loncom /interface londocs.pm /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Sat, 11 Jun 2005 13:38:49 -0000
This is a MIME encoded message
--raeburn1118497129
Content-Type: text/plain
raeburn Sat Jun 11 09:38:49 2005 EDT
Modified files:
/loncom/interface londocs.pm
/loncom/lonnet/perl lonnet.pm
Log:
HTML files uploaded via DOCS can now be parsed, and the user prompted to upload embedded objects (e.g., images, movie files, applets). Need to add support for js and css files.
--raeburn1118497129
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20050611093849.txt"
Index: loncom/interface/londocs.pm
diff -u loncom/interface/londocs.pm:1.187 loncom/interface/londocs.pm:1.188
--- loncom/interface/londocs.pm:1.187 Fri Jun 10 13:51:29 2005
+++ loncom/interface/londocs.pm Sat Jun 11 09:38:47 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Documents
#
-# $Id: londocs.pm,v 1.187 2005/06/10 17:51:29 www Exp $
+# $Id: londocs.pm,v 1.188 2005/06/11 13:38:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -679,7 +679,7 @@
if ($contents) {
$$content_file = &store_template($contents,$tempexport,$count,$content_type);
}
- } elsif ($symb =~ m-lib/templates/examupload\.problem-m) {
+ } elsif ($symb =~ m-lib/templates/examupload\.problem$-) {
$content_type = 'examupload';
} elsif ($symb =~ m-adm/(\w+)/(\w+)/(\d+)/bulletinboard$-) {
$content_type = 'bulletinboard';
@@ -904,7 +904,7 @@
}
sub editor {
- my ($r,$coursenum,$coursedom,$folder,$allowed)=@_;
+ my ($r,$coursenum,$coursedom,$folder,$allowed,$upload_output)=@_;
my $errtext='';
my $fatal=0;
my $container='sequence';
@@ -1032,46 +1032,7 @@
}
}
-# upload a file, if present
- if (($env{'form.uploaddoc.filename'}) &&
- ($env{'form.cmd'}=~/^upload_(\w+)/)) {
- if ( ($folder=~/^$1/) || ($1 eq 'default') ) {
- my $destination = 'docs/';
- if ($folder eq 'default') {
- $destination .= 'default/';
- } elsif ($folder =~ /^default_(\d+)$/) {
- $destination .= $1.'/';
- }
-# this is for a course, not a user, so set coursedoc flag
-# probably the only place in the system where this should be "1"
-
- my $newidx=&Apache::lonratedt::getresidx();
- $destination .= $newidx;
- my $url=&Apache::lonnet::userfileupload('uploaddoc',1,$destination);
-
- my $ext='false';
- if ($url=~/^http\:\/\//) { $ext='true'; }
- $url=~s/\:/\:/g;
- my $comment=$env{'form.comment'};
- $comment=~s/\</\<\;/g;
- $comment=~s/\>/\>\;/g;
- $comment=~s/\:/\:/g;
- if ($folder=~/^supplemental/) {
- $comment=time.'___&&&___'.$env{'user.name'}.'___&&&___'.
- $env{'user.domain'}.'___&&&___'.$comment;
- }
- $Apache::lonratedt::resources[$newidx]=
- $comment.':'.$url.':'.$ext.':normal:res';
- $Apache::lonratedt::order[$#Apache::lonratedt::order+1]=
- $newidx;
-
- ($errtext,$fatal)=&storemap($coursenum,$coursedom,$folder.'.'.$container);
- if ($fatal) {
- $r->print('<p><font color="red">'.$errtext.'</font></p>');
- return;
- }
- }
- }
+ $r->print($upload_output);
if ($env{'form.cmd'}) {
my ($cmd,$idx)=split(/\_/,$env{'form.cmd'});
if ($cmd eq 'del') {
@@ -1214,6 +1175,127 @@
}
}
+sub process_file_upload {
+ my ($upload_output,$coursenum,$coursedom,$allfiles,$codebase) = @_;
+# upload a file, if present
+ my $parseaction;
+ if ($env{'form.parserflag'}) {
+ $parseaction = 'parse';
+ }
+ my $phase_status;
+ my $folder=$env{'form.folder'};
+ if ($folder eq '' || $folder eq 'supplemental') {
+ $folder='default';
+ }
+ if ( ($folder=~/^$1/) || ($1 eq 'default') ) {
+ my $errtext='';
+ my $fatal=0;
+ my $container='sequence';
+ if ($env{'form.pagepath'}) {
+ $container='page';
+ }
+ ($errtext,$fatal)=
+ &mapread($coursenum,$coursedom,$folder.'.'.$container);
+ if ($#Apache::lonratedt::order<1) {
+ $Apache::lonratedt::order[0]=1;
+ $Apache::lonratedt::resources[1]='';
+ }
+ if ($fatal) {
+ return 'failed';
+ }
+ my $destination = 'docs/';
+ if ($folder eq 'default') {
+ $destination .= 'default/';
+ } elsif ($folder =~ /^default_(\d+)$/) {
+ $destination .= $1.'/';
+ }
+# this is for a course, not a user, so set coursedoc flag
+# probably the only place in the system where this should be "1"
+ my $newidx=&Apache::lonratedt::getresidx();
+ $destination .= $newidx;
+ my $url=&Apache::lonnet::userfileupload('uploaddoc',1,$destination,$parseaction,$allfiles,$codebase);
+ my $ext='false';
+ if ($url=~/^http\:\/\//) { $ext='true'; }
+ $url=~s/\:/\:/g;
+ my $comment=$env{'form.comment'};
+ $comment=~s/\</\<\;/g;
+ $comment=~s/\>/\>\;/g;
+ $comment=~s/\:/\:/g;
+ if ($folder=~/^supplemental/) {
+ $comment=time.'___&&&___'.$env{'user.name'}.'___&&&___'.
+ $env{'user.domain'}.'___&&&___'.$comment;
+ }
+
+ $Apache::lonratedt::resources[$newidx]=
+ $comment.':'.$url.':'.$ext.':normal:res';
+ $Apache::lonratedt::order[$#Apache::lonratedt::order+1]=
+ $newidx;
+ ($errtext,$fatal)=&storemap($coursenum,$coursedom,$folder.'.'.$container);
+ if ($fatal) {
+ $$upload_output .= '<p><font color="red">'.$errtext.'</font></p>';
+ return 'failed';
+ } else {
+ if ($parseaction eq 'parse') {
+ my $total_embedded = keys %{$allfiles};
+ if ($total_embedded > 0) {
+ my $num = 0;
+ $$upload_output .= 'This file contains embedded multimedia objects, which need to be uploaded to LON-CAPA.<br />
+ <form name="upload_embedded" action="/adm/coursedocs"
+ method="post" enctype="multipart/form-data">
+ <input type="hidden" name="folderpath" value="'.$env{'form.folderpath'}.'" /> <input type="hidden" name="cmd" value="upload_embedded" />
+ <input type="hidden" name="newidx" value="'.$newidx.'" />
+ <input type="hidden" name="primaryurl" value="'.&Apache::lonnet::escape($url).'" />
+ <input type="hidden" name="phasetwo" value="'.$total_embedded.'" />';
+ $$upload_output .= '<b>Upload embedded files</b>:<br />
+ <table>';
+ foreach my $embed_file (keys %{$allfiles}) {
+ $$upload_output .= '<tr><td>'.$embed_file.
+ '<input name="embedded_item_'.$num.'" type="file">
+ <input name="embedded_orig_'.$num.'" type="hidden" value="'.&Apache::lonnet::escape($embed_file).'"/>';
+ my $attrib;
+ if (@{$$allfiles{$embed_file}} > 1) {
+ $attrib = join(':',@{$$allfiles{$embed_file}});
+ } else {
+ $attrib = $$allfiles{$embed_file}[0];
+ }
+ $$upload_output .=
+ '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.$attrib.'" />';
+ if (exists($$codebase{$embed_file})) {
+ $$upload_output .=
+ '<input name="codebase_'.$num.'" type="hidden" value="'.&Apache::lonnet::escape($$codebase{$embed_file}).'" />';
+ }
+ $$upload_output .= '</td></tr>';
+ $num ++;
+ }
+ $phase_status = 'phasetwo';
+ $$upload_output .= '</table><br />
+ <input type ="submit" value="Complete upload" />
+ </form>';
+ } else {
+ $$upload_output .= 'No embedded items identified<br />';
+ }
+ }
+ }
+ }
+ return $phase_status;
+}
+
+sub process_secondary_uploads {
+ my ($upload_output,$coursedom,$coursenum,$formname,$num,$newidx) = @_;
+ my $folder=$env{'form.folder'};
+ my $destination = 'docs/';
+ if ($folder eq 'default') {
+ $destination .= 'default/';
+ } elsif ($folder =~ /^default_(\d+)$/) {
+ $destination .= $1.'/';
+ }
+ $destination .= $newidx;
+ my ($url,$filename);
+ $url=&Apache::lonnet::userfileupload($formname.$num,1,$destination);
+ ($filename) = ($url =~ m-^/uploaded/$coursedom/$coursenum/$destination/(.+)$-);
+ return $filename;
+}
+
# --------------------------------------------------------------- An entry line
sub entryline {
@@ -2155,7 +2237,88 @@
&Apache::loncommon::bodytag('Course Documents','',$events,
'','',$showdoc).
&Apache::loncommon::help_open_menu('','','','',273,'RAT'));
- unless ($showdoc) {
+ my %allfiles = ();
+ my %codebase = ();
+ my ($upload_result,$upload_output);
+ if ($allowed) {
+ if (($env{'form.uploaddoc.filename'}) && ($env{'form.cmd'}=~/^upload_(\w+)/)) {
+# Process file upload - phase one - upload and parse primary file.
+ $upload_result = &process_file_upload(\$upload_output,$coursenum,$coursedom,\%allfiles,\%codebase);
+ if ($upload_result eq 'phasetwo') {
+ $r->print($upload_output);
+ }
+ } elsif ($env{'form.phasetwo'}) {
+ my %newname = ();
+ my %origname = ();
+ my %attribs = ();
+ my $updateflag = 0;
+ my $residx = $env{'form.newidx'};
+ my $primary_url = &Apache::lonnet::unescape($env{'form.primaryurl'});
+# Process file upload - phase two - gather secondary files.
+ for (my $i=0; $i<$env{'form.phasetwo'}; $i++) {
+ if ($env{'form.embedded_item_'.$i.'.filename'}) {
+ my $javacodebase;
+ $newname{$i} = &process_secondary_uploads(\$upload_output,$coursedom,$coursenum,'embedded_item_',$i,$residx);
+ $origname{$i} = &Apache::lonnet::unescape($env{'form.embedded_orig_'.$i});
+ if (exists($env{'form.embedded_codebase_'.$i})) {
+ $javacodebase = &Apache::lonnet::unescape($env{'form.embedded_codebase_'.$i});
+ $origname{$i} =~ s#^\Q$javacodebase\E/##;
+ }
+ my @attributes = ();
+ if ($env{'form.embedded_attrib_'.$i} =~ /:/) {
+ @attributes = split/:/,$env{'form.embedded_attrib_'.$i};
+ } else {
+ @attributes = ($env{'form.embedded_attrib_'.$i});
+ }
+ foreach (@attributes) {
+ push(@{$attribs{$i}},&Apache::lonnet::unescape($_));
+ }
+ if ($javacodebase) {
+ $codebase{$i} = $javacodebase;
+ $codebase{$i} =~ s#/$##;
+ $updateflag = 1;
+ }
+ }
+ unless ($newname{$i} eq $origname{$i}) {
+ $updateflag = 1;
+ }
+ }
+# Process file upload - phase three - modify primary file
+ if ($updateflag) {
+ my ($content,$rtncode);
+ my $updateflag = 0;
+ my $getstatus = &Apache::lonnet::getuploaded('GET',$primary_url,$coursedom,$coursenum,\$content,\$rtncode);
+ if ($getstatus eq 'ok') {
+ foreach my $item (keys %newname) {
+ if ($newname{$item} ne $origname{$item}) {
+ my $attrib_regexp = '';
+ if (@{$attribs{$item}} > 1) {
+ $attrib_regexp = join('|',@{$attribs{$item}});
+ } else {
+ $attrib_regexp = $attribs{$item}[0];
+ }
+ if ($content =~ m#($attrib_regexp\s*=\s*['"]?)\Q$origname{$item}\E(['"]?)#) {
+ }
+ $content =~ s#($attrib_regexp\s*=\s*['"]?)\Q$origname{$item}\E(['"]?)#$1$newname{$item}$2#gi;
+ }
+ if (exists($codebase{$item})) {
+ $content =~ s/(codebase\s*=\s*["']?)\Q$codebase{$item}\E(["']?)/$1.$2/i;
+ }
+ }
+# Save edited file.
+ my $saveresult;
+ my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $docuhome=$env{'course.'.$env{'request.course.id'}.'.home'};
+ my $url = &Apache::lonnet::store_edited_file($primary_url,$content,$docudom,$docuname,$docuhome,\$saveresult);
+ } else {
+ &Apache::lonnet::logthis('retrieval of uploaded file - '.$primary_url.' - for editing, failed: '.$getstatus);
+ }
+ }
+ }
+ }
+
+ unless ($showdoc || $upload_result eq 'phasetwo') {
# -----------------------------------------------------------------------------
my %lt=&Apache::lonlocal::texthash(
'uplm' => 'Upload a new main course document',
@@ -2184,7 +2347,8 @@
'imsf' => 'Import IMS package',
'file' => 'File',
'title' => 'Title',
- 'comment' => 'Comment'
+ 'comment' => 'Comment',
+ 'parse' => 'If HTML file, upload embedded images/multimedia files'
);
# -----------------------------------------------------------------------------
if ($allowed) {
@@ -2251,7 +2415,7 @@
#$postexec='self.close();';
}
$hadchanges=0;
- &editor($r,$coursenum,$coursedom,$folder,$allowed);
+ &editor($r,$coursenum,$coursedom,$folder,$allowed,$upload_output);
if ($hadchanges) {
&mark_hash_old()
}
@@ -2280,6 +2444,13 @@
<input type="text" size="50" name="comment">
$uploadtag
<input type="hidden" name="cmd" value="upload_default">
+<br />
+<nobr>
+$lt{'parse'}?
+<input type="checkbox" name="parserflag" />
+</nobr>
+<br />
+<br />
<nobr>
<input type="submit" value="$lt{'upld'}">
$help{'Uploading_From_Harddrive'}
@@ -2532,11 +2703,13 @@
}
$r->print('</table>');
} else {
+ unless ($upload_result eq 'phasetwo') {
# -------------------------------------------------------- This is showdoc mode
- $r->print("<h1>".&mt('Uploaded Document').' - '.
+ $r->print("<h1>".&mt('Uploaded Document').' - '.
&Apache::lonnet::gettitle($r->uri).'</h1><p>'.
&mt('It is recommended that you use an up-to-date virus scanner before handling this file.')."</p><p><table>".
- &entryline(0,&mt("Click to download or use your browser's Save Link function"),$showdoc).'</table></p>');
+ &entryline(0,&mt("Click to download or use your browser's Save Link function"),$showdoc).'</table></p>');
+ }
}
}
$r->print('</body></html>');
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.636 loncom/lonnet/perl/lonnet.pm:1.637
--- loncom/lonnet/perl/lonnet.pm:1.636 Wed May 25 17:33:35 2005
+++ loncom/lonnet/perl/lonnet.pm Sat Jun 11 09:38:47 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.636 2005/05/25 21:33:35 albertel Exp $
+# $Id: lonnet.pm,v 1.637 2005/06/11 13:38:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -47,6 +47,7 @@
use GDBM_File;
use Apache::Constants qw(:common :http);
use HTML::LCParser;
+use HTML::Parser;
use Fcntl qw(:flock);
use Apache::lonlocal;
use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
@@ -1132,7 +1133,10 @@
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
# input: action, courseID, current domain, home server for course, intended
-# path to file, source of file.
+# path to file, source of file, instruction to parse file for objects,
+# ref to hash for embedded objects,
+# ref to hash for codebase of java objects.
+#
# output: url to file (if action was uploaddoc),
# ok if successful, or diagnostic message otherwise (if action was propagate or copy)
#
@@ -1155,10 +1159,10 @@
# /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
# and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file
# in course's home server.
-
+#
sub process_coursefile {
- my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;
+ my ($action,$docuname,$docudom,$docuhome,$file,$source,$parser,$allfiles,$codebase)=@_;
my $fetchresult;
if ($action eq 'propagate') {
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
@@ -1169,16 +1173,7 @@
my $fname = $file;
($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
$fpath=$docudom.'/'.$docuname.'/'.$fpath;
- my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
- unless ($fpath eq '') {
- my @parts=split('/',$fpath);
- foreach my $part (@parts) {
- $filepath.= '/'.$part;
- if ((-e $filepath)!=1) {
- mkdir($filepath,0777);
- }
- }
- }
+ my $filepath = &build_filepath($fpath);
if ($action eq 'copy') {
if ($source eq '') {
$fetchresult = 'no source file';
@@ -1193,6 +1188,12 @@
open(my $fh,'>'.$filepath.'/'.$fname);
print $fh $env{'form.'.$source};
close($fh);
+ if ($parser eq 'parse') {
+ my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase);
+ unless ($parse_result eq 'ok') {
+ &logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
+ }
+ }
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
$docuhome);
if ($fetchresult eq 'ok') {
@@ -1211,6 +1212,43 @@
return $fetchresult;
}
+sub build_filepath {
+ my ($fpath) = @_;
+ my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
+ unless ($fpath eq '') {
+ my @parts=split('/',$fpath);
+ foreach my $part (@parts) {
+ $filepath.= '/'.$part;
+ if ((-e $filepath)!=1) {
+ mkdir($filepath,0777);
+ }
+ }
+ }
+ return $filepath;
+}
+
+sub store_edited_file {
+ my ($primary_url,$content,$docudom,$docuname,$docuhome,$fetchresult) = @_;
+ my $file = $primary_url;
+ $file =~ s#^/uploaded/$docudom/$docuname/##;
+ my $fpath = '';
+ my $fname = $file;
+ ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
+ $fpath=$docudom.'/'.$docuname.'/'.$fpath;
+ my $filepath = &build_filepath($fpath);
+ open(my $fh,'>'.$filepath.'/'.$fname);
+ print $fh $content;
+ close($fh);
+ $$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
+ $docuhome);
+ if ($$fetchresult eq 'ok') {
+ return '/uploaded/'.$fpath.'/'.$fname;
+ } else {
+ &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file. ' to host '.$docuhome.': '.$$fetchresult);
+ return '/adm/notfound.html';
+ }
+}
+
sub clean_filename {
my ($fname)=@_;
# Replace Windows backslashes by forward slashes
@@ -1233,7 +1271,7 @@
sub userfileupload {
- my ($formname,$coursedoc,$subdir)=@_;
+ my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_;
if (!defined($subdir)) { $subdir='unknown'; }
my $fname=$env{'form.'.$formname.'.filename'};
$fname=&clean_filename($fname);
@@ -1266,21 +1304,21 @@
$docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
$docuhome=$env{'course.'.$env{'request.course.id'}.'.home'};
if ($env{'form.folder'} =~ m/^default/) {
- return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+ return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase);
} else {
$fname=$env{'form.folder'}.'/'.$fname;
- return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname);
+ return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname,$parser,$allfiles,$codebase);
}
} else {
$docuname=$env{'user.name'};
$docudom=$env{'user.domain'};
$docuhome=$env{'user.home'};
- return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+ return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase);
}
}
sub finishuserfileupload {
- my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
+ my ($docuname,$docudom,$docuhome,$formname,$fname,$parser,$allfiles,$codebase) = @_;
my $path=$docudom.'/'.$docuname.'/';
my $filepath=$perlvar{'lonDocRoot'};
my ($fnamepath,$file);
@@ -1303,6 +1341,12 @@
print FH $env{'form.'.$formname};
close(FH);
}
+ if ($parser eq 'parse') {
+ my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,$codebase);
+ unless ($parse_result eq 'ok') {
+ &logthis('Failed to parse '.$filepath.$file.' for embedded media: '.$parse_result);
+ }
+ }
# Notify homeserver to grep it
#
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
@@ -1317,6 +1361,133 @@
}
}
+sub extract_embedded_items {
+ my ($filepath,$file,$allfiles,$codebase) = @_;
+ my @state = ();
+ my %javafiles = (
+ codebase => '',
+ code => '',
+ archive => ''
+ );
+ my %mediafiles = (
+ src => '',
+ movie => '',
+ );
+ my $p = HTML::Parser->new
+ (
+ xml_mode => 1,
+ start_h =>
+ [sub {
+ my ($tagname, $attr) = @_;
+ push (@state, $tagname);
+ if (lc($tagname) eq 'img') {
+ if (exists($$allfiles{$attr->{'src'}})) {
+ unless (grep/^src$/,@{$$allfiles{$attr->{'src'}}}) {
+ push (@{$$allfiles{$attr->{'src'}}},&escape('src'));
+ }
+ } else {
+ @{$$allfiles{$attr->{'src'}}} = (&escape('src'));
+ }
+ }
+ if (lc($tagname) eq 'object') {
+ foreach my $item (keys (%javafiles)) {
+ $javafiles{$item} = '';
+ }
+ }
+ if (lc($state[-2]) eq 'object') {
+ if (lc($tagname) eq 'param') {
+ my $name = lc($attr->{'name'});
+ foreach my $item (keys (%mediafiles)) {
+ if ($name eq $item) {
+ if (exists($$allfiles{$attr->{'value'}})) {
+ unless(grep/^value$/,@{$$allfiles{$attr->{'value'}}}) {
+ push(@{$$allfiles{$attr->{'value'}}},&escape('value'));
+ }
+ } else {
+ @{$$allfiles{$attr->{'value'}}} = (&escape('value'));
+ }
+ last;
+ }
+ }
+ foreach my $item (keys (%javafiles)) {
+ if ($name eq $item) {
+ $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}) {
+ $javafiles{$item} = $attr->{$item};
+ last;
+ }
+ }
+ foreach my $item (keys (%mediafiles)) {
+ if ($attr->{$item}) {
+ if (exists($$allfiles{$attr->{$item}})) {
+ unless (grep/^$item$/,@{$$allfiles{$item}}) {
+ push(@{$$allfiles{$attr->{$item}}},&escape($item));
+ }
+ } else {
+ @{$$allfiles{$attr->{$item}}} = (&escape($item));
+ }
+ last;
+ }
+ }
+ }
+ }, "tagname, attr"],
+ text_h =>
+ [sub {
+ my ($text) = @_;
+ }, "dtext"],
+ end_h =>
+ [sub {
+ my ($tagname) = @_;
+ unless ($javafiles{'codebase'} eq '') {
+ $javafiles{'codebase'} .= '/';
+ }
+ if (lc($tagname) eq 'object') {
+ &extract_java_items(\%javafiles,$allfiles,$codebase);
+ }
+ if (lc($tagname) eq 'embed') {
+ unless (lc($state[-2]) eq 'object') {
+ &extract_java_items(\%javafiles,$allfiles,$codebase);
+ }
+ }
+ pop @state;
+ }, "tagname"],
+ );
+ $p->parse_file($filepath.'/'.$file);
+ $p->eof;
+ return 'ok';
+}
+
+sub extract_java_items {
+ my ($javafiles,$allfiles,$codebase) = @_;
+ foreach my $item (keys (%{$javafiles})) {
+ unless ($item eq 'codebase') {
+ if ($$javafiles{$item} ne '') {
+ if (exists($$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}})) {
+ unless (grep/^$item$/,@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}}) {
+ push(@{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}},&escape($item));
+ }
+ } else {
+ @{$$allfiles{$$javafiles{'codebase'}.$$javafiles{$item}}} = (&escape($item));
+ $$codebase{$$javafiles{'codebase'}.$$javafiles{$item}} = $$javafiles{'codebase'};
+
+ }
+ }
+ }
+ }
+}
+
sub removeuploadedurl {
my ($url)=@_;
my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
--raeburn1118497129--