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