1: # The LearningOnline Network with CAPA
2: # Publication Handler
3: #
4: # (TeX Content Handler
5: #
6: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
7: #
8: # 11/28,11/29,11/30,12/01,12/02,12/04 Gerd Kortemeyer
9:
10: package Apache::lonpublisher;
11:
12: use strict;
13: use Apache::File;
14: use Apache::Constants qw(:common :http :methods);
15: use HTML::TokeParser;
16: use Apache::lonxml;
17: use Apache::structuretags;
18: use Apache::inputtags;
19: use Apache::response;
20:
21: my %addid;
22: my %nokey;
23: my %language;
24: my %cprtag;
25:
26: my %metadatafields;
27: my %metadatakeys;
28:
29: my $docroot;
30:
31: # ----------------------------------------------- Evaluate string with metadata
32:
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}) {
57: my $newentry=$parser->get_text('/'.$entry);
58: unless ($metadatafields{$unikey}=~/$newentry/) {
59: $metadatafields{$unikey}.=', '.$newentry;
60: }
61: } else {
62: $metadatafields{$unikey}=$parser->get_text('/'.$entry);
63: }
64: }
65: }
66: }
67:
68: # -------------------------------------------------------- Read a metadata file
69:
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:
86: # --------------------------------------------------------- Various form fields
87:
88: sub textfield {
89: my ($title,$name,$value)=@_;
90: return "\n<p><b>$title:</b><br>".
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.'">';
97: }
98:
99: sub selectbox {
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>';
108: }
109:
110: # -------------------------------------------------------- Publication Step One
111:
112: sub publish {
113:
114: my ($source,$target,$style)=@_;
115: my $logfile;
116: my $scrout='';
117:
118: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
119: return
120: '<font color=red>No write permission to user directory, FAIL</font>';
121: }
122: print $logfile
123: "\n\n================= Publish ".localtime()." Phase One ================\n";
124:
125: if (($style eq 'ssi') || ($style eq 'rat')) {
126: # ------------------------------------------------------- This needs processing
127:
128: # ----------------------------------------------------------------- Backup Copy
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 {
138: print $logfile "Unable to write backup ".$copyfile."\n";
139: return "<font color=red>Failed to write backup copy, FAIL</font>";
140: }
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";
226: return
227: "<font color=red>No write permission to $source, FAIL</font>";
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: }
238:
239: # --------------------------------------------- Initial step done, now metadata
240:
241: # ---------------------------------------- Storage for metadata keys and fields
242:
243: %metadatafields=();
244: %metadatakeys=();
245:
246: my %oldparmstores=();
247:
248: # ------------------------------------------------ First, check out environment
249: unless (-e $source.'.meta') {
250: $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
251: $ENV{'environment.middlename'}.' '.
252: $ENV{'environment.lastname'}.' '.
253: $ENV{'environment.generation'};
254: $metadatafields{'author'}=~s/\s+/ /g;
255: $metadatafields{'author'}=~s/\s+$//;
256: $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
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:
281: } else {
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:
293: }
294:
295: # -------------------------------------------------- Parse content for metadata
296:
297: my $allmeta=Apache::lonxml::xmlparse('meta',$content);
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/)) {
321: unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) {
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: }
331:
332: # ------------------------------------------------------- Now have all metadata
333:
334: $scrout.=
335: '<form action="/adm/publish" method="post">'.
336: &hiddenfield('phase','two').
337: &hiddenfield('filename',$ENV{'form.filename'}).
338: &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
339: &textfield('Title','title',$metadatafields{'title'}).
340: &textfield('Author(s)','author',$metadatafields{'author'}).
341: &textfield('Subject','subject',$metadatafields{'subject'});
342:
343: # --------------------------------------------------- Scan content for keywords
344:
345: my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
346: my $colcount=0;
347:
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:
364: map {
365: $keywords{$_}=1;
366: } split(/\W+/,$metadatafields{'keywords'});
367:
368: map {
369: $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
370: if ($metadatafields{'keywords'}=~/$_/) {
371: $keywordout.=' checked';
372: }
373: $keywordout.='>'.$_.'</td>';
374: if ($colcount>10) {
375: $keywordout.="</tr><tr>\n";
376: $colcount=0;
377: }
378: $colcount++;
379: } sort keys %keywords;
380: $keywordout.='</tr></table>';
381:
382: }
383:
384: $scrout.=$keywordout;
385:
386: $scrout.=&textfield('Additional Keywords','addkey','');
387:
388: $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
389:
390: $scrout.=
391: '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
392: $metadatafields{'abstract'}.'</textarea>';
393:
394: $source=~/\.(\w+)$/;
395:
396: $scrout.=&hiddenfield('mime',$1);
397:
398: $scrout.=&selectbox('Language','language',
399: $metadatafields{'language'},%language);
400:
401: unless ($metadatafields{'creationdate'}) {
402: $metadatafields{'creationdate'}=time;
403: }
404: $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'});
405:
406: $scrout.=&hiddenfield('lastrevisiondate',time);
407:
408:
409: $scrout.=&textfield('Publisher/Owner','owner',
410: $metadatafields{'owner'});
411:
412: $scrout.=&selectbox('Copyright/Distribution','copyright',
413: $metadatafields{'copyright'},%cprtag);
414:
415: }
416: return $scrout.
417: '<p><input type="submit" value="Finalize Publication"></form>';
418: }
419:
420: # -------------------------------------------------------- Publication Step Two
421:
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'};
451:
452: my $allkeywords=$ENV{'form.addkey'};
453: map {
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: }
548:
549:
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>';
638: }
639:
640: # ================================================================ Main Handler
641:
642: sub handler {
643: my $r=shift;
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: }
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: }
668:
669: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
670:
671: my $targetdir='';
672: $docroot=$r->dir_config('lonDocRoot');
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:
692: unless ($ENV{'form.phase'} eq 'two') {
693:
694: # --------------------------------- File is there and owned, init lookup tables
695:
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: }
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;
713: } <$fh>;
714: }
715:
716: %language=();
717:
718: {
719: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
720: map {
721: $_=~/(\w+)\s+([\w\s\-]+)/;
722: $language{$1}=$2;
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;
733: } <$fh>;
734: }
735:
736: }
737:
738: # ----------------------------------------------------------- Start page output
739:
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">');
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>');
767:
768: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
769:
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: }
775:
776: }
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