package TSM::Retcode;

use strict;

sub new {
        my $type = shift;
        my $code = shift;

        my $this = {};
        $this->{success} = 0;
        $this->{detail} = ();

        if (defined $code) {
                parse_code( $this, $code);
        }

        bless $this, $type;
}

sub update {
        my $this = shift;
        my $code = shift;

        if (/^ANS8002I/) {
                $this->{success} = 1;
        } elsif (/^ANS8001I Return code (\d+)/) {
                $this->{retcode} = $1;
        }
}

sub parse_code {
        my $this = shift;
        my $code = shift;

        $code =~ /^(A..)(....)(.)/;
        $this->{prefix} = $1;
        $this->{number} = $2;
        $this->{type}   = $3;

        if ($code =~ /^(ANE)(4...)/) {
                print STDERR "parse_code( $code) ba client to server event logging\n";
        } elsif ($code =~ /^(ANR)(....)/) {
                print STDERR "parse_code( $code) server\n";
        } elsif ($code =~ /^(ANS)([58]...)/) {
                print STDERR "parse_code( $code) administration client\n";
        } elsif ($code =~ /^(ANS)(....)/) {
                print STDERR "parse_code( $code) ba client\n";
        } elsif ($code =~ /^(ACO)(....)/) {
                if ($1 > '0300' && $1 <= '5203') {
                        print STDERR "parse_code( $code) admin client (TDP for MSSQL)\n";
                }
        } else {
                print STDERR "parse_code( $code) unknown\n";
        }
}

package TSM::Statement;

use strict;

my %columns = (
        "select * from db", [qw(AVAIL_SPACE_MB CAPACITY_MB MAX_EXTENSION_MB MAX_REDUCTION_MB PAGE_SIZE USABLE_PAGES USED_PAGES PCT_UTILIZED MAX_PCT_UTILIZED PHYSICAL_VOLUMES BUFF_POOL_PAGES TOTAL_BUFFER_REQ CACHE_HIT_PCT CACHE_WAIT_PCT BACKUP_RUNNING BACKUP_TYPE NUM_BACKUP_INCR BACKUP_CHG_MB BACKUP_CHG_PCT LAST_BACKUP_DATE)],
        "select * from dbvolumes", [qw(COPY1_NAME COPY1_STATUS COPY2_NAME COPY2_STATUS COPY3_NAME COPY3_STATUS AVAIL_SPACE_MB ALLOC_SPACE_MB FREE_SPACE_MB)],
        "select * from log", [qw(AVAIL_SPACE_MB CAPACITY_MB MAX_EXTENSION_MB MAX_REDUCTION_MB PAGE_SIZE USABLE_PAGES USED_PAGES PCT_UTILIZED MAX_PCT_UTILIZED PHYSICAL_VOLUMES LOG_POOL_PAGES LOG_POOL_PCT_UTIL LOG_POOL_PCT_WAIT CONSUMPTION_MB CONSUMPTION_DATE)],
        "select * from logvolumes", [qw(COPY1_NAME COPY1_STATUS COPY2_NAME COPY2_STATUS COPY3_NAME COPY3_STATUS AVAIL_SPACE_MB ALLOC_SPACE_MB FREE_SPACE_MB)],
        "select * from stgpools", [qw(STGPOOL_NAME POOLTYPE DEVCLASS EST_CAPACITY_MB PCT_UTILIZED PCT_MIGR PCT_LOGICAL HIGHMIG LOWMIG MIGPROCESS NEXTSTGPOOL MAXSIZE ACCESS DESCRIPTION OVFLOCATION CACHE COLLOCATE RECLAIM MAXSCRATCH REUSEDELAY MIGR_RUNNING MIGR_MB MIGR_SECONDS RECL_RUNNING RECL_VOLUME CHG_TIME CHG_ADMIN RECLAIMSTGPOOL MIGDELAY MIGCONTINUE)],
        "select * from actlog", [qw(DATE_TIME MSGNO SEVERITY MESSAGE ORIGINATOR NODENAME OWNERNAME SCHEDNAME DOMAINNAME SESSID SERVERNAME)],
        );

sub _columns {
        my $query = shift;
        my @ret;

        if ($columns{$query}) {
                return $columns{$query};
        } else {
                my $cc = 0;
                my $col;

                foreach my $re (keys %columns) {
                        my $re2 = $re;
                        $re2 =~ s/\*/\\*/g;
                        if ($query =~ /^$re2/i) {
                                if (++$cc == 1) {
                                        $col = $columns{$re};
                                } else {
                                        # more than one match!
                                        return undef;
                                }
                        }
                }

                if ($cc == 1) {
                        return $col;
                } else {
                        return undef;
                }
        }
}

sub new {
        my $type = shift;
        my ($query, $fh) = @_;
        my $this = {};

        $this->{fh} = $fh;
        $this->{buffer} = '';
        $this->{columns} = _columns( $query);
        $this->{rowcount} = 0;

        bless $this, $type;
}

sub finish {
        my $this = shift;

        delete $this->{buffer};
        delete $this->{columns};
        delete $this->{fh};
        delete $this->{rowcount};
}

sub fetchall_arrayref {
        my $this = shift;
        my $query = shift;
        my @ret;

        my $cols = $ret[0] = $this->columns( $query);
        $this->query( $query);

        my $fh = $this->{fh};

        #
        # HACK! We have to check if first record is in fact an error
        #
        $_ = <$fh>; chomp;

        if (/^ANR/) {
                return undef;
        }

        # we have a vaild resultset
        for (;;) {
                last if /^ANS/ || /^$/;

                print STDERR "$_\n" if $this->{debug};
                my @r = split /\t/ => $_;
                push @ret => \@r;

                $_ = <$fh>; chomp;
        }

        \@ret;
}

sub fetchrow_array_old {
        my $this = shift;
        my @args = @_;

        my $fh = $this->{fh};

        for (my $again = 1; $again > 0; $again--) {
                $again = 0;
                $_ = <$fh>; chomp;

                if (/^ANR/) {
                        return ();
                }
                return () if /^ANS/;

#               while (/\r$/) {
#                       $_ .= <$fh>;
#               }

#               # damn awful HACK
#               ++$this->{rowcount};
                if (/^$/) {
#                       if ($this->{rowcount} % 23) {
#                               return ();
#                       } else {
                                $again = 2;
#                       }
                }
        }

        print STDERR "$_\n" if $this->{debug};
        return split /\t/ => $_;
}

sub fetchrow_array {
        my $this = shift;
        my @args = @_;

        my $fh = $this->{fh};

        my $ret = $this->{buffer} || "";
        $this->{buffer} = "";

        if ($ret =~ /^AN[RS]/) {
                return ();
        }

        for (;;) {
                $_ = <$fh>; chomp;

                #
                # At EOF just return the buffer
                #
                if (!defined $_) {
                        last;
                }
                print STDERR "$_\n" if $this->{debug};

                if (/^AN[RS]/) {
                        if ($ret ne '') {
                                $this->{buffer} = $_;
                                last;
                        } else {
                                return ();
                        }
                }

                if (/^\S+/) {
                        if ($ret eq '') {
                                $ret = $_;
                        } else {
                                $this->{buffer} = $_;
                                last;
                        }
                } else {
                        $ret .= $_;
                }
        }

        return split /\t/ => $ret;
}

sub fetchrow_hashref {
        my $this = shift;
        my @args = @_;
        my $h;

        if (!defined $this->{columns}) {
                return undef;
        }

        my $fh = $this->{fh};

        for (my $again = 1; $again > 0; $again--) {
                $again = 0;
                $_ = <$fh>; chomp;

                if (/^ANR/) {
                        return undef;
                }
                return undef if /^ANS/;

                # damn awful HACK
                ++$this->{rowcount};
                if (/^$/) {
                        if ($this->{rowcount} % 23) {
                                return undef;
                        } else {
                                $again = 2;
                        }
                }
        }

        print STDERR "$_\n" if $this->{debug};
        my @r = split /\t/ => $_;

        for (my $i = 0; $i < scalar @{$this->{columns}}; $i++) {
                $h->{$this->{columns}[$i]} = $r[$i];
        }

        $h;
}

package TSM::Admin;

use IO::File;

my @installpath = qw(/usr/bin);
my @retcodes = qw(RC_OK                                         /* 0    OK */
        RC_NOTFOUND                                             /* 1    WARNING (use 11 instead) */
        RC_UNKNOWN RC_SYNTAX RC_ERROR RC_NOMEMORY               /* 2-5  ERROR */
        RC_NOLOG RC_NODB RC_NOSTORAGE RC_NOAUTH RC_EXISTS       /* 6-10 ERROR */
        RC_NOTFOUND                                             /* 11   WARNING */
        RC_INUSE RC_ISREFERENCED RC_NOTAVAILABLE                /* 12-14ERROR */
        );

sub new {
        my $type = shift;
        my ($user, $pass, $opt) = @_;
        my $this = {};

        if ($user ne '') {
                $this->{user} = $user;
        } else {
                return undef;
        }

        if ($pass ne '') {
                $this->{pass} = $user;
        } else {
                return undef;
        }

        if (defined $opt->{debug}) {
                $this->{debug} = $opt->{debug};
        } else {
                $this->{debug} = 0;
        }

        if (defined $opt->{path}) {
                $this->{path} = $opt->{path};
        } else {
                foreach (@installpath) {
                        if (-x "$_/dsmadmc") {
                                $this->{path} = "$_/dsmadmc";
                                last;
                        }
                }

                if (!defined $this->{path}) {
                        return undef;
                }
        }

        $this->{cmd} = sprintf qq{%s '-id=%s' '-pass=%s' -tabdelimited "%%s" |},
                $this->{path}, $this->{user}, $this->{pass};
        $this->{fh} = new IO::File;

        bless $this, $type;
}

sub query {
        my $this = shift;
        my $query = shift;

        print STDERR "TSM::Admin::query( $query)\n" if $this->{debug};

        if ($this->{fh}->opened()) {
                close $this->{fh};
        }

        $this->{fh}->open( sprintf( $this->{cmd}, $query));
        my $fh = $this->{fh};

        #
        # Throw away common header
        #
        while (<$fh>) {
                chomp;
                last if /^$/;
                print STDERR "TSM::Admin::query() read $_\n" if $this->{debug} > 1;
        }
        while (<$fh>) {
                chomp;
                last if /^$/;
                print STDERR "TSM::Admin::query() read $_\n" if $this->{debug} > 1;
        }
        $_ = <$fh>; chomp;
        die "$_" unless /^ANS8000I/;
}

sub select {
        my $this = shift;
        my $query = shift;
        my @ret;

        $this->query( $query);

        return new TSM::Statement( $query, $this->{fh});
}

sub execute {
        my $this = shift;
        my $query = shift;
        my @ret;

        $this->query( $query);
        my $fh = $this->{fh};
        my $ret = new TSM::Retcode();

        while (<$fh>) {
                chomp $_;
                print STDERR "detail: $_\n" if $this->{debug} > 1;
                last if (/^ANS800[12]/);

                push @{$ret->{detail}} => $_;
        }
        $ret->update( $_);

        return $ret;
}

sub dump {
        my $this = shift;

        my $fh = $this->{fh};

        while (<$fh>) {
                chomp;
                last if /^ANS/;
                print STDERR "$_\n";
        }

        if ($_) {
                return new TSM::Retcode( $_);
        } else {
                return undef;
        }
}

