Adding initial commit.
This commit is contained in:
commit
506324ad5e
25
Build.PL
Executable file
25
Build.PL
Executable file
@ -0,0 +1,25 @@
|
||||
#!/usr/bin/env perl
|
||||
use Module::Build;
|
||||
|
||||
my $home = $ENV{HOME};
|
||||
|
||||
my $build = Module::Build->new(
|
||||
module_name => 'GTSRSSApi',
|
||||
license => 'AGPLv3',
|
||||
dist_author => 'Sergio Iglesias <contact@owlcode.tech>',
|
||||
dist_abstract => 'API to fetch pkmn-classic gts trades.',
|
||||
requires => {
|
||||
'Mojolicious' => 0,
|
||||
'DBI' => 0,
|
||||
'DBD::Pg' => 0,
|
||||
'Mojo::UserAgent' => 0,
|
||||
'Mojo::Util' => 0,
|
||||
'DateTime::Format::Strptime' => 0,
|
||||
'DateTime' => 0,
|
||||
'DateTime::Format::Pg' => 0,
|
||||
'JSON' => 0,
|
||||
'UUID::URandom' => 0,
|
||||
'DateTime::Format::Mail' => 0,
|
||||
},
|
||||
);
|
||||
$build->create_build_script;
|
5
g_t_s_r_s_s_api.example.yml
Normal file
5
g_t_s_r_s_s_api.example.yml
Normal file
@ -0,0 +1,5 @@
|
||||
---
|
||||
secrets:
|
||||
- pwgen_generated_255_chars_secret
|
||||
db:
|
||||
database: "gtsrssapi"
|
376
lib/GTSRSSApi.pm
Normal file
376
lib/GTSRSSApi.pm
Normal file
@ -0,0 +1,376 @@
|
||||
package GTSRSSApi;
|
||||
|
||||
use v5.34.1;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
|
||||
use Mojo::Base 'Mojolicious', -signatures;
|
||||
|
||||
use Mojo::UserAgent;
|
||||
use Mojo::Util qw/url_unescape url_escape b64_decode/;
|
||||
use Data::Dumper;
|
||||
use Encode qw/encode decode is_utf8/;
|
||||
use DateTime::Format::Strptime qw/strptime/;
|
||||
use DateTime;
|
||||
use DateTime::Format::Pg;
|
||||
use JSON;
|
||||
use UUID::URandom qw/create_uuid_string/;
|
||||
|
||||
use GTSRSSApi::DB;
|
||||
|
||||
my $ua;
|
||||
|
||||
my $html_origin;
|
||||
my $viewstate;
|
||||
my $viewstate_generator;
|
||||
my $event_validation;
|
||||
my $pg_date_formatter = DateTime::Format::Pg->new;
|
||||
my $db = GTSRSSApi::DB->connect;
|
||||
|
||||
# This method will run once at server start
|
||||
sub startup ($self) {
|
||||
|
||||
# Load configuration from config file
|
||||
my $config = $self->plugin('NotYAMLConfig');
|
||||
|
||||
# Configure the application
|
||||
$self->secrets( $config->{secrets} );
|
||||
|
||||
# Router
|
||||
my $r = $self->routes;
|
||||
|
||||
# Normal route to controller
|
||||
$r->get('/')->to('Page#index');
|
||||
$r->get('/all.rss')->to('Page#all_rss');
|
||||
$r->get('/shiny.rss')->to('Page#shiny_rss');
|
||||
$r->get('/pokerus.rss')->to('Page#pokerus_rss');
|
||||
$self->start_gts_bot;
|
||||
}
|
||||
|
||||
sub start_gts_bot ($self) {
|
||||
Mojo::IOLoop->next_tick(
|
||||
sub ($loop) {
|
||||
$ua = Mojo::UserAgent->new;
|
||||
$ua->cookie_jar->ignore(0);
|
||||
$ua->transactor->name('Sergiotarxz GTS Crawler');
|
||||
|
||||
$html_origin =
|
||||
$ua->get('https://pkmnclassic.net/gts/')->result->dom;
|
||||
$viewstate = $html_origin->at('#__VIEWSTATE')->attr('value');
|
||||
$viewstate_generator =
|
||||
$html_origin->at('#__VIEWSTATEGENERATOR')->attr('value');
|
||||
$event_validation =
|
||||
$html_origin->at('#__EVENTVALIDATION')->attr('value');
|
||||
$self->fetch_gts_data;
|
||||
Mojo::IOLoop->recurring(
|
||||
120 => sub ($loop) {
|
||||
$self->fetch_gts_data;
|
||||
}
|
||||
);
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
my $first_run = 0;
|
||||
|
||||
sub fetch_gts_data {
|
||||
eval {
|
||||
my $html = Mojo::DOM->new(
|
||||
$ua->post(
|
||||
'https://pkmnclassic.net/gts/',
|
||||
form => {
|
||||
__VIEWSTATE => $viewstate,
|
||||
__VIEWSTATEGENERATOR => $viewstate_generator,
|
||||
__EVENTVALIDATION => $event_validation,
|
||||
'ctl00$cpMain$ppSpecies$theLookup$txtInput' => '',
|
||||
|
||||
'cpMain$ppSpecies$theLookup$hdSelectedValue' => '',
|
||||
'ctl00$cpMain$grpGeneration' => 'rbGen4',
|
||||
'ctl00$cpMain$btnSearch' => 'Search',
|
||||
'ctl00$cpMain$txtLevelMin' => 1,
|
||||
'ctl00$cpMain$txtLevelMax' => 100,
|
||||
'ctl00$cpMain$chkMale' => 'on',
|
||||
'ctl00$cpMain$chkFemale' => 'on',
|
||||
}
|
||||
)->result->body
|
||||
);
|
||||
$viewstate = $html->at('#__VIEWSTATE')->attr('value');
|
||||
$viewstate_generator =
|
||||
$html->at('#__VIEWSTATEGENERATOR')->attr('value');
|
||||
$event_validation = $html->at('#__EVENTVALIDATION')->attr('value');
|
||||
my @offers =
|
||||
$html->find('.gtsPokemonSummary.gtsOffer.pfBoxThin.pfFormGroup')
|
||||
->each;
|
||||
$db->do( <<'EOF', undef );
|
||||
UPDATE offers SET marked_to_check_is_available = true WHERE is_available = true;
|
||||
EOF
|
||||
for my $offer (@offers) {
|
||||
eval {
|
||||
my $species =
|
||||
$offer->at('.pfFormValue.colPortrait .sprite.species')
|
||||
->attr('alt');
|
||||
my $species_img =
|
||||
$offer->at('.pfFormValue.colPortrait .sprite.species')
|
||||
->attr('src');
|
||||
my $is_shiny =
|
||||
$species_img =~ m@^/images/pkmn-lg-s/\d+(?:-.*?)?\.png@;
|
||||
my $pokeball_element =
|
||||
$offer->at('.pfFormValue.colPortrait .sprite.item');
|
||||
my $pokeball = 'Glitch Ball';
|
||||
if ( defined $pokeball_element ) {
|
||||
$pokeball = $pokeball_element->attr('alt');
|
||||
}
|
||||
my $level_container =
|
||||
$offer->at('.pfFormValue.colPortrait li.portrait')->next;
|
||||
|
||||
# my $level_string = decode( 'utf-8', $level_container->text );
|
||||
my $level_string = $level_container->text;
|
||||
|
||||
my ($level) = $level_string =~ /(\d+)/;
|
||||
my ($gender) = $level_string =~ /(♂|♀)/;
|
||||
my $has_pokerus = $offer->at('span.pkrs');
|
||||
$has_pokerus = !!$has_pokerus;
|
||||
my $date;
|
||||
my $offerer;
|
||||
my $nature;
|
||||
my $ability;
|
||||
my $held_item;
|
||||
my $wanted_species;
|
||||
my $requirements;
|
||||
my $nick;
|
||||
|
||||
for my $keyElement ( $offer->find('.pfFormKey')->each ) {
|
||||
my $key = $keyElement->text;
|
||||
my $valueElement = $keyElement->next;
|
||||
my $value = $valueElement->text;
|
||||
|
||||
# $value = decode 'utf-8', $value;
|
||||
($key) = $key =~ /^\s*(.*?)\s*$/m;
|
||||
($value) = $value =~ /^\s*(.*?)\s*$/m;
|
||||
$value //= '';
|
||||
if ( $key eq 'Date' ) {
|
||||
$date = strptime( "%A, %B %d, %Y %I:%M %P", $value );
|
||||
}
|
||||
if ( $key eq 'Offered by' ) {
|
||||
$offerer = $value;
|
||||
}
|
||||
if ( $key eq 'Ability' ) {
|
||||
$ability = $value;
|
||||
}
|
||||
if ( $key eq 'Name' ) {
|
||||
$nick = $value;
|
||||
}
|
||||
if ( $key eq 'Nature' ) {
|
||||
$nature = $value;
|
||||
my $requirementsElement = $valueElement->next;
|
||||
$requirements = $requirementsElement->text;
|
||||
$requirements = decode 'utf-8', $requirements;
|
||||
$requirements =~ s/\n//g;
|
||||
($requirements) = $requirements =~ /^\s*(.*?)\s*$/m;
|
||||
$requirements =~ s/[^♂♀. a-zA-Z0-9]//gu;
|
||||
$requirements =~ s/ +/ /g;
|
||||
}
|
||||
if ( $key eq 'Held item' ) {
|
||||
$held_item = $value;
|
||||
}
|
||||
if ( $key eq 'Wanted' ) {
|
||||
$wanted_species = $value;
|
||||
$wanted_species =~ s/\s*\(.*$//;
|
||||
}
|
||||
}
|
||||
|
||||
my $line =
|
||||
"At $date @{[decode 'utf-8', $offerer]} offers $species named @{[decode 'utf-8', $nick]} caught in $pokeball with level $level, gender"
|
||||
. " @{[$gender // 'unknown']}, nature $nature and ability $ability";
|
||||
if ($is_shiny) {
|
||||
$line .= ' is Shiny';
|
||||
}
|
||||
if ($has_pokerus) {
|
||||
$line .= ' with Pokerus';
|
||||
}
|
||||
if ($held_item) {
|
||||
$line .= " holds item $held_item";
|
||||
}
|
||||
$line .=
|
||||
" wants $wanted_species matching this requirements $requirements";
|
||||
$is_shiny = $is_shiny ? $JSON::true : $JSON::false;
|
||||
$has_pokerus = $has_pokerus ? $JSON::true : $JSON::false;
|
||||
my $pg_date = $pg_date_formatter->format_datetime($date);
|
||||
my $query = <<'EOF';
|
||||
SELECT * FROM offers WHERE
|
||||
date IS NOT DISTINCT FROM ?
|
||||
AND offerer IS NOT DISTINCT FROM ?
|
||||
AND species IS NOT DISTINCT FROM ?
|
||||
AND nickname IS NOT DISTINCT FROM ?
|
||||
AND pokeball IS NOT DISTINCT FROM ?
|
||||
AND level IS NOT DISTINCT FROM ?
|
||||
AND gender IS NOT DISTINCT FROM ?
|
||||
AND nature IS NOT DISTINCT FROM ?
|
||||
AND ability IS NOT DISTINCT FROM ?
|
||||
AND is_shiny IS NOT DISTINCT FROM ?
|
||||
AND has_pokerus IS NOT DISTINCT FROM ?
|
||||
AND held_item IS NOT DISTINCT FROM ?
|
||||
AND wanted_species IS NOT DISTINCT FROM ?
|
||||
AND wanted_requirements IS NOT DISTINCT FROM ?
|
||||
AND is_available
|
||||
EOF
|
||||
my @matching_rows = $db->selectall_array(
|
||||
$query, {},
|
||||
$pg_date, decode( 'utf-8', $offerer ),
|
||||
$species, decode( 'utf-8', $nick ),
|
||||
$pokeball, $level,
|
||||
$gender, $nature,
|
||||
$ability, $is_shiny,
|
||||
$has_pokerus, $held_item,
|
||||
$wanted_species, $requirements,
|
||||
);
|
||||
if (@matching_rows) {
|
||||
my $matching_row_confirm_query = <<'EOF';
|
||||
UPDATE offers SET marked_to_check_is_available = false WHERE
|
||||
date IS NOT DISTINCT FROM ?
|
||||
AND offerer IS NOT DISTINCT FROM ?
|
||||
AND species IS NOT DISTINCT FROM ?
|
||||
AND nickname IS NOT DISTINCT FROM ?
|
||||
AND pokeball IS NOT DISTINCT FROM ?
|
||||
AND level IS NOT DISTINCT FROM ?
|
||||
AND gender IS NOT DISTINCT FROM ?
|
||||
AND nature IS NOT DISTINCT FROM ?
|
||||
AND ability IS NOT DISTINCT FROM ?
|
||||
AND is_shiny IS NOT DISTINCT FROM ?
|
||||
AND has_pokerus IS NOT DISTINCT FROM ?
|
||||
AND held_item IS NOT DISTINCT FROM ?
|
||||
AND wanted_species IS NOT DISTINCT FROM ?
|
||||
AND wanted_requirements IS NOT DISTINCT FROM ?
|
||||
AND is_available
|
||||
AND marked_to_check_is_available
|
||||
EOF
|
||||
|
||||
$db->do(
|
||||
$matching_row_confirm_query,
|
||||
undef,
|
||||
$pg_date,
|
||||
decode( 'utf-8', $offerer ),
|
||||
$species,
|
||||
decode( 'utf-8', $nick ),
|
||||
$pokeball,
|
||||
$level,
|
||||
$gender,
|
||||
$nature,
|
||||
$ability,
|
||||
$is_shiny,
|
||||
$has_pokerus,
|
||||
$held_item,
|
||||
$wanted_species,
|
||||
$requirements,
|
||||
);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
my $uuid = create_uuid_string;
|
||||
my $query_create_offer = <<'EOF';
|
||||
INSERT
|
||||
INTO offers
|
||||
(uuid, date, offerer, species, nickname, pokeball,
|
||||
level, gender, nature, ability, is_shiny,
|
||||
has_pokerus, held_item, wanted_species, wanted_requirements)
|
||||
VALUES (
|
||||
?, ?, ?, ?, ?, ?,
|
||||
?, ?, ?, ?, ?,
|
||||
?, ?, ?, ?
|
||||
)
|
||||
EOF
|
||||
$db->do(
|
||||
$query_create_offer, {},
|
||||
$uuid, $pg_date,
|
||||
decode( 'utf-8', $offerer ), $species,
|
||||
decode( 'utf-8', $nick ), $pokeball,
|
||||
$level, $gender,
|
||||
$nature, $ability,
|
||||
$is_shiny, $has_pokerus,
|
||||
$held_item, $wanted_species,
|
||||
$requirements,
|
||||
);
|
||||
my $query_create_news = <<'EOF';
|
||||
INSERT
|
||||
INTO news
|
||||
(uuid, date, offerer, species, is_shiny, has_pokerus, news_text, held_item)
|
||||
VALUES ( ?, ?, ?, ?, ?, ?, ?, ? );
|
||||
EOF
|
||||
$uuid = create_uuid_string;
|
||||
$db->do(
|
||||
$query_create_news, undef,
|
||||
$uuid, $pg_date,
|
||||
decode( 'utf-8', $offerer ), $species,
|
||||
$is_shiny, $has_pokerus,
|
||||
$line, $held_item,
|
||||
);
|
||||
|
||||
};
|
||||
if ($@) {
|
||||
warn $@;
|
||||
}
|
||||
}
|
||||
my @no_longer_available_pokemon =
|
||||
$db->selectall_array( <<'EOF', { Slice => {} } );
|
||||
SELECT * FROM offers WHERE is_available and marked_to_check_is_available;
|
||||
EOF
|
||||
for my $pokemon (@no_longer_available_pokemon) {
|
||||
my $species = $pokemon->{species};
|
||||
my $nick = $pokemon->{nickname};
|
||||
my $offerer = $pokemon->{offerer};
|
||||
my $pokeball = $pokemon->{pokeball};
|
||||
my $level = $pokemon->{level};
|
||||
my $gender = $pokemon->{gender};
|
||||
my $nature = $pokemon->{nature};
|
||||
my $ability = $pokemon->{ability};
|
||||
my $is_shiny = $pokemon->{is_shiny};
|
||||
my $has_pokerus = $pokemon->{has_pokerus};
|
||||
my $pg_date = $pokemon->{date};
|
||||
my $date = '' . $pg_date_formatter->parse_datetime($pg_date);
|
||||
my $held_item = $pokemon->{held_item};
|
||||
my $wanted_species = $pokemon->{wanted_species};
|
||||
my $requirements = $pokemon->{wanted_requirements};
|
||||
|
||||
$is_shiny = $is_shiny ? $JSON::true : $JSON::false;
|
||||
$has_pokerus = $has_pokerus ? $JSON::true : $JSON::false;
|
||||
my $line =
|
||||
"(NO LONGER AVAILABLE) At $date $offerer offers $species named $nick caught in $pokeball with level $level, gender"
|
||||
. " @{[$gender // 'unknown']}, nature $nature and ability $ability";
|
||||
|
||||
if ($is_shiny) {
|
||||
$line .= ' is Shiny';
|
||||
}
|
||||
if ($has_pokerus) {
|
||||
$line .= ' with Pokerus';
|
||||
}
|
||||
if ($held_item) {
|
||||
$line .= " holds item $held_item";
|
||||
}
|
||||
$line .=
|
||||
" wants $wanted_species matching this requirements $requirements";
|
||||
my $query_create_news = <<'EOF';
|
||||
INSERT
|
||||
INTO news
|
||||
(uuid, date, offerer, species, is_shiny, has_pokerus, news_text, held_item)
|
||||
VALUES ( ?, ?, ?, ?, ?, ?, ?, ? );
|
||||
EOF
|
||||
my $uuid = create_uuid_string;
|
||||
$db->do(
|
||||
$query_create_news, undef, $uuid,
|
||||
$pg_date, $offerer, $species,
|
||||
$is_shiny, $has_pokerus, $line,
|
||||
$held_item,
|
||||
);
|
||||
}
|
||||
$db->do( <<'EOF', undef );
|
||||
UPDATE offers SET is_available = false, marked_to_check_is_available = false = true WHERE is_available and marked_to_check_is_available;
|
||||
EOF
|
||||
};
|
||||
if ($@) {
|
||||
warn $@;
|
||||
}
|
||||
}
|
||||
1;
|
11
lib/GTSRSSApi/Controller/Example.pm
Normal file
11
lib/GTSRSSApi/Controller/Example.pm
Normal file
@ -0,0 +1,11 @@
|
||||
package GTSRSSApi::Controller::Example;
|
||||
use Mojo::Base 'Mojolicious::Controller', -signatures;
|
||||
|
||||
# This action will render a template
|
||||
sub welcome ($self) {
|
||||
|
||||
# Render template "example/welcome.html.ep" with message
|
||||
$self->render(msg => 'Welcome to the Mojolicious real-time web framework!');
|
||||
}
|
||||
|
||||
1;
|
107
lib/GTSRSSApi/Controller/Page.pm
Normal file
107
lib/GTSRSSApi/Controller/Page.pm
Normal file
@ -0,0 +1,107 @@
|
||||
package GTSRSSApi::Controller::Page;
|
||||
|
||||
use v5.34.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use DateTime::Format::Pg;
|
||||
use DateTime::Format::Mail;
|
||||
use Mojo::DOM;
|
||||
|
||||
use Mojo::Base 'Mojolicious::Controller', -signatures;
|
||||
use GTSRSSApi::DB;
|
||||
|
||||
my $db = GTSRSSApi::DB->connect;
|
||||
|
||||
# This action will render a template
|
||||
sub index ($self) {
|
||||
|
||||
# Render template "example/welcome.html.ep" with message
|
||||
$self->render;
|
||||
}
|
||||
|
||||
sub all_rss ($self) {
|
||||
my @news = $db->selectall_array( <<'EOF', { Slice => {} } );
|
||||
SELECT news_text, date FROM news ORDER BY date DESC LIMIT 100;
|
||||
EOF
|
||||
my $dom = $self->_feed_from_news_list(
|
||||
\@news,
|
||||
'All trades GTS',
|
||||
'https://pkmnclassic.net/gts/'
|
||||
);
|
||||
$self->render(
|
||||
format => 'xml',
|
||||
text => $dom,
|
||||
);
|
||||
}
|
||||
|
||||
sub shiny_rss ($self) {
|
||||
my @news = $db->selectall_array( <<'EOF', { Slice => {} } );
|
||||
SELECT news_text, date FROM news WHERE is_shiny ORDER BY date DESC LIMIT 100;
|
||||
EOF
|
||||
my $dom = $self->_feed_from_news_list(
|
||||
\@news,
|
||||
'Shiny trades GTS',
|
||||
'https://pkmnclassic.net/gts/'
|
||||
);
|
||||
$self->render(
|
||||
format => 'xml',
|
||||
text => $dom,
|
||||
);
|
||||
}
|
||||
|
||||
sub pokerus_rss($self) {
|
||||
my @news = $db->selectall_array( <<'EOF', { Slice => {} } );
|
||||
SELECT news_text, date FROM news WHERE has_pokerus ORDER BY date DESC LIMIT 100;
|
||||
EOF
|
||||
my $dom = $self->_feed_from_news_list(
|
||||
\@news,
|
||||
'Pokerus infected trades GTS',
|
||||
'https://pkmnclassic.net/gts/'
|
||||
);
|
||||
$self->render(
|
||||
format => 'xml',
|
||||
text => $dom,
|
||||
);
|
||||
}
|
||||
|
||||
sub _feed_from_news_list ( $self, $news, $title, $link ) {
|
||||
my $dom = Mojo::DOM->new_tag( 'rss', version => '2.0', undef );
|
||||
my $channel_tag = Mojo::DOM->new_tag('channel');
|
||||
my $title_tag = Mojo::DOM->new_tag( 'title', $title );
|
||||
my $link_tag = Mojo::DOM->new_tag( 'link', $link );
|
||||
my $description_tag = Mojo::DOM->new_tag( 'description', '' );
|
||||
$channel_tag->child_nodes->first->append_content($title_tag);
|
||||
$channel_tag->child_nodes->first->append_content($link_tag);
|
||||
$channel_tag->child_nodes->first->append_content($description_tag);
|
||||
|
||||
for my $new ( @$news ) {
|
||||
$channel_tag->child_nodes->first->append_content( $self->_new_to_rss($new) );
|
||||
}
|
||||
$dom->child_nodes->first->append_content($channel_tag);
|
||||
return $dom;
|
||||
}
|
||||
|
||||
sub _new_to_rss ( $self, $new ) {
|
||||
my $item_tag = Mojo::DOM->new_tag('item');
|
||||
my $title_tag = Mojo::DOM->new_tag( 'title', $new->{news_text} );
|
||||
my $link = Mojo::DOM->new_tag( 'link', 'https://pkmnclassic.net/gts/' );
|
||||
my $description = Mojo::DOM->new_tag( 'description',
|
||||
$new->{news_text});
|
||||
my $guid = Mojo::DOM->new_tag( 'guid', $new->{uuid} );
|
||||
my $date = Mojo::DOM->new_tag(
|
||||
'pubDate',
|
||||
''
|
||||
. DateTime::Format::Mail->format_datetime(
|
||||
DateTime::Format::Pg->parse_datetime( $new->{date} )
|
||||
)
|
||||
);
|
||||
|
||||
$item_tag->child_nodes->first->append_content($title_tag);
|
||||
$item_tag->child_nodes->first->append_content($link);
|
||||
$item_tag->child_nodes->first->append_content($description);
|
||||
$item_tag->child_nodes->first->append_content($guid);
|
||||
$item_tag->child_nodes->first->append_content($date);
|
||||
return $item_tag;
|
||||
}
|
||||
1;
|
104
lib/GTSRSSApi/DB.pm
Normal file
104
lib/GTSRSSApi/DB.pm
Normal file
@ -0,0 +1,104 @@
|
||||
package GTSRSSApi::DB;
|
||||
|
||||
use v5.34.1;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use DBI;
|
||||
use DBD::Pg;
|
||||
|
||||
use GTSRSSApi::DB::Migrations;
|
||||
use Data::Dumper;
|
||||
|
||||
my $dbh;
|
||||
|
||||
sub connect {
|
||||
require GTSRSSApi;
|
||||
if ( defined $dbh ) {
|
||||
return $dbh;
|
||||
}
|
||||
my $class = shift;
|
||||
my $app = GTSRSSApi->new;
|
||||
my $config = $app->config;
|
||||
my $database = $config->{db}{database};
|
||||
$dbh = DBI->connect(
|
||||
"dbi:Pg:dbname=$database",
|
||||
undef, undef,
|
||||
{
|
||||
RaiseError => 1,
|
||||
pg_enable_utf8 => 1,
|
||||
Callbacks => {
|
||||
connected => sub {
|
||||
shift->do('set timezone = UTC');
|
||||
return;
|
||||
}
|
||||
},
|
||||
},
|
||||
);
|
||||
$class->_migrate($dbh);
|
||||
return $dbh;
|
||||
}
|
||||
|
||||
sub _migrate {
|
||||
my $class = shift;
|
||||
my $dbh = shift;
|
||||
local $dbh->{RaiseError} = 0;
|
||||
local $dbh->{PrintError} = 0;
|
||||
my @migrations = GTSRSSApi::DB::Migrations::MIGRATIONS();
|
||||
if ( $class->get_current_migration($dbh) > @migrations ) {
|
||||
warn "Something happened there, wrong migration number.";
|
||||
}
|
||||
if ( $class->get_current_migration($dbh) >= @migrations ) {
|
||||
say STDERR "Migrations already applied.";
|
||||
return;
|
||||
}
|
||||
$class->_apply_migrations( $dbh, \@migrations );
|
||||
}
|
||||
|
||||
sub _apply_migrations {
|
||||
my $class = shift;
|
||||
my $dbh = shift;
|
||||
my $migrations = shift;
|
||||
for (
|
||||
my $i = $class->get_current_migration($dbh) ;
|
||||
$i < @$migrations ;
|
||||
$i++
|
||||
)
|
||||
{
|
||||
local $dbh->{RaiseError} = 1;
|
||||
my $current_migration = $migrations->[$i];
|
||||
my $migration_number = $i + 1;
|
||||
$class->_apply_migration( $dbh, $current_migration, $migration_number );
|
||||
}
|
||||
}
|
||||
|
||||
sub _apply_migration {
|
||||
my $class = shift;
|
||||
my $dbh = shift;
|
||||
my $current_migration = shift;
|
||||
my $migration_number = shift;
|
||||
{
|
||||
if ( ref $current_migration eq 'CODE' ) {
|
||||
$current_migration->($dbh);
|
||||
next;
|
||||
}
|
||||
$dbh->do($current_migration);
|
||||
}
|
||||
$dbh->do( <<'EOF', undef, 'current_migration', $migration_number );
|
||||
INSERT INTO options
|
||||
VALUES ($1, $2)
|
||||
ON CONFLICT (name) DO
|
||||
UPDATE SET value = $2;
|
||||
EOF
|
||||
}
|
||||
|
||||
sub get_current_migration {
|
||||
my $class = shift;
|
||||
my $dbh = shift;
|
||||
my $result = $dbh->selectrow_hashref( <<'EOF', undef, 'current_migration' );
|
||||
select value from options where name = ?;
|
||||
EOF
|
||||
return int( $result->{value} // 0 );
|
||||
}
|
||||
1;
|
48
lib/GTSRSSApi/DB/Migrations.pm
Normal file
48
lib/GTSRSSApi/DB/Migrations.pm
Normal file
@ -0,0 +1,48 @@
|
||||
package GTSRSSApi::DB::Migrations;
|
||||
|
||||
use v5.34.1;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use utf8;
|
||||
|
||||
use feature 'signatures';
|
||||
|
||||
sub MIGRATIONS {
|
||||
return (
|
||||
'CREATE TABLE options (
|
||||
name TEXT PRIMARY KEY,
|
||||
value TEXT
|
||||
);',
|
||||
'CREATE TABLE offers (
|
||||
uuid UUID PRIMARY KEY,
|
||||
date timestamp NOT NULL,
|
||||
species TEXT NOT NULL,
|
||||
offerer TEXT NOT NULL,
|
||||
nickname TEXT NOT NULL,
|
||||
level NUMERIC NOT NULL,
|
||||
nature TEXT NOT NULL,
|
||||
ability TEXT NOT NULL,
|
||||
is_shiny boolean NOT NULL,
|
||||
has_pokerus boolean NOT NULL,
|
||||
wanted_species TEXT NOT NULL,
|
||||
wanted_requirements TEXT NOT NULL,
|
||||
gender TEXT,
|
||||
pokeball TEXT,
|
||||
held_item TEXT
|
||||
)',
|
||||
'ALTER TABLE offers ADD COLUMN is_available BOOLEAN NOT NULL DEFAULT true;',
|
||||
'ALTER TABLE offers ADD COLUMN marked_to_check_is_available BOOLEAN NOT NULL DEFAULT false;',
|
||||
'CREATE TABLE news (
|
||||
uuid UUID PRIMARY KEY,
|
||||
date timestamp NOT NULL,
|
||||
species TEXT NOT NULL,
|
||||
offerer TEXT NOT NULL,
|
||||
is_shiny boolean NOT NULL,
|
||||
has_pokerus boolean NOT NULL,
|
||||
news_text TEXT NOT NULL,
|
||||
held_item TEXT
|
||||
);',
|
||||
);
|
||||
}
|
||||
1;
|
0
public/.exists
Normal file
0
public/.exists
Normal file
11
script/gtsrssapi
Executable file
11
script/gtsrssapi
Executable file
@ -0,0 +1,11 @@
|
||||
#!/usr/bin/env perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Mojo::File qw(curfile);
|
||||
use lib curfile->dirname->sibling('lib')->to_string;
|
||||
use Mojolicious::Commands;
|
||||
|
||||
# Start command line interface for application
|
||||
Mojolicious::Commands->start_app('GTSRSSApi');
|
5
templates/layouts/default.html.ep
Normal file
5
templates/layouts/default.html.ep
Normal file
@ -0,0 +1,5 @@
|
||||
<!DOCTYPE html>
|
||||
<html>
|
||||
<head><title><%= title %></title></head>
|
||||
<body><%= content %></body>
|
||||
</html>
|
12
templates/page/index.html.ep
Normal file
12
templates/page/index.html.ep
Normal file
@ -0,0 +1,12 @@
|
||||
<html>
|
||||
<head>
|
||||
</head>
|
||||
<body>
|
||||
<h1>List of RSS Feeds for different kinds of GTS trades in pkmn-classic network.</h1>
|
||||
<ul>
|
||||
<li><a href="/all.rss">All trades.</a></li>
|
||||
<li><a href="/shiny.rss">Only shiny trades.</a></li>
|
||||
<li><a href="/pokerus.rss">Only pokerus trades.</a></li>
|
||||
</ul>
|
||||
</body>
|
||||
</html>
|
Loading…
Reference in New Issue
Block a user