The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Net::Google::SafeBrowsing2::DBI;

use strict;
use warnings;

use base 'Net::Google::SafeBrowsing2::Storage';

use Carp;
use DBI;
use List::Util qw(first);


our $VERSION = '1.0';


=head1 NAME

Net::Google::SafeBrowsing2::DBI - Base class for all DBI-based back-end storage for the Google Safe Browsing v2 database

=head1 SYNOPSIS

Net::Google::SafeBrowsing2::DBI cannot be used directly. Instead, use a class inheriting Net::Google::SafeBrowsing2::DBI, like L<Net::Google::SafeBrowsing2::MySQL>.


  use Net::Google::SafeBrowsing2::MySQL;

  my $storage = Net::Google::SafeBrowsing2::MySQL->new(host => '127.0.0.1', database => 'GoogleSafeBrowsingv2');
  ...
  $storage->close();

=head1 DESCRIPTION

This is a base implementation of L<Net::Google::SafeBrowsing2::Storage> using DBI.

=cut


=head1 CONSTRUCTOR

=over 4

=back

=head2 new()

This method should be overwritten.

Arguments

=over 4

=item keep_all

Optional. Set to 1 to keep old information (such as expiring full hashes) in the database. 0 (delete) by default.


=back

=cut

sub new {
	my ($class, %args) = @_;

	my $self = { # default arguments
		keep_all	=> 0,
		%args,
	};

	bless $self, $class or croak "Can't bless $class: $!";


	$self->init();

    return $self;
}

=head1 PUBLIC FUNCTIONS

=over 4

See L<Net::Google::SafeBrowsing2::Storage> for a complete list of public functions.

=back

=head2 close()

Cleanup old full hashes, and close the connection to the database.

  $storage->close();


=cut

sub close {
	my ($self, %args) = @_;


	if ($self->{keep_all} == 0) {
		$self->{dbh}->do('DELETE FROM full_hashes WHERE timestamp < ?', { }, time() - Net::Google::SafeBrowsing2::FULL_HASH_TIME);
	}

	$self->{dbh}->disconnect;
}


=head2 export()

Export add chunks and sub chunks to a file. The file content looks like what Google sends in redirections. The file can be used with the C<import_chunks> function from C<Net::Google::SafeBrowsing2>. This is useful when moving from one back-end storage to another

  $storage->export(list => MALWARE);

Arguments

=over 4

=item list

Required. The Google Safe Browsing list to export.

=item file

Optional. Filename to export to. Uses "$list.dat" by default.

=back

=cut

sub export {
	my ($self, %args) 	= @_;
	my $list			= $args{list}	|| '';
	my $file			= $args{file}	|| "$list.dat";


	open EXPORT, "> $file" or croak "Cannot open $file: $!\n";
	binmode EXPORT;

	# Add chunks
	my $num = 0;
	my $chunk_data = '';
	my $hostkey = '';
	my $prefixes = '';
	my $count = 0;

	my $sth = $self->{dbh}->prepare("SELECT * FROM a_chunks WHERE list = ? ORDER BY num ASC");
	$sth->execute($list);

	while (my $row = $sth->fetchrow_hashref()) {
		if (($num != $row->{num} && $num != 0) || $num > 1000) { # if num is too bif, we can not print chr($num) a a single byte
			$chunk_data .= $hostkey;
			$chunk_data .= chr($count);
			$chunk_data .= $prefixes;
			
			print EXPORT "a:", $num, ":", length($hostkey), ":", length($chunk_data), "\n";
			print EXPORT $chunk_data;

			$num = $row->{num};
			$chunk_data = '';
			$hostkey = '';
			$prefixes = '';
			$count = 0;
		}
		elsif ($num == 0) {
			$num = $row->{num};
			$hostkey = $row->{hostkey};
		}
		if ($hostkey ne $row->{hostkey} && $hostkey ne '') {
			$chunk_data .= $hostkey;
			$chunk_data .= chr($count);
			$chunk_data .= $prefixes;
		
			$count = 0;
			$prefixes = '';
		}
		$hostkey = $row->{hostkey};
		if (length($row->{prefix}) > 0) {
			$prefixes .= $row->{prefix};
			$count++;
		}
	}
	$sth->finish();

	$chunk_data .= $hostkey;
	$chunk_data .= chr($count);
	$chunk_data .= $prefixes;
	print EXPORT "a:", $num, ":", length($hostkey), ":", length($chunk_data) , "\n";
	print EXPORT $chunk_data;


	# sub chunks
	$num = 0;
	$chunk_data = '';
	$hostkey = '';
	$prefixes = '';
	$count = 0;

	$sth = $self->{dbh}->prepare("SELECT * FROM s_chunks WHERE list = ? ORDER BY num ASC");
	$sth->execute($list);


	while (my $row = $sth->fetchrow_hashref()) {
		if (($num != $row->{num} && $num != 0) || $num > 1000) { # if num is too bif, we can not print chr($num) a a single byte
			$chunk_data .= $hostkey;
			$chunk_data .= chr($count) if (length($hostkey) > 0);
			$chunk_data .= $prefixes;
			
			print EXPORT "s:", $num, ":", length($hostkey), ":", length($chunk_data), "\n";
			print EXPORT $chunk_data;

			$num = $row->{num};
			$chunk_data = '';
			$hostkey = '';
			$prefixes = '';
			$count = 0;
		}
		elsif ($num == 0) {
			$num = $row->{num};
			$hostkey = $row->{hostkey};
		}
		if ($hostkey ne $row->{hostkey} && $hostkey ne '') {
			$chunk_data .= $hostkey;
			$chunk_data .= chr($count) if (length($hostkey) > 0);
			$chunk_data .= $prefixes;
		
			$count = 0;
			$prefixes = '';
		}
		$hostkey = $row->{hostkey};
		if ($row->{add_num} > 0) {
			$prefixes .= $self->ascii_to_hex( sprintf("%08x", $row->{add_num}) );
		}

		if (length($row->{prefix}) > 0 && $row->{add_num} > 0) {
			$prefixes .= $row->{prefix};
			$count++;
		}
	}
	$sth->finish();

	$chunk_data .= $hostkey;
	$chunk_data .= chr($count) if (length($hostkey) > 0);
	$chunk_data .= $prefixes;
	print EXPORT "s:", $num, ":", length($hostkey), ":", length($chunk_data) , "\n";
	print EXPORT $chunk_data;

	CORE::close(EXPORT);
}

sub init {
	my ($self, %args) = @_;

	# Should connect to database
	# Shoudl check if all tables exist
}


sub create_table_updates {
	my ($self, %args) = @_;

	my $schema = qq{	
		CREATE TABLE updates (
			last INT NOT NULL DEFAULT '0',
			wait INT NOT NULL DEFAULT '0',
			errors INT NOT NULL DEFAULT '1800',
			list VARCHAR( 50 ) NOT NULL
		);
	}; # Need to handle errors

	$self->{dbh}->do($schema);
}

sub create_table_a_chunks {
	my ($self, %args) = @_;

	my $schema = qq{
		CREATE TABLE a_chunks (
			hostkey VARCHAR( 8 ),
			prefix VARCHAR( 8 ),
			num INT NOT NULL,
			list VARCHAR( 50 ) NOT NULL
		);
	};

	$self->{dbh}->do($schema);

	my $index = qq{
		CREATE INDEX a_chunks_hostkey ON a_chunks (
			hostkey
		);
	};
	$self->{dbh}->do($index);

	$index = qq{
		CREATE INDEX a_chunks_num_list ON a_chunks (
			num,
			list
		);
	};
	$self->{dbh}->do($index);

	$index = qq{
		CREATE UNIQUE INDEX a_chunks_unique ON a_chunks (
			hostkey,
			prefix,
			num,
			list
		);
	};
	$self->{dbh}->do($index);
}

sub create_table_s_chunks {
	my ($self, %args) = @_;

	my $schema = qq{
		CREATE TABLE s_chunks (
			hostkey VARCHAR( 8 ),
			prefix VARCHAR( 8 ),
			num INT NOT NULL,
			add_num INT  Default '0',
			list VARCHAR( 50 ) NOT NULL
		);
	};

	$self->{dbh}->do($schema);

	my $index = qq{
		CREATE INDEX s_chunks_hostkey ON s_chunks (
			hostkey
		);
	};
	$self->{dbh}->do($index);

	$index = qq{
		CREATE INDEX s_chunks_num ON s_chunks (
			num
		);
	};
	$self->{dbh}->do($index);

	$index = qq{
		CREATE INDEX s_chunks_num_list ON s_chunks (
			num,
			list
		);
	};
	$self->{dbh}->do($index);

	$index = qq{
		CREATE UNIQUE INDEX s_chunks_unique ON s_chunks (
			hostkey,
			prefix,
			num,
			add_num,
			list
		);
	};
	$self->{dbh}->do($index);
}

sub create_table_full_hashes {
	my ($self, %args) = @_;

	my $schema = qq{
		CREATE TABLE full_hashes (
			id INT AUTO_INCREMENT PRIMARY KEY,
			num INT,
			hash VARCHAR( 32 ),
			list VARCHAR( 50 ),
			timestamp INT Default '0'
		);
	};

	$self->{dbh}->do($schema);

	my $index = qq{
		CREATE UNIQUE INDEX hash ON full_hashes (
			num,
			hash,
			list
		);
	};
	$self->{dbh}->do($index);
}

sub create_table_full_hashes_errors {
	my ($self, %args) = @_;

	my $schema = qq{
		CREATE TABLE full_hashes_errors (
			id INT AUTO_INCREMENT PRIMARY KEY,
			errors INT Default '0',
			prefix VARCHAR( 8 ),
			timestamp INT Default '0'
		);
	};

	$self->{dbh}->do($schema);
}

sub create_table_mac_keys{
	my ($self, %args) = @_;

	my $schema = qq{
		CREATE TABLE mac_keys (
			client_key VARCHAR( 50 ) Default '',
			wrapped_key VARCHAR( 50 ) Default ''
		);
	};

	$self->{dbh}->do($schema);
}


sub add_chunks {
	my ($self, %args) 	= @_;
	my $type			= $args{type}		|| 'a';
	my $chunknum		= $args{chunknum}	|| 0;
	my $chunks			= $args{chunks}		|| [];
	my $list			= $args{'list'}		|| '';

# 	$self->{dbh}->do("PRAGMA journal_mode = OFF");
# 	$self->{dbh}->do("PRAGMA synchronous = OFF"); 

	if ($type eq 's') {
		$self->add_chunks_s(chunknum => $chunknum, chunks => $chunks, list => $list);
	}
	elsif ($type eq 'a') {
		$self->add_chunks_a(chunknum => $chunknum, chunks => $chunks, list => $list);
	}

# 	$self->{dbh}->do("PRAGMA journal_mode = DELETE");
# 	$self->{dbh}->do("PRAGMA synchronous = FULL"); 
}

sub add_chunks_s {
	my ($self, %args) 	= @_;
	my $chunknum		= $args{chunknum}	|| 0;
	my $chunks			= $args{chunks}		|| [];
	my $list			= $args{'list'}		|| '';

	my $add = $self->{dbh}->prepare('INSERT INTO s_chunks (hostkey, prefix, num, add_num, list) VALUES (?, ?, ?, ?, ?)');
	my $del = $self->{dbh}->prepare('DELETE FROM s_chunks WHERE hostkey = ? AND prefix = ? AND num = ? AND add_num = ? AND list = ?');

	foreach my $chunk (@$chunks) {
		$del->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $chunk->{add_chunknum}, $list );
		$add->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $chunk->{add_chunknum}, $list );
	}

	if (scalar @$chunks == 0) { # keep empty chunks
		$del->execute( '', '', $chunknum, '', $list );
		$add->execute( '', '', $chunknum, '', $list );
	}
}

sub add_chunks_a {
	my ($self, %args) 	= @_;
	my $chunknum		= $args{chunknum}	|| 0;
	my $chunks			= $args{chunks}		|| [];
	my $list			= $args{'list'}		|| '';

	my $add = $self->{dbh}->prepare('INSERT INTO a_chunks (hostkey, prefix, num, list) VALUES (?, ?, ?, ?)');
	my $del = $self->{dbh}->prepare('DELETE FROM a_chunks WHERE hostkey = ? AND  prefix  = ? AND num = ? AND  list  = ?');

	foreach my $chunk (@$chunks) {
		$del->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $list );
		$add->execute( $chunk->{host}, $chunk->{prefix}, $chunknum, $list );
	}

	if (scalar @$chunks == 0) { # keep empty chunks
		$del->execute( '', '', $chunknum, $list );
		$add->execute( '', '', $chunknum, $list );
	}
}


sub get_add_chunks {
	my ($self, %args) = @_;
	my $hostkey			= $args{hostkey}	|| '';
# 	my $list			= $args{'list'}		|| '';

	my @list = ();
# 	my $rows = $self->{dbh}->selectall_arrayref("SELECT * FROM a_chunks WHERE hostkey = ? AND list = ?", { Slice => {} }, $hostkey, $list);
	my $rows = $self->{dbh}->selectall_arrayref("SELECT * FROM a_chunks WHERE hostkey = ?", { Slice => {} }, $hostkey);

	foreach my $row (@$rows) {
		push(@list, { chunknum => $row->{num}, prefix => $row->{prefix}, list => $row->{list}, hostkey => $hostkey });
	}

	return @list;
}

sub get_sub_chunks {
	my ($self, %args) = @_;
	my $hostkey			= $args{hostkey}	|| '';
# 	my $list			= $args{'list'}		|| '';

	my @list = ();
# 	my $rows = $self->{dbh}->selectall_arrayref("SELECT * FROM s_chunks WHERE hostkey = ? AND list = ?", { Slice => {} }, $hostkey, $list);
	my $rows = $self->{dbh}->selectall_arrayref("SELECT * FROM s_chunks WHERE hostkey = ?", { Slice => {} }, $hostkey);

	foreach my $row (@$rows) {
		push(@list, { chunknum => $row->{num}, prefix => $row->{prefix}, addchunknum => $row->{add_num}, list => $row->{list}  });
	}

	return @list;
}

sub get_add_chunks_nums {
	my ($self, %args) 	= @_;
	my $list			= $args{'list'}		|| '';
	
	my @list = ();
	my $rows = $self->{dbh}->selectall_arrayref("SELECT DISTINCT(num) FROM a_chunks WHERE list = ? ORDER BY num ASC", { Slice => {} }, $list);
	foreach my $row (@$rows) {
		push(@list, $row->{num});
	}

	return @list;
}

sub get_sub_chunks_nums {
	my ($self, %args) 	= @_;
	my $list			= $args{'list'}		|| '';
	
	my @list = ();
	my $rows = $self->{dbh}->selectall_arrayref("SELECT DISTINCT(num) FROM s_chunks WHERE list = ? ORDER BY num ASC", { Slice => {} }, $list);
	foreach my $row (@$rows) {
		push(@list, $row->{num});
	}

	return @list;
}


sub delete_add_ckunks {
	my ($self, %args) 	= @_;
	my $chunknums		= $args{chunknums}	|| [];
	my $list			= $args{'list'}		|| '';

	my $sth = $self->{dbh}->prepare("DELETE FROM a_chunks WHERE num = ? AND list = ?");

	foreach my $num (@$chunknums) {
		$sth->execute($num, $list);
	}
}


sub delete_sub_ckunks {
	my ($self, %args) = @_;
	my $chunknums		= $args{chunknums}	|| [];
	my $list			= $args{'list'}		|| '';

	my $sth = $self->{dbh}->prepare("DELETE FROM s_chunks WHERE num = ? AND list = ?");

	foreach my $num (@$chunknums) {
		$sth->execute($num, $list);
	}


}

sub get_full_hashes {
	my ($self, %args) = @_;
	my $chunknum		= $args{chunknum}	|| 0;
	my $timestamp		= $args{timestamp}	|| 0;
	my $list			= $args{list}		|| '';

	my @hashes = ();

	my $rows = $self->{dbh}->selectall_arrayref("SELECT hash FROM full_hashes WHERE timestamp >= ? AND num = ? AND list = ?", { Slice => {} }, $timestamp, $chunknum, $list);
	foreach my $row (@$rows) {
		push(@hashes, $row->{hash});
	}

	return @hashes;
}


sub updated {
	my ($self, %args) 	= @_;
	my $time			= $args{'time'}	|| time;
	my $wait			= $args{'wait'}	|| 1800;
	my $list			= $args{'list'}	|| '';

	if ($self->last_update(list => $list)->{'time'} == 0) {
		$self->{dbh}->do("INSERT INTO updates (last, wait, errors, list) VALUES (?, ?, 0, ?)", undef, $time, $wait, $list);
	}
	else {
		$self->{dbh}->do("UPDATE updates SET last = ?, wait = ?, errors = 0 WHERE list = ?", undef, $time, $wait, $list);
	}
}

sub update_error {
	my ($self, %args) 	= @_;
	my $time			= $args{'time'}	|| time;
	my $list			= $args{'list'}	|| '';
	my $wait			= $args{'wait'}	|| 60;
	my $errors			= $args{errors}	|| 1;

	if ($self->last_update(list => $list)->{'time'} == 0) {
		$self->{dbh}->do("INSERT INTO updates (last, wait, errors, list) VALUES (?, ?, ?, ?)", undef, $time, $wait, $errors, $list);
	}
	else {
		$self->{dbh}->do("UPDATE updates SET last = ?, wait = ?, errors = ?, list = ? WHERE 1", undef, $time, $wait, $errors, $list);
	}
}

sub last_update {
	my ($self, %args) 	= @_;
	my $list			= $args{'list'}	|| '';

	my $rows = $self->{dbh}->selectall_arrayref("SELECT last, wait, errors FROM updates WHERE list = ? LIMIT 1", { Slice => {} }, $list);

	foreach my $row (@$rows) {
		return {'time' => $row->{'last'} || 0, 'wait' => $row->{'wait'} || 1800, errors	=> $row->{'errors'} || 0};
	}

	return {'time' => 0, 'wait' => 1800};
}

sub add_full_hashes {
	my ($self, %args) 	= @_;
	my $timestamp		= $args{timestamp}		|| time();
	my $full_hashes		= $args{full_hashes}	|| [];

	foreach my $hash (@$full_hashes) {
# 		$self->{dbh}->do("INSERT OR REPLACE INTO full_hashes (num, hash, list, timestamp) VALUES (?, ?, ?, ?)", { }, $hash->{chunknum}, $hash->{hash}, $hash->{list}, $timestamp);
		$self->{dbh}->do("DELETE FROM full_hashes WHERE num = ? AND hash = ? AND list = ?", { }, $hash->{chunknum}, $hash->{hash}, $hash->{list});
		$self->{dbh}->do("INSERT INTO full_hashes (num, hash, list, timestamp) VALUES (?, ?, ?, ?)", { }, $hash->{chunknum}, $hash->{hash}, $hash->{list}, $timestamp);
	}
}

sub delete_full_hashes {
	my ($self, %args) 	= @_;
	my $chunknums		= $args{chunknums}	|| [];
	my $list			= $args{list}		|| croak "Missing list name\n";

	my $sth = $self->{dbh}->prepare("DELETE FROM full_hashes WHERE num = ? AND list = ?");

	foreach my $num (@$chunknums) {
		$sth->execute($num, $list);
	}
}

sub full_hash_error {
	my ($self, %args) 	= @_;
	my $timestamp		= $args{timestamp}	|| time();
	my $prefix			= $args{prefix}		|| '';

	my $rows = $self->{dbh}->selectall_arrayref("SELECT id, errors FROM full_hashes_errors WHERE prefix = ? LIMIT 1", { Slice => {} }, $prefix);

	if (scalar @$rows == 0) {
		$self->{dbh}->do("INSERT INTO full_hashes_errors (prefix, errors, timestamp) VALUES (?, 1, ?)", { }, $prefix, $timestamp);
	}
	else {
		my $errors = $rows->[0]->{errors} + 1;
		$self->{dbh}->do("UPDATE full_hashes_errors SET errors = ?, timestamp = ? WHERE id = ?", $errors, $timestamp, $rows->[0]->{id});
	}
}

sub full_hash_ok {
	my ($self, %args) 	= @_;
	my $timestamp		= $args{timestamp}	|| time();
	my $prefix			= $args{prefix}		|| '';

	my $rows = $self->{dbh}->selectall_arrayref("SELECT id, errors FROM full_hashes_errors WHERE prefix = ? AND errors > 0 LIMIT 1", { Slice => {} }, $prefix);

	if (scalar @$rows > 0) {
		$self->{dbh}->do("UPDATE full_hashes_errors SET errors = 0, timestamp = ? WHERE id = ?", $timestamp, $rows->[0]->{id});
		$self->{dbh}->do("DELETE FROM full_hashes_errors WHERE id = ?", $rows->[0]->{id});
	}
}

sub get_full_hash_error {
	my ($self, %args) 	= @_;
	my $prefix			= $args{prefix}		|| '';

	my $rows = $self->{dbh}->selectall_arrayref("SELECT timestamp, errors FROM full_hashes_errors WHERE prefix = ? LIMIT 1", { Slice => {} }, $prefix);
	
	if (scalar @$rows == 0) {
		return undef;
	}
	else {
		return $rows->[0];
	}
}

sub get_mac_keys {
	my ($self, %args) 	= @_;


	my $rows = $self->{dbh}->selectall_arrayref("SELECT client_key, wrapped_key FROM mac_keys LIMIT 1", { Slice => {} });

	if (scalar @$rows == 0) {
		return { client_key => '', wrapped_key => '' };
	}
	else {
		return $rows->[0];
	}
}

sub add_mac_keys {
	my ($self, %args) 	= @_;
	my $client_key		= $args{client_key}		|| '';
	my $wrapped_key		= $args{wrapped_key}	|| '';


	$self->delete_mac_keys();

	$self->{dbh}->do("INSERT INTO mac_keys (client_key, wrapped_key) VALUES (?, ?)", { }, $client_key, $wrapped_key);

}

sub delete_mac_keys {
	my ($self, %args) 	= @_;

	$self->{dbh}->do("DELETE FROM mac_keys WHERE 1");
}

sub reset {
	my ($self, %args) 	= @_;
	my $list			= $args{'list'}		|| '';

	my $sth = $self->{dbh}->prepare('DELETE FROM s_chunks WHERE list = ?');
	$sth->execute( $list );

	$sth = $self->{dbh}->prepare('DELETE FROM a_chunks WHERE list = ?');
	$sth->execute( $list );

	$sth = $self->{dbh}->prepare('DELETE FROM full_hashes WHERE list = ?');
	$sth->execute( $list );

	$sth = $self->{dbh}->prepare('DELETE FROM full_hashes_errors');
	$sth->execute();

	$sth = $self->{dbh}->prepare('DELETE FROM updates WHERE list = ?');
	$sth->execute( $list );
}

sub create_range {
	my ($self, %args) 	= @_;
	my $numbers			= $args{numbers}	|| []; # should already be ordered

	return '' if (scalar @$numbers == 0);

	my $range = $$numbers[0];
	my $new_range = 0;
	for(my $i = 1; $i < scalar @$numbers; $i++) {
# 		next if ($$numbers[$i] == $$numbers[$i-1]); # should not happen

		if ($$numbers[$i] != $$numbers[$i-1] + 1) {
			$range .= $$numbers[$i-1] if ($i > 1 && $new_range == 1);
			$range .= ',' . $$numbers[$i];

			$new_range = 0
		}
		elsif ($new_range == 0) {
			$range .= "-";
			$new_range = 1;
		}
	}
	$range .= $$numbers[scalar @$numbers - 1] if ($new_range == 1);

	return $range;
}

=head1 CHANGELOG

=over 4

=item 0.7.1

Fix for empty sub chunks.

=item 0.7

New C<export()> function.

Keep empty sub chunks.

Fix index for sub chunks.

=item 0.6

Add option keep_all to keep expired full hashes. Useful for debugging.

=item 0.5

Return the hostkey in get_add_chunks.

=item 0.4

Fix duplicate insert of add chunks and sub chunks.

=item 0.3

Add reset function to reset all tables for a given list

=item 0.2

Replace "INSERT OR REPLACE" statements by DELETE + INSERT to work with all databases

=back

=head1 SEE ALSO

See L<Net::Google::SafeBrowsing2> for handling Google Safe Browsing v2.

See L<Net::Google::SafeBrowsing2::Storage> for the list of public functions.

See L<Net::Google::SafeBrowsing2::Sqlite> for a back-end using Sqlite.

Google Safe Browsing v2 API: L<http://code.google.com/apis/safebrowsing/developers_guide_v2.html>


=head1 AUTHOR

Julien Sobrier, E<lt>jsobrier@zscaler.comE<gt> or E<lt>julien@sobrier.netE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2011 by Julien Sobrier

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut

1;