File:  [LON-CAPA] / loncom / publisher / loncleanup.pm
Revision 1.16: download - view: text, annotated - select for diffs
Mon Nov 14 00:20:31 2011 UTC (12 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: language_hyphenation_merge, language_hyphenation, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse
- &authorspace() routine now takes an argument: $uri
  so "Construction Space" breadcrumb points at appropriate author space
  for resource/directory being viewed or acted om.
  - current role could be different or ("no role" - i.e., cm), so is only
    used to determine authorspace when $uri is unavailable.

    1: # The LearningOnline Network with CAPA
    2: # Handler to cleanup XML files
    3: #
    4: # $Id: loncleanup.pm,v 1.16 2011/11/14 00:20:31 raeburn Exp $
    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::lonhtmlcommon();
   40: use Apache::lonlocal;
   41: use Apache::lonnet;
   42: use lib '/home/httpd/lib/perl/';
   43: use LONCAPA;
   44:  
   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 {
  215:     my ($raw,$full,$blocklinefeed,$blockemptytags,$blocklowercasing,$blockdesymboling)=@_;
  216: # Take care of CRLF etc
  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:     }
  223: # Generate empty tags, remove wrong end tags
  224:     unless ($blockemptytags) {
  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;
  228: 	unless ($full) {
  229: 	    $raw=~s/\<[\/]*(body|head|html)\>//gis;
  230: 	}
  231:     }
  232: # Make standard tags lowercase
  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);
  246:     }
  247:     return $raw;
  248: }
  249: 
  250: sub phaseone {
  251:     my ($r,$fn,$uname,$udom)=@_;
  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:     );
  276: }
  277: 
  278: sub phasetwo {
  279:     # Check original file
  280:     my ($r,$fn,$uname,$udom)=@_;
  281:     my $text='';
  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);
  288:     }
  289:     my $uri="/priv/$udom/$uname".$fn;
  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);
  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
  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;
  315:     if (open(OUT,">$londocroot/priv/$udom/$uname".$newfn)) {
  316:         print OUT $text;
  317:         close(OUT);
  318:     }
  319:     my $newuri="/priv/$udom/$uname".$newfn;
  320:     $result=&Apache::lonnet::ssi_body($newuri,
  321:                                          ('grade_target'=>'web',
  322:                                           'return_only_error_and_warning_counts' => 1));
  323:     ($errorcount,$warningcount)=split(':',$result);
  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:     );
  358: }
  359: 
  360: sub phasethree {
  361:     my ($r,$fn,$uname,$udom)=@_;
  362:     my $old=$r->dir_config('lonDocRoot')."/priv/$udom/$uname".$fn;
  363:     my ($main,$ext)=($fn=~/^(.*)\.(\w+)/);
  364:     my $newfn=$main.'_Auto_Cleaned_Up.'.$ext;
  365:     my $new=$r->dir_config('lonDocRoot')."/priv/$udom/$uname".$newfn;
  366:     if ($env{'form.accept'}) {
  367: 	$r->print(
  368:         '<p class="LC_info">'
  369:        .&mt('Accepting changes')
  370:        .'</p>'
  371:     );
  372:         move($new,$old);
  373:     } else {
  374: 	$r->print(
  375:         '<p class="LC_info">'
  376:        .&mt('Rejecting changes')
  377:        .'</p>'
  378:     );
  379:         unlink($new);
  380:     }
  381: }
  382: 
  383: # ---------------------------------------------------------------- Main Handler
  384: sub handler {
  385: 
  386:     my $r=shift;
  387:     my $fn='';
  388: 
  389: # Get query string for limited number of parameters
  390: 
  391:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  392: 					    ['filename']);
  393: 
  394:     if ($env{'form.filename'}) {
  395: 	$fn=$env{'form.filename'};
  396: 	$fn=~s{^https?\://[^/]+}{};
  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:     } 
  408: 
  409: # ----------------------------------------------------------- Start page output
  410:     my $uname;
  411:     my $udom;
  412: 
  413:     ($uname,$udom)=&Apache::loncacc::constructaccess($fn);
  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: 
  425:     # Breadcrumbs
  426:     my $brcrum = [{'href' => &Apache::loncommon::authorspace($fn),
  427:                    'text' => 'Construction Space'},
  428:                   {'href' => '',
  429:                    'text' => 'Cleanup XML Document'}];
  430: 
  431:     $fn=~s{^/priv/$LONCAPA::domain_re/$LONCAPA::username_re}{};
  432: 
  433:     $r->print(&Apache::loncommon::start_page('Cleanup XML Document',
  434:                                              undef,
  435:                                              {'bread_crumbs' => $brcrum,}));
  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'));
  441:     } else {
  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: 	}
  449:     }
  450:     my $dir=$fn;
  451:     $dir=~s{[^/]+$}{};
  452:     $r->print(
  453:         '</form>'
  454:        .&Apache::lonhtmlcommon::start_funclist()
  455:        .&Apache::lonhtmlcommon::add_item_funclist(
  456:             '<a href="/priv/'.$udom.'/'.$uname.$fn.'">'.&mt('Back to Source File').'</a>')
  457:        .&Apache::lonhtmlcommon::add_item_funclist(
  458:             '<a href="/priv/'.$udom.'/'.$uname.$dir.'">'.&mt('Back to Source Directory').'</a>')
  459:        .&Apache::lonhtmlcommon::end_funclist()
  460:        .&Apache::loncommon::end_page()
  461:     );
  462: 
  463:     return OK;  
  464: }
  465: 
  466: 1;
  467: __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>