<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">{ 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-&gt;{tracker} = $tracker;
	
	
	$self-&gt;create_filelist;
	
	
	return $self;
    }
    
    
    
    # all_peerlists
    # Returns a list of active peerlists.
    # Usage:
    #	my @peerlists = $backend-&gt;all_peerlists;
    sub all_peerlists
    {
	my $self	= shift;
	
	return keys %{$self-&gt;{peerlists}};
    }
    
    
    
    # create_filelist
    # Create the filelist table
    # Usage:
    #	$backend-&gt;create_filelist;
    sub create_filelist
    {
	my $self	= shift;
	
	$self-&gt;{filelist} = {};
	
	return 1;
    }
    
    
    
    # create_peerlist
    # Creates a peerlist table
    # Usage:
    # 	$backend-&gt;create_peerlist("info_hash");	# REQUIRED: File info hash
    sub create_peerlist
    {
	my $self	= shift;
	my $info_hash	= shift;
	
	$self-&gt;{peerlists}-&gt;{$info_hash} = {};
	
	return 1;
    }
    
    
    
    # delete_file
    # Delete an entry in the filelist
    # Usage:
    #	$backend-&gt;delete_file("info_hash");	# REQUIRED: File info hash
    sub delete_file
    {
	my $self	= shift;
	my $info_hash	= shift;
	
	delete $self-&gt;{filelists}-&gt;{$info_hash};
	
	return 1;
    }
    
    
    
    # delete_peer
    # Delete an entry in a peerlist
    # Usage:
    #	$backend-&gt;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-&gt;{peerlists}-&gt;{$info_hash}-&gt;{$peer_id};
	
	return 1;
    }
    
    
    
    # drop_filelist
    # Deletes the filelist
    # Usage:
    #	$backend-&gt;drop_filelist
    sub drop_filelist
    {
	my $self	= shift;
	
	delete $self-&gt;{filelist};
	
	return 1;
    }
    
    
    
    # drop_peerlist
    # Deletes a peerlist
    # Usage:
    #	$backend-&gt;drop_peerlist("info_hash")	# REQUIRED: File info hash
    sub drop_peerlist
    {
	my $self	= shift;
	my $info_hash	= shift;
	
	delete $self-&gt;{peerlists}-&gt;{$info_hash};
	
	return 1;
    }
    
    
    
    # find_file
    # Find a list of files in the filelist
    # Usage:
    #	my @files = $backend-&gt;find_file(
    #		{ where 	=&gt; "column ge 'value' &amp;&amp; column == 22",
    #		  order_by 	=&gt; "columns [ASC|DESC]",
    #		  limit		=&gt; "5,2" } ); 	# OPTIONAL: search info
    sub find_file
    {
	my $self		= shift;
	my $find		= shift;
	
	
	my $where		= $find-&gt;{where} || "1 == 1";
	my $order		= $find-&gt;{order_by};
	my ($limit,$start)	= split(',',$find-&gt;{limit}) if $find-&gt;{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-&gt;{filelist}})
	{
	    my %file_data = $self-&gt;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-&gt;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-&gt;get_file($b)-&gt;{$column} =~ $is_num &amp;&amp; 
			     $self-&gt;get_file($a)-&gt;{$column} =~ $is_num ) ?
			     $self-&gt;get_file($b)-&gt;{$column} &lt;=&gt; $self-&gt;get_file($a)-&gt;{$column} : 
			     $self-&gt;get_file($b)-&gt;{$column} cmp $self-&gt;get_file($a)-&gt;{$column} } @files;
		}
		else
		{
		    @files =
		    sort { ( $self-&gt;get_file($a)-&gt;{$column} =~ $is_num &amp;&amp; 
			     $self-&gt;get_file($b)-&gt;{$column} =~ $is_num ) ?
			     $self-&gt;get_file($a)-&gt;{$column} &lt;=&gt; $self-&gt;get_file($b)-&gt;{$column} : 
			     $self-&gt;get_file($a)-&gt;{$column} cmp $self-&gt;get_file($b)-&gt;{$column} } @files;
		}
		
	    }
	    
	}
	
	
	return @files[$start..$start+$limit] 	if $start &amp;&amp; $limit;
	return @files[0..$limit] 		if $limit;
	return @files;
    }

    
    
    
    
    # find_peer
    # Find a list of peers from a peerlist
    # Usage:
    #	my @peers = $backend-&gt;find_peer(
    #		"info_hash",			# REQUIRED: File info hash
    #		{ where 	=&gt; "column ge 'value' &amp;&amp; column == 22",
    #		  order_by 	=&gt; "columns [ASC|DESC]",
    #		  limit		=&gt; 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-&gt;{where} || "1 == 1";
	my $order		= $find-&gt;{order_by};
	my ($limit,$start)	= split(',',$find-&gt;{limit}) if $find-&gt;{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-&gt;{peerlists}-&gt;{$i_h}})
	{
	    my %peer_data = $self-&gt;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-&gt;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-&gt;get_peer($i_h,$b)-&gt;{$column} =~ $is_num &amp;&amp; 
			     $self-&gt;get_peer($i_h,$a)-&gt;{$column} =~ $is_num ) ?
			     $self-&gt;get_peer($i_h,$b)-&gt;{$column} &lt;=&gt; $self-&gt;get_peer($i_h,$a)-&gt;{$column} : 
			     $self-&gt;get_peer($i_h,$b)-&gt;{$column} cmp $self-&gt;get_peer($i_h,$a)-&gt;{$column} } @peers;
		}
		else
		{
		    @peers =
		    sort { ( $self-&gt;get_peer($i_h,$a)-&gt;{$column} =~ $is_num &amp;&amp; 
			     $self-&gt;get_peer($i_h,$b)-&gt;{$column} =~ $is_num ) ?
			     $self-&gt;get_peer($i_h,$a)-&gt;{$column} &lt;=&gt; $self-&gt;get_peer($i_h,$b)-&gt;{$column} : 
			     $self-&gt;get_peer($i_h,$a)-&gt;{$column} cmp $self-&gt;get_peer($i_h,$b)-&gt;{$column} } @peers;
		}
		
	    }
	    
	}
	
	
	return @peers[$start..$start+$limit] 	if $start &amp;&amp; $limit;
	return @peers[0..$limit] 		if $limit;
	return @peers;
    }
    
    
    
    # get_file
    # Get an entry from the filelist
    # Usage:
    #	my %file = $backend-&gt;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-&gt;{filelist}-&gt;{$info_hash}};
	$file_data{info_hash} = $info_hash;
	
	return map { $_ =&gt; $file_data{$_} } @{$columns} if $columns;
	
	return %file_data;
    }
    
    
    
    # get_peer
    # Gets an entry from a peerlist
    # Usage:
    #	my %peer = $backend-&gt;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-&gt;{peerlists}-&gt;{$info_hash}-&gt;{$peer_id};
	
	
	my %peer_data	= %{$self-&gt;{peerlists}-&gt;{$info_hash}-&gt;{$peer_id}};
	$peer_data{peer_id} = $peer_id;
	
	return map { $_ =&gt; $peer_data{$_} } @{$columns} if $columns;
	
	return %peer_data;
    }
    
    
    
    # load_config
    # Loads configuration from a more permanent location
    # Usage:
    #	$backend-&gt;load_config( from_file =&gt; $filename )
    sub load_config
    {
	my $self	= shift;
	my $from	= shift;
	my $name	= shift;
	
	
	if ($from eq "from_file")
	{
	    open CONFIG,"&lt;$name" or ($self-&gt;error($!), return 0);
	    
	    while (my $line = &lt;CONFIG&gt;)
	    {
		next if $line =~ /^\;/;
		
		$line =~ /^\s*(\S+)\s+(.+)$/;
		
		$self-&gt;tracker-&gt;config($1,$2);
	    }
	    
	    close CONFIG or ($self-&gt;error($!), return 0);
	}
	
	return 1;
    }
    
    
    
    # save_config
    # Saves configuration to a more permanent location.
    # Usage:
    #	$backend-&gt;save_config( to_file =&gt; $filename )
    sub save_config
    {
	my $self	= shift;
	my $to		= shift;
	my $name	= shift;
	
	my %config 	= $self-&gt;config;
	
	if ($to eq "to_file")
	{
	    my @config;
	    
	    # Open config to read in comments
	    
	    
	    
	    open CONFIG,"&lt;$name" or ($self-&gt;error($!), return 0);
	    
	    print CONFIG @config;
	    
	    close CONFIG or ($self-&gt;error($!), return 0);
	}
	
	return 1;
    }
    
    
    
    # set_file
    # Sets an entry in the filelist
    # Usage:
    #	$backend-&gt;set_file(
    #		"info_hash",			# REQUIRED: File info hash
    #		{ column =&gt; value, ... } );	# REQUIRED: Columns to set
    sub set_file
    {
	my $self	= shift;
	my $info_hash	= shift;
	my $file_data	= shift;
	
	$self-&gt;{filelist}-&gt;{$info_hash}-&gt;{$_} = $file_data-&gt;{$_} 
		for keys %$file_data;
	
	return 1;
    }
    
    
    
    # set_peer
    # Sets an entry in a peerlist
    # Usage:
    #	$backend-&gt;set_peer(
    #		"info_hash",			# REQUIRED: File info hash
    #		"peer_id",			# REQUIRED: Peer ID
    #		{ column =&gt; 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-&gt;{last_update} = time;
	
	$self-&gt;{peerlists}-&gt;{$info_hash}-&gt;{$peer_id}-&gt;{$_} = $peer_data-&gt;{$_} 
		for keys %$peer_data;
	
	return 1;
    }
    
    
    
    # tracker
    # Returns the tracker that's running this protocol
    # Usage:
    #	$backend-&gt;tracker;
    sub tracker
    {
	my $self	= shift;
	
	return $self-&gt;{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&lt;backend&gt; method C&lt;$tracker-&gt;backend-&gt;new_method()&gt;.




=head2 all_peerlists

=over 4

@active_files = $backend-&gt;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-&gt;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-&gt;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-&gt;delete_file($info_hash);

=back

Removes a file from the file summary table.



=head2 delete_peer

=over 4

$backend-&gt;delete_peer($info_hash,$peer_id);

=back

Removes a peer from a peerlist.



=head2 drop_filelist

=over 4

$backend-&gt;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-&gt;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-&gt;find_file(
	{ where 	=&gt; "column &lt;= 23 &amp;&amp; column eq 'value'",
	  order_by 	=&gt; "columns [ASC|DESC]",
	  limit		=&gt; 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&lt;column OP value [CONJ column OP value]&gt; where C&lt;column&gt; is the column name, C&lt;OP&gt; is an operator (below), C&lt;value&gt; is the value to test, and C&lt;CONJ&gt; 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
 &gt;  - Greater than
 &lt;  - Less than
 &gt;= - Greater than or equal to
 &lt;= - Less than or equal to

Conjunctions:

 &amp;&amp; - and
 || - or

=item order_by 

An string of the form C&lt;column [DESC|ASC] [, column [DESC|ASC], ...] where C&lt;column&gt; is the column name, C&lt;DESC&gt; means to sort descending, and C&lt;ASC&gt; 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&lt;max_rows,start_row&gt; where C&lt;max_rows&gt; is the maximum number of rows to return and C&lt;start_row&gt; is the row number to start from.

=back



=head2 find_peer

=over 4

@files = $backend-&gt;find_peer(
	$info_hash,			# REQUIRED: File info hash
	{ where 	=&gt; "column &lt;= 'value' &amp;&amp; column = 'value'",
	  order_by 	=&gt; "columns [ASC|DESC]",
	  limit		=&gt; 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-&gt;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-&gt;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-&gt;load_config( from_file =&gt; $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&lt;config&gt; method. (See the documentation with your backend for more information on where you can load from)



=head2 save_config

=over 4

$backend-&gt;save_config( to_file =&gt; $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-&gt;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-&gt;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-&gt;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&lt;-&gt;Protocol&lt;-&gt;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
</pre></body></html>