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