Created
January 3, 2017 05:19
-
-
Save briandfoy/4b4025b8026e4eee26c11811ba1a7efe to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/Users/brian/bin/perls/perl5.24.0 | |
use v5.24; | |
use feature qw(signatures); | |
no warnings qw(experimental::signatures); | |
use Data::Dumper; | |
use HTML::Entities; | |
use Mojo::UserAgent; | |
use open qw(:std :utf8); | |
run() unless caller; | |
sub run ( $user_id = 2766176 ) { | |
my $date_string = munge_date(); | |
my $atom_url = 'https://www.learningperl6.com/downloads/stackoverflow-questions.xml'; | |
my $string =<<"HERE"; | |
<?xml version="1.0" encoding="utf-8"?> | |
<feed xmlns="http://www.w3.org/2005/Atom"> | |
<title>brian d foy Perl 6 StackOverflow Atom Feed</title> | |
<link href="http://www.stackexchange.com/" rel="related" /> | |
<link href="$atom_url" rel="self" /> | |
<updated>$date_string</updated> | |
<id>$atom_url</id> | |
HERE | |
foreach my $item ( get_items()->@* ) { | |
next unless grep { $_ eq 'perl6' } $item->{tags}->@*; | |
my $question_id = $item->{question_id}; | |
$string .= "<entry>\n"; | |
my $decoded_title = decode_entities( $item->{title} ); | |
$string .= "\t" . make_tag( 'title', $decoded_title ) . "\n"; | |
$string .= "\t" . "<author><name>" . encode_entities( $item->{owner}{display_name} ) . "</name></author>" . "\n"; | |
# use the link to get the share credit | |
my $url = sprintf 'http://stackoverflow.com/q/%d/%d', $question_id, $user_id; | |
$string .= qq(\t<link href="$url" />\n); | |
$string .= "\t<id>$url</id>\n"; | |
$string .= "\t" . make_tag( 'updated', munge_date( $item->{'creation_date'} ) ) . "\n"; | |
my $text = get_question( $item->{'question_id'} ); | |
$text =~ s/&/&/g; | |
$text =~ s/</</g; | |
$text =~ s/>/>/g; | |
$string .= <<"HERE"; | |
<content type="html"> | |
$text | |
</content> | |
HERE | |
$string .= "</entry>\n\n"; | |
} | |
$string .= '</feed>'; | |
print $string; | |
} | |
sub get_ua { | |
state $r = require Mojo::UserAgent; | |
state $ua = Mojo::UserAgent->new->max_redirects(3); | |
$ua; | |
} | |
sub get_items ( $user_id = 2766176 ) { | |
state $url = "https://api.stackexchange.com/2.2/users/$user_id/questions?order=desc&sort=activity&site=stackoverflow"; | |
my $tx = get_ua()->get( $url ); | |
my $items = $tx->res->json->{items}; | |
} | |
sub munge_date { | |
state $template = '%04d-%02d-%02dT%02d:%02d:%02dZ'; | |
my( $epoch_time ) = @_; | |
$epoch_time //= time; | |
my @array = ( localtime( $epoch_time // time ) )[ reverse 0 .. 5 ]; | |
$array[0] += 1900; | |
$array[1] += 1; | |
sprintf $template, @array; | |
} | |
sub make_tag { | |
my( $tag, $data ) = @_; | |
my $xml = "<$tag><![CDATA[$data]]></$tag>"; | |
}; | |
sub get_question { | |
my( $question_id ) = @_; | |
# <div class="post-text" itemprop="text"> | |
state $question_url = "http://stackoverflow.com/questions/%d"; | |
my $q_tx = get_ua()->get( sprintf $question_url, $question_id ); | |
my $text = $q_tx->res->dom->at( 'div[class=post-text]' ); | |
$text =~ s/\A\s*<div class="post-text" itemprop="text">\s*//; | |
$text =~ s/\s*<\/div>\s*//; | |
$text; | |
} | |
__END__ | |
$VAR1 = { | |
'tags' => [ | |
'unicode', | |
'perl6' | |
], | |
'last_edit_date' => 1452328578, | |
'title' => 'What's allowed in a Perl 6 identifier?', | |
'last_activity_date' => 1483287082, | |
'accepted_answer_id' => 34693397, | |
'score' => 7, | |
'creation_date' => 1452315569, | |
'owner' => { | |
'profile_image' => 'https://www.gravatar.com/avatar/edd8638efe875601bfe394a8aea5b16d?s=128&d=identicon&r=PG', | |
'user_type' => 'registered', | |
'reputation' => 88120, | |
'link' => 'http://stackoverflow.com/users/2766176/brian-d-foy', | |
'display_name' => 'brian d foy', | |
'user_id' => 2766176, | |
'accept_rate' => 70 | |
}, | |
'answer_count' => 1, | |
'is_answered' => bless( do{\(my $o = 1)}, 'JSON::PP::Boolean' ), | |
'view_count' => 109, | |
'question_id' => 34689850, | |
'link' => 'http://stackoverflow.com/questions/34689850/whats-allowed-in-a-perl-6-identifier' | |
}; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment