home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Schemeless.pm < prev    next >
Encoding:
Perl POD Document  |  2002-07-01  |  2.5 KB  |  91 lines
  1. # $Id: Schemeless.pm,v 1.6 2002/07/01 14:45:52 roderick Exp $
  2.  
  3. package URI::Find::Schemeless;
  4.  
  5. use base qw(URI::Find);
  6.  
  7. # base.pm error in 5.005_03 prevents it from loading URI::Find if I'm
  8. # required first.
  9. use URI::Find ();
  10.  
  11. use vars qw($VERSION);
  12. $VERSION = q$Revision: 1.6 $ =~ /(\d\S+)/ ? $1 : '?';
  13.  
  14. my($dnsSet) = 'A-Za-z0-9-';
  15.  
  16. my($cruftSet) = __PACKAGE__->cruft_set;
  17.  
  18. # We could put the whole ISO country code thing in here.
  19. my($tldRe)  = '(?i:biz|com|edu|gov|info|int|mil|net|org|[a-z]{2})';
  20.  
  21. my($uricSet) = __PACKAGE__->uric_set;
  22.  
  23. =pod
  24.  
  25. =head1 NAME
  26.  
  27. URI::Find::Schemeless - Find schemeless URIs in arbitrary text.
  28.  
  29.  
  30. =head1 SYNOPSIS
  31.  
  32.   require URI::Find::Schemeless;
  33.  
  34.   my $finder = URI::Find::Schemeless->new(\&callback);
  35.  
  36.   The rest is the same as URI::Find.
  37.  
  38.  
  39. =head1 DESCRIPTION
  40.  
  41. URI::Find finds absolute URIs in plain text with some weak heuristics
  42. for finding schemeless URIs.  This subclass is for finding things
  43. which might be URIs in free text.  Things like "www.foo.com" and
  44. "lifes.a.bitch.if.you.aint.got.net".
  45.  
  46. The heuristics are such that it hopefully finds a minimum of false
  47. positives, but there's no easy way for it know if "COMMAND.COM" refers
  48. to a web site or a file.
  49.  
  50. =cut
  51.  
  52. sub schemeless_uri_re {
  53.     return qr{
  54.               # Originally I constrained what couldn't be before the match
  55.               # like this:  don't match email addresses, and don't start
  56.               # anywhere but at the beginning of a host name
  57.               #    (?<![\@.$dnsSet])
  58.               # but I switched to saying what can be there after seeing a
  59.               # false match of "Lite.pm" via "MIME/Lite.pm".
  60.               (?: ^ | (?<=[\s<]) )
  61.               # hostname
  62.               (?: [$dnsSet]+(?:\.[$dnsSet]+)*\.$tldRe
  63.                   | (?:\d{1,3}\.){3}\d{1,3} ) # not inet_aton() complete
  64.               (?:
  65.                   (?=[\s>?$cruftSet])    # followed by unrelated thing
  66.           (?!\.\w)        #   but don't stop mid foo.xx.bar
  67.                       (?<!\.p[ml])    #   but exclude Foo.pm and Foo.pl
  68.                   |$            # or end of line
  69.                       (?<!\.p[ml])    #   but exclude Foo.pm and Foo.pl
  70.                   |/[$uricSet#]*    # or slash and URI chars
  71.               )
  72.            }x;
  73. }
  74.  
  75. =pod
  76.  
  77. =head1 AUTHOR
  78.  
  79. Original code by Roderick Schertler <roderick@argon.org>, adapted by
  80. Michael G Schwern <schwern@pobox.com>.
  81.  
  82. Currently maintained by Roderick Schertler <roderick@argon.org>.
  83.  
  84. =head1 SEE ALSO
  85.  
  86.   L<URI::Find>
  87.  
  88. =cut
  89.  
  90. 1;
  91.