Changeset 352

Show
Ignore:
Timestamp:
01/17/07 00:08:24 (2 years ago)
Author:
miya
Message:

Assurer: assurer.pl supports --host option.
config.yaml supports hosts and role.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • library/perl/trunk/Assurer/assurer.pl

    r344 r352  
    1212 
    1313my $config = File::Spec->catfile($FindBin::Bin, 'config.yaml'); 
    14 GetOptions('--config=s', \$config, '--version' => \my $version); 
     14GetOptions( 
     15    '--config=s' => \$config, 
     16    '--host=s'     => \my $host, 
     17    '--version'  => \my $version, 
     18); 
    1519 
    1620Getopt::Long::Configure('bundling'); 
    …… 
    2125} 
    2226 
    23 Assurer->bootstrap({ config => $config }); 
     27Assurer->bootstrap({ 
     28    config => $config, 
     29    host   => $host, 
     30}); 
    2431 
    2532exit; 

  • library/perl/trunk/Assurer/examples/config.yaml

    r351 r352  
    44test: 
    55  - module: HTTP 
    6     name: Apache テスト #0 
    76    config: 
    8       - url: http://svn.mizzy.org/ 
    9         match: It not works! 
    10       - url: http://svn.mizzy.org/ 
    11         match: It works! 
    12       - url: http://svn.mizzy.org/ 
    13         match: It not works! 
    14       - url: http://svn.mizzy.org/ 
    15         match: It works! 
    16       - url: http://svn.mizzy.org/ 
    17         match: It works! 
    18       - url: http://svn.mizzy.org/ 
    19         match: It works! 
    20       - url: http://svn.mizzy.org/ 
    21         match: It works! 
    22  
    23   - module: HTTP 
    24     name: Apache テスト #1 
    25     config: 
    26       - url: http://svn.mizzy.org/ 
    27         match: It works! 
    28       - url: http://svn.mizzy.org/ 
    29         match: It not works! 
    30       - url: http://svn.mizzy.org/ 
    31         match: It works! 
    32       - url: http://svn.mizzy.org/ 
    33         match: It works! 
    34  
    35   - module: HTTP 
    36     name: Apache テスト #2 
    37     config: 
    38       - url: http://svn.mizzy.org/ 
    39         match: It works! 
    40       - url: http://svn.mizzy.org/ 
    41         match: It works! 
    42       - url: http://svn.mizzy.org/ 
    43         match: It works! 
    44  
    45   - module: HTTP 
    46     name: Apache テスト #3 
    47     config: 
    48       - url: http://svn.mizzy.org/ 
    49         match: It not works! 
    50       - url: http://svn.mizzy.org/ 
    51         match: It not works! 
     7      content: It works! 
     8    role: web 
    529 
    5310format: 
    54   - module: HTML 
    55     config: 
    56       css_uri: htmlmatrix.css 
     11  - module: Text 
     12#    config: 
     13#      css_uri: htmlmatrix.css 
    5714 
    5815publish: 
    5916  - module: Term 
     17     
     18hosts: 
     19  web: 
     20    - svn.mizzy.org 
     21    - trac.mizzy.org 

  • library/perl/trunk/Assurer/lib/Assurer.pm

    r351 r352  
    1212use Assurer::Test; 
    1313use UNIVERSAL::require; 
     14use Encode; 
    1415 
    1516__PACKAGE__->mk_accessors( qw/ test / ); 
    …… 
    3738    my $config_loader = Assurer::ConfigLoader->new; 
    3839    $self->{config} = $config_loader->load($opts->{config}); 
     40    $self->{config}->{global}->{host} ||= $opts->{host}; 
    3941    Assurer->set_context($self); 
    4042 
    4143    $self->{test} = Assurer::Test->new; 
     44 
     45    if ( eval { require Term::Encoding } ) { 
     46        $self->{config}->{global}->{log}->{encoding} ||= Term::Encoding::get_encoding(); 
     47    } 
     48 
     49    if ( my $hosts = $self->{config}->{hosts} ) { 
     50        $self->{hosts} = []; 
     51        if ( ref $hosts eq 'HASH' ) { 
     52            for my $role ( keys %$hosts ) { 
     53                for my $host ( @{ $hosts->{$role} } ) { 
     54                    push @{ $self->{hosts} }, { role => $role, host => $host }; 
     55                } 
     56            } 
     57        } 
     58        else { 
     59            for my $host ( @$hosts ) { 
     60                push @{ $self->{hosts} }, { role => undef, host => $host }; 
     61            } 
     62        } 
     63    } 
    4264 
    4365    return $self; 
    …… 
    5173 
    5274    $self->run_hook('test'); 
     75 
    5376    $self->run_hook('format'); 
    5477 
    …… 
    6386 
    6487    for my $plugin ( @{ $self->{hooks}->{$hook} || [] } ) { 
    65         $plugin->pre_run($context, $args); 
    66         $plugin->finalize($context, $args) if $plugin->can('finalize'); 
     88        if ( $hook eq 'test' and $self->{hosts} ) { 
     89            for my $host ( @{ $self->{hosts} } ) { 
     90                next if ( $plugin->{role} and ( !defined $host->{role} or $host->{role} ne $plugin->{role} ) ); 
     91                $plugin->conf->{host} = $host->{host}; 
     92                $plugin->pre_run($context, $args); 
     93                $plugin->post_run($context, $args) if $plugin->can('post_run'); 
     94            } 
     95        } 
     96        else { 
     97            $plugin->pre_run($context, $args); 
     98            $plugin->post_run($context, $args) if $plugin->can('post_run'); 
     99        } 
    67100    } 
    68101} 
    …… 
    75108            my $class = "Assurer::Plugin::" . ucfirst $hook . "::$plugin->{module}"; 
    76109            $class->use or die $@; 
     110            $plugin->{config} ||= {}; 
    77111            push @{ $self->{hooks}->{$hook} }, $class->new($plugin); 
    78112        } 
    …… 
    81115 
    82116sub log { 
    83     my ($self, $level, $msg) = @_; 
    84     warn "[$level] $msg\n"; 
     117    my ( $self, $level, $msg, %opts ) = @_; 
     118 
     119    my $caller = $opts{caller}; 
     120 
     121    unless ($caller) { 
     122        my $i = 0; 
     123        while (my $c = caller($i++)) { 
     124            last if $c !~ /Plugin/; 
     125            $caller = $c; 
     126        } 
     127        $caller ||= caller(0); 
     128    } 
     129 
     130    if ($self->conf->{log}->{encoding}) { 
     131        $msg = Encode::decode_utf8($msg) unless utf8::is_utf8($msg); 
     132        $msg = Encode::encode($self->conf->{log}->{encoding}, $msg); 
     133    } 
     134 
     135    warn "$caller [$level] $msg\n"; 
    85136} 
    86137 

  • library/perl/trunk/Assurer/lib/Assurer/Plugin.pm

    r351 r352  
    99 
    1010    my $self = { %$args }; 
    11  
    1211    bless $self, $class; 
    1312 

  • library/perl/trunk/Assurer/lib/Assurer/Plugin/Format.pm

    r351 r352  
    77use Assurer::Format; 
    88 
     9sub pre_run { 
     10    my $self = shift; 
     11    return unless Assurer->context->results; 
     12    $self->run(@_); 
     13} 
     14 
    9151; 

  • library/perl/trunk/Assurer/lib/Assurer/Plugin/Test.pm

    r351 r352  
    88sub init { 
    99    my $self = shift; 
    10     my $name = $self->{name} || 'no name'; 
    11  
     10    $self->{name} ||= 'no name'; 
    1211    return $self; 
    1312} 
    …… 
    1514sub pre_run { 
    1615    my $self = shift; 
     16    $self->log( info => qq{Testing $self->{name} ...}, caller => ref $self ); 
    1717    Assurer->context->test->init($self->{name}); 
     18 
     19    $self->conf->{host} ||= Assurer->context->conf->{host}; 
     20 
    1821    $self->run(@_); 
    1922} 
    2023 
    21 sub finalize { 
     24sub post_run { 
    2225    my ( $self, $context, $args ) = @_; 
    2326 
    …… 
    3740} 
    3841 
    39  
     42sub conf { 
     43    my $self = shift; 
     44    return $self->{config}; 
     45} 
    4046 
    41471; 

  • library/perl/trunk/Assurer/lib/Assurer/Plugin/Test/HTTP.pm

    r351 r352  
    55use base qw( Assurer::Plugin::Test ); 
    66use Assurer::Test; 
    7 use LWP::Simple; 
     7use LWP::UserAgent; 
     8use HTTP::Request; 
    89 
    910sub run { 
    …… 
    1112 
    1213    my $test = $context->test; 
     14    my $conf = $self->conf; 
    1315 
    14     my $config = $self->{config}; 
     16    my $host = $conf->{host} || $context->conf->{host}; 
     17    my $port = $conf->{port} || '80'; 
     18    my $path = $conf->{path} || '/'; 
     19    $path = "/$path" if $path !~ m!^/!; 
     20    my $url = "http://$host:$port$path"; 
    1521 
    16     $config = [ $config ] if ref $config eq 'HASH'; 
     22    my $ua = LWP::UserAgent->new; 
     23    $ua->agent("Assurer/$Assurer::VERSION (http://mizzy.org/)"); 
    1724 
    18     for ( @$config ) { 
    19         my $url   = $_->{url}; 
    20         my $match = $_->{match}; 
     25    my $req = HTTP::Request->new( GET => $url ); 
     26    my $res = $ua->request($req); 
    2127 
    22         $test->like ( 
    23             get($url), 
    24             qr/$match/, 
    25             "Content of $url matches '$match'", 
     28    $test->is_num( $res->code, 200, "HTTP status code of $url is 200" ); 
     29 
     30    my $content = $conf->{content}; 
     31    if ( $content ) { 
     32        $test->like( 
     33            $res->content, 
     34            qr/$content/, 
     35            "Content of $url matches '$content'", 
    2636        ); 
    2737    } 
     38 
    2839} 
    2940