#!/usr/bin/perl use strict; my @urls = qw(http://foo.com/downloads/pkg-5.6.tar.gz http://bar.com/list/file-5.6-win32.zip example.org/subd/golf.txt http://digg.com/page4 http://www.cnn.com/2008/US/07/17/beck.che.guevara/index.html ); for my $url (@urls){ print STDERR "URL: $url\n"; my $segment = url_segments($url); for my $key ( sort keys %$segment ){ my $val = $segment->{$key}; print STDERR " - $key : $val\n"; } print STDERR "\n"; } exit; sub url_segments { my $url = shift; my %segment = ( url => $url, domain => undef, location => undef, location_relative => undef, filename => undef, filename_only => undef, extension => undef, query_string => undef, protocol => undef, ); if ( $url=~s/(\?.*)$// ) {# take out possible query string $segment{query_string} = $1; } if ( $url=~s/^([a-z]{3,5})\:\/\///i ){ $segment{protocol} = $1; } if ( $url=~s/^([\w\.]+)// ){ $segment{domain} = $1; } if ( $url=~s/([^\/]+)\.([a-z0-9]{1,5})$// ){ $segment{filename} = "$1.$2"; $segment{filename_only} = $1; $segment{extension} = $2; } if ( $url ){ $segment{location_relative} = $url; $segment{location} = $segment{domain}.$segment{location_relative}; } return \%segment; }