Changeset 49

Show
Ignore:
Timestamp:
07/11/06 00:10:13 (2 years ago)
Author:
evdb
Message:

Fixed some bugs and started on rendering of the RSS

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lib/PrlMnks/Node.pm

    r47 r49  
    229229        push @{ $parent_to_children->{$parent_id} }, $id; 
    230230    } 
     231 
     232    $parent_to_children->{nodes} = $family; 
    231233 
    232234    return $parent_to_children; 

  • trunk/lib/PrlMnks/Plugin.pm

    r48 r49  
    151151    ); 
    152152 
     153    warn join ', ', sort keys %ENV; 
     154 
    153155    if ( my $cache_file = $options->{cache_to} ) { 
    154         PrlMnks::Utils->write_to_file( $cache_file, $content );    } 
     156        PrlMnks::Utils->write_to_file( $cache_file, $content ); 
     157    } 
    155158 
    156159    $self->res->code(200); 

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

    r48 r49  
    44package PrlMnks::Plugin::RSS; 
    55use base "PrlMnks::Plugin"; 
     6 
     7use Data::Dumper; 
     8use PrlMnks::Node; 
    69 
    710sub add_node { 
    …… 
    1922    } 
    2023 
    21     1; 
     24    return 1; 
    2225} 
    2326 
    …… 
    4649    return $self->send_file($file) if -e $file; 
    4750 
     51    # Get the node 
     52    my $node = PrlMnks::Node->new( node_id => $id ); 
     53    $self->vars->{node} = $node; 
     54 
     55    # If there is no node then return 404 
     56    return $self->send_file($file) unless $node; 
     57 
     58    # Otherwise create the RSS for the node. 
    4859    return $self->send_template( '/rss/index.mason', { cache_to => $file } ); 
    4960} 

  • trunk/lib/PrlMnks/RSS.pm

    r10 r49  
    33 
    44package PrlMnks::RSS; 
    5 use base 'PrlMnks' 
    6  
    7 use XML::RSS; 
    8 use HTML::Strip; 
    9 use File::Spec; 
    10  
    11 sub new { 
    12     my $class = shift; 
    13  
    14     my $self = {}; 
    15     bless $self, $class; 
    16  
    17     $self->setup_rss; 
    18     return $self; 
    19 } 
    20  
    21 sub setup_rss { 
    22     my $self = shift; 
    23  
    24     $$self{rss} = XML::RSS->new( version => '2.0' ); 
    25     return 1; 
    26 } 
    27  
    28 sub set_title { 
    29     my $self  = shift; 
    30     my $title = shift; 
    31  
    32     $$self{title} = $title; 
    33  
    34     $$self{rss}->channel( 
    35         title       => 'prlmnks.org: ' . $title, 
    36         link        => 'http://www.prlmnks.org', 
    37         language    => 'en', 
    38         description => 'RSS feeds from perlmonks.org', 
    39         ttl         => 5, 
    40     ); 
    41     return 1; 
    42 } 
    43  
    44 sub set_name { 
    45     my $self = shift; 
    46     $$self{name} = shift; 
    47     return 1; 
    48 } 
    49  
    50 sub add_node { 
    51     my $self = shift; 
    52     my $node = shift; 
    53  
    54     my $title = $node->title; 
    55  
    56     my $hs = HTML::Strip->new; 
    57     my $description = $hs->parse( $node->content ) || $node->content; 
    58     $description = substr $description, 0, $self->conf('rss_description_cutoff'); 
    59  
    60     $$self{rss}->add_item( 
    61         title => $title, 
    62         link  => "http://perlmonks.org/index.pl?node_id=" . $node->node_id, 
    63         description => $description, 
    64     ); 
    65  
    66     return 1; 
    67 } 
    68  
    69 sub save { 
    70     my $self = shift; 
    71  
    72     # Untaint the node id. 
    73     $$self{name} =~ m/([a-z0-9]+)/; 
    74     my $name = $1 . ".xml"; 
    75  
    76     my $filename = $self->dir( $self->conf('rss_dir'), $name ); 
    77  
    78     return $$self{rss}->save($filename); 
    79 } 
    80  
    81 sub as_string { 
    82     my $self = shift; 
    83     return $$self{rss}->as_string; 
    84 } 
     5use base 'PrlMnks'; 
    856 
    8671; 
     8 
     9# use XML::RSS; 
     10# use HTML::Strip; 
     11# use File::Spec; 
     12#  
     13# sub new { 
     14#     my $class = shift; 
     15#  
     16#     my $self = {}; 
     17#     bless $self, $class; 
     18#  
     19#     $self->setup_rss; 
     20#     return $self; 
     21# } 
     22#  
     23# sub setup_rss { 
     24#     my $self = shift; 
     25#  
     26#     $$self{rss} = XML::RSS->new( version => '2.0' ); 
     27#     return 1; 
     28# } 
     29#  
     30# sub set_title { 
     31#     my $self  = shift; 
     32#     my $title = shift; 
     33#  
     34#     $$self{title} = $title; 
     35#  
     36#     $$self{rss}->channel( 
     37#         title       => 'prlmnks.org: ' . $title, 
     38#         link        => 'http://www.prlmnks.org', 
     39#         language    => 'en', 
     40#         description => 'RSS feeds from perlmonks.org', 
     41#         ttl         => 5, 
     42#     ); 
     43#     return 1; 
     44# } 
     45#  
     46# sub set_name { 
     47#     my $self = shift; 
     48#     $$self{name} = shift; 
     49#     return 1; 
     50# } 
     51#  
     52# sub add_node { 
     53#     my $self = shift; 
     54#     my $node = shift; 
     55#  
     56#     my $title = $node->title; 
     57#  
     58#     my $hs = HTML::Strip->new; 
     59#     my $description = $hs->parse( $node->content ) || $node->content; 
     60#     $description = substr $description, 0, $self->conf('rss_description_cutoff'); 
     61#  
     62#     $$self{rss}->add_item( 
     63#         title => $title, 
     64#         link  => "http://perlmonks.org/index.pl?node_id=" . $node->node_id, 
     65#         description => $description, 
     66#     ); 
     67#  
     68#     return 1; 
     69# } 
     70#  
     71# sub save { 
     72#     my $self = shift; 
     73#  
     74#     # Untaint the node id. 
     75#     $$self{name} =~ m/([a-z0-9]+)/; 
     76#     my $name = $1 . ".xml"; 
     77#  
     78#     my $filename = $self->dir( $self->conf('rss_dir'), $name ); 
     79#  
     80#     return $$self{rss}->save($filename); 
     81# } 
     82#  
     83# sub as_string { 
     84#     my $self = shift; 
     85#     return $$self{rss}->as_string; 
     86# } 
     87#  
     88# 1; 

  • trunk/lib/PrlMnks/Template.pm

    r38 r49  
    1010use HTML::Mason; 
    1111use URI::Escape; 
     12use Data::Dumper; 
     13 
    1214 
    1315sub process { 
    …… 
    2729    $mi->set_global( vars => $vars ); 
    2830 
    29     $mi->exec( $template_file, () ); 
     31    $mi->exec( $template_file, %$vars ); 
    3032 
    3133    return \$output_buffer; 

  • trunk/lib/PrlMnks/WWW.pm

    r46 r49  
    1010# Go through all the plugins and store them in a hash based on the url that 
    1111# they can process. 
    12 my %URL_TO_PLUGIN = 
    13   map { $_->start_of_url() => $_ }    # 
    14   grep { $_->can('start_of_url') }    # 
    15   PrlMnks->plugins; 
     12my $URL_TO_PLUGIN = undef; 
    1613 
    17 # warn Dumper \%URL_TO_PLUGIN; 
     14sub _init_lookup { 
     15    %$URL_TO_PLUGIN = 
     16      map { $_->start_of_url() => $_ }    # 
     17      grep { $_->can('start_of_url') }    # 
     18      PrlMnks->plugins; 
     19 
     20    # warn Dumper $URL_TO_PLUGIN; 
     21} 
    1822 
    1923=head2 plugin_for_url 
    …… 
    3438    my $start = $1 || ''; 
    3539 
    36     return $URL_TO_PLUGIN{$start} 
    37       || $URL_TO_PLUGIN{''} 
     40    _init_lookup() if !$URL_TO_PLUGIN; 
     41 
     42    return $URL_TO_PLUGIN->{$start} 
     43      || $URL_TO_PLUGIN->{''} 
    3844      || die "Could not find a plugin for '$url'"; 
    3945} 
    …… 
    7480    # warn "Using plugin '$plugin_class' for '$url'"; 
    7581 
    76     $plugin->process || die "Could not process '$plugin'"; 
     82    $plugin->process() || die "Could not process '$plugin'"; 
    7783 
    7884    # Bit of a dirty hack. 

  • trunk/lib/PrlMnks/WWW/RSS.pm

    r38 r49  
    1 use strict; 
    2 use warnings; 
     11; 
    32 
    4 use base 'Prlmnks::WWW'; 
    5  
    6 use PrlMnks::Node; 
    7 use PrlMnks::RSS; 
    8 use CGI; 
    9 use Data::Dumper; 
    10  
    11 sub run { 
    12  
    13     my $id = $self->cgi->url( -absolute => 1 ); 
    14     $id =~ s/^\/rss\/(.*).xml$/$1/; 
    15  
    16     $self->debug("Looking at '$id'"); 
    17  
    18     # What sort of request is this? 
    19     $id =~ m{ \A \d+ \z}xms    # is it an id? 
    20       ? process_id($id)        # if so process it 
    21       : process_category($id); # assume a category 
    22  
    23     return 1; 
    24 } 
    25  
    26 ################################################################################ 
    27  
    28 sub process_id { 
    29     my $node_id = shift; 
    30     my $node    = PrlMnks::Node->retrieve($node_id); 
    31  
    32     unless ($node) { 
    33         require PrlMnks::Daemon; 
    34         $node = 
    35           PrlMnks::Daemon->new( DEBUG => $DEBUG ) 
    36           ->fetch_and_store_node($node_id); 
    37  
    38         die "Could not fetch the node id: '$node_id'"; 
    39     } 
    40  
    41     my $node_type = $node->node_type; 
    42     warn "Node type is '$node_type'\n" if $DEBUG; 
    43  
    44     my @nodes = (); 
    45  
    46     # Get the nodes to xmlify. 
    47     if ( $node_type =~ m/^user/ ) { 
    48         @nodes = PrlMnks::Node->search( 
    49             author_id => $node->node_id, 
    50             { order_by => 'node_id desc' } 
    51         ); 
    52     } 
    53  
    54     elsif ( $node_type eq 'note' ) { 
    55         @nodes = ( 
    56             $node, 
    57             PrlMnks::Node->search( 
    58                 parent_id => $node->node_id, 
    59                 { order_by => 'node_id desc' } 
    60             ) 
    61         ); 
    62     } 
    63  
    64     else { 
    65         @nodes = PrlMnks::Node->search( root_id => $node->node_id ); 
    66  
    67         # Order the nodes by thread. 
    68         @nodes = order_by_thread( $node->node_id, @nodes ); 
    69  
    70         unshift @nodes, $node; 
    71     } 
    72  
    73     create_rss( 
    74         title => $node->title, 
    75         name  => $node->node_id, 
    76         nodes => \@nodes 
    77     ); 
    78 } 
    79  
    80 sub order_by_thread { 
    81     my $top_id   = shift; 
    82     my @nodes_in = @_; 
    83  
    84     my %ids_to_nodes = map { $_->node_id => $_ } @nodes_in; 
    85  
    86     #warn "top_id is '$top_id'"; 
    87  
    88     my %hash = thread_build_hash(@nodes_in); 
    89  
    90     my @ids = thread_sort_hash( $top_id, %hash ); 
    91  
    92     #warn Dumper( \@ids); 
    93  
    94     my @nodes = (); 
    95     push @nodes, $ids_to_nodes{$_} for @ids; 
    96  
    97     return @nodes; 
    98 } 
    99  
    100 sub thread_build_hash { 
    101  
    102     # Build a hash 
    103     my @nodes   = @_; 
    104     my %parents = (); 
    105  
    106     foreach my $node (@nodes) { 
    107         my $parent_id = $node->parent_id; 
    108  
    109         #warn "adding '$parent_id' to \%parents"; 
    110         push @{ $parents{$parent_id} }, $node->node_id; 
    111     } 
    112  
    113     #warn Dumper( \%parents ); 
    114  
    115     return %parents; 
    116 } 
    117  
    118 sub thread_sort_hash { 
    119     my $id   = shift; 
    120     my %hash = @_; 
    121  
    122     my @sorted = (); 
    123  
    124     my $ids = $hash{$id}; 
    125     return @sorted unless $ids; 
    126  
    127     foreach my $id ( sort { $a <=> $b } @$ids ) { 
    128         push @sorted, $id; 
    129         push @sorted, thread_sort_hash( $id, %hash ); 
    130     } 
    131  
    132     return @sorted; 
    133 } 
    134  
    135 sub process_category { 
    136     my $category = shift; 
    137  
    138     # Check to see if the category is good. 
    139     die "Bad category '$category'" unless is_category_good($category); 
    140  
    141     my $SQL = ""; 
    142  
    143     if ( $category eq 'all' ) { 
    144         $SQL = "actual_id is null"; 
    145  
    146     } 
    147     elsif ( $category eq 'top' ) { 
    148         $SQL = "is_top = 1 "; 
    149  
    150     } 
    151     else { 
    152         $SQL = "node_type = '$category'"; 
    153     } 
    154  
    155     $SQL .= " order by node_id desc limit " . $$conf{number_of_nodes}; 
    156  
    157     my @nodes = PrlMnks::Node->retrieve_from_sql($SQL); 
    158  
    159     create_rss( title => $category, name => $category, nodes => \@nodes ); 
    160 } 
    161  
    162 sub is_category_good { 
    163     my $category = shift; 
    164     return 0 unless $category; 
    165  
    166     my %valid = map { $_ => 1 } 
    167       qw( user qandasection sourcecode usergroup bookreview note 
    168       perltutorial categorized_question poem monkdiscuss 
    169       perlquestion cufp obfuscated snippet perlnews scratchpad 
    170       perlmeditation pmdevtopic 
    171       all top ); 
    172  
    173     return $valid{$category} || 0; 
    174 } 
    175  
    176 sub create_rss { 
    177     my %args  = @_; 
    178     my $nodes = $args{nodes}; 
    179  
    180     # Create the RSS. 
    181     my $rss = PrlMnks::RSS->new; 
    182  
    183     $rss->set_title( $args{title} ); 
    184     $rss->set_name( $args{name} ); 
    185  
    186     $rss->add_node($_) for @$nodes; 
    187  
    188     $rss->save; 
    189  
    190     print $cgi->header( -type => 'application/xml', -status => '200 OK' ); 
    191     print $rss->as_string; 
    192 } 
     3# use strict; 
     4# use warnings; 
     5#  
     6# use base 'Prlmnks::WWW'; 
     7#  
     8# use PrlMnks::Node; 
     9# use PrlMnks::RSS; 
     10# use CGI; 
     11# use Data::Dumper; 
     12#  
     13# sub run { 
     14#  
     15#     my $id = $self->cgi->url( -absolute => 1 ); 
     16#     $id =~ s/^\/rss\/(.*).xml$/$1/; 
     17#  
     18#     $self->debug("Looking at '$id'"); 
     19#  
     20#     # What sort of request is this? 
     21#     $id =~ m{ \A \d+ \z}xms    # is it an id? 
     22#       ? process_id($id)        # if so process it 
     23#       : process_category($id); # assume a category 
     24#  
     25#     return 1; 
     26# } 
     27#  
     28# ################################################################################ 
     29#  
     30# sub process_id { 
     31#     my $node_id = shift; 
     32#     my $node    = PrlMnks::Node->retrieve($node_id); 
     33#  
     34#     unless ($node) { 
     35#         require PrlMnks::Daemon; 
     36#         $node = 
     37#           PrlMnks::Daemon->new( DEBUG => $DEBUG ) 
     38#           ->fetch_and_store_node($node_id); 
     39#  
     40#         die "Could not fetch the node id: '$node_id'"; 
     41#     } 
     42#  
     43#     my $node_type = $node->node_type; 
     44#     warn "Node type is '$node_type'\n" if $DEBUG; 
     45#  
     46#     my @nodes = (); 
     47#  
     48#     # Get the nodes to xmlify. 
     49#     if ( $node_type =~ m/^user/ ) { 
     50#         @nodes = PrlMnks::Node->search( 
     51#             author_id => $node->node_id, 
     52#             { order_by => 'node_id desc' } 
     53#         ); 
     54#     } 
     55#  
     56#     elsif ( $node_type eq 'note' ) { 
     57#         @nodes = ( 
     58#             $node, 
     59#             PrlMnks::Node->search( 
     60#                 parent_id => $node->node_id, 
     61#                 { order_by => 'node_id desc' } 
     62#             ) 
     63#         ); 
     64#     } 
     65#  
     66#     else { 
     67#         @nodes = PrlMnks::Node->search( root_id => $node->node_id ); 
     68#  
     69#         # Order the nodes by thread. 
     70#         @nodes = order_by_thread( $node->node_id, @nodes ); 
     71#  
     72#         unshift @nodes, $node; 
     73#     } 
     74#  
     75#     create_rss( 
     76#         title => $node->title, 
     77#         name  => $node->node_id, 
     78#         nodes => \@nodes 
     79#     ); 
     80# } 
     81#  
     82# sub order_by_thread { 
     83#     my $top_id   = shift; 
     84#     my @nodes_in = @_; 
     85#  
     86#     my %ids_to_nodes = map { $_->node_id => $_ } @nodes_in; 
     87#  
     88#     #warn "top_id is '$top_id'"; 
     89#  
     90#     my %hash = thread_build_hash(@nodes_in); 
     91#  
     92#     my @ids = thread_sort_hash( $top_id, %hash ); 
     93#  
     94#     #warn Dumper( \@ids); 
     95#  
     96#     my @nodes = (); 
     97#     push @nodes, $ids_to_nodes{$_} for @ids; 
     98#  
     99#     return @nodes; 
     100# } 
     101#  
     102# sub thread_build_hash { 
     103#  
     104#     # Build a hash 
     105#     my @nodes   = @_; 
     106#     my %parents = (); 
     107#  
     108#     foreach my $node (@nodes) { 
     109#         my $parent_id = $node->parent_id; 
     110#  
     111#         #warn "adding '$parent_id' to \%parents"; 
     112#         push @{ $parents{$parent_id} }, $node->node_id; 
     113#     } 
     114#  
     115#     #warn Dumper( \%parents ); 
     116#  
     117#     return %parents; 
     118# } 
     119#  
     120# sub thread_sort_hash { 
     121#     my $id   = shift; 
     122#     my %hash = @_; 
     123#  
     124#     my @sorted = (); 
     125#  
     126#     my $ids = $hash{$id}; 
     127#     return @sorted unless $ids; 
     128#  
     129#     foreach my $id ( sort { $a <=> $b } @$ids ) { 
     130#         push @sorted, $id; 
     131#         push @sorted, thread_sort_hash( $id, %hash ); 
     132#     } 
     133#  
     134#     return @sorted; 
     135# } 
     136#  
     137# sub process_category { 
     138#     my $category = shift; 
     139#  
     140#     # Check to see if the category is good. 
     141#     die "Bad category '$category'" unless is_category_good($category); 
     142#  
     143#     my $SQL = ""; 
     144#  
     145#     if ( $category eq 'all' ) { 
     146#         $SQL = "actual_id is null"; 
     147#  
     148#     } 
     149#     elsif ( $category eq 'top' ) { 
     150#         $SQL = "is_top = 1 "; 
     151#  
     152#     } 
     153#     else { 
     154#         $SQL = "node_type = '$category'"; 
     155#     } 
     156#  
     157#     $SQL .= " order by node_id desc limit " . $$conf{number_of_nodes}; 
     158#  
     159#     my @nodes = PrlMnks::Node->retrieve_from_sql($SQL); 
     160#  
     161#     create_rss( title => $category, name => $category, nodes => \@nodes ); 
     162# } 
     163#  
     164# sub is_category_good { 
     165#     my $category = shift; 
     166#     return 0 unless $category; 
     167#  
     168#     my %valid = map { $_ => 1 } 
     169#       qw( user qandasection sourcecode usergroup bookreview note 
     170#       perltutorial categorized_question poem monkdiscuss 
     171#       perlquestion cufp obfuscated snippet perlnews scratchpad 
     172#       perlmeditation pmdevtopic 
     173#       all top ); 
     174#  
     175#     return $valid{$category} || 0; 
     176# } 
     177#  
     178# sub create_rss { 
     179#     my %args  = @_; 
     180#     my $nodes = $args{nodes}; 
     181#  
     182#     # Create the RSS. 
     183#     my $rss = PrlMnks::RSS->new; 
     184#  
     185#     $rss->set_title( $args{title} ); 
     186#     $rss->set_name( $args{name} ); 
     187#  
     188#     $rss->add_node($_) for @$nodes; 
     189#  
     190#     $rss->save; 
     191#  
     192#     print $cgi->header( -type => 'application/xml', -status => '200 OK' ); 
     193#     print $rss->as_string; 
     194# } 

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

    r48 r49  
    6363ok !-e $paths{508208}, "not found '$paths{508208}'"; 
    6464ok !-e $paths{508218}, "not found '$paths{508218}'"; 
    65 ok -e $paths{508223}, "not found '$paths{508223}'"; 
     65ok -e $paths{508223}, "found '$paths{508223}'"; 
     66 
     67getc; 
    6668 
    6769# Delete all the rss. 

  • trunk/templates/rss/index.mason

    r48 r49  
     1<%args> 
     2  $node 
     3</%args> 
     4<?xml version="1.0" encoding="UTF-8"?> 
     5 
     6% my $family    = $node->as_thread; 
     7% my $node_data = $node->as_hashref; 
     8 
     9 
     10 
     11<rss version="2.0" xmlns:blogChannel="http://backend.userland.com/blogChannelModule"> 
     12 
     13    <channel> 
     14        <title><% $node_data->{title} %></title> 
     15        <link>http://www.prlmnks.org/html/<% $node_data->{node_id} %>.html</link> 
     16%#        <description>RSS feeds from perlmonks.org</description> 
     17        <language>en</language> 
     18        <ttl>5</ttl> 
     19 
     20        <& .items_loop, node_data => $node_data, family => $family &> 
     21 
     22    </channel> 
     23</rss> 
     24 
     25 
     26<%def .items_loop> 
     27    <%args> 
     28        $node_data 
     29        $family 
     30    </%args> 
     31 
     32%# foreach node print the node and then recurse down to the children. 
     33    <& .item, node_data => $node_data &> 
     34     
     35%   foreach my $child ( @{ $family->{ $node_data->{node_id} } } ) { 
     36        <& .items_loop, node_data => $family->{nodes}{$child}->as_hashref, family => $family &> 
     37%   } 
     38 
     39</%def> 
     40 
     41<%def .item > 
     42    <%args> 
     43        $node_data 
     44    </%args> 
     45 
     46    <item> 
     47        <title><% $node_data->{title} | h %></title> 
     48        <link>http://www.prlmnks.org/html/<% $node_data->{node_id} %>.html</link> 
     49        <guid isPermaLink="true">http://www.prlmnks.org/html/<% $node_data->{node_id} %>.html</guid> 
     50 
     51        <description><% $node_data->{content} | h %></description> 
     52    </item> 
     53</%def>