180 lines
5.0 KiB
Perl
Executable File
180 lines
5.0 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#===============================================================================
|
|
#
|
|
# FILE: host_image
|
|
#
|
|
# USAGE: ./host_image
|
|
#
|
|
# DESCRIPTION: Collects Gravatar images for HPR hosts. This version simply
|
|
# cycles through the list of hosts from the local copy of the
|
|
# database and attempts to collect the Gravatar for every one
|
|
# that has an email address and isn't marked as having a local
|
|
# image (provided via the show upload form) in the database.
|
|
#
|
|
# OPTIONS: ---
|
|
# REQUIREMENTS: ---
|
|
# BUGS: ---
|
|
# NOTES: ---
|
|
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
|
# VERSION: 0.0.2
|
|
# CREATED: 2016-08-31 16:52:52
|
|
# REVISION: 2021-10-15 21:02:52
|
|
#
|
|
#===============================================================================
|
|
|
|
use 5.010;
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use Config::General;
|
|
use Digest::MD5 qw{md5_hex};
|
|
#use Digest::MD5::File qw{file_md5_hex};
|
|
use LWP::Simple;
|
|
use DBI;
|
|
|
|
#
|
|
# Version number (manually incremented)
|
|
#
|
|
our $VERSION = '0.0.2';
|
|
|
|
#
|
|
# Script name
|
|
#
|
|
( my $PROG = $0 ) =~ s|.*/||mx;
|
|
( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
|
|
$DIR = '.' unless $DIR;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Declarations
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Constants and other declarations
|
|
#
|
|
my $basedir = "$ENV{HOME}/HPR/Database";
|
|
my $configfile = "$basedir/.hpr_db.cfg";
|
|
my $imgpath = "$basedir/www/images/hosts/%s.png";
|
|
my $urlformat = 'https://secure.gravatar.com/avatar/%s.png?d=404&s=90';
|
|
|
|
my ( $dbh, $sth1, $h1, $rv );
|
|
my ( $host, $hostid, $email, $grav_url, $img, $res );
|
|
|
|
#
|
|
# Enable Unicode mode
|
|
#
|
|
binmode STDOUT, ":encoding(UTF-8)";
|
|
binmode STDERR, ":encoding(UTF-8)";
|
|
|
|
#
|
|
# Load configuration data
|
|
#
|
|
my $conf = new Config::General(
|
|
-ConfigFile => $configfile,
|
|
-InterPolateVars => 1,
|
|
-ExtendedAccess => 1
|
|
);
|
|
my %config = $conf->getall();
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Connect to the database
|
|
# 2021-10-15: moved to MariaDB
|
|
#-------------------------------------------------------------------------------
|
|
my $dbhost = $config{database}->{host} // '127.0.0.1';
|
|
my $dbport = $config{database}->{port} // 3306;
|
|
my $dbname = $config{database}->{name};
|
|
my $dbuser = $config{database}->{user};
|
|
my $dbpwd = $config{database}->{password};
|
|
|
|
$dbh = DBI->connect( "DBI:MariaDB:host=$dbhost;port=$dbport;database=$dbname",
|
|
$dbuser, $dbpwd, { AutoCommit => 1, RaiseError => 1 } )
|
|
or die $DBI::errstr;
|
|
|
|
#
|
|
# Enable client-side UTF8 (MySQL only)
|
|
#
|
|
# $dbh->{mysql_enable_utf8} = 1;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Prepare SQL for finding hosts
|
|
#-------------------------------------------------------------------------------
|
|
$sth1 = $dbh->prepare(
|
|
q{SELECT host, hostid, email FROM hosts
|
|
WHERE valid = '1' AND local_image = '0'
|
|
ORDER BY hostid ASC}
|
|
);
|
|
$sth1->execute;
|
|
if ( $dbh->err ) {
|
|
die $dbh->errstr;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Loop through the hosts gathering gravatars
|
|
#-------------------------------------------------------------------------------
|
|
while ( $h1 = $sth1->fetchrow_hashref ) {
|
|
$host = $h1->{host};
|
|
$hostid = $h1->{hostid};
|
|
$email = $h1->{email};
|
|
|
|
#
|
|
# We need an email address
|
|
#
|
|
next unless ($email);
|
|
|
|
$res = fetch( $hostid, $host, $email, $urlformat, $imgpath );
|
|
}
|
|
|
|
$sth1->finish;
|
|
|
|
$dbh->disconnect;
|
|
|
|
exit;
|
|
|
|
#=== FUNCTION ================================================================
|
|
# NAME: fetch
|
|
# PURPOSE: Perform the fetching and saving of a gravatar image
|
|
# PARAMETERS: $hostid - host number from database
|
|
# $host - host name from database
|
|
# $email - email address from database
|
|
# $urlformat - template for building the gravatar URL
|
|
# $imgpath - template for building the file path
|
|
# RETURNS: Nothing
|
|
# DESCRIPTION: Uses LWP to collect the gravatar image using the URL
|
|
# constructed from a template and the email address, writes it
|
|
# to the constructed file path.
|
|
# THROWS: No exceptions
|
|
# COMMENTS: None
|
|
# SEE ALSO: N/A
|
|
#===============================================================================
|
|
sub fetch {
|
|
my ( $hostid, $host, $email, $urlformat, $imgpath ) = @_;
|
|
|
|
#
|
|
# Build the URL and the image file path
|
|
#
|
|
my $grav_url = sprintf( $urlformat, md5_hex( lc($email) ) );
|
|
my $img = sprintf( $imgpath, $hostid );
|
|
|
|
printf "%3d: %s (%s) %s %s - ", $hostid, $host, $email, $grav_url, $img;
|
|
|
|
#
|
|
# Collect the gravatar if there is one
|
|
#
|
|
my $res = getstore( $grav_url, $img );
|
|
|
|
#
|
|
# Remove any garbage
|
|
#
|
|
if ( $res != 200 ) {
|
|
print "Failed ($res)\n";
|
|
unlink($img);
|
|
return 0;
|
|
}
|
|
else {
|
|
print "OK\n";
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
|
|
|