# -*- perl -*- # # $Id: misc.t,v 1.1.1.1 1999/11/18 22:48:12 joe Exp $ # use strict; $^W = 1; $| = 1; print "1..82\n"; use HTML::EP (); my $have_dbd_csv = eval { require DBD::CSV }; my $have_dbi = eval { require DBI }; my $numTests = 0; sub Test($;@) { my $result = shift; if (@_ > 0) { printf(@_); } ++$numTests; if (!$result) { print "not " }; print "ok $numTests\n"; $result; } sub Test2($$;@) { my $a = shift; my $b = shift; my $c = ($a eq $b); if (!Test($c, @_)) { print("Expected $b, got $a\n"); } $c; } $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = ''; $ENV{DOCUMENT_ROOT} = ''; my $parser = HTML::EP->new(); Test($parser, "Creating the parser.\n"); my $input = <<'END_OF_HTML'; This is another comment. It will be removed.. END_OF_HTML my $output = <<'END_OF_HTML'; . END_OF_HTML Test2($parser->Run($input), $output, "Multi-line comment.\n"); $parser = HTML::EP->new(); Test2($parser->Run(''), '', "Setting a variable\n"); Test($parser->{'a'} eq 'b'); $parser = HTML::EP->new(); Test2($parser->Run('c'), '', "Setting a multi-line variable\n"); Test($parser->{'a'} eq 'c'); $parser = HTML::EP->new(); $parser->{'a'} = {}; Test2($parser->Run('c'), '', "Setting a structured variable\n"); Test($parser->{'a'}->{'b'} eq 'c'); $parser = HTML::EP->new(); $parser->{'a'} = []; Test2($parser->Run('d'), '', "Setting an array variable\n"); Test($parser->{'a'}->[0] eq 'd'); $parser = HTML::EP->new(); $input = <<'END_OF_HTML'; . END_OF_HTML Test2($parser->Run($input), $output, "Single-line comment.\n"); $input = "We'll see thisBut not this!"; $output = "We'll see this"; $parser = HTML::EP->new(); eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $output, "Exit\n"); $input = q{We'll see this} . "And this!"; $output = "We'll see thisAnd this!"; $parser = HTML::EP->new(); $parser->{'a'} = 0; Test2($parser->Run($input), $output, "Exit 2\n"); $input = q{We'll see this} . "But not this!"; $output = "We'll see this"; $parser = HTML::EP->new(); $parser->{'a'} = 1; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $output, "Exit 3\n"); $input = q{We'll see thisAnd this!} . q{} . "But not this!"; $output = "We'll see thisAnd this!"; $parser = HTML::EP->new(); $parser->{'a'} = 1; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $output, "Exit 4\n"); print "Testing conditions: neval, ==, !=, <, >, <=, >=, eq, ne\n"; $input = q{a is not seta is set}; $parser = HTML::EP->new(); $parser->{'a'} = 1; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, "a is set"); $parser = HTML::EP->new(); $parser->{'a'} = 0; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, "a is not set"); foreach my $ref (["==", 0, 1, 0], ["!=", 1, 0, 1], ["<", 1, 0, 0], [">", 0, 0, 1], ["<=", 1, 1, 0], [">=", 0, 1, 1]) { $input = q{10}; $parser = HTML::EP->new(); $parser->{'a'} = 1; $parser->{'b'} = 2; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $ref->[1]); $parser = HTML::EP->new(); $parser->{'a'} = 1; $parser->{'b'} = 1; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $ref->[2]); $parser = HTML::EP->new(); $parser->{'a'} = 2; $parser->{'b'} = 1; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $ref->[3]); } foreach my $ref (["eq", 0, 1], ["ne", 1, 0]) { $input = q{10}; $parser = HTML::EP->new(); $parser->{'a'} = 1; $parser->{'b'} = 2; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $ref->[1]); $parser = HTML::EP->new(); $parser->{'a'} = 1; $parser->{'b'} = 1; eval { $parser->Run($input) }; Test2($parser->{'_ep_output'}, $ref->[2]); } if ((-f "foo" && !unlink("foo")) || !open(FOO, ">foo") || !(print FOO "b") || !close(FOO)) { die "Error while writing 'foo': $!"; } $parser = HTML::EP->new(); Test2($parser->Run('ac'), "abc", "Include.\n"); $parser = HTML::EP->new(); $parser->{'list'} = [1,2,3,4]; $input = 'a$l$c'; Test2($parser->Run($input), "a1b2b3b4bc", "Repeated include.\n"); $parser = HTML::EP->new(); $parser->{'session'}->{'list'} = [[1,2,3,4]]; $input = 'a$l$c'; Test2($parser->Run($input), "a1b2b3b4bc", "Repeated include.\n"); $parser = HTML::EP->new(); $input = ''; Test2($parser->Run($input), $input, "DOCTYPE\n"); $parser = HTML::EP->new(); $input = ''; $output = '7'; Test2($parser->Run($input), $output, "Single-line Perl expression.\n"); $parser = HTML::EP->new(); $input = <<'_END_OF_HTML'; 'ab' . 'ce' _END_OF_HTML $output = <<'_END_OF_HTML'; abce _END_OF_HTML Test2($parser->Run($input), $output, "Multi-line Perl expression.\n"); if (!$have_dbi || !$have_dbd_csv) { ++$numTests; print "ok $numTests # Skip\n"; } else { $parser = HTML::EP->new(); $input = <<'_END_OF_HTML'; _END_OF_HTML $output = <<'_END_OF_HTML'; _END_OF_HTML my $got = eval { $parser->Run($input); }; Test2($got, $output, "Making a Database connection.\n"); } my $dbh = $parser->{dbh}; if (!$have_dbi || !$have_dbd_csv) { ++$numTests; print "ok $numTests # Skip\n"; } else { if (-f 'foo') { unlink 'foo'; } $parser = HTML::EP->new(); $input = <<'_END_OF_HTML'; $people_rows$
$p->id$$p->name$
$people2_rows$ $p->id$,$p->name$ _END_OF_HTML $output = <<'_END_OF_HTML'; 3
1joe
2amar
3gerald
1 2,amar _END_OF_HTML Test2($parser->Run($input), $output, "SQL queries.\n"); } $parser = HTML::EP->new(); $input = '' . ''; $output= ''; Test2($parser->Run($input), $output, "Select lists.\n"); $ENV{QUERY_STRING} = 'address_t_name=joe&address_t_street=Am+Eisteich+9' . '&address_n_zip=72555&address_t_city=Metzingen' . '&address_dy_date1=1998&address_dm_date1=7&address_dd_date1=2' . '&address_dy_date2=98&address_dm_date2=7&address_dd_date2=2' . '&address_dy_date3=8&address_dm_date3=7&address_dd_date3=2'; $input = <<'_END_OF_HTML';

Name = $address->name->val$

Street = $address->street->val$

Zip = $address->zip->val$

City = $address->city->val$

Date1 = $address->date1->val$

Date2 = $address->date2->val$

Date3 = $address->date3->val$

_END_OF_HTML $output = <<'_END_OF_HTML';

Name = joe

Street = Am Eisteich 9

Zip = 72555

City = Metzingen

Date1 = 1998-07-02

Date2 = 1998-07-02

Date3 = 2008-07-02

_END_OF_HTML $parser = HTML::EP->new(); Test2($parser->Run($input), $output, "Object input.\n"); if (!$have_dbi || !$have_dbd_csv) { ++$numTests; print "ok $numTests # Skip\n"; } else { $input = ''.$input; $input =~ s/(dest=address)/$1 sqlquery=1/; $input .= <<'END_OF_HTML';

Names = $address->names$

Values = $address->values$

Update = $address->update$ END_OF_HTML $output .= <<'END_OF_HTML';

Names = date2,date3,city,name,zip,date1,street

Values = '1998-07-02','2008-07-02','Metzingen','joe',72555,'1998-07-02','Am Eisteich 9'

Update = date2='1998-07-02',date3='2008-07-02',city='Metzingen',name='joe',zip=72555,date1='1998-07-02',street='Am Eisteich 9' END_OF_HTML $parser = HTML::EP->new(); Test2($parser->Run($input), $output, "Object input with 'sqlquery' set.\n"); } $ENV{QUERY_STRING} = 'art_0_t_name=Book&art_0_n_price=5.00' . '&art_1_t_name=Donut&art_1_n_price=1.00'; $input = <<'_END_OF_HTML'; Name = $a->name->val$, Price = $a->price->val$, Item = $a->i$ _END_OF_HTML $output = <<'_END_OF_HTML'; Name = Book, Price = 5.00, Item = 0 Name = Donut, Price = 1.00, Item = 1 _END_OF_HTML undef @CGI::QUERY_PARAM; # Arrgh! CGI caches :-( $parser = HTML::EP->new(); Test2($parser->Run($input), $output, "Object list input.\n"); $input = <<'_END_OF_HTML'; 0123 _END_OF_HTML for (my $i = 0; $i < 4; $i++) { $output = <<"_END_OF_HTML"; $i _END_OF_HTML $parser = HTML::EP->new(); $parser->{i} = $i; Test2($parser->Run($input), $output, "If: $i.\n"); } $input = <<'_END_OF_HTML'; i is < 0. i equals 0. j is < 0. j equals 0. Both numbers are > 0. _END_OF_HTML my $ref; my @conditionals = ( [ -1, -1, "i is < 0." ], [ -1, 0, "i is < 0." ], [ -1, 1, "i is < 0." ], [ 0, -1, "i equals 0." ], [ 0, 0, "i equals 0." ], [ 0, 1, "i equals 0." ], [ 1, -1, "j is < 0." ], [ 1, 0, "j equals 0." ], [ 1, 1, "Both numbers are > 0." ] ); foreach $ref (@conditionals) { $parser = HTML::EP->new(); $parser->{i} = $ref->[0]; $parser->{j} = $ref->[1]; my $result = $ref->[2]; $output = <<"_END_OF_HTML"; $result _END_OF_HTML Test2($parser->Run($input), $output); } $input = <<'_END_OF_HTML'; i is < 0. i equals 0. j is < 0. j equals 0. Both numbers are > 0. _END_OF_HTML foreach $ref (@conditionals) { $parser = HTML::EP->new(); $parser->{i} = $ref->[0]; $parser->{j} = $ref->[1]; my $result = $ref->[2]; $output = <<"_END_OF_HTML"; $result _END_OF_HTML Test2($parser->Run($input), $output); } my $cfg; if (-f "lib/HTML/EP/Config.pm") { $cfg = do "lib/HTML/EP/Config.pm"; } if (!$cfg->{email} || $cfg->{email} eq 'none' || !$cfg->{mailhost}) { Test(1); } else { print("Sending mail to ", $cfg->{email}, " via mail server ", $cfg->{mailhost}, "\n"); $input = <<'_END_OF_HTML'; Hello, this is a testmail from the script t/misc.t in the HTML::EP distribution. You may safely ignore it. It was sent to $cgi->email$ by using the mailserver $cgi->mailhost$. You should be alarmed, though, if it doesn't reach you. :-) Yours sincerely, Jochen Wiedmann _END_OF_HTML $output = <<'_END_OF_HTML'; _END_OF_HTML $ENV{QUERY_STRING} = 'email=' . CGI->escape($cfg->{email}) . '&mailhost=' . CGI->escape($cfg->{mailhost}); undef @CGI::QUERY_PARAM; # Arrgh! CGI caches :-( $parser = HTML::EP->new(); Test2($parser->Run($input), $output); } print "Checking nested loops.\n"; $input = q{ j$j$k$k$l$l$}; $output = "\n"; for (my $j = 1; $j < 4; $j++) { for (my $k = 4; $k < 7; $k++) { for (my $l = 7; $l < 10; $l++) { $output .= "j${j}k${k}l$l"; } } } $parser = HTML::EP->new(); Test2($parser->Run($input), $output); print "Checking nested loop/if.\n"; $input = q{ aok$j$b}; $output = "\naok1baok2babab"; $parser = HTML::EP->new(); Test2($parser->Run($input), $output); print "Checking nested if/loop.\n"; $input = q{a$j$}; $output = "a1a2a3a4"; $parser = HTML::EP->new(); $parser->{'a'} = 1; Test2($parser->Run($input), $output); $parser = HTML::EP->new(); $parser->{'a'} = 0; Test2($parser->Run($input), ""); print "Checking repeated ep-package\n"; $input = q{ }; $parser = HTML::EP->new(); Test2($parser->Run($input), "\n\n\n"); Test(ref($parser) eq "HTML::EP::PACK2") or print "$parser is a ", ref($parser), "\n"; Test(@HTML::EP::PACK2::ISA == 2 && $HTML::EP::PACK2::ISA[0] eq 'HTML::EP::EditTable' && $HTML::EP::PACK2::ISA[1] eq 'HTML::EP::Locale') or print "Wrong ISA, got\n", map { " $_\n " } @HTML::EP::PACK2::ISA; print "Checking ep-set nested with ep-list.\n"; $parser = HTML::EP->new(); $parser->{'list'} = [1,2,3,4]; $input = '$l$$Foo$'; Test2($parser->Run($input), "1234"); END { unlink 'foo' }