#!/usr/bin/perl

# $Id: gui-helper.pl,v 1.10 1996/02/12 18:52:56 hoagland Exp $

require '/pkg/arpa/demo.0/require.pl';

# a bunch of library routines used by the gui

# returns the state file to use from the ~/.ids_prefs file, otherwise
# return a default; use is identified by the REMOTE_USER field from server,
# which is set by user-based authentication
sub get_statefile {
  my $home= $ENV{'REMOTE_USER'}? '/home/'.$ENV{'REMOTE_USER'} : '/pkg/arpa/demo.0';
  my $preffile= $home."/.ids_prefs";
  my $statefile= $home."/.ids_gui_state";
  if (open(RC,"<$preffile")) {
    while (<RC>) {
      chomp;
      ($option,$value)= split(':',$_,2);
      ($statefile= $value,next) if $option eq "state file";
    }
    close RC;
  } else { # could not read pref file
    (-e $preffile) && die "could not read $preffile";
    open(RC,">$preffile") || die "could not create $preffile";
    print RC "state file:$statefile\n";
    close RC;
  }
  return $statefile;
}

# read in the file ad the first argument, output to the stream in the second
# argment after substituting the rest of the odd arguments with the following
# one.
# e.g. output_instantiated_file('srcfile',*STDOUT,'find','replace','yes','no')
#
sub output_instantiated_file {
  my($srcfile)= shift;
  local(*aStream)= shift;
  my($text)= '';
  open(SRC,"<$srcfile") || die "could not open $srcfile for read";
  $text.= $_ while (<SRC>);
  while (@_) {
    $find= shift;
    $replace= shift;
    $text =~ s/$find/$replace/g;
  }
  print aStream $text;
}

sub start_multipart_output {
  print "Content-type: multipart/x-mixed-replace;boundary=---ThisRandomString---\n\n";
  print "---ThisRandomString---\n";
}

sub end_part {
  print "\n---ThisRandomString---\n";
}

sub show_text_part {
  print "Content-type: text/plain\nPragma: no-cache\n\n";
  print @_;
  &end_part;
}



# returns text for the current time given unix time, i.e. from "time"
sub time_text {
  ($sec,$min,$hour,$mday,$mon,$year,$wday,undef,undef)= localtime($_[0]);
  return "$hour:".($mday<10?"0":'')."$mday:".($sec<10?"0":'')."$sec ".(qw(Sun Mon Tues Wednes Thurs Fri Sat))[$wday]."day, $mday ".(qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon]." $year";
}

# return as text the option list of working sets
sub ws_options {
  my $state= shift;
  my $ws_opt= '';
  foreach (sort $state->sets) {
    $ws_opt.= "<OPTION";
    $ws_opt.= " SELECTED" if $state->last_ws eq $_;
    $ws_opt.= ">$_";
  }
  return $ws_opt;
}

# return as text the option list of folders
sub folder_options {
  my $state= shift;
  my $text= '<OPTION VALUE="">(all)';
  foreach (sort $state->folders) {
    $text.= "<OPTION>";
    $text.= $_ ? $_ : '(all)';
  }
  return $text;
}

sub icons_avail {
  opendir(DIR,'/pkg/www/arpa/secret/icons');
  @files= readdir(DIR);
  @files= grep(/^[^\.]/,@files);
  close DIR;
  return @files;
}

sub url_encode {
  $_[0] =~ s:([ \t\+\?/\#]):sprintf("%%%02x",ord($1)):eg;
  return $_[0];
}

# may damage rules with spaces in regexs or quotes
sub canonize_rules {
  my(@rr)=();
  foreach (@_) {
    # put rule in canonical form
    s/==>/\xff/;
    s/\s/ /g;
    s/  +/ /g;
    s/\xff/ ==> /;
    s/^ //;
    s/ $//;
    push(@rr,$_);
  }
  return @rr;
}


#-----------------------

package State;


sub new {  
  my($class,$file)= @_;
  my $self=bless {};
  $hostname= $myhostname; # from require.pl
  unless (-e $file && ! -z $file) {
    # create state from scratch
    $self->{'wss'}{$hostname}= [$hostname];
    $self->{'last_ws'}= $hostname;
    $self->{'last_host'}= $hostname;
    $self->{'hosts'}= [$hostname];
    $self->{'rr2id'}=();
    $self->{'id2rr'}=();
    $self->{'rule_nonce'}=1;
    $self->{'folders'}{'urgent'}= 'priority=urgent';
    $self->{'storage_file'}= $file;
    $self->store;
  } else {
    $self= State->recover($file);
  }
  return $self;
}

sub recover { 
  my($class,$file)= @_;
  my $self={};
  open(F,"<$file") || die "could not read $file";
  flock(F,2); # lock exclusively
  $line= <F>;
  chomp $line;
  $self->{'hosts'}= [split(':',$line)];
  $line= <F>; # --------
  $line= <F>;
  chomp $line;
  $self->{'last_host'}= $line;
  $line= <F>; # --------
  $line= <F>;
  chomp $line;
  $self->{'last_ws'}= $line;
  $line= <F>; # --------
  while (($line= <F>) && $line !~ /^------/) {
    chomp $line;
    ($name,@hosts)= split(':',$line);
    $self->{'wss'}{$name}= [@hosts];
  }

  $self->{'rule_nonce'}= 0;
  while (($line= <F>) && $line !~ /^------/) {
    chomp $line;
    my($id,$rule)= split(';',$line);
    $self->{'id2rr'}{$id}= $rule;
    $self->{'rr2id'}{$rule}= $id;
    $self->{'rule_nonce'}= $id+1 unless $self->{'rule_nonce'} > $id;
  }

  while (($line= <F>) && $line !~ /^------/) {
    chomp $line;
    my($path,$icon,$condition)= split(';',$line,3);
    $self->{'folders'}{$path}= $condition;
    $self->{'icons'}{$path}= $icon;
  }

  $self->{'storage_file'}= $file;
  flock(F,8); # release lock
  close F;
  return bless $self;
}

sub store {
  my($self)=shift;
  my $file= $self->{'storage_file'};
  open(F,">$file") || die "could not write to $file"; 
  flock(F,2); # lock exclusively
  select F;
  print join(':',$self->hosts),"\n";
  print "----------\n";
  print $self->{'last_host'},"\n";
  print "----------\n";
  print $self->{'last_ws'},"\n";
  print "----------\n";
  foreach (keys %{$self->{'wss'}}) {
    print join(':',$_,@{$self->{'wss'}{$_}}),"\n";
  }
  print "----------\n";
  foreach ($self->routing_rules) {
    print $self->routing_rule_id($_),";$_\n";
  }
  print "----------\n";

  foreach $folder (keys %{$self->{'folders'}}) {
    print "$folder;",$self->{'icons'}{$folder},';',$self->{'folders'}{$folder},"\n";
  }
  print "----------\n";
  flock(F,8); # release lock
  close F;
  select STDOUT;
}

#--------

sub wss {
  return %{$_[0]->{'wss'}};
}

sub sets {
  return keys %{$_[0]->{'wss'}};
}

sub hosts_in_set {
  return @{$_[0]->{'wss'}{$_[1]}};
}

sub set_set {
  my ($self,$name,@hosts)= @_;
  return $self->{'wss'}{$name}= [@hosts];
}

sub last_ws {
  return $_[0]->{'last_ws'};
}

sub last_host {
  return $_[0]->{'last_host'};
}

sub hosts {
  return @{$_[0]->{'hosts'}};
}

sub add_hosts {
  my ($self,@new_hosts)= @_;
  # do a union of @new_hosts and the current hosts
  my(%tmp);
  grep($tmp{$_}++,@new_hosts);
  grep($tmp{$_}++,@{$self->{'hosts'}});
  $self->{'hosts'}= [keys %tmp];
}

sub routing_rules {
  return keys %{$_[0]->{'rr2id'}};
}

sub routing_rule_id {
  return $_[0]->{'rr2id'}{$_[1]};
}

sub routing_rule_for_id {
  return $_[0]->{'id2rr'}{$_[1]};
}

sub add_routing_rules {
  my $self= shift;
  my(@new_rules)= &::canonize_rules(@_);
  # do a union of @new_rules and the current rules
  foreach $rule (@new_rules) {
    unless (defined($self->{'rr2id'}{$rule})) {
      $self->{'rr2id'}{$rule}= $self->{'rule_nonce'}++;
      $self->{'id2rr'}{$self->{'rule_nonce'}}= $rule;
    }
  }
  return @new_rules; # return canonical version of new rules
}

sub folders {
  return keys %{$_[0]->{'folders'}};
}

sub subfolders {
  return grep(/^[^:]+$/,$_[0]->folders) if $_[1] eq '';
  return grep(/^$_[1]:[^:]+$/,keys %{$_[0]->{'folders'}});
}

sub superfolders {
  my($self_or_class,$path)= @_;
  my(@res)= ();
  my $pathtd='';
  foreach $part (split(':',$path)) {
    $pathtd.= $part;
    push(@res,$pathtd);
    $pathtd.=':';
  }
  return @res;
}

sub conditions_to_folder {
  return map($_[0]->folder_condition($_),$_[0]->superfolders($_[1]));
}

sub folder_condition {
  return $_[0]->{'folders'}{$_[1]};
}

sub folder_tail {
  return $_[1] unless $_[1] =~ /:/;
  $_[1] =~ /:([^:]+)$/;
  return $1;
}

sub icon {
  return $_[0]->{'icons'}{$_[1]};
}

sub set_folder {
  my ($self,$name,$condition,$icon)= @_;
  $self->{'icons'}{$name}= $icon;
  return $self->{'folders'}{$name}= $condition;
}


1;