package Apache::imsprocessor; use Apache::lonnet; use LONCAPA::Configuration; sub create_tempdir { my ($caller,$pathinfo) = @_; my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf'); my $tempdir; if ($caller eq 'DOCS') { $tempdir = $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo; if (!-e "$tempdir") { mkdir("$tempdir",0755); } } elsif ($caller eq "CSTR") { if (!-e "$pathinfo/temp") { mkdir("$pathinfo/temp",0755); } $tempdir = $pathinfo.'/temp'; } return $tempdir; } sub expand_zip { my ($tempdir,$filename) = @_; my $zipfile = "$tempdir/$filename"; if ($filename =~ m|\.zip$|i) { open(OUTPUT, "unzip -o $zipfile -d $tempdir 2> /dev/null |"); while () { print "$_
"; } close(OUTPUT); } else { return 'nozip'; } if ($filename =~ m|\.zip$|i) { unlink($zipfile); } return 'ok'; } sub process_manifest { my ($cms,$tempdir,$resources,$items,$hrefs) = @_; my %toc = ( bb5 => 'tableofcontents', angel => 'organization', ); my @state = (); my $itm = ''; my $identifier = ''; my @seq = "Top"; my $lastitem; $$items{'Top'}{'contentscount'} = 0; unless (-e "$tempdir/imsmanifest.xml") { return 'nomanifest'; } my $xmlfile = $tempdir.'/imsmanifest.xml'; my $p = HTML::Parser->new ( xml_mode => 1, start_h => [sub { my ($tagname, $attr) = @_; push @state, $tagname; my $num = @state - 3; my $start = $num; my $statestr = ''; foreach (@state) { $statestr .= "$_ "; } if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) { my $searchstr = "manifest organizations $toc{$cms}"; while ($num > 0) { $searchstr .= " item"; $num --; } if (("@state" eq $searchstr) && (@state > 3)) { $itm = $attr->{identifier}; %{$$items{$itm}} = (); $$items{$itm}{contentscount} = 0; if ($cms eq 'bb5') { $$items{$itm}{resnum} = $attr->{identifierref}; $$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]}} = (); } 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; } my $path; if (@seq > 1) { $path = join(',',@seq); } elsif (@seq > 0) { $path = $seq[0]; } $$items{$itm}{filepath} = $path; $$items{$seq[-1]}{contentscount} ++; $lastitem = $itm; } } elsif ("@state" eq "manifest resources resource" ) { $identifier = $attr->{identifier}; if ($cms eq 'bb5') { $$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}} = (); } elsif ("@state" eq "manifest resources resource file") { if ($cms eq 'bb5') { 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; } } } }, "tagname, attr"], text_h => [sub { my ($text) = @_; }, "dtext"], end_h => [sub { my ($tagname) = @_; pop @state; }, "tagname"], ); $p->parse_file($xmlfile); $p->eof; foreach my $itm (keys %contents) { @{$$items{$itm}{contents}} = @{$contents{$itm}}; } return 'ok' ; } sub target_resources { my ($resources,$oktypes,$targets) = @_; foreach my $key (keys %{$resources}) { if ( defined($$oktypes{$$resources{$key}{type}}) ) { push @{$targets}, $key; } } return; } sub copy_resources { my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$chome,$destdir) = @_; if ($context eq 'DOCS') { my $path= $cdom.'/'.$crs.'/'; my $filepath= $Apache::lonnet::perlvar{'lonDocRoot'}; my @parts=split(/\//,$filepath.'/userfiles/'.$path); for (my $count=4; $count<@parts; $count++) { $filepath.="/$parts[$count]"; if ((-e $filepath)!=1) { mkdir($filepath,0777); } } foreach my $key (sort keys %{$hrefs}) { if (grep/^$key$/,@{$targets}) { %{$url{$key}} = (); foreach my $file (@{$$hrefs{$key}}) { if ($cms eq 'bb5') { my $filename = $file; $filename =~ s/\//_/g; $filename = 'ims_'.$key.'_'.$filename; my $destination = $filepath.'/'.$filename; if (-e "$destination") { print STDERR "Can not copy file to $destination, as $filename already exists\n"; } else { system("cp $tempdir/$key/$file $filepath/$filename"); my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$filename,$chome); if ($fetchresult eq 'ok') { $$url{$key}{$filename} = '/uploaded/'.$path.$fname; } else { &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$filename.' to host '.$chome.': '.$fetchresult); $$url{$key}{$filename} = '/adm/notfound.html'; } } } elsif ($cms eq 'angel') { $file =~ s-\\-/-g; my $filename = $file; $filename =~ s/\//_/g; unless ($file eq 'pg'.$key.'.htm') { $filename = 'ims_'.$key.'_'.$filename; my $destination = $filepath.'/'.$filename; if (-e "$destination") { print STDERR "Can not copy file to $destination, as $filename already exists\n"; } else { system("cp $tempdir/_assoc/$key/$file $filepath/$filename"); my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome); if ($fetchresult eq 'ok') { $$url{$key}{$filename} = '/uploaded/'.$path.$fname; } else { &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$filename.' to host '.$chome.': '.$fetchresult); $$url{$key}{$filename} = '/adm/notfound.html'; } } } } } } } } elsif ($context eq 'CSTR') { if (!-e "$destdir/resfiles") { mkdir("$destdir/resfiles",0755); } if ($cms eq 'angel') { foreach my $key (sort keys %href) { foreach my $file (@{$href{$key}}) { $file =~ s-\\-/-g; unless ($file eq 'pg'.$key.'.htm') { if (!-e "$destdir/resfiles/$key") { mkdir("$destdir/resfiles/$key",0755); } } my $filepath = $file; while ($filepath =~ m-(\w+)/(.+)-) { $filepath = $2; if (!-e "$destdir/resfiles/$key/$1") { mkdir("$destdir/resfiles/$key/$1",0755); } } unless ($file eq 'pg'.$key.'.htm') { system("cp $tempdir/_assoc/$key/$file $destdir/resfiles/$key/$file"); } } } } elsif ($cms eq 'bb5') { foreach my $key (sort keys %href) { foreach my $file (@{$href{$key}}) { my $filepath = $file; if (!-e "$destdir/resfiles/$key") { mkdir("$destdir/resfiles/$key",0755); } while ($filepath =~ m-(\w+)/(.+)-) { $filepath = $2; if (!-e "$destdir/resfiles/$key/$1") { mkdir("$destdir/resfiles/$key/$1",0755); } } system("cp $tempdir/$key/$file $destdir/resfiles/$key/$file"); } } } } } 1; __END__