Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Commit efae52e

Browse files
committed
Initial revision
1 parent 3de2736 commit efae52e

1 file changed

Lines changed: 146 additions & 0 deletions

File tree

Tools/world/world

Lines changed: 146 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,146 @@
1+
#! /depot/gnu/plat/bin/perl
2+
#
3+
# Note: you may have to edit the top line in this file.
4+
#
5+
# Usage: world addr
6+
#
7+
# $Id$
8+
9+
# This little perl program will take an internet address of the form
10+
# [email protected] and will print out where in the world that
11+
# message originated from. Its pretty dumb in that it just matches
12+
# the `domain' part against a hard-coded list. Also, I haven't
13+
# checked the list for validity -- I picked it up from someplace. With
14+
# the speed in which political boundaries are changing these days, no
15+
# doubt there are some incorrect mappings.
16+
17+
$prog = $0;
18+
$ARGV[0] || die "No addresses provided.\nUsage: $prog addr1 [addr2 ...]\n";
19+
20+
21+
22+
# The mappings
23+
%nameorg = (
24+
"arpa", "Arpanet",
25+
'com', 'commercial',
26+
'edu', 'educational',
27+
'gov', 'government',
28+
'mil', 'military',
29+
'net', 'networking',
30+
'org', 'non-commercial',
31+
'int', 'international'
32+
);
33+
34+
35+
%country = (
36+
"ag", "Antigua and Barbuda",
37+
"al", "Albania",
38+
"aq", "Antarctica",
39+
"ar", "Argentina",
40+
"at", "Austria",
41+
"au", "Australia",
42+
"bb", "Barbados",
43+
"be", "Belgium",
44+
"bg", "Bulgaria",
45+
"bo", "Bolivia",
46+
"br", "Brazil",
47+
"bs", "Bahamas",
48+
"bz", "Belize",
49+
"ca", "Canada",
50+
"ch", "Switzerland",
51+
"cl", "Chile",
52+
"cm", "Cameroon",
53+
"cn", "China",
54+
"co", "Colombia",
55+
"cr", "Costa Rica",
56+
"cy", "Cyprus",
57+
"cz", "Czech Republic",
58+
"de", "Germany",
59+
"dk", "Denmark",
60+
"dm", "Dominica",
61+
"do", "Dominican Republic",
62+
"ec", "Ecuador",
63+
"ee", "Estonia",
64+
"eg", "Egypt",
65+
"es", "Spain",
66+
"fi", "Finland",
67+
"fj", "Fiji",
68+
"fr", "France",
69+
"gb", "Great Britain",
70+
"gh", "Ghana",
71+
"gr", "Greece",
72+
"hk", "Hong Kong",
73+
"hr", "Croatia",
74+
"hu", "Hungary",
75+
"id", "Indonesia",
76+
"ie", "Ireland",
77+
"il", "Israel",
78+
"in", "India",
79+
"is", "Iceland",
80+
"it", "Italy",
81+
"jm", "Jamaica",
82+
"jp", "Japan",
83+
"km", "Comoros",
84+
"kn", "Saint Kitts and Nevis",
85+
"kr", "Republic of Korea",
86+
"kw", "Kuwait",
87+
"lc", "Saint Lucia",
88+
"li", "Liechtenstein",
89+
"lk", "Sri Lanka",
90+
"lu", "Luxembourg",
91+
"lv", "Latvia",
92+
"my", "Malaysia",
93+
"mx", "Mexico",
94+
"na", "Namibia",
95+
"ni", "Nicaragua",
96+
"nl", "Netherlands",
97+
"no", "Norway",
98+
"nz", "New Zealand",
99+
"pe", "Peru",
100+
"pg", "Papua New Guinea",
101+
"ph", "Philippines",
102+
"pl", "Poland",
103+
"pr", "Puerto Rico",
104+
"pt", "Portugal",
105+
"py", "Paraguay",
106+
"ro", "Romania",
107+
"se", "Sweden",
108+
"sg", "Singapore",
109+
"si", "Slovenia",
110+
"sk", "Slovakia",
111+
"sr", "Suriname",
112+
"su", "USSR",
113+
"tw", "Taiwan",
114+
"th", "Thailand",
115+
"tn", "Tunisia",
116+
"tr", "Turkey",
117+
"tt", "Trinidad and Tobago",
118+
"uk", "United Kingdom",
119+
"us", "United States",
120+
"uy", "Uruguay",
121+
"vc", "Saint Vincent and the Grenadines",
122+
"ve", "Venezuela",
123+
"vi", "Virgin Islands",
124+
"yu", "Yugoslavia",
125+
"za", "South Africa",
126+
"zw", "Zimbabwe"
127+
);
128+
129+
130+
while ($addr = shift @ARGV) {
131+
($_) = $addr =~ /\.(.*)$/;
132+
$_ = $addr if !$_;
133+
134+
if ($nameorg{$_}) {
135+
# its one of the `special' USA organizational domains
136+
print "$addr is a USA $nameorg{$_} organization\n";
137+
}
138+
elsif ($country{$_}) {
139+
# its a country code
140+
print "$addr originated from $country{$_}\n";
141+
}
142+
else {
143+
# who knows?
144+
print "I have no idea where $addr came from!\n";
145+
}
146+
}

0 commit comments

Comments
 (0)