#!/opt/bin/perl

use Getopt::Long;

use PApp;
use PApp::Config ();
use PApp::SQL;
use PApp::XML qw(xml_quote xml_attr xml_tag xml_cdata);
use PApp::Util qw(dumpval); # debug#d#
use PApp::Event ();
use MIME::Base64;
use Convert::Scalar qw(utf8_valid);

use Agni;

sub do_some_tests {
   warn "heiheihei\n";#d#
   #my $vo = path_obj_by_gid 1, 783;
   #warn PApp::Util::dumpval($vo->{_content});
   #warn "hoiheihei\n";#d#
   #$vo->{_type}{content}->fetch($vo);
   #$vo->show_content;
   #(path_obj_by_gid 1, 5100000652)->show_content;
   local $Agni::debug=1;
   #my $o1 = path_obj_by_gid 1,5100000482;
   my $o1 = path_obj_by_gid 1,5100000016;
   warn PApp::Util::dumpval($o1->{_cache});
   exit;
   my $path = 3;
   my $t1 = Time::HiRes::time;
   my $customer = path_obj_by_gid $path, 5100000422;
   my $lg = path_obj_by_gid $path, 5100000420;
   my $us = path_obj_by_gid $path, 17180000071;
   my $t2 = Time::HiRes::time;
   warn $t2-$t1;
}

sub quote_attr($) {
   local $_ = $_[0];
   s/^/\t/gm;
   $_ = "\n$_\n    ";
   xml_cdata $_;
}

sub print_attr {
   my ($fh, $type, $data) = @_;

   my $encode = !utf8_valid $data || $data =~ /[\x{0}-\x{8}\x{b}\x{c}\x{e}-\x{1f}]/;

   print $fh "\n    ",
             (xml_tag "a",
                 type => $type,
                 $encode ? (base64 => "yes") : (),
                 defined $data
                    ? (length $data) < 30 && $data !~ y/a-zA-Z0-9_:\-$, //c
                       ? (value => $data, undef)
                       : ($encode
                          ? "\n" . (encode_base64 $data) . "    "
                          : quote_attr $data)
                    : (null => yes, undef));
}

sub parse_objects {
   my ($file) = @_;
   my @end;
   my $data;
   my @objs;
   my @paths;
   my ($o, $all);
   my @map_path;
   my %map_path;
   my $in_o;

   require XML::Parser::Expat;

   my $parser = new XML::Parser::Expat;
   $parser->setHandlers(
      Start => sub {
         shift;
         push @end, do {
            if ($_[0] eq "database" or $_[0] eq "image") {
               shift;
               my %a = @_;
               die "unsupported version '$a{version}'" if $a{version} != 1;
               sub { }
            } elsif ($_[0] eq "path") {
               shift;
               my %a = @_;
               my $id = $a{id};
               $data = "";
               sub {
                  push @paths, $data;
                  $map_path[$id] = $#paths;
               }
            } elsif ($_[0] eq "o") {
               shift;
               my %o = @_;
               $in_o and $parser->xpcroak ("nested <o> detected");
               $in_o = 1;
               $o = { gid => $o{gid}, attr => {} };

               if (exists $o{paths}) {
                  $o->{paths} = $map_path{$o{paths}} ||= do {
                     my $paths = "0";
                     for (split /,/, $o{paths}) {
                        defined $map_path[$_] or die "object (gid $gid, paths $o{paths}) references undeclared path $_";
                        $paths = Agni::or64 $paths, Agni::bit64 $map_path[$_];
                     }
                     $paths;
                  };
               }

               push @objs, $o;
               sub {
                  $in_o = 0;
               }
            } elsif ($_[0] eq "a" or $_[0] eq "m") {
               shift;
               $data = "";
               %m = @_;
               sub {
                  $data =~ s/^\n//; $data =~ s/\n?    $//; $data =~ s/^\t//gm;
                  undef $data if exists $m{null};
                  $data = decode_base64($data) if exists $m{base64};
                  $data = $m{value} if exists $m{value};
                  $o->{attr}{$m{type}} = $data;
               }
            } else {
               $parser->xpcroak("$file illegal element <$_[0]> found");
            }
         }
      },
      End => sub {
         &{pop @end};
      },
      Char => sub {
         $data .= $_[1];
      },
   );
   eval {
      $parser->parsefile($file);
   };
   $parser->release;
   $@ and die;

   (\@paths, \@objs);
}

sub save_image {
   my ($file) = @_;
   my $fh;
   defined $file and do { open $fh, ">", $file or die "can't create '$file': $!" };
   $fh ||= \*STDOUT; 

   print $fh xml_tag("image", version => '1'),
             "\n\n";

   sql_exec Agni::lock_all_tables "obj_path";

   my %map_path; # mask => list
   my @map_path;
   my @pathids;

   my $st = sql_exec \my($id, $path),
                     "select id, path from obj_path order by path";

   while ($st->fetch) {
      push @pathids, $id;
      $map_path[$id] = $#pathids;
      print $fh xml_tag "path", id => $#pathids, xml_quote $path;
      print $fh "\n";
   }
   print $fh "\n";

   my $st = sql_exec \my($id, $gid, $paths),
   		     "select id, gid, paths
                      from obj
                      order by gid, paths";

   while($st->fetch) {
      $paths
         = $map_path{$paths}
            ||= join ",",
               sort
                  map $map_path[$_],
                     grep { Agni::and64 $paths, Agni::bit64 $_ } sort @pathids;

      print $fh xml_tag("o", gid => $gid, paths => $paths);
      for my $table (@Agni::sqlcol) {
         my $st = sql_exec \my($type, $data),
                           "select type, data
                            from $table where id = ?
                            order by type",
                           $id;

         while ($st->fetch) {
            print_attr $fh, $type, $data;
         }
      }
      print $fh "\n</o><!--$paths/$gid-->\n\n\n";
   }
   print $fh "</image>\n\n";
   sql_exec "unlock tables"; 
}

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

   my ($paths, $objs) = parse_objects $file;

   my %sqlcol;

   # do upgrade translation
   my %replace = (
      "string", "d_string",
      "text",   "d_blob",
      "int",    "d_int",
      "double", "d_double",
   );
   @replace{@Agni::sqlcol} = @Agni::sqlcol;
   
   # gather info
   for (@$objs) {
      if (exists $_->{attr}{$Agni::OID_ATTR_SQLCOL}) {
         # first upgrade old sqlcol values
         $_->{attr}{$Agni::OID_ATTR_SQLCOL} = $sqlcol{$_->{gid}} = $replace{$_->{attr}{$Agni::OID_ATTR_SQLCOL}};

         $sqlcol{$_->{gid}} = $_->{attr}{$Agni::OID_ATTR_SQLCOL};
      }
   }

   # check attr consistency
   for (@$objs) {
      if (my @extra = grep !exists $sqlcol{$_}, keys %{$_->{attr}}) {
         die "object $_->{paths}/$_->{gid} references types (@extra) not in dump";
      }
   }

   sql_exec Agni::lock_all_tables "obj_path";

   for my $table ("obj", "obj_path", @Agni::sqlcol) {
      sql_exec "delete from $table";
      sql_exec "alter table $table disable keys";
   }

   # create paths
   for my $id (0 .. $#$paths) {
      sql_exec "insert into obj_path (id, path) values (?, ?)", $id, $paths->[$id];
   }

   # create objects and attrs
   for (@$objs) {
      $_->{id} = Agni::insert_obj undef, $_->{gid}, $_->{paths};
      while (my ($type, $value) = each %{$_->{attr}}) {
         sql_exec "insert into $sqlcol{$type} (id, type, data) values (?, ?, ?)",
                  $_->{id}, $type, $value;
      }
   }

   PApp::Event::broadcast agni_update => [&Agni::UPDATE_PATHS];
   PApp::Event::broadcast agni_update => [&Agni::UPDATE_ALL];

   for my $table ("obj", "obj_path", @Agni::sqlcol) {
      sql_exec "alter table $table enable keys";
      sql_exec "optimize table $table";
   }

   sql_exec "unlock tables";
}

sub export_path {
   my ($path,$file) = @_;
   my $fh;
   defined $file and do { open($fh, ">", $file) or die "can't create '$file': $!" };
   $fh ||= \*STDOUT; 

   die "no such path '$path'" unless sql_exists "obj_path where path = ?", $path;
   
   print $fh xml_tag("database", version => '1', path => $path),
             "\n\n";

   sql_exec Agni::lock_all_tables;

   my $st = sql_exec \my($id, $gid, $paths),
   		     "select obj.id, gid, paths
                      from obj
                      where paths & (1 << ?) <> 0 and paths & ? = 0
                      order by gid, paths",
                     $pathid{$path}, $parpathmask[$pathid{$path}];

   while($st->fetch) {
      print $fh xml_tag("o", gid => $gid);
      for my $table (@Agni::sqlcol) {
         my $st = sql_exec \my($type,$data),
                           "select type, data
                            from $table where id = ?
                            order by type",
                           $id;

         while ($st->fetch) {
            print_attr $fh, $type, $data;
         }
      }
      print $fh "\n</o>\n\n\n";
   }
   print $fh "</database>\n\n";
   sql_exec "unlock tables"; 
}

sub import_path {
   my ($path, $file) = @_;

   Agni::newpath $path;#d# should not be done automatically
      print STDERR "WARNING: paths should not be created automatically\n";#d#

   my $pathid = $pathid{$path};
   die "no such path '$path'" unless defined $pathid;

   my ($paths, $objs) = parse_objects $file;

   @$paths and die "file contains paths attributes, might be an image file. not imported.";

   Agni::import_objs($objs, $pathid, 0);
}

sub garbage_collect {
   my $ids = Agni::find_dead_objects;

   if (@$ids) {
      #print "DEAD OBJECTS: ".(join " ", sort @$ids)."\n";
      print "DELETING OBJECTS: ".(join " ", sort @$ids)."\n";
      #$|=1;
      #print "delete (y/n)?";
      #if (<STDIN> =~ /^y/i) {
         Agni::mass_delete_objects $ids;
      #}
   }
}

sub paths {
   for (@Agni::pathname) {
      printf "%2d %s\n", $Agni::pathid{$_}, $_;
   }
}

sub exec_cmd {
   my ($path, @cmd) = @_;

   local $PApp::NOW = time;

   die "no such path '$path'" unless defined $Agni::pathid{$path};
   
   my $cmdline = path_obj_by_gid($Agni::pathid{$path}, $Agni::OID_CMDLINE_HANDLER);

   print $cmdline->command(@cmd);

}

sub usage {
   print STDERR <<EOF;
Usage: $0 ...

   --app id|name                 use specified application instead of "mercury"
   --file file                   write output to file or read input from file
   --daemon            	         go into daemon mode
   -i | --interval <seconds>
   --export-path path            write path to file (or stdout)
   --import-path path            import path from file

   --gar                         starts garbagecollector

   --paths                       show paths
   --newpath <path>              creates a new path
   
   -e | --exec-cmd path command  executes a command as defined in util::cmdline
                                 path specifies the path to the object.

EOF
   exit 1;
}

Getopt::Long::Configure ("bundling", "no_ignore_case");

my @exec;
my $fn;

GetOptions(
   "file=s" => sub { $fn = $_[1] },
   "interval|i=i" => sub {
      $interval = shift;
   },
   "daemon" => sub {
      push @exec, sub {
         do {
            runq;
            sleep $interval;
         } while $interval;
      };
   },
   "init-db" => sub {
      push @exec, sub { Agni::init_db };
   },
   "save-image=s" => sub {
      my $path = $_[1]; push @exec, sub { save_image $path };
   },
   "load-image=s" => sub {
      my $path = $_[1]; push @exec, sub { load_image $path };
   },
   "export-path=s" => sub {
      my $layer = $_[1]; push @exec, sub { export_path $layer, $fn };
   },
   "import-path=s" => sub {
      my $path = $_[1]; push @exec, sub { import_path $path, $fn };
   },
   "garbage-collect" => sub {
      push @exec, \&garbage_collect;
   },
   "newpath=s" => sub {
      my $path = $_[1]; push @exec, sub { Agni::newpath $path };
   },
   "paths" => sub {
      push @exec, \&paths;
   },
   "test:s" => sub {
      my $arg = $_[1]; push @exec, sub { do_some_tests($arg) };
   },
   "exec-cmd|e=s" => sub {
      my $path = $_[1]; push @exec, sub { exec_cmd $path, @ARGV } ;
   }
) or usage;

@exec or usage;

local $PApp::SQL::Database = PApp::Config::Database;
local $PApp::SQL::DBH      = PApp::Config::DBH;

&{shift @exec} while @exec;

