{ package Bittorrent::TrackerLib::Backend;
    $VERSION = 0.04;
    
    
    use strict;
    use warnings;
    
    
    
    # new
    # Constructor function
    # Usage:
    #	my $backend = new Bittorrent::TrackerLib::Backend $tracker;
    sub new
    {
	my $class	= shift;
	my $tracker	= shift;
	my $self	= {};
	
	bless $self, $class;
	
	
	$self->{tracker} = $tracker;
	
	
	$self->create_filelist;
	
	
	return $self;
    }
    
    
    
    # all_peerlists
    # Returns a list of active peerlists.
    # Usage:
    #	my @peerlists = $backend->all_peerlists;
    sub all_peerlists
    {
	my $self	= shift;
	
	return keys %{$self->{peerlists}};
    }
    
    
    
    # create_filelist
    # Create the filelist table
    # Usage:
    #	$backend->create_filelist;
    sub create_filelist
    {
	my $self	= shift;
	
	$self->{filelist} = {};
	
	return 1;
    }
    
    
    
    # create_peerlist
    # Creates a peerlist table
    # Usage:
    # 	$backend->create_peerlist("info_hash");	# REQUIRED: File info hash
    sub create_peerlist
    {
	my $self	= shift;
	my $info_hash	= shift;
	
	$self->{peerlists}->{$info_hash} = {};
	
	return 1;
    }
    
    
    
    # delete_file
    # Delete an entry in the filelist
    # Usage:
    #	$backend->delete_file("info_hash");	# REQUIRED: File info hash
    sub delete_file
    {
	my $self	= shift;
	my $info_hash	= shift;
	
	delete $self->{filelists}->{$info_hash};
	
	return 1;
    }
    
    
    
    # delete_peer
    # Delete an entry in a peerlist
    # Usage:
    #	$backend->delete_peer(
    #		"info_hash",			# REQUIRED: File info hash
    #		"peer_id" );			# REQUIRED: Peer ID
    sub delete_peer
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $peer_id	= shift;
	
	delete $self->{peerlists}->{$info_hash}->{$peer_id};
	
	return 1;
    }
    
    
    
    # drop_filelist
    # Deletes the filelist
    # Usage:
    #	$backend->drop_filelist
    sub drop_filelist
    {
	my $self	= shift;
	
	delete $self->{filelist};
	
	return 1;
    }
    
    
    
    # drop_peerlist
    # Deletes a peerlist
    # Usage:
    #	$backend->drop_peerlist("info_hash")	# REQUIRED: File info hash
    sub drop_peerlist
    {
	my $self	= shift;
	my $info_hash	= shift;
	
	delete $self->{peerlists}->{$info_hash};
	
	return 1;
    }
    
    
    
    # find_file
    # Find a list of files in the filelist
    # Usage:
    #	my @files = $backend->find_file(
    #		{ where 	=> "column ge 'value' && column == 22",
    #		  order_by 	=> "columns [ASC|DESC]",
    #		  limit		=> "5,2" } ); 	# OPTIONAL: search info
    sub find_file
    {
	my $self		= shift;
	my $find		= shift;
	
	
	my $where		= $find->{where} || "1 == 1";
	my $order		= $find->{order_by};
	my ($limit,$start)	= split(',',$find->{limit}) if $find->{limit};
	
	
	
	my @files		= ();
	my $matches		= 0;	# begin grabbing results when $matches 
					# is greater than $start but less than 
					# $start + $limit
	
	
	# get matches
	foreach my $file (keys %{$self->{filelist}})
	{
	    my %file_data = $self->get_file($file);
	    
	    
	    # see if it's a match
	    # prepare match expression by replacing "column name" with the value
	    # to test against
	    my $test = $where;
	    $test =~ s/$_/$file_data{$_}/eg for keys %file_data;
	    
	    # test
	    my $is_match = eval $test;
	    $self->error($@), return 0 if $@;	# Error in evaluating
	    
	    if ($is_match)
	    {
		$matches++;
		
		push @files,$file_data{info_hash};
	    }
	    
	}
	
	
	# order matches
	if ($order)
	{
	    my @columns = split(',',$order);
	    
	    @columns = reverse @columns; # most important sorting is done last
	    
	    # regular expression for finding C-style floats
	    my $is_num = qr/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
	    
	    foreach my $column_def (@columns)
	    {
		my $column	= $column_def =~ /^\S+/;
		my $reverse	= 1 if $column_def =~ /DESC$/i;
		
		
		if ($reverse)
		{
		    @files =
		    sort { ( $self->get_file($b)->{$column} =~ $is_num && 
			     $self->get_file($a)->{$column} =~ $is_num ) ?
			     $self->get_file($b)->{$column} <=> $self->get_file($a)->{$column} : 
			     $self->get_file($b)->{$column} cmp $self->get_file($a)->{$column} } @files;
		}
		else
		{
		    @files =
		    sort { ( $self->get_file($a)->{$column} =~ $is_num && 
			     $self->get_file($b)->{$column} =~ $is_num ) ?
			     $self->get_file($a)->{$column} <=> $self->get_file($b)->{$column} : 
			     $self->get_file($a)->{$column} cmp $self->get_file($b)->{$column} } @files;
		}
		
	    }
	    
	}
	
	
	return @files[$start..$start+$limit] 	if $start && $limit;
	return @files[0..$limit] 		if $limit;
	return @files;
    }

    
    
    
    
    # find_peer
    # Find a list of peers from a peerlist
    # Usage:
    #	my @peers = $backend->find_peer(
    #		"info_hash",			# REQUIRED: File info hash
    #		{ where 	=> "column ge 'value' && column == 22",
    #		  order_by 	=> "columns [ASC|DESC]",
    #		  limit		=> 2 } ); 	# OPTIONAL: search info
    sub find_peer
    {
	my $self		= shift;
	my $i_h			= shift;	# $i_h = File info hash
	my $find		= shift;
	
	
	my $where		= $find->{where} || "1 == 1";
	my $order		= $find->{order_by};
	my ($limit,$start)	= split(',',$find->{limit}) if $find->{limit};
	
	
	
	my @peers		= ();
	my $matches		= 0;	# begin grabbing results when $matches 
					# is greater than $start but less than 
					# $start + $limit
	
	
	# get matches
	foreach my $peer (keys %{$self->{peerlists}->{$i_h}})
	{
	    my %peer_data = $self->get_peer($i_h,$peer);
	    
	    
	    # see if it's a match
	    # prepare match expression by replacing "column name" with the value
	    # to test against
	    my $test = $where;
	    $test =~ s/$_/$peer_data{$_}/eg for keys %peer_data;
	    
	    # test
	    my $is_match = eval $test;
	    $self->error($@), return 0 if $@;	# Error in evaluating
	    
	    if ($is_match)
	    {
		$matches++;
		
		push @peers,$peer_data{peer_id};
	    }
	    
	}
	
	
	# order matches
	if ($order)
	{
	    my @columns = split(',',$order);
	    
	    @columns = reverse @columns; # most important sorting is done last
	    
	    # regular expression for finding C-style floats
	    my $is_num = qr/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
	    
	    foreach my $column_def (@columns)
	    {
		my $column	= $column_def =~ /^\S+/;
		my $reverse	= 1 if $column_def =~ /DESC$/i;
		
		
		if ($reverse)
		{
		    @peers =
		    sort { ( $self->get_peer($i_h,$b)->{$column} =~ $is_num && 
			     $self->get_peer($i_h,$a)->{$column} =~ $is_num ) ?
			     $self->get_peer($i_h,$b)->{$column} <=> $self->get_peer($i_h,$a)->{$column} : 
			     $self->get_peer($i_h,$b)->{$column} cmp $self->get_peer($i_h,$a)->{$column} } @peers;
		}
		else
		{
		    @peers =
		    sort { ( $self->get_peer($i_h,$a)->{$column} =~ $is_num && 
			     $self->get_peer($i_h,$b)->{$column} =~ $is_num ) ?
			     $self->get_peer($i_h,$a)->{$column} <=> $self->get_peer($i_h,$b)->{$column} : 
			     $self->get_peer($i_h,$a)->{$column} cmp $self->get_peer($i_h,$b)->{$column} } @peers;
		}
		
	    }
	    
	}
	
	
	return @peers[$start..$start+$limit] 	if $start && $limit;
	return @peers[0..$limit] 		if $limit;
	return @peers;
    }
    
    
    
    # get_file
    # Get an entry from the filelist
    # Usage:
    #	my %file = $backend->get_file(
    #		"info_hash",			# REQUIRED: File info hash
    #		[ "column", "column" ] );	# OPTIONAL: Limit columns
    sub get_file
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $columns	= shift;
	
	
	my %file_data	= %{$self->{filelist}->{$info_hash}};
	$file_data{info_hash} = $info_hash;
	
	return map { $_ => $file_data{$_} } @{$columns} if $columns;
	
	return %file_data;
    }
    
    
    
    # get_peer
    # Gets an entry from a peerlist
    # Usage:
    #	my %peer = $backend->get_peer(
    #		"info_hash",			# REQUIRED: File info hash
    #		"peer_id",			# REQUIRED: Peer ID
    #		[ "column", "column" ] );	# OPTIONAL: Limit columns
    sub get_peer
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $peer_id	= shift;
	my $columns	= shift;
	
	
	return 0 if !$self->{peerlists}->{$info_hash}->{$peer_id};
	
	
	my %peer_data	= %{$self->{peerlists}->{$info_hash}->{$peer_id}};
	$peer_data{peer_id} = $peer_id;
	
	return map { $_ => $peer_data{$_} } @{$columns} if $columns;
	
	return %peer_data;
    }
    
    
    
    # load_config
    # Loads configuration from a more permanent location
    # Usage:
    #	$backend->load_config( from_file => $filename )
    sub load_config
    {
	my $self	= shift;
	my $from	= shift;
	my $name	= shift;
	
	
	if ($from eq "from_file")
	{
	    open CONFIG,"<$name" or ($self->error($!), return 0);
	    
	    while (my $line = <CONFIG>)
	    {
		next if $line =~ /^\;/;
		
		$line =~ /^\s*(\S+)\s+(.+)$/;
		
		$self->tracker->config($1,$2);
	    }
	    
	    close CONFIG or ($self->error($!), return 0);
	}
	
	return 1;
    }
    
    
    
    # save_config
    # Saves configuration to a more permanent location.
    # Usage:
    #	$backend->save_config( to_file => $filename )
    sub save_config
    {
	my $self	= shift;
	my $to		= shift;
	my $name	= shift;
	
	my %config 	= $self->config;
	
	if ($to eq "to_file")
	{
	    my @config;
	    
	    # Open config to read in comments
	    
	    
	    
	    open CONFIG,"<$name" or ($self->error($!), return 0);
	    
	    print CONFIG @config;
	    
	    close CONFIG or ($self->error($!), return 0);
	}
	
	return 1;
    }
    
    
    
    # set_file
    # Sets an entry in the filelist
    # Usage:
    #	$backend->set_file(
    #		"info_hash",			# REQUIRED: File info hash
    #		{ column => value, ... } );	# REQUIRED: Columns to set
    sub set_file
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $file_data	= shift;
	
	$self->{filelist}->{$info_hash}->{$_} = $file_data->{$_} 
		for keys %$file_data;
	
	return 1;
    }
    
    
    
    # set_peer
    # Sets an entry in a peerlist
    # Usage:
    #	$backend->set_peer(
    #		"info_hash",			# REQUIRED: File info hash
    #		"peer_id",			# REQUIRED: Peer ID
    #		{ column => value, ... } );	# REQUIRED: Columns to set
    sub set_peer
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $peer_id	= shift;
	my $peer_data	= shift;
	
	$peer_data->{last_update} = time;
	
	$self->{peerlists}->{$info_hash}->{$peer_id}->{$_} = $peer_data->{$_} 
		for keys %$peer_data;
	
	return 1;
    }
    
    
    
    # tracker
    # Returns the tracker that's running this protocol
    # Usage:
    #	$backend->tracker;
    sub tracker
    {
	my $self	= shift;
	
	return $self->{tracker};
    }
    
    
    
}




=pod

=head1 NAME

Bittorrent::TrackerLib::Backend - Default backend for the Bittorrent::TrackerLib module.



=head1 DESCRIPTION

This module is the standard backend for the Bittorrent::TrackerLib module. All tracker data is stored in memory and is forgotten as soon as the tracker is stopped.

This module is intended to be used by a Bittorrent::TrackerLib object.



=head1 USAGE

This module is loaded automatically by Bittorrent::TrackerLib, so there's no need to load it explicitly. This backend will be used unless another is given to the Bittorrent::TrackerLib constructor.



=head1 DESIGN

This section outlines how to design your own Bittorrent::TrackerLib::Backend module. Below are all the required methods and prototypes. It is possible to change the prototype of a method, but try to avoid it whenever possible. The *_peer and *_file methods should remain the same, as they are used by the Bittorrent::TrackerLib::Protocol module.

If you want your backend to have new methods, they can be accessed from the Bittorrent::TrackerLib module with the C<backend> method C<$tracker->backend->new_method()>.




=head2 all_peerlists

=over 4

@active_files = $backend->all_peerlists;

=back

Returns a list of all peerlist info hashes. These can be matched with info hashes from the file summary table.



=head2 create_filelist

=over 4

$backend->create_filelist

=back

Creates the file summary table. This function is called automatically when the tracker object is created.



=head2 create_peerlist

=over 4

$backend->create_peerlist($info_hash);

=back

Creates a database table for a peerlist named $info_hash. Uses the current prototypes specified using add_file_column and drop_file_column. 

Normally you shouldn't need to call this function, as the set_peer function will call it automatically if the peerlist doesn't exist.



=head2 delete_file

=over 4

$backend->delete_file($info_hash);

=back

Removes a file from the file summary table.



=head2 delete_peer

=over 4

$backend->delete_peer($info_hash,$peer_id);

=back

Removes a peer from a peerlist.



=head2 drop_filelist

=over 4

$backend->drop_filelist

=back

Drops the file summary table. Any data in the table is deleted, so be very sure before you use this.



=head2 drop_peerlist

=over 4

$backend->drop_peerlist($info_hash)

=back

Drops a peerlist table. Any data in the table is deleted. This function is  called automatically when the last peer in the list is deleted.



=head2 find_file

=over 4

@files = $backend->find_file(
	{ where 	=> "column <= 23 && column eq 'value'",
	  order_by 	=> "columns [ASC|DESC]",
	  limit		=> 2 } ); 	# OPTIONAL: SQL info

=back

Find a list of files from the file summary table. The first argument is a reference to a hash with the following keys:

=over 4

=item where

An string of the form C<column OP value [CONJ column OP value]> where C<column> is the column name, C<OP> is an operator (below), C<value> is the value to test, and C<CONJ> is an optional conjunction (below) for multiple columns. 

String operators:

 eq - Equals
 ne - Not equals
 gt - Greater than
 lt - Less than
 ge - Greater than or equal to
 le - Less than or equal to

Numeric operators (when in doubt, use a string operator):

 == - Equals
 != - Not equals
 >  - Greater than
 <  - Less than
 >= - Greater than or equal to
 <= - Less than or equal to

Conjunctions:

 && - and
 || - or

=item order_by 

An string of the form C<column [DESC|ASC] [, column [DESC|ASC], ...] where C<column> is the column name, C<DESC> means to sort descending, and C<ASC> means to sort ascending (which is the default action and redundant to specify). You can specify multiple columns by separating them with commas, most important column first.

=item limit

An string of the form C<max_rows,start_row> where C<max_rows> is the maximum number of rows to return and C<start_row> is the row number to start from.

=back



=head2 find_peer

=over 4

@files = $backend->find_peer(
	$info_hash,			# REQUIRED: File info hash
	{ where 	=> "column <= 'value' && column = 'value'",
	  order_by 	=> "columns [ASC|DESC]",
	  limit		=> 2 } ); 	# OPTIONAL: SQL info

=back

Find a list of peers from a peerlist. The first argument is a file info_hash. The second argument is a reference to a hash. See the find_file function (above) for details about this hashref.



=head2 get_file

=over 4

%file_data = $backend->get_file(
	$info_hash,			# REQUIRED: File info hash
	\@columns )			# OPTIONAL: Columns to return

=back

Get a row of data from the file summary table. The first argument is the file info hash to get. The optional second argument is a reference to an array of column names to return.

If the columns to return aren't specified, this function returns all columns. These columns must include an "info_hash" column referring to the file's info_hash.



=head2 get_peer

=over 4

%peer_data = $backend->get_peer(
	$info_hash,			# REQUIRED: File info hash
	$peer_id,			# REQUIRED: Peer ID
	\@columns )			# OPTIONAL: Columns to return

=back

Get a row of data from a peerlist. The first argument is the file info hash. The second argument is the peer id to get. The optional third argument is a reference to an array of columns names to return.

If the columns to return aren't specified, this function returns all columns. These columns must include a "peer_id" column referring to the peer's peer_id.



=head2 load_config

=over 4

$backend->load_config( from_file => $filename );	# Read from a file

=back

Loads config from a more permanent location. The first argument is either "from_file" or some other string, specifying where to load the config values from. The second argument is the path/filename or other identifier to load from. The config values can then be accessed with the C<config> method. (See the documentation with your backend for more information on where you can load from)



=head2 save_config

=over 4

$backend->save_config( to_file => $filename );		# Write to a file

=back

Saves config to a more permanent location. The first argument is either "to_file" or "to_table", specifying where to save the config values to (this varies, see the documentation with your backend). The second argument is either the path/filename or the table name to save to.



=head2 set_file

=over 4

$backend->set_file($info_hash, \%file_data);

=back

Sets columns in the file summary table. The first argument is the info_hash of the file to be set. The second argument is a hash reference of data to set.



=head2 set_peer

=over 4

$backend->set_peer($info_hash, $peer_id, \%peer_data);

=back

Sets columns in the peerlist table. The first argument is the info_hash of the peerlist. The second argument is the peer_id of the peer to be set. The third argument is a hash reference of data to set.



=head2 tracker

=over 4

$tracker = $backend->tracker;

=back

Returns the tracker that is using this backend. Mainly used for error reporting and configuration.



=head1 SEE ALSO

=over 4

=item perldoc Bittorrent::TrackerLib

=back



=head1 AUTHOR

Doug Bell (doug@hawkaloogie.com). Any inaccuracies in the module or the documentation, please let me know and I'll fix them.



=head1 COPYRIGHT

Copyright (c)2004, Doug Bell. This module is free software and can be modified/distributed under the same terms as Perl itself.



=head1 HISTORY

v0.04 - ??/??/2004 - Fixed load_config, ** Add comments for load_config/save_config, ** Fix find_file, ** Add REGEXP power to find_

v0.03 - 02/17/2004 - Updated docs, improved Tracker<->Protocol<->Backend relationship

v0.02 - 02/15/2004 - Semi-stable release

v0.01 - 02/02/2004 - Released to comp.lang.perl for testing and feedback



=cut