package IRC::Tools::Server;

use IRC::Parser::Mapped qw(:all); 

use Carp qw(croak); 

use Exporter qw(import); 
our @EXPORT_OK = qw($Server $Support);

our %EXPORT_TAGS = ( 
  casemap => [ qw(rfc_lc rfc_uc rfc_casemap) ], 
  prefix => [ qw(mode2prefix prefix2mode) ], 
);

my %EXISTS; 
push @EXPORT_OK, grep {!$EXISTS{$_}++} @{ $EXPORT_TAGS{$_} } 
  foreach(keys %EXPORT_TAGS); 
$EXPORT_TAGS{all} = \@EXPORT_OK; 
undef(%EXISTS);  

our $Server = {}; 
our $Support = {}; 

handler Server => { 
  '004' => sub { @{ $Server }{qw(name version usermodes chanmodes listmodes)} = split ' ', $_[PM_ARGS]; PM_OK }, 
  '005' => sub { 
    PIECE: foreach(split ' ', $_[PM_ARGS]) { 
      $Support->{uc($_)} = 1, next PIECE 
        unless /=/;
      my($key, $val) = split '=', $_, 2; 
      $key =~ y/a-z/A-Z/; 
      if($key eq 'CHANMODES') { 
        $Support->{$key} = [ split ',', $val ]; 
      } elsif($key eq 'PREFIX') { 
        my($modes, $prefix) = $val =~ /^\((.+)\)(.+)$/; 
        @{ $Support->{$key} }{ split('', $modes) } = split '', $prefix;
      } elsif($key eq 'CASEMAPPING') {
        rfc_casemap($val);
      } elsif(grep {$_ eq $key} qw(MAXLIST TARGMAX IDCHAN)) { # CHANLIMIT
        foreach(split ',', $val) { 
          my($k, $v) = split ':'; 
          $Support->{$key}->{$k} = $v; 
        } 
      } else { $Support->{$key} = $val; } 
    }
    PM_OK
  }, 
  ERROR => sub { $Server = {}, $Support = {}; } 
}, PRI_CRITICAL + 10;  # Very *critical*?

sub mode2prefix { foreach(keys %{ $Support->{PREFIX} }) { return $Support->{PREFIX}->{$_} if $_ eq $_[0]; } } 
sub prefix2mode { foreach(keys %{ $Support->{PREFIX} }) { return $_ if $Support->{PREFIX}->{$_} eq $_[0]; } } 

my $CASEMAP; 
# as tr/// is handled at compile time, a var won't suffice unless I eval() this whole thing
#  which I can only do at a considerable cost to performance, so I won't
my $CMAPS = { 
  'ascii' => { 
    'LC' => sub { local $_ = shift; y/A-Z/a-z/; $_; },
    'UC' => sub { local $_ = shift; y/a-z/A-Z/; $_; }
  },  
  'rfc1459' => { 
    'LC' => sub { local $_ = shift; y/A-Z[]\\^/a-z{}|~/; $_; },
    'UC' => sub { local $_ = shift; y/a-z{}|~/A-Z[]\\^/; $_; }
  }, 
  'strict-rfc1459' => { 
    'LC' => sub { local $_ = shift; y/A-Z[]\\/a-z{}|/; $_; },
    'UC' => sub { local $_ = shift; y/a-z{}|/A-Z[]\\/; $_; } 
  }
}; 

sub rfc_casemap { 
  return $CASEMAP 
    unless @_;
  if(exists $CMAPS->{$_[0]}) { 
    $CASEMAP = $_[0]; 
#    do { no warnings; *rfc_lc = $CMAPS->{$CASEMAP}->{LC}; *rfc_uc = $CMAPS->{$CASEMAP}->{UC}; }; - apparently, when exported to a namespace.. its a reference to as it is at the time.. which would only make sense, it happens at ompile time.. oops
  } else { 
    $CASEMAP = 'ascii';
    warn "casemap(): unknown casemap $_[0], assuming 'ascii'."; 
  } 
} 

rfc_casemap('ascii');


# lexical returns first element, scalar a list
sub rfc_lc { 
  scalar @_ 
    or croak "usage: rfc_uc(LIST)"; 
  my @lc = (); 
  push @lc, $CMAPS->{$CASEMAP}->{LC}->($_) 
    while(local $_ = shift);
  wantarray() ? @lc : $lc[0]; 
}  
# scalar returns array reference, otherwise a list
sub rfc_uc {
  scalar @_ 
    or croak "usage: rfc_uc(LIST)"; 
  my @uc = (); 
  push @uc, $CMAPS->{$CASEMAP}->{UC}->($_) 
    while(local $_ = shift);
  wantarray() ? @uc : $uc[0];  
} 
 
1;