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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.72 and 1.83

version 1.72, 2002/01/18 16:48:14 version 1.83, 2002/06/24 14:25:38
Line 68  use strict; Line 68  use strict;
 use Apache::File;  use Apache::File;
 use File::Copy;  use File::Copy;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use HTML::TokeParser;  use HTML::LCParser;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::lonhomework;  use Apache::lonhomework;
 use Apache::loncacc;  use Apache::loncacc;
Line 91  my $cudom; Line 91  my $cudom;
 sub metaeval {  sub metaeval {
     my $metastring=shift;      my $metastring=shift;
         
         my $parser=HTML::TokeParser->new(\$metastring);          my $parser=HTML::LCParser->new(\$metastring);
         my $token;          my $token;
         while ($token=$parser->get_token) {          while ($token=$parser->get_token) {
            if ($token->[0] eq 'S') {             if ($token->[0] eq 'S') {
Line 217  sub absoluteurl { Line 217  sub absoluteurl {
     return $url;      return $url;
 }  }
   
   sub set_allow {
       my ($allow,$logfile,$target,$tag,$oldurl)=@_;
       my $newurl=&urlfixup($oldurl,$target);
       my $return_url=$oldurl;
       print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
       if ($newurl ne $oldurl) {
    $return_url=$newurl;
    print $logfile 'URL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
       }
       if (($newurl !~ /^javascript:/i) &&
    ($newurl !~ /^mailto:/i) &&
    ($newurl !~ /^http:/i) &&
    ($newurl !~ /^\#/)) {
    $$allow{&absoluteurl($newurl,$target)}=1;
       }
       return $return_url
   }
   
 sub publish {  sub publish {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style)=@_;
Line 257  sub publish { Line 275  sub publish {
           $content=join('',<$org>);            $content=join('',<$org>);
         }          }
         {          {
           my $parser=HTML::TokeParser->new(\$content);            my $parser=HTML::LCParser->new(\$content);
           my $token;            my $token;
           while ($token=$parser->get_token) {            while ($token=$parser->get_token) {
               if ($token->[0] eq 'S') {                if ($token->[0] eq 'S') {
Line 288  sub publish { Line 306  sub publish {
                 "Max Index: $maxindex (min 10)\n";                  "Max Index: $maxindex (min 10)\n";
       }        }
           my $outstring='';            my $outstring='';
           my $parser=HTML::TokeParser->new(\$content);            my $parser=HTML::LCParser->new(\$content);
           $parser->xml_mode(1);            $parser->xml_mode(1);
           my $token;            my $token;
           while ($token=$parser->get_token) {            while ($token=$parser->get_token) {
Line 318  sub publish { Line 336  sub publish {
   
                   foreach my $type ('src','href','background','bgimg') {                    foreach my $type ('src','href','background','bgimg') {
       foreach my $key (keys(%parms)) {        foreach my $key (keys(%parms)) {
     print $logfile "for $type, and $key\n";
   if ($key =~ /^$type$/i) {    if ($key =~ /^$type$/i) {
       my $oldurl=$parms{$key};        print $logfile "calling set_allow\n";
       my $newurl=&urlfixup($oldurl,$target);        $parms{$key}=&set_allow(\%allow,$logfile,
       if ($newurl ne $oldurl) {        $target,$tag,
   $parms{$key}=$newurl;        $parms{$key});
   print $logfile 'URL: '.$tag.':'.$oldurl.' - '.  
       $newurl."\n";  
       }  
       $allow{&absoluteurl($newurl,$target)}=1;  
   }    }
   last;  
       }        }
                   }                    }
     # probably a <randomlabel> image type <label>
     if ($lctag eq 'label' && defined($parms{'description'})) {
         my $next_token=$parser->get_token();
         if ($next_token->[0] eq 'T') {
     $next_token->[1]=&set_allow(\%allow,$logfile,
         $target,$tag,
         $next_token->[1]);
         }
         $parser->unget_token($next_token);
     }
                   if ($lctag eq 'applet') {                    if ($lctag eq 'applet') {
       my $codebase='';        my $codebase='';
                       if (defined($parms{'codebase'})) {                        if (defined($parms{'codebase'})) {
Line 392  sub publish { Line 415  sub publish {
           
  $scrout.='<h3>Dependencies</h3>';   $scrout.='<h3>Dependencies</h3>';
         my $allowstr='';          my $allowstr='';
         foreach (keys %allow) {          foreach (sort(keys(%allow))) {
    my $thisdep=$_;     my $thisdep=$_;
      if ($thisdep !~ /[^\s]/) { next; }
            unless ($style eq 'rat') {              unless ($style eq 'rat') { 
               $allowstr.="\n".'<allow src="'.$thisdep.'" />';                $allowstr.="\n".'<allow src="'.$thisdep.'" />';
    }     }
Line 420  sub publish { Line 444  sub publish {
        }         }
            }             }
         }          }
         $allowstr=~s/\n+/\n/g;          $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;
         $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;  
   
    #Encode any High ASCII characters
    $outstring=&HTML::Entities::encode($outstring,"\200-\377");
 # ------------------------------------------------------------- Write modified  # ------------------------------------------------------------- Write modified
   
         {          {
Line 507  sub publish { Line 532  sub publish {
         my $oldenv=$ENV{'request.uri'};          my $oldenv=$ENV{'request.uri'};
   
         $ENV{'request.uri'}=$target;          $ENV{'request.uri'}=$target;
         $allmeta=Apache::lonxml::xmlparse('meta',$content);          $allmeta=Apache::lonxml::xmlparse(undef,'meta',$content);
         $ENV{'request.uri'}=$oldenv;          $ENV{'request.uri'}=$oldenv;
   
         &metaeval($allmeta);          &metaeval($allmeta);
Line 548  sub publish { Line 573  sub publish {
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
   
         $scrout.=          $scrout.=
      '<form action="/adm/publish" method="post">'.       '<form name="pubform" action="/adm/publish" method="post">'.
        '<p><input type="submit" value="Finalize Publication" /></p>'.         '<p><input type="submit" value="Finalize Publication" /></p>'.
           &hiddenfield('phase','two').            &hiddenfield('phase','two').
           &hiddenfield('filename',$ENV{'form.filename'}).            &hiddenfield('filename',$ENV{'form.filename'}).
Line 560  sub publish { Line 585  sub publish {
   
 # --------------------------------------------------- Scan content for keywords  # --------------------------------------------------- Scan content for keywords
   
  my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';   my $keywordout=<<"END";
   <script>
   function checkAll(field)
   {
       for (i = 0; i < field.length; i++)
           field[i].checked = true ;
   }
   
   function uncheckAll(field)
   {
       for (i = 0; i < field.length; i++)
           field[i].checked = false ;
   }
   </script>
   <p><b>Keywords:</b> 
   <input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)"> 
   <input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)"> 
   <br />
   END
           $keywordout.='<table border=2><tr>';
         my $colcount=0;          my $colcount=0;
         my %keywords=();          my %keywords=();
                   
Line 586  sub publish { Line 630  sub publish {
             }              }
   
             foreach (sort keys %keywords) {              foreach (sort keys %keywords) {
                 $keywordout.='<td><input type=checkbox name="key.'.$_.'"';                  $keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"';
                 if ($metadatafields{'keywords'}) {                  if ($metadatafields{'keywords'}) {
                    if ($metadatafields{'keywords'}=~/$_/) {                      if ($metadatafields{'keywords'}=~/$_/) { 
                       $keywordout.=' checked';                         $keywordout.=' checked'; 
                    }                     }
         } elsif (&Apache::loncommon::keyword($_)) {          } elsif (&Apache::loncommon::keyword($_)) {
     $keywordout.=' checked';              $keywordout.=' checked';
                 }                   } 
                 $keywordout.='>'.$_.'</td>';                  $keywordout.='>'.$_.'</td>';
                 if ($colcount>10) {                  if ($colcount>10) {
Line 661  sub phasetwo { Line 705  sub phasetwo {
     my ($source,$target,$style,$distarget)=@_;      my ($source,$target,$style,$distarget)=@_;
     my $logfile;      my $logfile;
     my $scrout='';      my $scrout='';
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return    return 
          '<font color=red>No write permission to user directory, FAIL</font>';           '<font color=red>No write permission to user directory, FAIL</font>';
Line 688  sub phasetwo { Line 731  sub phasetwo {
      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};       $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
   
      my $allkeywords=$ENV{'form.addkey'};       my $allkeywords=$ENV{'form.addkey'};
      foreach (keys %ENV) {       if (exists($ENV{'form.keywords'}) && (ref($ENV{'form.keywords'}))) {
          if ($_=~/^form\.key\.(\w+)/) {           my @Keywords = @{$ENV{'form.keywords'}};
      $allkeywords.=','.$1;           foreach (@Keywords) {
                $allkeywords.=','.$_;
          }           }
      }       }
      $allkeywords=~s/\W+/\,/;       $allkeywords=~s/\W+/\,/;
Line 716  sub phasetwo { Line 760  sub phasetwo {
                $value=~s/\"/\'\'/g;                 $value=~s/\"/\'\'/g;
                print $mfh ' '.$_.'="'.$value.'"';                 print $mfh ' '.$_.'="'.$value.'"';
            }             }
    print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';     print $mfh '>'.
        &HTML::Entities::encode($metadatafields{$unikey})
          .'</'.$tag.'>';
          }           }
        }         }
        $scrout.='<p>Wrote Metadata';         $scrout.='<p>Wrote Metadata';
Line 941  if (-e $target) { Line 987  if (-e $target) {
   
   
     return $warning.$scrout.      return $warning.$scrout.
       '<hr><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'.        '<hr><a href="'.$thisdistarget.'"><font size=+2>View Published Version</font></a>'.
       '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.        '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
       '<p><a href="'.$thissrcdir.        '<p><a href="'.$thissrcdir.
       '"><font size=+2>Back to Source Directory</font></a>';        '"><font size=+2>Back to Source Directory</font></a>';
Line 961  sub handler { Line 1007  sub handler {
   
 # Get query string for limited number of parameters  # Get query string for limited number of parameters
   
     foreach (split(/&/,$ENV{'QUERY_STRING'})) {      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
        my ($name, $value) = split(/=/,$_);                                              ['filename']);
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        if ($name eq 'filename') {  
            unless ($ENV{'form.'.$name}) {  
               $ENV{'form.'.$name}=$value;  
    }  
        }  
     }  
   
   
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
Removed from v.1.72  
changed lines
  Added in v.1.83

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