#!/usr/bin/perl -w
#
# (c) Bernhard Walle <bwalle@suse.de>
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; You may only use version 2 of the License, you have no option to
# use any other version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 675 Mass
# Ave, Cambridge, MA 02139, USA.
#

use Getopt::Long;

my $VERSION = "0.3.3";
my %ALIASES = (
    'smb'       => 'cifs',
    'scp'       => 'ssh'
);

###############################################################################
# Outputs usage information
sub usage
{
    print "url_parser $VERSION\n";
    print "";
    print "Syntax:\n";
    print "    url_parser [options] URL\n";
    print "\n";
    print "Options:\n";
    print "    -h | --help        Print help\n";
    print "    -d | --debug       Outputs debug information\n";
    print "    -p | --protocol    Prints the protocol of the URL\n";
    print "    -u | --user        Prints the username (not NFS)\n";
    print "    -p | --password    Prints the password (not NFS\n";
    print "    -o | --hostname    Prints the hostname in the URL\n";
    print "    -s | --share       Prints the share (NFS and CIFS only)\n";
    print "    -t | --port        Prints the port (HTTP/FTP/SSH only)\n";
    print "    -a | --path        Prints the path\n";
}

###############################################################################
# Returns the protocol.
sub get_protocol
{
    my $url = shift;

    my ($protocol) = $url =~ m#^(\w+)://#;
    if (!$protocol) {
        return undef;
    }
    $protocol = lc($protocol);

    # protocol aliases
    if (exists $ALIASES{$protocol}) {
        $protocol = $ALIASES{$protocol};
    }

    return $protocol;
}

###############################################################################
# Returns username and password if appropriate
sub get_user_password
{
    my $url = shift;

    my ($user, $password) = $url =~ m#^\w+://([^\s:]+)(:[^\s]+)?@#;
    if (defined $password) {
        $password =~ s/^://;
    }

    return ($user, $password);
}

###############################################################################
# Returns host and port if appropriate
sub get_host_port
{
    my $url = shift;

    my ($host, $port) = $url =~ m#^\w+://(?:\S+@)?([^\s/:]+)(:[^/\s]+)?/?#;
    if (defined $port) {
        $port =~ s/^://;
    }

    return ($host, $port);
}

###############################################################################
# Gets the path
sub get_path
{
    my $url = shift;

    my ($path) = $url =~ m#^\w+://[^\s/]*(/.*)#;
    return $path;
}

###############################################################################
# Gets the NFS stuff
sub get_nfs_params
{
    my $url = shift;

    my ($hostname, $share, $path) = $url =~ m#^\w+://([^\s:]+):([^\s:]+):(.*)#;
    return ($hostname, $share, $path);
}

###############################################################################
# Prints debugging information if $print_debug was set.
sub debug
{
    if ($print_debug) {
        print join(" ", @_), "\n";
    }
}

###############################################################################
# The main program

#
# parse command line
our ($print_help, $print_debug, $print_protocol, $print_username, $print_password,
     $print_host, $print_port);
GetOptions (
    'h|help' 				=> 	\$print_help,
    'd|debug'				=>	\$print_debug,
    'p|protocol'            =>  \$print_protocol,
    'u|username'            =>  \$print_username,
    'w|password'            =>  \$print_password,
    'o|host'                =>  \$print_host,
    't|port'                =>  \$print_port,
    'a|path'                =>  \$print_path,
    's|share'               =>  \$print_share
);

if ($print_help) {
    usage();
    exit(0);
}

my $URL = $ARGV[0];
if (!$URL) {
    usage();
    exit(1);
}

my ($protocol, $user, $hostname, $password, $port, $share, $path);

#
# get the protocol
$protocol = get_protocol($URL);
    
#
# check for simple files
if (!defined $protocol) {
    if ($URL =~ m#://#) {
        die "Invalid protcol";
    }

    $protocol = "file";
    $path = $URL;
}
    
#
# username and password
if (($protocol eq "http") or ($protocol eq "ftp") or ($protocol eq "cifs")
        or ($protocol eq "ssh")) {
    ($user, $password) = get_user_password($URL);
}

#
# port and hostname
if (($protocol eq "http") or ($protocol eq "ftp") or ($protocol eq "ssh")) {
    ($hostname, $port) = get_host_port($URL);
} elsif ($protocol eq "cifs" or $protocol eq "nfs") {
    ($hostname, undef) = get_host_port($URL);
}

#
# path
if (!$path) {
    $path = get_path($URL);

    if ($protocol eq "cifs") {
        ($share, $path) = $path =~ m#^/?([^\s/]+)/(.*)$#;
    }
}

#
# print the stuff
if ($print_protocol) {
    print $protocol, "\n";
}
if ($print_username) {
    print (($user ? $user : "")."\n");
}
if ($print_password) {
    print (($password ? $password : "")."\n");
}
if ($print_host) {
    print (($hostname ? $hostname : "")."\n");
}
if ($print_port) {
    print (($port ? $port : "")."\n");
}
if ($print_share) {
    print (($share ? $share : "")."\n");
}
if ($print_path) {
    print (($path ? $path : "")."\n");
}



# vim: set sw=4 ts=4 et:
