Web Client Programming with Perl-Chapter 7: Graphical Examples with Perl/Tk- P2

Chapter 7: Graphical Examples with Perl/Tk- P2

The do_search( ) function will take an optional $url argument, to give it an
alternative place to connect to. Otherwise it expects $word to contain
something. We just hit Return from the entry widget, so $word contains the
string "example", and $url is undefined. If we accidentally hit Return before
typing anything, we don't want to search for a nonstring, so we return from
the subroutine if that's the case:
$INFORMATION = "Connect: $url";

$text->configure(-cursor=> 'watch');
$mw->idletasks;
We give the user some feedback by placing along the bottom of the
application a "Connect..." string, and we also change the cursor to a watch.
$mw->idletasks just tells the window to do anything it was waiting to do, so
that we can actually see the watch and information string:
my $request = new HTTP::Request('GET', $url);

my $response = $ua->request($request);
if ($response->is_error) {
$INFORMATION = "ERROR: Could not retrieve
$url";
} elsif ($response->is_success) {
my $html = parse_html($response->content);

## Clear out text item
$text->configure(-state => "normal");

$text->delete('1.0', 'end');
$html->traverse(\&display_html);
$text->configure(-state => "disabled");

$html_text = "";
$INFORMATION = "Done";
}

$text->configure(-cursor => 'top_left_arrow');
}
Next we try to connect to the $url. If we fail, the program should display a
simple error message in the information area. If we succeed, then we want to
get the actual document out and parse it. $html will contain the HTML tree
object. We reconfigure the text object to "normal" so that we can place text
in it,[5] delete anything that might have been there previously, and then call
traverse for the HTML object (telling traverse to call display_html for each
item). After the entire document has been traversed (we'll see what that does
in a minute), we re-disable the text widget, and declare ourselves done for
that particular word lookup.
Our function, display_html, gets called with three arguments: a $node
pointer, a $startflag flag, and the $depth we are into the tree. We only care
about the first two arguments, since they will help us decide what action to
perform.
sub display_html {
my ($node, $startflag, $depth) = @_;
my ($tag, $type, $coderef); ## This tag is the
HTML tag...

if (!ref $node) {
$html_text .= $node;
} else {
if ($startflag) {
$tag = $node->starttag;
} else {

$tag = $node->endtag;
}

## Gets rid of any 'extra' stuff in the tag, and
saves it
if ($tag =~ /^(<\w+)\s(.*)>/) {
$tag = "$1>";
$extra = $2;
}

if (exists $html_action{$tag}) {
$html_text =~ s/\s+/ /g;
&{ $html_action{$tag} }($tag,
$html_text);
$html_text = "";
}
}
1;
}
That's the entire function, but it does quite a bit. The $node could either be
an object or a simple text string. For the simple case, when it's just text, we
append it to any prior text (remember, we could be ignoring HTML tags,
along the way, that had text before them) and save it for future use. If $node
is an object pointer, then we have to determine what kind it is, and decide if
we care about the HTML tag it's telling us about.
HTML tags usually come in pairs, so $startflag tells us when we found the
first of a pair. We want to know what that tag was, so we call the starttag
method. Certain tags have other information associated with them (i.e., the
<A> tag), and we want to save that for future use in $extra. Remember that
we are trying to get just the plain simple tag to use in our lookup array.

We do a few more things to clean up, and then we can do our lookup. If we
care about this $tag, then we compress all spaces in the current text string
(makes the display a little bit nicer) and call the function specified in our
lookup array, passing it $tag and $html_text. We left $extra as a global
because most of our functions won't use it.
All that work was just to figure out what function to call. We could have
done a big huge if..then..else statement instead of utilizing a lookup hash,
but that would have been large and unwieldy, and would also have made it
more difficult to add new tag handling functions. The following are those tag
handling functions, and most of them are pretty short:
sub end_title {
$mw->title("xword: ". $_[1]);
}
When we find the end title tag, we change our window title to reflect it (a lot
like a standard web browser).
sub start_heading {
&flush_text(@_);
$text->insert('end', "\n\n");
}
When we start a heading, we need to delimit it from the prior text (which we
insert into our text widget with the flush_text( ) function) with a few returns.
Note that flush_text( ) takes the same arguments as any of our tag handlers.
This allows us to specify it explicitly in the lookup hash if we want to:
sub end_heading {
$text->insert('end', $_[1], $_[0]);
$text->insert('end', "\n");
}
At the end of the heading, we insert the heading text and another return
character. The third argument to the insert function is our actual HTML tag.
(In this case it could be </h2> or </H2> and so on.) This tells the text widget

to use that tag to format the text. For our headings, we set up that text tag to
be a font-changing tag:
sub paragraph {
&flush_text(@_);
$text->insert('end', "\n\n");
}
A paragraph marker, <P>, just means insert a few returns. We also have to
flush out any text prior to it:
sub line_break {
&flush_text(@_);
$text->insert('end', "\n");
}
Similar to <P>, the <BR> also just inserts a return:
sub draw_line {