#!/usr/bin/perl -w
#<url: encode or decode strings resembling URLs

use Getopt::Long;
use File::Basename;
use Carp;
use strict;

use subs qw(manpage myuuid usage version where);
$ENV{'PATH'} = join ":", qw(/bin /usr/bin /usr/local/bin /opt/sfw/bin);

my $myname = basename($0);
$myname =~ s/\.\w*$//;    # strip any extension

my %options;
my @getopt_args = (
    'd',          # decode URLs
    'e',          # encode URLs
    'h|?',        # print usage
    'm',          # print manpage
    'u',          # print UUID
    'v',          # print version
    'w',          # print source location
    );

Getopt::Long::config("noignorecase", "bundling");
usage unless GetOptions(\%options, @getopt_args);

manpage if $options{'m'};
myuuid  if $options{'u'};
version if $options{'v'};
where   if $options{'w'};
usage   if $options{'h'};

# Real work starts here.

my %args;
my $action = bless \%args, 'Action';
my $choice = "urldecode";            # default to decode URLs
$choice    = "urlencode" if $options{'e'};

my $f = $action->can($choice);
$f->();

exit(0);

#---------------------------------------------------------------------
# Decode URLs.

sub Action::urldecode {
    local $_;

    while (<>) {
        s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
        s/<!--(.|\n)*-->//g;
        print;
    }
}

#---------------------------------------------------------------------
# Encode strings unless they're already encoded.

sub Action::urlencode {
    local $_;

    while (<>) {
        s/([^a-z0-9\/\n\-_.!~*'()+])/"%" . sprintf("%2.2X", ord($1))/gei
          unless /%([a-fA-F0-9]{2,2})/;
        print;
    }
}

#---------------------------------------------------------------------
# Print a usage message from the comments and exit.

sub usage {
    my ($emsg) = @_;
    use Pod::Usage qw(pod2usage);
    warn "$emsg\n" if defined $emsg;
    pod2usage(-verbose => 99, -sections => "NAME|SYNOPSIS|OPTIONS");
}

sub manpage {
    my @args = ("perldoc", "$0");
    exec { $args[0] } @args;          # safe even with one-arg list
    die("should not get here\n");
}

#---------------------------------------------------------------------
# Print the UUID, current version, or source location.

sub myuuid {
    my $UUID = sprintf("%s",
        q$UUID: eb021dd0-8b94-36b0-9041-87e0ed317e20 $ =~ /UUID: (.*) /);
    print "$UUID\n";
    exit(0);
}

sub version {
    my $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
    my $DATE =
      sprintf("%s", q$Date: 2010-11-02 20:53:14-04 $ =~ /Date: (.*) /);
    print "$myname $VERSION $DATE\n";
    exit(0);
}

sub where {
    my $SOURCE =
      sprintf("%s", q$Source: /home/vogelke/projects/url-encoding/RCS/url,v $ =~ /Source: (.*) /);
    my $HOST = $1 if q$Host: sys7.com $ =~ /Host: (.*) /;
    print "file://$HOST", "$SOURCE\n";
    exit(0);
}

#---------------------------------------------------------------------
__END__

=head1 NAME

url - encode or decode URLs

=head1 SYNOPSIS

url [-dehmuvw] [file ...]

=head1 OPTIONS

=over 4

=item B<-d>

Decode strings resembling URLs.

=item B<-e>

Encode strings resembling URLs.

=item B<-h>

Print a brief help message and exit.

=item B<-m>

Print the manual page and exit.

=item B<-u>

Print the script UUID and exit.

=item B<-v>

Print the version and exit.

=item B<-w>

Print the source location and exit.

=back

=head1 DESCRIPTION

B<url> will read strings that look like URLs and either
encode them for use in a browser, or decode them.  Can be used
to turn webserver log entries into filenames or vice-versa.

=head1 EXAMPLES

 me% echo 'Process%20Improvements' | url -d
 Process Improvements

 me% echo 'Process Improvements' | url -e
 Process%20Improvements

=head1 AUTHOR

 Karl Vogel <vogelke@pobox.com>
 Sumaria Systems, Inc.

=cut