#!/usr/bin/perl
#
# $Id: echosync.pl,v 1.9 2003/09/10 18:06:38 gremlin Exp $
#

use strict;

use vars qw(%lists %conf @listtags @tossconf @echokill);
use vars qw($gettag $addtag $subscribed $addlink);

# read config
open FIN, "<echosync.conf" or die "Can't open config file\n";
while (my $line = <FIN>)
{
#	chomp $line;
	$line =~ s/[\r\n]//g;
	next if (($line eq '') or ($line =~ /^#/));
	my @tagdesc = split(' ',$line);
	$tagdesc[0] =~ tr/A-Z/a-z/;
	if ($tagdesc[0] eq 'list')
	{
		$lists{$tagdesc[1]} = [ split(',',$tagdesc[2]) ];
	}
	else
	{
		$conf{$tagdesc[0]} = $tagdesc[1];
	};
};
close FIN;

SWITCH:
{
	$conf{'tosser'} eq 'husky' && do
	{
		$gettag = \ &gettag_husky;
		$addtag = \ &addtag_husky;
		$subscribed = \ &subscribed_husky;
		$addlink = \ &addlink_husky;
		last;
	};
	$conf{'tosser'} eq 'qecho' && do
	{
		$gettag = \ &gettag_qecho;
		$addtag = \ &addtag_qecho;
		$subscribed = \ &subscribed_qecho;
		$addlink = \ &addlink_qecho;
		last;
	};
	$conf{'tosser'} eq 'squish' && do
	{
		$gettag = \ &gettag_squish;
		$addtag = \ &addtag_squish;
		$subscribed = \ &subscribed_squish;
		$addlink = \ &addlink_squish;
		last;
	};
	$conf{'tosser'} eq 'fidogate' && do
	{
		$gettag = \ &gettag_fidogate;
		$addtag = \ &addtag_fidogate;
		$subscribed = \ &subscribed_fidogate;
		$addlink = \ &addlink_fidogate;
		last;
	};
	die "Unknown tosser or no tosser specified\n";
};

# read tosser configuration
&readconf($conf{'config'});

# load list of echoes to be killed

@echokill = ();
open FIN, "<echokill.list" or die "Can't open echokill.list\n";
while (my $line = <FIN>)
{
#	chomp $line;
	$line =~ s/[\r\n]//g;
	next if $line =~ /^$/o;
	$line =~ s/\s.*//g;
	$line =~ tr/a-z/A-Z/;
#	print "debug: echokill: $line\n";
	push @echokill, $line;
}
close FIN;

# process given echolists
for my $echolist (keys %lists)
{
	@listtags = ();

	print "Processing $echolist...\n";
	
	# read echolist
	open FIN, "<$echolist" or die "Can't open $echolist\n";
	while (my $line = <FIN>)
	{
#		chomp $line;
		$line =~ s/[\r\n]//g;
		next if ($line !~ /^(|;|hold|down),(.+?),/i);
		my $tag = $2;
		$tag =~ tr/a-z/A-Z/;
		my $exists = 0;
		for my $killtag (@echokill)
		{
			last if ($exists = ($tag =~ /$killtag/ ))
		}
		if (!$exists)
		{
			push @listtags, $tag;
		}
	};
	close FIN;
	
	# check for missing tags
	for my $tag (@listtags)
	{
		my $cl_ref;
		my $exists = 0;
		for my $cl (@tossconf)
		{
			$cl_ref = \ $cl;
			last if ($exists = ($tag eq $gettag->($cl)));
		};
		if (!$exists)
		{
			$addtag->($tag,$echolist);
			print "$tag does not exist - created.\n";
		}
		else
		{
			# check subscription
			if ($conf{'subscribe'} eq 'yes')
			{
				for my $hub (@{$lists{$echolist}})
				{
					if (!$subscribed->($$cl_ref,$hub))
					{
						print "$hub was not subscribed to $tag from $echolist - fixed\n";
						$addlink->($cl_ref,$hub);
					};
				};
			};
		};
	};

};

# write tosser configuration
&writeconf($conf{'config'});


# husky support
sub gettag_husky
{
	my ($line) = @_;
	$line =~ /^\s*echoarea\s+(.+?)\s/i;
	$line =~ tr/a-z/A-Z/;
	return $1;
};
sub addtag_husky
{
	my ($tag, $list) = @_;
	$tag =~ tr/a-z/A-Z/;
	push @tossconf, "EchoArea $tag passthrough -a $conf{address} -g $conf{group} " . join(' ',@{$lists{$list}});
};
sub subscribed_husky
{
	my ($line, $node) = @_;
	$line =~ tr/a-z/A-Z/;
	return $line =~ /\s+$node(\s+.*|)$/;
};
sub addlink_husky
{
	my ($line, $node) = @_;
	$line =~ tr/a-z/A-Z/;
	$$line = $$line . " " . $node;
};


# qecho support
sub gettag_qecho
{
	my ($line) = @_;
	$line =~ /^\d+\s+\*\s+-1\s+(.+?)\s/i;
	$line =~ tr/a-z/A-Z/;
	return $1;
};
sub addtag_qecho
{
	my ($tag, $list) = @_;
	$tag =~ tr/a-z/A-Z/;
	push @tossconf, "$conf{group} * -1 $tag\tpassthrough\t* $conf{address}\t* " . join("\t* ",@{$lists{$list}});
};
sub subscribed_qecho
{
	my ($line, $node) = @_;
	$line =~ tr/a-z/A-Z/;
#	return $line =~ /\t\*\s$node(\t.*|)$/;
#	return $line =~ /\*\s$node(\t.*|)$/;
	return $line =~ /.*\s$node\s.*/;
};
sub addlink_qecho
{
	my ($line, $node) = @_;
	$line =~ tr/a-z/A-Z/;
	$$line = $$line . "\t* " . $node;
};


# squish support
sub gettag_squish
{
	my ($line) = @_;
	$line =~ /^\s*echoarea\s+(.+?)\s+/i;
	$line =~ tr/a-z/A-Z/;
	return $1;
};
sub addtag_squish
{
	my ($tag, $list) = @_;
	$tag =~ tr/a-z/A-Z/;
	push @tossconf, "EchoArea $tag passthrough -p$conf{address} -0 " . join(' ',@{$lists{$list}});
};
sub subscribed_squish
{
	my ($line, $node) = @_;
	$line =~ tr/a-z/A-Z/;
	return $line =~ /\s+$node(\s+.*|)$/;
};
sub addlink_squish
{
	my ($line, $node) = @_;
	$line =~ tr/a-z/A-Z/;
	$$line = $$line . " " . $node;
};


sub readconf
{
	my ($filename) = @_;

	open FIN, "<$filename" or die "Can't open $filename\n";
	while (my $line = <FIN>)
	{
#		chomp $line;
		$line =~ s/[\r\n]//g;
		push @tossconf, $line;
	};
	close FIN;
};
sub writeconf
{
	my ($filename) = @_;

	open FOUT,">$filename.out" or die "Can't open $filename.out\n";
	for my $line (@tossconf)
	{
		print FOUT $line . "\n";
	};
	close FOUT;
};

# fidogate support by Dmitriy Yermakov 2:5030/1115
sub gettag_fidogate
{
	my ($line) = @_;
	if ( $line =~ /^*\s+(.+?)\s+/i ) { return $1; }
};
sub addtag_fidogate
{
	my ($tag, $list) = @_;
	push @tossconf, "#- $tag -z 2 -s S " . join(' ',@{$lists{$list}});
};
sub subscribed_fidogate
{
	my ($line, $snode) = @_;
	my ($zone, $net, $node, $subs, @links);
	($zone, $net, $node) = split('\D',$snode);
        $line =~ /(.+)-z\s(\d)\s(-p\s\S+\s)?(-a\s.*)?(-t\s\d+\s)?(-d\s.*)?(-s\s\w\s)?(\d\:.*)/;
        $subs = $8;
        @links = split(' ',$subs);
        foreach my $curr (@links) {
	# Z:N/F.P
	if ( $curr =~ /(\d)\:(\d+)\/(\d+)\.(\d+)/ ) {
		$zone = $1; $net = $2; $node = $3;
		}
		# Z:N/F
		elsif ( $curr =~ /(\d)\:(\d+)\/(\d+)/ ) {
			$zone = $1; $net = $2; $node = $3;
			}
		# N/F.P
		elsif ( $curr =~ /(\d+)\/(\d+)\.(\d+)/ ) {
			$net = $1; $node = $2; 
			}
		# N/F
		elsif ( $curr =~ /(\d+)\/(\d+)/ ) {
			$net = $1; $node = $2; 
			}
		# F
		elsif ( $curr =~ /(\d+)/ ) {
			$node = $1; 
			}
		# F.P
		elsif ( $curr =~ /(\d+)\.(\d+)/ ) {
			$node = $1;
			}
        $curr = $zone . ":" . $net . "/" . $node;
	return 1 if ( $curr =~ /$snode/ );
	}
};

sub addlink_fidogate {
	my ($line, $node) = @_;
	my $zone;
	($zone, $node) = split(':',$node);
	$$line = $$line . " " . $node;
};

sub readconf
{
	my ($filename) = @_;
	open FIN, "<$filename" or die "Can't open $filename\n";
	while (my $line = <FIN>)
	{
		chomp $line;
		push @tossconf, $line;
	};
	close FIN;
};

sub writeconf
{
	my ($filename) = @_;
	open FOUT,">$filename.out" or die "Can't open $filename.out\n";
	for my $line (@tossconf)
	{
		print FOUT $line . "\n";
	};
	close FOUT;
};
