#!/usr/bin/env perl

# Daniel Bowling <dbowling@akamai.com>
# Feb 2020
# version 0.21 - update $ver @ line 23

use strict;
use warnings;
use LWP::UserAgent;
use Getopt::Long qw(:config no_ignore_case);

# Parse options
GetOptions(
    'delimiter|d=s' => \my $sep,
    'header|H'      => \my $head,
    'help|h',       # technically does nothing right now
    'version|v'     => \my $ver,
    'wait|w=i'      => \my $wait
    );

# Version info option
if ($ver) {
    $ver = '0.21';
    print "$ver\n";
    exit;
}

# Choose what to do given args, STDIN, or null
if (@ARGV) {
    @_ = @ARGV                           # use args or...
} elsif (! -t STDIN) {
    chomp (@_ = <STDIN>)                 # use STDIN or...
} else {
    print "Usage: $0 <HOSTNAME(S)>\n\n"; # null, print help
    die <<'OPTIONS';
Find CP code from hostnames provided as arguments or STDIN.
    -d, --delimiter=DELIM   Change delimiting character (default is TAB)
    -H, --header            Print header with output lines
    -h, --help              Print this help message
    -v, --version           Print version
    -w, --wait              Set timeout value (default is 10)
OPTIONS
}

$sep = "\t" if ! $sep;  # Delimiter character
$wait = 10  if ! $wait; # Timeout value

# Define function to grab CP code from response headers
sub get_cp {
    # Declare some variables
    my ($ua, @reqheaders, $response, @ckey);

    # Create new LWP::UserAgent object & set timeout
    $ua  = LWP::UserAgent->new(
        'timeout'      => "$wait",
        'max_redirect' => '0'
        );

    # Add Pragma header to request headers
    @reqheaders = (
        'Pragma' => 'akamai-x-get-cache-key'
        );

    # Make HTTP request
    $response = $ua->head("http://@_", @reqheaders);

    # Return CP code
    if ($response->header("X-Cache-Key")) {
        @ckey = split(/\//, $response->header("X-Cache-Key"));
        return $ckey[3]; # CP code field of cache key
    } else {
        return "?"
    }
}

# Print header if -H|--header is specified
print "Hostname${sep}CP Code\n" if $head;

# Begin parsing hostnames
for (@_) {
    # Print hostname, delimiter, CP code and newline
    print $_ . $sep . get_cp($_) . "\n";
}