[LON-CAPA-cvs] cvs: loncom /imspackages imsprocessor.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Tue, 03 May 2005 18:38:38 -0000
This is a MIME encoded message
--raeburn1115145518
Content-Type: text/plain
raeburn Tue May 3 14:38:38 2005 EDT
Modified files:
/loncom/imspackages imsprocessor.pm
Log:
Fetch remotely stored images, referred to img src tags, and store locally, and convert img tags. Other fix-ups to BB5 import code. xhtml compliance.
--raeburn1115145518
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20050503143838.txt"
Index: loncom/imspackages/imsprocessor.pm
diff -u loncom/imspackages/imsprocessor.pm:1.19 loncom/imspackages/imsprocessor.pm:1.20
--- loncom/imspackages/imsprocessor.pm:1.19 Thu Apr 7 02:56:22 2005
+++ loncom/imspackages/imsprocessor.pm Tue May 3 14:38:37 2005
@@ -24,6 +24,8 @@
package Apache::imsprocessor;
use Apache::lonnet;
+use LWP::UserAgent;
+use HTTP::Request::Common;
use LONCAPA::Configuration;
use strict;
@@ -1724,7 +1726,7 @@
$id = $attr->{id};
} elsif ( ($state[0] eq $toptag{$container}) && ($state[1] =~ m/^QUESTION_(\w+)$/) && ($state[2] eq "BODY") && ($state[3] eq "FLAGS") ) {
if ($state[4] eq "ISHTML") {
- $$settings{$id}{html} = $attr->{value};
+ $$settings{$id}{ishtml} = $attr->{value};
} elsif ($state[4] eq "ISNEWLINELITERAL") {
$$settings{$id}{newline} = $attr->{value};
}
@@ -2342,7 +2344,7 @@
if (!-e "$destdir/problems/$seqname") {
mkdir("$destdir/problems/$seqname",0755);
}
- my $newdir = "$destdir/problems/$seqname";
+ $newdir = "$destdir/problems/$seqname";
my $dbcontainerdir;
&build_problem_container($cms,$seqname,$destdir,'database',$seqname,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@{$$catinfo{$category}{contents}},$udom,$uname,$dirname,\$dbcontainerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
}
@@ -2370,14 +2372,18 @@
if (!-e "$destdir/problems/$dirtitle") {
mkdir("$destdir/problems/$dirtitle",0755);
}
- my $newdir = "$destdir/problems/$dirtitle";
+ $newdir = "$destdir/problems/$dirtitle";
}
- &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
+ if ($cms eq 'webct4') {
+ &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$qzdbsettings);
+ } else {
+ &build_problem_container($cms,$dirtitle,$destdir,$container,$res,$total,$sequencesfiles,$pagesfiles,$randompickflag,$context,\@allids,$udom,$uname,$dirname,\$containerdir,$cid,$cdom,$cnum,$catinfo,$settings);
+ }
if ($cms eq 'bb5') {
- &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
+ &write_bb5_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot);
} elsif ($cms eq 'bb6') {
- &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
+ &write_bb6_questions(\@allids,$containerdir,$context,$settings,$dirname,$destdir,$res,\%allanswers,\%allchoices,$total,$newdir,$cid,$cdom,$cnum);
}
}
@@ -2411,7 +2417,11 @@
my $probsrc = "/res/lib/templates/simpleproblem.problem";
if ($context eq 'CSTR') {
foreach my $id (@{$allids}) {
- $probtitle{$id} = $$settings{$id}{title};
+ if ($cms eq 'webct4') {
+ $probtitle{$id} = $$settings{$id}{title};
+ } else {
+ $probtitle{$id} = $$settings{title};
+ }
$probtitle{$id} =~ s/\s/_/g;
$probtitle{$id} =~ s/\W//g;
$probtitle{$id} .= '_'.$id;
@@ -2423,7 +2433,7 @@
$probdir =~ s/\W//g;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[0]}.problem";
} else {
- $probsrc="$dirname/problems/$dirtitle/$$allids[0].problem";
+ $probsrc="$dirname/problems/$dirtitle/$probtitle{$$allids[0]}.problem";
}
}
print $fh qq|<resource id="1" src="$probsrc" type="start" title="question_0001"></resource>|;
@@ -2447,7 +2457,7 @@
$probdir =~ s/\W//g;
$probsrc = "$dirname/problems/$probdir/$probtitle{$$allids[$j]}.problem";
} else {
- $probsrc = "$dirname/problems/$dirtitle/$$allids[$j].problem";
+ $probsrc = "$dirname/problems/$dirtitle/$probtitle{$$allids[$j]}.problem";
}
}
print $fh qq|
@@ -2465,9 +2475,19 @@
}
sub write_bb5_questions {
- my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum) = @_;
+ my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices,$total,$newdir,$cid,$cdom,$cnum,$docroot) = @_;
my $qnum = 0;
foreach my $id (@{$allids}) {
+ if ($$settings{$id}{ishtml} eq 'true') {
+ $$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
+ }
+ if ($$settings{$id}{text} =~ m#<img src=['"]?(https?://[^\s]+/)([^/\s\'"]+)['"]?[^>]*>#) {
+ if (&retrieve_image($context,$res,$dirname,$cdom,$cnum,$docroot,$destdir,$1,$2) eq 'ok') {
+ $$settings{$id}{text} =~ s#(<img src=['"]?)(https?://[^\s]+/)([^/\s'"]+)(['"]?[^>]*>)#$1../../resfiles/$res/webimages/$3$4#g;
+ }
+ }
+ $$settings{$id}{text} =~ s#(<img src=[^>]+)/*>#$1 />#gi;
+ $$settings{$id}{text} =~ s#<br>#<br />#g;
$qnum ++;
my $output;
my $permcontainer = $containerdir;
@@ -2811,7 +2831,11 @@
if ($context eq 'CSTR') {
$output .= qq|</problem>
|;
- open(PROB,">$newdir/problems/$id.problem");
+ my $title = $$settings{title};
+ $title =~ s/\s/_/g;
+ $title =~ s/\W//g;
+ $title .= '_'.$id;
+ open(PROB,">:utf8", "$newdir/$title.problem");
print PROB $output;
close PROB;
} else {
@@ -2841,13 +2865,13 @@
if ($$settings{$id}{texttype} eq 'text/html') {
$$settings{$id}{text} = &HTML::Entities::decode($$settings{$id}{text});
$$settings{$id}{text} = &Apache::lonxml::htmlclean($$settings{$id}{text});
- $$settings{$id}{text} =~ s#(<img src=")([^>]+)>#$1../../resfiles/$2 />#gi;
- $$settings{$id}{text} =~ s#<hr>#<hr />#g;
+ $$settings{$id}{text} =~ s#(<img src=["']?)([^>]+)(/?>)#$1../../resfiles/$2 />#gi;
+ $$settings{$id}{text} =~ s#<([bh])r>#<$1r />#g;
# $$settings{$id}{text} =~ s#<p>#</p><p>#g;
# $$settings{$id}{text} =~ s#</p></p>#</p>#;
# $$settings{$id}{text} =~ s#<p></p>##g;
$$settings{$id}{text} =~ s#<p>#<br /><br />#g;
- $$settings{$id}{text} =~ s#<\\p>##g;
+ $$settings{$id}{text} =~ s#</p>##g;
}
if ($$settings{$id}{class} eq 'numerical') {
foreach my $numid (@{$$settings{$id}{numids}}) {
@@ -3332,7 +3356,49 @@
}
sub write_bb6_questions {
- my ($allids,$containerdir,$context,$settings,$dirname,$res,$allanswers,$allchoices) = @_;
+ my ($allids,$containerdir,$context,$settings,$dirname,$destdir,$res,$allanswers,$allchoices) = @_;
+}
+
+sub retrieve_image {
+ my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
+ my $contents;
+ my $url = $urlpath.$filename;
+ my $ua=new LWP::UserAgent;
+ my $request=new HTTP::Request('GET',$url);
+ my $response=$ua->request($request);
+ if ($response->is_success) {
+ $contents = $response->content;
+ if (!-e "$docroot/$res") {
+ mkdir("$docroot/$res",0755);
+ }
+ if (!-e "$docroot/$res/webimages") {
+ mkdir("$docroot/$res/webimages",0755);
+ }
+ open(my $fh,">$docroot/$res/webimages/$filename");
+ print $fh $contents;
+ close($fh);
+ if ($context eq 'DOCS') {
+ my $chome = &Apache::lonnet::homeserver($cname,$cdom);
+ my $copyfile = $dirname.'/'.$filename;
+ my $source = "$docroot/$res/webimages/$filename";
+ my $fileresult;
+ if (-e $source) {
+ $fileresult = &Apache::lonnet::process_coursefile('copy',$cname,$cdom,$chome,$copyfile,$source);
+ }
+ return $fileresult;
+ } elsif ($context eq 'CSTR') {
+ if (!-e "$destdir/resfiles/$res") {
+ mkdir("$destdir/resfiles/$res",0755);
+ }
+ if (!-e "$destdir/resfiles/$res/webimages") {
+ mkdir("$destdir/resfiles/$res/webimages",0755);
+ }
+ rename("$docroot/$res/webimages/$filename","$destdir/resfiles/$res/webimages/$filename");
+ return 'ok';
+ }
+ } else {
+ return -1;
+ }
}
# ---------------------------------------------------------------- Process Blackboard Announcements
--raeburn1115145518--