Return to lonpublisher.pm CVS log

Up to [LON-CAPA] / loncom / publisher

Now fixes IDs and indexes

    1: # The LearningOnline Network with CAPA
    2: # Publication Handler
    3: # 
    4: # (TeX Content Handler
    5: #
    6: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
    7: #
    8: # 11/28,11/29,11/30 Gerd Kortemeyer
    9: 
   10: package Apache::lonpublisher;
   11: 
   12: use strict;
   13: use Apache::File;
   14: use Apache::Constants qw(:common :http :methods);
   15: use HTML::TokeParser;
   16: use Apache::lonxml;
   17: 
   18: my %addid;
   19: 
   20: sub publish {
   21: 
   22:     my ($source,$target,$style)=@_;
   23:     my $logfile;
   24:     my $scrout='';
   25: 
   26:     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
   27: 	return 'No write permission to user directory, FAIL';
   28:     }
   29:     print $logfile 
   30: "\n\n================== Publish ".localtime()." =================\n";
   31: 
   32:     if (($style eq 'ssi') || ($style eq 'rat')) {
   33: # ------------------------------------------------------- This needs processing
   34: 
   35: # ----------------------------------------------------------------- Backup Copy
   36: 	my $copyfile=$source.'.save';
   37:         {
   38: 	    my $org=Apache::File->new($source);
   39:             my $cop=Apache::File->new('>'.$copyfile);
   40:             while (my $line=<$org>) { print $cop $line; }
   41:         }
   42:         if (-e $copyfile) {
   43: 	    print $logfile "Copied original file to ".$copyfile."\n";
   44:         } else {
   45: 	    print $logfile "Unable to write backup ".$copyfile."\n";
   46:             return "Failed to write backup copy, FAIL";
   47:         }
   48: # ------------------------------------------------------------- IDs and indices
   49: 
   50:         my $maxindex=10;
   51:         my $maxid=10;
   52:         my $content='';
   53:         my $needsfixup=0;
   54: 
   55:         {
   56:           my $org=Apache::File->new($source);
   57:           $content=join('',<$org>);
   58:         }
   59:         {
   60:           my $parser=HTML::TokeParser->new(\$content);
   61:           my $token;
   62:           while ($token=$parser->get_token) {
   63:               if ($token->[0] eq 'S') {
   64:                   my $counter;
   65: 		  if ($counter=$addid{$token->[1]}) {
   66: 		      if ($counter eq 'id') {
   67: 			  if (defined($token->[2]->{'id'})) {
   68:                              $maxid=
   69: 		       ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
   70: 			 } else {
   71:                              $needsfixup=1;
   72:                          }
   73:                       } else {
   74:  			  if (defined($token->[2]->{'index'})) {
   75:                              $maxindex=
   76: 	   ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
   77: 			  } else {
   78:                              $needsfixup=1;
   79: 			  }
   80: 		      }
   81: 		  }
   82:               }
   83:           }
   84:       }
   85:       if ($needsfixup) {
   86:           print $logfile "Needs ID and/or index fixup\n".
   87: 	        "Max ID   : $maxid (min 10)\n".
   88:                 "Max Index: $maxindex (min 10)\n";
   89: 
   90:           my $outstring='';
   91:           my $parser=HTML::TokeParser->new(\$content);
   92:           my $token;
   93:           while ($token=$parser->get_token) {
   94:               if ($token->[0] eq 'S') {
   95:                   my $counter;
   96: 		  if ($counter=$addid{$token->[1]}) {
   97: 		      if ($counter eq 'id') {
   98: 			  if (defined($token->[2]->{'id'})) {
   99: 			      $outstring.=$token->[4];
  100: 			  } else {
  101:                               $maxid++;
  102:                               my $thisid=' id="'.$maxid.'"';
  103: 			      my $fixup=$token->[4];
  104:                               $fixup=~s/(\<\w+)/$1$thisid/;
  105:                               $outstring.=$fixup;
  106:                               print $logfile 'ID: '.$fixup."\n";
  107:                           }
  108:                       } else {
  109:  			  if (defined($token->[2]->{'index'})) {
  110: 			      $outstring.=$token->[4];
  111: 			  } else {
  112:                               $maxindex++;
  113:                               my $thisindex=' index="'.$maxindex.'"';
  114: 			      my $fixup=$token->[4];
  115:                               $fixup=~s/(\<\w+)/$1$thisindex/;
  116:                               $outstring.=$fixup;
  117:                               print $logfile 'Index: '.$fixup."\n";
  118: 			  }
  119: 		      }
  120: 		  } else {
  121:                       $outstring.=$token->[4];
  122:                   }
  123:               } elsif ($token->[0] eq 'E') {
  124:                   $outstring.=$token->[2];
  125:               } else {
  126:                   $outstring.=$token->[1];
  127:               }
  128:           }
  129:         {
  130:           my $org;
  131:           unless ($org=Apache::File->new('>'.$source)) {
  132:              print $logfile "No write permit to $source\n";
  133:              return "No write permission to $source, FAIL";
  134: 	  }
  135:           print $org $outstring;
  136:         }
  137: 	  $content=$outstring;
  138:           print $logfile "End of ID and/or index fixup\n".
  139: 	        "Max ID   : $maxid (min 10)\n".
  140:                 "Max Index: $maxindex (min 10)\n";
  141:       } else {
  142: 	  print $logfile "Does not need ID and/or index fixup\n";
  143:       }
  144: # -------------------------------------------------- Parse content for metadata
  145: 
  146: 	my $allmeta=Apache::lonxml::xmlparse('meta',$content);
  147:         
  148:         $scrout=$allmeta;
  149: 
  150:     }
  151:     return $scrout;
  152: }
  153: 
  154: # ================================================================ Main Handler
  155: 
  156: sub handler {
  157:   my $r=shift;
  158: 
  159:   if ($r->header_only) {
  160:      $r->content_type('text/html');
  161:      $r->send_http_header;
  162:      return OK;
  163:   }
  164: 
  165: # -------------------------------------------------------------- Check filename
  166: 
  167:   my $fn=$ENV{'form.filename'};
  168: 
  169:   unless ($fn) { 
  170:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  171:          ' trying to publish empty filename', $r->filename); 
  172:      return HTTP_NOT_FOUND;
  173:   } 
  174: 
  175:   unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
  176:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  177:          ' trying to publish file '.$ENV{'form.filename'}.
  178:          ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', 
  179:          $r->filename); 
  180:      return HTTP_NOT_ACCEPTABLE;
  181:   }
  182: 
  183:   $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
  184: 
  185:   my $targetdir='';
  186:   my $docroot=$r->dir_config('lonDocRoot'); 
  187:   if ($1 ne $ENV{'user.name'}) {
  188:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  189:          ' trying to publish unowned file '.$ENV{'form.filename'}.
  190:          ' ('.$fn.')', 
  191:          $r->filename); 
  192:      return HTTP_NOT_ACCEPTABLE;
  193:   } else {
  194:       $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
  195:   }
  196:                                  
  197:   
  198:   unless (-e $fn) { 
  199:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  200:          ' trying to publish non-existing file '.$ENV{'form.filename'}.
  201:          ' ('.$fn.')', 
  202:          $r->filename); 
  203:      return HTTP_NOT_FOUND;
  204:   } 
  205: 
  206: # --------------------------------- File is there and owned, init lookup tables
  207: 
  208:   %addid=();
  209: 
  210:   {
  211:       my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
  212:       while (<$fh>=~/(\w+)\s+(\w+)/) {
  213:           $addid{$1}=$2;
  214:       }
  215:   }
  216: # ----------------------------------------------------------- Start page output
  217: 
  218:   $r->content_type('text/html');
  219:   $r->send_http_header;
  220: 
  221:   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
  222:   $r->print('<body bgcolor="#FFFFFF">');
  223:   my $thisfn=$fn;
  224:    
  225: # ------------------------------------------------------------- Individual file
  226:   {
  227:       $thisfn=~/\.(\w+)$/;
  228:       my $thistype=$1;
  229:       my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
  230: 
  231:       my $thistarget=$thisfn;
  232:       
  233:       $thistarget=~s/^\/home/$targetdir/;
  234:       $thistarget=~s/\/public\_html//;
  235: 
  236:       my $thisdistarget=$thistarget;
  237:       $thisdistarget=~s/^$docroot//;
  238: 
  239:       my $thisdisfn=$thisfn;
  240:       $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
  241: 
  242:       $r->print('<h2>Publishing '.
  243:         &Apache::lonnet::filedescription($thistype).' <tt>'.
  244:         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
  245: 
  246: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
  247: 
  248:       $r->print('<b>Result:</b> '.&publish($thisfn,$thistarget,$thisembstyle));
  249:       
  250:   }  
  251: 
  252:   $r->print('</body></html>');
  253: 
  254:   return OK;
  255: }
  256: 
  257: 1;
  258: __END__
  259: 
  260: 
  261: 
  262: 
  263: 
  264: 
  265: