Adding tracking to now what pages are visited.

I feel a little zuckenberg today.
This commit is contained in:
sergiotarxz 2022-11-15 23:30:37 +01:00
parent 0afc3f5475
commit ae16dd4b6b
7 changed files with 210 additions and 5 deletions

View File

@ -0,0 +1,5 @@
{
"db": {
"database": "example"
}
}

View File

@ -1,9 +1,21 @@
package BurguillosInfo; package BurguillosInfo;
use BurguillosInfo::Controller::Metrics;
use Mojo::Base 'Mojolicious', -signatures; use Mojo::Base 'Mojolicious', -signatures;
# This method will run once at server start # This method will run once at server start
sub startup ($self) { sub startup ($self) {
my $metrics = BurguillosInfo::Controller::Metrics->new;
$self->hook(around_dispatch => sub {
my $next = shift;
my $c = shift;
$metrics->request($c);
if (defined $next) {
$next->();
}
});
my $config = $self->plugin('JSONConfig');
$self->config(hypnotoad => {listen => ['http://localhost:3000']}); $self->config(hypnotoad => {listen => ['http://localhost:3000']});
# Router # Router
my $r = $self->routes; my $r = $self->routes;

View File

@ -0,0 +1,27 @@
package BurguillosInfo::Controller::Metrics;
use v5.34.1;
use strict;
use warnings;
use Data::Dumper;
use BurguillosInfo::Tracking;
use Mojo::Base 'Mojolicious::Controller';
use DateTime::Format::ISO8601;
use DateTime::Format::Mail;
my $tracking;
sub request {
shift;
my $c = shift;
my $app = $c->app;
if (!defined $tracking) {
$tracking = BurguillosInfo::Tracking->new($app);
}
$tracking->register_request($c);
}
1;

View File

@ -1,13 +1,13 @@
package BurguillosInfo::Controller::Page; package BurguillosInfo::Controller::Page;
use BurguillosInfo::Categories;
use BurguillosInfo::Posts;
use v5.34.1; use v5.34.1;
use strict; use strict;
use warnings; use warnings;
use BurguillosInfo::Categories;
use BurguillosInfo::Posts;
use Data::Dumper; use Data::Dumper;
use Mojo::Base 'Mojolicious::Controller'; use Mojo::Base 'Mojolicious::Controller';

91
lib/BurguillosInfo/DB.pm Normal file
View File

@ -0,0 +1,91 @@
package BurguillosInfo::DB;
use v5.34.1;
use strict;
use warnings;
use DBI;
use DBD::Pg;
use BurguillosInfo::DB::Migrations;
use Data::Dumper;
my $dbh;
sub connect {
if (defined $dbh) {
return $dbh;
}
my $class = shift;
my $app = shift;
my $config = $app->config;
my $database = $config->{db}{database};
$dbh = DBI->connect(
"dbi:Pg:dbname=$database",
, undef, undef, { RaiseError => 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 = BurguillosInfo::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;
$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;

View File

@ -0,0 +1,30 @@
package BurguillosInfo::DB::Migrations;
use v5.34.1;
use strict;
use warnings;
sub MIGRATIONS {
return (
'CREATE TABLE options (
name TEXT PRIMARY KEY,
value TEXT
)',
'CREATE EXTENSION IF NOT EXISTS "uuid-ossp"',
'CREATE TABLE paths (
path TEXT PRIMARY KEY,
first_seen timestamp DEFAULT NOW()
)',
'CREATE TABLE requests (
uuid UUID DEFAULT uuid_generate_v4(),
remote_address TEXT NOT NULL,
user_agent TEXT NOT NULL,
params JSON NOT NULL,
date timestamp DEFAULT NOW(),
path TEXT,
FOREIGN KEY (path) REFERENCES paths(path)
)',
);
}
1;

View File

@ -0,0 +1,40 @@
package BurguillosInfo::Tracking;
use v5.34.1;
use strict;
use warnings;
use JSON;
use BurguillosInfo::DB;
my $app;
sub new {
my $class = shift;
$app = shift;
my $dbh = BurguillosInfo::DB->connect($app);
return bless {}, $class;
}
sub register_request {
my $self = shift;
my $c = shift;
my $path = $c->req->url->path;
my $dbh = BurguillosInfo::DB->connect($app);
$dbh->do( <<'EOF', undef, $c->req->url->path );
INSERT INTO paths (path) VALUES (?) ON CONFLICT DO NOTHING;
EOF
my $remote_address = $c->tx->remote_address;
my $user_agent = $c->req->headers->user_agent;
my $params_json = encode_json( $c->req->params->to_hash );
$dbh->do(
<<'EOF', undef, $remote_address, $user_agent, $params_json, $path );
INSERT INTO requests(remote_address, user_agent, params, path)
VALUES (?, ?, ?, ?);
EOF
say "Registered $remote_address with user agent $user_agent visited $path with $params_json";
}
1;