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