Web::Chain project: Web/Chain/IO/t/Web-Chain-IO-Rawtext.t
# Test file created outside of h2xs framework.
# Run this like so: `perl Web-Chain-IO-Rawtext.t'
# doom@kzsu.stanford.edu 2004/10/13 04:50:50
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use warnings;
use strict;
$|=1;
use Test::More;
BEGIN { plan tests => 15 };
### Note, not supposed to need to do this:
### use Web::Chain::IO::Rawtext;
### (That happens up on the "IO" level, dynamically);
use FindBin qw($Bin);
use Web::Definitions qw( $DEBUG );
use Web::Chain::IO;
ok(1); # If we made it this far, we're ok.
#=======
# Input tests
#
#========
# subs used by the following tests (proceedural)
sub check_chain_against_content_hash {
# Given a chain object and a ref to a hash full of the content keyed on node name
# tries to match up text from the chain with text from the hash
# Example usage:
# check_chain_against_content_hash($chain, \%content);
my $chain = shift; # Yes, a proceedural routine that takes an object ref as first parameter
my $hashref = shift;
foreach my $node_name (sort keys %{ $hashref }) {
my $node = $chain->get_node_from_name($node_name);
($DEBUG) && print STDERR "Warning: Failed to get node pointer for $node_name" unless($node);
my $stored_content_ref = $node->get_body;
is (${ $stored_content_ref }, $hashref->{$node_name}, "Tried to retrieve content for node named: $node_name");
}
}
sub strip_leading_or_trailng_whitespace {
# Use this sub on both things being compared, when you don't
# care too much about getting the precise number of spaces
# and/or blank lines right.
my $string_ref = shift;
${ $string_ref } =~ /^\s*/;
${ $string_ref } =~ /\s*$/;
}
#--------
# The input tests themselves
### This approach doesn't work yet -- TODO
### ($input_location is supposed to be optional if full path is used)
# my $input_location = "";
# my $file_name_rawtext = "$Bin/dat/DUMMY_CHAIN";
my $input_location = "$Bin/dat";
my $file_name_rawtext = "DUMMY_CHAIN";
# /home/doom/lib/perl/Web/Chain/IO/Input/t/dat/DUMMY_CHAIN
my $dfh = Web::Chain::IO->new; # Create a doomfiles io handle
$dfh->input_location($input_location); # the current input directory, optional if full path is used.
$dfh->input_format('Rawtext'); # uses a Web::Chain::IO::Input::Rawtext
my $chain = $dfh->input($file_name_rawtext);
# Note: input (above) creates and returns a chain object.
my @existing_names = $chain->get_names();
my @expected_names = qw(
DUMMY_NODE
LONG_NODE
TRASHIC
CLASSIC
COMPLETENESS
KNOW_WAN_OHM
);
# is_deeply(\@existing_names, \@expected_names, "Rawtext creates nodes with the correct names");
my $name_dump = join( ' ', @expected_names );
is_deeply(\@existing_names, \@expected_names, "Rawtext created nodes with the correct names: $name_dump");
###
# Now let's look at the content of the chain, (just checking some of
# the shorter ones by embedding copies of the text here. These include
# the first and last nodes in the file).
my (%text_content, %xml_content);
$text_content{'TRASHIC'} = <<TRASHIC_TEXT;
Just trashy useless
words words words.
TRASHIC_TEXT
$xml_content{'TRASHIC'} = <<TRASHIC_XML;
<NODEBODY>
Just trashy useless
words words words.
</NODEBODY>
TRASHIC_XML
$text_content{'KNOW_WAN_OHM'} = <<KNOW_WAN_OHM_TEXT;
And one more time and let us
leave off, without a triple equal sign,
to see if that actually works.
KNOW_WAN_OHM_TEXT
$xml_content{'KNOW_WAN_OHM'} = <<KNOW_WAN_OHM_XML;
<NODEBODY>
And one more time and let us
leave off, without a triple equal sign,
to see if that actually works.</NODEBODY>
KNOW_WAN_OHM_XML
$text_content{'DUMMY_NODE'} = <<DUMMY_NODE_TEXT;
Sun Sep 26 12:39:24 2004
Wanted a short one up top,
To make test simpler. So what once was here is now
down one.
DUMMY_NODE_TEXT
$xml_content{'DUMMY_NODE'} = <<DUMMY_NODE_XML;
<NODEBODY> Sun Sep 26 12:39:24 2004
Wanted a short one up top,
To make test simpler. So what once was here is now
down one.
</NODEBODY>
DUMMY_NODE_XML
check_chain_against_content_hash($chain, \%xml_content);
#========
# Tests of single file nodes
#--------
# DUMMY_SINGLET - short, single file node with no trailng '==='.
%text_content =(); %xml_content =();
$text_content{'DUMMY_SINGLET'} = <<DUMMY_SINGLET_TEXT;
Sunday September 26, 2004
This is a single node file.
This one closes without the
triple equal sign bar.
DUMMY_SINGLET_TEXT
chomp( $text_content{'DUMMY_SINGLET'} ); # Yeah, a funny tweak. Don't ask me.
$xml_content{'DUMMY_SINGLET'} = <<DUMMY_SINGLET_XML;
<NODEBODY> Sunday September 26, 2004
This is a single node file.
This one closes without the
triple equal sign bar.</NODEBODY>
DUMMY_SINGLET_XML
chomp( $xml_content{'DUMMY_SINGLET'} ); # Yeah, a funny tweak. Don't ask me.
{
my $input_location = "$Bin/dat";
my $file_name_rawtext = "DUMMY_SINGLET";
# /home/doom/lib/perl/Web/Chain/IO/Input/t/dat/DUMMY_SINGLET
my $dfh = Web::Chain::IO->new; # Create a doomfiles io handle
$dfh->input_location($input_location); # the current input directory, optional if full path is used.
$dfh->input_format('Rawtext'); # uses a Web::Chain::IO::Input::Rawtext
my $chain = $dfh->input($file_name_rawtext); # creates and returns a chain object.
my @existing_names = $chain->get_names();
my @expected_names = qw( DUMMY_SINGLET );
my $name_dump = join( ' ', @expected_names );
is_deeply(\@existing_names, \@expected_names, "Rawtext created nodes with the correct names: $name_dump");
check_chain_against_content_hash($chain, \%xml_content);
}
#--------
# DUMMY_TRAILNG_EQS
%text_content = (); %xml_content = ();
$text_content{'DUMMY_TRAILNG_EQS'} = <<DUMMY_TRAILNG_EQS_TEXT;
Sunday September 26, 2004
This is another single node file.
With the dreaded hanging '===' problem:
DUMMY_TRAILNG_EQS_TEXT
$xml_content{'DUMMY_TRAILNG_EQS'} = <<DUMMY_TRAILNG_EQS_XML;
<NODEBODY> Sunday September 26, 2004
This is another single node file.
With the dreaded hanging '===' problem:
</NODEBODY>
DUMMY_TRAILNG_EQS_XML
{
my $input_location = "$Bin/dat";
my $file_name_rawtext = "DUMMY_TRAILNG_EQS";
# /home/doom/lib/perl/Web/Chain/IO/Input/t/dat/DUMMY_TRAILNG_EQS
my $dfh = Web::Chain::IO->new; # Create a doomfiles io handle
$dfh->input_location($input_location); # the current input directory, optional if full path is used.
$dfh->input_format('Rawtext'); # uses a Web::Chain::IO::Input::Rawtext
my $chain = $dfh->input($file_name_rawtext); # creates and returns a chain object.
my @existing_names = $chain->get_names();
my @expected_names = qw( DUMMY_TRAILNG_EQS );
my $name_dump = join( ' ', @expected_names );
is_deeply(\@existing_names, \@expected_names, "Rawtext created nodes with the correct names: $name_dump");
check_chain_against_content_hash($chain, \%xml_content);
}
#--------
# DUMMY_TRAILING_EQS_PLUS_WS
%text_content = (); %xml_content = ();
$text_content{'DUMMY_TRAILING_EQS_PLUS_WS'} = <<DUMMY_TRAILING_EQS_PLUS_WS;
Sunday September 26, 2004
This is another single node file.
With the dreaded hanging '===' problem:
DUMMY_TRAILING_EQS_PLUS_WS
$xml_content{'DUMMY_TRAILING_EQS_PLUS_WS'} = <<DUMMY_TRAILING_EQS_PLUS_WS;
<NODEBODY> Sunday September 26, 2004
This is another single node file.
With the dreaded hanging '===' problem:
</NODEBODY>
DUMMY_TRAILING_EQS_PLUS_WS
{
my $input_location = "$Bin/dat";
my $file_name_rawtext = "DUMMY_TRAILING_EQS_PLUS_WS";
# /home/doom/lib/perl/Web/Chain/IO/Input/t/dat/DUMMY_TRAILING_EQS_PLUS_WS
my $dfh = Web::Chain::IO->new; # Create a doomfiles io handle
$dfh->input_location($input_location); # the current input directory, optional if full path is used.
$dfh->input_format('Rawtext'); # uses a Web::Chain::IO::Input::Rawtext
my $chain = $dfh->input($file_name_rawtext); # creates and returns a chain object.
my @existing_names = $chain->get_names();
my @expected_names = qw( DUMMY_TRAILING_EQS_PLUS_WS );
my $name_dump = join( ' ', @expected_names );
is_deeply(\@existing_names, \@expected_names, "Rawtext created nodes with the correct names: $name_dump");
check_chain_against_content_hash($chain, \%xml_content);
}
Joseph Brenner,
Sat Nov 6 17:04:11 2004