package GNS::Node;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use IO::Scalar;
use IO::File;

use POSIX;
use LWP::Simple;

use Safe;

use GNS::User;
use GNS::DB;
use GNS::Cache;

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw( );
$VERSION = '0.1';

######################################################################
+########

## several globals we use
use vars qw( $db $error $cache);
## our list of fields
my @fields=qw( id p_id date modified expires user_id mimetype type pri
+vate 
           reader_ids writer_ids exclude_ids
           description title body );

## the types of node's we understand so far (some are handled internal
+ly, some aren't)
## this list is not definitive. Userspace apps can use any type they w
+ant. 
my @types=qw ( file text perl url link chat home );
## the account that can't do shit 
## (quasi-artifact -- I use a different set of checks)
my $dead_account='nobody-x';
######################################################################
+########
## some initialization
$db=new GNS::DB || die "Couldn't access DB server: $!";
## just to make sure $cache is empty
undef $cache;

######################################################################
+########
## non class stuff


## link handeling stuff
##  the default link-replacement handler.
sub default_link {
  my $name=shift;
  my $link=shift;

  if (my $id=$db->diysval("select id from node where title like \"\Q$l
+ink\E\"")) {
    return "$name($id)";
  }

  $name;
}

my %callbacks=(
           link => \&default_link,
           );

## we allow the userspace program to interpret links
sub setlinkcallback {
  $callbacks{link}=shift;
}

##   handles the replacement of links in a body.
sub makelinks {
  my $txt=shift;

  while ($txt=~/\[(.+?)\]/m) {
    my $old=$1;
    my $link;
    my $name;

    if ($old=~/(.+)\|(.+)/) {
      $name=$2;
      $link=$1;
    }
    else {
      $link=$old;
      $name=$link;
    }

    my $new;

    ## alright, the link might contain a special character
    ## at the start of the string. It could be
    ##
    ## # which means it's a node number
    ## < which means to inplace display the node (which could be <#382
+ or <new nodes)
    ##   
    ## * which is an external URL reference (which has to be handled b
+y the userspace program)
    ## 
    
    ## okay, some stuff is handled internally
    ## if the begining of the "link" is a "<" sign, it
    ## means to resolve the node in-place
    if ($link=~/^\<(.+)/) {
      my $rest=$1;
      ## next bit will be a name or "# number"
      if ($rest=~/^\#(.+)/) {
    my $id=$1;
    my $node=new GNS::Node(id=>$id);

    if ($node) {
      local $_;
      $new.=$_ while $_=$node->body;
    }
    else {
      ### hmm error
      $new="($error)";
    }
      }
      else {
    ## not a number, must be a search string
    my @ids=search($rest);

    ## only inplace if there is an exact match
    if ($#ids!=0) {
      $new="(too many results)";
    }
    else {
      ## get that node
      my $node=new GNS::Node(id => $ids[0]);
      if ($node) {
        local $_;
        $new.=$_ while $_=$node->body;
      }
      else {
        ### hmm error
        $new="($error)";
      }
    }
      }
    }
    ## everything else is handled by the userspace callback
    else {
      $new=&{$callbacks{link}}($name,$link);
    }

    $txt=~s/\Q[$old]\E/$new/;
  }

  $txt;
}


## and some generic routines
## (not used)
sub inlist {
  my $id=shift;
  my @list=split /[\s+,:;]/,shift;

  for my $x (@list) {
    return 1 if $x eq $id;
  }
  return;
}

## *_ids aren't numberic, they are now usernames
sub inlist2 {
  my $user=shift;
  my @list=split /[\s+,:;]/,shift;

  for my $x (@list) {
    my $u=new GNS::User(name => $x);

    return 1 if $u->{id} == $user->{id};
  }
  return;
}


## does the passed user have read access to this node?
sub canread {
  my $node=shift;
  my $user=shift;

  if ($node->{user_id} == $user->{id}) {
    return 1;
  }

  ## if in exclude, bye!
  if (inlist2($user,$node->{exclude_ids})) {
    $error="You are excluded from this node";
    return;
  }

  ## check to see if this user is in the reader_ids list
  if (inlist2($user,$node->{reader_ids})) {
    return 1;
  }
  if ($node->{private} eq 'Y') {
    $error="Cannot read node, private";
    return;
  }

  return 1;
}

## can this user write to this node?
sub canwrite {
  my $node=shift;
  my $user=shift;

  if (!$node || !$user) {
    $error="Parameter error to canwrite";
    return;
  }
  
  if ($node->{user_id} == $user->{id}) {
    return 1;
  }
  ## if in exclude, bye!
  if (inlist2($user,$node->{exclude_ids})) {
    $error="You are excluded from this node";
    return;
  }
  ## check to see if this user is in the writer_ids list
  if (inlist2($user,$node->{writer_ids})) {
    return 1;
  }

  $error="Cannot write node, not owner";

  return;
}

sub fields {
  return @fields;
}
sub error {
  return $error;
}
sub types {
  return @types;
}
sub mimetypes {
  my @mime;

  open IN,"</etc/mime.types" || return;
  while (<IN>) {
    next if /^\#/;
    next if /^\s*$/;
    push @mime,$1 if /^([^\s]+)/;
  }
  close IN;

  @mime;
}

## converts the arrayref into a simple hash reference
sub arraytohash {
  my $node=shift;
  my $newnode={};

  for my $fn (0..$#fields) {
    $newnode->{$fields[$fn]}=$node->[$fn];
  }

  $newnode;
}

## gets a raw node (no translations/executions)
sub getrawnode {
  my $id=shift;
  my $user=new GNS::User( this => 1);
  
  if (! defined $user) {
    $error=GNS::User::error();
    return;
  }
  
  if (! $id) {
    $error="No ID passed to getrawnode";
    return undef;
  }
  
  #  ## cache (must be careful, check for security here also)
  if ($cache) {
    if (my $c=$cache->check($id)) {
      if (!canread($c,$user)) {
    ## we fake the node not being there for people who can't read
    $error="Node $id not found";
    return;
      }
      return $c;
    }
  }
  my $rawnode;
  
  $rawnode=$db->diys("select ".join(",",@fields)." from node where id 
+= $id");
  
  my $node;
  
  if (defined $rawnode && defined $rawnode->[0]) {
    $node=arraytohash($rawnode->[0]);
    
    if (!canread($node,$user)) {
      $error="Node $id not found";
      return;
    }
  }
  else {
    $error="Node $id not found";
    return;
  }
  
  $cache->insert($id,$node) if $cache;
  $node;
}

## returns an array of ids
sub search {
  my $term=shift;

  if (! defined $term) {
    $error="No search term specified";
    return undef;
  }

  my $user=new GNS::User(this=>1);

  if (! defined $user) {
    $error=GNS::User::error();
    return;
  }

  ## check for exact match
  my $id=$db->diysval("select id from node where title like \"\Q$term\
+E\"");
  return $id if $id;

  ## okay, we need to construct a statement
  my @buf;
  my @words=split /\s+/,$term;
  
  for my $w (@words) {
    push @buf,"( body rlike \"\Q$w\E\" or title rlike \"\Q$w\E\" )";
  }

  my $rawnodes=$db->diys("select id from node where ".
             join(" and ",@buf).
             " order by date desc limit 100");

  if (! defined $rawnodes || ! defined $rawnodes->[0]) {
    $error="No node matching search found";
    return;
  }

  my @results;

  ## go through and make sure this user can read these nodes
  for my $n (@$rawnodes) {
    my $ah=getrawnode($n->[0]);
    next unless $ah;
    push @results,$n->[0];
  }
  
  @results;

}

## a generic select function
sub selectnodes {
  my $where=shift;

  if (!$where) {
    $error="No where passed to selectnodes";
    return;
  }

  my $nodes=$db->diys("select id from node where $where");
  my @results;

  if ($nodes && $nodes->[0]) {
    for my $n (@$nodes) {
      ## do this for security's sake
      my $node=getrawnode($n->[0]);
      push @results,$node->{id} if $node;
    }
  }
  else {
    $error="Nothing found where $where";
    return;
  }

  @results;
}

sub expirenodes {
  my $time=time;
  my $nodes=$db->diys("select id from node where ".
                      "( modified > 0 and expires > 0 and expires + mo
+dified < $time )".
                      " or ".
                      "( modified = 0 and expires > 0 and expires + da
+te < $time )");

  my @todie;
  ## don't expire anything that has children
  for my $n (@$nodes) {
    push @todie,$n->[0] unless $db->diysval("select id from node where
+ p_id = $n->[0]");
  }

  ## kill all in @todie
  for my $i (@todie) {
    $db->diys("delete from node where id = $i");
  }
}

expirenodes;

######################################################################
+########


######################################################################
+########
sub new {
  my $class=shift;
  my %args=@_;
  my $self={ };

  ## parse any arguments
  if (defined $args{id}) {
    ## preloaded with an ID
    my $node=getrawnode($args{id});

    ## and it worked?
    if (!$node) {
      return;
    }

    ## and make it an instance of this class
    $self=$node;
  }
  elsif (defined $args{reply}) {
    ## set this up as a reply to the node ID passed
    my $node=getrawnode($args{reply});

    if (!$node) {
      ## well damn
      return;
    }
    ## do it by copying various information
    $self->{p_id}=$node->{id};

    for my $f (qw(private readers_id type mimetype expires)) {
      $self->{$f}=$node->{$f} if defined $node->{$f};
    }

    ## and some tweaks
    ## homenode replies don't remain homenodes
    $self->{type}="text" if $node->{type} eq 'home'; 

    ## the title is special
    if ($node->{title}!~/^re:/i) {
      $self->{title}="re: $node->{title}";
    }
    else {
      $self->{title}=$node->{title};
    }
  }
  else {
    $self->{type}='text';
    $self->{mimetype}='text/html';
    $self->{title}="(untitled)";
  }

  bless $self,$class;

  $self;
}

#############
sub body {
  my $self=shift;
  my $buff;

  ## if there is a filehandle already, it's been opened and ready
  if (defined $self->{fh}) {
    ## return a block of information
    if (sysread($self->{fh},$buff,1024)) {
      return $buff;
    }
    else {
      ## failed, close the handle and quit
      delete $self->{fh};
      return;
    }
  }
  ## or a simple flag for simple bodies
  elsif (defined $self->{retrieved}) {
    delete $self->{retrieved};
    return;
  }

  ## okay, 
  if ($self->{type} eq 'file') {
    ## create a file handle for this file
    my $fh=new IO::File;
    ## try to open the file
    if (!$fh->open($self->{body})) {
      ## hmm, that failed
      $error="Unable to open file: $!";
      return;
    }
    ## we're good
    $self->{fh}=$fh;

    ## return the first block
    return $self->body;
  }
  elsif ($self->{type} eq 'perl') {
    local *FH;
    my $fh;
    tie (*FH,'IO::Scalar',\$fh);
    my $oldfh=select FH;

    ## okay, we'll cheat for me
    if ($self->{user_id}==1) {
      eval $self->{body};
    }
    else {
      my $safe=new Safe;
      $safe->reval($self->{body});
    }

    select $oldfh;

    $self->{retrieved}=1;
    return $@.$fh;
  }
  else {
    ## simple body, just return it
    $self->{retrieved}=1;
    return makelinks($self->{body});
  }
}

sub childrenids {
  my $self=shift;
  my $childs=$db->diys("select id from node where p_id = $self->{id} o
+rder by date");

  ## not really an error
  if (! defined $childs) {
    $error="No children found";
    return;
  }

  my @results;
  my $user=new GNS::User(this=>1);

  if (! defined $user) {
    $error=GNS::User::error();
    return;
  }

  for my $n (@$childs) {
    ## security again
    my $ah=getrawnode($n->[0]);
    next unless $ah;
    push @results,$n->[0];
  }
  
  return if $#results==-1;

  @results;
}

sub change {
  my $self=shift;
  my $new=shift;
  my $user=new GNS::User(this=>1);
  
  ## check a couple of things here
  if (!$user) {
    $error=GNS::User::error;
    return;
  }
  
  ## also chekc $dead_account
  if ($user->{name} eq $dead_account) {
    $error="Access denied";
    return;
  }
  
  ## can this user write to this node?
  if ($user->{id}==$self->{user_id} ||
      canwrite($self,$user)) {
    ## sure can
  }
  else {
    $error="You may not write to this node";
    return;
  }
  
  ## check the ID
  if (!getrawnode($self->{id})) {
    $error="This node no longer exists";
    return;
  }
  
  ## update modified
  $self->{modified}=time;
  
  my @buf;
  
  ## okay, change the values
  for my $f (@fields) {
    ## but ignore certain ones
    next if $f eq 'id';
    next if $f eq 'date';
    next if $f eq 'user_id';
    
    ## quote the string
    my $str="\Q$new->{$f}\E";
    ## but change any \% back to %
    $str=~s/\\%/%/g;
    
    push @buf,"$f = \"$str\"";
  }
  
  my $buf="update node set ".join(", ",@buf)." where id = $self->{id}"
+;
  
  $cache->purge if $cache;
  
  $db->diys($buf);
  
  $self->{id};
}

sub add {
  my $self=shift;
  my $user=new GNS::User(this=>1);

  ## check a couple of things here
  if (!$user) {
    $error=GNS::User::error;
    return;
  }

  ## also chekc $dead_account
  if ($user->{name} eq $dead_account) {
    $error="Access denied";
    return;
  }

  $cache->purge if $cache;

  ## if the p_id is not readable, can't reply
  if ($self->{p_id}) {
    my $p=new GNS::Node(id => $self->{p_id});
    ## the above checks readness automatically
    if (!$p) {
      $error="You may not reply to that node";
      return;
    }
  }

  ## set stuff
  $self->{date}=time;
  $self->{user_id}=$user->{id};
  $self->{type}='text' unless defined $self->{type};
  $self->{mimetype}='text/plain' unless defined $self->{type};

  my @fie;
  my @val;


  ## okay, change the values
  for my $f (@fields) {
    ## but ignore certain ones
    next if $f eq 'id';
    ## quote the string
    my $str="\Q$self->{$f}\E";
    ## but change any \% back to %
    $str=~s/\\%/%/g;
    
    push @fie,$f;
    push @val,"\"$str\"";
  }

  my $buf="insert into node (".join(",",@fie).") values (".join(",",@v
+al).")";

  $db->diys($buf);

  $db->diysval("select LAST_INSERT_ID()");
}

sub deletenode {
  my $self=shift;

  ## make sure this user can delete, 
  my $user=new GNS::User(this=>1);

  if (!$user) {
    $error=GNS::User::error();
    return;
  }

  if (!canwrite($self,$user)) {
    $error="You may not delete this node";
    return;
  }

  $db->diys("delete from node where id = $self->{id}");

  ## now, if this node has children, and this one a parent, move those
+ children to the parent
  ## if no parent, then they become rooties (pid of 0)
  my $newpid=0;

  $newpid=$self->{p_id} if defined $self->{p_id};

  $db->diys("update node set p_id = $newpid where p_id = $self->{id}")
+;

  1;
}
  

######################################################################
+########
1;
__END__