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