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