#!/usr/bin/perl
use strict;
use warnings;
use diagnostics;
#
#  (c) 2005 John Garvin, Corkball Systems Inc.
#                        http://www.corkball.net
#
#  showallheaders.pl <url>:
#           prints out all client and server headers for one HTTP transaction.
#
use LWP;
my $VERSION = 0.01;

sub usage;
sub printheader($$);

if (defined ($ARGV[0])) {
    my $url       = 'http://' . $ARGV[0];
    my $ua       = LWP::UserAgent->new;
    my $headers   = HTTP::Headers->new('User_Agent' => 'Cyberdog/5.0',
                                        'Accept'    => 'image/gif, 
                                                       image/x-xbitmap,
                                                       image/pjpeg,
                                                       image/png,
                                                       */*',
                                        'Accept-Charset' => 'iso-8859-1',
                                        'Accept-Language'=> 'en-US');
  
        print("Client sends these headers:\n");
        print("\$headers->header_field_names: " . $headers->header_field_names . "\n");
        foreach my $k ($headers->header_field_names) {
	  print ("header field name: $k;\n");
	  }
	$headers->scan(\&printheader);
	print("===============\n");
        print("Server sends these headers back:\n");
    my $response  = $ua->get($url, $headers);
     if ($response->is_success) {
        print("ok!\n");
        $response->scan(\&printheader);
        print("length: " . length($response->content) . "\n");
        print("\$response->header_field_names: " . $response->header_field_names . "\n");
        foreach my $k ($response->header_field_names) {
	  print ("header field name: $k;\n");
	  }
        print("\$response->content_type: " . $response->content_type . "\n");
        print("\$response->status_line: " . $response->status_line . "\n");
    } else {
        print("uh-oh!\n");
        print($response->status_line . "\n");
    }
} else { 
     die &usage;
}
sub usage {
    print("showallheaders.pl <url>:\n\t\tprints out all client and server headers for one HTTP transaction.\n");
}

sub printheader($$) {
my $k = shift;
my $v = shift;
print ("Header: $k Value: $v\n");
}