[Israel.pm] rapid CGI application

[Shlomo Yona]

On Fri, 18 Feb 2005, Gabor Szabo wrote:

> On Wed, 16 Feb 2005, Shlomo Yona wrote:
>
>> Hello,
>> 
>> Well... as the application's development was supposed to be
>> rapid, I've already developed it :-)
>> 
>> Those of you who might have interest in the code, please
>> email me off-list. Unless, of course, there's interest in
>> the list to see such code.
>
> please send us the code

Here you go:

[...begin code...]

#!/usr/local/perl/bin/perl
use strict;
use warnings;
use CGI;
use Fcntl ':flock';
use utf8;
use Encode;

my $charset='UTF-8';
my $title='Annotation:';
#my $filename = 'test.txt';
#my $filename = 'analyzed.tokens.aa.txt';
#my $filename = 'analyzed.tokens.ab.txt';
#my $filename = 'analyzed.tokens.ac.txt';
my $filename = 'analyzed.tokens.ad.txt';
my $no_lock = "yes";
my $q = CGI->new;

my $backup_name="dummy";

if ($q->param()) { # this means that data is submitted via form
 	$backup_name=update_file_with_annotations($q,$filename);
}
post_annotation_HTML($q,$filename); # anyway, read the file's contents and post as HTML to the user

unlink $backup_name if -f $backup_name;
exit 0;

sub update_file_with_annotations {
 	my ($q,$filename) = @_;
 	my $num_lines = count_lines($filename);
 	chomp $num_lines;
 	my @file_content;
 	for (my $i=1; $i<=$num_lines; ++$i) {
 		my $line_number = $i;
 		my $q1 = $q->param("q1_$line_number");
 		my $q2 = $q->param("q2_$line_number");
 		my $text = $q->param("text_$line_number");
 		if (not ($q1 or $q2 or $text)) {
 			push @file_content,"\n";
 			next;
 		}
 		dieweb ("problems reading q1_$line_number from param()\n") unless $q1;
 		dieweb ("problems reading q2_$line_number from param()\n") unless $q2;
 		dieweb ("problems reading text_$line_number from param()\n") unless $text;
 		push @file_content,"$q1\t$q2\t$text\n";
 	}
 	my $backup_name = backup_file($filename);
 	write_lines_to_file($filename,\@file_content);
 	return $backup_name;
}

sub count_lines {
 	my ($filename) = @_;
 	my $lines = 0;
 	my $buffer;
 	open(IN,"<:utf8",$filename) or dieweb("Cannot open $filename : $!");
 	flock(IN,LOCK_EX) unless $no_lock eq "yes";
 	while (sysread IN, $buffer, 4096) {
 		$lines += ($buffer =~ tr/\n//);
 	}
 	flock(IN,LOCK_UN) unless $no_lock eq "yes";
 	close(IN);
 	return $lines;
}

sub backup_file {
 	my ($filename) = @_;
 	use File::Copy;
 	my $from = $filename;
 	my $to = "$filename.$$";
 	File::Copy::copy($from,$to) or dieweb("Problems while trying to copy |$from| to |$to|\n");
 	return $to;
}

sub write_lines_to_file {
 	my ($filename,$lines) = @_;
 	open(OUT,">:utf8",$filename) or dieweb("Cannot open $filename : $!");
 	flock(OUT,LOCK_EX) unless $no_lock eq "yes";
 	foreach my $line (@$lines) {
 		print OUT $line;
 	}
 	flock(OUT,LOCK_UN) unless $no_lock eq "yes";
 	close(OUT);
}


sub post_annotation_HTML {
 	my ($q,$filename) = @_;
 	my $lines = get_lines_from_file($filename);
 	my $html = do_html($q,$lines);
 	binmode STDOUT,":utf8";
 	print $html;
}

sub do_html {
 	my ($q,$lines) = @_;
 	my $html =
 			$q->header(-charset=>$charset) .
 			$q->start_html(
 					-encoding=> $charset,
 					-head=>$q->meta({-http_equiv => 'Content-Type',-content=>"text/html; charset=$charset"}),
 					-title=>$title
 			) .
 			'<span dir="ltr">' .
 			'<h1>' .
 			$title .
 			'</h1>' .
 			get_lines_header() .
 			get_lines($lines) .
 			get_lines_footer() .
 			$q->end_html
 	;
 	return $html;
}

sub get_lines_header {
 	return qq{\n
<form action="http://mila.cs.technion.ac.il/cgi-bin/annotate.cgi.pl" method="post" accept-charset="UTF-8">
 	<table border="1">
 	\n};
}

sub get_lines {
 	my ($lines) = @_;
 	my $html_lines='';
 	my $line_count=0;
 	foreach my $line (@$lines) {
 		++$line_count;
 		if ($line=~m/^\s*$/) {
 			$html_lines.=do_blank_line();
 			next;
 		}
 		my ($q1,$q2,$text) = ($line=~/^([YN])\s+([YN])\s+(.+)\s+$/s);
 		dieweb ("problems parsing q1 while reading line #$line_count:\n$line\n") unless $q1;
 		dieweb ("problems parsing q2 while reading line #$line_count:\n$line\n") unless $q2;
 		dieweb ("problems parsing text while reading line #$line_count:\n$line\n") unless $text;
 		$html_lines.=do_line($line_count,$q1,$q2,$text);
 	}
 	return $html_lines;
}

sub do_blank_line {
 	return qq{\n<tr><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td><td>&nbsp;</td></tr>\n};
}

sub do_line {
 	my ($line_count,$q1,$q2,$text) = @_;
 	my $line='';
 	$line .= qq{\n<tr><td><input type="submit" value="S" /></td><td>$line_count</td><td align="right">Correct?<select name="q1_$line_count">};
 	if ("N" eq $q1) {
 		$line.=qq{<option value="N" selected="selected">N</option><option value="Y">Y</option>};
 	} else {
 		$line.=qq{<option value="N">N</option><option value="Y" selected="selected">Y</option>};
 	}
 	$line.=qq{</select></td><td>Error<select name="q2_$line_count">};
 	if ("N" eq $q2) {
 		$line.=qq{<option value="N" selected="selected">N</option><option value="Y">Y</option>};
 	} else {
 		$line.=qq{<option value="N">N</option><option value="Y" selected="selected">Y</option>};
 	}
 	my $escaped_text=Encode::decode("utf8",$q->escapeHTML($text));
#	my $escaped_text=$q->escapeHTML($text);
 	$line.=qq{</select></td><td><input name="text_$line_count" value="$escaped_text" type="hidden" />$escaped_text</td></tr>\n};
 	return $line;
}

sub get_lines_footer {
 	return qq{\n
 	</table>
</form>
 	\n};
}

sub get_lines_from_file {
 	my ($filename) = @_;
 	open(IN,"<:utf8",$filename) or dieweb("Cannot open $filename : $!");
 	flock(IN,LOCK_EX) unless $no_lock eq "yes";
 	my @lines=<IN>;
 	flock(IN,LOCK_UN) unless $no_lock eq "yes";
 	close(IN);
 	return \@lines;
}


sub dieweb {
 	my ($msg)=@_;
 	print $q->header(-charset=>$charset), $q->start_html(-encoding=> $charset,-head=>$q->meta({-http_equiv => 'Content-Type',-content=>"text/html; charset=$charset"}),-title=>$title),$q->h1($title);
 	print '<h2><font color="red">',$msg,'</font></h2></body></html>';
 	exit 0;
}

[...end code...]

-- 
Shlomo Yona
shlomo at cs.haifa.ac.il
http://cs.haifa.ac.il/~shlomo/