--- loncom/imspackages/imsprocessor.pm 2004/12/23 18:38:45 1.13
+++ loncom/imspackages/imsprocessor.pm 2005/02/14 22:46:12 1.14
@@ -141,7 +141,7 @@ sub expand_zip {
}
sub process_manifest {
- my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo) = @_;
+ my ($cms,$tempdir,$resources,$items,$hrefs,$resinfo,$phase,$includedres,$includeditems) = @_;
my %toc = (
bb6 => 'organization',
bb5 => 'tableofcontents',
@@ -165,6 +165,8 @@ sub process_manifest {
$$resources{'toplevel'}{type} = "FOLDER";
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
$$resources{'toplevel'}{type} = 'resource/x-bb-document';
+ } else {
+ $$resources{'toplevel'}{type} = 'webcontent';
}
unless (-e "$tempdir/imsmanifest.xml") {
@@ -192,84 +194,88 @@ sub process_manifest {
$num --;
}
if (("@state" eq $searchstr) && (@state > 3)) {
- $itm = $attr->{identifier};
- %{$$items{$itm}} = ();
- $$items{$itm}{contentscount} = 0;
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- $$items{$itm}{resnum} = $attr->{identifierref};
- if ($cms eq 'bb5') {
- $$items{$itm}{title} = $attr->{title};
- }
- } elsif ($cms eq 'angel') {
- if ($attr->{identifierref} =~ m/^res(.+)$/) {
- $$items{$itm}{resnum} = $1;
- }
- }
- unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
- %{$$resources{$$items{$itm}{resnum}}} = ();
- }
- $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
-
- if ($start > @seq) {
- unless ($lastitem eq '') {
- push @seq, $lastitem;
- unless ( defined($contents{$seq[-1]}) ) {
- @{$contents{$seq[-1]}} = ();
+ $itm = $attr->{identifier};
+ if ($$includeditems{$itm} || $phase ne 'build') {
+ %{$$items{$itm}} = ();
+ $$items{$itm}{contentscount} = 0;
+ if ($cms eq 'bb5' || $cms eq 'bb6') {
+ $$items{$itm}{resnum} = $attr->{identifierref};
+ if ($cms eq 'bb5') {
+ $$items{$itm}{title} = $attr->{title};
+ }
+ } elsif ($cms eq 'angel') {
+ if ($attr->{identifierref} =~ m/^res(.+)$/) {
+ $$items{$itm}{resnum} = $1;
}
- push @{$contents{$seq[-1]}},$itm;
- $$items{$itm}{parentseq} = $seq[-1];
}
- }
- elsif ($start < @seq) {
- my $diff = @seq - $start;
- while ($diff > 0) {
- pop @seq;
- $diff --;
+ unless (defined(%{$$resources{$$items{$itm}{resnum}}}) ) {
+ %{$$resources{$$items{$itm}{resnum}}} = ();
}
- if (@seq) {
+ $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
+ if ($start > @seq) {
+ unless ($lastitem eq '') {
+ push @seq, $lastitem;
+ unless ( defined($contents{$seq[-1]}) ) {
+ @{$contents{$seq[-1]}} = ();
+ }
+ push @{$contents{$seq[-1]}},$itm;
+ $$items{$itm}{parentseq} = $seq[-1];
+ }
+ } elsif ($start < @seq) {
+ my $diff = @seq - $start;
+ while ($diff > 0) {
+ pop @seq;
+ $diff --;
+ }
+ if (@seq) {
+ push @{$contents{$seq[-1]}}, $itm;
+ }
+ } else {
push @{$contents{$seq[-1]}}, $itm;
}
- } else {
- push @{$contents{$seq[-1]}}, $itm;
- }
- my $path;
- if (@seq > 1) {
- $path = join(',',@seq);
- } elsif (@seq > 0) {
- $path = $seq[0];
- }
- $$items{$itm}{filepath} = $path;
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- if ($$items{$itm}{filepath} eq 'Top') {
- $$items{$itm}{resnum} = $itm;
- $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
- $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
- $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
+ my $path;
+ if (@seq > 1) {
+ $path = join(',',@seq);
+ } elsif (@seq > 0) {
+ $path = $seq[0];
}
+ $$items{$itm}{filepath} = $path;
+ if ($cms eq 'bb5' || $cms eq 'bb6') {
+ if ($$items{$itm}{filepath} eq 'Top') {
+ $$items{$itm}{resnum} = $itm;
+ $$resources{$$items{$itm}{resnum}}{type} = 'resource/x-bb-document';
+ $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
+ $$resinfo{$$items{$itm}{resnum}}{'isfolder'} = 'true';
+ }
+ }
+ $$items{$seq[-1]}{contentscount} ++;
+ $lastitem = $itm;
}
- $$items{$seq[-1]}{contentscount} ++;
- $lastitem = $itm;
}
} elsif ("@state" eq "manifest resources resource" ) {
$identifier = $attr->{identifier};
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- $$resources{$identifier}{file} = $attr->{file};
- $$resources{$identifier}{type} = $attr->{type};
- } elsif ($cms eq 'angel') {
- $identifier = substr($identifier,3);
- if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
- $$resources{$identifier}{file} = $1;
+ if ($$includedres{$identifier} || $phase ne 'build') {
+ if ($cms eq 'bb5' || $cms eq 'bb6') {
+ $$resources{$identifier}{file} = $attr->{file};
+ $$resources{$identifier}{type} = $attr->{type};
+ } elsif ($cms eq 'angel') {
+ $identifier = substr($identifier,3);
+ if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
+ $$resources{$identifier}{file} = $1;
+ }
}
+ @{$$hrefs{$identifier}} = ();
}
- @{$$hrefs{$identifier}} = ();
} elsif ("@state" eq "manifest resources resource file") {
- if ($cms eq 'bb5' || $cms eq 'bb6') {
- push @{$$hrefs{$identifier}},$attr->{href};
- } elsif ($cms eq 'angel') {
- if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
- push @{$$hrefs{$identifier}},$1;
- } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
- $$resources{$identifier}{type} = $1;
+ if ($$includedres{$identifier} || $phase ne 'build') {
+ if ($cms eq 'bb5' || $cms eq 'bb6') {
+ push @{$$hrefs{$identifier}},$attr->{href};
+ } elsif ($cms eq 'angel') {
+ if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
+ push @{$$hrefs{$identifier}},$1;
+ } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
+ $$resources{$identifier}{type} = $1;
+ }
}
}
}
@@ -278,8 +284,10 @@ sub process_manifest {
[sub {
my ($text) = @_;
if ($state[0] eq "manifest" && $state[1] eq "organizations" && $state[2] eq $toc{$cms} && $state[-1] eq "title") {
- if ($cms eq 'angel' || $cms eq 'bb6') {
- $$items{$itm}{title} = $text;
+ if ($$includeditems{$itm} || $phase ne 'build') {
+ if ($cms eq 'angel' || $cms eq 'bb6') {
+ $$items{$itm}{title} = $text;
+ }
}
}
}, "dtext"],
@@ -298,6 +306,35 @@ sub process_manifest {
return 'ok' ;
}
+sub get_imports {
+ my ($includeditems,$items,$resources,$importareas,$itm) = @_;
+ if (exists($$items{$itm}{resnum})) {
+ if ($$importareas{$$resources{$$items{$itm}{resnum}}{type}}) {
+ unless (exists($$includeditems{$itm})) {
+ $$includeditems{$itm} = 1;
+ }
+ }
+ }
+ if ($$items{$itm}{contentscount} > 0) {
+ foreach my $child (@{$$items{$itm}{contents}}) {
+ &get_imports($includeditems,$items,$resources,$importareas,$child);
+ }
+ }
+}
+
+sub get_parents {
+ my ($includeditems,$items,$itm) = @_;
+ my @pathitems = ();
+ if ($$items{$itm}{filepath} =~ m/,/) {
+ @pathitems = split/,/,$$items{$itm}{filepath};
+ } else {
+ $pathitems[0] = $$items{$itm}{filepath};
+ }
+ foreach (@pathitems) {
+ $$includeditems{$_} = 1;
+ }
+}
+
sub target_resources {
my ($resources,$oktypes,$targets) = @_;
foreach my $key (keys %{$resources}) {
@@ -334,28 +371,30 @@ sub copy_resources {
mkdir("$destdir/resfiles",0770);
}
foreach my $key (sort keys %{$hrefs}) {
- foreach my $file (@{$$hrefs{$key}}) {
- $file =~ s-\\-/-g;
- if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6') ) {
- if (!-e "$destdir/resfiles/$key") {
- mkdir("$destdir/resfiles/$key",0770);
- }
-
- my $filepath = $file;
- my $front = '';
- while ($filepath =~ m-(\w+)/(.+)-) {
- $front .= $1.'/';
- $filepath = $2;
- my $fulldir = "$destdir/resfiles/$key/$front";
- chop($fulldir);
- if (!-e "$fulldir") {
- mkdir("$fulldir",0770);
+ if (grep/^$key$/,@{$targets}) {
+ foreach my $file (@{$$hrefs{$key}}) {
+ $file =~ s-\\-/-g;
+ if ( ($cms eq 'angel' && $file ne 'pg'.$key.'.htm') || ($cms eq 'bb5') || ($cms eq 'bb6') ) {
+ if (!-e "$destdir/resfiles/$key") {
+ mkdir("$destdir/resfiles/$key",0770);
+ }
+
+ my $filepath = $file;
+ my $front = '';
+ while ($filepath =~ m-(\w+)/(.+)-) {
+ $front .= $1.'/';
+ $filepath = $2;
+ my $fulldir = "$destdir/resfiles/$key/$front";
+ chop($fulldir);
+ if (!-e "$fulldir") {
+ mkdir("$fulldir",0770);
+ }
+ }
+ if ($cms eq 'angel') {
+ rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
+ } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
+ rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
}
- }
- if ($cms eq 'angel') {
- rename("$tempdir/_assoc/$key/$file","$destdir/resfiles/$key/$file");
- } elsif ($cms eq 'bb5' || $cms eq 'bb6') {
- rename("$tempdir/$key/$file","$destdir/resfiles/$key/$file");
}
}
}
@@ -363,38 +402,8 @@ sub copy_resources {
}
}
-sub process_coursefile {
- my ($crs,$cdom,$chome,$file,$source)=@_;
- my $fetchresult = '';
- my $fpath = '';
- my $fname = $file;
- ($fpath,$fname) = ($file =~ m/^(.*)\/([^\/])$/);
- $fpath=$cdom.'/'.$crs.'/'.$fpath;
- my $filepath=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles';
- unless ($fpath eq '') {
- my @parts=split(/\//,$fpath);
- foreach my $part (@parts) {
- $filepath.= '/'.$part;
- if ((-e $filepath)!=1) {
- mkdir($filepath,0777);
- }
- }
- }
- if ($source eq '') {
- $fetchresult eq 'no source file provided';
- } else {
- my $destination = $filepath.'/'.$fname;
- rename($source,$destination);
- $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome);
- unless ($fetchresult eq 'ok') {
- &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$fname.' to host '.$chome.': '.$fetchresult);
- }
- }
- return $fetchresult;
-}
-
sub process_resinfo {
- my ($cms,$context,$docroot,$destdir,$items,$resources,$boards,$announcements,$quizzes,$surveys,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles) = @_;
+ my ($cms,$context,$docroot,$destdir,$items,$resources,$targets,$boards,$announcements,$quizzes,$surveys,$pools,$groups,$messages,$timestamp,$boardnum,$resinfo,$udom,$uname,$cdom,$crs,$db_handling,$user_handling,$total,$dirname,$seqstem,$resrcfiles,$packages,$hrefs,$pagesfiles,$sequencesfiles) = @_;
my $board_id = time;
my $board_count = 0;
my $announce_handling = 'include';
@@ -402,9 +411,15 @@ sub process_resinfo {
if ($crs =~ m/^(\d)(\d)(\d)/) {
$longcrs = $1.'/'.$2.'/'.$3.'/'.$crs;
}
+ if ($context eq 'CSTR') {
+ if (!-e "$destdir/resfiles") {
+ mkdir("$destdir/resfiles",0770);
+ }
+ }
if ($cms eq 'angel') {
my $currboard = '';
foreach my $key (sort keys %{$resources}) {
+ if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "BOARD") {
push @{$boards}, $key;
$$boardnum{$$resources{$key}{revitm}} = $board_count;
@@ -429,9 +444,11 @@ sub process_resinfo {
} elsif ($$resources{$key}{type} eq "DROPBOX") {
%{$$resinfo{$key}} = ();
}
+ }
}
} elsif ($cms eq 'bb5' || $cms eq 'bb6') {
foreach my $key (sort keys %{$resources}) {
+ if (grep/^$key$/,@{$targets}) {
if ($$resources{$key}{type} eq "resource/x-bb-document") {
unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') {
%{$$resinfo{$key}} = ();
@@ -455,6 +472,7 @@ sub process_resinfo {
} elsif ($$resources{$key}{type} eq "assessment/x-bb-pool") {
%{$$resinfo{$key}} = ();
&process_assessment($context,$key,$docroot,'pool',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);
+ push @{$pools}, $key;
} elsif ($$resources{$key}{type} eq "assessment/x-bb-quiz") {
%{$$resinfo{$key}} = ();
&process_assessment($context,$key,$docroot,'quiz',$dirname,$destdir,\%{$$resinfo{$key}},$total,$udom,$uname,$pagesfiles,$sequencesfiles);
@@ -479,6 +497,7 @@ sub process_resinfo {
&process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles);
}
}
+ }
}
if (@{$announcements}) {
$$items{'Top'}{'contentscount'} ++;
@@ -492,20 +511,25 @@ sub process_resinfo {
if (@{$surveys}) {
$$items{'Top'}{'contentscount'} ++;
}
+ if (@{$pools}) {
+ $$items{'Top'}{'contentscount'} ++;
+ }
}
$$total{'board'} = $board_count;
$$total{'quiz'} = @{$quizzes};
$$total{'surv'} = @{$surveys};
+ $$total{'pool'} = @{$pools};
}
sub build_structure {
- my ($cms,$context,$destdir,$items,$resinfo,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages) = @_;
+ my ($cms,$context,$destdir,$items,$resinfo,$resources,$targets,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$pools,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames,$packages,$includeditems) = @_;
my %flag = ();
my %count = ();
my %pagecontents = ();
my %seqtext = ();
my $topnum = 0;
+ my $topspecials = @$announcements + @$boards + @$quizzes + @$surveys + @$pools;
if (!-e "$destdir") {
mkdir("$destdir",0755);
@@ -537,6 +561,7 @@ sub build_structure {
}
foreach my $key (sort keys %{$items}) {
+ if ($$includeditems{$key}) {
%{$flag{$key}} = (
page => 0,
seq => 0,
@@ -562,9 +587,17 @@ sub build_structure {
$seqtext{$key} = "\n";
open(TOPFILE,">$destdir/sequences/Top.sequence");
print TOPFILE $seqtext{'Top'};
@@ -815,12 +860,14 @@ sub process_specials {
quizzes => 'quizzes',
surveys => 'surveys',
announcements => 'announcements',
+ pools => 'pools'
);
my %seqtitles = (
boards => 'Course Bulletin Boards',
quizzes => 'Course Quizzes',
surveys => 'Course Surveys',
announcements => 'Course Announcements',
+ pools => 'Course Question Pools'
);
$$topnum ++;
@@ -862,6 +909,8 @@ sub process_specials {
$specialsrc = "/adm/$udom/$uname/$$timestamp[0]/bulletinboard";
} elsif ($type eq 'announcements') {
$specialsrc = "$seqstem/resfiles/$$specials[0].html";
+ } elsif ($type eq 'pools') {
+ $specialsrc = "$seqstem/sequences/$$specials[0].sequence";
} else {
$specialsrc = "$seqstem/pages/$$specials[0].page";
}
@@ -1509,10 +1558,6 @@ sub process_assessment {
my @allids = ();
my %allanswers = ();
my %allchoices = ();
- my $resdir = '';
- if ($docroot =~ m|public_html/(.+)$|) {
- $resdir = $1;
- }
my $id; # the current question ID
my $answer_id; # the current answer ID
my %toptag = ( pool => 'POOL',
@@ -1697,7 +1742,7 @@ sub process_assessment {
($cdom,$cnum) = split/_/,$cid;
}
if ($context eq 'CSTR') {
- $probsrc="/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[0].problem";
+ $probsrc="/res/$udom/$uname/$dirname/problems/$dirtitle/$allids[0].problem";
}
print $fh qq||;
if (@allids == 1) {
@@ -1713,7 +1758,7 @@ sub process_assessment {
$curr_id = $j;
$next_id = $curr_id + 1;
if ($context eq 'CSTR') {
- $probsrc = "/res/$udom/$uname/$resdir/problems/$dirtitle/$allids[$j].problem";
+ $probsrc = "/res/$udom/$uname/$dirname/problems/$dirtitle/$allids[$j].problem";
}
print $fh qq|
@@ -2177,7 +2222,8 @@ sub process_content {
my $xmlfile = $docroot.'/'.$res.".dat";
my $destresdir = $destdir;
if ($context eq 'CSTR') {
- $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
+# $destresdir =~ s|/home/$user/public_html/|/res/$dom/$user/|;
+ $destresdir =~ s|/home/$user/public_html/|/priv/$user/|;
} elsif ($context eq 'DOCS') {
$destresdir =~ s|^/home/httpd/html/userfiles|/uploaded|;
}
@@ -2355,37 +2401,40 @@ sub process_content {
}
}
- open(FILE,">$destdir/resfiles/$res.html");
- push @{$resrcfiles}, "$res.html";
- my $htmldoc = 0;
-# if ($$settings{maindata}{text} =~ m-<(html|HTML)>.+<\\(html|HTML)-) {
- if ($$settings{maindata}{text} =~ m-<(html|HTML)>-) {
- $htmldoc = 1;
- }
- unless ($htmldoc) {
- print FILE qq|
+ if (!open(FILE,">$destdir/resfiles/$res.html")) {
+ &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
+ } else {
+ push @{$resrcfiles}, "$res.html";
+ my $htmldoc = 0;
+# if ($$settings{maindata}{text} =~ m-<(html|HTML)>.+<\\(html|HTML)-) {
+ if ($$settings{maindata}{text} =~ m-<(html|HTML)>-) {
+ $htmldoc = 1;
+ }
+ unless ($htmldoc) {
+ print FILE qq|
$$settings{title}
$fontcol
|;
- }
- unless ($$settings{title} eq '') {
- print FILE qq|$$settings{title}
\n|;
- }
- print FILE qq|
-$$settings{maindata}{text}
-$linktag|;
- unless ($htmldoc) {
- if (defined($$settings{maindata}{textcolor})) {
- print FILE qq||;
+ }
+ unless ($$settings{title} eq '') {
+ print FILE qq|$$settings{title}
\n|;
}
print FILE qq|
+$$settings{maindata}{text}
+$linktag|;
+ unless ($htmldoc) {
+ if (defined($$settings{maindata}{textcolor})) {
+ print FILE qq||;
+ }
+ print FILE qq|
|;
+ }
+ close(FILE);
}
- close(FILE);
}