Annotation of loncom/publisher/lonpublisher.pm, revision 1.20
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.20 ! www 9: # 03/23 Guy Albertelli
! 10: # 03/24 Gerd Kortemeyer
1.1 www 11:
12: package Apache::lonpublisher;
13:
14: use strict;
15: use Apache::File;
1.13 www 16: use File::Copy;
1.2 www 17: use Apache::Constants qw(:common :http :methods);
18: use HTML::TokeParser;
1.4 www 19: use Apache::lonxml;
1.17 albertel 20: use Apache::lonhomework;
1.2 www 21:
1.3 www 22: my %addid;
1.5 www 23: my %nokey;
1.9 www 24: my %language;
1.10 www 25: my %cprtag;
26:
1.7 www 27: my %metadatafields;
28: my %metadatakeys;
29:
1.12 www 30: my $docroot;
31:
32: # ----------------------------------------------- Evaluate string with metadata
33:
1.7 www 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}) {
1.8 www 58: my $newentry=$parser->get_text('/'.$entry);
59: unless ($metadatafields{$unikey}=~/$newentry/) {
60: $metadatafields{$unikey}.=', '.$newentry;
61: }
1.7 www 62: } else {
63: $metadatafields{$unikey}=$parser->get_text('/'.$entry);
64: }
65: }
66: }
67: }
68:
1.12 www 69: # -------------------------------------------------------- Read a metadata file
70:
1.7 www 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:
1.12 www 87: # --------------------------------------------------------- Various form fields
88:
1.8 www 89: sub textfield {
1.10 www 90: my ($title,$name,$value)=@_;
1.8 www 91: return "\n<p><b>$title:</b><br>".
1.11 www 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.'">';
1.8 www 98: }
99:
1.9 www 100: sub selectbox {
1.10 www 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>';
1.9 www 109: }
110:
1.12 www 111: # -------------------------------------------------------- Publication Step One
112:
1.2 www 113: sub publish {
1.4 www 114:
1.2 www 115: my ($source,$target,$style)=@_;
116: my $logfile;
1.4 www 117: my $scrout='';
118:
1.2 www 119: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
1.7 www 120: return
121: '<font color=red>No write permission to user directory, FAIL</font>';
1.2 www 122: }
123: print $logfile
1.11 www 124: "\n\n================= Publish ".localtime()." Phase One ================\n";
1.2 www 125:
1.3 www 126: if (($style eq 'ssi') || ($style eq 'rat')) {
127: # ------------------------------------------------------- This needs processing
1.4 www 128:
129: # ----------------------------------------------------------------- Backup Copy
1.3 www 130: my $copyfile=$source.'.save';
1.13 www 131: if (copy($source,$copyfile)) {
1.3 www 132: print $logfile "Copied original file to ".$copyfile."\n";
133: } else {
1.13 www 134: print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
135: return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
1.3 www 136: }
1.4 www 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";
1.7 www 222: return
223: "<font color=red>No write permission to $source, FAIL</font>";
1.4 www 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: }
1.7 www 234:
235: # --------------------------------------------- Initial step done, now metadata
236:
237: # ---------------------------------------- Storage for metadata keys and fields
238:
1.8 www 239: %metadatafields=();
240: %metadatakeys=();
241:
242: my %oldparmstores=();
1.7 www 243:
244: # ------------------------------------------------ First, check out environment
1.8 www 245: unless (-e $source.'.meta') {
1.7 www 246: $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
247: $ENV{'environment.middlename'}.' '.
248: $ENV{'environment.lastname'}.' '.
249: $ENV{'environment.generation'};
1.8 www 250: $metadatafields{'author'}=~s/\s+/ /g;
251: $metadatafields{'author'}=~s/\s+$//;
1.10 www 252: $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
1.7 www 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:
1.8 www 277: } else {
1.7 www 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:
1.8 www 289: }
1.7 www 290:
1.4 www 291: # -------------------------------------------------- Parse content for metadata
292:
1.10 www 293: my $allmeta=Apache::lonxml::xmlparse('meta',$content);
1.19 albertel 294: &metaeval($allmeta);
1.7 www 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/)) {
1.12 www 317: unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) {
1.7 www 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: }
1.5 www 327:
1.8 www 328: # ------------------------------------------------------- Now have all metadata
1.5 www 329:
1.8 www 330: $scrout.=
331: '<form action="/adm/publish" method="post">'.
1.11 www 332: &hiddenfield('phase','two').
333: &hiddenfield('filename',$ENV{'form.filename'}).
334: &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
1.10 www 335: &textfield('Title','title',$metadatafields{'title'}).
336: &textfield('Author(s)','author',$metadatafields{'author'}).
337: &textfield('Subject','subject',$metadatafields{'subject'});
1.5 www 338:
339: # --------------------------------------------------- Scan content for keywords
1.7 www 340:
1.8 www 341: my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
1.7 www 342: my $colcount=0;
343:
1.5 www 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:
1.12 www 360: map {
361: $keywords{$_}=1;
362: } split(/\W+/,$metadatafields{'keywords'});
1.5 www 363:
1.7 www 364: map {
1.12 www 365: $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
1.8 www 366: if ($metadatafields{'keywords'}=~/$_/) {
367: $keywordout.=' checked';
368: }
369: $keywordout.='>'.$_.'</td>';
1.7 www 370: if ($colcount>10) {
371: $keywordout.="</tr><tr>\n";
372: $colcount=0;
373: }
374: $colcount++;
375: } sort keys %keywords;
376: $keywordout.='</tr></table>';
1.5 www 377:
378: }
1.4 www 379:
1.7 www 380: $scrout.=$keywordout;
1.9 www 381:
1.12 www 382: $scrout.=&textfield('Additional Keywords','addkey','');
383:
1.10 www 384: $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
1.9 www 385:
386: $scrout.=
387: '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
388: $metadatafields{'abstract'}.'</textarea>';
389:
1.11 www 390: $source=~/\.(\w+)$/;
391:
392: $scrout.=&hiddenfield('mime',$1);
393:
1.10 www 394: $scrout.=&selectbox('Language','language',
395: $metadatafields{'language'},%language);
1.11 www 396:
397: unless ($metadatafields{'creationdate'}) {
398: $metadatafields{'creationdate'}=time;
399: }
400: $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'});
401:
402: $scrout.=&hiddenfield('lastrevisiondate',time);
403:
1.9 www 404:
1.10 www 405: $scrout.=&textfield('Publisher/Owner','owner',
406: $metadatafields{'owner'});
407:
408: $scrout.=&selectbox('Copyright/Distribution','copyright',
409: $metadatafields{'copyright'},%cprtag);
1.9 www 410:
1.3 www 411: }
1.8 www 412: return $scrout.
413: '<p><input type="submit" value="Finalize Publication"></form>';
1.2 www 414: }
1.1 www 415:
1.12 www 416: # -------------------------------------------------------- Publication Step Two
417:
1.11 www 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'};
1.12 www 447:
448: my $allkeywords=$ENV{'form.addkey'};
1.11 www 449: map {
1.12 www 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:
1.13 www 510: if (copy($target,$copyfile)) {
1.12 www 511: print $logfile "Copied old target to ".$copyfile."\n";
512: $scrout.='<p>Copied old target file';
513: } else {
1.13 www 514: print $logfile "Unable to write ".$copyfile.':'.$!."\n";
515: return "<font color=red>Failed to copy old target, $!, FAIL</font>";
1.12 www 516: }
517:
518: # --------------------------------------------------------------- Copy Metadata
519:
520: $copyfile=$copyfile.'.meta';
1.13 www 521:
522: if (copy($target.'.meta',$copyfile)) {
1.14 www 523: print $logfile "Copied old target metadata to ".$copyfile."\n";
1.12 www 524: $scrout.='<p>Copied old metadata';
525: } else {
1.13 www 526: print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.14 www 527: if (-e $target.'.meta') {
528: return
1.13 www 529: "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
1.14 www 530: }
1.12 www 531: }
1.11 www 532:
533:
1.12 www 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:
1.13 www 555: if (copy($source,$copyfile)) {
1.12 www 556: print $logfile "Copied original source to ".$copyfile."\n";
557: $scrout.='<p>Copied source file';
558: } else {
1.13 www 559: print $logfile "Unable to write ".$copyfile.':'.$!."\n";
560: return "<font color=red>Failed to copy source, $!, FAIL</font>";
1.12 www 561: }
562:
563: # --------------------------------------------------------------- Copy Metadata
564:
1.13 www 565: $copyfile=$copyfile.'.meta';
566:
567: if (copy($source.'.meta',$copyfile)) {
1.12 www 568: print $logfile "Copied original metadata to ".$copyfile."\n";
569: $scrout.='<p>Copied metadata';
570: } else {
1.13 www 571: print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
1.12 www 572: return
1.13 www 573: "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
1.12 www 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);
1.20 ! www 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);
1.12 www 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>';
1.11 www 636: }
637:
1.1 www 638: # ================================================================ Main Handler
639:
640: sub handler {
641: my $r=shift;
1.2 www 642:
643: if ($r->header_only) {
644: $r->content_type('text/html');
645: $r->send_http_header;
646: return OK;
647: }
648:
1.15 www 649: unless ($ENV{'form.pubdir'}) {
1.2 www 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: }
1.4 www 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: }
1.2 www 667:
668: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
669:
670: my $targetdir='';
1.12 www 671: $docroot=$r->dir_config('lonDocRoot');
1.2 www 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:
1.11 www 691: unless ($ENV{'form.phase'} eq 'two') {
692:
1.2 www 693: # --------------------------------- File is there and owned, init lookup tables
694:
1.3 www 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: }
1.5 www 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;
1.9 www 712: } <$fh>;
713: }
714:
715: %language=();
716:
717: {
718: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
719: map {
1.10 www 720: $_=~/(\w+)\s+([\w\s\-]+)/;
1.9 www 721: $language{$1}=$2;
1.10 www 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;
1.5 www 732: } <$fh>;
1.3 www 733: }
1.11 www 734:
735: }
736:
1.2 www 737: # ----------------------------------------------------------- Start page output
738:
1.1 www 739: $r->content_type('text/html');
740: $r->send_http_header;
741:
742: $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
1.15 www 743: $r->print(
744: '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
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>');
1.15 www 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
1.1 www 795:
1.15 www 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: }
1.1 www 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