--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interps/clc-intercal/inst/lib/perl5/Language/INTERCAL/HostIP.pm	Sun Dec 09 19:30:08 2012 +0000
@@ -0,0 +1,101 @@
+package Language::INTERCAL::HostIP;
+
+# Finds information about local network interfaces; this has been inspired
+# by Sys::HostIP, but completely rewritten. I did email the author of
+# Sys::HostIP offering patches which would make it more general (general
+# enough for what I need) and more portable, but I never received an
+# answer so I have decided to write my own version. At the same time,
+# some of the extra bits of Sys::HostIP which I don't need have not
+# been duplicated.
+
+# This file is part of CLC-INTERCAL
+
+# Copyright (c) 2007-2008 Claudio Calvelli, all rights reserved.
+
+# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
+# and distribute it is granted provided that the conditions set out in the
+# licence agreement are met. See files README and COPYING in the distribution.
+
+use strict;
+use vars qw($VERSION $PERVERSION);
+($VERSION) = ($PERVERSION = "CLC-INTERCAL/Base INTERCAL/HostIP.pm 1.-94.-2") =~ /\s(\S+)$/;
+
+use Carp;
+use Language::INTERCAL::Exporter '1.-94.-2';
+use vars qw(@EXPORT_OK);
+@EXPORT_OK = qw(find_interfaces);
+
+sub find_interfaces {
+    @_ == 0 or croak "Usage: find_interfaces()";
+    if ($^O =~ /MSWin32|cygwin/i) {
+	return _find_interfaces_windows();
+    } else {
+	return _find_interfaces_unix();
+    }
+}
+
+sub _find_interfaces_unix {
+    my $ifconfig = undef;
+    # if the system has some form of ifconfig, assume we can use it...
+    for my $path (qw(/sbin /usr/sbin /etc /usr/etc), split(/:/, $ENV{PATH})) {
+	-f "$path/ifconfig" or next;
+	$ifconfig = "$path/ifconfig";
+	last;
+    }
+    $ifconfig or return {}; # sorry, can't do it
+    # try $ifconfig -a first; if that fails, try $ifconfig
+    my $res = _parse_unix("$ifconfig -a");
+    keys %$res and return $res;
+    _parse_unix($ifconfig);
+}
+
+sub _parse_unix {
+    my ($ifconfig) = @_;
+    open(IFCONFIG, "$ifconfig 2>&1 |") or return {};
+    my %res = ();
+    my $name = undef;
+    # this parses the output of both Linux' and *BSD's ifconfig
+    while (<IFCONFIG>) {
+	/^(\w+):?\s/ and $name = $1;
+	/\S/ or $name = undef;
+	defined $name or next;
+	/\binet(?:\s+addr)?\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i
+	    and $res{$name}{addr} = $1;
+	/\bb(?:road)?cast\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i
+	    and $res{$name}{bcast} = $1;
+	/\b(?:net)?mask\s*(?::\s*)?(\d+(?:\.\d+){3})\b/i # linux mask
+	    and $res{$name}{mask} = $1;
+	/\b(?:net)?mask\s*(?::\s*)?0x([[:xdigit:]]{2})   # *bsd mask
+				     ([[:xdigit:]]{2})
+				     ([[:xdigit:]]{2})
+				     ([[:xdigit:]]{2})\b/ix
+	    and $res{$name}{mask} = join('.', map { hex } $1, $2, $3, $4);
+	# XXX IPv6
+    }
+    close IFCONFIG;
+    \%res;
+}
+
+sub _find_interfaces_windows {
+    # XXX tested on 98 and eXtra Perverse, but not on Vista
+    open(IPCONFIG, 'ipconfig |') or return {};
+    my %res = ();
+    my $name = undef;
+    while (<IFCONFIG>) {
+	/^Windows .* IP Configuration/i and next;
+	/\S/ or next;
+	/^(?:Ethernet|Wireless)\s+adapter\s+(.*):/i and $name = $1;
+	/^(.*)\s+(?:Ethernet|Wireless)\s+adapter/i and $name = $1;
+	defined $name or next;
+	/\sIP\s+Address.*:\s+(\d+(?:\.\d+){3})/i
+	    and $res{$name}{addr} = $1;
+	/\sMask.*:\s+(\d+(?:\.\d+){3})/i
+	    and $res{$name}{mask} = $1;
+	/\sBroadcast.*:\s+(\d+(?:\.\d+){3})/i
+	    and $res{$name}{bcast} = $1;
+    }
+    close IPCONFIG;
+    \%res;
+}
+
+1;