Tfe

Old stuff/Perl/newirc/grabber.pl

#!/usr/bin/perl -w
use DBI;

sub grabber($)
{
    my $message = shift;

my ($nick,$channel,$message) = $message =~ /:([^!]+)!\S+\s+PRIVMSG\s+(\S+)\s(\S+)/;
$nick = lc($nick);


    print STDOUT "MESSAGE: $message\n";    



    if ($message =~
	/
	    (?:\W|^)
	    (
	     ((?:https?)|(?:ftp))		
	      :\/\/				
	              (
		      (?:
		       [a-z\.\-\_0-9]+ 	
			\.			
		      )?
    	    	        (
			    [a-z\-\_0-9]+?
		    	    \.

		        [a-z]{2,4}		
			)
		      )
		        (?::(\d+))?		
		    
		(
	        (?:\/|\?)
	        [a-z\/\?\(\)\~\;0-9\.\-\_\%\&\=]+
	        )?
	  )
	/ix
  
  )
    {
print STDOUT " ADDING  !!!!\n";
my $bdd = DBI->connect("dbi:Pg:dbname=web;","tfe","monger") or die "error connecting";

$url  = $1 ? $1 : "";
$protocol  = $2 ? $2 : "";
$fhost  = $3 ? $3 : "";
$mhost  = $4 ? $4 : "";
$port  = $5 ? $5 : "";


# $1 = url    
# $2 = protocol
# $3 = full host
# $4 = main host
# $5 = port



my $sth = $bdd->prepare("SELECT * FROM url WHERE url='$url'");
$sth->execute();
my $compteur=0;
while(my $row = $sth->fetchrow_hashref)
{
    $compteur= 1;
}
if ($compteur ==0)
{
$sth = $bdd->prepare("INSERT INTO url
    (protocol,pseudo,channel,server,host,vhost,url,port)
    VALUES
    ('$protocol','$nick','$channel','$server','$mhost','$fhost','$url','$port')
    ") or die $bdd->errstr;
$sth->execute() or  die $bdd->errstr;
}


$bdd->disconnect();


}



$_ = $message;



return $_;
}

return 1;