379 lines
14 KiB
Perl
379 lines
14 KiB
Perl
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;
|
|
$self->config(
|
|
hypnotoad => { proxy => 1, listen => [$self->config('listen') // 'http://localhost:3000'] } );
|
|
|
|
# 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;
|