#!/usr/bin/env perl

# Copyright (C) 2005-2008  Joshua Hoblitt
#
# $Id: neb-admin,v 1.14 2008-10-16 22:24:39 jhoblitt Exp $

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

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

use DBI;
use Net::Server::Daemonize qw( check_pid_file create_pid_file unlink_pid_file );
use URI;

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

my (
    $db,
    $dbhost,
    $dbpass,
    $dbuser,
    $limit,
    $pending,
    $removal,
    $verbose,
);

$db     = $ENV{'NEB_DB'};
$dbhost = $ENV{'NEB_DBHOST'} || 'localhost';
$dbuser = $ENV{'NEB_USER'};
$dbpass = $ENV{'NEB_PASS'};

GetOptions(
    'db|d=s'                => \$db,
    'host=s'                => \$dbhost,
    'user|u=s'              => \$dbuser,
    'pass|p=s'              => \$dbpass,
    'pendingreplicate|r'    => \$pending,
    'pendingremoval'        => \$removal,
    'limit|l=i'             => \$limit,
    'verbose|v'             => \$verbose,
) || pod2usage( 2 );

pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV;
pod2usage( -msg => "Required options: --db --user --pass", -exitval => 2 )
    unless $db && $dbuser && $dbpass;
pod2usage( -msg => "--limit is meaningless without --pendingreplicate",
        -exitval => 2 )
    if defined $limit and not defined $pending;
pod2usage( -msg => "no operation specified", -exitval => 2 )
    unless defined $pending or defined $removal;

# set default limit to 5
$limit ||= 5;

# check to make sure that only one instance of neb-admin is running
my $pidfile = '/var/tmp/neb-admin';
# abort if an instance is already running
END { unlink_pid_file($pidfile) };
check_pid_file($pidfile);
create_pid_file($pidfile);

my $dbh = DBI->connect(
    "DBI:mysql:database=$db:host=$dbhost",
    $dbuser,
    $dbpass,
    {
        RaiseError => 1,
        PrintError => 0,
        AutoCommit => 1,
    },
);

if ($pending) {
    pending();
} elsif ($removal) {
    removal();
} else {
    die "THIS SHOULD NOT HAPPEN";
}

sub pending
{
# so_id, ext_id, instances, available_instances, need_recovery, recoverable
    $dbh->do("CREATE TEMPORARY TABLE mymountedvol LIKE mountedvol");
    $dbh->do("INSERT INTO mymountedvol SELECT * FROM mountedvol");
    $dbh->do("CREATE TEMPORARY TABLE myvolume LIKE volume");
    $dbh->do("INSERT INTO myvolume SELECT * FROM volume");

    my $query = $dbh->prepare(
    "        SELECT
                storage_object.so_id,
                ext_id,
                count(ins_id) as instances,
                myvolume.name as volume_name,
                myvolume.host as volume_host,
                count(mymountedvol.vol_id) as available_instances,
                count(mymountedvol.vol_id) > 0 as recoverable,
                storage_object_xattr.value as copies
            FROM storage_object
            JOIN instance
                USING(so_id)
            JOIN myvolume
                USING(vol_id)
            LEFT JOIN storage_object_xattr
                ON storage_object.so_id = storage_object_xattr.so_id
            JOIN mymountedvol
                USING(vol_id)
            WHERE mymountedvol.available = 1
    --        WHERE storage_object_xattr.name = 'user.copies'
            GROUP BY so_id
            HAVING available_instances < instances OR instances < copies
            LIMIT $limit"
    );
    $query->execute;

    $dbh->do("DROP TABLE IF EXISTS mymountedvol");

    my @rows;
    while (my $row = $query->fetchrow_hashref) {
        push @rows, $row;        
    }
    $query->finish;
        
    exit unless scalar @rows;

    print "replicatePending MULTI\n\n";

    foreach my $obj (@rows) {
        if (defined $verbose) {
            require Data::Dumper;
            print Data::Dumper::Dumper($obj);
        }

        my $so_id = $obj->{so_id};
        my $key = $obj->{ext_id};
        my $has = $obj->{instances};
        my $vol_name = $obj->{volume_name};
        my $vol_host = $obj->{volume_host};
        my $available = $obj->{available_instances} || 0;
        my $need_recovery = $obj->{need_recovery};
        my $recoverable = $obj->{recoverable};
        # if the copies xattr is unset and the object has 2 or more instances, we
        # will assume a target of 2 copies
        my $copies = $obj->{copies} || 2;

        # objects with only a single instance that are offline are unrecoverable so
        # we don't need to handle that special case
#    next unless $need_recovery;
        unless ($recoverable) {
            warn "so_id: $so_id key: \'$key\' ",
                "can not be recovered - no available instances\n";
            next;
        }

        my $need = $copies - $available;
        $need = 0 if $need < 0;

        next unless $need;

        my %md = (
            key         => $key,
            need_copies => $need,
            volume_name => $vol_name,
            volume_host => $vol_host,
        );

        print_metadata("replicatePending", \%md);
        print "\n";
    }

    return 1;
}


sub removal
{
# so_id, ext_id, instances, available_instances, need_recovery, recoverable
    $dbh->do("CREATE TEMPORARY TABLE mymountedvol LIKE mountedvol");
    $dbh->do("INSERT INTO mymountedvol SELECT * FROM mountedvol");
    $dbh->do("CREATE TEMPORARY TABLE myvolume LIKE volume");
    $dbh->do("INSERT INTO myvolume SELECT * FROM volume");

    my $query = $dbh->prepare(
    );
    $query->execute;

    $dbh->do("DROP TABLE IF EXISTS mymountedvol");

    my @rows;
    while (my $row = $query->fetchrow_hashref) {
        push @rows, $row;        
    }
    $query->finish;
        
    exit unless scalar @rows;

    print "removalPending MULTI\n\n";

    foreach my $obj (@rows) {
        if (defined $verbose) {
            require Data::Dumper;
            print Data::Dumper::Dumper($obj);
        }

        my $so_id = $obj->{so_id};
        my $key = $obj->{ext_id};
        my $has = $obj->{instances};
        my $vol_name = $obj->{volume_name};
        my $vol_host = $obj->{volume_host};
        my $available = $obj->{available_instances} || 0;
        my $need_recovery = $obj->{need_recovery};
        my $recoverable = $obj->{recoverable};
        # if the copies xattr is unset and the object has 2 or more instances, we
        # will assume a target of 2 copies
        my $copies = $obj->{copies} || 2;

        # objects with only a single instance that are offline are unrecoverable so
        # we don't need to handle that special case
#    next unless $need_recovery;
        unless ($recoverable) {
            warn "so_id: $so_id key: \'$key\' ",
                "can not be recovered - no available instances\n";
            next;
        }

        my $need = $copies - $available;
        $need = 0 if $need < 0;

        next unless $need;

        my %md = (
            key         => $key,
            need_copies => $need,
            volume_name => $vol_name,
            volume_host => $vol_host,
        );

        print_metadata("replicatePending", \%md);
        print "\n";
    }

    return 1;
}


sub print_metadata
{
    my ($name, $pairs) = @_;

    print "$name METADATA\n";

    # format from formatMetadataItem() in pzMetadataConfig.c
    foreach my $key (keys %$pairs) {
        my $value = $pairs->{$key};
        if (looks_like_number($value)) {
            printf("   " . "%-15s  %-8s  %-15s\n", $key, "S32", $value);
        } else {
            printf("   " . "%-15s  %-8s  %-15s\n", $key, "STR", $value);
        }
    }
    
    print "END\n";
}

# looks_like_number() was stolen from Scalar::Util
#
# Copyright (c) 1997-2006 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

sub looks_like_number {
  local $_ = shift;

  # checks from perlfaq4
  return 0 if !defined($_) or ref($_);
  return 1 if (/^[+-]?\d+$/); # is a +/- integer
  return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
  return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);

  0;
}

__END__

=pod

=head1 NAME

neb-admin - perform misc. Nebulous administrative functions

=head1 SYNOPSIS

    neb-admin [--host <db host>] [--db <db name>] [--user <db username>]
        [--pass <db password>] [--pendingreplicate] [--limit <n>]

=head1 DESCRIPTION

=head1 OPTIONS

=over 4

=item * --pendingreplicate|-r

Print out a list of nebulous keys that need additional replications created.

=item * --limit|-l <n>

Limits the number of items return in response to some request (like
C<--pendingreplicate>). 

Optional.  Defaults to 5.  --limit 0 is treated as asking for the default
value.

=item * --host <database host>

Name of host on which the database resides.

Optional.  Defaults to C<localhost>.

=item * --db|-d <database>

Name of database (C<namespace>) to create tables in.

Optional if the appropriate environment variable is set.

=item * --user|-u <username>

Username to authenticate with.

Optional if the appropriate environment variable is set.

=item * --pass|-p <password>

Password to authenticate with.

Optional if the appropriate environment variable is set.

=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_DB>

Equivalent to --db|-d

=item * C<NEB_HOST>

Equivalent to --host

=item * C<NEB_USER>

Equivalent to --user|-u

=item * C<NEB_PASS>

Equivalent to --pass|-p 

=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) 2005-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-addvol>, L<neb-fsck>, L<neb-initdb>, L<nebdiskd>

=cut
