Web::Chain project:    Web/t/Web-Definitions.t

     # Test file created outside of h2xs framework.
# Run this like so: `perl Web-Definitions.t'
#   doom@kzsu.stanford.edu     2004/09/18 20:16:26

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use warnings;
use strict;
$|=1;

use Test::More;
BEGIN { plan tests => 4 + 6 + 4 + 2 + 1 + 3 + 12 + 1 + 5};


use Web::Definitions qw(:all);

ok(1); # If we made it this far, we're ok.

is ($DF_TOPNODE_NAME, 'TOP', "simple string constant exported: TOP");

is ($DF_LOC, "/home/doom/End/Stage/Mirthless/doomfiles", "built up string  constant exported: doomfiles location");

my ($count, @suspect_constant);
my $prefix = 'DOOM';
{
  no strict 'refs';
  @suspect_constant = grep{/$prefix/} map{ &{ $_ } }  grep{/::$prefix[^:]*$/} (keys  %constant::declared);
  $count = scalar @suspect_constant;
}
cmp_ok ($count, '<', 1 , "checked for constants that look like they've got an embedded constant name in them");
if ($count) {
   print "Warning: Signs of attempted interpolation of constant names.  Do these look like good values?\n\t";
   print join "\n\t", @suspect_constant;
   print "\n";
}

{
  my $test;

  my @positive_test = qw(FOXTROT BUGOFF FOUR_SCORE McPISSOFFS DIRTBALL-AMERICAN HIKE123 );

  foreach $test (@positive_test){
    like ($test, $DF_DESTINATION_RULE, "exported doomnode name rule matches: $test");
  }

  my @negative_test = qw(smallego False_Modesty leapFROG 12 );
  foreach $test (@negative_test) {
    unlike ($test , $DF_DESTINATION_RULE, "exported doomnode name rule should not match: $test");
  }

  my @known_problems = qw(SINGLEFLAWi PUNCH!OUT);
  foreach $test (@known_problems) {
    unlike ($test , $DF_DESTINATION_RULE, "exported doomnode name rule should not match: $test");
  }
}

{
  my $slurped_doom_node = <<END_NODE;

DUMMY_NODE

      This here is supposed
      to be a mock up like         TO_HELL
uh    of a doomfile node.
thus
no      And here          Note, a jump
spc     a simpler         with no spaces to
        case:    ONE      rightward, there 

             A little crowded, 
   FALSIe    that "one", but not 
             enough to matter.

You know, this      Flat mental tires?
TRICK never         Call the AAAS today.
works, excpt        (And that shouldn't
now it might.       be a link.)

                One more, case, 
                HAS no trailng 
                two space.

Up there TRICK is not 
a link (neither is it          A funny 
down here).  The next          one:  LINKAGE 
two cases are toughies,        has two spaces
which are *not* identified     in front and 
as links at present            one-space/eol
(though perhaps they           behind it to 
should be):                    make it linkish.

 NOHOW      Note that in these cases, 
            they don't have two leading 
NOWHERE     spaces, and NOWHERE is 
            historically a nasty case 
            that used to get mis-identified 
            as a new node.  

Repeating those cases with trailing eols 
(and no spaces between them and the eols):

 NO_OHM
NO_RESISTANCE

Here is one more problem
case:  TOOSPACEY has two  
spaces in front of it, but 
only one behind, and should
not be a link.

           WIDE_OPEN              you know?

END_NODE

  print $slurped_doom_node;

  my @matches_raw;
  #my $pat = $DF_THOUGHTS_LINK_RULE;
  my $pat = $DF_EMBEDDED_LINK_RULE;
  ($DEBUG) && print STDERR "pattern: $pat\n";
  foreach ($slurped_doom_node =~ /$pat/g) {
    push @matches_raw, $_;
  }

  my @matches = sort @matches_raw;
  my @expected_matches = sort qw(TO_HELL ONE WIDE_OPEN LINKAGE);
  my @expected_nonmatches = qw(TOOSPACEY 
                               HAS
                               DUMMY_NODE
                               FALSI
                               FALSIe
                               TRICK
                               AAAS
                               NOHOW 
                               NOWHERE 
                               NO_OHM 
                               NO_RESISTANCE );

  print "\n\nActual Matches: \n";
  print join " ", @matches;
  print "\n";
  print "Expected Matches: \n";
  print join " ", @expected_matches;
  print "\n\n";

  my $count = scalar(@matches);
  my $expected_count = scalar(@expected_matches);

  is( $count, $expected_count, "DF_EMBEDDED_LINK_RULE: Test if found the right number of embedded nodes");
#   is_deeply(\@matches, \@expected_matches, "Test DF_EMBEDDED_LINK_RULE");

  my %seen = ();
  map { $seen{ $_ } = $_; } @matches;
  
  foreach (@expected_matches) { 
    is( $seen{$_}, $_, "Test if $_ was found");
  }

  foreach (@expected_nonmatches) { 
    isnt( $seen{$_}, $_, "Test that $_ was *not* found");
  }

}

#--------
# The goal of this pattern:
#   $DF_EMBEDDED_LINK_SINGLE_CAPTURE_RULE
# is to extract the link text to $1 without using anything 
# but zero width anchors, so you can transform it in place 
# simply, like this:  <A HREF="$1.html">$1</A>

{
  my $string = 
    'An embedded link:    EMBEDDED_LINK   aka a doomfiles jump.';
  my $expected_string = 
    'An embedded link:    <A HREF="EMBEDDED_LINK.html">EMBEDDED_LINK</A>   aka a doomfiles jump.'; 

  my $working_string = $string;
  $working_string =~ s{$DF_EMBEDDED_LINK_SINGLE_CAPTURE_RULE}
                      {<A HREF="$1.html">$1</A>};
  is( $working_string, $expected_string, "Test transforming embedded link to html link.");

}

#--------
# Tests of patterns that extract elements from the 
# published doomfiles html file.
# 
#   prev/next/body
#   while we're at it: title, h1
{

   my $dummy_html_file_slurpage = <<SLURPED;
<HTML><HEAD>
<TITLE>The doomfiles - DREAMS.html</TITLE>
</HEAD><BODY>
<PRE>                                <A HREF="MAGIC.html">[PREV - MAGIC]</A>    <A HREF="TOP.html">[TOP]</A></PRE>
<H1>DREAMS</H1>


<PRE>     

     I don't remember looking in   
     their direction either.       
    
    
--------                      
                            
<A HREF="COUCH.html">[NEXT - COUCH]</A>
</PRE></BODY></HTML>
SLURPED

($DEBUG) && print STDERR "dummy_html_file_slurpage: \n$dummy_html_file_slurpage\n";

   my $expected_body=
'
     I don\'t remember looking in   
     their direction either.       
    
    
';

   my @test_patterns = qw(
                    $DF_EXTRACT_NEXT_NODE_RULE
                    $DF_EXTRACT_PREV_NODE_RULE
                    $DF_EXTRACT_BODY_RULE
                    $DF_EXTRACT_TITLE_RULE
                    $DF_EXTRACT_H1_RULE
                   );

   my @expected_values = (
                    'COUCH',                        # NEXT
                    'MAGIC',                        # PREV
                    $expected_body,                 # BODY
                    'The doomfiles - DREAMS.html',  # TITLE
                    'DREAMS',                       # H1
                     );
  my $test_result;
  my $i = 0;
                    
  ($test_result) = 
    ($dummy_html_file_slurpage =~ m{ 
                                    $DF_EXTRACT_NEXT_NODE_RULE 
                                    }msx);

    is($test_result, $expected_values[$i], "Test that $test_patterns[$i] gave expected result");
    $i++;
   
  ($test_result) = 
    ($dummy_html_file_slurpage =~ m{ 
                                    $DF_EXTRACT_PREV_NODE_RULE
                                    }msx);

    is($test_result, $expected_values[$i], "$i: Test that $test_patterns[$i] gave expected result");
    $i++;

  ($test_result) = 
    ($dummy_html_file_slurpage =~ m{ 
                                    $DF_EXTRACT_BODY_RULE
                                    }msx);
    is($test_result, $expected_values[$i], "$i: Test that $test_patterns[$i] gave expected result");
    $i++;

  ($test_result) = 
    ($dummy_html_file_slurpage =~ m{ 
                                    $DF_EXTRACT_TITLE_RULE
                                    }msx);
    is($test_result, $expected_values[$i], "$i: Test that $test_patterns[$i] gave expected result");
    $i++;

  ($test_result) = 
    ($dummy_html_file_slurpage =~ m{ 
                                    $DF_EXTRACT_H1_RULE
                                    }msx);
    is($test_result, $expected_values[$i], "$i: Test that $test_patterns[$i] gave expected result");
    $i++;



}