Diff for /loncom/publisher/lonpublisher.pm between versions 1.218 and 1.223

version 1.218, 2007/01/26 22:16:33 version 1.223, 2007/04/17 23:21:06
Line 183  sub metaeval { Line 183  sub metaeval {
  if ($token->[0] eq 'S') {   if ($token->[0] eq 'S') {
     my $entry=$token->[1];      my $entry=$token->[1];
     my $unikey=$entry;      my $unikey=$entry;
       next if ($entry =~ m/^(?:parameter|stores)_/);
     if (defined($token->[2]->{'package'})) {       if (defined($token->[2]->{'package'})) { 
  $unikey.='_package_'.$token->[2]->{'package'};   $unikey.="\0package\0".$token->[2]->{'package'};
     }       } 
     if (defined($token->[2]->{'part'})) {       if (defined($token->[2]->{'part'})) { 
  $unikey.='_'.$token->[2]->{'part'};    $unikey.="\0".$token->[2]->{'part'}; 
     }      }
     if (defined($token->[2]->{'id'})) {       if (defined($token->[2]->{'id'})) { 
  $unikey.='_'.$token->[2]->{'id'};   $unikey.="\0".$token->[2]->{'id'};
     }       } 
     if (defined($token->[2]->{'name'})) {       if (defined($token->[2]->{'name'})) { 
  $unikey.='_'.$token->[2]->{'name'};    $unikey.="\0".$token->[2]->{'name'}; 
     }      }
     foreach (@{$token->[3]}) {      foreach (@{$token->[3]}) {
  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};   $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
Line 408  sub urlfixup { Line 409  sub urlfixup {
     if ($url =~ /^mailto:/i) { return $url; }      if ($url =~ /^mailto:/i) { return $url; }
     #internal document links need no fixing      #internal document links need no fixing
     if ($url =~ /^\#/) { return $url; }       if ($url =~ /^\#/) { return $url; } 
     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);      my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)});
     foreach (values %Apache::lonnet::hostname) {      my @lonids = &Apache::lonnet::machine_ids($host);
  if ($_ eq $host) {      if (@lonids) {
     $url=~s/^http\:\/\///;   $url=~s{^(?:http|https|ftp)://}{};
             $url=~s/^$host//;   $url=~s/^\Q$host\E//;
         }  
     }      }
     if ($url=~/^http\:\/\//) { return $url; }      if ($url=~m{^(?:http|https|ftp)://}) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;      $url=~s{\Q~$cuname\E}{res/$cudom/$cuname};
     return $url;      return $url;
 }  }
   
Line 467  sub set_allow { Line 467  sub set_allow {
     }      }
     if (($newurl !~ /^javascript:/i) &&      if (($newurl !~ /^javascript:/i) &&
  ($newurl !~ /^mailto:/i) &&   ($newurl !~ /^mailto:/i) &&
  ($newurl !~ /^http:/i) &&   ($newurl !~ /^(?:http|https|ftp):/i) &&
  ($newurl !~ /^\#/)) {   ($newurl !~ /^\#/)) {
  $$allow{&absoluteurl($newurl,$target)}=1;   $$allow{&absoluteurl($newurl,$target)}=1;
     }      }
Line 1095  sub publish { Line 1095  sub publish {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($_=~/^parameter/) || ($_=~/^stores/)) {
     unless ($_=~/\.\w+$/) {       unless ($_=~/\.\w+$/) { 
  unless ($oldparmstores{$_}) {   unless ($oldparmstores{$_}) {
     print $logfile 'New: '.$_."\n";      my $disp_key = $_;
     $chparms.=$_.' ';      $disp_key =~ tr/\0/_/;
       print $logfile ('New: '.$disp_key."\n");
       $chparms .= $disp_key.' ';
  }   }
     }      }
  }   }
Line 1111  sub publish { Line 1113  sub publish {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($_=~/^parameter/) || ($_=~/^stores/)) {
     unless (($metadatafields{$_.'.name'}) ||      unless (($metadatafields{$_.'.name'}) ||
     ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {      ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
  print $logfile 'Obsolete: '.$_."\n";   my $disp_key = $_;
  $chparms.=$_.' ';   $disp_key =~ tr/\0/_/;
    print $logfile ('Obsolete: '.$disp_key."\n");
    $chparms.=$disp_key.' ';
     }      }
  }   }
     }      }
     if ($chparms) {      if ($chparms) {
  $scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.   $scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.
     $chparms.'</p><h1><font color="red">'.&mt('Warning!').      $chparms.'</p><h1><span class="LC_warning">'.&mt('Warning!').
     '</font></h1><p><font color="red" size="+1">'.      '</span></h1><p><span class="LC_warning">'.
     &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</font></p><hr />';      &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</span></p><hr />';
     }      }
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata

Removed from v.1.218  
changed lines
  Added in v.1.223


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