package SVL::Bonjour;
use strict;
use warnings;
use base qw(Class::Accessor::Chained::Fast);
use Net::Rendezvous;
use Net::Rendezvous::Publish;
use Sys::Hostname;
use Sys::HostIP;
__PACKAGE__->mk_accessors(qw(res peers));
my $publisher = Net::Rendezvous::Publish->new
or die "couldn't make a Responder object";
my $hostname = hostname;
my ($host) = split /\./, $hostname;
my $hostip = hostip;
my $repository = "$ENV{USER}-$host\'s svk repository";
my $old_repos = "";
my $service;
sub new {
my $class = shift;
my $self = $class->SUPER::new();
$self->res(Net::Rendezvous->new('svl'));
return $self;
}
sub discover {
my $self = shift;
$self->res->discover();
my @objects;
foreach my $entry ($self->res->entries) {
my $peer = SVL::Bonjour::Peer->new();
$peer->address($entry->address);
$peer->port($entry->port);
my %attrs = $entry->all_attrs;
$peer->svnport($attrs{svnport});
my @shares;
foreach my $attr (sort keys %attrs) {
next unless $attr =~ /^svl\d+$/;
push @shares, SVL::Share->parse($attrs{$attr});
}
$peer->shares(\@shares);
my $name = $entry->name;
$name =~ s/\\(0\d\d)/chr($1)/eg;
$peer->name($name);
push @objects, $peer;
}
$self->peers(\@objects);
return $self;
}
sub publish {
my ($self, $shares) = @_;
my $repos = "";
my $i = 0;
foreach my $share (@$shares) {
$repos .= "svl" . $i++ . "=" . $share->dump . "\x{1}";
}
$repos ||= "\x{1}";
if ($repos ne $old_repos) {
$old_repos = $repos;
$service->stop if $service;
$service = $publisher->publish(
name => $repository,
type => '_svl._tcp',
port => $SVL::SVL_PORT,
domain => 'local',
# why oh why \x{1}
txt => "svnport=$SVL::SVNSERVE_PORT\x{1}${repos}we hate software",
);
}
}
sub step {
my ($self, $step) = @_;
$publisher->step($step);
}
sub match_peer_name {
my $self = shift;
my $host = shift;
my @candidates;
foreach my $peer (@{ $self->peers }) {
for my $share (@{ $peer->shares }) {
push @candidates, $peer
if grep { $host eq $_ } @{$share->tags};
}
}
if (@candidates == 0) {
die "No candidates found for root '$host'";
} elsif (@candidates > 1) {
print "Too many matching peers for $host:\n";
print "\t" . $_->name . "\n" for (@candidates);
exit;
}
my $peer = $candidates[0];
return $peer;
}
package SVL::Bonjour::Peer;
use strict;
use warnings;
use base qw(Class::Accessor::Chained::Fast);
__PACKAGE__->mk_accessors(qw(name port address svnport shares));
1;