Changeset 82

Show
Ignore:
Timestamp:
09/12/06 09:09:59 (2 years ago)
Author:
evdb
Message:

Added caching to the list pages - just need to add tests now.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lib/PrlMnks/DBI.pm

    r81 r82  
    3636    my $class = shift; 
    3737    my $dbh   = shift; 
     38    my @sql   = (); 
    3839 
    39     my $sql = << "SQL_END"; 
    40 create table nodes ( 
    41     node_id         integer primary key, 
    42     title           text, 
    43     created         text, 
    44     updated         text, 
    45     year            integer, 
    46     month           integer, 
    47     type_id         integer, 
    48     type_name       text, 
    49     author_id       integer, 
    50     author_name     text, 
    51     content         text, 
    52     root_node_id    integer, 
    53     parent_node_id  integer 
    54 ); 
    55 SQL_END 
     40    push @sql, 
     41      "create table nodes (                                " 
     42      . "    node_id         integer primary key,            " 
     43      . "    title           text,                           " 
     44      . "    created         text,                           " 
     45      . "    updated         text,                           " 
     46      . "    year            integer,                        " 
     47      . "    month           integer,                        " 
     48      . "    type_id         integer,                        " 
     49      . "    type_name       text,                           " 
     50      . "    author_id       integer,                        " 
     51      . "    author_name     text,                           " 
     52      . "    content         text,                           " 
     53      . "    root_node_id    integer,                        " 
     54      . "    parent_node_id  integer                         " 
     55      . ");                                                  "; 
    5656 
    57     $dbh->do($sql) || die $dbh->errstr; 
     57    push @sql,                             # 
     58      "CREATE INDEX nodes_type_index" .    # 
     59      " ON nodes( type_name );"; 
     60 
     61    push @sql,                                  # 
     62      "CREATE INDEX nodes_type_year_index" .    # 
     63      " ON nodes( type_name, year );"; 
     64 
     65    push @sql,                                  # 
     66      "CREATE INDEX nodes_type_year_month_index" 
     67      . " ON nodes( type_name, year, month );"; 
     68 
     69    for (@sql) { 
     70        $dbh->do($_) || die $dbh->errstr; 
     71    } 
    5872} 
    5973 

  • trunk/lib/PrlMnks/Plugin.pm

    r81 r82  
    180180my %SUFFIX_TO_MIME_TYPE = ( 
    181181    ''     => 'text/html', 
     182    'css'  => 'text/css', 
     183    'gif'  => 'image/gif', 
     184    'html' => 'text/html', 
     185    'ico'  => 'image/x-icon', 
     186    'jpg'  => 'image/jpeg', 
     187    'json' => 'application/json', 
     188    'png'  => 'image/png', 
    182189    'txt'  => 'text/plain', 
    183190    'xml'  => 'text/xml', 
    184     'ico'  => 'image/x-icon', 
    185     'png'  => 'image/png', 
    186     'jpg'  => 'image/jpeg', 
    187     'gif'  => 'image/gif', 
    188     'html' => 'text/html', 
    189     'json' => 'application/json', 
    190191); 
    191192 
    …… 
    196197    # If the file is not there then 404 
    197198    return $self->error_404 unless -e $file; 
    198  
    199     # use Time::HiRes 'time'; 
    200     # warn "1 - " . time; 
    201199 
    202200    # Has the file changed? 
    …… 
    211209    } 
    212210 
    213     warn "2 - " . time; 
    214  
    215211    # content type based on file suffix 
    216212    $file =~ m{ \. ([^\./]+) \z }xms; 

  • trunk/lib/PrlMnks/Plugin/List.pm

    r81 r82  
    1010=head1 URL 
    1111 
    12   /list/node_type/year/month 
     12  /list/type_name/year/month 
    1313 
    14 all can be empty. If no C<node_type> then a list of categories is shown. If 
     14all can be empty. If no C<type_name> then a list of categories is shown. If 
    1515there is no year or month specified then the current year and month are used. 
    1616 
    1717=cut 
     18 
     19sub add_node { 
     20    my $self      = shift; 
     21    my $node      = shift; 
     22    my $node_data = $node->as_hashref; 
     23    my @to_delete = (); 
     24 
     25    push @to_delete,    # 
     26      $self->list_file( @$node_data{qw( type_name  )} ), 
     27      $self->list_file( @$node_data{qw( type_name year  )} ), 
     28      $self->list_file( @$node_data{qw( type_name year month )} ); 
     29 
     30    foreach my $file (@to_delete) { 
     31        next unless -e $file; 
     32        unlink $file; 
     33    } 
     34 
     35    return 1; 
     36} 
     37 
     38sub update_node { die } 
     39sub delete_node { die } 
     40 
     41sub list_file { 
     42    my $self = shift; 
     43    return $self->shared( 'list', grep { $_ } @_ ) . '.html'; 
     44} 
    1845 
    1946sub start_of_url { '/list/' } 
    …… 
    2754    # If any of the values are undef then the url is bad - 404 it. 
    2855    return $self->error_404 if grep { !defined $_ } values %$args; 
     56 
     57    # work out what the cached file name should be. 
     58    my $cache_file = $self->list_file( @$args{qw(type_name year month)} ); 
     59 
     60    # if the content is cached then use that. 
     61    return $self->send_file($cache_file) if -e $cache_file; 
    2962 
    3063    # Set the vars to args. 
    …… 
    4073 
    4174    # If this is the homepage then use the homepage template. 
    42     return $self->send_template('/list/list.mason'); 
     75    return $self->send_template( '/list/list.mason', 
     76        { cache_to => $cache_file } ); 
    4377} 
    4478 
    …… 
    5791 
    5892    # get the details from the url. 
    59     my ( $undef, $list, $node_type, $year, $month ) = split /\//, $url; 
     93    my ( $undef, $list, $type_name, $year, $month ) = split /\//, $url; 
    6094 
    61     # Get the node_type. If it is not allowed then set it to ''. 
    62     $node_type ||= ''; 
    63     $node_type = undef 
    64       unless $node_type eq '' 
    65       || PrlMnks::Type->get($node_type); 
     95    # Get the type_name. If it is not allowed then set it to ''. 
     96    $type_name ||= ''; 
     97    $type_name = undef 
     98      unless $type_name eq '' 
     99      || PrlMnks::Type->get($type_name); 
    66100 
    67101    for ( $year, $month ) { 
    …… 
    75109      && ( $month < 1 || $month > 12 ); 
    76110 
    77     return { node_type => $node_type, year => $year, month => $month }; 
     111    return { type_name => $type_name, year => $year, month => $month }; 
    78112} 
    79113 
    …… 
    93127    my @sql_args = (); 
    94128 
    95     if ( !$args->{node_type} ) { 
     129    if ( !$args->{type_name} ) { 
    96130        $sql = "select distinct type_name"    # 
    97131          . " from nodes"                     # 
    …… 
    104138          . " where type_name = ?" 
    105139          . " order by year"; 
    106         @sql_args = ( $args->{node_type} ); 
     140        @sql_args = ( $args->{type_name} ); 
    107141    } 
    108142    elsif ( !$args->{month} ) { 
    …… 
    111145          . " where type_name = ? and year = ?" 
    112146          . " order by month"; 
    113         @sql_args = ( $args->{node_type}, $args->{year} ); 
     147        @sql_args = ( $args->{type_name}, $args->{year} ); 
    114148    } 
    115149 
    …… 
    137171      . "  order by node_id"; 
    138172 
    139     my @sql_args = @$args{qw( node_type year month )}; 
     173    my @sql_args = @$args{qw( type_name year month )}; 
    140174 
    141175    my @nodes = (); 

  • trunk/t/plugin/base/if-modified-since.t

    r73 r82  
    4848 
    4949# touch the file and check that we get a 200 again. 
     50sleep 2; # so that the change is not in the same second as above. 
    5051`echo 'bob' >> $file`; 
    5152$mech->get_ok( $url, "get '$url'" ); 

  • trunk/t/plugin/default/default.t

    r50 r82  
    2323# Get a static file - check content-type 
    2424 
    25 my %tests = ( '/robots.txt' => 'text/plain', '/' => 'text/html' ); 
     25my %tests = ( 
     26    '/'                => 'text/html', 
     27    '/css/default.css' => 'text/css', 
     28    '/robots.txt'      => 'text/plain', 
     29); 
    2630 
    2731while ( my ( $url, $ct ) = each %tests ) { 

  • trunk/t/plugin/list/url_to_args.t

    r81 r82  
    1111use PrlMnks::Plugin::List; 
    1212 
    13 #    0    1    2     3     4    5     6     7     8 
    14 # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) 
    15  
    16 # my @date  = localtime; 
    17 # my $year  = $date[5] + 1900; 
    18 # my $month = $date[4] + 1; 
    19 #  
    20 # diag "year: '$year', month: '$month'."; 
    21  
    2213my %tests = ( 
    2314 
    2415    "/list/" => { 
    25         node_type => "", 
     16        type_name => "", 
    2617        year      => "", 
    2718        month     => "", 
    …… 
    2920 
    3021    "/list/perlmeditation" => { 
    31         node_type => "perlmeditation", 
     22        type_name => "perlmeditation", 
    3223        year      => "", 
    3324        month     => "", 
    …… 
    3526 
    3627    "/list/perlmeditation/2005" => { 
    37         node_type => "perlmeditation", 
     28        type_name => "perlmeditation", 
    3829        year      => 2005, 
    3930        month     => "", 
    …… 
    4132 
    4233    "/list/perlmeditation/2005/10" => { 
    43         node_type => "perlmeditation", 
     34        type_name => "perlmeditation", 
    4435        year      => 2005, 
    4536        month     => 10, 
    …… 
    4738 
    4839    "/list/bogus/2005/10" => { 
    49         node_type => undef, 
     40        type_name => undef, 
    5041        year      => 2005, 
    5142        month     => 10, 
    …… 
    5344 
    5445    "/list/perlmeditation/bogus/10" => { 
    55         node_type => "perlmeditation", 
     46        type_name => "perlmeditation", 
    5647        year      => undef, 
    5748        month     => 10, 
    …… 
    5950 
    6051    "/list/perlmeditation/2005/bogus" => { 
    61         node_type => "perlmeditation", 
     52        type_name => "perlmeditation", 
    6253        year      => 2005, 
    6354        month     => undef, 
    …… 
    6556 
    6657    "/list/perlmeditation/2005/0" => { 
    67         node_type => "perlmeditation", 
     58        type_name => "perlmeditation", 
    6859        year      => 2005, 
    6960        month     => undef, 
    …… 
    7162 
    7263    "/list/perlmeditation/2005/13" => { 
    73         node_type => "perlmeditation", 
     64        type_name => "perlmeditation", 
    7465        year      => 2005, 
    7566        month     => undef, 

  • trunk/t/plugin/rss/rss.t

    r72 r82  
    1919} 
    2020 
    21 # Add a load of nodes to the database: 
    22 #         508076  Scrabble word arrangements with blank tiles 
    23 # 508076  508081  Re: Scrabble word arrangements with blank tiles 
    24 # 508076  508170  Re: Scrabble word arrangements with blank tiles 
    25 # 508170  508234  Re^2: Scrabble word arrangements with blank tiles 
    26 # 508234  508363  Re^3: Scrabble word arrangements with blank tiles 
    27 # 508076  508208  Re: Scrabble word arrangements with blank tiles 
    28 # 508208  508216  Re^2: Scrabble word arrangements with blank tiles 
    29 # 508208  508218  Re^2: Scrabble word arrangements with blank tiles 
    30 # 508218  508223  Re^3: Scrabble word arrangements with blank tiles 
    31 # 508208  508221  Re^2: Scrabble word arrangements with blank tiles 
    32 # 508221  508245  Re^3: Scrabble word arrangements with blank tiles 
    33 # 508076  508299  Re: Scrabble word arrangements with blank tiles 
    34 # 508299  508411  Re^2: Scrabble word arrangements with blank tiles 
    35 # 508299  509065  Re^2: Scrabble word arrangements with blank tiles 
    36 # 508076  508350  Re: Scrabble word arrangements with blank tiles 
    37 # 508076  509993  Re: Scrabble word arrangements with blank tiles 
    38 my @ids = ( 
    39  
    40     # Scrabble thread nodes 
    41     508076, 508081, 508170, 508208, 508216, 508218, 
    42     508221, 508223, 508234, 508245, 508299, 508350, 
    43     508363, 508411, 509065, 509993, 
    44  
    45     # Anonymous monk and perlquestions. 
    46     961, 432878, 115, 
    47 ); 
    48  
    49 # Foreach id create a node and then run the plugin on it. 
    50 my %nodes = (); 
    51 foreach my $id (@ids) { 
    52     my $node = 
    53       PrlMnks::Node->new( xml => scalar slurp "test_data/flat/$id-flat.xml" ); 
    54     $node->parse_xml && $node->save_to_db; 
    55     ok $p->add_node($node), "added node '$id'"; 
    56     $nodes{$id} = $node; 
    57 } 
     21my $nodes = setup_scrabble_data( plugin => $p ); 
    5822 
    5923# Fetch RSS for 508208, 508218, 508223. Check that the RSS is created and 
    …… 
    7034# Check that adding nodes leads to the parents being deleted - but not the 
    7135# children. 
    72 ok $p->add_node( $nodes{508218} ), "added node '508218'"; 
     36ok $p->add_node( $nodes->{508218} ), "added node '508218'"; 
    7337ok !-e $paths{508208}, "not found '$paths{508208}'"; 
    7438ok !-e $paths{508218}, "not found '$paths{508218}'"; 

  • trunk/t/setup_testing_environment.pl

    r65 r82  
    44use Test::WWW::Mechanize; 
    55use Carp; 
     6use Perl6::Slurp; 
    67 
    78# NOTE - do not 'use' any PrlMnks modules here as the ENV variables must be 
    …… 
    910 
    1011# Set the environment variables correctly 
    11 $ENV{PRLMNKS_SHARED}  = ''; 
    12 $ENV{PRLMNKS_BASE}    = 't/base'; 
    13 $ENV{PRLMNKS_CURRENT} = '.'; 
     12BEGIN { 
     13    $ENV{PRLMNKS_SHARED}  = ''; 
     14    $ENV{PRLMNKS_BASE}    = 't/base'; 
     15    $ENV{PRLMNKS_CURRENT} = '.'; 
     16} 
    1417 
    1518eval("use PrlMnks; 1;")      || die $@; 
    …… 
    4245} 
    4346 
     47sub setup_scrabble_data { 
     48    my %args   = @_; 
     49    my $plugin = $args{plugin}; 
     50 
     51    # Add a load of nodes to the database: 
     52    #         508076  Scrabble word arrangements with blank tiles 
     53    # 508076  508081  Re: Scrabble word arrangements with blank tiles 
     54    # 508076  508170  Re: Scrabble word arrangements with blank tiles 
     55    # 508170  508234  Re^2: Scrabble word arrangements with blank tiles 
     56    # 508234  508363  Re^3: Scrabble word arrangements with blank tiles 
     57    # 508076  508208  Re: Scrabble word arrangements with blank tiles 
     58    # 508208  508216  Re^2: Scrabble word arrangements with blank tiles 
     59    # 508208  508218  Re^2: Scrabble word arrangements with blank tiles 
     60    # 508218  508223  Re^3: Scrabble word arrangements with blank tiles 
     61    # 508208  508221  Re^2: Scrabble word arrangements with blank tiles 
     62    # 508221  508245  Re^3: Scrabble word arrangements with blank tiles 
     63    # 508076  508299  Re: Scrabble word arrangements with blank tiles 
     64    # 508299  508411  Re^2: Scrabble word arrangements with blank tiles 
     65    # 508299  509065  Re^2: Scrabble word arrangements with blank tiles 
     66    # 508076  508350  Re: Scrabble word arrangements with blank tiles 
     67    # 508076  509993  Re: Scrabble word arrangements with blank tiles 
     68    my @ids = ( 
     69 
     70        # Scrabble thread nodes 
     71        508076, 508081, 508170, 508208, 508216, 508218, 
     72        508221, 508223, 508234, 508245, 508299, 508350, 
     73        508363, 508411, 509065, 509993, 
     74 
     75        # Anonymous monk and perlquestions. 
     76        961, 432878, 115, 
     77    ); 
     78 
     79    # Foreach id create a node and then run the plugin on it. 
     80    my %nodes = (); 
     81    foreach my $id (@ids) { 
     82        my $node = 
     83          PrlMnks::Node->new( 
     84            xml => scalar slurp "test_data/flat/$id-flat.xml" ); 
     85        $node->parse_xml && $node->save_to_db; 
     86        ok $plugin->add_node($node), "added node '$id'"; 
     87        $nodes{$id} = $node; 
     88    } 
     89 
     90    return \%nodes; 
     91 
     92} 
     93 
    44941; 
    4595 

  • trunk/templates/list/list.mason

    r81 r82  
    99 
    1010<%args> 
    11   $node_type 
     11  $type_name 
    1212  $year 
    1313  $month 
    …… 
    2626 
    2727<%perl> 
    28     if ( ! $node_type  ) { 
    29         $m->comp( 'list_options.mason', what => 'node_type' ); 
     28    if ( ! $type_name  ) { 
     29        $m->comp( 'list_options.mason', what => 'type_name' ); 
    3030    } elsif ( ! $year ) { 
    3131        $m->comp( 'list_options.mason', what => 'year' ); 

  • trunk/templates/list/list_options.mason

    r81 r82  
    1313 
    1414    my $base_url = '/list'; 
    15     foreach my $key ( qw( node_type year month ) ) { 
     15    foreach my $key ( qw( type_name year month ) ) { 
    1616        last unless $vars->{$key}; 
    1717        $base_url .= "/$vars->{$key}"; 

  • trunk/templates/top.mason

    r81 r82  
     1<?xml version="1.0" encoding="UTF-8"?> 
     2 
     3<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" 
     4  "http://www.w3.org/TR/html4/loose.dtd"> 
     5 
    16<%args> 
    27  $title