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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.34 and 1.38

version 1.34, 2001/08/11 18:06:25 version 1.38, 2001/08/13 16:12:59
Line 11 Line 11
 # 04/16/2001 Scott Harrison  # 04/16/2001 Scott Harrison
 # 05/03,05/05,05/07 Gerd Kortemeyer  # 05/03,05/05,05/07 Gerd Kortemeyer
 # 05/28/2001 Scott Harrison  # 05/28/2001 Scott Harrison
 # 06/23,08/07,08/11 Gerd Kortemeyer  # 06/23,08/07,08/11,8/13 Gerd Kortemeyer
   
 package Apache::lonpublisher;  package Apache::lonpublisher;
   
Line 133  sub selectbox { Line 133  sub selectbox {
   
 # -------------------------------------------------------- Publication Step One  # -------------------------------------------------------- Publication Step One
   
 sub makeallowed {  
 }  
   
 sub urlfixup {  sub urlfixup {
     return shift;      my ($url,$target)=@_;
       my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
       map {
    if ($_ eq $host) {
       $url=~s/^http\:\/\///;
               $url=~s/^$host//;
           }
       } values %Apache::lonnet::hostname;
       $url=~s/\~$cuname/res\/$cudom\/$cuname/;
       if ($target) {
    $target=~s/\/[^\/]+$//;
          $url=&Apache::lonnet::hreflocation($target,$url);
       }
       return $url;
 }  }
   
 sub publish {  sub publish {
Line 147  sub publish { Line 157  sub publish {
     my $scrout='';      my $scrout='';
     my $allmeta='';      my $allmeta='';
     my $content='';      my $content='';
       my %allow=();
       undef %allow;
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return    return 
Line 236  sub publish { Line 248  sub publish {
                   map {                    map {
                       if (defined($parms{$_})) {                        if (defined($parms{$_})) {
   my $oldurl=$parms{$_};    my $oldurl=$parms{$_};
                           my $newurl=&urlfixup($oldurl);                            my $newurl=&urlfixup($oldurl,$target);
                           if ($newurl ne $oldurl) {                            if ($newurl ne $oldurl) {
       $parms{$_}=$newurl;        $parms{$_}=$newurl;
                               print $logfile 'URL: '.$tag.':'.$oldurl.' - '.                                print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
   $newurl."\n";    $newurl."\n";
   }    }
                           &makeallowed($newurl);                            $allow{$newurl}=1;
                       }                        }
                   } ('src','href','codebase');                    } ('src','href');
   
                     if ($tag eq 'applet') {
         my $codebase='';
                         if (defined($parms{'codebase'})) {
            my $oldcodebase=$parms{'codebase'};
                            unless ($oldcodebase=~/\/$/) {
                               $oldcodebase.='/';
                            }
                            $codebase=&urlfixup($oldcodebase,$target);
                            $codebase=~s/\/$//;    
                            if ($codebase ne $oldcodebase) {
        $parms{'codebase'}=$codebase;
                                print $logfile 'URL codebase: '.$tag.':'.
                                     $oldcodebase.' - '.
     $codebase."\n";
    }
                            $allow{$codebase.'/*'}=1;
         } else {
                           map {
                             if (defined($parms{$_})) {
         my $oldurl=$parms{$_};
                                 my $newurl=&urlfixup($oldurl,$target);
         $newurl=~s/\/[^\/]+$/\/\*/;
                                     print $logfile 'Allow: applet '.$_.':'.
                                     $oldurl.' allows '.
     $newurl."\n";
                                 $allow{$newurl}=1;
                             }
                           } ('archive','code','object');
                         }
                     }
   
                   my $newparmstring='';                    my $newparmstring='';
                   my $endtag='';                    my $endtag='';
Line 258  sub publish { Line 301  sub publish {
                   } keys %parms;                    } keys %parms;
       
   $outstring.='<'.$tag.$newparmstring.$endtag.'>';    $outstring.='<'.$tag.$newparmstring.$endtag.'>';
         }           } else {
      $allow{$token->[2]->{'src'}}=1;
    }
               } elsif ($token->[0] eq 'E') {                } elsif ($token->[0] eq 'E') {
                   unless ($token->[1] eq 'allow') {                    unless ($token->[1] eq 'allow') {
                      $outstring.=$token->[2];                       $outstring.=$token->[2];
Line 267  sub publish { Line 312  sub publish {
                   $outstring.=$token->[1];                    $outstring.=$token->[1];
               }                }
           }            }
   # ------------------------------------------------------------ Construct Allows
        unless ($style eq 'rat') {
    my $allowstr="\n";
           map {
              $allowstr.='<allow src="'.$_.'" />'."\n";
           } keys %allow;
           $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
       }
   # ------------------------------------------------------------- Write modified
   
         {          {
           my $org;            my $org;
           unless ($org=Apache::File->new('>'.$source)) {            unless ($org=Apache::File->new('>'.$source)) {
Line 285  sub publish { Line 340  sub publish {
       } else {        } else {
   print $logfile "Does not need ID and/or index fixup\n";    print $logfile "Does not need ID and/or index fixup\n";
       }        }
       }
 # --------------------------------------------- Initial step done, now metadata  # --------------------------------------------- Initial step done, now metadata
   
 # ---------------------------------------- Storage for metadata keys and fields  # ---------------------------------------- Storage for metadata keys and fields
Line 343  sub publish { Line 398  sub publish {
     }      }
   
 # -------------------------------------------------- Parse content for metadata  # -------------------------------------------------- Parse content for metadata
       if ($style eq 'ssi') {
         $allmeta=Apache::lonxml::xmlparse('meta',$content);          $allmeta=Apache::lonxml::xmlparse('meta',$content);
   
         &metaeval($allmeta);          &metaeval($allmeta);
       }
 # ---------------- Find and document discrepancies in the parameters and stores  # ---------------- Find and document discrepancies in the parameters and stores
   
         my $chparms='';          my $chparms='';
Line 380  sub publish { Line 435  sub publish {
     $scrout.='<p><b>Obsolete parameters or stored values:</b> '.      $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
                      $chparms;                       $chparms;
         }          }
     }  
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
   
         $scrout.=          $scrout.=
Removed from v.1.34  
changed lines
  Added in v.1.38

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