File Coverage

blib/lib/getaddress.pm
Criterion Covered Total %
statement 28 39 71.7
branch 3 10 30.0
condition 1 3 33.3
subroutine 7 9 77.7
pod 0 1 0.0
total 39 62 62.9


line stmt bran cond sub pod time code
1             package getaddress;
2              
3 1     1   37948 use 5.006001;
  1         4  
  1         34  
4 1     1   5 use strict;
  1         1  
  1         31  
5 1     1   4 use warnings;
  1         7  
  1         46  
6 1     1   6 use Carp;
  1         2  
  1         125  
7              
8             require Exporter;
9 1     1   920 use AutoLoader;
  1         1547  
  1         5  
10              
11             our @ISA = qw(Exporter);
12              
13             # Items to export into callers namespace by default. Note: do not export
14             # names by default without a very good reason. Use EXPORT_OK instead.
15             # Do not simply export all your public functions/methods/constants.
16              
17             # This allows declaration use getaddress ':all';
18             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
19             # will save memory.
20             our %EXPORT_TAGS = ( 'all' => [ qw(
21            
22             ) ] );
23              
24             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25              
26             our @EXPORT = qw(
27             ipwhere
28             );
29              
30             our $VERSION = '0.04';
31              
32             sub AUTOLOAD {
33             # This AUTOLOAD is used to 'autoload' constants from the constant()
34             # XS function.
35              
36 0     0   0 my $constname;
37 0         0 our $AUTOLOAD;
38 0         0 ($constname = $AUTOLOAD) =~ s/.*:://;
39 0 0       0 croak "&getaddress::constant not defined" if $constname eq 'constant';
40 0         0 my ($error, $val) = constant($constname);
41 0 0       0 if ($error) { croak $error; }
  0         0  
42             {
43 1     1   154 no strict 'refs';
  1         1  
  1         207  
  0         0  
44             # Fixed between 5.005_53 and 5.005_61
45             #XXX if ($] >= 5.00561) {
46             #XXX *$AUTOLOAD = sub () { $val };
47             #XXX }
48             #XXX else {
49 0     0   0 *$AUTOLOAD = sub { $val };
  0         0  
50             #XXX }
51             }
52 0         0 goto &$AUTOLOAD;
53             }
54              
55             require XSLoader;
56             XSLoader::load('getaddress', $VERSION);
57              
58             # Preloaded methods go here.
59             sub ipwhere
60             {
61 1     1 0 9 my $ip = shift;
62 1         2 my $ipfile = shift;
63 1 50       4 $ipfile = "data/QQWry.Dat" unless ($ipfile);
64 1         175 my $ipaddr = getipwhere ($ipfile, $ip);
65 1 50       5 return '未知地区' unless ($ipaddr);
66 1         3 $ipaddr =~ s/CZ88\.NET//ig;
67 1         6 $ipaddr =~ s/^\s*//;
68 1         7 $ipaddr =~ s/\s*$//;
69 1 50 33     20 $ipaddr = '未知地区' if (!$ipaddr || $ipaddr =~ /未知|http/i);
70 1         3 return $ipaddr;
71             }
72              
73             # Autoload methods go after =cut, and are processed by the autosplit program.
74              
75             1;
76             __END__