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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.270 and 1.291

version 1.270, 2011/10/22 22:05:23 version 1.291, 2014/07/27 11:39:33
Line 66  invocation by F<loncapa_apache.conf>: Line 66  invocation by F<loncapa_apache.conf>:
   
 =head1 OVERVIEW  =head1 OVERVIEW
   
 Authors can only write-access the C</~authorname/> space. They can  Authors can only write-access the C</priv/domain/authorname/> space. 
 copy resources into the resource area through the publication step,  They can copy resources into the resource area through the 
 and move them back through a recover step. Authors do not have direct  publication step, and move them back through a recover step. 
 write-access to their resource space.  Authors do not have direct write-access to their resource space.
   
 During the publication step, several events will be  During the publication step, several events will be
 triggered. Metadata is gathered, where a wizard manages default  triggered. Metadata is gathered, where a wizard manages default
Line 102  to publication space. Line 102  to publication space.
 Many of the undocumented subroutines implement various magical  Many of the undocumented subroutines implement various magical
 parsing shortcuts.  parsing shortcuts.
   
 =over 4  
   
 =cut  =cut
   
 ######################################################################  ######################################################################
Line 121  use HTML::LCParser; Line 119  use HTML::LCParser;
 use HTML::Entities;  use HTML::Entities;
 use Encode::Encoder;  use Encode::Encoder;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::loncacc;  
 use DBI;  use DBI;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
Line 150  my $lock; Line 147  my $lock;
   
 =pod  =pod
   
   =over 4
   
 =item B<metaeval>  =item B<metaeval>
   
 Evaluates a string that contains metadata.  This subroutine  Evaluates a string that contains metadata.  This subroutine
Line 266  sub metaread { Line 265  sub metaread {
     my ($logfile,$fn,$prefix)=@_;      my ($logfile,$fn,$prefix)=@_;
     unless (-e $fn) {      unless (-e $fn) {
  print($logfile 'No file '.$fn."\n");   print($logfile 'No file '.$fn."\n");
         return '<div><b>'          return '<p class="LC_warning">'
               .&mt('No file: [_1]'                .&mt('No file: [_1]',&Apache::loncfile::display($fn))
                   ,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');                .'</p>';
     }      }
     print($logfile 'Processing '.$fn."\n");      print($logfile 'Processing '.$fn."\n");
     my $metastring;      my $metastring;
Line 277  sub metaread { Line 276  sub metaread {
  $metastring=join('',<$metafh>);   $metastring=join('',<$metafh>);
     }      }
     &metaeval($metastring,$prefix);      &metaeval($metastring,$prefix);
     return '<div><b>'      return '<p class="LC_info">'
           .&mt('Processed file: [_1]'            .&mt('Processed file: [_1]',&Apache::loncfile::display($fn))
               ,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');            .'</p>';
 }  }
   
 #########################################  #########################################
Line 469  Currently undocumented Line 468  Currently undocumented
 #########################################  #########################################
 #########################################  #########################################
 sub set_allow {  sub set_allow {
     my ($allow,$logfile,$target,$tag,$oldurl)=@_;      my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_;
     my $newurl=&urlfixup($oldurl,$target);      my $newurl=&urlfixup($oldurl,$target);
     my $return_url=$oldurl;      my $return_url=$oldurl;
     print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";      print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
Line 481  sub set_allow { Line 480  sub set_allow {
  ($newurl !~ /^mailto:/i) &&   ($newurl !~ /^mailto:/i) &&
  ($newurl !~ /^(?:http|https|ftp):/i) &&   ($newurl !~ /^(?:http|https|ftp):/i) &&
  ($newurl !~ /^\#/)) {   ($newurl !~ /^\#/)) {
           if (($type eq 'src') || ($type eq 'href')) {
               if ($newurl =~ /^([^?]+)\?[^?]*$/) {
                   $newurl = $1;
               }
           }
  $$allow{&absoluteurl($newurl,$target)}=1;   $$allow{&absoluteurl($newurl,$target)}=1;
     }      }
     return $return_url;      return $return_url;
Line 724  sub fix_ids_and_indices { Line 728  sub fix_ids_and_indices {
     if ($key =~ /^$type$/i) {      if ($key =~ /^$type$/i) {
  $parms{$key}=&set_allow(\%allow,$logfile,   $parms{$key}=&set_allow(\%allow,$logfile,
  $target,$tag,   $target,$tag,
  $parms{$key});   $parms{$key},$type);
     }      }
  }   }
     }      }
Line 791  sub fix_ids_and_indices { Line 795  sub fix_ids_and_indices {
  }   }
  if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }   if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
  $outstring.='<'.$tag.$newparmstring.$endtag.'>';   $outstring.='<'.$tag.$newparmstring.$endtag.'>';
  if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer'    if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' ||
                     || $lctag eq 'display' || $lctag eq 'tex') {                      $lctag eq 'tex') {
     $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);      $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
  }                  } elsif ($lctag eq 'script') {
                       if ($parms{'type'} eq 'loncapa/perl') {
                           $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
                       } else {
                           my $script = &get_all_text_unbalanced('/'.$lctag,\@parser);
                           if ($script =~ m{\.set\w+(Src|Swf)\(["']}i) {
                               my @srcs = split(/\.set/i,$script);
                               if (scalar(@srcs) > 1) {
                                   foreach my $item (@srcs) {
                                       if ($item =~ m{^(FlashPlayerSwf|MediaSrc|XMPSrc|ConfigurationSrc|PosterImageSrc)\((['"])(?:(?!\2).)+\2\)}is) {
                                           my $srctype = $1;
                                           my $quote = $2;
                                           my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E});
                                           $url = &urlfixup($url);
                                           unless ($url=~m{^(?:http|https|ftp)://}) {
                                               $allow{&absoluteurl($url,$target)}=1;
                                               if ($srctype eq 'ConfigurationSrc') {
                                                   if ($url =~ m{^(.+/)configuration_express\.xml$}) {
   #
   # Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $spritesheet = $1.'express_show/spritesheet.png';
                                                       $allow{&absoluteurl($spritesheet,$target)}=1;
                                                   }
                                               } elsif ($srctype eq 'PosterImageSrc') {
                                                   if ($url =~ m{^(.+)_First_Frame\.png$}) {
                                                       my $prefix = $1;
   #
   # Camtasia 8.1: <main>_Thumbnails.png needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $thumbnail = $prefix.'_Thumbnails.png';
                                                       $allow{&absoluteurl($thumbnail,$target)}=1;
                                                   }
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                           if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
                               my $scriptslist = $2;
                               my @srcs = split(/\s*,\s*/,$scriptslist);
                               foreach my $src (@srcs) {
                                   if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
                                       my $quote = $1;
                                       my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
                                       $url = &urlfixup($url);
                                       unless ($url=~m{^(?:http|https|ftp)://}) {
                                           $allow{&absoluteurl($url,$target)}=1;
                                       }
                                   }
                               }
                           }
                           $outstring .= $script;
                       }
                   }
     } elsif ($token->[0] eq 'E') {      } elsif ($token->[0] eq 'E') {
  if ($token->[2]) {   if ($token->[2]) {
     unless ($token->[1] eq 'allow') {      unless ($token->[1] eq 'allow') {
Line 1017  sub publish { Line 1080  sub publish {
    $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').     $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
        '</span>';         '</span>';
                } else {                 } else {
   #
   # Store the fact that the dependency has been used by the target file
   # Unfortunately, usage is erroneously named sequsage in lonmeta.pm
   # The translation happens in lonmetadata.pm
   #
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
                              &Apache::lonnet::declutter($thisdep).'___usage'                               &Apache::lonnet::declutter($thisdep).'___usage'
                                  => time);                                   => time);
Line 1228  sub publish { Line 1296  sub publish {
                     .'</p>'                      .'</p>'
                     .'<p><input type="submit" value="'                      .'<p><input type="submit" value="'
                     .&mt('Finalize Publication')                      .&mt('Finalize Publication')
                     .'" /> <a href="'.&Apache::loncfile::display($source).'">'.&mt('Cancel').'</a></p>';                      .'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>';
     }      }
     $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();      $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();
     $intr_scrout.=      $intr_scrout.=
Line 1480  Returns: Line 1548  Returns:
 0: fail  0: fail
 1: success  1: success
   
   =back
   
 =cut  =cut
   
 #'stupid emacs  #'stupid emacs
Line 1766  sub phasetwo { Line 1836  sub phasetwo {
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
     unless ($batch) {      unless ($batch) {
                   
         my $thissrc=&Apache::loncfile::display($source);          my $thissrc=&Apache::loncfile::url($source);
         my $thissrcdir=$thissrc;          my $thissrcdir=$thissrc;
         $thissrcdir=~s/\/[^\/]+$/\//;          $thissrcdir=~s/\/[^\/]+$/\//;
                   
         $r->print(&Apache::loncommon::head_subbox(          $r->print(
             &Apache::lonhtmlcommon::start_funclist().              &Apache::lonhtmlcommon::actionbox([
             &Apache::lonhtmlcommon::add_item_funclist(  
                 '<a href="'.$thisdistarget.'">'.                  '<a href="'.$thisdistarget.'">'.
                 &mt('View Published Version').                  &mt('View Published Version').
                 '</a>').                  '</a>',
             &Apache::lonhtmlcommon::add_item_funclist(  
                 '<a href="'.$thissrc.'">'.                  '<a href="'.$thissrc.'">'.
                 &mt('Back to Source').                  &mt('Back to Source').
                 '</a>').                  '</a>',
             &Apache::lonhtmlcommon::add_item_funclist(  
                 '<a href="'.$thissrcdir.'">'.                  '<a href="'.$thissrcdir.'">'.
                 &mt('Back to Source Directory').                  &mt('Back to Source Directory').
                 '</a>').                  '</a>'])
             &Apache::lonhtmlcommon::end_funclist())  
         );          );
     }      }
     return 1;      return 1;
Line 1852  sub batchpublish { Line 1918  sub batchpublish {
     my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);      my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
             
     $r->print('<h2>'      $r->print('<h2>'
              .&mt('Publishing [_1]'               .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
                  ,'<span class="LC_filename">'.&Apache::loncfile::display($srcfile).'</span>')  
              .'</h2>'               .'</h2>'
     );      );
   
Line 1879  sub publishdirectory { Line 1944  sub publishdirectory {
     my ($r,$fn,$thisdisfn)=@_;      my ($r,$fn,$thisdisfn)=@_;
     $fn=~s/\/+/\//g;      $fn=~s/\/+/\//g;
     $thisdisfn=~s/\/+/\//g;      $thisdisfn=~s/\/+/\//g;
     my $resdir=      my $thisdisresdir=$thisdisfn;
  $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.      $thisdisresdir=~s/^\/priv\//\/res\//;
  $thisdisfn;      my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir;
     $r->print(&Apache::lonhtmlcommon::start_pick_box()      $r->print('<form name="pubdirpref" method="post" action="">'
                .&Apache::lonhtmlcommon::start_pick_box()
              .&Apache::lonhtmlcommon::row_title(&mt('Directory'))               .&Apache::lonhtmlcommon::row_title(&mt('Directory'))
             .'<span class="LC_filename">'.$thisdisfn.'</span>'              .'<span class="LC_filename">'.$thisdisfn.'</span>'
             .&Apache::lonhtmlcommon::row_closure()              .&Apache::lonhtmlcommon::row_closure()
             .&Apache::lonhtmlcommon::row_title(&mt('Target'))              .&Apache::lonhtmlcommon::row_title(&mt('Target'))
             .'<span class="LC_filename">'.$resdir.'</span>'              .'<span class="LC_filename">'.$thisdisresdir.'</span>'
     );      );
   
     my $dirptr=16384; # Mask indicating a directory in stat.cmode.      my $dirptr=16384; # Mask indicating a directory in stat.cmode.
Line 1896  sub publishdirectory { Line 1962  sub publishdirectory {
         $r->print(&Apache::lonhtmlcommon::row_closure()          $r->print(&Apache::lonhtmlcommon::row_closure()
                  .&Apache::lonhtmlcommon::row_title(&mt('Options'))                   .&Apache::lonhtmlcommon::row_title(&mt('Options'))
         );          );
         $r->print('<form name="pubdirpref" method="post">'.          $r->print(&hiddenfield('phase','two').
   &hiddenfield('phase','two').  
   &hiddenfield('filename',$env{'form.filename'}).    &hiddenfield('filename',$env{'form.filename'}).
   &checkbox('pubrec','include subdirectories').    &checkbox('pubrec','include subdirectories').
   &checkbox('forcerepub','force republication of previously published files').    &checkbox('forcerepub','force republication of previously published files').
                   &checkbox('obsolete','make file(s) obsolete').                    &checkbox('obsolete','make file(s) obsolete').
   &checkbox('forceoverride','force directory level metadata over existing').    &checkbox('forceoverride','force directory level metadata over existing')
   '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');          );
         $r->print(&Apache::lonhtmlcommon::row_closure(1)          $r->print(&Apache::lonhtmlcommon::row_closure(1)
                  .&Apache::lonhtmlcommon::end_pick_box()                   .&Apache::lonhtmlcommon::end_pick_box()
                    .'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>'
         );          );
         $lock=0;          $lock=0;
     } else {      } else {
Line 2015  sub defaultmetapublish { Line 2081  sub defaultmetapublish {
  $r->print($reply.'</p><br />');$r->rflush;   $r->print($reply.'</p><br />');$r->rflush;
     }      }
 # ------------------------------------------------------------------- Link back  # ------------------------------------------------------------------- Link back
     $r->print("<a href='".&Apache::lonnet::display($fn)."'>".&mt('Back to Metadata').'</a>');      $r->print("<a href='".&Apache::loncfile::display($fn)."'>".&mt('Back to Metadata').'</a>');
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }  }
Line 2079  sub handler { Line 2145  sub handler {
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
     my $fn=&unescape($env{'form.filename'});      my $fn=&unescape($env{'form.filename'});
     ($cuname,$cudom)=&Apache::loncacc::constructaccess($fn);      ($cuname,$cudom)=&Apache::lonnet::constructaccess($fn);
 # ----------------------------------------------------- Do we have permissions?  # ----------------------------------------------------- Do we have permissions?
      unless (($cuname) && ($cudom)) {       unless (($cuname) && ($cudom)) {
        $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.         $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
Line 2144  sub handler { Line 2210  sub handler {
     # Breadcrumbs      # Breadcrumbs
     &Apache::lonhtmlcommon::clear_breadcrumbs();      &Apache::lonhtmlcommon::clear_breadcrumbs();
     &Apache::lonhtmlcommon::add_breadcrumb({      &Apache::lonhtmlcommon::add_breadcrumb({
         'text'  => 'Construction Space',          'text'  => 'Authoring Space',
         'href'  => &Apache::loncommon::authorspace(),          'href'  => &Apache::loncommon::authorspace($fn),
     });      });
     &Apache::lonhtmlcommon::add_breadcrumb({      &Apache::lonhtmlcommon::add_breadcrumb({
         'text'  => 'Resource Publication',          'text'  => 'Resource Publication',
Line 2158  sub handler { Line 2224  sub handler {
     $r->print(&Apache::loncommon::start_page('Resource Publication',$js)      $r->print(&Apache::loncommon::start_page('Resource Publication',$js)
              .&Apache::lonhtmlcommon::breadcrumbs()               .&Apache::lonhtmlcommon::breadcrumbs()
              .&Apache::loncommon::head_subbox(               .&Apache::loncommon::head_subbox(
                   &Apache::loncommon::CSTR_pageheader()) # FIXME crumbs broken?                    &Apache::loncommon::CSTR_pageheader($docroot.$fn))
     );      );
   
     my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');      my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');
Line 2168  sub handler { Line 2234  sub handler {
   
     if ($fn=~/\/$/) {      if ($fn=~/\/$/) {
 # -------------------------------------------------------- This is a directory  # -------------------------------------------------------- This is a directory
  &publishdirectory($r,$fn,$thisdisfn);   &publishdirectory($r,$docroot.$fn,$thisdisfn);
  $r->print('<hr /><a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>');          $r->print(
               '<br /><br />'.
               &Apache::lonhtmlcommon::actionbox([
                   '<a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>']));
     } else {      } else {
 # ---------------------- Evaluate individual file, and then output information.  # ---------------------- Evaluate individual file, and then output information.
  $fn=~/\.(\w+)$/;   $fn=~/\.(\w+)$/;
Line 2219  ENDCAPTION Line 2288  ENDCAPTION
             $r->print(&Apache::lonhtmlcommon::row_closure()              $r->print(&Apache::lonhtmlcommon::row_closure()
                      .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));                       .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
     $r->print(<<ENDDIFF);      $r->print(<<ENDDIFF);
 <a href='javascript:void(window.open("/adm/diff?filename=$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>  <a href='javascript:void(window.open("/adm/diff?filename=$thisdisfn&amp;versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
 ENDDIFF  ENDDIFF
             $r->print(&mt('Diffs with Current Version').'</a>');              $r->print(&mt('Diffs with Current Version').'</a>');
  }   }
Line 2238  ENDDIFF Line 2307  ENDDIFF
     }      }
     unless ($errorcount) {      unless ($errorcount) {
  my ($outstring,$error)=   my ($outstring,$error)=
     &publish($docroot.$fn,$thistarget,$thisembstyle);      &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle);
  $r->print($outstring);   $r->print($outstring);
     } else {      } else {
  $r->print('<h3 class="LC_error">'.   $r->print('<h3 class="LC_error">'.
Line 2246  ENDDIFF Line 2315  ENDDIFF
   '</h3>');    '</h3>');
     }      }
  } else {   } else {
     &phasetwo($r,$fn,$thistarget,$thisembstyle,$thisdistarget);       &phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget); 
  }   }
     }      }
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
Line 2261  __END__ Line 2330  __END__
   
 =back  =back
   
 =back  
   
 =cut  =cut
   
Removed from v.1.270  
changed lines
  Added in v.1.291

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