Annotation of loncom/publisher/lonpublisher.pm, revision 1.6
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.2 www 22: sub publish {
1.4 www 23:
1.2 www 24: my ($source,$target,$style)=@_;
25: my $logfile;
1.4 www 26: my $scrout='';
27:
1.2 www 28: unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
29: return 'No write permission to user directory, FAIL';
30: }
31: print $logfile
32: "\n\n================== Publish ".localtime()." =================\n";
33:
1.3 www 34: if (($style eq 'ssi') || ($style eq 'rat')) {
35: # ------------------------------------------------------- This needs processing
1.4 www 36:
37: # ----------------------------------------------------------------- Backup Copy
1.3 www 38: my $copyfile=$source.'.save';
39: {
40: my $org=Apache::File->new($source);
41: my $cop=Apache::File->new('>'.$copyfile);
42: while (my $line=<$org>) { print $cop $line; }
43: }
44: if (-e $copyfile) {
45: print $logfile "Copied original file to ".$copyfile."\n";
46: } else {
1.4 www 47: print $logfile "Unable to write backup ".$copyfile."\n";
1.3 www 48: return "Failed to write backup copy, FAIL";
49: }
1.4 www 50: # ------------------------------------------------------------- IDs and indices
51:
52: my $maxindex=10;
53: my $maxid=10;
54: my $content='';
55: my $needsfixup=0;
56:
57: {
58: my $org=Apache::File->new($source);
59: $content=join('',<$org>);
60: }
61: {
62: my $parser=HTML::TokeParser->new(\$content);
63: my $token;
64: while ($token=$parser->get_token) {
65: if ($token->[0] eq 'S') {
66: my $counter;
67: if ($counter=$addid{$token->[1]}) {
68: if ($counter eq 'id') {
69: if (defined($token->[2]->{'id'})) {
70: $maxid=
71: ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
72: } else {
73: $needsfixup=1;
74: }
75: } else {
76: if (defined($token->[2]->{'index'})) {
77: $maxindex=
78: ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
79: } else {
80: $needsfixup=1;
81: }
82: }
83: }
84: }
85: }
86: }
87: if ($needsfixup) {
88: print $logfile "Needs ID and/or index fixup\n".
89: "Max ID : $maxid (min 10)\n".
90: "Max Index: $maxindex (min 10)\n";
91:
92: my $outstring='';
93: my $parser=HTML::TokeParser->new(\$content);
94: my $token;
95: while ($token=$parser->get_token) {
96: if ($token->[0] eq 'S') {
97: my $counter;
98: if ($counter=$addid{$token->[1]}) {
99: if ($counter eq 'id') {
100: if (defined($token->[2]->{'id'})) {
101: $outstring.=$token->[4];
102: } else {
103: $maxid++;
104: my $thisid=' id="'.$maxid.'"';
105: my $fixup=$token->[4];
106: $fixup=~s/(\<\w+)/$1$thisid/;
107: $outstring.=$fixup;
108: print $logfile 'ID: '.$fixup."\n";
109: }
110: } else {
111: if (defined($token->[2]->{'index'})) {
112: $outstring.=$token->[4];
113: } else {
114: $maxindex++;
115: my $thisindex=' index="'.$maxindex.'"';
116: my $fixup=$token->[4];
117: $fixup=~s/(\<\w+)/$1$thisindex/;
118: $outstring.=$fixup;
119: print $logfile 'Index: '.$fixup."\n";
120: }
121: }
122: } else {
123: $outstring.=$token->[4];
124: }
125: } elsif ($token->[0] eq 'E') {
126: $outstring.=$token->[2];
127: } else {
128: $outstring.=$token->[1];
129: }
130: }
131: {
132: my $org;
133: unless ($org=Apache::File->new('>'.$source)) {
134: print $logfile "No write permit to $source\n";
135: return "No write permission to $source, FAIL";
136: }
137: print $org $outstring;
138: }
139: $content=$outstring;
140: print $logfile "End of ID and/or index fixup\n".
141: "Max ID : $maxid (min 10)\n".
142: "Max Index: $maxindex (min 10)\n";
143: } else {
144: print $logfile "Does not need ID and/or index fixup\n";
145: }
146: # -------------------------------------------------- Parse content for metadata
147:
1.6 ! www 148: my $allmeta='';
! 149: if ($source=~/\.problem$/) {
! 150: $allmeta=Apache::lonhomework::subhandler('meta',$content);
! 151: } else {
! 152: $allmeta=Apache::lonxml::xmlparse('meta',$content);
! 153: }
1.5 www 154:
155: # DEBUG:
156:
157: $scrout=$allmeta;
158:
159: # --------------------------------------------------- Scan content for keywords
160: {
161: my $textonly=$content;
162: $textonly=~s/\<script[^\<]+\<\/script\>//g;
163: $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
164: $textonly=~s/\<[^\>]*\>//g;
165: $textonly=~tr/A-Z/a-z/;
166: $textonly=~s/[\$\&][a-z]\w*//g;
167: $textonly=~s/[^a-z\s]//g;
168:
169: my %keywords=();
170: map {
171: unless ($nokey{$_}) {
172: $keywords{$_}=1;
173: }
174: } ($textonly=~m/(\w+)/g);
175:
176: # DEBUG:
177:
1.6 ! www 178: $scrout.=join('<br>',sort keys %keywords);
1.5 www 179:
180: }
1.4 www 181:
1.3 www 182:
183: }
1.4 www 184: return $scrout;
1.2 www 185: }
1.1 www 186:
187: # ================================================================ Main Handler
188:
189: sub handler {
190: my $r=shift;
1.2 www 191:
192: if ($r->header_only) {
193: $r->content_type('text/html');
194: $r->send_http_header;
195: return OK;
196: }
197:
198: # -------------------------------------------------------------- Check filename
199:
200: my $fn=$ENV{'form.filename'};
201:
202: unless ($fn) {
203: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
204: ' trying to publish empty filename', $r->filename);
205: return HTTP_NOT_FOUND;
206: }
1.4 www 207:
208: unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
209: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
210: ' trying to publish file '.$ENV{'form.filename'}.
211: ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')',
212: $r->filename);
213: return HTTP_NOT_ACCEPTABLE;
214: }
1.2 www 215:
216: $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
217:
218: my $targetdir='';
219: my $docroot=$r->dir_config('lonDocRoot');
220: if ($1 ne $ENV{'user.name'}) {
221: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
222: ' trying to publish unowned file '.$ENV{'form.filename'}.
223: ' ('.$fn.')',
224: $r->filename);
225: return HTTP_NOT_ACCEPTABLE;
226: } else {
227: $targetdir=$docroot.'/res/'.$ENV{'user.domain'};
228: }
229:
230:
231: unless (-e $fn) {
232: $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
233: ' trying to publish non-existing file '.$ENV{'form.filename'}.
234: ' ('.$fn.')',
235: $r->filename);
236: return HTTP_NOT_FOUND;
237: }
238:
239: # --------------------------------- File is there and owned, init lookup tables
240:
1.3 www 241: %addid=();
242:
243: {
244: my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
245: while (<$fh>=~/(\w+)\s+(\w+)/) {
246: $addid{$1}=$2;
247: }
1.5 www 248: }
249:
250: %nokey=();
251:
252: {
253: my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
254: map {
255: my $word=$_;
256: chomp($word);
257: $nokey{$word}=1;
258: } <$fh>;
1.3 www 259: }
1.2 www 260: # ----------------------------------------------------------- Start page output
261:
1.1 www 262: $r->content_type('text/html');
263: $r->send_http_header;
264:
265: $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
266: $r->print('<body bgcolor="#FFFFFF">');
1.2 www 267: my $thisfn=$fn;
268:
269: # ------------------------------------------------------------- Individual file
270: {
271: $thisfn=~/\.(\w+)$/;
272: my $thistype=$1;
273: my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);
274:
275: my $thistarget=$thisfn;
276:
277: $thistarget=~s/^\/home/$targetdir/;
278: $thistarget=~s/\/public\_html//;
279:
280: my $thisdistarget=$thistarget;
281: $thisdistarget=~s/^$docroot//;
282:
283: my $thisdisfn=$thisfn;
284: $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
285:
286: $r->print('<h2>Publishing '.
287: &Apache::lonnet::filedescription($thistype).' <tt>'.
288: $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
289:
290: # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
291:
292: $r->print('<b>Result:</b> '.&publish($thisfn,$thistarget,$thisembstyle));
293:
294: }
295:
1.1 www 296: $r->print('</body></html>');
297:
298: return OK;
299: }
300:
301: 1;
302: __END__
303:
304:
305:
306:
307:
308:
309:
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