Annotation of loncom/publisher/loncleanup.pm, revision 1.7
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to cleanup XML files
3: #
1.7 ! albertel 4: # $Id: loncleanup.pm,v 1.6 2005/07/13 21:43:02 www Exp $
1.1 www 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: #
29: ###
30:
31: package Apache::loncleanup;
32:
33: use strict;
34: use Apache::File;
35: use File::Copy;
36: use Apache::Constants qw(:common :http :methods);
37: use Apache::loncacc;
38: use Apache::loncommon();
39: use Apache::lonlocal;
40: use Apache::lonnet;
41:
42: sub latextrans {
43: my $symbolfont=shift;
44: my %latexsymb=(
45: '±' => '\pm',
46: '´' => '\times',
47: '¸' => '\div',
48: 'Ò' => '(R)',
49: 'Ó' => '\copy',
50: 'Ø' => '\neg',
51: 'â' => '(R)',
52: 'ã' => '\copy',
53: '¦' => 'f',
54: 'A' => '\Alpha',
55: 'B' => '\Beta',
56: 'G' => '\Gamma',
57: 'D' => '\Delta',
58: 'E' => '\Epsilon',
59: 'Z' => '\Zeta',
60: 'H' => '\Eta',
61: 'Q' => '\Theta',
62: 'I' => '\Iota',
63: 'K' => '\Kappa',
64: 'L' => '\Lambda',
65: 'M' => '\Mu',
66: 'N' => '\Nu',
67: 'X' => '\Xi',
68: 'O' => '\Omicron',
69: 'P' => '\Pi',
70: 'R' => '\Rho',
71: 'S' => '\Sigma',
72: 'T' => '\Tau',
73: 'U' => 'Y',
74: 'F' => '\Phi',
75: 'C' => '\Chi',
76: 'Y' => '\Psi',
77: 'W' => '\Omega',
78: 'a' => '\alpha',
79: 'b' => '\beta',
80: 'g' => '\gamma',
81: 'd' => '\delta',
82: 'e' => '\epsilon',
83: 'z' => '\zeta',
84: 'h' => '\eta',
85: 'q' => '\theta',
86: 'i' => '\iota',
87: 'k' => '\kappa',
88: 'l' => '\lambda',
89: 'm' => '\mu',
90: 'n' => '\nu',
91: 'x' => '\xi',
92: 'o' => '\omicron',
93: 'p' => '\pi',
94: 'r' => '\rho',
95: 'V' => '\sigmaf',
96: 's' => '\sigma',
97: 't' => '\tau',
98: 'u' => '\upsilon',
99: 'f' => '\phi',
100: 'c' => '\chi',
101: 'y' => '\psi',
102: 'w' => '\omega',
103: 'J' => '\vartheta',
104: 'j' => '\varphi',
105: 'v' => '\varpi',
106: '¡' => '\Upsilon',
107: '¢' => "'",
108: '¤' => '/',
109: '²' => '"',
110: '¼' => '\ldots',
111: 'À' => '\aleph',
112: 'Á' => '\Im',
113: 'Â' => '\Re',
114: 'Ã' => '\wp',
115: 'Ô' => '^{TM}',
116: 'ä' => '^{TM}',
117: 'ð' => 'EUR',
118: '«' => '\leftrightarrow',
119: '¬' => '\leftarrow',
120: '­' => '\uparrow',
121: '®' => '\rightarrow',
122: '¯' => '\downarraw',
123: '¿' => '\hookleftarrow',
124: 'Û' => '\Leftrightarrow',
125: 'Ü' => '\Leftarrow',
126: 'Ý' => '\Uparrow',
127: 'Þ' => '\Rightarrow',
128: 'ß' => '\Downarrow',
129: '"' => '\forall',
130: '$' => '\exists',
131: ''' => '\ni',
132: '*' => '\ast',
133: '-' => '-',
134: '@' => '\cong',
135: '\' => '\therefore',
136: '^' => '\perp',
137: '~' => '\sim',
138: '£' => '\leq',
139: '¥' => '\infty',
140: '³' => '\geq',
141: 'µ' => '\propto',
142: '¶' => '\partial',
143: '·' => '\cdot',
144: '¹' => '\not=',
145: 'º' => '\equiv',
146: '»' => '\approx',
147: 'Ä' => '\otimes',
148: 'Å' => '\oplus',
149: 'Æ' => '\emptyset',
150: 'Ç' => '\cap',
151: 'È' => '\cup',
152: 'É' => '\supset',
153: 'Ê' => '\supseteq',
154: 'Ë' => '\not\subset',
155: 'Ì' => '\subset',
156: 'Í' => '\subseteq',
157: 'Î' => '\in',
158: 'Ï' => '\not\in',
159: 'Ð' => '\angle',
160: 'Ñ' => '\nabla',
161: 'Õ' => '\prod',
162: 'Ö' => '\surd',
163: '×' => '\cdot',
164: 'Ù' => '\wedge',
165: 'Ú' => '\wee',
166: 'å' => '\sum',
167: 'ò' => '\int',
168: 'á' => '\langle',
169: 'ñ' => '\rangle',
170: 'à' => '\diamondsuit',
171: '§' => '\clubsuit',
172: '¨' => '\diamondsuit',
173: '©' => '\heartsuit',
174: 'ª' => '\spadesuit'
175: );
176: my $output='';
177: my $char='';
178: my $entitymode=0;
179: for (my $i=0; $i<length($symbolfont); $i++) {
180: my $newchar=substr($symbolfont,$i,1);
181: $char.=$newchar;
182: if ($newchar eq '&') { $entitymode=1; }
183: if (($entitymode) && ($newchar ne ';')) { next; }
184: my $latex=$latexsymb{$char};
185: if ($latex) {
186: $output.=$latex;
187: } else {
188: $output.=$char;
189: }
190: $char='';
191: $entitymode=0;
192: }
193: return $output;
194: }
195:
196: sub insidetrans {
197: my @args=@_;
198: return '<font'.$args[0].$args[1].'><m>$'.&latextrans($args[2]).'$</m>';
199: }
200:
201: sub symbolfontreplace {
202: my $text=shift;
203: my @fragments=split(/\<\/font\>/si,$text);
204: for (my $i=0; $i<=$#fragments;$i++) {
205: $fragments[$i]=~s/\<font([^\>]*)\s+face=[\"\']*symbol[\"\']*([^\>]*)\>(.*)$/&insidetrans($1,$2,$3)/gsie;
206: }
207: return join('</font>',@fragments);
208: }
209:
210: sub htmlclean {
1.2 www 211: my ($raw,$full,$blocklinefeed,$blockemptytags,$blocklowercasing,$blockdesymboling)=@_;
1.1 www 212: # Take care of CRLF etc
1.2 www 213: unless ($blocklinefeed) {
214: $raw=~s/\r\f/\n/gs; $raw=~s/\f\r/\n/gs;
215: $raw=~s/\r\n/\n/gs; $raw=~s/\n\r/\n/gs;
216: $raw=~s/\f/\n/gs; $raw=~s/\r/\n/gs;
217: $raw=~s/\&\#10\;/\n/gs; $raw=~s/\&\#13\;/\n/gs;
218: }
1.1 www 219: # Generate empty tags, remove wrong end tags
1.2 www 220: unless ($blockemptytags) {
1.6 www 221: $raw=~s/\<(br|hr|img|meta|embed|allow|basefont)([^\>]*?)\>/\<$1$2 \/\>/gis;
222: $raw=~s/\<\/(br|hr|img|meta|embed|allow|basefont)\>//gis;
223: $raw=~s/\/ \/\>/\/\>/gs;
1.2 www 224: unless ($full) {
225: $raw=~s/\<[\/]*(body|head|html)\>//gis;
226: }
1.1 www 227: }
228: # Make standard tags lowercase
1.2 www 229: unless ($blocklowercasing) {
230: foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m',
231: 'table','tr','td','th','p','br','hr','img','embed','font',
232: 'a','strong','center','title','basefont','li','ol','ul',
233: 'input','select','form','option','script','pre') {
234: $raw=~s/\<$_\s*\>/\<$_\>/gis;
235: $raw=~s/\<\/$_\s*\>/<\/$_\>/gis;
236: $raw=~s/\<$_\s([^\>]*)\>/<$_ $1\>/gis;
237: }
238: }
239: # Replace <font face="symbol">
240: unless ($blockdesymboling) {
241: $raw=&symbolfontreplace($raw);
1.1 www 242: }
243: return $raw;
244: }
245:
246: sub phaseone {
1.2 www 247: my ($r,$fn,$uname,$udom)=@_;
1.4 www 248: $r->print(&mt('Select actions to attempt:').
249: '<br /><input type="checkbox" name="linefeed" checked="checked" /> '.
250: &mt('Linefeeds, formfeeds, and carriage returns').
251: '<br /><input type="checkbox" name="empty" checked="checked" /> '.
252: &mt('Empty tags').
253: '<br /><input type="checkbox" name="lower" checked="checked" /> '.
254: &mt('Lower casing').
255: '<br /><input type="checkbox" name="symbol"checked="checked" /> '.
256: &mt('Symbol font').
257: '<input type="hidden" name="phase" value="two" />'.
258: '<p><input type="submit" value="'.&mt('Cleanup').'" /></p>');
1.1 www 259: }
260:
261: sub phasetwo {
1.2 www 262: my ($r,$fn,$uname,$udom)=@_;
1.4 www 263: open(IN,'/home/'.$uname.'/public_html/'.$fn);
264: my $text='';
265: while (my $line=<IN>) {
266: $text.=$line;
267: }
268: close(IN);
269: my $uri='/~'.$uname.$fn;
270: my $result=&Apache::lonnet::ssi_body($uri,
271: ('grade_target'=>'web',
272: 'return_only_error_and_warning_counts' => 1));
273: my ($errorcount,$warningcount)=split(':',$result);
274: $r->print(&mt('Original file').': '.
275: $errorcount.' '.&mt('error(s)').', '.
276: $warningcount.' '.&mt('warning(s)'));
277: $text=&htmlclean($text,1,
278: ($env{'form.linefeed'} ne 'on'),
279: ($env{'form.empty'} ne 'on'),
280: ($env{'form.lower'} ne 'on'),
281: ($env{'form.symbol'} ne 'on'));
282: my ($main,$ext)=($fn=~/^(.*)\.(\w+)/);
283: my $newfn=$main.'_Auto_Cleaned_Up.'.$ext;
284: open(OUT,'>/home/'.$uname.'/public_html'.$newfn);
285: print OUT $text;
286: close(OUT);
287: my $newuri='/~'.$uname.$newfn;
288: $result=&Apache::lonnet::ssi_body($newuri,
289: ('grade_target'=>'web',
290: 'return_only_error_and_warning_counts' => 1));
291: ($errorcount,$warningcount)=split(':',$result);
292: $r->print('<br />'.&mt('Cleaned up file').': '.
293: $errorcount.' '.&mt('error(s)').', '.
294: $warningcount.' '.&mt('warning(s)').
295: '<br /><a href="'.$newuri.'" target="prev">'.
296: &mt('Open (and edit) cleaned up file in new window').'</a>'.
297: '<br /><a href="/adm/diff?filename='.&Apache::lonnet::escape($uri).
298: '&versionone=priv&filetwo='.
299: &Apache::lonnet::escape($newuri).'" target="prev">'.
300: &mt('Show diffs in new window').'</a><br />'.
301: '<input type="hidden" name="phase" value="three" />'.
302: '<input type="submit" name="accept" value="'.&mt('Accept Result').'" />'.
303: '<input type="submit" name="reject" value="'.&mt('Reject Result').'" />'
304: );
1.2 www 305: }
306:
307: sub phasethree {
308: my ($r,$fn,$uname,$udom)=@_;
1.4 www 309: my $old='/home/'.$uname.'/public_html/'.$fn;
310: my ($main,$ext)=($fn=~/^(.*)\.(\w+)/);
311: my $newfn=$main.'_Auto_Cleaned_Up.'.$ext;
312: my $new='/home/'.$uname.'/public_html'.$newfn;
313: if ($env{'form.accept'}) {
314: $r->print(&mt('Accepting changes'));
315: move($new,$old);
316: } else {
317: $r->print(&mt('Rejeting changes'));
318: unlink($new);
319: }
1.1 www 320: }
321:
322: # ---------------------------------------------------------------- Main Handler
323: sub handler {
324:
1.3 albertel 325: my $r=shift;
1.4 www 326: my $fn='';
1.1 www 327:
328: # Get query string for limited number of parameters
329:
1.3 albertel 330: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
331: ['filename']);
1.1 www 332:
1.3 albertel 333: if ($env{'form.filename'}) {
334: $fn=$env{'form.filename'};
335: $fn=~s/^http\:\/\/[^\/]+//;
336: } else {
337: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
338: ' unspecified filename for cleanup', $r->filename);
339: return HTTP_NOT_FOUND;
340: }
341:
342: unless ($fn) {
343: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
344: ' trying to cleanup non-existing file', $r->filename);
345: return HTTP_NOT_FOUND;
346: }
1.1 www 347:
348: # ----------------------------------------------------------- Start page output
1.3 albertel 349: my $uname;
350: my $udom;
351:
352: ($uname,$udom)=
353: &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
354: unless (($uname) && ($udom)) {
355: $r->log_reason($uname.' at '.$udom.
356: ' trying to cleanup file '.$env{'form.filename'}.
357: ' ('.$fn.') - not authorized',
358: $r->filename);
359: return HTTP_NOT_ACCEPTABLE;
360: }
361:
362: $fn=~s/\/\~(\w+)//;
1.1 www 363:
1.3 albertel 364: &Apache::loncommon::content_type($r,'text/html');
365: $r->send_http_header;
366:
1.7 ! albertel 367: $r->print(&Apache::loncommon::start_page('Cleanup XML Document'));
1.4 www 368: $r->print('<h2>'.$fn.'</h2>'.
369: '<form action="/adm/cleanup" method="post">'.
370: '<input type="hidden" name="filename" value="'.$env{'form.filename'}.'" />');
371: unless ($fn=~/\.(problem|exam|quiz|assess|survey|form|library|xml|html|htm|xhtml|xhtm|sty)$/) {
372: $r->print(&mt('Cannot cleanup this filetype'));
1.3 albertel 373: } else {
1.4 www 374: if ($env{'form.phase'} eq 'three') {
375: &phasethree($r,$fn,$uname,$udom);
376: } elsif ($env{'form.phase'} eq 'two') {
377: &phasetwo($r,$fn,$uname,$udom);
378: } else {
379: &phaseone($r,$fn,$uname,$udom);
380: }
1.3 albertel 381: }
1.4 www 382: my $dir=$fn;
383: $dir=~s/\/[^\/]+$/\//;
384: $r->print('</form>'.
385: '<br /><a href="/priv/'.$uname.'/'.$fn.'">'.&mt('Back to Source File').'</a>'.
386: '<br /><a href="/priv/'.$uname.'/'.$dir.'">'.&mt('Back to Source Directory').'</a>'.
1.7 ! albertel 387: &Apache::loncommon::end_page());
1.3 albertel 388: return OK;
1.1 www 389: }
390:
391: 1;
392: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>