2 # This module impliments the new protocal mode for a dx cluster
4 # Copyright (c) 2001 Dirk Koopman G1TLH
11 @ISA = qw(DXChannel DXProt);
25 use Time::HiRes qw(gettimeofday tv_interval);
37 use vars qw($VERSION $BRANCH);
38 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
39 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/,(0,0));
40 $main::build += $VERSION;
41 $main::branch += $BRANCH;
45 my $user = DXUser->get($main::mycall);
46 $DXProt::myprot_version += ($main::version - 1 + 0.52)*100;
47 $main::me = QXProt->new($main::mycall, 0, $user);
48 $main::me->{here} = 1;
49 $main::me->{state} = "indifferent";
50 $main::me->{sort} = 'S'; # S for spider
51 $main::me->{priv} = 9;
52 $main::me->{metric} = 0;
53 $main::me->{pingave} = 0;
54 $main::me->{registered} = 1;
55 $main::me->{version} = $main::version;
56 $main::me->{build} = $main::build;
58 # $Route::Node::me->adddxchan($main::me);
64 $self->SUPER::start(@_);
76 if ($_[1] =~ /^PC\d\d\^/) {
81 # Although this is called the 'QX' Protocol, this is historical
82 # I am simply using this module to save a bit of time.
85 return unless my ($tonode, $fromnode, $class, $msgid, $hoptime, $rest) =
86 $_[1] =~ /^([^;]+;){5,5}\|(.*)$/;
90 # add this interface's hop time to the one passed
91 my $newhoptime = $self->{pingave} >= 999 ?
92 $hoptime+10 : ($hoptime + int($self->{pingave}*10));
94 # split up the 'rest' which are 'a=b' pairs separated by commas
95 # and create a new thingy based on the class passed (if known)
96 # ignore pairs with a leading '_'.
100 for (split /;/, $rest) {
103 s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
104 push @par, split(/=/,$_,2);
108 my $pkg = 'Thingy::' . lcfirst $class;
109 my $t = $pkg->new(_tonode=>$tonode, _fromnode=>$fromnode,
110 _msgid=>$msgid, _hoptime=>$newhoptime,
111 _newdata=>$rest, _inon=>$self->{call},
112 @par) if defined *$pkg && $pkg->can('new');
117 my $last_node_update = 0;
118 my $node_update_interval = 60*60;
122 if ($main::systime >= $last_node_update+$node_update_interval) {
123 $last_node_update = $main::systime;
130 my $t = Thingy::Route->new_node_disconnect($main::mycall, $main::mycall, $self->{call});
132 $self->DXProt::disconnect(@_);
140 $msgid = 1 if ++$msgid > 99999;
146 my $t = Thingy::Route->new_node_update();
154 confess('$t is not a Thingy') unless $t->isa('Thingy');
156 # manufacture the protocol line if required
157 unless (exists $t->{_newprot}) {
158 my ($class) = ref $self =~ /::(\w+)$/;
159 unless (exists $t->{_rest}) {
161 while (my ($k,$v) = each %$t) {
167 $vv =~ s/([\%;=,\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
172 $t->{_rest} .= "$k=$val;";
174 } elsif (length $v) {
175 $v =~ s/([\%;=\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
176 $t->{_rest} .= "$k=$v;";
179 chop $t->{_rest} if length $t->{_rest};
182 $t->{_hoptime} ||= 1;
183 $t->{_msgid} = nextmsgid() unless $t->{_msgid};
184 $t->{_newprot} = join(';', $t->{_tonode}, $t->{_fromnode}, uc $class,
185 $t->{_msgid}, $t->{_hoptime}) . '|' . $t->{_rest};
187 $self->SUPER::send($t->{_newprot});