webpac/trunk/back2html.pm

#
# reformat html inside xml back to html (basically, support for tables)
#
# filed #-# field ###
# ...

sub back2html {
        my $html = shift;
        my $url_params = shift;

        $html =~ s/</&lt;/g;
        $html =~ s/>/&gt;/g;
        my $out;
        foreach $line (split(/\s*###\s*/,$html)) {
                $out .= "<tr><td valign=\"top\">";
                my @items = split(/\s*#-#\s*/,$line);
                # convert spaces in left field to non-breaking spaces
                $items[0] =~ s#\s+#&nbsp;#g;
                # try to make link on right field
                sub mkurl($) {
                        my $url = shift || die "mkurl needs url as argument";
                        # chop URLS longer than 60 characters
                        my $txturl = substr($1,0,60);
                        $txturl .= "..." if (length($1) > 60);
                        return "<a href=\"$url\">$txturl</a>";
                }
                $items[1] =~ s#(http://[\S]+)#mkurl($1)#gie;
                $out .= join("</td><td>",@items);
                $out .= "</td></tr>\n";
        }
        # put <br> back into html
        $out =~ s,&lt;br/*&gt;,<br/>,gi;
        # put <a href=xxx>yyyy</a> back into html
        sub mkurl_param($$$$) {
                my ($a_href,$url,$text,$a_end) = @_;
                if ($url =~ m#\?#) {
                        $url .= "&".$url_params;
                } else {
                        $url .= "?".$url_params;
                }
                return '<'.$a_href.'"'.$url.'">'.$text.'<'.$a_end.'>';
        }
        $out =~ s#&lt;(a\s+href=)['"]*(.+?)['"]*&gt;(.+?)&lt;(/a)&gt;#mkurl_param($1,$2,$3,$4)#gsie;
        return $out;
}

1;
1	#
2	# reformat html inside xml back to html (basically, support for tables)
3	#
4	# filed #-# field ###
5	# ...
6
7	sub back2html {
8	my $html = shift;
9	my $url_params = shift;
10
11	$html =~ s/</</g;
12	$html =~ s/>/>/g;
13	my $out;
14	foreach $line (split(/\s###\s/,$html)) {
15	$out .= "<tr><td valign=\"top\">";
16	my @items = split(/\s#-#\s/,$line);
17	# convert spaces in left field to non-breaking spaces
18	$items[0] =~ s#\s+# #g;
19	# try to make link on right field
20	sub mkurl($) {
21	my $url = shift \|\| die "mkurl needs url as argument";
22	# chop URLS longer than 60 characters
23	my $txturl = substr($1,0,60);
24	$txturl .= "..." if (length($1) > 60);
25	return "<a href=\"$url\">$txturl</a>";
26	}
27	$items[1] =~ s#(http://[\S]+)#mkurl($1)#gie;
28	$out .= join("</td><td>",@items);
29	$out .= "</td></tr>\n";
30	}
31	# put <br> back into html
32	$out =~ s,<br/*>,<br/>,gi;
33	# put <a href=xxx>yyyy</a> back into html
34	sub mkurl_param($$$$) {
35	my ($a_href,$url,$text,$a_end) = @_;
36	if ($url =~ m#\?#) {
37	$url .= "&".$url_params;
38	} else {
39	$url .= "?".$url_params;
40	}
41	return '<'.$a_href.'"'.$url.'">'.$text.'<'.$a_end.'>';
42	}
43	$out =~ s#<(a\s+href=)['"](.+?)['"]>(.+?)<(/a)>#mkurl_param($1,$2,$3,$4)#gsie;
44	return $out;
45	}
46
47	1;