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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.70 and 1.86

version 1.70, 2002/01/16 19:09:31 version 1.86, 2002/08/07 19:45:05
Line 43 Line 43
 # 12/06,12/07 Gerd Kortemeyer  # 12/06,12/07 Gerd Kortemeyer
 # 12/15,12/16 Scott Harrison  # 12/15,12/16 Scott Harrison
 # 12/25 Gerd Kortemeyer  # 12/25 Gerd Kortemeyer
   # YEAR=2002
   # 1/16,1/17 Scott Harrison
   # 1/17 Gerd Kortemeyer
 #  #
 ###  ###
   
Line 65  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 88  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 200  sub urlfixup { Line 203  sub urlfixup {
     }      }
     if ($url=~/^http\:\/\//) { return $url; }      if ($url=~/^http\:\/\//) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;      $url=~s/\~$cuname/res\/$cudom\/$cuname/;
       return $url;
   }
   
   
   sub absoluteurl {
       my ($url,$target)=@_;
       unless ($url) { return ''; }
     if ($target) {      if ($target) {
  $target=~s/\/[^\/]+$//;   $target=~s/\/[^\/]+$//;
        $url=&Apache::lonnet::hreflocation($target,$url);         $url=&Apache::lonnet::hreflocation($target,$url);
Line 207  sub urlfixup { Line 217  sub urlfixup {
     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 get_subscribed_hosts {
       my ($target)=@_;
       my @subscribed;
       my $filename;
       $target=~/(.*)\/([^\/]+)$/;
       my $srcf=$2;
       opendir(DIR,$1);
       while ($filename=readdir(DIR)) {
    if ($filename=~/$srcf\.(\w+)$/) {
       my $subhost=$1;
       if ($subhost ne 'meta' && $subhost ne 'subscription') {
    push(@subscribed,$subhost);
       }
    }
       }
       closedir(DIR);
       my $sh;
       if ( $sh=Apache::File->new("$target.subscription") ) {
    &Apache::lonnet::logthis("opened $target.subscription");
    while (my $subline=<$sh>) {
       &Apache::lonnet::logthis("Trying $subline");
       if ($subline =~ /(^\w+):/) { push(@subscribed,$1); } else {
    &Apache::lonnet::logthis("No Match for $subline");
       }
    }
       } else {
    &Apache::lonnet::logthis("Un able to open $target.subscription");
       }
       &Apache::lonnet::logthis("Got list of ".join(':',@subscribed));
       return @subscribed;
   }
   
   
   sub get_max_ids_indices {
       my ($content)=@_;
       my $maxindex=10;
       my $maxid=10;
       my $needsfixup=0;
   
       my $parser=HTML::LCParser->new($content);
       my $token;
       while ($token=$parser->get_token) {
    if ($token->[0] eq 'S') {
       my $counter;
       if ($counter=$addid{$token->[1]}) {
    if ($counter eq 'id') {
       if (defined($token->[2]->{'id'})) {
    $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
       } else {
    $needsfixup=1;
       }
    } else {
       if (defined($token->[2]->{'index'})) {
    $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
       } else {
    $needsfixup=1;
       }
    }
       }
    }
       }
       return ($needsfixup,$maxid,$maxindex);
   }
   
   #Arguably this should all be done as an lonnet::ssi instead
   sub fix_ids_and_indices {
       my ($logfile,$source,$target)=@_;
   
       my %allow;
       my $content;
       {
    my $org=Apache::File->new($source);
    $content=join('',<$org>);
       }
   
       my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content);
   
       if ($needsfixup) {
    print $logfile "Needs ID and/or index fixup\n".
       "Max ID   : $maxid (min 10)\n".
                   "Max Index: $maxindex (min 10)\n";
       }
       my $outstring='';
       my @parser;
       $parser[0]=HTML::LCParser->new(\$content);
       $parser[-1]->xml_mode(1);
       my $token;
       while (@parser) {
    while ($token=$parser[-1]->get_token) {
       if ($token->[0] eq 'S') {
    my $counter;
    my $tag=$token->[1];
    my $lctag=lc($tag);
    if ($lctag eq 'allow') {
       $allow{$token->[2]->{'src'}}=1;
       next;
    }
    my %parms=%{$token->[2]};
    $counter=$addid{$tag};
    if (!$counter) { $counter=$addid{$lctag}; }
    if ($counter) {
       if ($counter eq 'id') {
    unless (defined($parms{'id'})) {
       $maxid++;
       $parms{'id'}=$maxid;
       print $logfile 'ID: '.$tag.':'.$maxid."\n";
    }
       } elsif ($counter eq 'index') {
    unless (defined($parms{'index'})) {
       $maxindex++;
       $parms{'index'}=$maxindex;
       print $logfile 'Index: '.$tag.':'.$maxindex."\n";
    }
       }
    }
    foreach my $type ('src','href','background','bgimg') {
       foreach my $key (keys(%parms)) {
    print $logfile "for $type, and $key\n";
    if ($key =~ /^$type$/i) {
       print $logfile "calling set_allow\n";
       $parms{$key}=&set_allow(\%allow,$logfile,
       $target,$tag,
       $parms{$key});
    }
       }
    }
    # probably a <randomlabel> image type <label>
    if ($lctag eq 'label' && defined($parms{'description'})) {
       my $next_token=$parser[-1]->get_token();
       if ($next_token->[0] eq 'T') {
    $next_token->[1]=&set_allow(\%allow,$logfile,
       $target,$tag,
       $next_token->[1]);
       }
       $parser[-1]->unget_token($next_token);
    }
    if ($lctag 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{&absoluteurl($codebase,$target).'/*'}=1;
       } else {
    foreach ('archive','code','object') {
       if (defined($parms{$_})) {
    my $oldurl=$parms{$_};
    my $newurl=&urlfixup($oldurl,$target);
    $newurl=~s/\/[^\/]+$/\/\*/;
    print $logfile 'Allow: applet '.$_.':'.
       $oldurl.' allows '.
    $newurl."\n";
    $allow{&absoluteurl($newurl,$target)}=1;
       }
    }
       }
    }
    my $newparmstring='';
    my $endtag='';
    foreach (keys %parms) {
       if ($_ eq '/') {
    $endtag=' /';
       } else { 
    my $quote=($parms{$_}=~/\"/?"'":'"');
    $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
       }
    }
    if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
    $outstring.='<'.$tag.$newparmstring.$endtag.'>';
       } elsif ($token->[0] eq 'E') {
    if ($token->[2]) {
       unless ($token->[1] eq 'allow') {
    $outstring.='</'.$token->[1].'>';
       }
    }
       } else {
    $outstring.=$token->[1];
       }
    }
    pop(@parser);
       }
   
       if ($needsfixup) {
    print $logfile "End of ID and/or index fixup\n".
       "Max ID   : $maxid (min 10)\n".
    "Max Index: $maxindex (min 10)\n";
       } else {
    print $logfile "Does not need ID and/or index fixup\n";
       }
   
       return ($outstring,%allow);
   }
   
 sub publish {  sub publish {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style)=@_;
Line 215  sub publish { Line 445  sub publish {
     my $allmeta='';      my $allmeta='';
     my $content='';      my $content='';
     my %allow=();      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 465  sub publish {
           return "<font color=red>Failed to write backup copy, $!,FAIL</font>";            return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
         }          }
 # ------------------------------------------------------------- IDs and indices  # ------------------------------------------------------------- IDs and indices
   
         my $maxindex=10;   my $outstring;
         my $maxid=10;   ($outstring,%allow)=&fix_ids_and_indices($logfile,$source,$target);
   
         my $needsfixup=0;  
   
         {  
           my $org=Apache::File->new($source);  
           $content=join('',<$org>);  
         }  
         {  
           my $parser=HTML::TokeParser->new(\$content);  
           my $token;  
           while ($token=$parser->get_token) {  
               if ($token->[0] eq 'S') {  
                   my $counter;  
   if ($counter=$addid{$token->[1]}) {  
       if ($counter eq 'id') {  
   if (defined($token->[2]->{'id'})) {  
                              $maxid=  
        ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;  
  } else {  
                              $needsfixup=1;  
                          }  
                       } else {  
    if (defined($token->[2]->{'index'})) {  
                              $maxindex=  
    ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;  
   } else {  
                              $needsfixup=1;  
   }  
       }  
   }  
               }  
           }  
       }  
       if ($needsfixup) {  
           print $logfile "Needs ID and/or index fixup\n".  
         "Max ID   : $maxid (min 10)\n".  
                 "Max Index: $maxindex (min 10)\n";  
       }  
           my $outstring='';  
           my $parser=HTML::TokeParser->new(\$content);  
           $parser->xml_mode(1);  
           my $token;  
           while ($token=$parser->get_token) {  
               if ($token->[0] eq 'S') {  
                 my $counter;  
                 my $tag=$token->[1];  
                 my $lctag=lc($tag);  
                 unless ($lctag eq 'allow') {    
                   my %parms=%{$token->[2]};  
                   $counter=$addid{$tag};  
                   if (!$counter) { $counter=$addid{$lctag}; }  
                   if ($counter) {  
       if ($counter eq 'id') {  
   unless (defined($parms{'id'})) {  
                               $maxid++;  
                               $parms{'id'}=$maxid;  
                               print $logfile 'ID: '.$tag.':'.$maxid."\n";  
                           }  
                       } elsif ($counter eq 'index') {  
    unless (defined($parms{'index'})) {  
                               $maxindex++;  
                               $parms{'index'}=$maxindex;  
                               print $logfile 'Index: '.$tag.':'.$maxindex."\n";  
   }  
       }  
   }   
                     
                   foreach ('src','href','background') {  
                       if (defined($parms{$_})) {  
   my $oldurl=$parms{$_};  
                           my $newurl=&urlfixup($oldurl,$target);  
                           if ($newurl ne $oldurl) {  
       $parms{$_}=$newurl;  
                               print $logfile 'URL: '.$tag.':'.$oldurl.' - '.  
   $newurl."\n";  
   }  
                           $allow{$newurl}=1;  
                       }  
                   }  
   
                   if ($lctag 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 {  
                         foreach ('archive','code','object') {  
                           if (defined($parms{$_})) {  
       my $oldurl=$parms{$_};  
                               my $newurl=&urlfixup($oldurl,$target);  
       $newurl=~s/\/[^\/]+$/\/\*/;  
                                   print $logfile 'Allow: applet '.$_.':'.  
                                   $oldurl.' allows '.  
   $newurl."\n";  
                               $allow{$newurl}=1;  
                           }  
                         }  
                       }  
                   }  
   
                   my $newparmstring='';  
                   my $endtag='';  
                   foreach (keys %parms) {  
                     if ($_ eq '/') {  
                       $endtag=' /';  
                     } else {   
                       my $quote=($parms{$_}=~/\"/?"'":'"');  
                       $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;  
     }  
                   }  
   if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }  
   $outstring.='<'.$tag.$newparmstring.$endtag.'>';  
          } else {  
    $allow{$token->[2]->{'src'}}=1;  
  }  
               } elsif ($token->[0] eq 'E') {  
  if ($token->[2]) {  
                   unless ($token->[1] eq 'allow') {  
                      $outstring.='</'.$token->[1].'>';  
   }  
  }  
               } else {  
                   $outstring.=$token->[1];  
               }  
           }  
 # ------------------------------------------------------------ Construct Allows  # ------------------------------------------------------------ Construct Allows
           
  $scrout.='<h3>Dependencies</h3>';   $scrout.='<h3>Dependencies</h3>';
         my $allowstr='';          my $allowstr='';
         foreach (keys %allow) {          foreach (sort(keys(%allow))) {
    my $thisdep=$_;     my $thisdep=$_;
      if ($thisdep !~ /[^\s]/) { next; }
            unless ($style eq 'rat') {              unless ($style eq 'rat') { 
               $allowstr.="\n".'<allow src="'.$thisdep.'" />';                $allowstr.="\n".'<allow src="'.$thisdep.'" />';
    }     }
Line 407  sub publish { Line 501  sub publish {
        }         }
            }             }
         }          }
         $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;          $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;
   
    #Encode any High ASCII characters
    $outstring=&HTML::Entities::encode($outstring,"\200-\377");
 # ------------------------------------------------------------- Write modified  # ------------------------------------------------------------- Write modified
   
         {          {
Line 422  sub publish { Line 518  sub publish {
         }          }
   $content=$outstring;    $content=$outstring;
   
       if ($needsfixup) {  
           print $logfile "End of ID and/or index fixup\n".  
         "Max ID   : $maxid (min 10)\n".  
                 "Max Index: $maxindex (min 10)\n";  
       } else {  
   print $logfile "Does not need ID and/or index fixup\n";  
       }  
     }      }
 # --------------------------------------------- Initial step done, now metadata  # --------------------------------------------- Initial step done, now metadata
   
Line 439  sub publish { Line 528  sub publish {
             
      my %oldparmstores=();       my %oldparmstores=();
             
      $scrout.='<h3>Metadata Information</h3>';       
        $scrout.='<h3>Metadata Information ' .
          Apache::loncommon::help_open_topic("Metadata_Description")
          . '</h3>';
   
 # ------------------------------------------------ First, check out environment  # ------------------------------------------------ First, check out environment
      unless (-e $source.'.meta') {       unless (-e $source.'.meta') {
Line 493  sub publish { Line 585  sub publish {
         my $oldenv=$ENV{'request.uri'};          my $oldenv=$ENV{'request.uri'};
   
         $ENV{'request.uri'}=$target;          $ENV{'request.uri'}=$target;
         $allmeta=Apache::lonxml::xmlparse('meta',$content);          $allmeta=Apache::lonxml::xmlparse(undef,'meta',$content);
         $ENV{'request.uri'}=$oldenv;          $ENV{'request.uri'}=$oldenv;
   
         &metaeval($allmeta);          &metaeval($allmeta);
Line 534  sub publish { Line 626  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 546  sub publish { Line 638  sub publish {
   
 # --------------------------------------------------- Scan content for keywords  # --------------------------------------------------- Scan content for keywords
   
  my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';          my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
    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: $keywords_help</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 572  sub publish { Line 684  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'; 
                    }                     }
         } elsif (&Apache::loncommon::keyword($_)) {          } elsif (&Apache::loncommon::keyword($_)) {
     $keywordout.=' checked';              $keywordout.=' checked';
                 }                   } 
                 $keywordout.='>'.$_.'</td>';                  $keywordout.='>'.$_.'</td>';
                 if ($colcount>10) {                  if ($colcount>10) {
Line 621  sub publish { Line 733  sub publish {
  $scrout.=&textfield('Publisher/Owner','owner',   $scrout.=&textfield('Publisher/Owner','owner',
                             $metadatafields{'owner'});                              $metadatafields{'owner'});
 # --------------------------------------------------- Correct copyright for rat          # --------------------------------------------------- Correct copyright for rat        
   
     if ($style eq 'rat') {      if ($style eq 'rat') {
  if ($metadatafields{'copyright'} eq 'public') {    if ($metadatafields{'copyright'} eq 'public') { 
     delete $metadatafields{'copyright'};      delete $metadatafields{'copyright'};
Line 636  sub publish { Line 749  sub publish {
     \&Apache::loncommon::copyrightdescription,      \&Apache::loncommon::copyrightdescription,
      (&Apache::loncommon::copyrightids));       (&Apache::loncommon::copyrightids));
     }      }
   
       my $copyright_help = Apache::loncommon::help_open_topic("Publishing_Copyright");
       $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
     return $scrout.      return $scrout.
       '<p><input type="submit" value="Finalize Publication" /></p></form>';        '<p><input type="submit" value="Finalize Publication" /></p></form>';
 }  }
Line 647  sub phasetwo { Line 763  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 674  sub phasetwo { Line 789  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 702  sub phasetwo { Line 818  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 863  if (-e $target) { Line 981  if (-e $target) {
   
 # --------------------------------------------------- Send update notifications  # --------------------------------------------------- Send update notifications
   
 {      my @subscribed=&get_subscribed_hosts($target);
       foreach my $subhost (@subscribed) {
     my $filename;   $scrout.='<p>Notifying host '.$subhost.':';
     print $logfile "\nNotifying host ".$subhost.':';
     $target=~/(.*)\/([^\/]+)$/;   my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
     my $srcf=$2;   $scrout.=$reply;
     opendir(DIR,$1);   print $logfile $reply;
     while ($filename=readdir(DIR)) {  
        if ($filename=~/$srcf\.(\w+)$/) {  
    my $subhost=$1;  
            if ($subhost ne 'meta') {  
        $scrout.='<p>Notifying host '.$subhost.':';  
                print $logfile "\nNotifying host '.$subhost.':'";  
                my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);  
                $scrout.=$reply;  
                print $logfile $reply;                
            }  
        }  
     }      }
     closedir(DIR);  
   
 }  
   
 # ---------------------------------------- Send update notifications, meta only  # ---------------------------------------- Send update notifications, meta only
   
 {      my @subscribedmeta=&get_subscribed_hosts("$target.meta");
       foreach my $subhost (@subscribedmeta) {
     my $filename;   $scrout.='<p>Notifying host for metadata only '.$subhost.':';
     print $logfile "\nNotifying host for metadata only ".$subhost.':';
     $target=~/(.*)\/([^\/]+)$/;   my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
     my $srcf=$2.'.meta';      $subhost);
     opendir(DIR,$1);   $scrout.=$reply;
     while ($filename=readdir(DIR)) {   print $logfile $reply;
        if ($filename=~/$srcf\.(\w+)$/) {  
    my $subhost=$1;  
            if ($subhost ne 'meta') {  
        $scrout.=  
                 '<p>Notifying host for metadata only '.$subhost.':';  
                print $logfile   
                 "\nNotifying host for metadata only '.$subhost.':'";  
                my $reply=&Apache::lonnet::critical(  
                                 'update:'.$target.'.meta',$subhost);  
                $scrout.=$reply;  
                print $logfile $reply;                
            }  
        }  
     }      }
     closedir(DIR);  
   
 }  
   
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
   
Line 927  if (-e $target) { Line 1015  if (-e $target) {
   
   
     return $warning.$scrout.      return $warning.$scrout.
       '<hr><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'.        '<hr><a href="'.$thisdistarget.'"><font size=+2>View Published Version</font></a>'.
       '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.        '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
       '<p><a href="'.$thissrcdir.        '<p><a href="'.$thissrcdir.
       '"><font size=+2>Back to Source Directory</font></a>';        '"><font size=+2>Back to Source Directory</font></a>';
Line 947  sub handler { Line 1035  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.70  
changed lines
  Added in v.1.86

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.