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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.75 and 1.81

version 1.75, 2002/03/25 17:09:21 version 1.81, 2002/05/17 22:08:01
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";  
       }  
       if (($newurl !~ /^javascript:/i) &&  
   ($newurl !~ /^mailto:/i) &&  
   ($newurl !~ /^http:/i) &&  
   ($newurl !~ /^\#/)) {  
   $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 429  sub publish { Line 447  sub publish {
         $allowstr=~s/\n+/\n/g;          $allowstr=~s/\n+/\n/g;
         $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;          $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
   
    #Encode any High ASCII characters
    $outstring=&HTML::Entities::encode($outstring,"\200-\377");
 # ------------------------------------------------------------- Write modified  # ------------------------------------------------------------- Write modified
   
         {          {
Line 554  sub publish { Line 574  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 566  sub publish { Line 586  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 592  sub publish { Line 631  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'; 
Line 667  sub phasetwo { Line 706  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 694  sub phasetwo { Line 732  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 722  sub phasetwo { Line 761  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 967  sub handler { Line 1008  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.75  
changed lines
  Added in v.1.81

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