The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

VBAR / Algorithm-NeedlemanWunsch-0.04 / t / html.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88

              
#!/usr/bin/perl
use strict;
use warnings;
use Algorithm::NeedlemanWunsch;
use Test::More tests => 6;
my @haystack = qw(div span font /font /span a /a table tr td font span /span a /a br span a /a /span br br span /span nobr a /a /nobr /font /td /tr /table /div);
my @needle = qw(div a /a table tr td font br span /span nobr a /a a /a /nobr /font /td /tr /table /div);
my @background;
my @foreground;
sub score_sub {
    my ($a, $b) = @_;
    return ($a eq $b) ? 1 : -2;
}
sub prepend_align {
    my ($i, $j) = @_;
    unshift @background, $haystack[$i];
    unshift @foreground, $needle[$j];
}
sub prepend_first_only {
    my $i = shift;
    unshift @background, $haystack[$i];
    unshift @foreground, '-';
}
sub prepend_second_only {
    my $j = shift;
    unshift @background, '-';
    unshift @foreground, $needle[$j];
}
my $matcher = Algorithm::NeedlemanWunsch->new(\&score_sub, -1);
$matcher->local(1);
my $score = $matcher->align(\@haystack, \@needle,
                            {
                             align => \&prepend_align,
                             shift_a => \&prepend_first_only,
                             shift_b => \&prepend_second_only
                            });
is($score, 5);
is_deeply(\@background,
          [ 'div', 'span', 'font', '/font', '/span', '-', 'a', '/a',
            'table', 'tr', 'td', 'font', '-', 'span', '/span',
            'a', '/a', 'br', 'span', 'a', '/a', '/span', 'br', 'br',
            'span', '/span', 'nobr', 'a', '/a', '/nobr', '/font',
            '/td', '/tr', '/table', '/div' ]);
is_deeply(\@foreground,
          [ '-', '-', '-', '-', '-', 'div', 'a', '/a', 'table', 'tr',
            'td', 'font', 'br', 'span', '/span', '-', '-', '-',
            'nobr', 'a', '/a', '-', '-', '-', '-', '-', '-', 'a',
            '/a', '/nobr', '/font', '/td', '/tr', '/table', '/div' ]);
@background = ();
@foreground = ();
$matcher = Algorithm::NeedlemanWunsch->new(\&score_sub);
$matcher->local(1);
$matcher->gap_open_penalty(-2);
$matcher->gap_extend_penalty(-1);
$score = $matcher->align(\@haystack, \@needle,
                         {
                          align => \&prepend_align,
                          shift_a => \&prepend_first_only,
                          shift_b => \&prepend_second_only
                         });
is($score, 3);
is_deeply(\@background,
          [ 'div', 'span', 'font', '/font', '/span', 'a', '/a',
            'table', 'tr', 'td', 'font', 'span', '/span',
            'a', '/a', 'br', 'span', '-', 'a', '/a', '-', '-', '/span',
            'br', 'br', 'span', '/span', 'nobr', '-', '-', 'a', '/a',
            '/nobr', '/font', '/td', '/tr', '/table', '/div' ]);
is_deeply(\@foreground,
          [ '-', '-', '-', '-', '-', '-', '-', '-', '-', '-', '-', '-',
            '-', '-', '-', '-', '-', 'div', 'a', '/a', 'table', 'tr', 
            'td', 'font', 'br', 'span', '/span', 'nobr', 'a', '/a',
            'a', '/a', '/nobr', '/font', '/td', '/tr', '/table',
            '/div' ]);