From ae16dd4b6b076eb8332c5df45443d97b0cde725f Mon Sep 17 00:00:00 2001 From: sergiotarxz Date: Tue, 15 Nov 2022 23:30:37 +0100 Subject: [PATCH] Adding tracking to now what pages are visited. I feel a little zuckenberg today. --- burguillos_info.json.example | 5 ++ lib/BurguillosInfo.pm | 16 ++++- lib/BurguillosInfo/Controller/Metrics.pm | 27 +++++++ lib/BurguillosInfo/Controller/Page.pm | 6 +- lib/BurguillosInfo/DB.pm | 91 ++++++++++++++++++++++++ lib/BurguillosInfo/DB/Migrations.pm | 30 ++++++++ lib/BurguillosInfo/Tracking.pm | 40 +++++++++++ 7 files changed, 210 insertions(+), 5 deletions(-) create mode 100644 burguillos_info.json.example create mode 100644 lib/BurguillosInfo/Controller/Metrics.pm create mode 100644 lib/BurguillosInfo/DB.pm create mode 100644 lib/BurguillosInfo/DB/Migrations.pm create mode 100644 lib/BurguillosInfo/Tracking.pm diff --git a/burguillos_info.json.example b/burguillos_info.json.example new file mode 100644 index 0000000..aef7a35 --- /dev/null +++ b/burguillos_info.json.example @@ -0,0 +1,5 @@ +{ + "db": { + "database": "example" + } +} diff --git a/lib/BurguillosInfo.pm b/lib/BurguillosInfo.pm index 146d862..ac22510 100644 --- a/lib/BurguillosInfo.pm +++ b/lib/BurguillosInfo.pm @@ -1,13 +1,25 @@ package BurguillosInfo; + +use BurguillosInfo::Controller::Metrics; + use Mojo::Base 'Mojolicious', -signatures; # This method will run once at server start 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']}); # Router my $r = $self->routes; - + # Normal route to controller $r->get('/')->to('Page#index'); # $r->get('/:post')->to('Page#post'); diff --git a/lib/BurguillosInfo/Controller/Metrics.pm b/lib/BurguillosInfo/Controller/Metrics.pm new file mode 100644 index 0000000..50baa76 --- /dev/null +++ b/lib/BurguillosInfo/Controller/Metrics.pm @@ -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; diff --git a/lib/BurguillosInfo/Controller/Page.pm b/lib/BurguillosInfo/Controller/Page.pm index c0e2c5e..4768e76 100644 --- a/lib/BurguillosInfo/Controller/Page.pm +++ b/lib/BurguillosInfo/Controller/Page.pm @@ -1,13 +1,13 @@ package BurguillosInfo::Controller::Page; -use BurguillosInfo::Categories; -use BurguillosInfo::Posts; - use v5.34.1; use strict; use warnings; +use BurguillosInfo::Categories; +use BurguillosInfo::Posts; + use Data::Dumper; use Mojo::Base 'Mojolicious::Controller'; diff --git a/lib/BurguillosInfo/DB.pm b/lib/BurguillosInfo/DB.pm new file mode 100644 index 0000000..2bbdfca --- /dev/null +++ b/lib/BurguillosInfo/DB.pm @@ -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; diff --git a/lib/BurguillosInfo/DB/Migrations.pm b/lib/BurguillosInfo/DB/Migrations.pm new file mode 100644 index 0000000..f648836 --- /dev/null +++ b/lib/BurguillosInfo/DB/Migrations.pm @@ -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; diff --git a/lib/BurguillosInfo/Tracking.pm b/lib/BurguillosInfo/Tracking.pm new file mode 100644 index 0000000..74a277b --- /dev/null +++ b/lib/BurguillosInfo/Tracking.pm @@ -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;