#!/usr/bin/perl
#
# X10 interface done via HTTP+REST
#
######################### 
# $Id: template.pl 129 2005-02-08 23:52:40Z steve $
#########################
# $Log$
#########################

use strict;
use Getopt::Std;
use HTTP::Daemon;
use HTTP::Status;
use URI::Escape;

my ($version) = '$Revision: 129 $' =~ /Revision:\s*(.+?)\s*\$/;

our ( $opt_h, $opt_V );
getopts("hV");

usage() if $opt_h;
die "$0 version: $version\n" if $opt_V;

#### end init

my $port = "8090";
my @avail_housecodes = ('E');

my $aliases_file = "$ENV{HOME}/.x10_rest_server.aliases";
# forward and backword aliases
my($aliases, $aliases_rev) = read_aliases($aliases_file);

my $d = HTTP::Daemon->new(LocalPort => $port )
  || die "cannot create daemon: $!\n";

print "Server started at ", $d->url, "\n";
my $baseurl = $d->url;

while (my $c = $d->accept) {
  my $pid = fork();

  # have the parent process loop endlessly
  next if $pid != 0;

  $SIG{INT} = sub { $c->close; undef($c) };
  while (my $r = $c->get_request) {

    use Data::Dumper;
    my @pp = $r->url->path_segments;

    # remove trailing empty bits
    while( $#pp > 0 && $pp[$#pp] eq '' ){
      delete $pp[$#pp];
    }
    print Dumper(\@pp);
    my ($path) = $r->url->path;
    print "path: '".$path."'\n";
    print "method: '".$r->method."'\n";

    # /
    if ( @pp == 1 && $pp[0] eq '' ) {
      process_root_request( $r, $c );

      # /unit/UNIT
    } elsif ( @pp == 3 && $pp[1] eq 'unit' ) {
      my $unit = $pp[2];
      process_unit_request( $r, $c, $unit );

      # /unit/UNIT/alias
    } elsif ( @pp == 4 && $pp[1] eq 'unit' && $pp[3] eq 'alias' ) {
      my $unit = $pp[2];
      process_unit_alias( $r, $c, $unit );

    } elsif ( @pp == 2 && $pp[1] eq 'aliases' ) {
      process_aliases( $r, $c );

    } else {
      $c->send_error(RC_FORBIDDEN);
    }
  } # get_request

  if( $c ){
    $c->close;
    undef($c);
  }
} # accept


sub process_unit_alias{
  my( $r, $c, $unit ) = @_;

  if ( $r->method eq 'GET' ) {

    if( exists $aliases->{lc $unit} ){
      my $res = new HTTP::Response( RC_OK );
      $res->header( 'Content-Type' => 'text/plain' );
      $res->content( $aliases->{lc $unit}."\n" );
      $c->send_response( $res );

    }else{
      $c->send_error( RC_NOT_FOUND, 'Alias not defined for given unit' );
    }

  } elsif ( $r->method eq 'PUT' ) {
    my $name = $r->content;
    chomp $name;
    print "alias: $unit = $name\n";
    $aliases->{lc $unit} = $name;
    $aliases_rev->{lc $name} = $unit;

    write_aliases($aliases_file);
    $c->send_response( RC_OK );

  } elsif ( $r->method eq 'DELETE' ) {
    if ( exists $aliases->{lc $unit} ) {
      my $name = $aliases->{lc $unit};
      print "deleting alias: $unit = $name\n";
      delete $aliases->{lc $unit};
      delete $aliases_rev->{lc $name};

      write_aliases($aliases_file);
      $c->send_response( RC_OK );
    }else{
	$c->send_error( RC_NOT_FOUND, 'Alias not defined for given unit' );
    }
  }
}


sub process_unit_request{
  my( $r, $c, $unit ) = @_;

  if ( $r->method eq 'GET' ) {
    $c->send_response( new HTTP::Response(RC_OK, $unit) );

  }elsif( $r->method eq 'POST' ){
    print $r->content, "\n";
    if ( $r->content =~ /^action=(on|off|dim\s+(\d+)|bright\s+(\d+))$/ ) {
      my $action = $1;
      my $value  = $2;

      my $err = set_unit( $unit, $action, $value );
      if ( $err ) {
	$c->send_response( RC_INTERNAL_SERVER_ERROR, $err );
      } else {
	$c->send_redirect( $baseurl, RC_FOUND );
      }

    } else {
      $c->send_error(RC_BAD_REQUEST, "unknown method");
    }
  } elsif ( $r->method eq 'PUT' ) {
    if ( $r->content =~ /^(on|off|dim\s+(\d+)|bright\s+(\d+))$/ ) {
      my $action = $1;
      my $value  = $2;

      my $err = set_unit( $unit, $action, $value );
      if ( $err ) {
	$c->send_response( RC_INTERNAL_SERVER_ERROR, $err );
      } else {
	$c->send_response( RC_OK );
      }

    } else {
      $c->send_error(RC_BAD_REQUEST, "unknown method");
    }
  }
}

  sub process_root_request{
    my( $r, $c ) = @_;

    if ( $r->method eq 'GET' ) {
      $c->send_response( list_units( \@avail_housecodes,
				     $baseurl ) );
    }
  }

  sub process_aliases{
    my( $r, $c ) = @_;

    if ( $r->method eq 'GET' ) {
      $c->send_response( list_aliases( \@avail_housecodes,
				     $baseurl ) );
    }
  }

sub set_unit{
  my( $unit, $action, $value ) = @_;

  if( exists $aliases_rev->{lc $unit} ){
    $unit = $aliases_rev->{lc $unit};
    print "using alias for $unit\n";
  }

  print "br", $unit, $action, $value, "\n";
  my $retval;
  if ( $action eq "on" || $action eq "off") {
    $retval = system("br", $unit, $action );
  } elsif ( $action eq "bright" || $action eq "dim" ) {
    $retval = system( "br", $unit, $action, $value );
  }

  return ($retval == 0 ? undef : $! );
}

sub list_units{
  my( $housecodes, $baseurl ) = @_;
  my $body = "";

  $body .= "<ul>\n";
  foreach my $housecode (@$housecodes) {
    for ( my $i = 1; $i <= 16; $i++ ){
      my $unit = $housecode.$i;
      my $unit_alias = exists $aliases->{lc $unit} ?
			$aliases->{lc $unit} :
			$unit;
      my $url = $baseurl.'unit/'.uri_escape($unit_alias);

      $body .= "<li>\n";
      $body .= "<a href='$url'>".
	$unit_alias.
	  "</a>";
      $body .= "<form action='$url' method='POST'>\n";
      $body .= "<input type='submit' name='action' value='on'/>\n";
      $body .= "<input type='submit' name='action' value='off'/>\n";
      $body .= "<input type='submit' name='action' value='bright'/>\n";
      $body .= "<input type='submit' name='action' value='dim'/>\n";
      $body .= "</form>\n";
      $body .= "</li>\n";
    }
  }
  $body .= "</ul>\n";

  return basic_xhtml_skel( $body );
}

sub list_aliases{
  my( $housecodes, $baseurl ) = @_;
  my $body = "";

  $body .= "<ul>\n";
  foreach my $housecode (@$housecodes) {
    for ( my $i = 1; $i <= 16; $i++ ){
      my $unit = $housecode.$i;
      my $unit_alias = exists $aliases->{lc $unit} ?
			$aliases->{lc $unit} :
			$unit;
      my $url = $baseurl.'unit/'.$unit."/alias";

      $body .= "<li>\n";
      $body .= "<a href='$url'>".
	$unit_alias.
	  "</a>";
      $body .= "<form action='$url' method='POST'>\n";
      $body .= "<input type='text' name='alias'/>\n";
      $body .= "<input type='submit' name='action' value='set'/>\n";
      $body .= "<input type='submit' name='action' value='delete'/>\n";
      $body .= "</form>\n";
      $body .= "</li>\n";
    }
  }
  $body .= "</ul>\n";

  return basic_xhtml_skel( $body );
}

sub get_unit_url{
  my( $unit, $baseurl ) = @_;

}

sub basic_xhtml_skel{
  my( $body ) = @_;

  my $content =<<EOS;
<?xml version='1.0'?>
<html xmlns="http://www.w3.org/1999/xhtml">
  <head><title>X10 REST Server</title></head>
  <body>$body</body>
</html>

EOS

  my $response = new HTTP::Response( RC_OK, "Listing" );

  $response->header( 'Content-Type' => 'application/xhtml+xml' );
  $response->content( $content );

  return $response;

}

sub write_aliases{
  my($file) = @_;

  open ALIASES, ">$file" or die "cannot create aliases file: $!\n";

  foreach my $alias (sort keys %$aliases){
    print ALIASES "$alias = ".$aliases->{$alias}."\n";
  }
  close ALIASES;
}

sub read_aliases{
  my($file) = @_;

  my %aliases;
  my %aliases_rev;

  if( ! -f $file ){
    open ALIASES, ">$file" or die "cannot create aliases file: $!\n";
    print ALIASES<<EOS;
# aliases are in the format of:
# UNIT=ALIAS
# eg: E1 = main light

EOS

    close ALIASES;
  }

  open ALIASES, "<$file" or die "cannot read aliases file: $!\n";
  while( my $line = <ALIASES> ){
    # filter out comments
    $line =~ s/\#.+//;

    if( $line =~ /([a-pA-P]\d+)\s*\=\s*(.+?)\s*$/ ){
      # we want to be able to turn on/off units by alias, so they must
      # be unique.
      if( exists $aliases_rev{$2} ){
	warn "Alias '$2' already exists for unit '$aliases_rev{$2}'. Not redefining\n";
	next;
      }

      $aliases{lc $1}     = $2;
      $aliases_rev{lc $2} = $1;
    }
  }
  close ALIASES;

  return (\%aliases, \%aliases_rev);
}
#### helper subs

sub usage(){
    die <<USAGE;
usage: $0 [options]
 
options:
    -h          this help
    -V          print version information

Copyright(C) 2003 Steve Pomeroy <steve\@staticfree.info>
Licensed under the GNU GPL. See documentation for complete details.
USAGE

}

__END__