#!/usr/bin/perl # spellerpages script - adapted to use FindBin; and CGI::Simple in place of CGI use lib ( '/home/raj/perl-lib', '/home/raj/perl5/lib/perl5', ); use File::Temp qw(tempfile tempdir); use Modern::Perl qw(2012); use CGI::Simple::Cookie; use Storable qw(thaw); use FindBin qw($Bin); # warn $Bin; use DBIx::Simple; use Data::Printer; use CGI::Simple; use Path::Tiny; use Local::DB; open my $debug, '>', path($Bin, '..', 'logs', 'debug.txt')->realpath; my $q = new CGI::Simple; my $spellercss = '/speller/spellerStyle.css'; my $wordWindowSrc = '/speller/wordWindow.js'; my @textinputs = $q->param( 'textinputs[]' ); # array my $aspell_cmd = 'aspell'; my $lang = 'en_GB'; my $input_separator = 'A'; my $dicts_dir = path($Bin, '..', 'static', 'speller', 'dicts')->realpath; my $medical = path($dicts_dir, 'en-medical.rws'); my @aspell_opts = ( '-a', "--lang=$lang", '--encoding=utf-8', "--home-dir=$dicts_dir", "--extra-dicts=$medical", # loaded but doesn't appear in Text::Aspell::print_config() ); # if user_profile retrived from session, add personal dict: if ( my $user_profile = _get_user_profile() ) { my $user_centre = $user_profile->{user_location}->{centre}; push @aspell_opts, "--personal=.aspell.$user_centre.pws"; } my $aspell_opts = join " ", @aspell_opts; # print $debug $aspell_opts; # set the 'wordtext' JavaScript variable to the submitted text. sub printTextVar { for( my $i = 0; $i <= $#textinputs; $i++ ) { print "textinputs[$i] = decodeURIComponent('" . escapeQuote( $textinputs[$i] ) . "')\n"; } } sub printTextIdxDecl { my $idx = shift; print "words[$idx] = [];\n"; print "suggs[$idx] = [];\n"; } sub printWordsElem { my( $textIdx, $wordIdx, $word ) = @_; print "words[$textIdx][$wordIdx] = '" . escapeQuote( $word ) . "';\n"; } sub printSuggsElem { my( $textIdx, $wordIdx, @suggs ) = @_; print "suggs[$textIdx][$wordIdx] = ["; for my $i ( 0..$#suggs ) { print "'" . escapeQuote( $suggs[$i] ) . "'"; if( $i < $#suggs ) { print ", "; } } print "];\n"; } sub printCheckerResults { my $textInputIdx = -1; my $wordIdx = 0; my $unhandledText; # create temp file my $dir = tempdir( CLEANUP => 1 ); my( $fh, $tmpfilename ) = tempfile( DIR => $dir ); # temp file was created properly? # open temp file, add the submitted text. for( my $i = 0; $i <= $#textinputs; $i++ ) { my $text = url_decode( $textinputs[$i] ); my @lines = split( /\n/, $text ); print $fh "\%\n"; # exit terse mode print $fh "^$input_separator\n"; print $fh "!\n"; # enter terse mode for my $line ( @lines ) { # use carat on each line to escape possible aspell commands print $fh "^$line\n"; } } # exec aspell command my $cmd = "$aspell_cmd $aspell_opts < $tmpfilename 2>&1"; open ASPELL, "$cmd |" or handleError( "Could not execute `$cmd`\\n$!" ) and return; # parse each line of aspell return for my $ret ( ) { chomp( $ret ); # if '&', then not in dictionary but has suggestions # if '#', then not in dictionary and no suggestions # if '*', then it is a delimiter between text inputs if( $ret =~ /^\*/ ) { $textInputIdx++; printTextIdxDecl( $textInputIdx ); $wordIdx = 0; } elsif( $ret =~ /^(&|#)/ ) { my @tokens = split( " ", $ret, 5 ); printWordsElem( $textInputIdx, $wordIdx, $tokens[1] ); my @suggs = (); if( $tokens[4] ) { @suggs = split( ", ", $tokens[4] ); } printSuggsElem( $textInputIdx, $wordIdx, @suggs ); $wordIdx++; } else { $unhandledText .= $ret; } } close ASPELL or handleError( "Error executing `$cmd`\\n$unhandledText" ) and return; } sub escapeQuote { my $str = shift; $str =~ s/'/\\'/g; return $str; } sub handleError { my $err = shift; print "error = '" . escapeQuote( $err ) . "';\n"; } sub url_decode { local $_ = @_ ? shift : $_; defined or return; # change + signs to spaces tr/+/ /; # change hex escapes to the proper characters s/%([a-fA-F0-9]{2})/pack "H2", $1/eg; return $_; } # manually retrieve db.sessions.a_session using CGISESSID cookie: sub _get_user_profile { my @dsn = Local::DB->dsn({ dbname => 'hilis4' }); # p @dsn; my $dbix = DBIx::Simple->new(@dsn);# p $dbix; my %cookies = CGI::Simple::Cookie->fetch; my $sessid = $cookies{CGISESSID}->value; my @params = ( 'a_session', { id => $sessid } ); $dbix->select('sessions', @params)->into(my $session); # p $session; # or, look in other db's - TODO: lousy method but need session to get location! if (! $session ) { DB: for my $db( qw/uclh/ ) { # print $debug $db, "\n"; $dbix->select("$db.sessions", @params)->into($session); last DB if $session; } } if ($session) { my $user_profile = thaw($session)->{UserProfile}; # only if fastcgi process return $user_profile; } return 0; } # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # Display HTML # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # print < EOF