#!/usr/bin/env perl

# Copyright (C) 2008  Joshua Hoblitt
#
# $Id: neb-xattr,v 1.7 2008-05-27 21:03:50 jhoblitt Exp $

use strict;
use warnings FATAL => qw( all );

use vars qw( $VERSION );
$VERSION = '0.01';

use Nebulous::Client;

use Getopt::Long qw( GetOptions :config auto_help auto_version );
use Pod::Usage qw( pod2usage );

my ($server, $delete, $write);

$server = $ENV{'NEB_SERVER'} unless $server;

GetOptions(
    'server|s=s'    => \$server,
    'delete|d'      => \$delete,
    'write|w'       => \$write,
) || pod2usage( 2 );

my $key = shift;

#pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
pod2usage( -msg => "Required options: --server", -exitval => 2 )
    unless $server;
pod2usage( -msg => "missing nebulous key", exitval => 2 )
    unless defined $key;
pod2usage( -msg => "--delete and --write can not be combined", exitval => 2 )
    if defined $delete and defined $write;

my $neb = Nebulous::Client->new(
    proxy => "$server",
);

die "can't connect to Nebulous Server: $server"
    unless defined $neb;

# -d flag means delete the list of xattrs from key
if (defined $delete) {
    die "--delete requires a list of xattr names" unless scalar @ARGV;
    delete_xattrs($neb, $key, @ARGV) or die;
    exit(0);
}

# key with xattr:value pair and -w flag means write/overwrite xattr:value
if (defined $write) {
    die "--write requires a list of xattr:value pairs" unless scalar @ARGV;
    write_xattrs($neb, $key, @ARGV) or die;
    exit(0);
}

# key without xattr name list means print all xattr:value pairs
if (not scalar @ARGV) {
    print_all_xattrs($neb, $key) or die;
    exit(0);
}

# key with xattr name list means print the xattr:value pairs
print_xattrs($neb, $key, @ARGV) or die;
exit(0);

sub print_all_xattrs
{
    my ($neb, $key) = @_;

    return unless defined $neb;
    return unless defined $key;

    my $xattr_names = $neb->listxattr($key) or die $neb->err;
    foreach my $name (@$xattr_names) {
        print_xattrs($neb, $key, $name) or return;
    }

    return 1;
}


sub print_xattrs
{
    my ($neb, $key, @xattr_names) = @_;

    return unless defined $neb;
    return unless defined $key;
    return unless scalar @xattr_names;

    foreach my $arg (@xattr_names) {
        my ($name, $value) = parse_xattr_pair($arg);
        die "can not process $arg because it is in name:value form"
            if defined $value;
        $value = $neb->getxattr($key, $name) or die $neb->err;
        print "$name:$value\n";
    }

    return 1;
}


sub write_xattrs
{
    my ($neb, $key, @xattr_pairs) = @_;

    return unless defined $neb;
    return unless defined $key;
    return unless scalar @xattr_pairs;

    foreach my $arg (@xattr_pairs) {
        my ($name, $value) = parse_xattr_pair($arg);
        die "can not process $arg because it is not in name:value form"
            unless defined $name and defined $value;
        die "xattr name: $name is not in to the form user.name"
            unless $name =~ /^user\./;
        $neb->setxattr($key, $name, $value, "replace")
            or die $neb->err;
    }

    return 1;
}


sub delete_xattrs
{
    my ($neb, $key, @xattr_names) = @_;

    return unless defined $neb;
    return unless defined $key;
    return unless scalar @xattr_names;

    foreach my $arg (@xattr_names) {
        my ($name, $value) = parse_xattr_pair($arg);
        die "can not process $arg because it is in name:value form"
            if defined $value;
        $neb->removexattr($key, $name)
            or die $neb->err;
    }

    return 1;
}


sub parse_xattr_pair
{
    my $pair = shift;
    
    return unless defined $pair;

    no warnings qw( uninitialized );
    my ($name, $value) = split(/:/, $pair);
    use warnings;

    return ($name, $value);
}


__END__

=pod

=head1 NAME

neb-xattr - create an empty file

=head1 SYNOPSIS

    neb-xattr [--server <URL>] [--write] <key> [<xattr name>[:<value>]...]

=head1 DESCRIPTION

This program creates an empty file with the Nebulous key of C<<key>>.  At some
point in the future it will be able to adjust the timestamp of storage
instances assosiated with a Nebulous key similar to C<xattr(1)>.

=head1 OPTIONS

=over 4

=item * --server|-s <URL>

URL of the Nebulous server to connect to.

Optional if the appropriate environment variable is set.

=item * --volume <volume name>

Symbolic name of the volume to create the first instance on.

Optional.

=back

=head1 ENVIRONMENT

These environment variables may be used in place of the specified command line
options.  All command line option will override the corresponding environment
value.

=over 4

=item * C<NEB_SERVER>

Equivalent to --server|-s

=back

=head1 CREDITS

Just me, myself, and I.

=head1 SUPPORT

Please contact the author directly via e-mail.

=head1 AUTHOR

Joshua Hoblitt <jhoblitt@cpan.org>

=head1 COPYRIGHT

Copyright (C) 2007-2008  Joshua Hoblitt.  All rights reserved.

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA  02111-1307, USA.

The full text of the license can be found in the L<perlgpl> Pod as supplied
with Perl 5.8.1 and later.

=head1 SEE ALSO

L<Nebulous::Server>, L<neb-initdb>, L<neb-addvol>, L<nebdiskd>, L<neb-df>

=cut
