Moved project directories and files to an empty local repo

2024-06-04 16:35:44 +01:00
parent 2d2b937a9b
commit 38abbcdd39
271 changed files with 55348 additions and 0 deletions
--- a/Database/host_image
+++ b/Database/host_image
@@ -0,0 +1,179 @@
+#!/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
+