#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
# drupal_sync -- Drupal::REST application for importing/exporting files
#
# 2012-05-10, V0.1 jw@suse.de - initial draught

use Data::Dumper;
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use FindBin;
use lib "$FindBin::RealBin/blib/lib";
use Drupal::REST;

my $version = $Drupal::REST::VERSION;
#my %opt = ( server => 'http://activedoc.suse.de/activedoc/rest1' );
my %opt = ( server => 'http://cthulhu.suse.cz/activedoc/rest1' );

GetOptions(
	"verbose|v+"   	=> \$opt{verbose},
	"version|V"    	=> sub { print "$version\n"; exit },
	"quiet"        	=> sub { $opt{verbose} = 0; },
	"username|U=s" 	=> \$opt{username},
	"password|P=s" 	=> \$opt{password},
	"cookiejar|C=s" => \$opt{cookiejar},
	"serverurl|S=s" => \$opt{server},
	"help|?"      	=> \$help
) or $help++;
my $cmd = shift or $help++;
$help++ if $cmd and $cmd !~ m{^(GET|get_node|import|list)$}i;

pod2usage(-verbose => 1, -msg => qq{
drupal_sync V$version Usage: 

$0 [options] CMD [ARGS..]

Valid options are:
 -v	Be more verbose. Default: $opt{verbose}.
 -q     Be quiet, not verbose.

 -U --username USER
 -P --password PASS
 -S --serverurl URL
 -C --cookiejar COOKIEFILE

 -h --help -?
        Print this online help.

Commands are:
  GET	/RELATIVE_URL
     Run an http GET raw. Print the result.

  list [type=article|type=book title='.*SLMS.*']
     Retrieve a list of nodes.

  fetch	NODEID
     Retrieve contents of a node.

  import FILENAME.html [as NODEID]
     Push an html file into drupal. Specify a Drupal NODEID if you want to update 
     or overwrite an existing node. Otherwise Drupal will create a new node.
    
}) if $help;

my $d = Drupal::REST->new(%opt);

if (uc($cmd) eq 'GET')
  {
    my $json = $d->raw_GET(url => shift);
    die Dumper $json;
  }
elsif ($cmd eq 'list')
  {
    my %args = ();
    for my $arg (@ARGV)
      {
        if ($arg =~ m{^(\w+)=(.*)$})
	  {
	    $args{$1} = $2;
	  }
	else
	  {
	    die "malformed arg: '$arg'. Expected format: KEY=VALUE\n";
	  }
      }
    my $json = $d->list(%args);
    die 'bad response: ' . Dumper $json unless ref $json eq 'ARRAY';
    for my $e (sort { ($a->{nid}||0) <=> ($b->{nid}||0) } @$json)
      {
        ## can we see the parent node id here too??
        # printf("node:%-4d ctime:%10d mtime:%10d '%s'\n", 
	#         $e->{nid}||0, $e->{created}||0, $e->{changed}||0, $e->{title}||'');
        printf("node:%-4d type:%-8s '%s'\n", 
	        $e->{nid}||0, $e->{type}||0, $e->{title}||'');
      }
  }
elsif ($cmd eq 'get_node')
  {
    my $node = shift;
    $node =~ s@^/?node/@@;
    die "node needs to be /node/NNN or simply numeric NNN\n" unless $node =~ m{^\d+$};
    my $json = $d->get_node(nid => $node);
    die Dumper $json;
  }
elsif ($cmd eq 'import')
  {
    my $text = slurp_file($ARGV[0]);
    if (lc($ARGV[1]) eq 'as')
      {
        
      }
    my $status = $d->import_html($ARGV[0], $node);
    print Dumper $status;
  }
else
  {
    die Dumper $d;
  }

exit 0;

sub slurp_file
{
  my ($name) = @_;
  open IN, "<", $name or die "slurp_file: cannot open $name: $!\n";
  my $text = join '', <IN>;
  return $text;
}
