Changeset 22830


Ignore:
Timestamp:
09/09/10 10:45:05 (17 months ago)
Author:
alex
Message:

Check in prior to merge back onto trunk

Location:
branches/mnw21/pathquery_refactor/intermine/perl
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • branches/mnw21/pathquery_refactor/intermine/perl/Build.PL

    r22629 r22830  
    22 
    33my $build = Module::Build->new( 
    4                    module_name => 'InterMine', 
    5                    license     => 'perl', 
    6                    dist_author => 'FlyMine <info@flymine.org>', 
    7                    create_readme => 1, 
     4                   module_name      => 'InterMine', 
     5                   license          => 'perl', 
     6                   dist_author      => 'Alex Kalderimis <dev@intermine.org>', 
     7                   create_readme        => 1, 
    88                   recursive_test_files => 1, 
    99                               create_makefile_pl   => 'traditional', 
    10                    requires    => { 
    11                            'perl' => '5.8.0', 
    12                            'Carp' => 0, 
    13                            'File::Compare' => 0, 
    14                            'IO::All' => 0, 
    15                            'IO::String' => 0, 
    16                            'LWP::UserAgent' => 0, 
    17                            'Net::FTP' => 0, 
    18                            'URI' => 0, 
    19                            'XML::Parser::PerlSAX' => 0, 
    20                            'XML::Writer' => 0, 
    21                            'Scalar::Util' => 0, 
    22                            'List::MoreUtils' => 0, 
    23                           }, 
     10                   requires => { 
     11                   'perl'              => '5.8.3', 
     12                   'Clone'             => 0.26, 
     13                   'List::MoreUtils'           => 0.22, 
     14                   'LWP'                           => 5.8, 
     15                   'Module::Find'          => 0.05, 
     16                   'Moose'             => 0.95, 
     17                   'MooseX::Role::Parameterized'   => 0.10, 
     18                   'MooseX::Role::WithOverloading' => 0.03, 
     19                   'MooseX::Types'         => 0.22, 
     20                   'Perl::Tidy'            => 20070801, 
     21                   'Text::CSV_XS'          => 0.62, 
     22                   'URI'               => 1.37, 
     23                   'XML::Parser::PerlSAX'      => 0.08, 
     24                   'XML::Smart'            => '1.5.8', 
     25                   'XML::Writer'           => 0.602, 
     26                   }, 
     27                   recommends => { 
     28                   'YAML::Syck'          => 1.07, 
     29                   'Spreadsheet::WriteExcel' => 0, 
     30                   }, 
    2431                   build_requires => { 
    25                           'Test::Exception' => 0, 
    26                           'Test::More' => 0, 
    27                           'Test::Warn' => 0, 
    28                           'Test::XML' => 0, 
    29                           'Test::MockObject' => 0, 
    30                           'Text::CSV_XS' => 0, 
    31                          }, 
     32                   'Test::Class'           => 0, 
     33                   'Test::Exception'           => 0, 
     34                   'Test::More'            => 0, 
     35                   'Test::XML'             => 0, 
     36                   'Test::MockObject'          => 0, 
     37                   'Test::MockObject::Extends' => 0, 
     38                   'XML::Rules'            => 0, 
     39                   }, 
    3240                  ); 
    3341$build->create_build_script; 

  • branches/mnw21/pathquery_refactor/intermine/perl/Changes

    r21300 r22830  
    10100.03    Fri May  7 16:15:35 BST 2010 
    1111    Added Template classes 
     12 

  • branches/mnw21/pathquery_refactor/intermine/perl/MANIFEST.SKIP

    r22630 r22830  
    1010[Uu]til 
    1111experimental 
     12extras 
    1213\.zip$ 
    1314\.tar\.gz$ 

  • branches/mnw21/pathquery_refactor/intermine/perl/lib/InterMine/Query/Roles/HTMLTable.pm

    r22669 r22830  
    55requires qw(results_iterator views); 
    66 
    7 my $role = 'InterMine::ResultsIterator::Role::HTMLTableRow'; 
     7my $role = 'InterMine::ResultIterator::Role::HTMLTableRow'; 
    88 
    99sub results_as_html_table { 

  • branches/mnw21/pathquery_refactor/intermine/perl/t/09_intermine/01_integration.t

    r22676 r22830  
    22use warnings; 
    33 
    4 use Test::More tests => 30; 
     4use lib 't/tests'; 
     5 
     6use Test::More tests => 40; 
    57use Test::MockObject::Extends; 
    68use Test::Exception; 
    79use HTTP::Response; 
    810use IO::File; 
     11use YAML::Syck; 
    912 
    1013sub slurp { 
    1114    my $file = shift; 
    12     open(my $FH, '<', $file) or die "Could not open $file for reading"; 
    13     my $content = join('', <$FH>); 
    14     close $FH or die "Could not close $file after finishing reading"; 
    15     return $content; 
     15    return join('', IO::File->new($file, 'r')->getlines); 
    1616} 
    1717 
    1818my $module = 'InterMine'; 
    1919 
    20 my $model_file     = 't/data/testmodel_model.xml'; 
    21 my $results_file   = 't/data/mock_results'; 
    22 my $templates_file = 't/data/default-template-queries.xml'; 
    23  
    24 my $model     = slurp($model_file); 
     20my $results_file = 't/data/mock_content_results'; 
     21 
     22my $model     = slurp('t/data/testmodel_model.xml'); 
    2523my $results   = slurp($results_file); 
    26 my $templates = slurp($templates_file); 
     24my $templates = slurp('t/data/default-template-queries.xml'); 
    2725 
    2826my $fake_lwp = Test::MockObject::Extends->new('LWP::UserAgent'); 
    … …  
    4139        $content = $templates; 
    4240    } 
    43     elsif ($uri =~ m!model!) { 
     41    elsif ($uri =~ m!/model\?!) { 
    4442        $content = $model; 
    4543    } 
    … …  
    4745        $content = 2; 
    4846    } 
    49     elsif ($uri =~ m!results!) { 
     47    elsif ($uri =~ m!/results\?!) { 
    5048        $content = $results; 
    5149    } 
    … …  
    6058    new => sub { 
    6159    delete $fake_IOSock->{io}; 
    62     $fake_IOSock->{io} = IO::File->new($results_file, "r"); 
     60    $fake_IOSock->{io} = IO::File->new($results_file, 'r'); 
    6361    return $fake_IOSock; 
    6462    }, 
    … …  
    176174is(ref $res->[0], 'ARRAY', "An array of arrays in fact"); 
    177175 
    178 is($res->[1][3], "Chédin S", "With the right fields"); 
     176is($res->[1][3], "Chédin S", "With the right fields") 
     177    or diag(explain $res); 
    179178 
    180179lives_ok( 
    … …  
    185184is($res->[1]->{'Employee.address.address'}, "Chédin S", "with the right fields"); 
    186185 
     186my $test_role = 'Test::InterMine::FooBar'; 
     187my $q_roled; 
     188lives_ok( 
     189    sub {$q_roled = InterMine->new_query(with => [$test_role])}, 
     190    "Can make a query with a role", 
     191); 
     192 
     193is($q_roled->foo, "bar", "And it does what it's meant to"); 
     194 
     195 
     196my $role = 'InterMine::ResultIterator::Role::HTMLTableRow'; 
     197my $ri; 
     198lives_ok( 
     199    sub {$ri = $q->results_iterator(with => [$role, $test_role])}, 
     200    "Gets a results iterator with a role", 
     201); 
     202is($ri->foo, 'bar', "And it has one of the methods"); 
     203 
     204my $row = "<tr><td>S000000001</td><td>YAL001C</td><td>10531351</td><td>Rubbi L</td><td>J Biol Chem</td><td>1999</td><td>Saccharomyces cerevisiae</td></tr>"; 
     205is($ri->html_row, $row, "And it has the other"); 
     206 
    187207my $t; 
    188208lives_ok( 
    … …  
    203223 
    204224is($t->results->[1][3],  "Chédin S", "And ditto for results"); 
     225 
     226$role = 'InterMine::Query::Roles::HTMLTable'; 
     227lives_ok( 
     228    sub {$t = $module->template('employeeByName', with => [$role, $test_role]);}, 
     229    "Gets a template with a role ok", 
     230); 
     231is($t->foo, 'bar', "Does test role ok"); 
     232like( 
     233    $t->results_as_html_table, 
     234    qr|^<table>(?:<tr>(?:<td>.*</td>)*</tr>)*</table>$|, 
     235    "Makes a table of results ok" 
     236); 
     237$role = 'InterMine::Query::Roles::WriteOutYaml'; 
     238$t = $module->template('employeeByName', with => [$role]); 
     239my $out_buffer; 
     240open(my $out_handle, '>', \$out_buffer) or die $!; 
     241lives_ok( 
     242    sub{$t->dump_yaml_to_file(file => $out_handle);}, 
     243    "lives dumping yaml", 
     244); 
     245my $data = Load($out_buffer); 
     246is_deeply($data, $res, "Yamlises, and back, ok"); 

  • branches/mnw21/pathquery_refactor/intermine/perl/t/tests/Test/InterMine/ResultIterator.pm

    r22675 r22830  
    66 
    77use base 'Test::Class'; 
     8use Encode; 
    89use Test::More; 
    910use Test::Exception; 
    … …  
    4243    my $fake_connection = Test::MockObject::->new; 
    4344    $fake_connection->{io} = IO::File->new($results, 'r'); 
     45    $fake_connection->set_isa('IO::String'); 
    4446    $fake_connection->set_isa('Net::HTTP'); 
    4547    $fake_connection->mock( 
    … …  
    4749        my $self = shift; 
    4850        return $self->{io}->getline; 
     51    }, 
     52    ); 
     53    $fake_connection->mock( 
     54    getlines => sub { 
     55        my $self = shift; 
     56        return $self->{io}->getlines; 
    4957    }, 
    5058    ); 
    … …  
    102110    dies_ok( 
    103111    sub {$test->class->new( 
    104         connection => $test->fake_connection($test->mock_results), 
     112        content => $test->fake_connection($test->mock_results), 
    105113        ); 
    106114     }, 
    … …  
    116124    dies_ok( 
    117125    sub {$test->class->new( 
    118         connection => 'foo', 
     126        content => 'foo', 
    119127        view_list  => $test->view_list, 
    120128        ); 
    … …  
    124132    dies_ok( 
    125133    sub {$test->class->new( 
    126         connection => $test->fake_connection($test->mock_results), 
     134        content => $test->fake_connection($test->mock_results), 
    127135        view_list  => 'foo', 
    128136        ); 
    … …  
    263271} 
    264272 
    265  
    266  
     273sub content : Test(2) { 
     274    my $test = shift; 
     275    my $ri = new_ok( 
     276    $test->class, 
     277    [content => $test->fake_connection($test->mock_results), 
     278     view_list  => $test->view_list] 
     279    ); 
     280    my @linesRI = $ri->all_lines('string'); 
     281    my @linesFC = $test->fake_connection($test->mock_results)->getlines; 
     282 
     283    # These should be the only transformations done to the raw content 
     284    map {s/\015?\012//} @linesFC; 
     285    @linesFC = map {encode_utf8($_)} @linesFC; 
     286 
     287    is_deeply( 
     288    \@linesRI, \@linesFC, "Can handle results in content too" 
     289    ); 
     290} 
    267291 
    268292 

  • branches/mnw21/pathquery_refactor/intermine/perl/t/tests/Test/InterMine/Service.pm

    r22675 r22830  
    11package Test::InterMine::Service; 
     2 
     3#TODO - add tests for apply role, and new_query 
    24 
    35use base 'Test::Class'; 
    … …  
    7678        }, 
    7779        ); 
    78     $fakeRes->set_false('is_error'); 
     80    $fakeRes->set_false('is_error') 
     81            ->mock(code => sub {'FAKE_CODE'}) 
     82            ->mock(message => sub {'FAKE_MESSAGE'}); 
    7983    $test->{Res} = $fakeRes; 
    8084 
    … …  
    9397            ->mock(get => sub { 
    9498               my ($self, $uri) = @_; 
    95                my $url = $uri->{_url}; 
     99               my $url = $uri->{_url} || $uri; 
    96100               if ($url =~ m!/model!) { 
    97101               $fakeRes->{_content} = $model; 
    … …  
    144148} 
    145149 
    146 sub get_results_iterator : Test(6) { 
     150sub get_results_iterator : Test(4) { 
    147151    my $test     = shift; 
    148152    my $url      = $test->fake_queryurl; 
    149153    my $viewlist = $test->fake_viewlist; 
    150154    my $object   = $test->object; 
    151     my $response = $object->get_results_iterator($url, $viewlist); 
     155    my $response; 
     156    lives_ok( 
     157    sub {$response = $object->get_results_iterator($url, $viewlist);}, 
     158    "Calls for a result iterator ok", 
     159    ); 
     160 
    152161    is_deeply( 
    153162    $response->{_init_args}{view_list}, $viewlist, 
    … …  
    155164    ); 
    156165    is( 
    157     $response->{_init_args}{connection}{_write_args}{GET}, $url, 
    158     '... handles url correctly' 
    159     ); 
    160     is( 
    161     $response->{_init_args}{connection}{_write_args}{'User-Agent'}, 
    162     $test->user_agent, 
    163     "... sets the user agent string in the right place", 
    164     ); 
    165     is( 
    166     $response->{_init_args}{connection}{_init_args}{Host}, 'URI-HOST', 
    167     '... puts host in the right place', 
    168     ); 
     166    $response->{_content}, 
     167    $test->user_agent . $url, 
     168    "... handles agent and url correctly" 
     169    ) or diag(explain $test->{Res}); 
     170    # is( 
     171    #   $response->{_init_args}{connection}{_write_args}{'User-Agent'}, 
     172    #   $test->user_agent, 
     173    #   "... sets the user agent string in the right place", 
     174    # ); 
     175    # is( 
     176    #   $response->{_init_args}{connection}{_init_args}{Host}, 'URI-HOST', 
     177    #   '... puts host in the right place', 
     178    # ); 
    169179    $test->{Res}->set_true('is_error'); 
    170180    throws_ok( 
    … …  
    173183    '... Catches response errors correctly', 
    174184    ); 
    175     $test->{connection}->fake_module( 
    176     'Net::HTTP', 
    177     new => sub {return undef}, 
    178     ); 
    179     throws_ok( 
    180     sub {$object->get_results_iterator}, 
    181     qr/Could not connect to host/, 
    182     '... Catches connection errors correctly', 
    183     ); 
     185    # $test->{connection}->fake_module( 
     186    #   'Net::HTTP', 
     187    #   new => sub {return undef}, 
     188    # ); 
     189    # throws_ok( 
     190    #   sub {$object->get_results_iterator}, 
     191    #   qr/Could not connect to host/, 
     192    #   '... Catches connection errors correctly', 
     193    # ); 
    184194} 
    185195 
Note: See TracChangeset for help on using the changeset viewer.