Annotation of loncom/publisher/loncleanup.pm, revision 1.16
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to cleanup XML files
3: #
1.16 ! raeburn 4: # $Id: loncleanup.pm,v 1.15 2011/11/03 00:30:32 raeburn 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();
1.11 bisitz 39: use Apache::lonhtmlcommon();
1.1 www 40: use Apache::lonlocal;
41: use Apache::lonnet;
1.8 www 42: use lib '/home/httpd/lib/perl/';
43: use LONCAPA;
44:
1.1 www 45:
46: sub latextrans {
47: my $symbolfont=shift;
48: my %latexsymb=(
49: '±' => '\pm',
50: '´' => '\times',
51: '¸' => '\div',
52: 'Ò' => '(R)',
53: 'Ó' => '\copy',
54: 'Ø' => '\neg',
55: 'â' => '(R)',
56: 'ã' => '\copy',
57: '¦' => 'f',
58: 'A' => '\Alpha',
59: 'B' => '\Beta',
60: 'G' => '\Gamma',
61: 'D' => '\Delta',
62: 'E' => '\Epsilon',
63: 'Z' => '\Zeta',
64: 'H' => '\Eta',
65: 'Q' => '\Theta',
66: 'I' => '\Iota',
67: 'K' => '\Kappa',
68: 'L' => '\Lambda',
69: 'M' => '\Mu',
70: 'N' => '\Nu',
71: 'X' => '\Xi',
72: 'O' => '\Omicron',
73: 'P' => '\Pi',
74: 'R' => '\Rho',
75: 'S' => '\Sigma',
76: 'T' => '\Tau',
77: 'U' => 'Y',
78: 'F' => '\Phi',
79: 'C' => '\Chi',
80: 'Y' => '\Psi',
81: 'W' => '\Omega',
82: 'a' => '\alpha',
83: 'b' => '\beta',
84: 'g' => '\gamma',
85: 'd' => '\delta',
86: 'e' => '\epsilon',
87: 'z' => '\zeta',
88: 'h' => '\eta',
89: 'q' => '\theta',
90: 'i' => '\iota',
91: 'k' => '\kappa',
92: 'l' => '\lambda',
93: 'm' => '\mu',
94: 'n' => '\nu',
95: 'x' => '\xi',
96: 'o' => '\omicron',
97: 'p' => '\pi',
98: 'r' => '\rho',
99: 'V' => '\sigmaf',
100: 's' => '\sigma',
101: 't' => '\tau',
102: 'u' => '\upsilon',
103: 'f' => '\phi',
104: 'c' => '\chi',
105: 'y' => '\psi',
106: 'w' => '\omega',
107: 'J' => '\vartheta',
108: 'j' => '\varphi',
109: 'v' => '\varpi',
110: '¡' => '\Upsilon',
111: '¢' => "'",
112: '¤' => '/',
113: '²' => '"',
114: '¼' => '\ldots',
115: 'À' => '\aleph',
116: 'Á' => '\Im',
117: 'Â' => '\Re',
118: 'Ã' => '\wp',
119: 'Ô' => '^{TM}',
120: 'ä' => '^{TM}',
121: 'ð' => 'EUR',
122: '«' => '\leftrightarrow',
123: '¬' => '\leftarrow',
124: '­' => '\uparrow',
125: '®' => '\rightarrow',
126: '¯' => '\downarraw',
127: '¿' => '\hookleftarrow',
128: 'Û' => '\Leftrightarrow',
129: 'Ü' => '\Leftarrow',
130: 'Ý' => '\Uparrow',
131: 'Þ' => '\Rightarrow',
132: 'ß' => '\Downarrow',
133: '"' => '\forall',
134: '$' => '\exists',
135: ''' => '\ni',
136: '*' => '\ast',
137: '-' => '-',
138: '@' => '\cong',
139: '\' => '\therefore',
140: '^' => '\perp',
141: '~' => '\sim',
142: '£' => '\leq',
143: '¥' => '\infty',
144: '³' => '\geq',
145: 'µ' => '\propto',
146: '¶' => '\partial',
147: '·' => '\cdot',
148: '¹' => '\not=',
149: 'º' => '\equiv',
150: '»' => '\approx',
151: 'Ä' => '\otimes',
152: 'Å' => '\oplus',
153: 'Æ' => '\emptyset',
154: 'Ç' => '\cap',
155: 'È' => '\cup',
156: 'É' => '\supset',
157: 'Ê' => '\supseteq',
158: 'Ë' => '\not\subset',
159: 'Ì' => '\subset',
160: 'Í' => '\subseteq',
161: 'Î' => '\in',
162: 'Ï' => '\not\in',
163: 'Ð' => '\angle',
164: 'Ñ' => '\nabla',
165: 'Õ' => '\prod',
166: 'Ö' => '\surd',
167: '×' => '\cdot',
168: 'Ù' => '\wedge',
169: 'Ú' => '\wee',
170: 'å' => '\sum',
171: 'ò' => '\int',
172: 'á' => '\langle',
173: 'ñ' => '\rangle',
174: 'à' => '\diamondsuit',
175: '§' => '\clubsuit',
176: '¨' => '\diamondsuit',
177: '©' => '\heartsuit',
178: 'ª' => '\spadesuit'
179: );
180: my $output='';
181: my $char='';
182: my $entitymode=0;
183: for (my $i=0; $i<length($symbolfont); $i++) {
184: my $newchar=substr($symbolfont,$i,1);
185: $char.=$newchar;
186: if ($newchar eq '&') { $entitymode=1; }
187: if (($entitymode) && ($newchar ne ';')) { next; }
188: my $latex=$latexsymb{$char};
189: if ($latex) {
190: $output.=$latex;
191: } else {
192: $output.=$char;
193: }
194: $char='';
195: $entitymode=0;
196: }
197: return $output;
198: }
199:
200: sub insidetrans {
201: my @args=@_;
202: return '<font'.$args[0].$args[1].'><m>$'.&latextrans($args[2]).'$</m>';
203: }
204:
205: sub symbolfontreplace {
206: my $text=shift;
207: my @fragments=split(/\<\/font\>/si,$text);
208: for (my $i=0; $i<=$#fragments;$i++) {
209: $fragments[$i]=~s/\<font([^\>]*)\s+face=[\"\']*symbol[\"\']*([^\>]*)\>(.*)$/&insidetrans($1,$2,$3)/gsie;
210: }
211: return join('</font>',@fragments);
212: }
213:
214: sub htmlclean {
1.2 www 215: my ($raw,$full,$blocklinefeed,$blockemptytags,$blocklowercasing,$blockdesymboling)=@_;
1.1 www 216: # Take care of CRLF etc
1.2 www 217: unless ($blocklinefeed) {
218: $raw=~s/\r\f/\n/gs; $raw=~s/\f\r/\n/gs;
219: $raw=~s/\r\n/\n/gs; $raw=~s/\n\r/\n/gs;
220: $raw=~s/\f/\n/gs; $raw=~s/\r/\n/gs;
221: $raw=~s/\&\#10\;/\n/gs; $raw=~s/\&\#13\;/\n/gs;
222: }
1.1 www 223: # Generate empty tags, remove wrong end tags
1.2 www 224: unless ($blockemptytags) {
1.6 www 225: $raw=~s/\<(br|hr|img|meta|embed|allow|basefont)([^\>]*?)\>/\<$1$2 \/\>/gis;
226: $raw=~s/\<\/(br|hr|img|meta|embed|allow|basefont)\>//gis;
227: $raw=~s/\/ \/\>/\/\>/gs;
1.2 www 228: unless ($full) {
229: $raw=~s/\<[\/]*(body|head|html)\>//gis;
230: }
1.1 www 231: }
232: # Make standard tags lowercase
1.2 www 233: unless ($blocklowercasing) {
234: foreach ('html','body','head','meta','h1','h2','h3','h4','b','i','m',
235: 'table','tr','td','th','p','br','hr','img','embed','font',
236: 'a','strong','center','title','basefont','li','ol','ul',
237: 'input','select','form','option','script','pre') {
238: $raw=~s/\<$_\s*\>/\<$_\>/gis;
239: $raw=~s/\<\/$_\s*\>/<\/$_\>/gis;
240: $raw=~s/\<$_\s([^\>]*)\>/<$_ $1\>/gis;
241: }
242: }
243: # Replace <font face="symbol">
244: unless ($blockdesymboling) {
245: $raw=&symbolfontreplace($raw);
1.1 www 246: }
247: return $raw;
248: }
249:
250: sub phaseone {
1.2 www 251: my ($r,$fn,$uname,$udom)=@_;
1.11 bisitz 252: $r->print(
253: &Apache::lonhtmlcommon::start_pick_box()
254: .&Apache::lonhtmlcommon::row_title(&mt('Select actions to attempt'))
255: .'<input type="checkbox" name="linefeed" checked="checked" /> '
256: .&mt('Linefeeds, formfeeds, and carriage returns')
257: .'<br />'
258: .'<input type="checkbox" name="empty" checked="checked" /> '
259: .&mt('Empty tags')
260: .'<br />'
261: .'<input type="checkbox" name="lower" checked="checked" /> '
262: .&mt('Lower casing')
263: .'<br />'
264: .'<input type="checkbox" name="symbol" checked="checked" /> '
265: .&mt('Symbol font')
266: .&Apache::lonhtmlcommon::row_closure(1)
267: .&Apache::lonhtmlcommon::end_pick_box()
268: );
269:
270: $r->print(
271: '<input type="hidden" name="phase" value="two" />'
272: .'<p>'
273: .'<input type="submit" value="'.&mt('Next').'" />'
274: .'</p>'
275: );
1.1 www 276: }
277:
278: sub phasetwo {
1.11 bisitz 279: # Check original file
1.2 www 280: my ($r,$fn,$uname,$udom)=@_;
1.4 www 281: my $text='';
1.14 raeburn 282: my $londocroot = $r->dir_config('lonDocRoot');
283: if (open(IN,"<$londocroot/priv/$udom/$uname".$fn)) {
284: while (my $line=<IN>) {
285: $text.=$line;
286: }
287: close(IN);
1.4 www 288: }
1.14 raeburn 289: my $uri="/priv/$udom/$uname".$fn;
1.4 www 290: my $result=&Apache::lonnet::ssi_body($uri,
291: ('grade_target'=>'web',
292: 'return_only_error_and_warning_counts' => 1));
293: my ($errorcount,$warningcount)=split(':',$result);
1.11 bisitz 294:
295: # Display results for original file
296: $r->print(
297: &Apache::lonhtmlcommon::start_pick_box()
298: .&Apache::lonhtmlcommon::row_title(&mt('Original file'))
299: .&Apache::lonhtmlcommon::confirm_success(
300: &mt('[quant,_1,error]',$errorcount), $errorcount)
301: .'<br />'
302: .&Apache::lonhtmlcommon::confirm_success(
303: &mt('[quant,_1,warning]',$warningcount), $warningcount)
304: .&Apache::lonhtmlcommon::row_closure()
305: );
306:
307: # Clean up file
1.4 www 308: $text=&htmlclean($text,1,
309: ($env{'form.linefeed'} ne 'on'),
310: ($env{'form.empty'} ne 'on'),
311: ($env{'form.lower'} ne 'on'),
312: ($env{'form.symbol'} ne 'on'));
313: my ($main,$ext)=($fn=~/^(.*)\.(\w+)/);
314: my $newfn=$main.'_Auto_Cleaned_Up.'.$ext;
1.14 raeburn 315: if (open(OUT,">$londocroot/priv/$udom/$uname".$newfn)) {
316: print OUT $text;
317: close(OUT);
318: }
319: my $newuri="/priv/$udom/$uname".$newfn;
1.4 www 320: $result=&Apache::lonnet::ssi_body($newuri,
1.11 bisitz 321: ('grade_target'=>'web',
322: 'return_only_error_and_warning_counts' => 1));
1.4 www 323: ($errorcount,$warningcount)=split(':',$result);
1.11 bisitz 324:
325: # Display results for cleaned up file
326: $r->print(
327: &Apache::lonhtmlcommon::row_title(&mt('Cleaned up file'))
328: .&Apache::lonhtmlcommon::confirm_success(
329: &mt('[quant,_1,error]',$errorcount), $errorcount)
330: .'<br />'
331: .&Apache::lonhtmlcommon::confirm_success(
332: &mt('[quant,_1,warning]',$warningcount), $warningcount)
333: .&Apache::lonhtmlcommon::row_closure()
334: );
335:
336: # Display actions
337: $r->print(
338: &Apache::lonhtmlcommon::row_title(&mt('Actions'))
339: .'<ul>'
340: .'<li><a href="'.$newuri.'" target="prev">'
341: .&mt('Open (and edit) cleaned up file in new window')
342: .'</a></li>'
343: .'<li><a href="/adm/diff?filename='.&escape($uri)
344: .'&versionone=priv&filetwo='.&escape($newuri).'" target="prev">'
345: .&mt('Show diffs in new window')
346: .'</a></li>'
347: .'</ul>'
348: .&Apache::lonhtmlcommon::row_closure(1)
349: .&Apache::lonhtmlcommon::end_pick_box()
350: .'<p>'
351: .'<input type="hidden" name="phase" value="three" />'
352: .'<input type="submit" name="accept" value="'
353: .&mt('Clean Up').'" />'
354: .' <input type="submit" name="reject" value="'
355: .&mt('Cancel').'" />'
356: .'</p>'
357: );
1.2 www 358: }
359:
360: sub phasethree {
361: my ($r,$fn,$uname,$udom)=@_;
1.14 raeburn 362: my $old=$r->dir_config('lonDocRoot')."/priv/$udom/$uname".$fn;
1.4 www 363: my ($main,$ext)=($fn=~/^(.*)\.(\w+)/);
364: my $newfn=$main.'_Auto_Cleaned_Up.'.$ext;
1.14 raeburn 365: my $new=$r->dir_config('lonDocRoot')."/priv/$udom/$uname".$newfn;
1.4 www 366: if ($env{'form.accept'}) {
1.11 bisitz 367: $r->print(
368: '<p class="LC_info">'
369: .&mt('Accepting changes')
370: .'</p>'
371: );
1.4 www 372: move($new,$old);
373: } else {
1.11 bisitz 374: $r->print(
375: '<p class="LC_info">'
376: .&mt('Rejecting changes')
377: .'</p>'
378: );
1.4 www 379: unlink($new);
380: }
1.1 www 381: }
382:
383: # ---------------------------------------------------------------- Main Handler
384: sub handler {
385:
1.3 albertel 386: my $r=shift;
1.4 www 387: my $fn='';
1.1 www 388:
389: # Get query string for limited number of parameters
390:
1.3 albertel 391: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
392: ['filename']);
1.1 www 393:
1.3 albertel 394: if ($env{'form.filename'}) {
395: $fn=$env{'form.filename'};
1.15 raeburn 396: $fn=~s{^https?\://[^/]+}{};
1.3 albertel 397: } else {
398: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
399: ' unspecified filename for cleanup', $r->filename);
400: return HTTP_NOT_FOUND;
401: }
402:
403: unless ($fn) {
404: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
405: ' trying to cleanup non-existing file', $r->filename);
406: return HTTP_NOT_FOUND;
407: }
1.1 www 408:
409: # ----------------------------------------------------------- Start page output
1.3 albertel 410: my $uname;
411: my $udom;
412:
1.13 www 413: ($uname,$udom)=&Apache::loncacc::constructaccess($fn);
1.3 albertel 414: unless (($uname) && ($udom)) {
415: $r->log_reason($uname.' at '.$udom.
416: ' trying to cleanup file '.$env{'form.filename'}.
417: ' ('.$fn.') - not authorized',
418: $r->filename);
419: return HTTP_NOT_ACCEPTABLE;
420: }
421:
422: &Apache::loncommon::content_type($r,'text/html');
423: $r->send_http_header;
424:
1.11 bisitz 425: # Breadcrumbs
1.16 ! raeburn 426: my $brcrum = [{'href' => &Apache::loncommon::authorspace($fn),
1.11 bisitz 427: 'text' => 'Construction Space'},
428: {'href' => '',
429: 'text' => 'Cleanup XML Document'}];
430:
1.16 ! raeburn 431: $fn=~s{^/priv/$LONCAPA::domain_re/$LONCAPA::username_re}{};
! 432:
1.11 bisitz 433: $r->print(&Apache::loncommon::start_page('Cleanup XML Document',
434: undef,
435: {'bread_crumbs' => $brcrum,}));
1.4 www 436: $r->print('<h2>'.$fn.'</h2>'.
437: '<form action="/adm/cleanup" method="post">'.
438: '<input type="hidden" name="filename" value="'.$env{'form.filename'}.'" />');
439: unless ($fn=~/\.(problem|exam|quiz|assess|survey|form|library|xml|html|htm|xhtml|xhtm|sty)$/) {
440: $r->print(&mt('Cannot cleanup this filetype'));
1.3 albertel 441: } else {
1.4 www 442: if ($env{'form.phase'} eq 'three') {
443: &phasethree($r,$fn,$uname,$udom);
444: } elsif ($env{'form.phase'} eq 'two') {
445: &phasetwo($r,$fn,$uname,$udom);
446: } else {
447: &phaseone($r,$fn,$uname,$udom);
448: }
1.3 albertel 449: }
1.4 www 450: my $dir=$fn;
1.14 raeburn 451: $dir=~s{[^/]+$}{};
1.11 bisitz 452: $r->print(
453: '</form>'
454: .&Apache::lonhtmlcommon::start_funclist()
455: .&Apache::lonhtmlcommon::add_item_funclist(
1.14 raeburn 456: '<a href="/priv/'.$udom.'/'.$uname.$fn.'">'.&mt('Back to Source File').'</a>')
1.11 bisitz 457: .&Apache::lonhtmlcommon::add_item_funclist(
1.14 raeburn 458: '<a href="/priv/'.$udom.'/'.$uname.$dir.'">'.&mt('Back to Source Directory').'</a>')
1.11 bisitz 459: .&Apache::lonhtmlcommon::end_funclist()
460: .&Apache::loncommon::end_page()
461: );
462:
1.3 albertel 463: return OK;
1.1 www 464: }
465:
466: 1;
467: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to loncleanup.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher