Annotation of loncom/publisher/loncleanup.pm, revision 1.4
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to cleanup XML files
3: #
1.4 ! www 4: # $Id: loncleanup.pm,v 1.3 2005/05/28 18:53:50 albertel 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) {
221: $raw=~s/\<(br|hr|img|meta|allow|basefont)([^\>\/]*?)\>/\<$1$2 \/\>/gis;
222: $raw=~s/\<\/(br|hr|img|meta|allow|basefont)\>//gis;
223: unless ($full) {
224: $raw=~s/\<[\/]*(body|head|html)\>//gis;
225: }
1.1 www 226: }
227: # Make standard tags lowercase
1.2 www 228: unless ($blocklowercasing) {
229: foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m',
230: 'table','tr','td','th','p','br','hr','img','embed','font',
231: 'a','strong','center','title','basefont','li','ol','ul',
232: 'input','select','form','option','script','pre') {
233: $raw=~s/\<$_\s*\>/\<$_\>/gis;
234: $raw=~s/\<\/$_\s*\>/<\/$_\>/gis;
235: $raw=~s/\<$_\s([^\>]*)\>/<$_ $1\>/gis;
236: }
237: }
238: # Replace <font face="symbol">
239: unless ($blockdesymboling) {
240: $raw=&symbolfontreplace($raw);
1.1 www 241: }
242: return $raw;
243: }
244:
245: sub phaseone {
1.2 www 246: my ($r,$fn,$uname,$udom)=@_;
1.4 ! www 247: $r->print(&mt('Select actions to attempt:').
! 248: '<br /><input type="checkbox" name="linefeed" checked="checked" /> '.
! 249: &mt('Linefeeds, formfeeds, and carriage returns').
! 250: '<br /><input type="checkbox" name="empty" checked="checked" /> '.
! 251: &mt('Empty tags').
! 252: '<br /><input type="checkbox" name="lower" checked="checked" /> '.
! 253: &mt('Lower casing').
! 254: '<br /><input type="checkbox" name="symbol"checked="checked" /> '.
! 255: &mt('Symbol font').
! 256: '<input type="hidden" name="phase" value="two" />'.
! 257: '<p><input type="submit" value="'.&mt('Cleanup').'" /></p>');
1.1 www 258: }
259:
260: sub phasetwo {
1.2 www 261: my ($r,$fn,$uname,$udom)=@_;
1.4 ! www 262: open(IN,'/home/'.$uname.'/public_html/'.$fn);
! 263: my $text='';
! 264: while (my $line=<IN>) {
! 265: $text.=$line;
! 266: }
! 267: close(IN);
! 268: my $uri='/~'.$uname.$fn;
! 269: my $result=&Apache::lonnet::ssi_body($uri,
! 270: ('grade_target'=>'web',
! 271: 'return_only_error_and_warning_counts' => 1));
! 272: my ($errorcount,$warningcount)=split(':',$result);
! 273: $r->print(&mt('Original file').': '.
! 274: $errorcount.' '.&mt('error(s)').', '.
! 275: $warningcount.' '.&mt('warning(s)'));
! 276: $text=&htmlclean($text,1,
! 277: ($env{'form.linefeed'} ne 'on'),
! 278: ($env{'form.empty'} ne 'on'),
! 279: ($env{'form.lower'} ne 'on'),
! 280: ($env{'form.symbol'} ne 'on'));
! 281: my ($main,$ext)=($fn=~/^(.*)\.(\w+)/);
! 282: my $newfn=$main.'_Auto_Cleaned_Up.'.$ext;
! 283: open(OUT,'>/home/'.$uname.'/public_html'.$newfn);
! 284: print OUT $text;
! 285: close(OUT);
! 286: my $newuri='/~'.$uname.$newfn;
! 287: $result=&Apache::lonnet::ssi_body($newuri,
! 288: ('grade_target'=>'web',
! 289: 'return_only_error_and_warning_counts' => 1));
! 290: ($errorcount,$warningcount)=split(':',$result);
! 291: $r->print('<br />'.&mt('Cleaned up file').': '.
! 292: $errorcount.' '.&mt('error(s)').', '.
! 293: $warningcount.' '.&mt('warning(s)').
! 294: '<br /><a href="'.$newuri.'" target="prev">'.
! 295: &mt('Open (and edit) cleaned up file in new window').'</a>'.
! 296: '<br /><a href="/adm/diff?filename='.&Apache::lonnet::escape($uri).
! 297: '&versionone=priv&filetwo='.
! 298: &Apache::lonnet::escape($newuri).'" target="prev">'.
! 299: &mt('Show diffs in new window').'</a><br />'.
! 300: '<input type="hidden" name="phase" value="three" />'.
! 301: '<input type="submit" name="accept" value="'.&mt('Accept Result').'" />'.
! 302: '<input type="submit" name="reject" value="'.&mt('Reject Result').'" />'
! 303: );
1.2 www 304: }
305:
306: sub phasethree {
307: my ($r,$fn,$uname,$udom)=@_;
1.4 ! www 308: my $old='/home/'.$uname.'/public_html/'.$fn;
! 309: my ($main,$ext)=($fn=~/^(.*)\.(\w+)/);
! 310: my $newfn=$main.'_Auto_Cleaned_Up.'.$ext;
! 311: my $new='/home/'.$uname.'/public_html'.$newfn;
! 312: if ($env{'form.accept'}) {
! 313: $r->print(&mt('Accepting changes'));
! 314: move($new,$old);
! 315: } else {
! 316: $r->print(&mt('Rejeting changes'));
! 317: unlink($new);
! 318: }
1.1 www 319: }
320:
321: # ---------------------------------------------------------------- Main Handler
322: sub handler {
323:
1.3 albertel 324: my $r=shift;
1.4 ! www 325: my $fn='';
1.1 www 326:
327: # Get query string for limited number of parameters
328:
1.3 albertel 329: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
330: ['filename']);
1.1 www 331:
1.3 albertel 332: if ($env{'form.filename'}) {
333: $fn=$env{'form.filename'};
334: $fn=~s/^http\:\/\/[^\/]+//;
335: } else {
336: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
337: ' unspecified filename for cleanup', $r->filename);
338: return HTTP_NOT_FOUND;
339: }
340:
341: unless ($fn) {
342: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
343: ' trying to cleanup non-existing file', $r->filename);
344: return HTTP_NOT_FOUND;
345: }
1.1 www 346:
347: # ----------------------------------------------------------- Start page output
1.3 albertel 348: my $uname;
349: my $udom;
350:
351: ($uname,$udom)=
352: &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
353: unless (($uname) && ($udom)) {
354: $r->log_reason($uname.' at '.$udom.
355: ' trying to cleanup file '.$env{'form.filename'}.
356: ' ('.$fn.') - not authorized',
357: $r->filename);
358: return HTTP_NOT_ACCEPTABLE;
359: }
360:
361: $fn=~s/\/\~(\w+)//;
1.1 www 362:
1.3 albertel 363: &Apache::loncommon::content_type($r,'text/html');
364: $r->send_http_header;
365:
366: $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
367:
368: $r->print(&Apache::loncommon::bodytag('Cleanup XML Document'));
1.4 ! www 369: $r->print('<h2>'.$fn.'</h2>'.
! 370: '<form action="/adm/cleanup" method="post">'.
! 371: '<input type="hidden" name="filename" value="'.$env{'form.filename'}.'" />');
! 372: unless ($fn=~/\.(problem|exam|quiz|assess|survey|form|library|xml|html|htm|xhtml|xhtm|sty)$/) {
! 373: $r->print(&mt('Cannot cleanup this filetype'));
1.3 albertel 374: } else {
1.4 ! www 375: if ($env{'form.phase'} eq 'three') {
! 376: &phasethree($r,$fn,$uname,$udom);
! 377: } elsif ($env{'form.phase'} eq 'two') {
! 378: &phasetwo($r,$fn,$uname,$udom);
! 379: } else {
! 380: &phaseone($r,$fn,$uname,$udom);
! 381: }
1.3 albertel 382: }
1.4 ! www 383: my $dir=$fn;
! 384: $dir=~s/\/[^\/]+$/\//;
! 385: $r->print('</form>'.
! 386: '<br /><a href="/priv/'.$uname.'/'.$fn.'">'.&mt('Back to Source File').'</a>'.
! 387: '<br /><a href="/priv/'.$uname.'/'.$dir.'">'.&mt('Back to Source Directory').'</a>'.
! 388: '</body></html>');
1.3 albertel 389: return OK;
1.1 www 390: }
391:
392: 1;
393: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>