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

1.1       www         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: #
1.15      www         8: # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
1.1       www         9: 
                     10: package Apache::lonpublisher;
                     11: 
                     12: use strict;
                     13: use Apache::File;
1.13      www        14: use File::Copy;
1.2       www        15: use Apache::Constants qw(:common :http :methods);
                     16: use HTML::TokeParser;
1.4       www        17: use Apache::lonxml;
1.17      albertel   18: use Apache::lonhomework;
1.2       www        19: 
1.3       www        20: my %addid;
1.5       www        21: my %nokey;
1.9       www        22: my %language;
1.10      www        23: my %cprtag;
                     24: 
1.7       www        25: my %metadatafields;
                     26: my %metadatakeys;
                     27: 
1.12      www        28: my $docroot;
                     29: 
                     30: # ----------------------------------------------- Evaluate string with metadata
                     31: 
1.7       www        32: sub metaeval {
                     33:     my $metastring=shift;
                     34:    
                     35:         my $parser=HTML::TokeParser->new(\$metastring);
                     36:         my $token;
                     37:         while ($token=$parser->get_token) {
                     38:            if ($token->[0] eq 'S') {
                     39: 	      my $entry=$token->[1];
                     40:               my $unikey=$entry;
                     41:               if (defined($token->[2]->{'part'})) { 
                     42:                  $unikey.='_'.$token->[2]->{'part'}; 
                     43: 	      }
                     44:               if (defined($token->[2]->{'name'})) { 
                     45:                  $unikey.='_'.$token->[2]->{'name'}; 
                     46: 	      }
                     47:                map {
                     48: 		  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
                     49:                   if ($metadatakeys{$unikey}) {
                     50: 		      $metadatakeys{$unikey}.=','.$_;
                     51:                   } else {
                     52:                       $metadatakeys{$unikey}=$_;
                     53:                   }
                     54:               } @{$token->[3]};
                     55:               if ($metadatafields{$unikey}) {
1.8       www        56: 		  my $newentry=$parser->get_text('/'.$entry);
                     57:                   unless ($metadatafields{$unikey}=~/$newentry/) {
                     58:                      $metadatafields{$unikey}.=', '.$newentry;
                     59: 		  }
1.7       www        60: 	      } else {
                     61:                  $metadatafields{$unikey}=$parser->get_text('/'.$entry);
                     62:               }
                     63:           }
                     64:        }
                     65: }
                     66: 
1.12      www        67: # -------------------------------------------------------- Read a metadata file
                     68: 
1.7       www        69: sub metaread {
                     70:     my ($logfile,$fn)=@_;
                     71:     unless (-e $fn) {
                     72: 	print $logfile 'No file '.$fn."\n";
                     73:         return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
                     74:     }
                     75:     print $logfile 'Processing '.$fn."\n";
                     76:     my $metastring;
                     77:     {
                     78:      my $metafh=Apache::File->new($fn);
                     79:      $metastring=join('',<$metafh>);
                     80:     }
                     81:     &metaeval($metastring);
                     82:     return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
                     83: }
                     84: 
1.12      www        85: # --------------------------------------------------------- Various form fields
                     86: 
1.8       www        87: sub textfield {
1.10      www        88:     my ($title,$name,$value)=@_;
1.8       www        89:     return "\n<p><b>$title:</b><br>".
1.11      www        90:            '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
                     91: }
                     92: 
                     93: sub hiddenfield {
                     94:     my ($name,$value)=@_;
                     95:     return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
1.8       www        96: }
                     97: 
1.9       www        98: sub selectbox {
1.10      www        99:     my ($title,$name,$value,%options)=@_;
                    100:     my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
                    101:     map {
                    102:         $selout.='<option value="'.$_.'"';
                    103:         if ($_ eq $value) { $selout.=' selected'; }
                    104:         $selout.='>'.$options{$_}.'</option>';
                    105:     } sort keys %options;
                    106:     return $selout.'</select>';
1.9       www       107: }
                    108: 
1.12      www       109: # -------------------------------------------------------- Publication Step One
                    110: 
1.2       www       111: sub publish {
1.4       www       112: 
1.2       www       113:     my ($source,$target,$style)=@_;
                    114:     my $logfile;
1.4       www       115:     my $scrout='';
                    116: 
1.2       www       117:     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
1.7       www       118: 	return 
                    119:          '<font color=red>No write permission to user directory, FAIL</font>';
1.2       www       120:     }
                    121:     print $logfile 
1.11      www       122: "\n\n================= Publish ".localtime()." Phase One  ================\n";
1.2       www       123: 
1.3       www       124:     if (($style eq 'ssi') || ($style eq 'rat')) {
                    125: # ------------------------------------------------------- This needs processing
1.4       www       126: 
                    127: # ----------------------------------------------------------------- Backup Copy
1.3       www       128: 	my $copyfile=$source.'.save';
1.13      www       129:         if (copy($source,$copyfile)) {
1.3       www       130: 	    print $logfile "Copied original file to ".$copyfile."\n";
                    131:         } else {
1.13      www       132: 	    print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
                    133:           return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
1.3       www       134:         }
1.4       www       135: # ------------------------------------------------------------- IDs and indices
                    136: 
                    137:         my $maxindex=10;
                    138:         my $maxid=10;
                    139:         my $content='';
                    140:         my $needsfixup=0;
                    141: 
                    142:         {
                    143:           my $org=Apache::File->new($source);
                    144:           $content=join('',<$org>);
                    145:         }
                    146:         {
                    147:           my $parser=HTML::TokeParser->new(\$content);
                    148:           my $token;
                    149:           while ($token=$parser->get_token) {
                    150:               if ($token->[0] eq 'S') {
                    151:                   my $counter;
                    152: 		  if ($counter=$addid{$token->[1]}) {
                    153: 		      if ($counter eq 'id') {
                    154: 			  if (defined($token->[2]->{'id'})) {
                    155:                              $maxid=
                    156: 		       ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
                    157: 			 } else {
                    158:                              $needsfixup=1;
                    159:                          }
                    160:                       } else {
                    161:  			  if (defined($token->[2]->{'index'})) {
                    162:                              $maxindex=
                    163: 	   ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
                    164: 			  } else {
                    165:                              $needsfixup=1;
                    166: 			  }
                    167: 		      }
                    168: 		  }
                    169:               }
                    170:           }
                    171:       }
                    172:       if ($needsfixup) {
                    173:           print $logfile "Needs ID and/or index fixup\n".
                    174: 	        "Max ID   : $maxid (min 10)\n".
                    175:                 "Max Index: $maxindex (min 10)\n";
                    176: 
                    177:           my $outstring='';
                    178:           my $parser=HTML::TokeParser->new(\$content);
                    179:           my $token;
                    180:           while ($token=$parser->get_token) {
                    181:               if ($token->[0] eq 'S') {
                    182:                   my $counter;
                    183: 		  if ($counter=$addid{$token->[1]}) {
                    184: 		      if ($counter eq 'id') {
                    185: 			  if (defined($token->[2]->{'id'})) {
                    186: 			      $outstring.=$token->[4];
                    187: 			  } else {
                    188:                               $maxid++;
                    189:                               my $thisid=' id="'.$maxid.'"';
                    190: 			      my $fixup=$token->[4];
                    191:                               $fixup=~s/(\<\w+)/$1$thisid/;
                    192:                               $outstring.=$fixup;
                    193:                               print $logfile 'ID: '.$fixup."\n";
                    194:                           }
                    195:                       } else {
                    196:  			  if (defined($token->[2]->{'index'})) {
                    197: 			      $outstring.=$token->[4];
                    198: 			  } else {
                    199:                               $maxindex++;
                    200:                               my $thisindex=' index="'.$maxindex.'"';
                    201: 			      my $fixup=$token->[4];
                    202:                               $fixup=~s/(\<\w+)/$1$thisindex/;
                    203:                               $outstring.=$fixup;
                    204:                               print $logfile 'Index: '.$fixup."\n";
                    205: 			  }
                    206: 		      }
                    207: 		  } else {
                    208:                       $outstring.=$token->[4];
                    209:                   }
                    210:               } elsif ($token->[0] eq 'E') {
                    211:                   $outstring.=$token->[2];
                    212:               } else {
                    213:                   $outstring.=$token->[1];
                    214:               }
                    215:           }
                    216:         {
                    217:           my $org;
                    218:           unless ($org=Apache::File->new('>'.$source)) {
                    219:              print $logfile "No write permit to $source\n";
1.7       www       220:              return 
                    221:               "<font color=red>No write permission to $source, FAIL</font>";
1.4       www       222: 	  }
                    223:           print $org $outstring;
                    224:         }
                    225: 	  $content=$outstring;
                    226:           print $logfile "End of ID and/or index fixup\n".
                    227: 	        "Max ID   : $maxid (min 10)\n".
                    228:                 "Max Index: $maxindex (min 10)\n";
                    229:       } else {
                    230: 	  print $logfile "Does not need ID and/or index fixup\n";
                    231:       }
1.7       www       232: 
                    233: # --------------------------------------------- Initial step done, now metadata
                    234: 
                    235: # ---------------------------------------- Storage for metadata keys and fields
                    236: 
1.8       www       237:      %metadatafields=();
                    238:      %metadatakeys=();
                    239:      
                    240:      my %oldparmstores=();
1.7       www       241: 
                    242: # ------------------------------------------------ First, check out environment
1.8       www       243:      unless (-e $source.'.meta') {
1.7       www       244:         $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
                    245: 	                          $ENV{'environment.middlename'}.' '.
                    246: 		                  $ENV{'environment.lastname'}.' '.
                    247: 		                  $ENV{'environment.generation'};
1.8       www       248:         $metadatafields{'author'}=~s/\s+/ /g;
                    249:         $metadatafields{'author'}=~s/\s+$//;
1.10      www       250:         $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
1.7       www       251: 
                    252: # ------------------------------------------------ Check out directory hierachy
                    253: 
                    254:         my $thisdisfn=$source;
                    255:         $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///;
                    256: 
                    257:         my @urlparts=split(/\//,$thisdisfn);
                    258:         $#urlparts--;
                    259: 
                    260:         my $currentpath='/home/'.$ENV{'user.name'}.'/';
                    261: 
                    262:         map {
                    263: 	    $currentpath.=$_.'/';
                    264:             $scrout.=&metaread($logfile,$currentpath.'default.meta');
                    265:         } @urlparts;
                    266: 
                    267: # ------------------- Clear out parameters and stores (there should not be any)
                    268: 
                    269:         map {
                    270: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
                    271: 		delete $metadatafields{$_};
                    272:             }
                    273:         } keys %metadatafields;
                    274: 
1.8       www       275:     } else {
1.7       www       276: # ---------------------- Read previous metafile, remember parameters and stores
                    277: 
                    278:         $scrout.=&metaread($logfile,$source.'.meta');
                    279: 
                    280:         map {
                    281: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
                    282:                 $oldparmstores{$_}=1;
                    283: 		delete $metadatafields{$_};
                    284:             }
                    285:         } keys %metadatafields;
                    286:         
1.8       www       287:     }
1.7       www       288: 
1.4       www       289: # -------------------------------------------------- Parse content for metadata
                    290: 
1.10      www       291:         my $allmeta=Apache::lonxml::xmlparse('meta',$content);
1.18    ! albertel  292: #        &metaeval($allmeta);
1.7       www       293: 
                    294: # ---------------- Find and document discrepancies in the parameters and stores
                    295: 
                    296:         my $chparms='';
                    297:         map {
                    298: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
                    299:                 unless ($_=~/\.\w+$/) { 
                    300:                    unless ($oldparmstores{$_}) {
                    301: 		      print $logfile 'New: '.$_."\n";
                    302:                       $chparms.=$_.' ';
                    303:                    }
                    304: 	        }
                    305:             }
                    306:         } sort keys %metadatafields;
                    307:         if ($chparms) {
                    308: 	    $scrout.='<p><b>New parameters or stored values:</b> '.
                    309:                      $chparms;
                    310:         }
                    311: 
                    312:         my $chparms='';
                    313:         map {
                    314: 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
1.12      www       315:                 unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) {
1.7       www       316: 		    print $logfile 'Obsolete: '.$_."\n";
                    317:                     $chparms.=$_.' ';
                    318:                 }
                    319:             }
                    320:         } sort keys %oldparmstores;
                    321:         if ($chparms) {
                    322: 	    $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
                    323:                      $chparms;
                    324:         }
1.5       www       325: 
1.8       www       326: # ------------------------------------------------------- Now have all metadata
1.5       www       327: 
1.8       www       328:         $scrout.=
                    329:      '<form action="/adm/publish" method="post">'.
1.11      www       330:           &hiddenfield('phase','two').
                    331:           &hiddenfield('filename',$ENV{'form.filename'}).
                    332: 	  &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
1.10      www       333:           &textfield('Title','title',$metadatafields{'title'}).
                    334:           &textfield('Author(s)','author',$metadatafields{'author'}).
                    335: 	  &textfield('Subject','subject',$metadatafields{'subject'});
1.5       www       336: 
                    337: # --------------------------------------------------- Scan content for keywords
1.7       www       338: 
1.8       www       339: 	my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
1.7       www       340:         my $colcount=0;
                    341:         
1.5       www       342: 	{
                    343: 	    my $textonly=$content;
                    344:             $textonly=~s/\<script[^\<]+\<\/script\>//g;
                    345:             $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
                    346:             $textonly=~s/\<[^\>]*\>//g;
                    347:             $textonly=~tr/A-Z/a-z/;
                    348:             $textonly=~s/[\$\&][a-z]\w*//g;
                    349:             $textonly=~s/[^a-z\s]//g;
                    350: 
                    351:             my %keywords=();
                    352:             map {
                    353: 		unless ($nokey{$_}) {
                    354:                    $keywords{$_}=1;
                    355:                 } 
                    356:             } ($textonly=~m/(\w+)/g);
                    357: 
1.12      www       358:             map {
                    359: 		$keywords{$_}=1;
                    360:             } split(/\W+/,$metadatafields{'keywords'});
1.5       www       361: 
1.7       www       362:             map {
1.12      www       363:                 $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
1.8       www       364:                 if ($metadatafields{'keywords'}=~/$_/) { 
                    365:                    $keywordout.=' checked'; 
                    366:                 }
                    367:                 $keywordout.='>'.$_.'</td>';
1.7       www       368:                 if ($colcount>10) {
                    369: 		    $keywordout.="</tr><tr>\n";
                    370:                     $colcount=0;
                    371:                 }
                    372:                 $colcount++;
                    373:             } sort keys %keywords;
                    374:             $keywordout.='</tr></table>';
1.5       www       375: 
                    376:         }         
1.4       www       377:         
1.7       www       378: 	$scrout.=$keywordout;
1.9       www       379: 
1.12      www       380:         $scrout.=&textfield('Additional Keywords','addkey','');
                    381: 
1.10      www       382:         $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
1.9       www       383: 
                    384:         $scrout.=
                    385:              '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
                    386:               $metadatafields{'abstract'}.'</textarea>';
                    387: 
1.11      www       388: 	$source=~/\.(\w+)$/;
                    389: 
                    390: 	$scrout.=&hiddenfield('mime',$1);
                    391: 
1.10      www       392:         $scrout.=&selectbox('Language','language',
                    393:                             $metadatafields{'language'},%language);
1.11      www       394: 
                    395:         unless ($metadatafields{'creationdate'}) {
                    396: 	    $metadatafields{'creationdate'}=time;
                    397:         }
                    398:         $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'});
                    399: 
                    400:         $scrout.=&hiddenfield('lastrevisiondate',time);
                    401: 
1.9       www       402: 			   
1.10      www       403: 	$scrout.=&textfield('Publisher/Owner','owner',
                    404:                             $metadatafields{'owner'});
                    405: 
                    406:         $scrout.=&selectbox('Copyright/Distribution','copyright',
                    407:                             $metadatafields{'copyright'},%cprtag);
1.9       www       408: 
1.3       www       409:     }
1.8       www       410:     return $scrout.
                    411:       '<p><input type="submit" value="Finalize Publication"></form>';
1.2       www       412: }
1.1       www       413: 
1.12      www       414: # -------------------------------------------------------- Publication Step Two
                    415: 
1.11      www       416: sub phasetwo {
                    417: 
                    418:     my ($source,$target,$style)=@_;
                    419:     my $logfile;
                    420:     my $scrout='';
                    421: 
                    422:     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
                    423: 	return 
                    424:          '<font color=red>No write permission to user directory, FAIL</font>';
                    425:     }
                    426:     print $logfile 
                    427: "\n================= Publish ".localtime()." Phase Two  ================\n";
                    428: 
                    429:      %metadatafields=();
                    430:      %metadatakeys=();
                    431: 
                    432:      &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
                    433: 
                    434:      $metadatafields{'title'}=$ENV{'form.title'};
                    435:      $metadatafields{'author'}=$ENV{'form.author'};
                    436:      $metadatafields{'subject'}=$ENV{'form.subject'};
                    437:      $metadatafields{'notes'}=$ENV{'form.notes'};
                    438:      $metadatafields{'abstract'}=$ENV{'form.abstract'};
                    439:      $metadatafields{'mime'}=$ENV{'form.mime'};
                    440:      $metadatafields{'language'}=$ENV{'form.language'};
                    441:      $metadatafields{'creationdate'}=$ENV{'form.creationdate'};
                    442:      $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
                    443:      $metadatafields{'owner'}=$ENV{'form.owner'};
                    444:      $metadatafields{'copyright'}=$ENV{'form.copyright'};
1.12      www       445: 
                    446:      my $allkeywords=$ENV{'form.addkey'};
1.11      www       447:      map {
1.12      www       448:          if ($_=~/^form\.key\.(\w+)/) {
                    449: 	     $allkeywords.=','.$1;
                    450:          }
                    451:      } keys %ENV;
                    452:      $allkeywords=~s/\W+/\,/;
                    453:      $allkeywords=~s/^\,//;
                    454:      $metadatafields{'keywords'}=$allkeywords;
                    455:  
                    456:      {
                    457:        print $logfile "\nWrite metadata file for ".$source;
                    458:        my $mfh;
                    459:        unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
                    460: 	return 
                    461:          '<font color=red>Could not write metadata, FAIL</font>';
                    462:        }    
                    463:        map {
                    464: 	 unless ($_=~/\./) {
                    465:            my $unikey=$_;
                    466:            $unikey=~/^([A-Za-z]+)/;
                    467:            my $tag=$1;
                    468:            $tag=~tr/A-Z/a-z/;
                    469:            print $mfh "\n\<$tag";
                    470:            map {
                    471:                my $value=$metadatafields{$unikey.'.'.$_};
                    472:                $value=~s/\"/\'\'/g;
                    473:                print $mfh ' '.$_.'="'.$value.'"';
                    474:            } split(/\,/,$metadatakeys{$unikey});
                    475: 	   print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';
                    476:          }
                    477:        } sort keys %metadatafields;
                    478:        $scrout.='<p>Wrote Metadata';
                    479:        print $logfile "\nWrote metadata";
                    480:      }
                    481: 
                    482: # ----------------------------------------------------------- Copy old versions
                    483:    
                    484: if (-e $target) {
                    485:     my $filename;
                    486:     my $maxversion=0;
                    487:     $target=~/(.*)\/([^\/]+)\.(\w+)$/;
                    488:     my $srcf=$2;
                    489:     my $srct=$3;
                    490:     my $srcd=$1;
                    491:     unless ($srcd=~/^\/home\/httpd\/html\/res/) {
                    492: 	print $logfile "\nPANIC: Target dir is ".$srcd;
                    493:         return "<font color=red>Invalid target directory, FAIL</font>";
                    494:     }
                    495:     opendir(DIR,$srcd);
                    496:     while ($filename=readdir(DIR)) {
                    497:        if ($filename=~/$srcf\.(\d+)\.$srct$/) {
                    498: 	   $maxversion=($1>$maxversion)?$1:$maxversion;
                    499:        }
                    500:     }
                    501:     closedir(DIR);
                    502:     $maxversion++;
                    503:     $scrout.='<p>Creating old version '.$maxversion;
                    504:     print $logfile "\nCreating old version ".$maxversion;
                    505: 
                    506:     my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
                    507: 
1.13      www       508:         if (copy($target,$copyfile)) {
1.12      www       509: 	    print $logfile "Copied old target to ".$copyfile."\n";
                    510:             $scrout.='<p>Copied old target file';
                    511:         } else {
1.13      www       512: 	    print $logfile "Unable to write ".$copyfile.':'.$!."\n";
                    513:            return "<font color=red>Failed to copy old target, $!, FAIL</font>";
1.12      www       514:         }
                    515: 
                    516: # --------------------------------------------------------------- Copy Metadata
                    517: 
                    518: 	$copyfile=$copyfile.'.meta';
1.13      www       519: 
                    520:         if (copy($target.'.meta',$copyfile)) {
1.14      www       521: 	    print $logfile "Copied old target metadata to ".$copyfile."\n";
1.12      www       522:             $scrout.='<p>Copied old metadata';
                    523:         } else {
1.13      www       524: 	    print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.14      www       525:             if (-e $target.'.meta') {
                    526:                return 
1.13      www       527:        "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
1.14      www       528: 	    }
1.12      www       529:         }
1.11      www       530: 
                    531: 
1.12      www       532: } else {
                    533:     $scrout.='<p>Initial version';
                    534:     print $logfile "\nInitial version";
                    535: }
                    536: 
                    537: # ---------------------------------------------------------------- Write Source
                    538: 	my $copyfile=$target;
                    539: 
                    540:            my @parts=split(/\//,$copyfile);
                    541:            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
                    542: 
                    543:            my $count;
                    544:            for ($count=5;$count<$#parts;$count++) {
                    545:                $path.="/$parts[$count]";
                    546:                if ((-e $path)!=1) {
                    547:                    print $logfile "\nCreating directory ".$path;
                    548:                    $scrout.='<p>Created directory '.$parts[$count];
                    549: 		   mkdir($path,0777);
                    550:                }
                    551:            }
                    552: 
1.13      www       553:         if (copy($source,$copyfile)) {
1.12      www       554: 	    print $logfile "Copied original source to ".$copyfile."\n";
                    555:             $scrout.='<p>Copied source file';
                    556:         } else {
1.13      www       557: 	    print $logfile "Unable to write ".$copyfile.':'.$!."\n";
                    558:             return "<font color=red>Failed to copy source, $!, FAIL</font>";
1.12      www       559:         }
                    560: 
                    561: # --------------------------------------------------------------- Copy Metadata
                    562: 
1.13      www       563:         $copyfile=$copyfile.'.meta';
                    564: 
                    565:         if (copy($source.'.meta',$copyfile)) {
1.12      www       566: 	    print $logfile "Copied original metadata to ".$copyfile."\n";
                    567:             $scrout.='<p>Copied metadata';
                    568:         } else {
1.13      www       569: 	    print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.12      www       570:             return 
1.13      www       571:           "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
1.12      www       572:         }
                    573: 
                    574: # --------------------------------------------------- Send update notifications
                    575: 
                    576: {
                    577: 
                    578:     my $filename;
                    579:  
                    580:     $target=~/(.*)\/([^\/]+)$/;
                    581:     my $srcf=$2;
                    582:     opendir(DIR,$1);
                    583:     while ($filename=readdir(DIR)) {
                    584:        if ($filename=~/$srcf\.(\w+)$/) {
                    585: 	   my $subhost=$1;
                    586:            if ($subhost ne 'meta') {
                    587: 	       $scrout.='<p>Notifying host '.$subhost.':';
                    588:                print $logfile "\nNotifying host '.$subhost.':'";
                    589:                my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
                    590:                $scrout.=$reply;
                    591:                print $logfile $reply;              
                    592:            }
                    593:        }
                    594:     }
                    595:     closedir(DIR);
                    596: 
                    597: }
                    598: 
                    599: # ------------------------------------------------ Provide link to new resource
                    600: 
                    601:     my $thisdistarget=$target;
                    602:     $thisdistarget=~s/^$docroot//;
                    603: 
                    604:     return $scrout.
                    605: 	'<p><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>';
1.11      www       606: }
                    607: 
1.1       www       608: # ================================================================ Main Handler
                    609: 
                    610: sub handler {
                    611:   my $r=shift;
1.2       www       612: 
                    613:   if ($r->header_only) {
                    614:      $r->content_type('text/html');
                    615:      $r->send_http_header;
                    616:      return OK;
                    617:   }
                    618: 
1.15      www       619: unless ($ENV{'form.pubdir'}) {
1.2       www       620: # -------------------------------------------------------------- Check filename
                    621: 
                    622:   my $fn=$ENV{'form.filename'};
                    623: 
                    624:   unless ($fn) { 
                    625:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                    626:          ' trying to publish empty filename', $r->filename); 
                    627:      return HTTP_NOT_FOUND;
                    628:   } 
1.4       www       629: 
                    630:   unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
                    631:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                    632:          ' trying to publish file '.$ENV{'form.filename'}.
                    633:          ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', 
                    634:          $r->filename); 
                    635:      return HTTP_NOT_ACCEPTABLE;
                    636:   }
1.2       www       637: 
                    638:   $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
                    639: 
                    640:   my $targetdir='';
1.12      www       641:   $docroot=$r->dir_config('lonDocRoot'); 
1.2       www       642:   if ($1 ne $ENV{'user.name'}) {
                    643:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                    644:          ' trying to publish unowned file '.$ENV{'form.filename'}.
                    645:          ' ('.$fn.')', 
                    646:          $r->filename); 
                    647:      return HTTP_NOT_ACCEPTABLE;
                    648:   } else {
                    649:       $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
                    650:   }
                    651:                                  
                    652:   
                    653:   unless (-e $fn) { 
                    654:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                    655:          ' trying to publish non-existing file '.$ENV{'form.filename'}.
                    656:          ' ('.$fn.')', 
                    657:          $r->filename); 
                    658:      return HTTP_NOT_FOUND;
                    659:   } 
                    660: 
1.11      www       661: unless ($ENV{'form.phase'} eq 'two') {
                    662: 
1.2       www       663: # --------------------------------- File is there and owned, init lookup tables
                    664: 
1.3       www       665:   %addid=();
                    666: 
                    667:   {
                    668:       my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
                    669:       while (<$fh>=~/(\w+)\s+(\w+)/) {
                    670:           $addid{$1}=$2;
                    671:       }
1.5       www       672:   }
                    673: 
                    674:   %nokey=();
                    675: 
                    676:   {
                    677:      my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
                    678:       map {
                    679:           my $word=$_;
                    680:           chomp($word);
                    681:           $nokey{$word}=1;
1.9       www       682:       } <$fh>;
                    683:   }
                    684: 
                    685:   %language=();
                    686: 
                    687:   {
                    688:      my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
                    689:       map {
1.10      www       690:           $_=~/(\w+)\s+([\w\s\-]+)/;
1.9       www       691:           $language{$1}=$2;
1.10      www       692:       } <$fh>;
                    693:   }
                    694: 
                    695:   %cprtag=();
                    696: 
                    697:   {
                    698:      my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');
                    699:       map {
                    700:           $_=~/(\w+)\s+([\w\s\-]+)/;
                    701:           $cprtag{$1}=$2;
1.5       www       702:       } <$fh>;
1.3       www       703:   }
1.11      www       704: 
                    705: }
                    706: 
1.2       www       707: # ----------------------------------------------------------- Start page output
                    708: 
1.1       www       709:   $r->content_type('text/html');
                    710:   $r->send_http_header;
                    711: 
                    712:   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
1.15      www       713:   $r->print(
                    714:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
1.2       www       715:   my $thisfn=$fn;
                    716:    
                    717: # ------------------------------------------------------------- Individual file
                    718:   {
                    719:       $thisfn=~/\.(\w+)$/;
                    720:       my $thistype=$1;
                    721:       my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
                    722: 
                    723:       my $thistarget=$thisfn;
                    724:       
                    725:       $thistarget=~s/^\/home/$targetdir/;
                    726:       $thistarget=~s/\/public\_html//;
                    727: 
                    728:       my $thisdistarget=$thistarget;
                    729:       $thisdistarget=~s/^$docroot//;
                    730: 
                    731:       my $thisdisfn=$thisfn;
                    732:       $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
                    733: 
                    734:       $r->print('<h2>Publishing '.
                    735:         &Apache::lonnet::filedescription($thistype).' <tt>'.
                    736:         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
1.11      www       737:   
1.2       www       738: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
                    739: 
1.11      www       740:        unless ($ENV{'form.phase'} eq 'two') {
                    741:           $r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
                    742:        } else {
                    743:           $r->print('<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle));      
                    744:        }  
1.2       www       745: 
1.11      www       746:   }
1.1       www       747:   $r->print('</body></html>');
1.15      www       748: } else {
                    749: 
                    750:   my $fn=$ENV{'form.filename'};
                    751: 
                    752:   $fn=~s/\/[^\/]+$//;
                    753:   my $thisprefix=$fn;
                    754:   $thisprefix=~s/\/\~/\/priv\//;
                    755: 
                    756:   $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
                    757: 
                    758:   unless ($fn) { 
                    759:      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                    760:          ' trying to publish empty directory', $r->filename); 
                    761:      return HTTP_NOT_FOUND;
                    762:   } 
                    763: 
                    764: # ----------------------------------------------------------- Start page output
1.1       www       765: 
1.15      www       766:   $r->content_type('text/html');
                    767:   $r->send_http_header;
                    768: 
                    769:   $r->print('<html><head><title>LON-CAPA Publishing Directory</title></head>');
                    770:   $r->print(
                    771:    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
                    772: 
                    773:   my $thisdisfn=$fn;
                    774:   $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
                    775:   
                    776:   $r->print('<h1>Publishing directory <tt>'.$thisdisfn.'</tt></h1>');
                    777:   my $i=0;
                    778:   $r->print('<script>');
                    779:     my $filename;
                    780:     opendir(DIR,$fn);
                    781:        while ($filename=readdir(DIR)) {
                    782:            $filename=~/\.(\w+)$/;
                    783:            if ((&Apache::lonnet::fileembstyle($1)) && ($1 ne 'meta')) {
                    784: 	      $r->print(<<ENDOPEN);
                    785: 	      pub$i=window.open("$thisprefix/$filename","LONCAPApub$i",
                    786:                                 "menubar=no,height=450,width=650");
                    787: ENDOPEN
                    788:               $i++;     
                    789: 	   }
                    790:        }
                    791:     closedir(DIR);
                    792:   $r->print('</script>');
                    793: 
                    794:   $r->print('</body></html>');
                    795:   
                    796: }
1.1       www       797:   return OK;
                    798: }
                    799: 
                    800: 1;
                    801: __END__
                    802: 
                    803: 
                    804: 
                    805: 
                    806: 
                    807: 
                    808: 

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