first commit

Logging.pm

+package Logging;
+
+# ==============[ Classe pour gérer les logs correctement ]============== #
+#  Date : 29/10/2010                                                      #
+#  Auteur : TC                                                            #
+# ======================================================================= #
+
+use strict;
+use warnings;
+
+use Fcntl ':mode';
+
+
+# ###
+#  new
+# Instancie la classe - un constructeur en somme
+# ###
+sub new
+{
+	my $class = shift;
+	my $self = {
+		_file    =>   shift,
+		_colored =>   0,
+		_pending =>   0,
+		_utf8    =>   0,
+		_right_align => shift,
+	};
+	
+	bless $self, $class;
+	
+	# On active la couleur que si on est sur un terminal
+	# C'est moche après pour les fichiers ou un less
+	if($self->file eq "STDOUT")
+	{
+		$self->{"_colored"} = 1 if((stat(STDOUT))[2] & S_IFCHR);
+	}
+	elsif($self->file eq "STDERR")
+	{
+		$self->{"_colored"} = 1 if((stat(STDERR))[2] & S_IFCHR);
+	}
+	else
+	{
+		$self->{"_colored"} = 1 if((stat($self->file))[2] & S_IFCHR);
+	}
+	
+	
+	unless(defined $self->{"_right_align"})
+	{
+		$self->{"_right_align"} = 0;
+	}
+	
+	return $self;
+} # Fin new
+
+
+# ###
+#  file
+# Renvoie/maj $self->{'_file'}
+# ###
+sub file
+{
+	my $self = shift;
+	$self->{"_file"} = $_[0] if(defined($_[0]));
+	return $self->{"_file"};
+} # Fin file
+
+
+# ###
+#  colored
+# Renvoie/maj $self->{'_colored'}
+# ###
+sub colored
+{
+	my $self = shift;
+	$self->{"_colored"} = $_[0] if(defined($_[0]));
+	return $self->{"_colored"};
+} # Fin colored
+
+
+# ###
+#  pending
+# Renvoie/maj $self->{'_pending'}
+# ###
+sub pending
+{
+	my $self = shift;
+	$self->{"_pending"} = $_[0] if(defined($_[0]));
+	return $self->{"_pending"};
+} # Fin pending
+
+
+# ###
+#  utf8
+# Renvoie/maj $self->{"_utf8"}
+# ###
+sub utf8
+{
+	my $self = shift;
+	$self->{"_utf8"} = $_[0] if(defined($_[0]));
+	return $self->{"_utf8"};
+} # Fin utf8
+
+
+# ###
+#  right_align
+# Renvoie/maj $self->{"_right_align"}
+# ###
+sub right_align
+{
+	my $self = shift;
+	$self->{"_right_align"} = $_[0] if(defined($_[0]));
+	return $self->{"_right_align"};
+} # Fin right_align
+
+
+# ###
+#  debug
+# Fonction gérant les logs du niveau debug (1)
+# ###
+sub debug
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[36mDEBUG\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "DEBUG:$parent:$text";
+	}
+	
+	return $self->print_in_file($text, $self->DEBUG);
+} # Fin debug
+
+
+# ###
+#  pending_debug
+# Fonction gérant les logs du niveau debug (1)
+# ###
+sub pending_debug
+{
+	my ($self, $text) = @_;
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[36mDEBUG\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "DEBUG:$parent:$text";
+	}
+	
+	return $self->pending_in_file($text, $self->DEBUG);
+} # Fin pending_debug
+
+
+# ###
+#  info
+# Fonction gérant les logs du niveau info (2)
+# ###
+sub info
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[33;1mINFO\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "INFO:$parent:$text";
+	}
+	
+	return $self->print_in_file($text, $self->INFO);
+} # Fin info
+
+
+# ###
+#  pending_info
+# Fonction gérant les logs du niveau info (2)
+# ###
+sub pending_info
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[33;1mINFO\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "INFO:$parent:$text";
+	}
+	
+	return $self->pending_in_file($text, $self->INFO);
+} # Fin pending_info
+
+
+# ###
+#  warning
+# Fonction gérant les logs du niveau warning (3)
+# ###
+sub warning
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[33mWARNING\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "WARNING:$parent:$text";
+	}
+	
+	return $self->print_in_file($text, $self->WARNING);
+} # Fin warning
+
+
+# ###
+#  pending_warning
+# Fonction gérant les logs du niveau warning (3)
+# ###
+sub pending_warning
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[33mWARNING\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "WARNING:$parent:$text";
+	}
+	
+	return $self->pending_in_file($text, $self->WARNING);
+} # Fin pending_warning
+
+
+# ###
+#  error
+# Fonction gérant les logs du niveau error (4)
+# ###
+sub error
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[31mERROR\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "ERROR:$parent:$text";
+	}
+	
+	return $self->print_in_file($text, $self->ERROR);
+} # Fin error
+
+
+# ###
+#  pending_error
+# Fonction gérant les logs du niveau error (4)
+# ###
+sub pending_error
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[31mERROR\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "ERROR:$parent:$text";
+	}
+	
+	return $self->pending_in_file($text, $self->ERROR);
+} # Fin pending_error
+
+
+# ###
+#  critical
+# Fonction gérant les logs du niveau critical (5)
+# ###
+sub critical
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[31;1mCRITICAL\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "CRITICAL:$parent:$text";
+	}
+	
+	return $self->print_in_file($text, $self->CRITICAL);
+} # Fin critical
+
+
+# ###
+#  pending_critical
+# Fonction gérant les logs du niveau critical (5)
+# ###
+sub pending_critical
+{
+	my ($self, $text) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	
+	my $parent = ( caller(1) )[3];
+	$parent = "" if(!defined($parent));
+	
+	if($self->colored)
+	{
+		$text = "\e[31;1mCRITICAL\e[0m:$parent:$text";
+	}
+	else
+	{
+		$text = "CRITICAL:$parent:$text";
+	}
+	
+	return $self->pending_in_file($text, $self->CRITICAL);
+} # Fin pending_critical
+
+
+# ###
+#  print_in_file
+# Écrit dans le fichier
+# ###
+sub print_in_file
+{
+	my ($self, $text, $level) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	$text = "[\e[32m" . (scalar localtime time) . "\e[0m] $text";
+	
+	$self->end_pending(0, $level) if($self->pending);
+	
+	if($self->file eq "STDOUT")
+	{
+		print STDOUT $text."\n";
+	}
+	elsif($self->file eq "STDERR")
+	{
+		print STDERR $text."\n";
+	}
+	else
+	{
+		open LOG, ">>", $self->file or return 0;
+		print LOG $text."\n";
+		close LOG;
+		
+		print $text."\n" if(defined($level) && $Config::debug >= $level);
+	}
+	
+	return 1;
+} # Fin print_in_file
+
+
+# ###
+#  pending_in_file
+# Écrit dans le fichier en attendant de savoir si ça a réussi ou pas
+# ###
+sub pending_in_file
+{
+	my ($self, $text, $level) = @_;
+	return unless(defined $text);
+	
+	chomp $text;
+	$text = "[" . (scalar localtime time) . "] $text";
+	
+	if($self->file eq "STDOUT")
+	{
+		if($self->right_align)
+		{
+			printf STDOUT "%-90s", $text;
+		}
+		else
+		{
+			print STDOUT $text;
+		}
+	}
+	elsif($self->file eq "STDERR")
+	{
+		if($self->right_align)
+		{
+			printf STDERR "%-90s", $text;
+		}
+		else
+		{
+			print STDERR $text;
+		}
+	}
+	else
+	{
+		if($self->right_align)
+		{
+			open LOG, ">>", $self->file or return 0;
+			printf LOG "%-90s", $text;
+			close LOG;
+			
+			printf "%-90s", $text if(defined($level) && $Config::debug >= $level);
+		}
+		else
+		{
+			open LOG, ">>", $self->file or return 0;
+			print LOG $text;
+			close LOG;
+			
+			print $text if(defined($level) && $Config::debug >= $level);
+		}
+	}
+	
+	$self->pending(1);
+	
+	return 1;
+} # Fin pending_in_file
+
+
+# ###
+#  end_pending
+# Écrit dans le fichier le résultat de l'attente
+# ###
+sub end_pending
+{
+	my ($self, $done_or_error, $level) = @_;
+	
+	my $done = "";
+	
+	if($done_or_error)
+	{
+		if($self->colored)
+		{
+			$done = sprintf "%c[32m Done ", 0x1B;
+		}
+		else
+		{
+			$done = sprintf " Done \n";
+		}
+		
+		$done .= "☑" if($self->utf8);
+	}
+	else
+	{
+		if($self->colored)
+		{
+			$done = sprintf "%c[31m Error ", 0x1B;
+		}
+		else
+		{
+			$done = sprintf " Error \n";
+		}
+		
+		$done .= "☒" if($self->utf8);
+	}
+	
+	$done .= "\e[0m\n" if($self->colored);
+	
+	
+	# À partir d'ici, $done peut vouloir dire que c'est bon, ou pas
+	if($self->file eq "STDOUT")
+	{
+		printf STDOUT $done;
+	}
+	elsif($self->file eq "STDERR")
+	{
+		printf STDERR $done;
+	}
+	else
+	{
+		open LOG, ">>", $self->file or return 0;
+		printf LOG $done;
+		close LOG;
+		
+		printf $done if(defined($level) && $Config::debug >= $level);
+	}
+	
+	
+	$self->pending(0);
+	
+	return 1;
+} # Fin end_pending
+
+
+#
+# Fonctions pour récupérer les différents niveaux de debug
+#
+sub DEBUG   { return 3; }
+sub INFO    { return 2; }
+sub WARNING { return 1; }
+sub ERROR   { return 0; }
+sub CRITICAL { return -1; }
+# Pour ceux qui préfèrent utiliser des variables...
+our $DEBUG    = 3;
+our $INFO     = 2;
+our $WARNING  = 1;
+our $ERROR    = 0;
+our $CRITICAL = -1;
+our %LVL_NAME = (
+	"DEBUG"    => 3,
+	"INFO"     => 2,
+	"WARNING"  => 1,
+	"ERROR"    => 0,
+	"CRITICAL" => -1
+);
+
+# Et dans l'autre sens
+sub LVL
+{
+	my ($self, $num) = @_;
+	
+	my %LVL = (
+		3    => "DEBUG",
+		2    => "INFO",
+		1    => "WARNING",
+		0    => "ERROR",
+		"-1" => "CRITICAL"
+	);
+	
+	return $LVL{$num};
+}
+our %LVL = (
+	3    => "DEBUG",
+	2    => "INFO",
+	1    => "WARNING",
+	0    => "ERROR",
+	"-1" => "CRITICAL"
+);
+
+
+# ###
+#  dbg
+# Imprime des infos de debug à l'écran (STDOUT)
+# ###
+sub dbg
+{
+	my $self = shift;
+	
+	require Data::Dumper;
+	print Data::Dumper->Dump([$self], [qw(Logging)]);
+} # Fin dbg
+
+
+1;
+
+__END__
+

PlayBot.pl

+#!/usr/bin/perl -w
+use strict;
+use warnings;
+use POE;
+use POE::Component::IRC;
+use POSIX 'strftime';
+use DBI;
+use Tie::File;
+
+use Logging;
+use youtube;
+use soundcloud;
+use mixcloud;
+use zippy;
+
+
+# nom du fichier
+my $bot = $0;
+
+my $log = Logging->new('STDOUT', 1);
+
+# config
+my $serveur = 'IRC.iiens.net';
+my $nick = 'PlayBot';
+my $port = 6667;
+my $ircname = 'nightiies';
+my $username = 'nightiies';
+my $channel = '#nightiies';
+my $admin = 'moise';
+my $baseurl = 'http://nightiies.iiens.net/links/';
+
+my $debug = 0;
+
+# mode debug
+if ($#ARGV + 1) {
+	$channel = "#hormone";
+	$nick = 'kikoo';
+	$debug = 1;
+}
+
+
+## CONNEXION 
+my ($irc) = POE::Component::IRC->spawn();
+my $dbh = DBI->connect('DBI:mysql:assoce_nightiies;host=mysql.iiens.net', 'assoce_nightiies', 'POiREAU.jKNCFfBRq', {
+	        PrintError => 0,
+	        AutoCommit => 1,
+		mysql_auto_reconnect => 1
+	  })
+	or die("Couldn't connect to database: ".DBI->errstr);
+
+
+# Evenements que le bot va gérer
+POE::Session->create(
+	inline_states => {
+		_start     => \&bot_start,
+		irc_001    => \&on_connect,
+		irc_public => \&on_speak,
+		irc_msg    => \&on_query,
+		_flux	   => \&flux
+	},
+);
+
+
+my %commandes_admin = ("cycle" => \&cycle);
+
+
+
+### FONCTIONS
+sub flux
+{
+	my $kernel = $_[ KERNEL ];
+	my $date = strftime ("%Y-%m-%d", localtime(time - 3600*24));
+	
+	my $sth = $dbh->prepare_cached('SELECT COUNT(*) FROM playbot WHERE date = ?');
+	$log->error("Couldn't prepare querie; aborting") unless (defined $sth);
+	$sth->execute($date)
+		or $log->error("Couldn't finish transaction: " . $dbh->errstr);
+	my ($nbr) = $sth->fetchrow_array;
+
+	if ($nbr) {
+		$irc->yield(privmsg => $channel => $nbr.' liens aujourd\'hui : '.$baseurl.$date);
+	}
+
+	$kernel->delay_set('_flux', 3600*24);
+}
+
+
+sub cycle
+{
+	my ($arg) = @_;
+
+	$log->info("restarting");
+	$irc->yield(quit => 'goodbye');
+	sleep 1;
+	exec $bot;
+}
+
+
+## GESTION EVENTS
+
+# Au démarrage
+sub bot_start {
+	$irc->yield(register => "all");
+	$irc->yield(
+		connect => {
+			Nick     => $nick,
+			Username => $username, 
+			Ircname  => $ircname,
+			Server   => $serveur,
+			Port     => $port,
+		}
+	);
+}
+
+
+# A la connection
+sub on_connect
+{
+	my $kernel = $_[ KERNEL ];
+	$irc->yield(join => $channel);
+	$log->info('connected');
+	
+	my $hour = strftime ('%H', localtime);
+	my $min = strftime ('%M', localtime);
+
+	$kernel->delay_set('_flux', (23-$hour)*3600 + (60-$min)*60);
+}
+
+
+# Discussion privée
+sub on_query
+{
+	my ($user,$msg) = @_[ARG0, ARG2];
+	$user = (split (/!/,$user))[0];
+
+	if ($msg =~ m/^!/ && $user eq $admin) {
+		my $commande = ( $msg =~ m/^!([^ ]*)/ )[0]; 
+		my @params = grep {!/^\s*$/} split(/\s+/, substr($msg, length("!$commande")));
+
+		foreach (keys(%commandes_admin)) {
+			if ($commande eq $_) {
+				$commandes_admin{$_}->(@params);
+				last;
+			}
+		}
+	}
+}
+
+
+# Quand un user parle
+sub on_speak
+{
+	my ($kernel, $user, $chan, $msg) = @_[KERNEL, ARG0, ARG1, ARG2];
+	my ($nick,$mask) = split(/!/,$user);
+	my $site;
+	my %content;
+
+	if ($msg =~ m#(^|[^!])https?://(www.youtube.com/watch\?[a-zA-Z0-9_=&-]*v=|youtu.be/)([a-zA-Z0-9_-]+)#) {
+		my $url = 'https://www.youtube.com/watch?v='.$3;
+		eval { %content = youtube($url) };
+		$site = 'youtube';
+	}
+	elsif ($msg =~ m#(^|[^!])https?://soundcloud.com/([a-zA-Z0-9-]+/[a-zA-Z0-9-]+)#) {
+		my $url = 'https://www.soundcloud.com/'.$2;
+		eval { %content = soundcloud($url) };
+		$site = 'soundcloud';
+	}
+	elsif ($msg =~ m#(^|[^!])https?://www.mixcloud.com/([a-zA-Z0-9-_]+/[a-zA-Z0-9-_]+)#) {
+		my $url = 'https://www.mixcloud.com/'.$2;
+		eval { %content = mixcloud($url) };
+		$site = 'mixcloud';
+	}
+	elsif ($msg =~ m#((^|[^!])http://www[0-9]+.zippyshare.com/v/[0-9]+/file.html)#) {
+		my $url = $1;
+		eval { %content = zippy($url) };
+		$site = 'zippyshare';
+	}	
+	else {
+		return;
+	}
+
+	if ($@) {
+		$log->warning ($@);
+		return;
+	}
+
+	if ($debug) {
+		$log->debug($content{'url'});
+	}
+	else {
+		my $sth = $dbh->prepare_cached('INSERT INTO playbot (date, type, url, sender_irc, sender, title, chan) VALUES (NOW(),?,?,?,?,?,?)');
+		$log->error("Couldn't prepare querie; aborting") unless (defined $sth);
+
+		$sth->execute($site, $content{'url'}, $nick, $content{'author'}, $content{'title'}, '#nightiies')
+			or $log->error("Couldn't finish transaction: " . $dbh->errstr);
+	}
+
+	if (defined $content{'author'}) {
+		$irc->yield(privmsg => $chan => $content{'title'}.' | '.$content{'author'}) ;
+	}
+	else {
+		$irc->yield(privmsg => $chan => $content{'title'});
+	}
+}
+
+
+# Boucle des events
+$poe_kernel->run();
+exit 0;

mixcloud.pm

+package mixcloud;
+
+use LWP::UserAgent;
+use HTML::Parser;
+use HTML::Entities;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(mixcloud);
+
+
+my $inTitle = 0;
+my $inAuthor = 0;
+my %infos;
+
+
+sub mixcloud {
+	my ($url) = @_;
+
+	my $ua = LWP::UserAgent->new(
+		agent   => "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13 GTB7.1",
+		timeout => 30
+	);
+
+	my $response = $ua->get($url);
+	die($response->status_line) unless ($response->is_success);
+
+	my $content = $response->decoded_content;
+
+	my $parser = HTML::Parser->new();
+	$parser->handler(text => \&parser_text, 'text');
+	$parser->handler(start => \&parser_start, 'tagname');
+	$parser->handler(end => \&parser_end, 'tagname');
+	$parser->unbroken_text(1);
+	$parser->report_tags('title', 'a');
+	$parser->parse($content);
+	$parser->eof();
+	
+	$infos{'url'} = $url;
+	
+	return %infos;
+}
+
+sub parser_text
+{
+	my ($text) = @_;
+	chomp $text;
+	$text = decode_entities($text);
+
+	if ($inTitle) {
+		$text =~ s/\n//;
+		$text =~ s/ \| Mixcloud .*//;
+		$text =~ s/^ *//;
+		$text =~ s/[^a-zA-Z0-9\(\)\[\]]*$//;
+		($infos{'author'}, $infos{'title'}) = split (' - ', $text, 2);
+	}
+}
+
+sub parser_start
+{
+	my ($tag) = @_;
+	$inTitle = 1 if ($tag eq 'title');
+}
+
+sub parser_end
+{
+	my ($tag) = @_;
+	$inTitle = 0 if ($tag eq 'title');
+}
+
+1;

soundcloud.pm

+package soundcloud;
+
+use LWP::UserAgent;
+use HTML::Parser;
+use HTML::Entities;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(soundcloud);
+
+
+my $inTitle = 0;
+my $inAuthor = 0;
+my %infos;
+
+
+sub soundcloud {
+	my ($url) = @_;
+
+	my $ua = LWP::UserAgent->new(
+		agent   => "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13 GTB7.1",
+		timeout => 30
+	);
+
+	my $response = $ua->get($url);
+	die($response->status_line) unless ($response->is_success);
+
+	my $content = $response->decoded_content;
+
+	my $parser = HTML::Parser->new();
+	$parser->handler(text => \&parser_text, 'text');
+	$parser->handler(start => \&parser_start, 'tagname');
+	$parser->handler(end => \&parser_end, 'tagname');
+	$parser->unbroken_text(1);
+	$parser->report_tags('title', 'a');
+	$parser->parse($content);
+	$parser->eof();
+	
+	$infos{'url'} = $url;
+	
+	return %infos;
+}
+
+sub parser_text
+{
+	my ($text) = @_;
+	chomp $text;
+	$text = decode_entities($text);
+
+	if ($inTitle) {
+		$text =~ s/\n//;
+		$text =~ s/ on SoundCloud.*//;
+		$text =~ s/^ *//;
+		$text =~ s/[^a-zA-Z0-9\(\)\[\]]*$//;
+		($infos{'title'}, $infos{'author'}) = split (' by ', $text);
+	}
+}
+
+sub parser_start
+{
+	my ($tag) = @_;
+	$inTitle = 1 if ($tag eq 'title');
+}
+
+sub parser_end
+{
+	my ($tag) = @_;
+	$inTitle = 0 if ($tag eq 'title');
+}
+
+1;

youtube.pm

+package youtube;
+
+use LWP::UserAgent;
+use HTML::Parser;
+use HTML::Entities;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(youtube);
+
+
+my $inTitle = 0;
+my $inAuthor = 0;
+my %infos;
+
+
+sub youtube {
+	my ($url) = @_;
+
+	my $ua = LWP::UserAgent->new(
+		agent   => "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13 GTB7.1",
+		timeout => 30
+	);
+
+	my $response = $ua->get($url);
+	die($response->status_line) unless ($response->is_success);
+
+	my $content = $response->decoded_content;
+
+	my $parser = HTML::Parser->new();
+	$parser->handler(text => \&parser_text, 'text');
+	$parser->handler(start => \&parser_start, 'tagname,attr');
+	$parser->handler(end => \&parser_end, 'tagname');
+	$parser->unbroken_text(1);
+	$parser->report_tags('title', 'a');
+	$parser->parse($content);
+	$parser->eof();
+	
+	$infos{'url'} = $url;
+	
+	return %infos;
+}
+
+sub parser_text
+{
+	my ($text) = @_;
+	chomp $text;
+
+	if ($inTitle) {
+		$text =~ s/\n//;
+		$text =~ s/- YouTube//;
+		$text =~ s/^ *//;
+		$text =~ s/[^a-zA-Z0-9\(\)\[\]]*$//;
+		$infos{'title'} = decode_entities($text);
+	}
+	elsif ($inAuthor) {
+		$infos{'author'} = $text;
+	}
+}
+
+sub parser_start
+{
+	my ($tag, $attr) = @_;
+	$inTitle = 1 if ($tag eq 'title');
+	return unless (defined $attr);
+	$inAuthor = 1 if ($tag eq 'a' && exists($attr->{'class'}) && $attr->{'class'} =~ /yt-user-name author/);
+}
+
+sub parser_end
+{
+	my ($tag) = @_;
+	$inTitle = 0 if ($tag eq 'title');
+	$inAuthor = 0 if ($tag eq 'a');
+}
+
+1;

zippy.pm

+package zippy;
+
+use LWP::UserAgent;
+use HTML::Parser;
+use HTML::Entities;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(zippy);
+
+
+my $inTitle = 0;
+my $inAuthor = 0;
+my %infos;
+
+
+sub zippy {
+	my ($url) = @_;
+
+	my $ua = LWP::UserAgent->new(
+		agent   => "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-US; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13 GTB7.1",
+		timeout => 30
+	);
+
+	my $response = $ua->get($url);
+	die($response->status_line) unless ($response->is_success);
+
+	my $content = $response->decoded_content;
+
+	my $parser = HTML::Parser->new();
+	$parser->handler(text => \&parser_text, 'text');
+	$parser->handler(start => \&parser_start, 'tagname');
+	$parser->handler(end => \&parser_end, 'tagname');
+	$parser->unbroken_text(1);
+	$parser->report_tags('title', 'a');
+	$parser->parse($content);
+	$parser->eof();
+	
+	$infos{'url'} = $url;
+	$infos{'author'} = undef;
+	
+	return %infos;
+}
+
+sub parser_text
+{
+	my ($text) = @_;
+	chomp $text;
+	$text = decode_entities($text);
+
+	if ($inTitle) {
+		$text =~ s/^Zippyshare.com - //;
+		$text =~ s/\.mp3$//;
+		$infos{'title'} = $text;
+	}
+}
+
+sub parser_start
+{
+	my ($tag) = @_;
+	$inTitle = 1 if ($tag eq 'title');
+}
+
+sub parser_end
+{
+	my ($tag) = @_;
+	$inTitle = 0 if ($tag eq 'title');
+}
+
+1;