[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.37

version 1.34, 2001/08/11 18:06:25 version 1.37, 2001/08/13 12:53:06
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','codebase');
   
Line 258  sub publish { Line 270  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 281  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 309  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 367  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 404  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.37

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