Tfe

Old stuff/Perl/Url/url/urls.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"; }