#!/usr/bin/env perl use strict; use warnings FATAL => 'all'; use Dancer ':script'; use Dancer::Plugin::DBIC 'schema'; use HTTP::Tiny; use Try::Tiny; =head1 netdisco-db-deploy This script upgrades or initialises a Netdisco database schema. Pre-existing requirements are that there be a database table created and a user with rights to create tables in that database. Both the table and user name must match those configured in your environment YAML file (default C). Simply run this script, which connects to the database and runs without user interaction. If there's no Nedisco schema, it is deployed. If there's an unversioned schema then versioning is added, and updates applied. Otherwise only necessary updates are applied to an already versioned schema. Additionally this script will download the latest MAC address vendor prefix data from the Internet, and update the OUI table in the database. Hence Internet access is required to run the script. =head2 Versions =over 4 =item * Version 1 is a completely empty database schema with no tables =item * Version 2 is the "classic" Netdisco database schema as of Netdisco 1.1 =item * Version 3 adds patches for Netdisco 1.2 =item * Version 4 (not yet created) B =back =cut my $schema = schema('netdisco'); # installs the dbix_class_schema_versions table with version "1" # which corresponds to an empty schema if (not $schema->get_db_version) { $schema->txn_do(sub { $schema->install(1) }); $schema->storage->disconnect; } # test for existing schema at public release version, set v=2 if so try { $schema->storage->dbh_do(sub { my ($storage, $dbh) = @_; $dbh->selectrow_arrayref("SELECT * FROM device WHERE 0 = 1"); }); $schema->_set_db_version(2) if $schema->get_db_version == 1; $schema->storage->disconnect; }; # upgrade from whatever dbix_class_schema_versions says, to $VERSION $schema->txn_do(sub { $schema->upgrade }); # now populate/update the OUI data my $url = 'http://standards.ieee.org/develop/regauth/oui/oui.txt'; my $resp = HTTP::Tiny->new->get($url); my %data = (); if ($resp->{success}) { foreach my $line (split /\n/, $resp->{content}) { if ($line =~ m/^(.{2}-.{2}-.{2})\s+\(hex\)\s+(.*)\s*$/i) { my ($oui, $company) = ($1, $2); $oui =~ s/-/:/g; $data{lc($oui)} = $company; } } if ((scalar keys %data) > 15_000) { $schema->txn_do(sub{ $schema->resultset('Oui')->delete; $schema->resultset('Oui')->populate([ map {{oui => $_, company => $data{$_}}} keys %data ]); }); } } exit 0;