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

Diff for /loncom/interface/londocs.pm between versions 1.566 and 1.567

version 1.566, 2013/10/06 20:33:45 version 1.567, 2013/11/12 14:36:07
Line 41  use Apache::lonclonecourse; Line 41  use Apache::lonclonecourse;
 use Apache::lonnavmaps;  use Apache::lonnavmaps;
 use Apache::lonnavdisplay();  use Apache::lonnavdisplay();
 use Apache::lonextresedit();  use Apache::lonextresedit();
   use Apache::lontemplate();
   use Apache::lonsimplepage();
 use HTML::Entities;  use HTML::Entities;
 use HTML::TokeParser;  use HTML::TokeParser;
 use GDBM_File;  use GDBM_File;
Line 141  sub clean { Line 143  sub clean {
 sub dumpcourse {  sub dumpcourse {
     my ($r) = @_;      my ($r) = @_;
     my $crstype = &Apache::loncommon::course_type();      my $crstype = &Apache::loncommon::course_type();
     $r->print(&Apache::loncommon::start_page('Dump '.$crstype.' Content to Authoring Space')."\n".      my ($starthash,$js);
       unless (($env{'form.authorspace'}) && ($env{'form.authorfolder'}=~/\w/)) {
           $js = <<"ENDJS";
   <script type="text/javascript">
   // <![CDATA[
   
   function hide_searching() {
       if (document.getElementById('searching')) {
           document.getElementById('searching').style.display = 'none';
       }
       return;
   }
   
   // ]]>
   </script>
   ENDJS
           $starthash = {
                            add_entries => {'onload' => "hide_searching();"},
                        };
       }
       $r->print(&Apache::loncommon::start_page('Dump '.$crstype.' Content to Authoring Space',$js,$starthash)."\n".
               &Apache::lonhtmlcommon::breadcrumbs('Dump '.$crstype.' Content to Authoring Space')."\n");                &Apache::lonhtmlcommon::breadcrumbs('Dump '.$crstype.' Content to Authoring Space')."\n");
     $r->print(&startContentScreen('tools'));      $r->print(&startContentScreen('tools'));
     my ($home,$other,%outhash)=&authorhosts();      my ($home,$other,%outhash)=&authorhosts();
Line 161  sub dumpcourse { Line 183  sub dumpcourse {
  $r->print('<h3>'.&mt('Copying Files').'</h3>');   $r->print('<h3>'.&mt('Copying Files').'</h3>');
  my $title=$env{'form.authorfolder'};   my $title=$env{'form.authorfolder'};
  $title=&clean($title);   $title=&clean($title);
  my %replacehash=();          my ($navmap,$errormsg) =
  foreach my $key (keys(%env)) {              &Apache::loncourserespicker::get_navmap_object($crstype,'dumpdocs');
     if ($key=~/^form\.namefor\_(.+)/) {          my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
  $replacehash{$1}=$env{$key};          my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
     }          my (%maps,%resources,%titles);
           if (!ref($navmap)) {
               $r->print($errormsg.
                         &endContentScreen());
               return '';
           } else {
               &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
                                                                      'dumpdocs',$cdom,$cnum);
  }   }
           my @todump = &Apache::loncommon::get_env_multiple('form.archive');
           my (%tocopy,%replacehash,%lookup,%deps,%display,%result,%depresult,%simpleproblems,%simplepages,
               %newcontent,%has_simpleprobs);
           foreach my $item (sort {$a <=> $b} (@todump)) {
               my $name = $env{'form.namefor_'.$item};
               if ($resources{$item}) {
                   my ($map,$id,$res) = &Apache::lonnet::decode_symb($resources{$item});
                   if ($res =~ m{^uploaded/$cdom/$cnum/\E((?:docs|supplemental)/.+)$}) {
                       $tocopy{$1} = $name;
                       $display{$item} = $1;
                       $lookup{$1} = $item; 
                   } elsif ($res eq 'lib/templates/simpleproblem.problem') {
                       $simpleproblems{$item} = {
                                                   symb => $resources{$item},
                                                   name => $name,
                                                };
                       $display{$item} = 'simpleproblem_'.$name;
                       if ($map =~ m{^\Quploaded/$cdom/$cnum/\E(.+)$}) {
                           $has_simpleprobs{$1}{$id} = $item;
                       }
                   } elsif ($res =~ m{^adm/$match_domain/$match_username/(\d+)/smppg}) {
                       my $marker = $1;
                       my $db_name = &Apache::lonsimplepage::get_db_name($res,$marker,$cdom,$cnum);
                       $simplepages{$item} = {
                                               res    => $res,
                                               title  => $titles{$item},
                                               db     => $db_name,
                                               marker => $marker,
                                               symb   => $resources{$item},
                                               name   => $name,
                                             };
                       $display{$item} = '/'.$res;
                   }
               } elsif ($maps{$item}) {
                   if ($maps{$item} =~ m{^\Quploaded/$cdom/$cnum/\E((?:default|supplemental)_\d+\.(?:sequence|page))$}) {
                       $tocopy{$1} = $name;
                       $display{$item} = $1;
                       $lookup{$1} = $item;
                   }
               } else {
                   next;
               }
           }
  my $crs='/uploaded/'.$env{'request.course.id'}.'/';   my $crs='/uploaded/'.$env{'request.course.id'}.'/';
  $crs=~s/\_/\//g;   $crs=~s/\_/\//g;
  foreach my $item (keys(%replacehash)) {          my $mm = new File::MMagic;
     my $newfilename=$title.'/'.$replacehash{$item};          my $prefix = "/uploaded/$cdom/$cnum/";
     $newfilename=~s/\.(\w+)$//;          %replacehash = %tocopy;
     my $ext=$1;          foreach my $item (sort(keys(%simpleproblems))) {
     $newfilename=&clean($newfilename);              my $content = &Apache::imsexport::simpleproblem($simpleproblems{$item}{'symb'});
     $newfilename.='.'.$ext;              $newcontent{$display{$item}} = $content;
     my @dirs=split(/\//,$newfilename);          }
     my $path=$r->dir_config('lonDocRoot')."/priv/$cd/$ca";          my $gateway = Apache::lonhtmlgateway->new('web');
     my $makepath=$path;          foreach my $item (sort(keys(%simplepages))) {
     my $fail=0;              if (ref($simplepages{$item}) eq 'HASH') {
     for (my $i=0;$i<$#dirs;$i++) {                  my $pagetitle = $simplepages{$item}{'title'};
  $makepath.='/'.$dirs[$i];                  my %fields = &Apache::lonnet::dump($simplepages{$item}{'db'},$cdom,$cnum);
  unless (-e $makepath) {                  my %contents;
     unless(mkdir($makepath,0777)) { $fail=1; }                  foreach my $field (keys(%fields)) {
  }                      if ($field =~ /^(?:aaa|bbb|ccc)_(\w+)$/) {
     }                          my $name = $1;
     $r->print('<br /><tt>'.$item.'</tt> => <tt>'.$newfilename.'</tt>: ');                          my $msg = $fields{$field};
     if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) {                          if ($name eq 'webreferences') {
  if ($item=~/\.(sequence|page|html|htm|xml|xhtml)$/) {                              if ($msg =~ m{^https?://}) {
     print $fh &Apache::lonclonecourse::rewritefile(                                  $contents{$name} = '<a href="'.$msg.'"><tt>'.$msg.'</tt></a>';
          &Apache::lonclonecourse::readfile($env{'request.course.id'},$item),                              }
      (%replacehash,$crs => '')                          } else {
     );                              $msg = &Encode::decode('utf8',$msg);
  } else {                              $msg = $gateway->process_outgoing_html($msg,1);
     print $fh                              $contents{$name} = $msg;
          &Apache::lonclonecourse::readfile($env{'request.course.id'},$item);                          }
        }                      } elsif ($field eq 'uploaded.photourl') {
  $fh->close();                          my $marker = $simplepages{$item}{marker};
     } else {                          if ($fields{$field} =~ m{^\Q$prefix\E(simplepage/$marker/.+)$}) {
  $fail=1;                              my $filepath = $1;
     }                              my ($relpath,$fname) = ($filepath =~ m{^(.+/)([^/]+)$});
     if ($fail) {                              if ($fname ne '') {
  $r->print('<span class="LC_error">'.&mt('fail').'</span>');                                  $fname=~s/\.(\w+)$//;
     } else {                                  my $ext=$1;
  $r->print('<span class="LC_success">'.&mt('ok').'</span>');                                  $fname = &clean($fname);
     }                                  $fname.='.'.$ext;
  }                                  $contents{image} = '<img src="'.$relpath.$fname.'" alt="Image" />';
                                   $replacehash{$filepath} = $relpath.$fname;
                                   $deps{$item}{$filepath} = 1;
                               }
                           }
                       }
                   }
                   $replacehash{'/'.$simplepages{$item}{'res'}} = $simplepages{$item}{'name'};
                   $lookup{'/'.$simplepages{$item}{'res'}} = $item;
                   my $content = '
   <html>
   <head>
   <title>'.$pagetitle.'</title>
   </head>
   <body bgcolor="#ffffff">';
                   if ($contents{title}) {
                       $content .= "\n".'<h2>'.$contents{title}.'</h2>';
                   }
                   if ($contents{image}) {
                       $content .= "\n".$contents{image};
                   }
                   if ($contents{content}) {
                       $content .= '
   <div class="LC_Box">
   <h4 class="LC_hcell">Content</h4>'.
   $contents{content}.'
   </div>';
                   }
                   if ($contents{webreferences}) {
                       $content .= ' 
   <div class="LC_Box">
   <h4 class="LC_hcell">Web References</h4>'.
   $contents{webreferences}.'
   </div>';
                   }
                   $content .= '
   </body>
   </html>
   ';
                   $newcontent{'/'.$simplepages{$item}{res}} = $content; 
               }
           }
    foreach my $item (keys(%tocopy)) {
               unless ($item=~/\.(sequence|page)$/) {
                   my $currurlpath = $prefix.$item;
                   my $currdirpath = &Apache::lonnet::filelocation('',$currurlpath);
                   &recurse_html($mm,$prefix,$currdirpath,$currurlpath,$item,$lookup{$item},\%replacehash,\%deps);
               }
           }
           foreach my $num (sort {$a <=> $b} (@todump)) {
               my $src = $display{$num};
               next if ($src eq '');
               my @needcopy = ();
               if ($replacehash{$src}) {
                   push(@needcopy,$src);
                   if (ref($deps{$num}) eq 'HASH') {
                       foreach my $dep (sort(keys(%{$deps{$num}}))) {
                           if ($replacehash{$dep}) {
                               push(@needcopy,$dep);
                           }
                       }
                   }
               } elsif ($src =~ /^simpleproblem_/) {
                   push(@needcopy,$src);
               }
               next if (@needcopy == 0);
               my ($result,$depresult);
               for (my $i=0; $i<@needcopy; $i++) {
                   my $item = $needcopy[$i];
                   my $newfilename;
                   if ($simpleproblems{$num}) {
                       $newfilename=$title.'/'.$simpleproblems{$num}{'name'};
                   } else {
               $newfilename=$title.'/'.$replacehash{$item};
                   }
           $newfilename=~s/\.(\w+)$//;
           my $ext=$1;
           $newfilename=&clean($newfilename);
           $newfilename.='.'.$ext;
                   my ($newrelpath) = ($newfilename =~ m{^\Q$title/\E(.+)$}); 
                   if ($newrelpath ne $replacehash{$item}) {
                       $replacehash{$item} = $newrelpath;
                   }
           my @dirs=split(/\//,$newfilename);
           my $path=$r->dir_config('lonDocRoot')."/priv/$cd/$ca";
           my $makepath=$path;
           my $fail;
                   my $origin;
           for (my $i=0;$i<$#dirs;$i++) {
       $makepath.='/'.$dirs[$i];
       unless (-e $makepath) {
           unless(mkdir($makepath,0755)) { 
                               $fail = &mt('Directory creation failed.');
                           }
       }
           }
                   if ($i == 0) {
               $result = '<br /><tt>'.$item.'</tt> => <tt>'.$newfilename.'</tt>: ';
                   } else {
                       $depresult .= '<li><tt>'.$item.'</tt> => <tt>'.$newfilename.'</tt> '.
                                     '<span class="LC_fontsize_small" style="font-weight: bold;">'.
                                     &mt('(dependency)').'</span>: ';
                   }
                   if (-e $path.'/'.$newfilename) {
                       $fail = &mt('Destination already exists -- not overwriting.'); 
           } else {
                       if (my $fh=Apache::File->new('>'.$path.'/'.$newfilename)) {
                           if (($item =~ m{^/adm/$match_domain/$match_username/\d+/smppg}) ||
                               ($item =~ /^simpleproblem_/)) {
                               print $fh $newcontent{$item};
                           } else {
                               my $fileloc = &Apache::lonnet::filelocation('',$prefix.$item);
                               if (-e $fileloc) {
                                   if ($item=~/\.(sequence|page|html|htm|xml|xhtml)$/) {
                                       if ((($1 eq 'sequence') || ($1 eq 'page')) &&
                                           (ref($has_simpleprobs{$item}) eq 'HASH')) {
                                           my %changes = %{$has_simpleprobs{$item}};
                                           my $content = &Apache::lonclonecourse::rewritefile(
                        &Apache::lonclonecourse::readfile($env{'request.course.id'},$item),
                                                         (%replacehash,$crs => '')
                                                                                             );
                                           my $updatedcontent = '';
                                           my $parser = HTML::TokeParser->new(\$content);
                                           $parser->attr_encoded(1);
                                           while (my $token = $parser->get_token) {
                                               if ($token->[0] eq 'S') {
                                                   if (($token->[1] eq 'resource') &&
                                                       ($token->[2]->{'src'} eq '/res/lib/templates/simpleproblem.problem') && 
                                                       ($changes{$token->[2]->{'id'}})) {
                                                       my $id = $token->[2]->{'id'};
                                                       $updatedcontent .= '<'.$token->[1];
                                                       foreach my $attrib (@{$token->[3]}) {
                                                           next unless ($attrib =~ /^(src|type|title|id)$/);
                                                           if ($attrib eq 'src') {
                                                               my ($file) = ($display{$changes{$id}} =~ /^\Qsimpleproblem_\E(.+)$/); 
                                                               if ($file) {
                                                                   $updatedcontent .= ' '.$attrib.'="'.$file.'"';
                                                               } else {
                                                                   $updatedcontent .= ' '.$attrib.'="'.$token->[2]->{$attrib}.'"'; 
                                                               }
                                                           } else {
                                                               $updatedcontent .= ' '.$attrib.'="'.$token->[2]->{$attrib}.'"';
                                                           }
                                                       }
                                                       $updatedcontent .= ' />'."\n";
                                                   } else {
                                                       $updatedcontent .= $token->[4]."\n";
                                                   }
                                                } else {
                                                    $updatedcontent .= $token->[2];
                                                }
                                            }
                                            print $fh $updatedcontent;
                                       } else {  
                           print $fh &Apache::lonclonecourse::rewritefile(
                        &Apache::lonclonecourse::readfile($env{'request.course.id'},$item),
                                         (%replacehash,$crs => '')
                                 );
                                       }
                                   } else {
                       print $fh
                                           &Apache::lonclonecourse::readfile($env{'request.course.id'},$item);
                   }
                               } else {
                                   $fail = &mt('Source does not exist.');  
                               }
                           }
                           $fh->close();
               } else {
           $fail = &mt('Could not write to destination.');
                       }
           }
                   my $text;
           if ($fail) {
                       $text = '<span class="LC_error">'.&mt('fail').('&nbsp;'x3).$fail.'</span>';
           } else {
                       $text = '<span class="LC_success">'.&mt('ok').'</span>';
                   }
                   if ($i == 0) {
                       $result .= $text;
                   } else {
                       $depresult .= $text.'</li>';
           }
               }
               $r->print($result);
               if ($depresult) {
                   $r->print('<ul>'.$depresult.'</ul>');
               }
           }
     } else {      } else {
         $r->print(&mt('Searching ...').'<br />');          my ($navmap,$errormsg) =
         $r->rflush();              &Apache::loncourserespicker::get_navmap_object($crstype,'dumpdocs');
 # Input form          if (!ref($navmap)) {
         $r->print('<form name="dumpdoc" action="" method="post">'."\n");              $r->print($errormsg);
  unless ($home==1) {          } else {
     $r->print('<div class="LC_left_float">'.              $r->print('<div id="searching">'.&mt('Searching ...').'</div>');
       '<fieldset><legend>'.              $r->rflush();
                       &mt('Select the Authoring Space').              my ($preamble,$formname);
                       '</legend><select name="authorspace">');              $formname = 'dumpdoc';
  }      unless ($home==1) {
  foreach my $key (sort(keys(%outhash))) {          $preamble = '<div class="LC_left_float">'.
     if ($key=~/^home_(.+)$/) {              '<fieldset><legend>'.
                               &mt('Select the Authoring Space').
                               '</legend><select name="authorspace">';
       }
               my @orderspaces = ();
       foreach my $key (sort(keys(%outhash))) {
                   if ($key=~/^home_(.+)$/) {
                       if ($1 eq $env{'user.name'}.':'.$env{'user.domain'}) {
                           unshift(@orderspaces,$1);
                       } else {
                           push(@orderspaces,$1);
                       }
                   } 
               }
               foreach my $user (@orderspaces) {
  if ($home==1) {   if ($home==1) {
     $r->print(      $preamble .= '<input type="hidden" name="authorspace" value="'.$user.'" />';
   '<input type="hidden" name="authorspace" value="'.$1.'" />');  
  } else {   } else {
     $r->print('<option value="'.$1.'">'.$1.' - '.      $preamble .= '<option value="'.$user.'">'.$user.' - '.
       &Apache::loncommon::plainname(split(/\:/,$1)).'</option>');           &Apache::loncommon::plainname(split(/\:/,$user)).'</option>';
  }          }
     }      }
  }      unless ($home==1) {
  unless ($home==1) {          $preamble .= '</select></fieldset></div>'."\n";
     $r->print('</select></fieldset></div>'."\n");  
  }  
  my $title=$origcrsdata{'description'};  
  $title=~s/[\/\s]+/\_/gs;  
  $title=&clean($title);  
  $r->print('<div class="LC_left_float">'.  
                   '<fieldset><legend>'.&mt('Folder in Authoring Space').'</legend>'.  
                   '<input type="text" size="50" name="authorfolder" value="'.  
                   $title.'" />'.  
                   '</fieldset></div><br clear="all" />'."\n");  
  &tiehash();  
  $r->print('<h4>'.&mt('Filenames in Authoring Space').'</h4>'  
                  .&Apache::loncommon::start_data_table()  
                  .&Apache::loncommon::start_data_table_header_row()  
                  .'<th>'.&mt('Internal Filename').'</th>'  
                  .'<th>'.&mt('Title').'</th>'  
                  .'<th>'.&mt('Save as ...').'</th>'  
                  .&Apache::loncommon::end_data_table_header_row());  
  foreach my $file (&Apache::lonclonecourse::crsdirlist($origcrsid,'userfiles')) {  
     $r->print(&Apache::loncommon::start_data_table_row()  
                      .'<td>'.$file.'</td>');  
     my ($ext)=($file=~/\.(\w+)$/);  
     my $title=$hash{'title_'.$hash{  
  'ids_/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'.$file}};  
     $r->print('<td>'.($title?$title:'&nbsp;').'</td>');  
     if (!$title) {  
  $title=$file;  
     } else {  
  $title=~s|/|_|g;  
     }      }
     $title=~s/\.(\w+)$//;      my $title=$origcrsdata{'description'};
       $title=~s/[\/\s]+/\_/gs;
     $title=&clean($title);      $title=&clean($title);
     $title.='.'.$ext;      $preamble .= '<div class="LC_left_float">'.
     $r->print("\n<td><input type='text' size='60' name='namefor_".$file."' value='".$title."' /></td>"                           '<fieldset><legend>'.&mt('Folder in Authoring Space').'</legend>'.
                      .&Apache::loncommon::end_data_table_row());                           '<input type="text" size="50" name="authorfolder" value="'.
  }                           $title.'" />'.
  $r->print(&Apache::loncommon::end_data_table());                           '</fieldset></div><div style="padding:0;clear:both;margin:0;border:0"></div>'."\n";
  &untiehash();              my %uploadedfiles;
  $r->print(      &tiehash();
   '<p><input type="submit" name="dumpcourse" value="'.&mt("Dump $crstype Content").'" /></p></form>');      foreach my $file (&Apache::lonclonecourse::crsdirlist($origcrsid,'userfiles')) {
           my ($ext)=($file=~/\.(\w+)$/);
   # FIXME Check supplemental here
           my $title=$hash{'title_'.$hash{
                   'ids_/uploaded/'.$origcrsdata{'domain'}.'/'.$origcrsdata{'num'}.'/'.$file}};
           if (!$title) {
       $title=$file;
           } else {
       $title=~s|/|_|g;
           }
           $title=~s/\.(\w+)$//;
           $title=&clean($title);
           $title.='.'.$ext;
   #    $r->print("\n<td><input type='text' size='60' name='namefor_".$file."' value='".$title."' /></td>"
                   $uploadedfiles{$file} = $title;
       }
       &untiehash();
               $r->print(&Apache::loncourserespicker::create_picker($navmap,'dumpdocs',$formname,$crstype,undef,
                                                                    undef,undef,$preamble,$home,\%uploadedfiles));
           }
     }      }
     $r->print(&endContentScreen());      $r->print(&endContentScreen());
 }  }
   
   sub recurse_html {
       my ($mm,$prefix,$currdirpath,$currurlpath,$container,$item,$replacehash,$deps) = @_;
       return unless ((ref($replacehash) eq 'HASH') && (ref($deps) eq 'HASH'));
       my (%allfiles,%codebase);
       if (&Apache::lonnet::extract_embedded_items($currdirpath,\%allfiles,\%codebase) eq 'ok') {
           if (keys(%allfiles)) {
               foreach my $dependency (keys(%allfiles)) {
                   next if (($dependency =~ m{^/(res|adm)/}) || ($dependency =~ m{^https?://}));
                   my ($depurl,$relfile,$newcontainer);
                   if ($dependency =~ m{^/}) {
                       if ($dependency =~ m{^\Q$currurlpath/\E(.+)$}) {
                           $relfile = $1;
                           if ($dependency =~ m{^\Q$prefix\E(.+)$}) {
                               $newcontainer = $1;
                               next if ($replacehash->{$newcontainer});
                           }
                           $depurl = $dependency;
                       } else {
                           next;
                       }
                   } else {
                       $relfile = $dependency;
                       $depurl = $currurlpath;
                       $depurl =~ s{[^/]+$}{};  
                       $depurl .= $dependency;
                       ($newcontainer) = ($depurl =~ m{^\Q$prefix\E(.+)$}); 
                   }
                   next if ($relfile eq '');
                   my $newname = $replacehash->{$container};
                   $newname =~ s{[^/]+$}{};
                   $replacehash->{$newcontainer} = $newname.$relfile;
                   $deps->{$item}{$newcontainer} = 1;
                   my ($newurlpath) = ($depurl =~ m{^(.*)/[^/]+$});  
                   my $depfile = &Apache::lonnet::filelocation('',$depurl);
                   my $type = $mm->checktype_filename($depfile);
                   if ($type eq 'text/html') {
                       &recurse_html($mm,$prefix,$depfile,$newurlpath,$newcontainer,$item,$replacehash,$deps);
                   }
               }
           }
       }
       return;
   }
   
 sub group_import {  sub group_import {
     my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_;      my ($coursenum, $coursedom, $folder, $container, $caller, @files) = @_;
     my ($donechk,$allmaps,%hierarchy,%titles,%addedmaps,%removefrommap,      my ($donechk,$allmaps,%hierarchy,%titles,%addedmaps,%removefrommap,
Removed from v.1.566  
changed lines
  Added in v.1.567

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