[BACK]Return to imsprocessor.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / imspackages

Diff for /loncom/imspackages/imsprocessor.pm between versions 1.54.4.1 and 1.55

version 1.54.4.1, 2018/09/03 12:43:00 version 1.55, 2017/05/23 03:07:40
Line 29 Line 29
 package Apache::imsprocessor;  package Apache::imsprocessor;
   
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  
 use Apache::loncleanup;  use Apache::loncleanup;
 use Apache::lonlocal;  use Apache::lonlocal;
 use LWP::UserAgent;  
 use HTTP::Request::Common;  use HTTP::Request::Common;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use LONCAPA::LWPReq;
 use strict;  use strict;
   
 sub ims_config {  sub ims_config {
Line 100  sub create_tempdir { Line 99  sub create_tempdir {
     my ($context,$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;
     $pathinfo = &Apache::loncommon::clean_path($pathinfo);  
 # Collapse dots  
     $pathinfo =~ s/\.+/./g;  
     if ($context eq 'DOCS') {      if ($context eq 'DOCS') {
         $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;          $tempdir =  $$configvars{'lonDaemons'}.'/tmp/'.$pathinfo;
         if (!-e "$tempdir") {          if (!-e "$tempdir") {
Line 134  sub uploadzip { Line 130  sub uploadzip {
         $fname=~s/\s+/\_/g;          $fname=~s/\s+/\_/g;
 # Replace all other weird characters by nothing  # Replace all other weird characters by nothing
         $fname=~s/[^\w\.\-]//g;          $fname=~s/[^\w\.\-]//g;
 # Collapse dots  
         $fname=~s/\.+/./g;  
 # See if there is anything left  # See if there is anything left
         unless ($fname) { return 'error: no uploaded file'; }          unless ($fname) { return 'error: no uploaded file'; }
 # Save the file  # Save the file
         chomp($env{'form.uploadname'});          chomp($env{'form.uploadname'});
         open(my $fh,'>',"$tempdir/$fname");          open(my $fh,'>'.$tempdir.'/'.$fname);
         print $fh $env{'form.uploadname'};          print $fh $env{'form.uploadname'};
         close($fh);          close($fh);
     } elsif ($context eq 'CSTR') {      } elsif ($context eq 'CSTR') {
Line 994  sub build_structure { Line 988  sub build_structure {
                 $seqtext{$key} .= "</map>\n";                  $seqtext{$key} .= "</map>\n";
                 if ($cms eq 'webctce4' && $key ne 'Top') {                  if ($cms eq 'webctce4' && $key ne 'Top') {
                     push @{$seqfiles}, "$seqtitle.sequence";                      push @{$seqfiles}, "$seqtitle.sequence";
                     open(LOCFILE,'>',"$destdir/sequences/$seqtitle.sequence");                      open(LOCFILE,">$destdir/sequences/$seqtitle.sequence");
                 } else {                  } else {
                     push @{$seqfiles}, "$key.sequence";                      push @{$seqfiles}, "$key.sequence";
                     open(LOCFILE,'>',"$destdir/sequences/$key.sequence");                      open(LOCFILE,">$destdir/sequences/$key.sequence");
                 }                  }
                 print LOCFILE $seqtext{$key};                  print LOCFILE $seqtext{$key};
                 close(LOCFILE);                  close(LOCFILE);
Line 1027  sub build_structure { Line 1021  sub build_structure {
             &process_specials($context,'pools',$pools,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);              &process_specials($context,'pools',$pools,\$topnum,$$items{'Top'}{contentscount},$destdir,$udom,$uname,$cdom,$crs,$timenow,$newdir,$timestamp,$resinfo,\$seqtext{'Top'},$pagesfiles,$seqfiles,$topurls,$topnames);
         }          }
         $seqtext{'Top'} .= "</map>\n";          $seqtext{'Top'} .= "</map>\n";
         open(TOPFILE,'>',"$destdir/sequences/Top.sequence");          open(TOPFILE,">$destdir/sequences/Top.sequence");
         print TOPFILE $seqtext{'Top'};          print TOPFILE $seqtext{'Top'};
         close(TOPFILE);          close(TOPFILE);
         push @{$seqfiles}, 'Top.sequence';          push @{$seqfiles}, 'Top.sequence';
Line 1049  sub build_structure { Line 1043  sub build_structure {
             if (grep/^$res$/,@{$packages}) {              if (grep/^$res$/,@{$packages}) {
                 $resource =  $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point                  $resource =  $filestem.'/resfiles/'.$res.'./index.html'; # should be entry_point
             }              }
             open(PAGEFILE,'>',$filename);              open(PAGEFILE,">$filename");
             print PAGEFILE qq|<map>              print PAGEFILE qq|<map>
 <resource src="$resource" id="1" type="start" title="$$items{$pagecontents{$key}[$i][0]}{title}"></resource>  <resource src="$resource" 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|;
Line 1238  sub process_specials { Line 1232  sub process_specials {
   
     if ($type eq "announcements") {      if ($type eq "announcements") {
         push @{$pagesfiles}, "$seqnames{$type}.page";          push @{$pagesfiles}, "$seqnames{$type}.page";
         open(ITEM,'>',"$destdir/pages/$seqnames{$type}.page");          open(ITEM,">$destdir/pages/$seqnames{$type}.page");
     } else {      } else {
         push @{$seqfiles}, "$seqnames{$type}.sequence";          push @{$seqfiles}, "$seqnames{$type}.sequence";
         open(ITEM,'>',"$destdir/sequences/$seqnames{$type}.sequence");          open(ITEM,">$destdir/sequences/$seqnames{$type}.sequence");
     }      }
   
     if ($type eq 'boards') {      if ($type eq 'boards') {
Line 1584  sub process_staff { Line 1578  sub process_staff {
   </tr>    </tr>
 </table>  </table>
     |;      |;
     open(FILE,'>',"$destdir/resfiles/$res.html");      open(FILE,">$destdir/resfiles/$res.html");
     push @{$resrcfiles}, "$res.html";      push @{$resrcfiles}, "$res.html";
     print FILE qq|<html>      print FILE qq|<html>
 <head>  <head>
Line 1663  sub process_link { Line 1657  sub process_link {
         $linktag .= qq|>$$settings{title}</a>|;          $linktag .= qq|>$$settings{title}</a>|;
     }      }
   
     open(FILE,'>',"$destdir/resfiles/$res.html");      open(FILE,">$destdir/resfiles/$res.html");
     push @{$resrcfiles}, "$res.html";      push @{$resrcfiles}, "$res.html";
     print FILE qq|<html>      print FILE qq|<html>
 <head>  <head>
Line 3399  sub build_category_sequences { Line 3393  sub build_category_sequences {
     my $curr_id = 0;      my $curr_id = 0;
     my $next_id = 1;      my $next_id = 1;
     my $fh;      my $fh;
     open($fh,'>',"$destdir/sequences/question_database.sequence");      open($fh,">$destdir/sequences/question_database.sequence");
     push @{$sequencesfiles},'question_database.sequence';      push @{$sequencesfiles},'question_database.sequence';
     foreach my $category (sort(keys(%{$catinfo}))) {      foreach my $category (sort(keys(%{$catinfo}))) {
         my $seqname;          my $seqname;
Line 3465  sub build_problem_container { Line 3459  sub build_problem_container {
         if (!-e "$seqdir") {          if (!-e "$seqdir") {
             mkdir("$seqdir",0770);              mkdir("$seqdir",0770);
         }          }
         open($fh,'>',$$containerdir);          open($fh,">$$containerdir");
         $$total{seq} ++;          $$total{seq} ++;
         push @{$sequencesfiles},$mapname.'.sequence';          push @{$sequencesfiles},$mapname.'.sequence';
     } else {      } else {
Line 3473  sub build_problem_container { Line 3467  sub build_problem_container {
         if (!-e "$pagedir") {          if (!-e "$pagedir") {
             mkdir("$pagedir",0770);              mkdir("$pagedir",0770);
         }          }
         open($fh,'>',$$containerdir);          open($fh,">$$containerdir");
         $$total{page} ++;          $$total{page} ++;
         push @{$pagesfiles},$mapname.'.page';          push @{$pagesfiles},$mapname.'.page';
     }      }
Line 3931  sub write_bb5_questions { Line 3925  sub write_bb5_questions {
             $title =~ s/\s/_/g;              $title =~ s/\s/_/g;
             $title =~ s/\W//g;              $title =~ s/\W//g;
             $title .= '_'.$id;              $title .= '_'.$id;
             open(PROB,'>',"$newdir/$title.problem");              open(PROB,">$newdir/$title.problem");
             print PROB $output;              print PROB $output;
             close PROB;              close PROB;
         } else {          } else {
Line 4549  $$settings{$id}{$list}{jumbledtext}[$k] Line 4543  $$settings{$id}{$list}{jumbledtext}[$k]
             $title =~ s/\s/_/g;              $title =~ s/\s/_/g;
             $title =~ s/:/_/g;              $title =~ s/:/_/g;
             $title =~ s/\//_/g;              $title =~ s/\//_/g;
             open(PROB,'>',"$destdir/problems/$probdir/$title.problem");              open(PROB,">$destdir/problems/$probdir/$title.problem");
             print PROB $output;              print PROB $output;
             close PROB;              close PROB;
         } else {          } else {
Line 4948  sub write_bb6_questions { Line 4942  sub write_bb6_questions {
             $title =~ s/\s/_/g;              $title =~ s/\s/_/g;
             $title =~ s/\W//g;              $title =~ s/\W//g;
             $title .= '_'.$id;              $title .= '_'.$id;
             open(PROB,'>',"$newdir/$title.problem");              open(PROB,">$newdir/$title.problem");
             print PROB $output;              print PROB $output;
             close PROB;              close PROB;
         } else {          } else {
Line 4963  sub retrieve_image { Line 4957  sub retrieve_image {
     my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;      my ($context,$res,$dirname,$cdom,$cname,$docroot,$destdir,$urlpath,$filename) = @_;
     my $contents;      my $contents;
     my $url = $urlpath.$filename;      my $url = $urlpath.$filename;
     my $ua=new LWP::UserAgent;      my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
     my $request=new HTTP::Request('GET',$url);      my $request=new HTTP::Request('GET',$url);
     my $response=$ua->request($request);      my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request);
     if ($response->is_success) {       if ($response->is_success) { 
         $contents = $response->content;          $contents = $response->content;
         if (!-e "$docroot/$res") {          if (!-e "$docroot/$res") {
Line 4974  sub retrieve_image { Line 4968  sub retrieve_image {
         if (!-e "$docroot/$res/webimages") {          if (!-e "$docroot/$res/webimages") {
             mkdir("$docroot/$res/webimages",0755);              mkdir("$docroot/$res/webimages",0755);
         }          }
         open(my $fh,'>',"$docroot/$res/webimages/$filename");          open(my $fh,">$docroot/$res/webimages/$filename");
         print $fh $contents;          print $fh $contents;
         close($fh);          close($fh);
         if ($context eq 'DOCS') {          if ($context eq 'DOCS') {
Line 5067  sub process_announce { Line 5061  sub process_announce {
         }          }
     }      }
   
     open(FILE,'>',"$destdir/resfiles/$res.html");      open(FILE,">$destdir/resfiles/$res.html");
     push @{$resrcfiles}, "$res.html";      push @{$resrcfiles}, "$res.html";
     print FILE qq|<html>      print FILE qq|<html>
 <head>  <head>
Line 5273  sub process_content { Line 5267  sub process_content {
         }          }
     }      }
   
     if (!open(FILE,'>',"$destdir/resfiles/$res.html")) {      if (!open(FILE,">$destdir/resfiles/$res.html")) {
         &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");          &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
     } else {      } else {
         push @{$resrcfiles}, "$res.html";          push @{$resrcfiles}, "$res.html";
Line 5466  sub angel_content { Line 5460  sub angel_content {
     $p->parse_file($xmlfile);      $p->parse_file($xmlfile);
     $p->eof;      $p->eof;
     if ($type eq "PAGE") {      if ($type eq "PAGE") {
         open(FILE,'<',$xmlfile);          open(FILE,"<$xmlfile");
         @buffer = <FILE>;          @buffer = <FILE>;
         close(FILE);          close(FILE);
         chomp(@buffer);          chomp(@buffer);
Line 5483  sub angel_content { Line 5477  sub angel_content {
             }              }
         }          }
     }      }
     open(FILE,'>',"$destdir/resfiles/$res.html");      open(FILE,">$destdir/resfiles/$res.html");
     push @{$resrcfiles}, "$res.html";      push @{$resrcfiles}, "$res.html";
     print FILE qq|<html>      print FILE qq|<html>
 <head>  <head>
Line 5519  sub angel_content { Line 5513  sub angel_content {
 sub webct4_content {  sub webct4_content {
     my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;      my ($res,$docroot,$destdir,$settings,$dom,$user,$type,$title,$resrcfiles) = @_;
     if (defined($$settings{url})) {      if (defined($$settings{url})) {
         if (!open(FILE,'>',"$destdir/resfiles/$res.html")) {          if (!open(FILE,">$destdir/resfiles/$res.html")) {
             &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");              &Apache::lonnet::logthis("IMS import error: Cannot open file - $destdir/resfiles/$res.html - $!");
         } else {          } else {
             push(@{$resrcfiles}, "$res.html");              push(@{$resrcfiles}, "$res.html");
Removed from v.1.54.4.1  
changed lines
  Added in v.1.55

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>