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 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::response;
19:
20: my %addid;
21: my %nokey;
22: my %language;
23: my %cprtag;
24:
25: my %metadatafields;
26: my %metadatakeys;
27:
28: sub metaeval {
29: my $metastring=shift;
30:
31: my $parser=HTML::TokeParser->new(\$metastring);
32: my $token;
33: while ($token=$parser->get_token) {
34: if ($token->[0] eq 'S') {
35: my $entry=$token->[1];
36: my $unikey=$entry;
37: if (defined($token->[2]->{'part'})) {
38: $unikey.='_'.$token->[2]->{'part'};
39: }
40: if (defined($token->[2]->{'name'})) {
41: $unikey.='_'.$token->[2]->{'name'};
42: }
43: map {
44: $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
45: if ($metadatakeys{$unikey}) {
46: $metadatakeys{$unikey}.=','.$_;
47: } else {
48: $metadatakeys{$unikey}=$_;
49: }
50: } @{$token->[3]};
51: if ($metadatafields{$unikey}) {
52: my $newentry=$parser->get_text('/'.$entry);
53: unless ($metadatafields{$unikey}=~/$newentry/) {
54: $metadatafields{$unikey}.=', '.$newentry;
55: }
56: } else {
57: $metadatafields{$unikey}=$parser->get_text('/'.$entry);
58: }
59: }
60: }
61: }
62:
63: sub metaread {
64: my ($logfile,$fn)=@_;
65: unless (-e $fn) {
66: print $logfile 'No file '.$fn."\n";
67: return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
68: }
69: print $logfile 'Processing '.$fn."\n";
70: my $metastring;
71: {
72: my $metafh=Apache::File->new($fn);
73: $metastring=join('',<$metafh>);
74: }
75: &metaeval($metastring);
76: return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
77: }
78:
79: sub textfield {
80: my ($title,$name,$value)=@_;
81: return "\n<p><b>$title:</b><br>".
82: '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
83: }
84:
85: sub hiddenfield {
86: my ($name,$value)=@_;
87: return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
88: }
89:
90: sub selectbox {
91: my ($title,$name,$value,%options)=@_;
92: my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
93: map {
94: $selout.='<option value="'.$_.'"';
95: if ($_ eq $value) { $selout.=' selected'; }
96: $selout.='>'.$options{$_}.'</option>';
97: } sort keys %options;
98: return $selout.'</select>';
99: }
100:
101: sub publish {
102:
103: my ($source,$target,$style)=@_;
104: my $logfile;
105: my $scrout='';
106:
107: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
108: return
109: '<font color=red>No write permission to user directory, FAIL</font>';
110: }
111: print $logfile
112: "\n\n================= Publish ".localtime()." Phase One ================\n";
113:
114: if (($style eq 'ssi') || ($style eq 'rat')) {
115: # ------------------------------------------------------- This needs processing
116:
117: # ----------------------------------------------------------------- Backup Copy
118: my $copyfile=$source.'.save';
119: {
120: my $org=Apache::File->new($source);
121: my $cop=Apache::File->new('>'.$copyfile);
122: while (my $line=<$org>) { print $cop $line; }
123: }
124: if (-e $copyfile) {
125: print $logfile "Copied original file to ".$copyfile."\n";
126: } else {
127: print $logfile "Unable to write backup ".$copyfile."\n";
128: return "<font color=red>Failed to write backup copy, FAIL</font>";
129: }
130: # ------------------------------------------------------------- IDs and indices
131:
132: my $maxindex=10;
133: my $maxid=10;
134: my $content='';
135: my $needsfixup=0;
136:
137: {
138: my $org=Apache::File->new($source);
139: $content=join('',<$org>);
140: }
141: {
142: my $parser=HTML::TokeParser->new(\$content);
143: my $token;
144: while ($token=$parser->get_token) {
145: if ($token->[0] eq 'S') {
146: my $counter;
147: if ($counter=$addid{$token->[1]}) {
148: if ($counter eq 'id') {
149: if (defined($token->[2]->{'id'})) {
150: $maxid=
151: ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
152: } else {
153: $needsfixup=1;
154: }
155: } else {
156: if (defined($token->[2]->{'index'})) {
157: $maxindex=
158: ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
159: } else {
160: $needsfixup=1;
161: }
162: }
163: }
164: }
165: }
166: }
167: if ($needsfixup) {
168: print $logfile "Needs ID and/or index fixup\n".
169: "Max ID : $maxid (min 10)\n".
170: "Max Index: $maxindex (min 10)\n";
171:
172: my $outstring='';
173: my $parser=HTML::TokeParser->new(\$content);
174: my $token;
175: while ($token=$parser->get_token) {
176: if ($token->[0] eq 'S') {
177: my $counter;
178: if ($counter=$addid{$token->[1]}) {
179: if ($counter eq 'id') {
180: if (defined($token->[2]->{'id'})) {
181: $outstring.=$token->[4];
182: } else {
183: $maxid++;
184: my $thisid=' id="'.$maxid.'"';
185: my $fixup=$token->[4];
186: $fixup=~s/(\<\w+)/$1$thisid/;
187: $outstring.=$fixup;
188: print $logfile 'ID: '.$fixup."\n";
189: }
190: } else {
191: if (defined($token->[2]->{'index'})) {
192: $outstring.=$token->[4];
193: } else {
194: $maxindex++;
195: my $thisindex=' index="'.$maxindex.'"';
196: my $fixup=$token->[4];
197: $fixup=~s/(\<\w+)/$1$thisindex/;
198: $outstring.=$fixup;
199: print $logfile 'Index: '.$fixup."\n";
200: }
201: }
202: } else {
203: $outstring.=$token->[4];
204: }
205: } elsif ($token->[0] eq 'E') {
206: $outstring.=$token->[2];
207: } else {
208: $outstring.=$token->[1];
209: }
210: }
211: {
212: my $org;
213: unless ($org=Apache::File->new('>'.$source)) {
214: print $logfile "No write permit to $source\n";
215: return
216: "<font color=red>No write permission to $source, FAIL</font>";
217: }
218: print $org $outstring;
219: }
220: $content=$outstring;
221: print $logfile "End of ID and/or index fixup\n".
222: "Max ID : $maxid (min 10)\n".
223: "Max Index: $maxindex (min 10)\n";
224: } else {
225: print $logfile "Does not need ID and/or index fixup\n";
226: }
227:
228: # --------------------------------------------- Initial step done, now metadata
229:
230: # ---------------------------------------- Storage for metadata keys and fields
231:
232: %metadatafields=();
233: %metadatakeys=();
234:
235: my %oldparmstores=();
236:
237: # ------------------------------------------------ First, check out environment
238: unless (-e $source.'.meta') {
239: $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
240: $ENV{'environment.middlename'}.' '.
241: $ENV{'environment.lastname'}.' '.
242: $ENV{'environment.generation'};
243: $metadatafields{'author'}=~s/\s+/ /g;
244: $metadatafields{'author'}=~s/\s+$//;
245: $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
246:
247: # ------------------------------------------------ Check out directory hierachy
248:
249: my $thisdisfn=$source;
250: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///;
251:
252: my @urlparts=split(/\//,$thisdisfn);
253: $#urlparts--;
254:
255: my $currentpath='/home/'.$ENV{'user.name'}.'/';
256:
257: map {
258: $currentpath.=$_.'/';
259: $scrout.=&metaread($logfile,$currentpath.'default.meta');
260: } @urlparts;
261:
262: # ------------------- Clear out parameters and stores (there should not be any)
263:
264: map {
265: if (($_=~/^parameter/) || ($_=~/^stores/)) {
266: delete $metadatafields{$_};
267: }
268: } keys %metadatafields;
269:
270: } else {
271: # ---------------------- Read previous metafile, remember parameters and stores
272:
273: $scrout.=&metaread($logfile,$source.'.meta');
274:
275: map {
276: if (($_=~/^parameter/) || ($_=~/^stores/)) {
277: $oldparmstores{$_}=1;
278: delete $metadatafields{$_};
279: }
280: } keys %metadatafields;
281:
282: }
283:
284: # -------------------------------------------------- Parse content for metadata
285:
286: my $allmeta=Apache::lonxml::xmlparse('meta',$content);
287: &metaeval($allmeta);
288:
289: # ---------------- Find and document discrepancies in the parameters and stores
290:
291: my $chparms='';
292: map {
293: if (($_=~/^parameter/) || ($_=~/^stores/)) {
294: unless ($_=~/\.\w+$/) {
295: unless ($oldparmstores{$_}) {
296: print $logfile 'New: '.$_."\n";
297: $chparms.=$_.' ';
298: }
299: }
300: }
301: } sort keys %metadatafields;
302: if ($chparms) {
303: $scrout.='<p><b>New parameters or stored values:</b> '.
304: $chparms;
305: }
306:
307: my $chparms='';
308: map {
309: if (($_=~/^parameter/) || ($_=~/^stores/)) {
310: unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) {
311: print $logfile 'Obsolete: '.$_."\n";
312: $chparms.=$_.' ';
313: }
314: }
315: } sort keys %oldparmstores;
316: if ($chparms) {
317: $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
318: $chparms;
319: }
320:
321: # ------------------------------------------------------- Now have all metadata
322:
323: $scrout.=
324: '<form action="/adm/publish" method="post">'.
325: &hiddenfield('phase','two').
326: &hiddenfield('filename',$ENV{'form.filename'}).
327: &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
328: &textfield('Title','title',$metadatafields{'title'}).
329: &textfield('Author(s)','author',$metadatafields{'author'}).
330: &textfield('Subject','subject',$metadatafields{'subject'});
331:
332: # --------------------------------------------------- Scan content for keywords
333:
334: my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
335: my $colcount=0;
336:
337: {
338: my $textonly=$content;
339: $textonly=~s/\<script[^\<]+\<\/script\>//g;
340: $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
341: $textonly=~s/\<[^\>]*\>//g;
342: $textonly=~tr/A-Z/a-z/;
343: $textonly=~s/[\$\&][a-z]\w*//g;
344: $textonly=~s/[^a-z\s]//g;
345:
346: my %keywords=();
347: map {
348: unless ($nokey{$_}) {
349: $keywords{$_}=1;
350: }
351: } ($textonly=~m/(\w+)/g);
352:
353:
354: map {
355: $keywordout.='<td><input type=checkbox name="'.$_.'"';
356: if ($metadatafields{'keywords'}=~/$_/) {
357: $keywordout.=' checked';
358: }
359: $keywordout.='>'.$_.'</td>';
360: if ($colcount>10) {
361: $keywordout.="</tr><tr>\n";
362: $colcount=0;
363: }
364: $colcount++;
365: } sort keys %keywords;
366: $keywordout.='</tr></table>';
367:
368: }
369:
370: $scrout.=$keywordout;
371:
372: $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
373:
374: $scrout.=
375: '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
376: $metadatafields{'abstract'}.'</textarea>';
377:
378: $source=~/\.(\w+)$/;
379:
380: $scrout.=&hiddenfield('mime',$1);
381:
382: $scrout.=&selectbox('Language','language',
383: $metadatafields{'language'},%language);
384:
385: unless ($metadatafields{'creationdate'}) {
386: $metadatafields{'creationdate'}=time;
387: }
388: $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'});
389:
390: $scrout.=&hiddenfield('lastrevisiondate',time);
391:
392:
393: $scrout.=&textfield('Publisher/Owner','owner',
394: $metadatafields{'owner'});
395:
396: $scrout.=&selectbox('Copyright/Distribution','copyright',
397: $metadatafields{'copyright'},%cprtag);
398:
399: }
400: return $scrout.
401: '<p><input type="submit" value="Finalize Publication"></form>';
402: }
403:
404: sub phasetwo {
405:
406: my ($source,$target,$style)=@_;
407: my $logfile;
408: my $scrout='';
409:
410: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
411: return
412: '<font color=red>No write permission to user directory, FAIL</font>';
413: }
414: print $logfile
415: "\n================= Publish ".localtime()." Phase Two ================\n";
416:
417: %metadatafields=();
418: %metadatakeys=();
419:
420: &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
421:
422: $metadatafields{'title'}=$ENV{'form.title'};
423: $metadatafields{'author'}=$ENV{'form.author'};
424: $metadatafields{'subject'}=$ENV{'form.subject'};
425: $metadatafields{'keywords'}=$ENV{'form.keywords'};
426: $metadatafields{'notes'}=$ENV{'form.notes'};
427: $metadatafields{'abstract'}=$ENV{'form.abstract'};
428: $metadatafields{'mime'}=$ENV{'form.mime'};
429: $metadatafields{'language'}=$ENV{'form.language'};
430: $metadatafields{'creationdate'}=$ENV{'form.creationdate'};
431: $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
432: $metadatafields{'owner'}=$ENV{'form.owner'};
433: $metadatafields{'copyright'}=$ENV{'form.copyright'};
434:
435: map {
436: print $logfile "\n".$_.': '.$metadatafields{$_}.
437: "\n".$_.'.keys: '.$metadatakeys{$_};
438: } sort keys %metadatafields;
439:
440:
441: }
442:
443: # ================================================================ Main Handler
444:
445: sub handler {
446: my $r=shift;
447:
448: if ($r->header_only) {
449: $r->content_type('text/html');
450: $r->send_http_header;
451: return OK;
452: }
453:
454: # -------------------------------------------------------------- Check filename
455:
456: my $fn=$ENV{'form.filename'};
457:
458: unless ($fn) {
459: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
460: ' trying to publish empty filename', $r->filename);
461: return HTTP_NOT_FOUND;
462: }
463:
464: unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
465: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
466: ' trying to publish file '.$ENV{'form.filename'}.
467: ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')',
468: $r->filename);
469: return HTTP_NOT_ACCEPTABLE;
470: }
471:
472: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
473:
474: my $targetdir='';
475: my $docroot=$r->dir_config('lonDocRoot');
476: if ($1 ne $ENV{'user.name'}) {
477: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
478: ' trying to publish unowned file '.$ENV{'form.filename'}.
479: ' ('.$fn.')',
480: $r->filename);
481: return HTTP_NOT_ACCEPTABLE;
482: } else {
483: $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
484: }
485:
486:
487: unless (-e $fn) {
488: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
489: ' trying to publish non-existing file '.$ENV{'form.filename'}.
490: ' ('.$fn.')',
491: $r->filename);
492: return HTTP_NOT_FOUND;
493: }
494:
495: unless ($ENV{'form.phase'} eq 'two') {
496:
497: # --------------------------------- File is there and owned, init lookup tables
498:
499: %addid=();
500:
501: {
502: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
503: while (<$fh>=~/(\w+)\s+(\w+)/) {
504: $addid{$1}=$2;
505: }
506: }
507:
508: %nokey=();
509:
510: {
511: my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
512: map {
513: my $word=$_;
514: chomp($word);
515: $nokey{$word}=1;
516: } <$fh>;
517: }
518:
519: %language=();
520:
521: {
522: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
523: map {
524: $_=~/(\w+)\s+([\w\s\-]+)/;
525: $language{$1}=$2;
526: } <$fh>;
527: }
528:
529: %cprtag=();
530:
531: {
532: my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');
533: map {
534: $_=~/(\w+)\s+([\w\s\-]+)/;
535: $cprtag{$1}=$2;
536: } <$fh>;
537: }
538:
539: }
540:
541: # ----------------------------------------------------------- Start page output
542:
543: $r->content_type('text/html');
544: $r->send_http_header;
545:
546: $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
547: $r->print('<body bgcolor="#FFFFFF">');
548: my $thisfn=$fn;
549:
550: # ------------------------------------------------------------- Individual file
551: {
552: $thisfn=~/\.(\w+)$/;
553: my $thistype=$1;
554: my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
555:
556: my $thistarget=$thisfn;
557:
558: $thistarget=~s/^\/home/$targetdir/;
559: $thistarget=~s/\/public\_html//;
560:
561: my $thisdistarget=$thistarget;
562: $thisdistarget=~s/^$docroot//;
563:
564: my $thisdisfn=$thisfn;
565: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
566:
567: $r->print('<h2>Publishing '.
568: &Apache::lonnet::filedescription($thistype).' <tt>'.
569: $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
570:
571: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
572:
573: unless ($ENV{'form.phase'} eq 'two') {
574: $r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
575: } else {
576: $r->print('<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle));
577: }
578:
579: }
580: $r->print('</body></html>');
581:
582: return OK;
583: }
584:
585: 1;
586: __END__
587:
588:
589:
590:
591:
592:
593:
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