Annotation of loncom/publisher/lonpublisher.pm, revision 1.7
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.4 www 8: # 11/28,11/29,11/30 Gerd Kortemeyer
1.1 www 9:
10: package Apache::lonpublisher;
11:
12: use strict;
13: use Apache::File;
1.2 www 14: use Apache::Constants qw(:common :http :methods);
15: use HTML::TokeParser;
1.4 www 16: use Apache::lonxml;
1.6 www 17: use Apache::lonhomework;
1.2 www 18:
1.3 www 19: my %addid;
1.5 www 20: my %nokey;
1.3 www 21:
1.7 ! www 22: my %metadatafields;
! 23: my %metadatakeys;
! 24:
! 25: sub metaeval {
! 26: my $metastring=shift;
! 27:
! 28: my $parser=HTML::TokeParser->new(\$metastring);
! 29: my $token;
! 30: while ($token=$parser->get_token) {
! 31: if ($token->[0] eq 'S') {
! 32: my $entry=$token->[1];
! 33: my $unikey=$entry;
! 34: if (defined($token->[2]->{'part'})) {
! 35: $unikey.='_'.$token->[2]->{'part'};
! 36: }
! 37: if (defined($token->[2]->{'name'})) {
! 38: $unikey.='_'.$token->[2]->{'name'};
! 39: }
! 40: map {
! 41: $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
! 42: if ($metadatakeys{$unikey}) {
! 43: $metadatakeys{$unikey}.=','.$_;
! 44: } else {
! 45: $metadatakeys{$unikey}=$_;
! 46: }
! 47: } @{$token->[3]};
! 48: if ($metadatafields{$unikey}) {
! 49: $metadatafields{$unikey}.=','.$parser->get_text('/'.$entry);
! 50: } else {
! 51: $metadatafields{$unikey}=$parser->get_text('/'.$entry);
! 52: }
! 53: }
! 54: }
! 55: }
! 56:
! 57: sub metaread {
! 58: my ($logfile,$fn)=@_;
! 59: unless (-e $fn) {
! 60: print $logfile 'No file '.$fn."\n";
! 61: return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
! 62: }
! 63: print $logfile 'Processing '.$fn."\n";
! 64: my $metastring;
! 65: {
! 66: my $metafh=Apache::File->new($fn);
! 67: $metastring=join('',<$metafh>);
! 68: }
! 69: &metaeval($metastring);
! 70: return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
! 71: }
! 72:
1.2 www 73: sub publish {
1.4 www 74:
1.2 www 75: my ($source,$target,$style)=@_;
76: my $logfile;
1.4 www 77: my $scrout='';
78:
1.2 www 79: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
1.7 ! www 80: return
! 81: '<font color=red>No write permission to user directory, FAIL</font>';
1.2 www 82: }
83: print $logfile
84: "\n\n================== Publish ".localtime()." =================\n";
85:
1.3 www 86: if (($style eq 'ssi') || ($style eq 'rat')) {
87: # ------------------------------------------------------- This needs processing
1.4 www 88:
89: # ----------------------------------------------------------------- Backup Copy
1.3 www 90: my $copyfile=$source.'.save';
91: {
92: my $org=Apache::File->new($source);
93: my $cop=Apache::File->new('>'.$copyfile);
94: while (my $line=<$org>) { print $cop $line; }
95: }
96: if (-e $copyfile) {
97: print $logfile "Copied original file to ".$copyfile."\n";
98: } else {
1.4 www 99: print $logfile "Unable to write backup ".$copyfile."\n";
1.7 ! www 100: return "<font color=red>Failed to write backup copy, FAIL</font>";
1.3 www 101: }
1.4 www 102: # ------------------------------------------------------------- IDs and indices
103:
104: my $maxindex=10;
105: my $maxid=10;
106: my $content='';
107: my $needsfixup=0;
108:
109: {
110: my $org=Apache::File->new($source);
111: $content=join('',<$org>);
112: }
113: {
114: my $parser=HTML::TokeParser->new(\$content);
115: my $token;
116: while ($token=$parser->get_token) {
117: if ($token->[0] eq 'S') {
118: my $counter;
119: if ($counter=$addid{$token->[1]}) {
120: if ($counter eq 'id') {
121: if (defined($token->[2]->{'id'})) {
122: $maxid=
123: ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
124: } else {
125: $needsfixup=1;
126: }
127: } else {
128: if (defined($token->[2]->{'index'})) {
129: $maxindex=
130: ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
131: } else {
132: $needsfixup=1;
133: }
134: }
135: }
136: }
137: }
138: }
139: if ($needsfixup) {
140: print $logfile "Needs ID and/or index fixup\n".
141: "Max ID : $maxid (min 10)\n".
142: "Max Index: $maxindex (min 10)\n";
143:
144: my $outstring='';
145: my $parser=HTML::TokeParser->new(\$content);
146: my $token;
147: while ($token=$parser->get_token) {
148: if ($token->[0] eq 'S') {
149: my $counter;
150: if ($counter=$addid{$token->[1]}) {
151: if ($counter eq 'id') {
152: if (defined($token->[2]->{'id'})) {
153: $outstring.=$token->[4];
154: } else {
155: $maxid++;
156: my $thisid=' id="'.$maxid.'"';
157: my $fixup=$token->[4];
158: $fixup=~s/(\<\w+)/$1$thisid/;
159: $outstring.=$fixup;
160: print $logfile 'ID: '.$fixup."\n";
161: }
162: } else {
163: if (defined($token->[2]->{'index'})) {
164: $outstring.=$token->[4];
165: } else {
166: $maxindex++;
167: my $thisindex=' index="'.$maxindex.'"';
168: my $fixup=$token->[4];
169: $fixup=~s/(\<\w+)/$1$thisindex/;
170: $outstring.=$fixup;
171: print $logfile 'Index: '.$fixup."\n";
172: }
173: }
174: } else {
175: $outstring.=$token->[4];
176: }
177: } elsif ($token->[0] eq 'E') {
178: $outstring.=$token->[2];
179: } else {
180: $outstring.=$token->[1];
181: }
182: }
183: {
184: my $org;
185: unless ($org=Apache::File->new('>'.$source)) {
186: print $logfile "No write permit to $source\n";
1.7 ! www 187: return
! 188: "<font color=red>No write permission to $source, FAIL</font>";
1.4 www 189: }
190: print $org $outstring;
191: }
192: $content=$outstring;
193: print $logfile "End of ID and/or index fixup\n".
194: "Max ID : $maxid (min 10)\n".
195: "Max Index: $maxindex (min 10)\n";
196: } else {
197: print $logfile "Does not need ID and/or index fixup\n";
198: }
1.7 ! www 199:
! 200: # --------------------------------------------- Initial step done, now metadata
! 201:
! 202: # ---------------------------------------- Storage for metadata keys and fields
! 203:
! 204: %metadatafields=();
! 205: %metadatakeys=();
! 206:
! 207: # ------------------------------------------------ First, check out environment
! 208:
! 209: $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
! 210: $ENV{'environment.middlename'}.' '.
! 211: $ENV{'environment.lastname'}.' '.
! 212: $ENV{'environment.generation'};
! 213:
! 214: # ------------------------------------------------ Check out directory hierachy
! 215:
! 216: my $thisdisfn=$source;
! 217: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///;
! 218:
! 219: my @urlparts=split(/\//,$thisdisfn);
! 220: $#urlparts--;
! 221:
! 222: my $currentpath='/home/'.$ENV{'user.name'}.'/';
! 223:
! 224: map {
! 225: $currentpath.=$_.'/';
! 226: $scrout.=&metaread($logfile,$currentpath.'default.meta');
! 227: } @urlparts;
! 228:
! 229: # ------------------- Clear out parameters and stores (there should not be any)
! 230:
! 231: map {
! 232: if (($_=~/^parameter/) || ($_=~/^stores/)) {
! 233: delete $metadatafields{$_};
! 234: }
! 235: } keys %metadatafields;
! 236:
! 237: # ---------------------- Read previous metafile, remember parameters and stores
! 238:
! 239: $scrout.=&metaread($logfile,$source.'.meta');
! 240: my %oldparmstores=();
! 241:
! 242: map {
! 243: if (($_=~/^parameter/) || ($_=~/^stores/)) {
! 244: $oldparmstores{$_}=1;
! 245: delete $metadatafields{$_};
! 246: }
! 247: } keys %metadatafields;
! 248:
! 249:
! 250:
1.4 www 251: # -------------------------------------------------- Parse content for metadata
252:
1.6 www 253: my $allmeta='';
254: if ($source=~/\.problem$/) {
255: $allmeta=Apache::lonhomework::subhandler('meta',$content);
256: } else {
257: $allmeta=Apache::lonxml::xmlparse('meta',$content);
258: }
1.7 ! www 259: &metaeval($allmeta);
! 260:
! 261: # ---------------- Find and document discrepancies in the parameters and stores
! 262:
! 263: my $chparms='';
! 264: map {
! 265: if (($_=~/^parameter/) || ($_=~/^stores/)) {
! 266: unless ($_=~/\.\w+$/) {
! 267: unless ($oldparmstores{$_}) {
! 268: print $logfile 'New: '.$_."\n";
! 269: $chparms.=$_.' ';
! 270: }
! 271: }
! 272: }
! 273: } sort keys %metadatafields;
! 274: if ($chparms) {
! 275: $scrout.='<p><b>New parameters or stored values:</b> '.
! 276: $chparms;
! 277: }
! 278:
! 279: my $chparms='';
! 280: map {
! 281: if (($_=~/^parameter/) || ($_=~/^stores/)) {
! 282: unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) {
! 283: print $logfile 'Obsolete: '.$_."\n";
! 284: $chparms.=$_.' ';
! 285: }
! 286: }
! 287: } sort keys %oldparmstores;
! 288: if ($chparms) {
! 289: $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
! 290: $chparms;
! 291: }
1.5 www 292:
293: # DEBUG:
294:
1.7 ! www 295: $scrout.=$allmeta;
1.5 www 296:
297: # --------------------------------------------------- Scan content for keywords
1.7 ! www 298:
! 299: my $keywordout='<table border=2><tr>';
! 300: my $colcount=0;
! 301:
1.5 www 302: {
303: my $textonly=$content;
304: $textonly=~s/\<script[^\<]+\<\/script\>//g;
305: $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
306: $textonly=~s/\<[^\>]*\>//g;
307: $textonly=~tr/A-Z/a-z/;
308: $textonly=~s/[\$\&][a-z]\w*//g;
309: $textonly=~s/[^a-z\s]//g;
310:
311: my %keywords=();
312: map {
313: unless ($nokey{$_}) {
314: $keywords{$_}=1;
315: }
316: } ($textonly=~m/(\w+)/g);
317:
318:
1.7 ! www 319: map {
! 320: $keywordout.='<td><input type=checkbox name="'.$_.'">'.$_.
! 321: '</td>';
! 322: if ($colcount>10) {
! 323: $keywordout.="</tr><tr>\n";
! 324: $colcount=0;
! 325: }
! 326: $colcount++;
! 327: } sort keys %keywords;
! 328: $keywordout.='</tr></table>';
1.5 www 329:
330: }
1.4 www 331:
1.7 ! www 332: # DEGUG
! 333:
! 334: $scrout.=$keywordout;
1.3 www 335: }
1.4 www 336: return $scrout;
1.2 www 337: }
1.1 www 338:
339: # ================================================================ Main Handler
340:
341: sub handler {
342: my $r=shift;
1.2 www 343:
344: if ($r->header_only) {
345: $r->content_type('text/html');
346: $r->send_http_header;
347: return OK;
348: }
349:
350: # -------------------------------------------------------------- Check filename
351:
352: my $fn=$ENV{'form.filename'};
353:
354: unless ($fn) {
355: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
356: ' trying to publish empty filename', $r->filename);
357: return HTTP_NOT_FOUND;
358: }
1.4 www 359:
360: unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
361: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
362: ' trying to publish file '.$ENV{'form.filename'}.
363: ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')',
364: $r->filename);
365: return HTTP_NOT_ACCEPTABLE;
366: }
1.2 www 367:
368: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
369:
370: my $targetdir='';
371: my $docroot=$r->dir_config('lonDocRoot');
372: if ($1 ne $ENV{'user.name'}) {
373: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
374: ' trying to publish unowned file '.$ENV{'form.filename'}.
375: ' ('.$fn.')',
376: $r->filename);
377: return HTTP_NOT_ACCEPTABLE;
378: } else {
379: $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
380: }
381:
382:
383: unless (-e $fn) {
384: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
385: ' trying to publish non-existing file '.$ENV{'form.filename'}.
386: ' ('.$fn.')',
387: $r->filename);
388: return HTTP_NOT_FOUND;
389: }
390:
391: # --------------------------------- File is there and owned, init lookup tables
392:
1.3 www 393: %addid=();
394:
395: {
396: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
397: while (<$fh>=~/(\w+)\s+(\w+)/) {
398: $addid{$1}=$2;
399: }
1.5 www 400: }
401:
402: %nokey=();
403:
404: {
405: my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
406: map {
407: my $word=$_;
408: chomp($word);
409: $nokey{$word}=1;
410: } <$fh>;
1.3 www 411: }
1.2 www 412: # ----------------------------------------------------------- Start page output
413:
1.1 www 414: $r->content_type('text/html');
415: $r->send_http_header;
416:
417: $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
418: $r->print('<body bgcolor="#FFFFFF">');
1.2 www 419: my $thisfn=$fn;
420:
421: # ------------------------------------------------------------- Individual file
422: {
423: $thisfn=~/\.(\w+)$/;
424: my $thistype=$1;
425: my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
426:
427: my $thistarget=$thisfn;
428:
429: $thistarget=~s/^\/home/$targetdir/;
430: $thistarget=~s/\/public\_html//;
431:
432: my $thisdistarget=$thistarget;
433: $thisdistarget=~s/^$docroot//;
434:
435: my $thisdisfn=$thisfn;
436: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
437:
438: $r->print('<h2>Publishing '.
439: &Apache::lonnet::filedescription($thistype).' <tt>'.
440: $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
441:
442: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
443:
1.7 ! www 444: $r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
1.2 www 445:
446: }
447:
1.1 www 448: $r->print('</body></html>');
449:
450: return OK;
451: }
452:
453: 1;
454: __END__
455:
456:
457:
458:
459:
460:
461:
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