#!perl
# arealist conversion from nice tosser to parma tosser же
$myAKA ='2:5100/14'; # needed for subscription abbrevs
$echopath ="\\Mailer\\ParToss\\Echo\\"; # pls add backslash; won't be checked

# get address defaults
($myZone, $myNet, $myNode, $myPoint) =split(/[:\/\.]/, $myAKA);

# read nice.are
LINE: while (<>) {
  next LINE if ($_ !~ /EchoArea\s+([A-Za-z]+)\s+(\S+)\s+\"(.*)\"\s+/);
  {
    my ($group, $tag, $desc, @links)
      =(uc($1), uc($2), substr($3, 0, 39), split(' ', $'));
    # expand defaults, convert flags for each link
    foreach (@links) {
      my ($flags, $zone, $net, $node, $point);
      if (/[\D]+/) { $flags =$&; tr/:\/\.[0-9]//cd; };
      if (/:/) { $zone =$`; $_ =$'; } else { $zone =$myZone; };
      if (/\d+(?=\/)/) { $net =$&; $_ =$'; } else { $net =$myNet; };
      tr/\///d;
      if (/\./) { $node =($` eq '') ? $myNode : $`; $point =$'; }
      else { $node =$_ };
      $flags =~ tr/RWP/xyy/; $flags =~ tr/xy//cd;
      $_ = ($flags ? "-$flags" :'') ."$zone:$net/$node";
      $_ .= ".$point" if $point;
    };
    @links =sort {
      my( $z, $n, $f, $p, $l, $r);
      ($l, $r) =($a, $b);
      $l =~tr[/:.0-9][]cd;
      ( $z, $n, $f, $p) =split(/[:\/\.]/, $l);
      $l =((($z <<16) +$n) *65536 +$f) *65536 +$p;
      $r =~tr[/:.0-9][]cd;
      ( $z, $n, $f, $p) =split(/[:\/\.]/, $r);
      $r =((($z <<16) +$n) *65536 +$f) *65536 +$p;
      $l cmp $r;
    } @links;
    $echo{$tag} = { 'group' => $group, 'desc' => $desc, 'links' => \@links };
    $groups{$group} =$group; # used in multi-to-single group translation
  };
};

@echotags =sort( keys( %echo));
print "; area configuration generated by nice2sq.pl\n;\n";
foreach $tag (@echotags) {
  # make unique name for arafiles (no -e checking though)
  $fname =$tag;
  $fname =~ tr/1-9A-Z_//cd; # uppercased above
  $fname =substr( $fname, 0, 8);
  while (exists $fnames{$fname}) { $fname++ };
  $fnames{$fname} =1;

  # translate complex group tags
  my $gold =$echo{$tag}{group};
  if (length($groups{$gold}) >1) {
    my $gnew ='A';
    while (exists( $groups{$gnew})) { $gnew++; };
    if (length( $gnew) >1) {
      print STDERR "\n*** No more group letter available for $gold\n";
      print STDERR "*** The group left as is\n";
    } else {
      $groups{$gnew} =$gold;
      $groups{$gold} =$gnew;
    };
  };
  print "EchoArea $tag   $echopath$fname   -\$ -p$myAKA -0 -\$g";
  print (((length( $gold) >1) ? $groups{$gold} : $gold), ' ');
  print "-\$n\"$echo{$tag}{desc}\" " unless ($echo{$tag}{desc} eq '');
  print join(' ', @{$echo{$tag}{links}}), "\n";
};
print ";\n; areagroup translations used:\n;\n";
foreach (keys(%groups)) {
 print "; $groups{$_} => $_\n" if (length( $groups{$_}) > length( $_));
};

1;