diff options
| author | Yang Tse <yangsita@gmail.com> | 2010-01-18 02:32:48 +0000 |
|---|---|---|
| committer | Yang Tse <yangsita@gmail.com> | 2010-01-18 02:32:48 +0000 |
| commit | 0375f70b5c0ca41dcf3d1fe2261170adf695fc47 (patch) | |
| tree | 2a0495c741c86e33a4464829bf485c99248eea4b | |
| parent | 7f8980114b4371db56ff19cdbaab58b18fad8874 (diff) | |
add serverfactors() sub which returns server characterization factors
| -rw-r--r-- | tests/serverhelp.pm | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/tests/serverhelp.pm b/tests/serverhelp.pm index 53aeb79cb..d34a821a1 100644 --- a/tests/serverhelp.pm +++ b/tests/serverhelp.pm @@ -47,6 +47,7 @@ use vars qw( # Global symbols this module will export upon request # @EXPORT_OK = qw( + serverfactors servername_id servername_str servername_canon @@ -63,6 +64,32 @@ use vars qw( #*************************************************************************** +# Return server characterization factors given a server id string. +# +sub serverfactors { + my $server = $_[0]; + my $proto; + my $ipvnum; + my $idnum; + + if($server =~ /^((ftp|http|imap|pop3|smtp)s?)(\d*)(-ipv6|)$/) { + $proto = $1; + $idnum = ($3 && ($3 > 1)) ? $3 : 1; + $ipvnum = ($4 && ($4 =~ /6$/)) ? 6 : 4; + } + elsif($server =~ /^(tftp|sftp|socks|ssh)(\d*)(-ipv6|)$/) { + $proto = $1; + $idnum = ($2 && ($2 > 1)) ? $2 : 1; + $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4; + } + else { + die "invalid server id: $server" + } + return($proto, $ipvnum, $idnum); +} + + +#*************************************************************************** # Return server name string formatted for presentation purposes # sub servername_str { |