Return to imsprocessor.pm CVS log

Up to [LON-CAPA] / loncom / imspackages

Modularization of imsimport.pm -> imsprocessor.pm
imsprocessor.pm contains routines to allow import of IMS packages into both
an author's contrsuction space, and also into a course directly via the DOCS interface.

imsimportdocs provides the user interface for import on an IMS package directly into a course using the DOCS screen. Both are currently incomplete, as additional existing routines in imsimport.pm need to be modularized, (and ins ome cases modified) to support both DOCS and CSTR targets, before routines are moved to imsprocessor.pm

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 (<OUTPUT>) {
            print "$_<br />";
        }
        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__