'readdatafile', 'writedatafile', 'printdatafile',
'printdatafileht', # TO REMOVE ???
'urlencode', # TO REMOVE
- 'linehtml',
+ 'linehtml', # TO REMOVE
'bb2ht', 'bb2bb'
);
###PERL_LIB: use lib /botm/lib/bsta
use botm_common (
+ 'url_query_decode', 'url_query_encode',
+ 'url_decode', 'url_encode',
'html_entity_encode_dec',
- 'merge_url', 'url_query_encode'
+ 'merge_url',
+ 'read_header_env',
+ 'read_data_file', 'write_data_file'
);
###PERL_CGI_GOTO_PATH: CGI_GOTO_PATH = /bsta/g
# function to encode entities, decimal,
sub entityencode {
(my $t, my $all) = @_;
- if ($all) {
- $t =~ s/(.)/sprintf('\&#%02hu;',ord($1))/eg;
- }
- else {
- $t =~ s/([\"=><\&])/sprintf('&#%02hu;',ord($1))/eg;
- }
- return $t;
+ return html_entity_encode_dec($t, 1, $all);
}
# TO REMOVE
sub gethttpheader {
(my $env) = @_;
- my %http;
-
- foreach my $ind (keys %$env) {
- my $name = '';
- my $value= '';
-
- if ($ind =~ /^HTTP_([A-Z0-9_]+)$/) {
- $name=$1;
- }
- elsif ($ind =~ /^(CONTENT_[A-Z0-9_]+)$/) {
- $name=$1;
- }
- else{
- next;
- }
- $name =~ s/_/-/g;
- $name = lc($name);
- if ($$env{$ind} =~ /^([\x20-\x7e]*)$/) {
- $value=$1;
- }
- else {
- next;
- }
- $http{$name}=$value;
- }
- return %http;
+ return read_header_env($env);
}
# TO REMOVE
# The function to get CGI parameters from string.
# Format is: name=url_encoded_value&name=url_encoded_value& ... &name=url_encoded_value
sub getcgi {
- my $arg;
- my $val;
- my %cgi;
- my $i = $_[0];
- $i =~ s/[\r\n]//g;
- my @s = split('&',$i);
- foreach my $l ( @s) {
- ($arg,$val)=split('=',$l);
- $cgi{$arg}=urldecode($val);
- }
- return %cgi;
+ return url_query_decode($_[0]);
}
# TO REMOVE
# Function for decoding URL-encoded text
sub urldecode {
- my $t = $_[0];
- $t =~ s/\+/ /g;
- $t =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/eg;
- return $t;
+ return url_decode($_[0]);
}
# TO REMOVE
#
sub readdatafile {
(my $datapath) = @_;
- my $datafile;
- my %data;
- my $eoh=0;
-
- # check if $datapath is actually a path or maybe a filehandle
- # filehandles are references.
- if(ref($datapath)) {
- $datafile=$datapath;
- unless (seek($datafile, 0, 0)) {
- return %data;
- }
- }
- else {
- unless (open ($datafile, "<", $datapath)) {
- return %data;
- }
- }
-
- # The name of header field in previous line. Required for header fields that
- # occupy multiple lines.
- my $lastname='';
-
- while (defined(my $line = <$datafile>)) {
- my $name='';
- my $value='';
-
- if ($eoh){
- unless($line eq'') {
- $data{'content'} = $data{'content'}.$line;
- }
- next;
- }
-
- $line =~ s/[\n]$//g;
-
- # Empty line - end of header.
- if ($line eq ''){
- $eoh=1;
- }
- # Line starts with whitespace. It's a continuation of the previous line.
- # Concatenate the field value, separated by newline.
- elsif($line =~ /^[ \t](.*)$/){
- if($lastname ne '') {
- $data{$lastname}.="\n".$1;
- }
- }
- # Line starts with a name followed by colon/equal sign. Save the value
- elsif ($line =~ /^([^:=]+)((:[ \t])|=)(.*)$/) {
- $name = lc($1);
- $value = $4;
-
- $data{$name}=$value;
-
- $lastname = $name;
- }
- }
-
- # If argument was a path the file must be closed.
- unless (ref($datapath)) {
- close ($datafile);
- }
- return %data;
+ return read_data_file($datapath);
}
# TO REMOVE
#
sub writedatafile {
(my $headerpath, my %header) = @_;
- my $headerfile;
- if(ref($headerpath)) {
- $headerfile=$headerpath;
- unless (seek($headerfile, 0, 0)) {
- return 0;
- }
- }
- else {
- unless (open ($headerfile, ">", $headerpath)) {
- return 0;
- }
- }
-
- foreach my $ind (keys %header) {
- unless($ind eq 'content') {
- my $headname = $ind;
- my $headval = $header{$ind};
- $headval =~ s/\r//g;
- $headval =~ s/\n/\n /g;
- print $headerfile "$headname: $headval\n";
- }
- }
- print $headerfile "\n".$header{'content'};
-
- unless (ref($headerpath)) {
- close ($headerfile);
- }
- else {
- truncate ($headerfile , tell($headerfile));
- }
-
- return 1;
+ return write_data_file($headerpath, '', 0, \%header);
}
# TO REMOVE
sub printdatafile {
(my %header) = @_;
- foreach my $ind (keys %header) {
- unless($ind eq 'content') {
- my $headname = $ind;
- my $headval = $header{$ind};
- $headval =~ s/\r//g;
- $headval =~ s/\n/\n /g;
- print "$headname: $headval\n";
- }
- }
- print "\n".$header{'content'};
-
- return 1;
+ return write_data_file(\*STDOUT, '', 0, \%header);
}
-# TO REMOVE ???
+# TO REMOVE
# the function to print data to stdout as html (see readdatafile() description)
#
# On success returns 1.
sub printdatafileht {
(my %header) = @_;
- foreach my $ind (keys %header) {
- unless($ind eq 'content') {
- my $headname = $ind;
- my $headval = $header{$ind};
- $headval =~ s/\r//g;
- $headval =~ s/\n/\n /g;
- print linehtml("$headname: $headval\n");
- }
- }
- print linehtml("\n".$header{'content'});
-
+ print_html_data(\*STDOUT, \%header);
return 1;
}
# TO REMOVE
sub urlencode {
(my $t, my $all) = @_;
- if ($all) {
- $t =~ s/(.)/sprintf('%%%02hX',ord($1))/eg;
- }
- else {
- $t =~ s/([^0-9A-Za-z.~\-_])/sprintf('%%%02hX',ord($1))/eg;
- }
- return $t;
+ return url_encode($t, '', $all);
}
#analyse bbcode text to build tag tree #TODO make [/*] optional!
#normal text
if($bbtree{$ind.'.t'} eq 'tx') {
$debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
- $ht = $ht.($escape?(linehtml($bbtree{$ind.'.v'})):($bbtree{$ind.'.v'}));
+ $ht .= $escape ? (html_encode_line($bbtree{$ind.'.v'})) : ($bbtree{$ind.'.v'});
{do{
$ind =~ s/\.([0-9]+)$//;
}
else {
$debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
- $ht = $ht.'['.($escape?linehtml($bbtree{$ind.'.n'}):$bbtree{$ind.'.n'}).']';
+ $ht .= '['.($escape?html_encode_line($bbtree{$ind.'.n'}):$bbtree{$ind.'.n'}).']';
}
if($bbtree{$ind.'.e'}>0) {
$ind = $ind.'.0';
# $debug .= debug($printdebug, "[$level:$ind:".int($bbtree{$ind.'.e'})."]");
# if($bbtree{$ind.'.t'} eq 'tx') {
# $debug .= debug($printdebug, "text: ".$bbtree{$ind.'.v'});
- # $ht = $ht.linehtml($bbtree{$ind.'.v'});
+ # $ht = $ht.html_encode_line($bbtree{$ind.'.v'});
# {do{
# $ind =~ s/\.([0-9]+)$//;
# $ht = $ht.'</i>';
# }
# else { #unimpl.
- # $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).']';
+ # $ht = $ht.'['.html_encode_line($bbtree{$ind.'.n'}).']';
# $debug .= debug($printdebug, "[unknown!]");
# }
# $ind =~ s/\.([0-9]+)$//;
# $ht = $ht.'<a href="'.entityencode($bbtree{$ind.'.v'}).'">';
# }
# else { #unimpl.
- # $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).(($bbtree{$ind.'.v'} ne '' )?entityencode($bbtree{$ind.'.v'}):'').']';
+ # $ht = $ht.'['.html_encode_line($bbtree{$ind.'.n'}).(($bbtree{$ind.'.v'} ne '' )?entityencode($bbtree{$ind.'.v'}):'').']';
# $debug .= debug($printdebug, "[unknown!]");
# }
# }
# else {
# $debug .= debug($printdebug, "unclosed tag: [".$bbtree{$ind.'.n'}."]");
- # $ht = $ht.'['.linehtml($bbtree{$ind.'.n'}).']';
+ # $ht = $ht.'['.html_encode_line($bbtree{$ind.'.n'}).']';
# }
# if($bbtree{$ind.'.e'}>0) {
# $ind = $ind.'.0';
}
-sub linehtml {
- (my $ht) = @_;
- my $esc;
+
+sub html_encode_line {
+ (my $text, my $non_ascii, my $all) = @_;
+ my $html;
my $ind;
- $ht =~ s/\r\n/\n/g;
- $ht =~ s/\r/\n/g;
+ $text =~ s/\r\n/\n/gs;
+ $text =~ s/\r/\n/gs;
- while ($ht ne '') {
- $ind = index($ht,"\n");
- if($ind>=0){
- $esc = $esc.entityencode(substr($ht,0,$ind))."<br>\n";
- $ht=substr($ht,$ind+1);
+ while ($text ne '') {
+ $ind = index($text, "\n");
+ if ($ind >= 0) {
+ $html .= html_entity_encode_dec(substr($text, 0, $ind), $non_ascii, $all)."<br>\n";
+ $text = substr($text, $ind+1);
}
else
{
- $esc = $esc.entityencode($ht);
- $ht = '';
+ $html .= html_entity_encode_dec($text, 1);
+ $text = '';
}
}
- return $esc;
+ return $html;
+}
+
+# TO REMOVE
+sub linehtml {
+ return html_encode_line($_[0], 1);
}
# TO REMOVE ???
foreach my $key (keys %$data) {
unless ($key eq 'content') {
my $val = $data->{'ind'};
- $val =~ s/(\r)?\n/\n /gs;
-
+ $val =~ s/(\r)?\n/\n /gs; # does the space make sense in HTML anyway?
+ print $fh html_encode_line("$key: $val\n", 1);
}
}
+ print $fh html_encode_line("\n".$data->{'content'});
}
sub print_viewer_page {
bicyclesonthemoon.info / projects / ott / bsta / commitdiff