Skip to content

Commit

Permalink
condensed rules in tests a lot
Browse files Browse the repository at this point in the history
  • Loading branch information
@wchristian
wchristian committed Dec 18, 2011
1 parent f2cdc2e commit bb21c04
Showing 1 changed file with 31 additions and 50 deletions.
81 changes: 31 additions & 50 deletions t/basic.t
View file
Expand Up @@ -31,62 +31,43 @@ sub run {
}

{
my $is_root = sub { $_[0]->tag eq 'preise' };
my $is_domains = sub { $_[0] and $_[0]->tag eq 'domains' };
my $is_vserver = sub { $_[0] and $_[0]->tag eq 'vserver' };
my $is_rserver = sub { $_[0] and $_[0]->tag eq 'root-server' };
my $is_mserver = sub { $_[0] and $_[0]->tag eq 'managed-server' };
my $is_interval = sub { $_[0] and $_[0]->tag eq 'interval' };
my $is_housing = sub { $_[0] and $_[0]->tag eq 'housing' };
my $is_rhousing = sub { $_[0] and $_[0]->tag eq 'rackhousing' };
my $is_webspace = sub { $_[0] and $_[0]->tag eq 'webspace' };
my $is_in_interval = sub { $is_interval->( $_[0]->parent ) };
my $is_in_domains = sub { $is_domains->( $_[0]->parent ) };
my $is_in_housing = sub { $is_housing->( $_[0]->parent ) };
my $is_in_webspace = sub { $_[0] and $is_webspace->( $_[0]->parent ) };
my $is_in_vserver = sub { $_[0] and $is_vserver->( $_[0]->parent ) };
my $is_in_rserver = sub { $_[0] and $is_rserver->( $_[0]->parent ) };
my $is_in_rhousing = sub { $_[0] and $is_rhousing->( $_[0]->parent ) };
my $is_in_mserver = sub { $_[0] and $is_mserver->( $_[0]->parent ) };
my $is_payment_interval_holder = sub {
$_[0]->tag eq 'zahlung' and ( $is_in_rserver->( $_[0]->parent ) or $is_in_mserver->( $_[0]->parent ) );
my %x_cache;
my $cpath = sub {
my ( $elt ) = @_;
$x_cache{$elt} ||= $elt->xpath;
return $x_cache{$elt};
};
my $is_named_payment_holder = sub {
$_[0]
and $_[0]->tag eq 'zahlung'
and ( $is_in_vserver->( $_[0]->parent ) or $is_in_webspace->( $_[0]->parent ) );
};
my $is_named_payment = sub { $is_named_payment_holder->( $_[0]->parent ) };
my $is_price_in_housing = sub { $_[0]->parent and $is_in_housing->( $_[0]->parent ) };

my $is_mserver_att = sub { $is_mserver->( $_[0]->parent ) and !$_[0]->first_child->is_elt };
my $is_rserver_att = sub { $is_rserver->( $_[0]->parent ) and !$_[0]->first_child->is_elt };
my $is_webspace_att = sub { $is_webspace->( $_[0]->parent ) and !$_[0]->first_child->is_elt };
my $is_rhousing_item_att = sub { $is_in_rhousing->( $_[0]->parent ) and !$_[0]->first_child->is_elt };
my $is_vserver_item_att = sub { $is_in_vserver->( $_[0]->parent ) and !$_[0]->first_child->is_elt };

my $is_mserver_item_att =
sub { $is_in_mserver->( $_[0]->parent ) and $_[0]->first_child and !$_[0]->first_child->is_elt };
my $is_rserver_item_att =
sub { $is_in_rserver->( $_[0]->parent ) and $_[0]->first_child and !$_[0]->first_child->is_elt };
my $is_webspace_item_att =
sub { $is_in_webspace->( $_[0]->parent ) and $_[0]->first_child and !$_[0]->first_child->is_elt };

my $is_in_domains = sub { $cpath->( $_[0] ) =~ m@^/preise/domains/[\w\.]+$@ };

my $repeat_group = "managed-server|rackhousing|root-server|vserver|webspace";

ok my $xd = XML::Dumb->new(
root_wrapper => "preise",
children_as_keys_by_tag => [
$is_root, $is_domains, $is_named_payment_holder, $is_in_housing,
$is_mserver, $is_interval, $is_in_mserver, $is_rhousing,
$is_in_rhousing, $is_rserver, $is_in_rserver, $is_vserver,
$is_webspace, $is_in_vserver, $is_in_webspace,
sub { $_[0]->tag eq "preise" },
sub { $cpath->( $_[0] ) =~ m@^/preise/(domains|$repeat_group)$@ },
sub { $cpath->( $_[0] ) =~ m@^/preise/(housing|$repeat_group)/\w+$@ },
sub { $cpath->( $_[0] ) =~ m@^/preise/(vserver|webspace)/\w+/zahlung$@ },
sub { $cpath->( $_[0] ) =~ m@^/preise/[\w+\-]+/\w+/zahlung/interval\[\d\]$@ },
],
children_as_keys_by_att => { length => $is_payment_interval_holder },
only_child_as_key => { preis => $is_in_domains },
atts_as_keys => [$is_in_domains],
element_as_only_child => [
$is_named_payment, $is_price_in_housing, $is_in_interval, $is_mserver_att,
$is_rserver_att, $is_webspace_att, $is_mserver_item_att, $is_rhousing_item_att,
$is_rserver_item_att, $is_vserver_item_att, $is_webspace_item_att,
children_as_keys_by_att => {
length => sub { $cpath->( $_[0] ) =~ m@^/preise/(root|managed)-server/\w+/zahlung$@ }
},
only_child_as_key => { preis => $is_in_domains },
atts_as_keys => [$is_in_domains],
element_as_only_child => [
sub {
my ( $elt ) = @_;
return if !$_[0]->first_child or $_[0]->first_child->is_elt;

my $xpath = $cpath->( $elt );
return 1 if $xpath =~ m@^/preise/(managed-server|root-server|webspace)/\w+$@;
return 1 if $xpath =~ m@^/preise/(housing|$repeat_group)/\w+/\w+$@;
return 1 if $xpath =~ m@^/preise/(vserver|webspace)/\w+/zahlung/\w+$@;
return 1 if $xpath =~ m@^/preise/(managed|root)-server/\w+/zahlung/interval\[\d\]/\w+$@;
return;
},
],
);
ok $xd->parsefile( "corpus/preise.xml" );
Expand Down

0 comments on commit bb21c04

Please sign in to comment.