Tfe

Old stuff/Perl/Url/url/old.pl

#!/usr/bin/perl -w
use strict;
use Tk;

# Perl script by tfe
# http/ftp/ed2k/rsync Grabber 
# Posibilite de personnaliser: grabber les urls ayant certaines extensions, ou certains type d'url.
# Version 0.1

$_ = "petit test: phrase avec un url. http://microsoft.com:21/linux/kernel.tar.bz2";
my @match = ("https","http","ftp","rsync");

#my @extension = ("com","org","net","fr","es");						# Pour grabber certains
my @extension = q!\w{2,5}!;								# Pour tout grabber toutes les extensions

my @words = ("pub","linux","download","warez");						# Grab url complete, si contient ces mots
my @bad_serv = ("porn","warez","sex","microsoft");



if   (  m/
      (
   
	  
	       (??{   join('|',@match)  })    						#(?: https|http|ftp|rsync)
	       :\/\/
	       (?: \w+\:\w+\@)?								 Si besoin d'un login et password
#
       	       [\w_\.]+\. (?: (??{ join ('|',@extension)})) 			#  url + (?: com|org|net|fr|es)
#	       (?: :\d+)?							# Si un port est specifie (facultatif)
#	       (?: \/								# urls complexes (http: urls suite)
#	       	    (?(?=							# motif de previon: 
# 		  	(??{join('|',@words)}))  				#    + Si un des @words trouve
#   		        [\w\._\?\/\&]+ 						# alors on grab...
#		    )
# 	
#	       )?								# url complexe facultative...
	

      )	
   
   
    
     /ix)
   
   
   
   { print "\nok: Url trouvee: $1\n\n"; }