Adding tracking to now what pages are visited.

I feel a little zuckenberg today.

burguillos_info.json.example

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

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');

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;

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';

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;

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;

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;