Diff for /loncom/publisher/lonpublisher.pm between versions 1.37 and 1.41

version 1.37, 2001/08/13 12:53:06 version 1.41, 2001/08/17 21:25:36
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,8/13 Gerd Kortemeyer  # 06/23,08/07,08/11,8/13,8/17 Gerd Kortemeyer
   
 package Apache::lonpublisher;  package Apache::lonpublisher;
   
Line 71  sub metaeval { Line 71  sub metaeval {
               } @{$token->[3]};                } @{$token->[3]};
               if ($metadatafields{$unikey}) {                if ($metadatafields{$unikey}) {
   my $newentry=$parser->get_text('/'.$entry);    my $newentry=$parser->get_text('/'.$entry);
                   unless ($metadatafields{$unikey}=~/$newentry/) {                    unless (($metadatafields{$unikey}=~/$newentry/) ||
                             ($newentry eq '')) {
                      $metadatafields{$unikey}.=', '.$newentry;                       $metadatafields{$unikey}.=', '.$newentry;
   }    }
       } else {        } else {
Line 135  sub selectbox { Line 136  sub selectbox {
   
 sub urlfixup {  sub urlfixup {
     my ($url,$target)=@_;      my ($url,$target)=@_;
       unless ($url) { return ''; }
     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);      my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
     map {      map {
  if ($_ eq $host) {   if ($_ eq $host) {
Line 142  sub urlfixup { Line 144  sub urlfixup {
             $url=~s/^$host//;              $url=~s/^$host//;
         }          }
     } values %Apache::lonnet::hostname;      } values %Apache::lonnet::hostname;
       if ($url=~/^http\:\/\//) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;      $url=~s/\~$cuname/res\/$cudom\/$cuname/;
     if ($target) {      if ($target) {
  $target=~s/\/[^\/]+$//;   $target=~s/\/[^\/]+$//;
Line 256  sub publish { Line 259  sub publish {
   }    }
                           $allow{$newurl}=1;                            $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 275  sub publish { Line 309  sub publish {
  }   }
               } 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->[1].'>';
   }    }
               } else {                } else {
                   $outstring.=$token->[1];                    $outstring.=$token->[1];

Removed from v.1.37  
changed lines
  Added in v.1.41


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