lib/SGN/Controller/GitHub/OrgNews.pm

   1 =head1 NAME
   2
   3 SGN::Controller::GitHub::OrgNews - controller that fetches and makes
   4 HTML showing the latest GitHub activity involving our github org.
   5
   6 =cut
   7
   8 package SGN::Controller::GitHub::OrgNews;
   9 use Moose;
  10 use Moose::Util::TypeConstraints;
  11 use namespace::autoclean;
  12
  13 use Cache::File;
  14 use LWP;
  15 use JSON;
  16 use Storable ();
  17 use URI;
  18 use XML::Atom::Feed;
  19
  20 BEGIN { extends 'Catalyst::Controller' }
  21
  22 =head1 CONFIGURATION
  23
  24 =head2 num_entries
  25
  26 Number of most recent entries to output.  Default 3.
  27
  28 =cut
  29
  30 has 'num_entries' => (
  31     is => 'ro',
  32     default => 5,
  33     );
  34
  35 =head2 title_regex
  36
  37 Quoted regular expression to use for filtering the titles of events.
  38 Default: C<< qr!solgenomics/! >>
  39
  40 =cut
  41
  42 {
  43     my $tr = subtype as 'RegexpRef';
  44     coerce $tr, from 'Str',
  45         via {
  46             # defend against code injection
  47             s/;//g; /^qr/ or die "invalid regexp";
  48             eval $_
  49         };
  50
  51     has 'title_regex' => (
  52         is      => 'ro',
  53         isa     => $tr,
  54         coerce  => 1,
  55         default => sub { qr!solgenomics/! },
  56     );
  57 }
  58
  59 =head1 PUBLIC ACTIONS
  60
  61 =head2 org_news
  62
  63 Public path: /github/org_news
  64
  65 Display HTML showing the most recent events by people in this organization.
  66
  67 =cut
  68
  69 sub org_news : Path('/github/org_news') Args(1) {
  70     my ( $self, $c, $orgname ) = @_;
  71     $orgname =~ s/[^a-z]//g;
  72     $c->stash->{org_name} = $orgname;
  73     $c->forward('fetch_org_news') or return;
  74
  75     $c->stash->{template} = '/github/org_news.mas';
  76 }
  77
  78 sub fetch_org_news : Private {
  79     my ( $self, $c ) = @_;
  80
  81     my $orgname = $c->stash->{org_name};
  82
  83     my $num_entries = $c->req->params->{'num_entries'};
  84     $num_entries = $self->num_entries unless defined $num_entries;
  85
  86     # get the members of the org
  87     my $response    = $c->stash->{org_response} =
  88         $self->_http_cache->thaw("https://api.github.com/orgs/$orgname/members");
  89     my $org_members = $c->stash->{org_members}  =
  90         eval { decode_json( $response->content ) };
  91     die "Cannot parse response: ".$response->content if $@;
  92
  93     # TODO: remove this
  94     #@{ $org_members } = grep { $_->{login} eq 'rbuels' } @$org_members;
  95
  96     # decorate each user with their feed
  97     for my $member ( @$org_members ) {
  98         my $xml  = $self->_http_cache->thaw("https://github.com/$member->{login}.atom")->content;
  99         my $feed = XML::Atom::Feed->new( \$xml );
 100         $member->{news_feed} = $feed;
 101     }
 102
 103     # make an array of the 5 most recent feed entries
 104     my $entries = $c->stash->{entries} = [
 105         ( sort { $b->published cmp $a->published }
 106           grep { $_->title =~ $self->title_regex }
 107           map {
 108              $_->{news_feed}->entries
 109           } @$org_members
 110         )[ 0 .. $num_entries-1 ]
 111     ];
 112
 113     return 1;
 114 }
 115
 116 has '_http_cache' => (
 117     is => 'ro',
 118     lazy_build => 1,
 119    ); sub _build__http_cache {
 120        my $self = shift;
 121
 122        # will cache for no more than 10 minutes, and also has a 5%
 123        # chance at each access of re-fetching something, which will
 124        # tend to prevent one person winning the complete 'booby prize'
 125        # and having to wait for an entire re-fetch.
 126        my $ua = LWP::UserAgent->new;
 127        return Cache::File->new(
 128            cache_root       => $self->_app->path_to( $self->_app->tempfiles_subdir('cache','github_http') ),
 129
 130            default_expires  => '10 minutes',
 131            size_limit       => 1_000_000,
 132            removal_strategy => 'Cache::RemovalStrategy::LRU',
 133            load_callback => sub {
 134                my $cache_entry = shift;
 135                my $url = $cache_entry->key;
 136                Storable::nfreeze( $ua->get( $url ) );
 137            },
 138            validate_callback => sub {
 139                # 5% of the time, re-update an entry even if it is not expired
 140                return rand > 0.05 ? 1 : 0
 141            },
 142           );
 143    }
 144
 145
 146 1;