version 1.2, 2004/03/09 16:44:01
|
version 1.3, 2004/03/16 19:20:58
|
Line 3 package Apache::imsprocessor;
|
Line 3 package Apache::imsprocessor;
|
use Apache::lonnet; |
use Apache::lonnet; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use strict; |
use strict; |
|
|
|
sub ims_config { |
|
my ($areas,$cmsmap,$areaname) = @_; |
|
@{$areas} = ("doc","extlink","announce","staff","board","quiz","survey","pool","users"); |
|
%{$$cmsmap{bb5}} = ( |
|
announce => 'resource/x-bb-announcement', |
|
board => 'resource/x-bb-discussionboard', |
|
doc => 'resource/x-bb-document', |
|
extlink => 'resource/x-bb-externallink', |
|
pool => 'assessment/x-bb-pool', |
|
quiz => 'assessment/x-bb-quiz', |
|
staff => 'resource/x-bb-staffinfo', |
|
survey => 'assessment/x-bb-survey', |
|
users => 'course/x-bb-user', |
|
); |
|
|
|
%{$$cmsmap{angel}} = ( |
|
board => 'BOARD', |
|
extlink => 'LINK', |
|
msg => 'MESSAGE', |
|
quiz => 'QUIZ', |
|
survey => 'FORM', |
|
); |
|
|
|
@{$$cmsmap{angel}{doc}} = ('FILE','PAGE'); |
|
|
|
|
|
%{$areaname} = ( |
|
announce => 'Announcements', |
|
board => 'Discussion Boards', |
|
doc => 'Documents, pages, and folders', |
|
extlink => 'Links to external sites', |
|
pool => 'Question pools', |
|
quiz => 'Quizzes', |
|
staff => 'Staff information', |
|
survey => 'Surveys', |
|
users => 'Enrollment', |
|
); |
|
|
|
} |
|
|
sub create_tempdir { |
sub create_tempdir { |
my ($caller,$pathinfo,$timenow) = @_; |
my ($context,$pathinfo,$timenow) = @_; |
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf'); |
my $tempdir; |
my $tempdir; |
if ($caller eq 'DOCS') { |
if ($context eq 'DOCS') { |
$tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo; |
$tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo; |
if (!-e "$tempdir") { |
if (!-e "$tempdir") { |
mkdir("$tempdir",0770); |
mkdir("$tempdir",0770); |
Line 17 sub create_tempdir {
|
Line 57 sub create_tempdir {
|
if (!-e "$tempdir") { |
if (!-e "$tempdir") { |
mkdir("$tempdir",0770); |
mkdir("$tempdir",0770); |
} |
} |
} elsif ($caller eq "CSTR") { |
} elsif ($context eq "CSTR") { |
if (!-e "$pathinfo/temp") { |
if (!-e "$pathinfo/temp") { |
mkdir("$pathinfo/temp",0770); |
mkdir("$pathinfo/temp",0770); |
} |
} |
Line 26 sub create_tempdir {
|
Line 66 sub create_tempdir {
|
return $tempdir; |
return $tempdir; |
} |
} |
|
|
|
sub uploadzip { |
|
my ($context,$tempdir,$source) = @_; |
|
my $fname; |
|
if ($context eq 'DOCS') { |
|
$fname=$ENV{'form.uploadname.filename'}; |
|
# Replace Windows backslashes by forward slashes |
|
$fname=~s/\\/\//g; |
|
# Get rid of everything but the actual filename |
|
$fname=~s/^.*\/([^\/]+)$/$1/; |
|
# Replace spaces by underscores |
|
$fname=~s/\s+/\_/g; |
|
# Replace all other weird characters by nothing |
|
$fname=~s/[^\w\.\-]//g; |
|
# See if there is anything left |
|
unless ($fname) { return 'error: no uploaded file'; } |
|
# Save the file |
|
chomp($ENV{'form.uploadname'}); |
|
open(my $fh,'>'.$tempdir.'/'.$fname); |
|
print $fh $ENV{'form.uploadname'}; |
|
close($fh); |
|
} elsif ($context eq 'CSTR') { |
|
if ($source =~ m/\/([^\/]+)$/) { |
|
$fname = $1; |
|
my $destination = $tempdir.'/'.$fname; |
|
rename($source,$destination); |
|
} |
|
} |
|
return $fname; |
|
} |
|
|
sub expand_zip { |
sub expand_zip { |
my ($tempdir,$filename) = @_; |
my ($tempdir,$filename) = @_; |
my $zipfile = "$tempdir/$filename"; |
my $zipfile = "$tempdir/$filename"; |
Line 60 sub process_manifest {
|
Line 130 sub process_manifest {
|
contentscount => 0, |
contentscount => 0, |
resnum => 'toplevel', |
resnum => 'toplevel', |
); |
); |
%{$$resources{'toplevel'}} = (); |
%{$$resources{'toplevel'}} = ( |
|
revitm => 'Top' |
|
); |
|
|
if ($cms eq 'angel') { |
if ($cms eq 'angel') { |
$$resources{'toplevel'}{type} = "FOLDER"; |
$$resources{'toplevel'}{type} = "FOLDER"; |
Line 212 sub copy_resources {
|
Line 284 sub copy_resources {
|
foreach my $file (@{$$hrefs{$key}}) { |
foreach my $file (@{$$hrefs{$key}}) { |
my $source = $tempdir.'/'.$key.'/'.$file; |
my $source = $tempdir.'/'.$key.'/'.$file; |
my $filename = ''; |
my $filename = ''; |
my $fpath = $timenow.'/resfiles/'.$key.'/'; |
my $fpath = $timenow.'/resfiles/'.$key.'/'; |
if ($cms eq 'bb5') { |
if ($cms eq 'angel') { |
if ($file =~ m-/-) { |
if ($file eq 'pg'.$key.'.htm') { |
my @items = split/\//,$file; |
next; |
$filename = pop @items; |
|
$fpath .= join('/',@items); |
|
$fpath .= '/'; |
|
} else { |
|
$filename = $file; |
|
} |
|
&Apache::lonnet::userfileupload(undef,'1',$filename,$fpath,$source); |
|
} elsif ($cms eq 'angel') { |
|
$file =~ s-\\-/-g; |
|
unless ($file eq 'pg'.$key.'.htm') { |
|
if ($file =~ m-/-) { |
|
my @items = split/\//,$file; |
|
$filename = pop @items; |
|
$fpath = join('/',@items); |
|
$fpath .= '/'; |
|
} else { |
|
$filename = $file; |
|
} |
|
&Apache::lonnet::userfileupload(undef,'1',$filename,$fpath,$source); |
|
} |
} |
} |
} |
|
$file =~ s-\\-/-g; |
|
$file = $fpath.$file; |
|
my $fileresult = &Apache::lonnet::process_coursefile('copy',$crs,$cdom,$chome,$file,$source); |
} |
} |
} |
} |
} |
} |
Line 274 sub copy_resources {
|
Line 330 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 { |
sub process_resinfo { |
my ($cms,$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) = @_; |
my ($cms,$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) = @_; |
my $board_id = time; |
my $board_id = time; |
Line 301 sub process_resinfo {
|
Line 387 sub process_resinfo {
|
&angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles); |
&angel_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$$resources{$key}{type},$$items{$$resources{$key}{revitm}}{title},$resrcfiles); |
} elsif ($$resources{$key}{type} eq "QUIZ") { |
} elsif ($$resources{$key}{type} eq "QUIZ") { |
%{$$resinfo{$key}} = (); |
%{$$resinfo{$key}} = (); |
|
push @{$quizzes}, $key; |
# &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); |
# &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); |
} elsif ($$resources{$key}{type} eq "FORM") { |
} elsif ($$resources{$key}{type} eq "FORM") { |
%{$$resinfo{$key}} = (); |
%{$$resinfo{$key}} = (); |
|
push @{$surveys}, $key; |
# &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); |
# &angel_assessment($key,$docroot,$dirname,$destdir,\%{$$resinfo{$key}},$resrcfiles); |
} elsif ($$resources{$key}{type} eq "DROPBOX") { |
} elsif ($$resources{$key}{type} eq "DROPBOX") { |
%{$$resinfo{$key}} = (); |
%{$$resinfo{$key}} = (); |
Line 312 sub process_resinfo {
|
Line 400 sub process_resinfo {
|
} elsif ($cms eq 'bb5') { |
} elsif ($cms eq 'bb5') { |
foreach my $key (sort keys %{$resources}) { |
foreach my $key (sort keys %{$resources}) { |
if ($$resources{$key}{type} eq "resource/x-bb-document") { |
if ($$resources{$key}{type} eq "resource/x-bb-document") { |
%{$$resinfo{$key}} = (); |
|
unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') { |
unless ($$items{$$resources{$key}{revitm}}{filepath} eq 'Top') { |
|
%{$$resinfo{$key}} = (); |
&process_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles); |
&process_content($key,$docroot,$destdir,\%{$$resinfo{$key}},$udom,$uname,$resrcfiles); |
} |
} |
} elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") { |
} elsif ($$resources{$key}{type} eq "resource/x-bb-staffinfo") { |
Line 355 sub process_resinfo {
|
Line 443 sub process_resinfo {
|
unless ($announce_handling eq 'ignore') { |
unless ($announce_handling eq 'ignore') { |
push @{$announcements}, $key; |
push @{$announcements}, $key; |
%{$$resinfo{$key}} = (); |
%{$$resinfo{$key}} = (); |
&process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$items,$resinfo,$seqstem,$resrcfiles); |
&process_announce($key,$docroot,$destdir,\%{$$resinfo{$key}},$resinfo,$seqstem,$resrcfiles); |
} |
} |
} |
} |
} |
} |
|
if (@{$announcements}) { |
|
$$items{'Top'}{'contentscount'} ++; |
|
} |
|
if (@{$boards}) { |
|
$$items{'Top'}{'contentscount'} ++; |
|
} |
|
if (@{$quizzes}) { |
|
$$items{'Top'}{'contentscount'} ++; |
|
} |
|
if (@{$surveys}) { |
|
$$items{'Top'}{'contentscount'} ++; |
|
|
|
} |
} |
} |
$$total{'board'} = $board_count; |
|
|
|
if (@{$announcements}) { |
$$total{'board'} = $board_count; |
$$items{'Top'}{'contentscount'} ++; |
$$total{'quiz'} = @{$quizzes}; |
} |
$$total{'surv'} = @{$surveys}; |
if (@{$boards}) { |
|
$$items{'Top'}{'contentscount'} ++; |
|
} |
|
if (@{$quizzes}) { |
|
$$items{'Top'}{'contentscount'} ++; |
|
$$total{'quiz'} = @{$quizzes}; |
|
} |
|
if (@{$surveys}) { |
|
$$items{'Top'}{'contentscount'} ++; |
|
$$total{'surv'} = @{$surveys}; |
|
} |
|
} |
} |
|
|
sub build_structure { |
sub build_structure { |
my ($cms,$context,$destdir,$resinfo,$items,$resources,$hrefs,$udom,$uname,$newdir,$timenow,$cdom,$crs,$timestamp,$total,$boards,$announcements,$quizzes,$surveys,$boardnum,$pagesfiles,$seqfiles,$topurls,$topnames) = @_; |
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) = @_; |
|
|
my %flag = (); |
my %flag = (); |
my %count = (); |
my %count = (); |
my %pagecontents = (); |
my %pagecontents = (); |
Line 571 sub build_structure {
|
Line 659 sub build_structure {
|
my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page'; |
my $filename = $destdir.'/pages/'.$key.'_'.$i.'.page'; |
open(PAGEFILE,">$filename"); |
open(PAGEFILE,">$filename"); |
print PAGEFILE qq|<map> |
print PAGEFILE qq|<map> |
<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}/$$items{$pagecontents{$key}[$i][0]}{resnum}.html" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource> |
<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][0]}{resnum}.html" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource> |
<link to="2" index="1" from="1">\n|; |
<link to="2" index="1" from="1">\n|; |
if (@{$pagecontents{$key}[$i]} == 1) { |
if (@{$pagecontents{$key}[$i]} == 1) { |
print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>|; |
print PAGEFILE qq|<resource src="" id="2" type="finish"></resource>\n|; |
} elsif (@{$pagecontents{$key}[$i]} == 2) { |
} elsif (@{$pagecontents{$key}[$i]} == 2) { |
print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][1]}{resnum}.html" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>|; |
print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][1]}{resnum}.html" id="2" type="finish" title="$$items{$pagecontents{$key}[$i][1]}{title}"></resource>\n|; |
} else { |
} else { |
for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) { |
for (my $j=1; $j<@{$pagecontents{$key}[$i]}-1; $j++) { |
my $curr_id = $j+1; |
my $curr_id = $j+1; |
Line 586 sub build_structure {
|
Line 674 sub build_structure {
|
<link to="$next_id" index="$curr_id" from="$curr_id">\n|; |
<link to="$next_id" index="$curr_id" from="$curr_id">\n|; |
} |
} |
my $final_id = @{$pagecontents{$key}[$i]}; |
my $final_id = @{$pagecontents{$key}[$i]}; |
print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][-1]}{resnum}/$$items{$pagecontents{$key}[$i][-1]}{resnum}.html" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|; |
print PAGEFILE qq|<resource src="$filestem/resfiles/$$items{$pagecontents{$key}[$i][-1]}{resnum}.html" id="$final_id" type="finish" title="$$items{$pagecontents{$key}[$i][-1]}{title}"></resource>\n|; |
} |
} |
print PAGEFILE "</map>"; |
print PAGEFILE "</map>"; |
close(PAGEFILE); |
close(PAGEFILE); |
Line 618 sub make_structure {
|
Line 706 sub make_structure {
|
$$flag{$key}{file} = 1; |
$$flag{$key}{file} = 1; |
} elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) ) { |
} elsif ($cms eq 'angel' && (($type eq "PAGE") || ($type eq "LINK")) ) { |
if ($$flag{$key}{page}) { |
if ($$flag{$key}{page}) { |
if ($$count{key}{page} == -1) { |
if ($$count{$key}{page} == -1) { |
print STDERR "Array index is -1, we shouldnt be here\n"; |
print STDERR "Array index is -1, we shouldnt be here, key is $key, type is $type\n"; |
} else { |
} else { |
push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem; |
push @{$$pagecontents{$key}[$$count{$key}{page}]},$contitem; |
} |
} |
Line 651 sub process_specials {
|
Line 739 sub process_specials {
|
my $nextnum = 0; |
my $nextnum = 0; |
my $seqstem = ''; |
my $seqstem = ''; |
if ($context eq 'CSTR') { |
if ($context eq 'CSTR') { |
$seqstem = '/res/'.$udom.'/'.$uname.'/'.$newdir; |
$seqstem = "/res/$udom/$uname/$newdir"; |
} elsif ($context eq 'DOCS') { |
} elsif ($context eq 'DOCS') { |
$seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow; |
$seqstem = '/uploaded/'.$cdom.'/'.$crs.'/'.$timenow; |
} |
} |
Line 1542 sub process_assessment {
|
Line 1630 sub process_assessment {
|
foreach my $id (@allids) { |
foreach my $id (@allids) { |
my $output = qq|<problem> |
my $output = qq|<problem> |
|; |
|; |
$$total{problem} ++; |
$$total{prob} ++; |
if ($$settings{$id}{class} eq "QUESTION_ESSAY") { |
if ($$settings{$id}{class} eq "QUESTION_ESSAY") { |
$output .= qq|<startouttext />$$settings{$id}{text}<endouttext /> |
$output .= qq|<startouttext />$$settings{$id}{text}<endouttext /> |
<essayresponse> |
<essayresponse> |
Line 1751 sub process_assessment {
|
Line 1839 sub process_assessment {
|
|
|
# ---------------------------------------------------------------- Process Blackboard Announcements |
# ---------------------------------------------------------------- Process Blackboard Announcements |
sub process_announce { |
sub process_announce { |
my ($res,$docroot,$destdir,$settings,$items,$globalresref,$seqstem,$resrcfiles) = @_; |
my ($res,$docroot,$destdir,$settings,$globalresref,$seqstem,$resrcfiles) = @_; |
my $xmlfile = $docroot.'/'.$res.".dat"; |
my $xmlfile = $docroot.'/'.$res.".dat"; |
my @state = (); |
my @state = (); |
my @assess = (); |
my @assess = (); |
Line 1812 sub process_announce {
|
Line 1900 sub process_announce {
|
|
|
if (@assess > 0) { |
if (@assess > 0) { |
foreach my $id (@assess) { |
foreach my $id (@assess) { |
$$settings{text} = "A $$settings{startassessment}{$id}{assessment_type}, entitled $$globalresref{$$settings{startassessment}{$id}{assessment_id}}{title} is available. Click <a href='$seqstem/$$items{$$settings{startassessment}{$id}{assessment_id}}{revitm}.sequence'>here</a> to enter the folder the contains the problems in this assessment."; |
$$settings{text} = "A $$settings{startassessment}{$id}{assessment_type}, entitled $$globalresref{$$settings{startassessment}{$id}{assessment_id}}{title} is available. Click <a href='$seqstem/pages/$$settings{startassessment}{$id}{assessment_id}.page' target='quizpage'>here</a> to enter the page that contains the problems in this assessment."; |
} |
} |
} |
} |
|
|
Line 1825 sub process_announce {
|
Line 1913 sub process_announce {
|
<body bgcolor='#ffffff'> |
<body bgcolor='#ffffff'> |
<table> |
<table> |
<tr> |
<tr> |
<td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{date}</td> |
<td bgcolor='#CCCCFF'>$$settings{title} - announcement date: $$settings{dates}</td> |
</tr> |
</tr> |
</table> |
</table> |
<br/> |
<br/> |