Annotation of loncom/imspackages/imsprocessor.pm, revision 1.1
1.1 ! raeburn 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to imsprocessor.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / imspackages