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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.3 and 1.4

version 1.3, 2000/11/29 19:52:34 version 1.4, 2000/11/30 10:11:47
Line 5 Line 5
 #  #
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  # 05/29/00,05/30,10/11 Gerd Kortemeyer)
 #  #
 # 11/28,11/29 Gerd Kortemeyer  # 11/28,11/29,11/30 Gerd Kortemeyer
   
 package Apache::lonpublisher;  package Apache::lonpublisher;
   
Line 13  use strict; Line 13  use strict;
 use Apache::File;  use Apache::File;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use HTML::TokeParser;  use HTML::TokeParser;
   use Apache::lonxml;
   
 my %addid;  my %addid;
   
 sub publish {  sub publish {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style)=@_;
     my $logfile;      my $logfile;
       my $scrout='';
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return 'No write permission to user directory, FAIL';   return 'No write permission to user directory, FAIL';
     }      }
Line 27  sub publish { Line 31  sub publish {
   
     if (($style eq 'ssi') || ($style eq 'rat')) {      if (($style eq 'ssi') || ($style eq 'rat')) {
 # ------------------------------------------------------- This needs processing  # ------------------------------------------------------- This needs processing
   
   # ----------------------------------------------------------------- Backup Copy
  my $copyfile=$source.'.save';   my $copyfile=$source.'.save';
         {          {
     my $org=Apache::File->new($source);      my $org=Apache::File->new($source);
Line 36  sub publish { Line 42  sub publish {
         if (-e $copyfile) {          if (-e $copyfile) {
     print $logfile "Copied original file to ".$copyfile."\n";      print $logfile "Copied original file to ".$copyfile."\n";
         } else {          } else {
       print $logfile "Unable to write backup ".$copyfile."\n";
             return "Failed to write backup copy, FAIL";              return "Failed to write backup copy, FAIL";
         }          }
   # ------------------------------------------------------------- IDs and indices
   
           my $maxindex=10;
           my $maxid=10;
           my $content='';
           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);
             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'})) {
         $outstring.=$token->[4];
     } else {
                                 $maxid++;
                                 my $thisid=' id="'.$maxid.'"';
         my $fixup=$token->[4];
                                 $fixup=~s/(\<\w+)/$1$thisid/;
                                 $outstring.=$fixup;
                                 print $logfile 'ID: '.$fixup."\n";
                             }
                         } else {
      if (defined($token->[2]->{'index'})) {
         $outstring.=$token->[4];
     } else {
                                 $maxindex++;
                                 my $thisindex=' index="'.$maxindex.'"';
         my $fixup=$token->[4];
                                 $fixup=~s/(\<\w+)/$1$thisindex/;
                                 $outstring.=$fixup;
                                 print $logfile 'Index: '.$fixup."\n";
     }
         }
     } else {
                         $outstring.=$token->[4];
                     }
                 } elsif ($token->[0] eq 'E') {
                     $outstring.=$token->[2];
                 } else {
                     $outstring.=$token->[1];
                 }
             }
           {
             my $org;
             unless ($org=Apache::File->new('>'.$source)) {
                print $logfile "No write permit to $source\n";
                return "No write permission to $source, FAIL";
     }
             print $org $outstring;
           }
     $content=$outstring;
             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";
         }
   # -------------------------------------------------- Parse content for metadata
   
    my $allmeta=Apache::lonxml::xmlparse('meta',$content);
           
           $scrout=$allmeta;
   
     }      }
     my $version='';      return $scrout;
      
     return 'Version '.$version.', SUCCESS';  
 }  }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
Line 66  sub handler { Line 172  sub handler {
      return HTTP_NOT_FOUND;       return HTTP_NOT_FOUND;
   }     } 
   
     unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
        $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
            ' trying to publish file '.$ENV{'form.filename'}.
            ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', 
            $r->filename); 
        return HTTP_NOT_ACCEPTABLE;
     }
   
   $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;    $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
   
   my $targetdir='';    my $targetdir='';
Removed from v.1.3  
changed lines
  Added in v.1.4

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