Annotation of loncom/publisher/lonpublisher.pm, revision 1.70

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Publication Handler
1.54      albertel    3: #
1.70    ! harris41    4: # $Id: lonpublisher.pm,v 1.69 2002/01/09 20:45:16 albertel Exp $
1.54      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       www        28: # 
                     29: # (TeX Content Handler
                     30: #
                     31: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
                     32: #
1.15      www        33: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
1.20      www        34: # 03/23 Guy Albertelli
1.23      www        35: # 03/24,03/29,04/03 Gerd Kortemeyer
1.24      harris41   36: # 04/16/2001 Scott Harrison
1.27      www        37: # 05/03,05/05,05/07 Gerd Kortemeyer
1.30      harris41   38: # 05/28/2001 Scott Harrison
1.51      www        39: # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer
1.58      www        40: # 12/04,12/05 Guy Albertelli
                     41: # 12/05 Gerd Kortemeyer
1.62      www        42: # 12/05 Guy Albertelli
1.64      www        43: # 12/06,12/07 Gerd Kortemeyer
1.66      harris41   44: # 12/15,12/16 Scott Harrison
1.67      www        45: # 12/25 Gerd Kortemeyer
1.65      harris41   46: #
                     47: ###
                     48: 
                     49: ###############################################################################
                     50: ##                                                                           ##
                     51: ## ORGANIZATION OF THIS PERL MODULE                                          ##
                     52: ##                                                                           ##
                     53: ## 1. Modules used by this module                                            ##
                     54: ## 2. Various subroutines                                                    ##
                     55: ## 3. Publication Step One                                                   ##
                     56: ## 4. Phase Two                                                              ##
                     57: ## 5. Main Handler                                                           ##
                     58: ##                                                                           ##
                     59: ###############################################################################
1.1       www        60: 
                     61: package Apache::lonpublisher;
                     62: 
1.65      harris41   63: # ------------------------------------------------- modules used by this module
1.1       www        64: use strict;
                     65: use Apache::File;
1.13      www        66: use File::Copy;
1.2       www        67: use Apache::Constants qw(:common :http :methods);
                     68: use HTML::TokeParser;
1.4       www        69: use Apache::lonxml;
1.17      albertel   70: use Apache::lonhomework;
1.27      www        71: use Apache::loncacc;
1.24      harris41   72: use DBI;
1.65      harris41   73: use Apache::lonnet();
                     74: use Apache::loncommon();
1.2       www        75: 
1.3       www        76: my %addid;
1.5       www        77: my %nokey;
1.10      www        78: 
1.7       www        79: my %metadatafields;
                     80: my %metadatakeys;
                     81: 
1.12      www        82: my $docroot;
                     83: 
1.27      www        84: my $cuname;
                     85: my $cudom;
                     86: 
1.12      www        87: # ----------------------------------------------- Evaluate string with metadata
1.7       www        88: sub metaeval {
                     89:     my $metastring=shift;
                     90:    
                     91:         my $parser=HTML::TokeParser->new(\$metastring);
                     92:         my $token;
                     93:         while ($token=$parser->get_token) {
                     94:            if ($token->[0] eq 'S') {
                     95: 	      my $entry=$token->[1];
                     96:               my $unikey=$entry;
1.32      www        97:               if (defined($token->[2]->{'package'})) { 
                     98:                   $unikey.='_package_'.$token->[2]->{'package'};
                     99:               } 
1.7       www       100:               if (defined($token->[2]->{'part'})) { 
                    101:                  $unikey.='_'.$token->[2]->{'part'}; 
                    102: 	      }
1.32      www       103:               if (defined($token->[2]->{'id'})) { 
1.49      www       104:                   $unikey.='_'.$token->[2]->{'id'};
1.32      www       105:               } 
1.7       www       106:               if (defined($token->[2]->{'name'})) { 
                    107:                  $unikey.='_'.$token->[2]->{'name'}; 
                    108: 	      }
1.65      harris41  109:               foreach (@{$token->[3]}) {
1.7       www       110: 		  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
                    111:                   if ($metadatakeys{$unikey}) {
                    112: 		      $metadatakeys{$unikey}.=','.$_;
                    113:                   } else {
                    114:                       $metadatakeys{$unikey}=$_;
                    115:                   }
1.65      harris41  116:               }
1.7       www       117:               if ($metadatafields{$unikey}) {
1.8       www       118: 		  my $newentry=$parser->get_text('/'.$entry);
1.41      www       119:                   unless (($metadatafields{$unikey}=~/$newentry/) ||
                    120:                           ($newentry eq '')) {
1.8       www       121:                      $metadatafields{$unikey}.=', '.$newentry;
                    122: 		  }
1.7       www       123: 	      } else {
                    124:                  $metadatafields{$unikey}=$parser->get_text('/'.$entry);
                    125:               }
                    126:           }
                    127:        }
                    128: }
                    129: 
1.12      www       130: # -------------------------------------------------------- Read a metadata file
1.7       www       131: sub metaread {
                    132:     my ($logfile,$fn)=@_;
                    133:     unless (-e $fn) {
                    134: 	print $logfile 'No file '.$fn."\n";
                    135:         return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
                    136:     }
                    137:     print $logfile 'Processing '.$fn."\n";
                    138:     my $metastring;
                    139:     {
                    140:      my $metafh=Apache::File->new($fn);
                    141:      $metastring=join('',<$metafh>);
                    142:     }
                    143:     &metaeval($metastring);
                    144:     return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
                    145: }
                    146: 
1.25      harris41  147: # ---------------------------- convert 'time' format into a datetime sql format
                    148: sub sqltime {
1.70    ! harris41  149:     my $timef=shift @_;
1.25      harris41  150:     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
1.70    ! harris41  151: 	localtime($timef);
1.25      harris41  152:     $mon++; $year+=1900;
                    153:     return "$year-$mon-$mday $hour:$min:$sec";
                    154: }
                    155: 
1.12      www       156: # --------------------------------------------------------- Various form fields
                    157: 
1.8       www       158: sub textfield {
1.10      www       159:     my ($title,$name,$value)=@_;
1.8       www       160:     return "\n<p><b>$title:</b><br>".
1.11      www       161:            '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
                    162: }
                    163: 
                    164: sub hiddenfield {
                    165:     my ($name,$value)=@_;
                    166:     return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
1.8       www       167: }
                    168: 
1.9       www       169: sub selectbox {
1.65      harris41  170:     my ($title,$name,$value,$functionref,@idlist)=@_;
                    171:     my $uctitle=uc($title);
                    172:     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
                    173: 	"</b></font><br />".'<select name="'.$name.'">';
                    174:     foreach (@idlist) {
                    175:         $selout.='<option value=\''.$_.'\'';
                    176:         if ($_ eq $value) {
                    177: 	    $selout.=' selected>'.&{$functionref}($_).'</option>';
                    178: 	}
                    179:         else {$selout.='>'.&{$functionref}($_).'</option>';}
                    180:     }
1.10      www       181:     return $selout.'</select>';
1.9       www       182: }
                    183: 
1.12      www       184: # -------------------------------------------------------- Publication Step One
                    185: 
1.34      www       186: sub urlfixup {
1.35      www       187:     my ($url,$target)=@_;
1.39      www       188:     unless ($url) { return ''; }
1.68      albertel  189:     #javascript code needs no fixing
                    190:     if ($url =~ /^javascript:/i) { return $url; }
1.69      albertel  191:     if ($url =~ /^mailto:/i) { return $url; }
1.68      albertel  192:     #internal document links need no fixing
                    193:     if ($url =~ /^\#/) { return $url; } 
1.35      www       194:     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
1.65      harris41  195:     foreach (values %Apache::lonnet::hostname) {
1.35      www       196: 	if ($_ eq $host) {
                    197: 	    $url=~s/^http\:\/\///;
                    198:             $url=~s/^$host//;
                    199:         }
1.65      harris41  200:     }
1.40      www       201:     if ($url=~/^http\:\/\//) { return $url; }
1.35      www       202:     $url=~s/\~$cuname/res\/$cudom\/$cuname/;
                    203:     if ($target) {
                    204: 	$target=~s/\/[^\/]+$//;
                    205:        $url=&Apache::lonnet::hreflocation($target,$url);
                    206:     }
                    207:     return $url;
1.34      www       208: }
                    209: 
1.2       www       210: sub publish {
1.50      www       211: 
1.2       www       212:     my ($source,$target,$style)=@_;
                    213:     my $logfile;
1.4       www       214:     my $scrout='';
1.23      www       215:     my $allmeta='';
                    216:     my $content='';
1.36      www       217:     my %allow=();
                    218:     undef %allow;
1.4       www       219: 
1.2       www       220:     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
1.7       www       221: 	return 
                    222:          '<font color=red>No write permission to user directory, FAIL</font>';
1.2       www       223:     }
                    224:     print $logfile 
1.11      www       225: "\n\n================= Publish ".localtime()." Phase One  ================\n";
1.2       www       226: 
1.3       www       227:     if (($style eq 'ssi') || ($style eq 'rat')) {
                    228: # ------------------------------------------------------- This needs processing
1.4       www       229: 
                    230: # ----------------------------------------------------------------- Backup Copy
1.3       www       231: 	my $copyfile=$source.'.save';
1.13      www       232:         if (copy($source,$copyfile)) {
1.3       www       233: 	    print $logfile "Copied original file to ".$copyfile."\n";
                    234:         } else {
1.13      www       235: 	    print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
                    236:           return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
1.3       www       237:         }
1.4       www       238: # ------------------------------------------------------------- IDs and indices
                    239: 
                    240:         my $maxindex=10;
                    241:         my $maxid=10;
1.23      www       242: 
1.4       www       243:         my $needsfixup=0;
                    244: 
                    245:         {
                    246:           my $org=Apache::File->new($source);
                    247:           $content=join('',<$org>);
                    248:         }
                    249:         {
                    250:           my $parser=HTML::TokeParser->new(\$content);
                    251:           my $token;
                    252:           while ($token=$parser->get_token) {
                    253:               if ($token->[0] eq 'S') {
                    254:                   my $counter;
                    255: 		  if ($counter=$addid{$token->[1]}) {
                    256: 		      if ($counter eq 'id') {
                    257: 			  if (defined($token->[2]->{'id'})) {
                    258:                              $maxid=
                    259: 		       ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
                    260: 			 } else {
                    261:                              $needsfixup=1;
                    262:                          }
                    263:                       } else {
                    264:  			  if (defined($token->[2]->{'index'})) {
                    265:                              $maxindex=
                    266: 	   ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
                    267: 			  } else {
                    268:                              $needsfixup=1;
                    269: 			  }
                    270: 		      }
                    271: 		  }
                    272:               }
                    273:           }
                    274:       }
                    275:       if ($needsfixup) {
                    276:           print $logfile "Needs ID and/or index fixup\n".
                    277: 	        "Max ID   : $maxid (min 10)\n".
                    278:                 "Max Index: $maxindex (min 10)\n";
1.34      www       279:       }
1.4       www       280:           my $outstring='';
                    281:           my $parser=HTML::TokeParser->new(\$content);
1.53      albertel  282:           $parser->xml_mode(1);
1.4       www       283:           my $token;
                    284:           while ($token=$parser->get_token) {
                    285:               if ($token->[0] eq 'S') {
1.34      www       286:                 my $counter;
                    287:                 my $tag=$token->[1];
1.56      albertel  288:                 my $lctag=lc($tag);
1.53      albertel  289:                 unless ($lctag eq 'allow') {  
1.34      www       290:                   my %parms=%{$token->[2]};
1.53      albertel  291:                   $counter=$addid{$tag};
                    292:                   if (!$counter) { $counter=$addid{$lctag}; }
                    293:                   if ($counter) {
1.4       www       294: 		      if ($counter eq 'id') {
1.34      www       295: 			  unless (defined($parms{'id'})) {
1.4       www       296:                               $maxid++;
1.34      www       297:                               $parms{'id'}=$maxid;
                    298:                               print $logfile 'ID: '.$tag.':'.$maxid."\n";
1.4       www       299:                           }
1.34      www       300:                       } elsif ($counter eq 'index') {
                    301:  			  unless (defined($parms{'index'})) {
1.4       www       302:                               $maxindex++;
1.34      www       303:                               $parms{'index'}=$maxindex;
                    304:                               print $logfile 'Index: '.$tag.':'.$maxindex."\n";
1.4       www       305: 			  }
                    306: 		      }
1.34      www       307: 		  } 
                    308:                   
1.65      harris41  309:                   foreach ('src','href','background') {
1.34      www       310:                       if (defined($parms{$_})) {
                    311: 			  my $oldurl=$parms{$_};
1.35      www       312:                           my $newurl=&urlfixup($oldurl,$target);
1.34      www       313:                           if ($newurl ne $oldurl) {
                    314: 			      $parms{$_}=$newurl;
                    315:                               print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
                    316: 				  $newurl."\n";
                    317: 			  }
1.36      www       318:                           $allow{$newurl}=1;
1.34      www       319:                       }
1.65      harris41  320:                   }
1.38      www       321: 
1.53      albertel  322:                   if ($lctag eq 'applet') {
1.38      www       323: 		      my $codebase='';
                    324:                       if (defined($parms{'codebase'})) {
                    325: 		         my $oldcodebase=$parms{'codebase'};
                    326:                          unless ($oldcodebase=~/\/$/) {
                    327:                             $oldcodebase.='/';
                    328:                          }
                    329:                          $codebase=&urlfixup($oldcodebase,$target);
                    330:                          $codebase=~s/\/$//;    
                    331:                          if ($codebase ne $oldcodebase) {
                    332: 			     $parms{'codebase'}=$codebase;
                    333:                              print $logfile 'URL codebase: '.$tag.':'.
                    334:                                   $oldcodebase.' - '.
                    335: 				  $codebase."\n";
                    336: 			 }
                    337:                          $allow{$codebase.'/*'}=1;
                    338: 		      } else {
1.65      harris41  339:                         foreach ('archive','code','object') {
1.38      www       340:                           if (defined($parms{$_})) {
                    341: 			      my $oldurl=$parms{$_};
                    342:                               my $newurl=&urlfixup($oldurl,$target);
                    343: 			      $newurl=~s/\/[^\/]+$/\/\*/;
                    344:                                   print $logfile 'Allow: applet '.$_.':'.
                    345:                                   $oldurl.' allows '.
                    346: 				  $newurl."\n";
                    347:                               $allow{$newurl}=1;
                    348:                           }
1.65      harris41  349:                         }
1.38      www       350:                       }
                    351:                   }
1.34      www       352: 
                    353:                   my $newparmstring='';
                    354:                   my $endtag='';
1.65      harris41  355:                   foreach (keys %parms) {
1.34      www       356:                     if ($_ eq '/') {
                    357:                       $endtag=' /';
                    358:                     } else { 
                    359:                       my $quote=($parms{$_}=~/\"/?"'":'"');
                    360:                       $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
                    361: 		    }
1.65      harris41  362:                   }
1.57      albertel  363: 		  if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
1.34      www       364: 		  $outstring.='<'.$tag.$newparmstring.$endtag.'>';
1.36      www       365: 	         } else {
                    366: 		   $allow{$token->[2]->{'src'}}=1;
                    367: 		 }
1.4       www       368:               } elsif ($token->[0] eq 'E') {
1.57      albertel  369: 		if ($token->[2]) {
1.34      www       370:                   unless ($token->[1] eq 'allow') {
1.41      www       371:                      $outstring.='</'.$token->[1].'>';
1.34      www       372: 		  }
1.57      albertel  373: 		}
1.4       www       374:               } else {
                    375:                   $outstring.=$token->[1];
                    376:               }
                    377:           }
1.36      www       378: # ------------------------------------------------------------ Construct Allows
1.62      www       379:     
1.44      www       380: 	$scrout.='<h3>Dependencies</h3>';
1.62      www       381:         my $allowstr='';
1.65      harris41  382:         foreach (keys %allow) {
1.59      www       383: 	   my $thisdep=$_;
1.62      www       384:            unless ($style eq 'rat') { 
                    385:               $allowstr.="\n".'<allow src="'.$thisdep.'" />';
                    386: 	   }
1.44      www       387:            $scrout.='<br>';
1.59      www       388:            unless ($thisdep=~/\*/) {
                    389: 	       $scrout.='<a href="'.$thisdep.'">';
1.44      www       390:            }
1.59      www       391:            $scrout.='<tt>'.$thisdep.'</tt>';
                    392:            unless ($thisdep=~/\*/) {
1.44      www       393: 	       $scrout.='</a>';
1.59      www       394:                if (
                    395:        &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                    396:                                             $thisdep.'.meta') eq '-1') {
1.58      www       397: 		   $scrout.=
                    398:                            ' - <font color=red>Currently not available</font>';
1.59      www       399:                } else {
                    400:                    my %temphash=(&Apache::lonnet::declutter($target).'___'.
                    401:                              &Apache::lonnet::declutter($thisdep).'___usage'
                    402:                                  => time);
                    403:                    $thisdep=~/^\/res\/(\w+)\/(\w+)\//;
                    404:                    if ((defined($1)) && (defined($2))) {
                    405:                       &Apache::lonnet::put('resevaldata',\%temphash,$1,$2);
                    406: 		   }
                    407: 	       }
1.44      www       408:            }
1.65      harris41  409:         }
1.36      www       410:         $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
1.62      www       411: 
1.37      www       412: # ------------------------------------------------------------- Write modified
                    413: 
1.4       www       414:         {
                    415:           my $org;
                    416:           unless ($org=Apache::File->new('>'.$source)) {
                    417:              print $logfile "No write permit to $source\n";
1.7       www       418:              return 
                    419:               "<font color=red>No write permission to $source, FAIL</font>";
1.4       www       420: 	  }
                    421:           print $org $outstring;
                    422:         }
                    423: 	  $content=$outstring;
1.34      www       424: 
                    425:       if ($needsfixup) {
1.4       www       426:           print $logfile "End of ID and/or index fixup\n".
                    427: 	        "Max ID   : $maxid (min 10)\n".
                    428:                 "Max Index: $maxindex (min 10)\n";
                    429:       } else {
                    430: 	  print $logfile "Does not need ID and/or index fixup\n";
                    431:       }
1.37      www       432:     }
1.7       www       433: # --------------------------------------------- Initial step done, now metadata
                    434: 
                    435: # ---------------------------------------- Storage for metadata keys and fields
                    436: 
1.8       www       437:      %metadatafields=();
                    438:      %metadatakeys=();
                    439:      
                    440:      my %oldparmstores=();
1.44      www       441:      
                    442:      $scrout.='<h3>Metadata Information</h3>';
1.7       www       443: 
                    444: # ------------------------------------------------ First, check out environment
1.8       www       445:      unless (-e $source.'.meta') {
1.7       www       446:         $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
                    447: 	                          $ENV{'environment.middlename'}.' '.
                    448: 		                  $ENV{'environment.lastname'}.' '.
                    449: 		                  $ENV{'environment.generation'};
1.8       www       450:         $metadatafields{'author'}=~s/\s+/ /g;
                    451:         $metadatafields{'author'}=~s/\s+$//;
1.27      www       452:         $metadatafields{'owner'}=$cuname.'@'.$cudom;
1.7       www       453: 
                    454: # ------------------------------------------------ Check out directory hierachy
                    455: 
                    456:         my $thisdisfn=$source;
1.27      www       457:         $thisdisfn=~s/^\/home\/$cuname\///;
1.7       www       458: 
                    459:         my @urlparts=split(/\//,$thisdisfn);
                    460:         $#urlparts--;
                    461: 
1.27      www       462:         my $currentpath='/home/'.$cuname.'/';
1.7       www       463: 
1.65      harris41  464:         foreach (@urlparts) {
1.7       www       465: 	    $currentpath.=$_.'/';
                    466:             $scrout.=&metaread($logfile,$currentpath.'default.meta');
1.65      harris41  467:         }
1.7       www       468: 
                    469: # ------------------- Clear out parameters and stores (there should not be any)
                    470: 
1.65      harris41  471:         foreach (keys %metadatafields) {
1.7       www       472: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
                    473: 		delete $metadatafields{$_};
                    474:             }
1.65      harris41  475:         }
1.7       www       476: 
1.8       www       477:     } else {
1.7       www       478: # ---------------------- Read previous metafile, remember parameters and stores
                    479: 
                    480:         $scrout.=&metaread($logfile,$source.'.meta');
                    481: 
1.65      harris41  482:         foreach (keys %metadatafields) {
1.7       www       483: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
                    484:                 $oldparmstores{$_}=1;
                    485: 		delete $metadatafields{$_};
                    486:             }
1.65      harris41  487:         }
1.7       www       488:         
1.8       www       489:     }
1.7       www       490: 
1.4       www       491: # -------------------------------------------------- Parse content for metadata
1.37      www       492:     if ($style eq 'ssi') {
1.42      www       493:         my $oldenv=$ENV{'request.uri'};
                    494: 
                    495:         $ENV{'request.uri'}=$target;
1.23      www       496:         $allmeta=Apache::lonxml::xmlparse('meta',$content);
1.42      www       497:         $ENV{'request.uri'}=$oldenv;
1.32      www       498: 
1.19      albertel  499:         &metaeval($allmeta);
1.37      www       500:     }
1.7       www       501: # ---------------- Find and document discrepancies in the parameters and stores
                    502: 
                    503:         my $chparms='';
1.65      harris41  504:         foreach (sort keys %metadatafields) {
1.7       www       505: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
                    506:                 unless ($_=~/\.\w+$/) { 
                    507:                    unless ($oldparmstores{$_}) {
                    508: 		      print $logfile 'New: '.$_."\n";
                    509:                       $chparms.=$_.' ';
                    510:                    }
                    511: 	        }
                    512:             }
1.65      harris41  513:         }
1.7       www       514:         if ($chparms) {
                    515: 	    $scrout.='<p><b>New parameters or stored values:</b> '.
                    516:                      $chparms;
                    517:         }
                    518: 
1.70    ! harris41  519:         $chparms='';
1.65      harris41  520:         foreach (sort keys %oldparmstores) {
1.7       www       521: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
1.33      www       522:                 unless (($metadatafields{$_.'.name'}) ||
                    523:                         ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
1.7       www       524: 		    print $logfile 'Obsolete: '.$_."\n";
                    525:                     $chparms.=$_.' ';
                    526:                 }
                    527:             }
1.65      harris41  528:         }
1.7       www       529:         if ($chparms) {
                    530: 	    $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
                    531:                      $chparms;
                    532:         }
1.37      www       533: 
1.8       www       534: # ------------------------------------------------------- Now have all metadata
1.5       www       535: 
1.8       www       536:         $scrout.=
                    537:      '<form action="/adm/publish" method="post">'.
1.63      albertel  538:        '<p><input type="submit" value="Finalize Publication" /></p>'.
1.11      www       539:           &hiddenfield('phase','two').
                    540:           &hiddenfield('filename',$ENV{'form.filename'}).
                    541: 	  &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
1.58      www       542:           &hiddenfield('dependencies',join(',',keys %allow)).
1.10      www       543:           &textfield('Title','title',$metadatafields{'title'}).
                    544:           &textfield('Author(s)','author',$metadatafields{'author'}).
                    545: 	  &textfield('Subject','subject',$metadatafields{'subject'});
1.5       www       546: 
                    547: # --------------------------------------------------- Scan content for keywords
1.7       www       548: 
1.8       www       549: 	my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
1.7       www       550:         my $colcount=0;
1.67      www       551:         my %keywords=();
1.7       www       552:         
1.52      albertel  553: 	if (length($content)<500000) {
1.5       www       554: 	    my $textonly=$content;
                    555:             $textonly=~s/\<script[^\<]+\<\/script\>//g;
                    556:             $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
                    557:             $textonly=~s/\<[^\>]*\>//g;
                    558:             $textonly=~tr/A-Z/a-z/;
                    559:             $textonly=~s/[\$\&][a-z]\w*//g;
                    560:             $textonly=~s/[^a-z\s]//g;
                    561: 
1.65      harris41  562:             foreach ($textonly=~m/(\w+)/g) {
1.50      www       563: 		unless ($nokey{$_}) {
                    564:                    $keywords{$_}=1;
                    565:                 } 
1.65      harris41  566:             }
1.67      www       567:         }
1.5       www       568: 
1.67      www       569:             
1.65      harris41  570:             foreach (split(/\W+/,$metadatafields{'keywords'})) {
1.12      www       571: 		$keywords{$_}=1;
1.65      harris41  572:             }
1.5       www       573: 
1.65      harris41  574:             foreach (sort keys %keywords) {
1.12      www       575:                 $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
1.67      www       576:                 if ($metadatafields{'keywords'}) {
                    577:                    if ($metadatafields{'keywords'}=~/$_/) { 
                    578:                       $keywordout.=' checked'; 
                    579:                    }
                    580: 	        } elsif (&Apache::loncommon::keyword($_)) {
                    581: 		    $keywordout.=' checked';
                    582:                 } 
1.8       www       583:                 $keywordout.='>'.$_.'</td>';
1.7       www       584:                 if ($colcount>10) {
                    585: 		    $keywordout.="</tr><tr>\n";
                    586:                     $colcount=0;
                    587:                 }
1.50      www       588:                 $colcount++;
1.65      harris41  589:             }
1.50      www       590:         
1.51      www       591: 	$keywordout.='</tr></table>';
                    592: 
                    593:         $scrout.=$keywordout;
1.9       www       594: 
1.12      www       595:         $scrout.=&textfield('Additional Keywords','addkey','');
                    596: 
1.10      www       597:         $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
1.9       www       598: 
                    599:         $scrout.=
                    600:              '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
                    601:               $metadatafields{'abstract'}.'</textarea>';
                    602: 
1.11      www       603: 	$source=~/\.(\w+)$/;
                    604: 
                    605: 	$scrout.=&hiddenfield('mime',$1);
                    606: 
1.10      www       607:         $scrout.=&selectbox('Language','language',
1.65      harris41  608:                             $metadatafields{'language'},
1.70    ! harris41  609: 			    \&Apache::loncommon::languagedescription,
1.65      harris41  610: 			    (&Apache::loncommon::languageids),
                    611: 			     );
1.11      www       612: 
                    613:         unless ($metadatafields{'creationdate'}) {
                    614: 	    $metadatafields{'creationdate'}=time;
                    615:         }
                    616:         $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'});
                    617: 
                    618:         $scrout.=&hiddenfield('lastrevisiondate',time);
                    619: 
1.9       www       620: 			   
1.10      www       621: 	$scrout.=&textfield('Publisher/Owner','owner',
                    622:                             $metadatafields{'owner'});
1.45      www       623: # --------------------------------------------------- Correct copyright for rat        
                    624:     if ($style eq 'rat') {
1.65      harris41  625: 	if ($metadatafields{'copyright'} eq 'public') { 
                    626: 	    delete $metadatafields{'copyright'};
                    627: 	}
                    628:         $scrout.=&selectbox('Copyright/Distribution','copyright',
                    629:                             $metadatafields{'copyright'},
1.70    ! harris41  630: 			    \&Apache::loncommon::copyrightdescription,
1.65      harris41  631: 		     (grep !/^public$/,(&Apache::loncommon::copyrightids)));
                    632:     }
                    633:     else {
1.10      www       634:         $scrout.=&selectbox('Copyright/Distribution','copyright',
1.65      harris41  635:                             $metadatafields{'copyright'},
1.70    ! harris41  636: 			    \&Apache::loncommon::copyrightdescription,
1.65      harris41  637: 			     (&Apache::loncommon::copyrightids));
                    638:     }
1.8       www       639:     return $scrout.
1.63      albertel  640:       '<p><input type="submit" value="Finalize Publication" /></p></form>';
1.2       www       641: }
1.1       www       642: 
1.12      www       643: # -------------------------------------------------------- Publication Step Two
                    644: 
1.11      www       645: sub phasetwo {
                    646: 
1.24      harris41  647:     my ($source,$target,$style,$distarget)=@_;
1.11      www       648:     my $logfile;
                    649:     my $scrout='';
                    650: 
                    651:     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
                    652: 	return 
                    653:          '<font color=red>No write permission to user directory, FAIL</font>';
                    654:     }
                    655:     print $logfile 
                    656: "\n================= Publish ".localtime()." Phase Two  ================\n";
                    657: 
                    658:      %metadatafields=();
                    659:      %metadatakeys=();
                    660: 
                    661:      &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
                    662: 
                    663:      $metadatafields{'title'}=$ENV{'form.title'};
                    664:      $metadatafields{'author'}=$ENV{'form.author'};
                    665:      $metadatafields{'subject'}=$ENV{'form.subject'};
                    666:      $metadatafields{'notes'}=$ENV{'form.notes'};
                    667:      $metadatafields{'abstract'}=$ENV{'form.abstract'};
                    668:      $metadatafields{'mime'}=$ENV{'form.mime'};
                    669:      $metadatafields{'language'}=$ENV{'form.language'};
                    670:      $metadatafields{'creationdate'}=$ENV{'form.creationdate'};
                    671:      $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
                    672:      $metadatafields{'owner'}=$ENV{'form.owner'};
                    673:      $metadatafields{'copyright'}=$ENV{'form.copyright'};
1.60      www       674:      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
1.12      www       675: 
                    676:      my $allkeywords=$ENV{'form.addkey'};
1.65      harris41  677:      foreach (keys %ENV) {
1.12      www       678:          if ($_=~/^form\.key\.(\w+)/) {
                    679: 	     $allkeywords.=','.$1;
                    680:          }
1.65      harris41  681:      }
1.12      www       682:      $allkeywords=~s/\W+/\,/;
                    683:      $allkeywords=~s/^\,//;
                    684:      $metadatafields{'keywords'}=$allkeywords;
                    685:  
                    686:      {
                    687:        print $logfile "\nWrite metadata file for ".$source;
                    688:        my $mfh;
                    689:        unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
                    690: 	return 
                    691:          '<font color=red>Could not write metadata, FAIL</font>';
1.65      harris41  692:        }
                    693:        foreach (sort keys %metadatafields) {
1.12      www       694: 	 unless ($_=~/\./) {
                    695:            my $unikey=$_;
                    696:            $unikey=~/^([A-Za-z]+)/;
                    697:            my $tag=$1;
                    698:            $tag=~tr/A-Z/a-z/;
                    699:            print $mfh "\n\<$tag";
1.65      harris41  700:            foreach (split(/\,/,$metadatakeys{$unikey})) {
1.12      www       701:                my $value=$metadatafields{$unikey.'.'.$_};
                    702:                $value=~s/\"/\'\'/g;
                    703:                print $mfh ' '.$_.'="'.$value.'"';
1.65      harris41  704:            }
1.12      www       705: 	   print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';
                    706:          }
1.65      harris41  707:        }
1.12      www       708:        $scrout.='<p>Wrote Metadata';
                    709:        print $logfile "\nWrote metadata";
                    710:      }
                    711: 
1.24      harris41  712: # -------------------------------- Synchronize entry with SQL metadata database
1.64      www       713:   my $warning;
                    714: 
                    715:   unless ($metadatafields{'copyright'} eq 'priv') {
1.25      harris41  716: 
1.24      harris41  717:     my $dbh;
                    718:     {
                    719: 	unless (
1.64      www       720: 		$dbh = DBI->connect("DBI:mysql:loncapa","www",
                    721:     $Apache::lonnet::perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
1.24      harris41  722: 		) { 
1.29      harris41  723: 	    $warning='<font color=red>WARNING: Cannot connect to '.
                    724: 		'database!</font>';
                    725: 	}
                    726: 	else {
                    727: 	    my %sqldatafields;
                    728: 	    $sqldatafields{'url'}=$distarget;
                    729: 	    my $sth=$dbh->prepare(
                    730: 				  'delete from metadata where url like binary'.
                    731: 				  '"'.$sqldatafields{'url'}.'"');
                    732: 	    $sth->execute();
1.65      harris41  733: 	    foreach ('title','author','subject','keywords','notes','abstract',
1.29      harris41  734: 	     'mime','language','creationdate','lastrevisiondate','owner',
1.65      harris41  735: 	     'copyright') {
                    736: 		my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; 
                    737: 		$sqldatafields{$_}=$field;
                    738: 	    }
1.29      harris41  739: 	    
                    740: 	    $sth=$dbh->prepare('insert into metadata values ('.
                    741: 			       '"'.delete($sqldatafields{'title'}).'"'.','.
                    742: 			       '"'.delete($sqldatafields{'author'}).'"'.','.
                    743: 			       '"'.delete($sqldatafields{'subject'}).'"'.','.
                    744: 			       '"'.delete($sqldatafields{'url'}).'"'.','.
                    745: 			       '"'.delete($sqldatafields{'keywords'}).'"'.','.
                    746: 			       '"'.'current'.'"'.','.
                    747: 			       '"'.delete($sqldatafields{'notes'}).'"'.','.
                    748: 			       '"'.delete($sqldatafields{'abstract'}).'"'.','.
                    749: 			       '"'.delete($sqldatafields{'mime'}).'"'.','.
                    750: 			       '"'.delete($sqldatafields{'language'}).'"'.','.
                    751: 			       '"'.
                    752: 			       sqltime(delete($sqldatafields{'creationdate'}))
                    753: 			       .'"'.','.
                    754: 			       '"'.
                    755: 			       sqltime(delete(
                    756: 			       $sqldatafields{'lastrevisiondate'})).'"'.','.
                    757: 			       '"'.delete($sqldatafields{'owner'}).'"'.','.
                    758: 			       '"'.delete(
                    759: 			       $sqldatafields{'copyright'}).'"'.')');
                    760: 	    $sth->execute();
                    761: 	    $dbh->disconnect;
                    762: 	    $scrout.='<p>Synchronized SQL metadata database';
                    763: 	    print $logfile "\nSynchronized SQL metadata database";
1.24      harris41  764: 	}
                    765:     }
                    766: 
1.64      www       767: } else {
                    768:     $scrout.='<p>Private Publication - did not synchronize database';
1.66      harris41  769:     print $logfile "\nPrivate: Did not synchronize data into ".
                    770: 	"SQL metadata database";
1.64      www       771: }
1.12      www       772: # ----------------------------------------------------------- Copy old versions
                    773:    
                    774: if (-e $target) {
                    775:     my $filename;
                    776:     my $maxversion=0;
                    777:     $target=~/(.*)\/([^\/]+)\.(\w+)$/;
                    778:     my $srcf=$2;
                    779:     my $srct=$3;
                    780:     my $srcd=$1;
                    781:     unless ($srcd=~/^\/home\/httpd\/html\/res/) {
                    782: 	print $logfile "\nPANIC: Target dir is ".$srcd;
                    783:         return "<font color=red>Invalid target directory, FAIL</font>";
                    784:     }
                    785:     opendir(DIR,$srcd);
                    786:     while ($filename=readdir(DIR)) {
                    787:        if ($filename=~/$srcf\.(\d+)\.$srct$/) {
                    788: 	   $maxversion=($1>$maxversion)?$1:$maxversion;
                    789:        }
                    790:     }
                    791:     closedir(DIR);
                    792:     $maxversion++;
                    793:     $scrout.='<p>Creating old version '.$maxversion;
                    794:     print $logfile "\nCreating old version ".$maxversion;
                    795: 
                    796:     my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
                    797: 
1.13      www       798:         if (copy($target,$copyfile)) {
1.12      www       799: 	    print $logfile "Copied old target to ".$copyfile."\n";
                    800:             $scrout.='<p>Copied old target file';
                    801:         } else {
1.13      www       802: 	    print $logfile "Unable to write ".$copyfile.':'.$!."\n";
                    803:            return "<font color=red>Failed to copy old target, $!, FAIL</font>";
1.12      www       804:         }
                    805: 
                    806: # --------------------------------------------------------------- Copy Metadata
                    807: 
                    808: 	$copyfile=$copyfile.'.meta';
1.13      www       809: 
                    810:         if (copy($target.'.meta',$copyfile)) {
1.14      www       811: 	    print $logfile "Copied old target metadata to ".$copyfile."\n";
1.12      www       812:             $scrout.='<p>Copied old metadata';
                    813:         } else {
1.13      www       814: 	    print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.14      www       815:             if (-e $target.'.meta') {
                    816:                return 
1.13      www       817:        "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
1.14      www       818: 	    }
1.12      www       819:         }
1.11      www       820: 
                    821: 
1.12      www       822: } else {
                    823:     $scrout.='<p>Initial version';
                    824:     print $logfile "\nInitial version";
                    825: }
                    826: 
                    827: # ---------------------------------------------------------------- Write Source
                    828: 	my $copyfile=$target;
                    829: 
                    830:            my @parts=split(/\//,$copyfile);
                    831:            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
                    832: 
                    833:            my $count;
                    834:            for ($count=5;$count<$#parts;$count++) {
                    835:                $path.="/$parts[$count]";
                    836:                if ((-e $path)!=1) {
                    837:                    print $logfile "\nCreating directory ".$path;
                    838:                    $scrout.='<p>Created directory '.$parts[$count];
                    839: 		   mkdir($path,0777);
                    840:                }
                    841:            }
                    842: 
1.13      www       843:         if (copy($source,$copyfile)) {
1.12      www       844: 	    print $logfile "Copied original source to ".$copyfile."\n";
                    845:             $scrout.='<p>Copied source file';
                    846:         } else {
1.13      www       847: 	    print $logfile "Unable to write ".$copyfile.':'.$!."\n";
                    848:             return "<font color=red>Failed to copy source, $!, FAIL</font>";
1.12      www       849:         }
                    850: 
                    851: # --------------------------------------------------------------- Copy Metadata
                    852: 
1.13      www       853:         $copyfile=$copyfile.'.meta';
                    854: 
                    855:         if (copy($source.'.meta',$copyfile)) {
1.12      www       856: 	    print $logfile "Copied original metadata to ".$copyfile."\n";
                    857:             $scrout.='<p>Copied metadata';
                    858:         } else {
1.13      www       859: 	    print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.12      www       860:             return 
1.13      www       861:           "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
1.12      www       862:         }
                    863: 
                    864: # --------------------------------------------------- Send update notifications
                    865: 
                    866: {
                    867: 
                    868:     my $filename;
                    869:  
                    870:     $target=~/(.*)\/([^\/]+)$/;
                    871:     my $srcf=$2;
                    872:     opendir(DIR,$1);
                    873:     while ($filename=readdir(DIR)) {
                    874:        if ($filename=~/$srcf\.(\w+)$/) {
                    875: 	   my $subhost=$1;
                    876:            if ($subhost ne 'meta') {
                    877: 	       $scrout.='<p>Notifying host '.$subhost.':';
                    878:                print $logfile "\nNotifying host '.$subhost.':'";
                    879:                my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
1.20      www       880:                $scrout.=$reply;
                    881:                print $logfile $reply;              
                    882:            }
                    883:        }
                    884:     }
                    885:     closedir(DIR);
                    886: 
                    887: }
                    888: 
                    889: # ---------------------------------------- Send update notifications, meta only
                    890: 
                    891: {
                    892: 
                    893:     my $filename;
                    894:  
                    895:     $target=~/(.*)\/([^\/]+)$/;
                    896:     my $srcf=$2.'.meta';
                    897:     opendir(DIR,$1);
                    898:     while ($filename=readdir(DIR)) {
                    899:        if ($filename=~/$srcf\.(\w+)$/) {
                    900: 	   my $subhost=$1;
                    901:            if ($subhost ne 'meta') {
                    902: 	       $scrout.=
                    903:                 '<p>Notifying host for metadata only '.$subhost.':';
                    904:                print $logfile 
                    905:                 "\nNotifying host for metadata only '.$subhost.':'";
                    906:                my $reply=&Apache::lonnet::critical(
                    907:                                 'update:'.$target.'.meta',$subhost);
1.12      www       908:                $scrout.=$reply;
                    909:                print $logfile $reply;              
                    910:            }
                    911:        }
                    912:     }
                    913:     closedir(DIR);
                    914: 
                    915: }
                    916: 
                    917: # ------------------------------------------------ Provide link to new resource
                    918: 
                    919:     my $thisdistarget=$target;
                    920:     $thisdistarget=~s/^$docroot//;
                    921: 
1.22      www       922:     my $thissrc=$source;
                    923:     $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
                    924: 
                    925:     my $thissrcdir=$thissrc;
                    926:     $thissrcdir=~s/\/[^\/]+$/\//;
                    927: 
                    928: 
1.29      harris41  929:     return $warning.$scrout.
1.22      www       930:       '<hr><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'.
                    931:       '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
                    932:       '<p><a href="'.$thissrcdir.
                    933:       '"><font size=+2>Back to Source Directory</font></a>';
                    934: 
1.11      www       935: }
                    936: 
1.1       www       937: # ================================================================ Main Handler
                    938: 
                    939: sub handler {
                    940:   my $r=shift;
1.2       www       941: 
                    942:   if ($r->header_only) {
                    943:      $r->content_type('text/html');
                    944:      $r->send_http_header;
                    945:      return OK;
                    946:   }
                    947: 
1.43      www       948: # Get query string for limited number of parameters
                    949: 
1.65      harris41  950:     foreach (split(/&/,$ENV{'QUERY_STRING'})) {
1.43      www       951:        my ($name, $value) = split(/=/,$_);
                    952:        $value =~ tr/+/ /;
                    953:        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    954:        if ($name eq 'filename') {
                    955:            unless ($ENV{'form.'.$name}) {
                    956:               $ENV{'form.'.$name}=$value;
                    957: 	   }
                    958:        }
1.65      harris41  959:     }
1.43      www       960: 
                    961: 
1.2       www       962: # -------------------------------------------------------------- Check filename
                    963: 
                    964:   my $fn=$ENV{'form.filename'};
                    965: 
1.27      www       966:   
1.2       www       967:   unless ($fn) { 
1.27      www       968:      $r->log_reason($cuname.' at '.$cudom.
1.2       www       969:          ' trying to publish empty filename', $r->filename); 
                    970:      return HTTP_NOT_FOUND;
                    971:   } 
1.4       www       972: 
1.31      www       973:   ($cuname,$cudom)=
                    974:     &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
                    975:   unless (($cuname) && ($cudom)) {
1.27      www       976:      $r->log_reason($cuname.' at '.$cudom.
1.4       www       977:          ' trying to publish file '.$ENV{'form.filename'}.
1.27      www       978:          ' ('.$fn.') - not authorized', 
                    979:          $r->filename); 
                    980:      return HTTP_NOT_ACCEPTABLE;
                    981:   }
                    982: 
                    983:   unless (&Apache::lonnet::homeserver($cuname,$cudom) 
                    984:           eq $r->dir_config('lonHostID')) {
                    985:      $r->log_reason($cuname.' at '.$cudom.
                    986:          ' trying to publish file '.$ENV{'form.filename'}.
                    987:          ' ('.$fn.') - not homeserver ('.
                    988:          &Apache::lonnet::homeserver($cuname,$cudom).')', 
1.4       www       989:          $r->filename); 
                    990:      return HTTP_NOT_ACCEPTABLE;
                    991:   }
1.2       www       992: 
1.43      www       993:   $fn=~s/^http\:\/\/[^\/]+//;
                    994:   $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;
1.2       www       995: 
                    996:   my $targetdir='';
1.12      www       997:   $docroot=$r->dir_config('lonDocRoot'); 
1.27      www       998:   if ($1 ne $cuname) {
                    999:      $r->log_reason($cuname.' at '.$cudom.
1.2       www      1000:          ' trying to publish unowned file '.$ENV{'form.filename'}.
                   1001:          ' ('.$fn.')', 
                   1002:          $r->filename); 
                   1003:      return HTTP_NOT_ACCEPTABLE;
                   1004:   } else {
1.27      www      1005:       $targetdir=$docroot.'/res/'.$cudom;
1.2       www      1006:   }
                   1007:                                  
                   1008:   
                   1009:   unless (-e $fn) { 
1.27      www      1010:      $r->log_reason($cuname.' at '.$cudom.
1.2       www      1011:          ' trying to publish non-existing file '.$ENV{'form.filename'}.
                   1012:          ' ('.$fn.')', 
                   1013:          $r->filename); 
                   1014:      return HTTP_NOT_FOUND;
                   1015:   } 
                   1016: 
1.11      www      1017: unless ($ENV{'form.phase'} eq 'two') {
                   1018: 
1.2       www      1019: # --------------------------------- File is there and owned, init lookup tables
                   1020: 
1.3       www      1021:   %addid=();
                   1022: 
                   1023:   {
                   1024:       my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
                   1025:       while (<$fh>=~/(\w+)\s+(\w+)/) {
                   1026:           $addid{$1}=$2;
                   1027:       }
1.5       www      1028:   }
                   1029: 
                   1030:   %nokey=();
                   1031: 
                   1032:   {
                   1033:      my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
1.65      harris41 1034:       while (<$fh>) {
1.5       www      1035:           my $word=$_;
                   1036:           chomp($word);
                   1037:           $nokey{$word}=1;
1.65      harris41 1038:       }
1.3       www      1039:   }
1.11      www      1040: 
                   1041: }
                   1042: 
1.2       www      1043: # ----------------------------------------------------------- Start page output
                   1044: 
1.1       www      1045:   $r->content_type('text/html');
                   1046:   $r->send_http_header;
                   1047: 
                   1048:   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
1.15      www      1049:   $r->print(
                   1050:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
1.2       www      1051:   my $thisfn=$fn;
                   1052:    
                   1053: # ------------------------------------------------------------- Individual file
                   1054:   {
                   1055:       $thisfn=~/\.(\w+)$/;
                   1056:       my $thistype=$1;
1.65      harris41 1057:       my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
1.2       www      1058: 
                   1059:       my $thistarget=$thisfn;
                   1060:       
                   1061:       $thistarget=~s/^\/home/$targetdir/;
                   1062:       $thistarget=~s/\/public\_html//;
                   1063: 
                   1064:       my $thisdistarget=$thistarget;
                   1065:       $thisdistarget=~s/^$docroot//;
                   1066: 
                   1067:       my $thisdisfn=$thisfn;
1.27      www      1068:       $thisdisfn=~s/^\/home\/$cuname\/public_html\///;
1.2       www      1069: 
                   1070:       $r->print('<h2>Publishing '.
1.66      harris41 1071:         &Apache::loncommon::filedescription($thistype).' <tt>'.
1.2       www      1072:         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
1.27      www      1073:    
                   1074:        if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {
                   1075:           $r->print('<h3><font color=red>Co-Author: '.$cuname.' at '.$cudom.
                   1076:                '</font></h3>');
                   1077:       }
1.26      www      1078: 
1.65      harris41 1079:       if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
1.28      www      1080:           $r->print('<br><a href="/adm/diff?filename=/~'.$cuname.'/'.
                   1081:                     $thisdisfn.
1.26      www      1082:   	  '&versionone=priv" target=cat>Diffs with Current Version</a><p>');
                   1083:       }
1.11      www      1084:   
1.2       www      1085: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
                   1086: 
1.11      www      1087:        unless ($ENV{'form.phase'} eq 'two') {
1.27      www      1088:          $r->print(
                   1089:           '<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
1.11      www      1090:        } else {
1.27      www      1091:          $r->print(
                   1092:           '<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); 
1.11      www      1093:        }  
1.2       www      1094: 
1.11      www      1095:   }
1.1       www      1096:   $r->print('</body></html>');
1.15      www      1097: 
1.1       www      1098:   return OK;
                   1099: }
                   1100: 
                   1101: 1;
                   1102: __END__
                   1103: 
1.66      harris41 1104: =head1 NAME
1.1       www      1105: 
1.66      harris41 1106: Apache::lonpublisher - Publication Handler
1.1       www      1107: 
1.66      harris41 1108: =head1 SYNOPSIS
1.1       www      1109: 
1.66      harris41 1110: Invoked by /etc/httpd/conf/srm.conf:
1.1       www      1111: 
1.66      harris41 1112:  <Location /adm/publish>
                   1113:  PerlAccessHandler       Apache::lonacc
                   1114:  SetHandler perl-script
                   1115:  PerlHandler Apache::lonpublisher
                   1116:  ErrorDocument     403 /adm/login
                   1117:  ErrorDocument     404 /adm/notfound.html
                   1118:  ErrorDocument     406 /adm/unauthorized.html
                   1119:  ErrorDocument	  500 /adm/errorhandler
                   1120:  </Location>
1.1       www      1121: 
1.66      harris41 1122: =head1 INTRODUCTION
1.1       www      1123: 
1.66      harris41 1124: This module publishes a file.  This involves gathering metadata,
                   1125: versioning the file, copying file from construction space to
                   1126: publication space, and copying metadata from construction space
                   1127: to publication space.
                   1128: 
                   1129: This is part of the LearningOnline Network with CAPA project
                   1130: described at http://www.lon-capa.org.
                   1131: 
                   1132: =head1 HANDLER SUBROUTINE
                   1133: 
                   1134: This routine is called by Apache and mod_perl.
                   1135: 
                   1136: =over 4
                   1137: 
                   1138: =item *
                   1139: 
                   1140: Get query string for limited number of parameters
                   1141: 
                   1142: =item *
                   1143: 
                   1144: Check filename
                   1145: 
                   1146: =item *
                   1147: 
                   1148: File is there and owned, init lookup tables
                   1149: 
                   1150: =item *
                   1151: 
                   1152: Start page output
                   1153: 
                   1154: =item *
                   1155: 
                   1156: Individual file
                   1157: 
                   1158: =item *
                   1159: 
                   1160: publish from $thisfn to $thistarget with $thisembstyle
                   1161: 
                   1162: =back
                   1163: 
                   1164: =head1 OTHER SUBROUTINES
                   1165: 
                   1166: =over 4
                   1167: 
                   1168: =item *
                   1169: 
                   1170: metaeval() : Evaluate string with metadata
                   1171: 
                   1172: =item *
                   1173: 
                   1174: metaread() : Read a metadata file
                   1175: 
                   1176: =item *
                   1177: 
                   1178: sqltime() : convert 'time' format into a datetime sql format
                   1179: 
                   1180: =item *
                   1181: 
                   1182: textfield() : form field
                   1183: 
                   1184: =item *
                   1185: 
                   1186: hiddenfield() : form field
                   1187: 
                   1188: =item *
                   1189: 
                   1190: selectbox() : form field
                   1191: 
                   1192: =item *
                   1193: 
                   1194: urlfixup() : fixup URL (Publication Step One)
                   1195: 
                   1196: =item *
                   1197: 
                   1198: publish() : publish (Publication Step One)
                   1199: 
                   1200: =item *
                   1201: 
                   1202: phasetwo() : render second interface showing status of publication steps
                   1203: (Publication Step Two)
                   1204: 
                   1205: =back
                   1206: 
                   1207: =cut

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