Changeset 17304

Show
Ignore:
Timestamp:
08/10/08 01:04:43 (5 years ago)
Author:
daisuke
Message:

add has_dom_root

Location:
lang/perl/MooseX-DOM/trunk
Files:
5 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/MooseX-DOM/trunk/Changes

    r17251 r17304  
    22======= 
    33 
     40.00002 - 10 Aug 2008 
     5  * Implement unimport(), so you can do 'no MooseX::DOM' 
     6  * Refactor get/set operations so you can specify them at declaration time 
     7 
    480.00001 - 08 Aug 2008 
    59  * Initial release 

  • lang/perl/MooseX-DOM/trunk/lib/MooseX/DOM.pm

    r17299 r17304  
    7272 
    7373=head1 DECLARATION 
     74 
     75=head2 has_dom_root $tag 
     76 
     77Specifies that the given XML have the specified tag 
    7478 
    7579=head2 has_dom_attr $name[, %opts] 

  • lang/perl/MooseX-DOM/trunk/lib/MooseX/DOM/LibXML.pm

    r17299 r17304  
    112112 
    113113    my %exports = ( 
     114        has_dom_root => sub { 
     115            return Class::MOP::subname($subname->('has_dom_attr') => sub ($;%) { 
     116                my $caller = caller(); 
     117                my $tag = shift; 
     118 
     119                my $assert_root = sub { 
     120                    my $self = shift; 
     121                    my $node = shift || $self->node; 
     122                    if ($node && $node->getName ne $tag) { 
     123                        confess "given node does not have required root node $tag"; 
     124                    } 
     125                }; 
     126 
     127                my $meta = $caller->meta; 
     128                $meta->add_around_method_modifier(new => sub { 
     129                    my $next = shift; 
     130                    my $self = $next->(@_); 
     131                    $assert_root->($self); 
     132                    return $self; 
     133                }); 
     134                $meta->add_after_method_modifier(node => sub { 
     135                    my $self = shift; 
     136                    if (@_) { 
     137                        $assert_root->($self, @_); 
     138                    } 
     139                }); 
     140            }); 
     141        }, 
    114142        has_dom_attr => sub { 
    115143            return Class::MOP::subname($subname->('has_dom_attr') => sub ($;%) { 

  • lang/perl/MooseX-DOM/trunk/t/01_simple.t

    r17249 r17304  
    11use strict; 
    22use lib "t/lib"; 
    3 use Test::More (tests => 9); 
     3use Test::More (tests => 10); 
    44 
    55BEGIN 
    … …  
    4141    is($obj->attribute, "fuga"); 
    4242} 
     43 
     44{ 
     45    my $xml = <<EOXML; 
     46<food attribute="hoge" xmlns="http://www.w3.org/2005/Atom"> 
     47<title>Hoge</title> 
     48<multi>multi1</multi> 
     49<multi>multi2</multi> 
     50<multi>multi3</multi> 
     51<multi>multi4</multi> 
     52</food> 
     53EOXML 
     54 
     55    my $obj = eval { Test::MxD::Simple->new(node => $xml) }; 
     56    like($@, qr/given node does not have required root node/); 
     57} 

  • lang/perl/MooseX-DOM/trunk/t/lib/Test/MxD/Simple.pm

    r17299 r17304  
    55use MooseX::DOM; 
    66 
     7has_dom_root 'feed'; 
    78has_dom_attr 'attribute'; 
    89has_dom_child 'title';