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

    1: package Apache::imsprocessor;
    2: 
    3: use Apache::lonnet;
    4: use LONCAPA::Configuration;
    5:  
    6: sub create_tempdir {
    7:     my ($caller,$pathinfo) = @_;   
    8:     my $configvars = &LONCAPA::Configuration::read_conf('loncapa.conf');
    9:     my $tempdir;
   10:     if ($caller eq 'DOCS') {
   11:         $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
   12:         if (!-e "$tempdir") {
   13:             mkdir("$tempdir",0755);
   14:         }
   15:     } elsif ($caller eq "CSTR") {
   16:         if (!-e "$pathinfo/temp") {
   17:             mkdir("$pathinfo/temp",0755);
   18:         }
   19:         $tempdir =  $pathinfo.'/temp';
   20:     }
   21:     return $tempdir;
   22: }
   23: 
   24: 
   25: sub expand_zip {
   26:     my ($tempdir,$filename) = @_;
   27:     my $zipfile = "$tempdir/$filename";
   28:     if ($filename =~ m|\.zip$|i) {
   29:         open(OUTPUT, "unzip -o $zipfile -d $tempdir  2> /dev/null |");
   30:         while (<OUTPUT>) {
   31:             print "$_<br />";
   32:         }
   33:         close(OUTPUT);
   34:     } else {
   35:         return 'nozip';
   36:     }
   37:     if ($filename =~ m|\.zip$|i) {
   38:         unlink($zipfile);
   39:     }
   40:     return 'ok';
   41: }
   42: 
   43: sub process_manifest {
   44:     my ($cms,$tempdir,$resources,$items,$hrefs) = @_;
   45:     my %toc = (
   46:               bb5 => 'tableofcontents',
   47:               angel => 'organization',
   48:               );
   49: 
   50:     my @state = ();
   51:     my $itm = '';
   52:     my $identifier = '';
   53:     my @seq = "Top";
   54:     my $lastitem;
   55:     $$items{'Top'}{'contentscount'} = 0;
   56: 
   57:     unless (-e "$tempdir/imsmanifest.xml") {
   58:         return 'nomanifest';
   59:     } 
   60: 
   61:     my $xmlfile = $tempdir.'/imsmanifest.xml';
   62:     my $p = HTML::Parser->new
   63:     (
   64:        xml_mode => 1,
   65:        start_h =>
   66:            [sub {
   67:                 my ($tagname, $attr) = @_;
   68:                 push @state, $tagname;
   69:                 my $num = @state - 3;
   70:                 my $start = $num;
   71:                 my $statestr = '';
   72:                 foreach (@state) {
   73:                     $statestr .= "$_ ";
   74:                 }
   75:                 if ( ($state[0] eq "manifest") && ($state[1] eq "organizations") && ($state[2] eq $toc{$cms}) ) {
   76:                     my $searchstr = "manifest organizations $toc{$cms}";
   77:                     while ($num > 0) {
   78:                         $searchstr .= " item";
   79:                         $num --; 
   80:                     }
   81:                     if (("@state" eq $searchstr) && (@state > 3)) {
   82:                         $itm = $attr->{identifier};              
   83:                         %{$$items{$itm}} = ();
   84:                         $$items{$itm}{contentscount} = 0;
   85:                         if ($cms eq 'bb5') {
   86:                             $$items{$itm}{resnum} = $attr->{identifierref};
   87:                             $$items{$itm}{title} = $attr->{title};
   88:                         } elsif ($cms eq 'angel') {
   89:                             if ($attr->{identifierref} =~ m/^res(.+)$/) {
   90:                                 $$items{$itm}{resnum} = $1;
   91:                             }
   92:                         }
   93:                         unless (defined(%{$resources{$$items{$itm}{resnum}}}) ) {
   94:                             %{$resources{$$items{$itm}{resnum}}} = ();
   95:                         }
   96:                         $$resources{$$items{$itm}{resnum}}{revitm} = $itm;
   97: 
   98:                         if ($start > @seq) {
   99:                             unless ($lastitem eq '') {
  100:                                 push @seq, $lastitem;
  101:                                 unless ( defined($contents{$seq[-1]}) ) {
  102:                                     @{$contents{$seq[-1]}} = ();
  103:                                 }
  104:                                 push @{$contents{$seq[-1]}},$itm;
  105:                                 $$items{$itm}{parentseq} = $seq[-1];
  106:                             }
  107:                         }
  108:                         elsif ($start < @seq) {
  109:                             my $diff = @seq - $start;
  110:                             while ($diff > 0) {
  111:                                 pop @seq;
  112:                                 $diff --;
  113:                             }
  114:                             if (@seq) {
  115:                                 push @{$contents{$seq[-1]}}, $itm;
  116:                             }
  117:                         } else {
  118:                             push @{$contents{$seq[-1]}}, $itm;
  119:                         }
  120:                         my $path;
  121:                         if (@seq > 1) {
  122:                             $path = join(',',@seq);
  123:                         } elsif (@seq > 0) {
  124:                             $path = $seq[0];
  125:                         }
  126:                         $$items{$itm}{filepath} = $path;
  127:                         $$items{$seq[-1]}{contentscount} ++;
  128:                         $lastitem = $itm;
  129:                     }
  130:                 } elsif ("@state" eq "manifest resources resource" ) {
  131:                     $identifier = $attr->{identifier};
  132:                     if ($cms eq 'bb5') {                 
  133:                         $$resources{$identifier}{file} = $attr->{file};
  134:                         $$resources{$identifier}{type} = $attr->{type};
  135:                     } elsif ($cms eq 'angel') {
  136:                         $identifier = substr($identifier,3);
  137:                         if ($attr->{href} =~ m-^_assoc/$identifier/(.+)$-) {
  138:                             $$resources{$identifier}{file} = $1;
  139:                         }                    
  140:                     }
  141:                     @{$$hrefs{$identifier}} = ();
  142:                 } elsif ("@state" eq "manifest resources resource file") {
  143:                     if ($cms eq 'bb5') {
  144:                         push @{$$hrefs{$identifier}},$attr->{href};
  145:                     } elsif ($cms eq 'angel') {
  146:                         if ($attr->{href} =~ m/^_assoc\\$identifier\\(.+)$/) {
  147:                             push @{$$hrefs{$identifier}},$1;
  148:                         } elsif ($attr->{href} =~ m/^Icons\\icon(\w+)\.gif/) {
  149:                             $$resources{$identifier}{type} = $1;
  150:                         } 
  151:                     }
  152:                 }
  153:            }, "tagname, attr"],
  154:         text_h =>
  155:             [sub {
  156:                 my ($text) = @_;
  157:               }, "dtext"],
  158:         end_h =>
  159:               [sub {
  160:                   my ($tagname) = @_;
  161:                   pop @state;
  162:                }, "tagname"],
  163:     );
  164:     $p->parse_file($xmlfile);
  165:     $p->eof;
  166: 
  167:     foreach my $itm (keys %contents) {
  168:         @{$$items{$itm}{contents}} = @{$contents{$itm}};
  169:     }
  170:     return 'ok' ;
  171: }
  172: 
  173: sub target_resources {
  174:     my ($resources,$oktypes,$targets) = @_; 
  175:     foreach my $key (keys %{$resources}) {
  176:         if ( defined($$oktypes{$$resources{$key}{type}}) ) {
  177:             push @{$targets}, $key;
  178:         }
  179:     }
  180:     return;
  181: }
  182: 
  183: 
  184: sub copy_resources {
  185:     my ($context,$cms,$hrefs,$tempdir,$targets,$url,$crs,$cdom,$chome,$destdir) = @_;
  186:     if ($context eq 'DOCS') {
  187:         my $path= $cdom.'/'.$crs.'/';
  188:         my $filepath= $Apache::lonnet::perlvar{'lonDocRoot'};
  189:         my @parts=split(/\//,$filepath.'/userfiles/'.$path);
  190:         for (my $count=4; $count<@parts; $count++) {
  191:             $filepath.="/$parts[$count]";
  192:             if ((-e $filepath)!=1) {
  193: 	        mkdir($filepath,0777);
  194:             }
  195:         }
  196:         foreach my $key (sort keys %{$hrefs}) {
  197:             if (grep/^$key$/,@{$targets}) {
  198:                 %{$url{$key}} = ();
  199:                 foreach my $file (@{$$hrefs{$key}}) {
  200:                     if ($cms eq 'bb5') {
  201:                         my $filename = $file;
  202:                         $filename =~ s/\//_/g;
  203:                         $filename = 'ims_'.$key.'_'.$filename;
  204:                         my $destination = $filepath.'/'.$filename;
  205:                         if (-e "$destination") {
  206:                             print STDERR "Can not copy file to $destination, as $filename already exists\n";
  207:                         } else {
  208:                             system("cp $tempdir/$key/$file $filepath/$filename");
  209:                             my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$filename,$chome);
  210: 
  211:                             if ($fetchresult eq 'ok') {
  212:                                 $$url{$key}{$filename} = '/uploaded/'.$path.$fname;
  213:                             } else {
  214:                                 &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$filename.' to host '.$chome.': '.$fetchresult);
  215:                                 $$url{$key}{$filename} = '/adm/notfound.html';
  216:                             }    
  217:                         }
  218:                     } elsif ($cms eq 'angel') {
  219:                         $file =~ s-\\-/-g;
  220:                         my $filename = $file;
  221:                         $filename =~ s/\//_/g;
  222:                         unless ($file eq 'pg'.$key.'.htm') {
  223:                             $filename = 'ims_'.$key.'_'.$filename;
  224:                             my $destination = $filepath.'/'.$filename;
  225:                             if (-e "$destination") {
  226:                                 print STDERR "Can not copy file to $destination, as $filename already exists\n";
  227:                             } else {
  228:                                 system("cp $tempdir/_assoc/$key/$file $filepath/$filename");
  229:                                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$cdom.'/'.$crs.'/'.$file,$chome);
  230:                                 if ($fetchresult eq 'ok') {
  231:                                     $$url{$key}{$filename} = '/uploaded/'.$path.$fname;
  232:                                 } else {
  233:                                     &Apache::lonnet::logthis('Failed to transfer '.$cdom.'/'.$crs.'/'.$filename.' to host '.$chome.': '.$fetchresult);
  234:                                     $$url{$key}{$filename} = '/adm/notfound.html';
  235:                                 }
  236:                             }
  237:                         }
  238:                     }
  239:                 }
  240:             }
  241:         }
  242:     } elsif ($context eq 'CSTR') {
  243:         if (!-e "$destdir/resfiles") {
  244:             mkdir("$destdir/resfiles",0755);
  245:         }
  246:         if ($cms eq 'angel') { 
  247:             foreach my $key (sort keys %href) {
  248:                 foreach my $file (@{$href{$key}}) {
  249:                     $file =~ s-\\-/-g;
  250:                     unless ($file eq 'pg'.$key.'.htm') {
  251:                         if (!-e "$destdir/resfiles/$key") {
  252:                             mkdir("$destdir/resfiles/$key",0755);
  253:                         }
  254:                     }
  255:                     my $filepath = $file;
  256:                     while ($filepath =~ m-(\w+)/(.+)-) {
  257:                         $filepath = $2;
  258:                         if (!-e "$destdir/resfiles/$key/$1") {
  259:                             mkdir("$destdir/resfiles/$key/$1",0755);
  260:                         }
  261:                     }
  262:                     unless ($file eq 'pg'.$key.'.htm') {
  263:                         system("cp $tempdir/_assoc/$key/$file $destdir/resfiles/$key/$file");
  264:                     }
  265:                 }
  266:             }
  267:         } elsif ($cms eq 'bb5') {
  268:             foreach my $key (sort keys %href) {
  269:                 foreach my $file (@{$href{$key}}) {
  270:                     my $filepath = $file;
  271:                     if (!-e "$destdir/resfiles/$key") {
  272:                         mkdir("$destdir/resfiles/$key",0755);
  273:                     }
  274:                     while ($filepath =~ m-(\w+)/(.+)-) {
  275:                         $filepath = $2;
  276:                         if (!-e "$destdir/resfiles/$key/$1") {
  277:                             mkdir("$destdir/resfiles/$key/$1",0755);
  278:                         }
  279:                     }
  280:                     system("cp $tempdir/$key/$file $destdir/resfiles/$key/$file");
  281:                 }
  282:             }
  283:         }
  284:     }
  285: }
  286: 
  287: 1;
  288: __END__
  289:    
  290: