# @(#)87	1.5 src/43haes/lib/perl/ODM.pm, hacmp, 61haes_r714 11/28/11 15:07:10
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
# 61haes_r714 src/43haes/lib/perl/ODM.pm 1.5 
#  
# Licensed Materials - Property of IBM 
#  
# COPYRIGHT International Business Machines Corp. 2003,2011 
# All Rights Reserved 
#  
# US Government Users Restricted Rights - Use, duplication or 
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
#  
# IBM_PROLOG_END_TAG 
package ODM;

=head1 NAME

ODM - Perl extension for Handling AIX ODM classes

=head1 SYNOPSIS

 use ODM;
 my $odm = ODM::new("HACMPnode");
 foreach my $node ( $odm->get() ) {
	 print $node->{name}, ": ", $node->{object}, $node->{value},"\n";
 }
 print $odm->get(-q=>{name=>"nodeA", object=>"VERBOSE_LOGGING"})->{value};

=head1 DESCRIPTION

This package provides a Perl-like interface for accessing and manipulating
AIX ODMs.

An ODM object is a 'handle' to a real ODM class so that arbitrary
operations can be performed on it.  The operations currently supported
are:

	new -- creates an interface to an ODM class
	get -- retrieves data from an ODM class
    error -- returns the error from the last command, if any or undef.

ODM data, as returned from 'get' is an array of hashes, where each hash
contains the descriptor names as hash keys and descriptor values as hash
values.

=head1 COPYRIGHT

(C) COPYRIGHT International Business Machines Corp. 2003
All Rights Reserved

=head1 METHODS

=cut

##
#
# Developers,
# The Programming Perl (Camel) book, 3rd Edition says the use of
# prototypes on methods are not honored.  They are included for
# documentation purposes only, and can be easily removed with no
# loss of functionality or safety.
#
# Also, as the need exists, change the 'internal' document format
# to POD.
##

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Symbol qw(qualify_to_ref);

use Carp;

require Exporter;

@ISA = qw(Exporter);	# AutoLoader ?
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);
$VERSION = '0.01';


# Preloaded methods go here.
sub stream2hashes(;*);
sub buildquery(\@);


#
# Name: DCD
#
# Description:
#    Returns a string containing the PowerHA SystemMirror ODM Default Configuration Directory.
# 
# Arguments:
#    None
#
# Returns:
#    DCD path
#
# Example:
#    my $dcd = ODM::DCD();
#
sub DCD() {
    return "/etc/es/objrepos";
}


#
# Name: ACD
#
# Description:
#    Returns a string containing the PowerHA SystemMirror ODM Active Configuration Directory.
# 
# Arguments:
#    None
#
# Returns:
#    ACD path
#
# Example:
#    my $acd = ODM::ACD();
#
sub ACD() {
    return "/usr/es/sbin/cluster/etc/objrepos/active";
}


#
# Name: create
#
# Description:
#    Creates a list of ODM objects give a file containing the 
#    the definitions of the classes.  This is analogous to the
#    odmcreate command.
# 
#    Any preferences passed in as extra arguments will be applied
#    to all of the objects as well.
#
# Arguments:
#    $: filename containing the class definitions
#    @: optional named parameters
#
# Returns:
#    A list of created classes.
#
# Example:
#    my @classes = ODM::create( "classfile", ODMDIR=>"/etc/objrepos" );
#
sub create($;@)
{
    my $filename = shift;
    my %prefs = @_;
    my @results = ();

    my $ODMDIR = $prefs{ODMDIR} || $ENV{ODMDIR} || croak "ODMDIR not set";
    
    open( PIPE, "ODMDIR=$ODMDIR odmcreate -c $filename|" )
      or return ();
    while (<PIPE>)
    {
        chomp;
        push @results, ODM->new( $_, %prefs );
    }
    close( PIPE );

    return @results;
}

# static function
sub show
{
}

#
# Name: drop
#
# Description:
#    Deletes an ODM class given a valid ODM object.  If the object is not
#    valid, this routine will croak.
# 
# Arguments:
#    $ : the Perl object representing the ODM class.
#
# Returns:
#    The return code from the system call to drop the ODM.
#
#    Note that the ODM object passed in still has valid data, but there
#    no longer be an ODM to back it up.  References to this object
#    should be deleted.
#
# Example:
#    ODM::drop( $odm );
#
sub drop($)
{
    my $odm = shift;
    croak "drop argument must be an ODM object"	unless defined( $odm ) and ("ODM" eq ref($odm));
    
    return system "ODMDIR=$odm->{ODMDIR} odmdrop -o $odm->{_classname}";
}

=head2 new()

Description:

    This is the constructor for ODM classes.  It takes the name of an
    ODM class with optional parameters and 'ties' the class with 
	a new Perl object that's created by this method.

Arguments:

	$: an instance of an ODM class.
	@: optional parameters

Returns:

    A new object used to represent the ODM class.

Example:

    my $HACMPcluster = ODM::new( "HACMPcluster", ODMDIR=>"/etc/objrepos" );

=cut

sub new($;@) {
    my $proto  = shift;
    my $class = ref($proto) || $proto;
    my $self = {};

    my $classname = shift || croak "argument 'classname' is mandatory";
    my %args = @_;

	$self->{_classname} = $classname;
	$self->{ODMDIR} = $args{ODMDIR} || $ENV{ODMDIR}
        || croak "ODMDIR not set";

    return bless $self, $class;
}

# dump
# utility function to write the ODM data to a file handle
sub dump(*@)
{
    my $self = shift;
    my $fh = qualify_to_ref( shift, caller );
    my ( $key, $value );

    foreach ( @_ )
    {
        print $fh "\n".$self->{_classname}.":\n";
        while (( $key, $value ) = each %{$_} )
		{
            print $fh "\t$key = $value\n";
        }
    }
}

#
# Name: add
#
# Description:
#   Adds a stanza to the ODM object.  The parameters to add must a hash
#   which contains field/value pairs that would comprise a complete
#   stanza for the ODM class.
# 
# Arguments:
#    @: A hash representing a stanza to add to the ODM class.
#
# Returns:
#    The return code from the system call to add the ODM stanza.
#
# Example:
#    $HACMPports->add(
#		node => "myNode",
#		tty => "/dev/tty0",
#	 );
#
sub add(@)
{
    my $self = shift;
    my ( $key, $value );
    
    open( PIPE, "| ODMDIR=$self->{ODMDIR} odmadd" )
         or return ();
    $self->dump( *PIPE, @_ );
    close PIPE;
# TBD add return code handling!!
}

=head2 error()

Description:

   Returns the error from the last operation, or undef if no error.

Arguments:

   None

Returns:

    A string representing the error encountered, or undef, if successful.

Examples:

    $HACMPport->get();
	if ( $HACMPport->error() ) { 
		die "Error encountered: " . $HACMPport->error();
    }
=cut

sub error() {
    return $_[0]->{_error};
}

=head2 get()

Description:

   Returns a list of hashes containing the results of the query.
   The arguments for the query can be one of:
   -q => "string containing query"
   -q => { queryterm1 => value, queryterm2 => value } # they are ANDed
   -q => ( queryterm1 => value, queryterm2 => value ) # they are ANDed
   undef # that is nothing, in which case the entire ODM is returned.
 
   If there was an error encountered while performing the operation,
   the error status will be set; the error() method can be used to
   detect it.

Arguments:

    @: A hash representing the query; please see the Description for
       how to form a query, or the examples below.

Returns:

    The results of a query as a list of hashes.

Examples:

    $HACMPport->get();
    $HACMPport->get( -q => "tty = /dev/ttyS0" );
    $HACMPport->get( -q => {node => "myNode"} );

=cut

sub get(;$)
{
    my $self = shift;
    my $QUERY = buildquery( @_ );
    my @results = ();

	# clear the error state
	delete $self->{_error};

    if ( ! defined open( PIPE,
        "ODMDIR=$self->{ODMDIR} odmget $QUERY $self->{_classname} 2> /dev/null |" )) {
		$self->{_error} = "$!";
        return ();
	}
    @results = stream2hashes( PIPE );
    close PIPE;

    return @results;
}

# change: 
# [ -q => "string" | -q => { key => value, ... } ]
# list of references to hashes
sub change
{
    my $self = shift;
    my $QUERY = buildquery( @_ );

    open( PIPE,
      "| ODMDIR=$self->{ODMDIR} odmchange -o $self->{_classname} $QUERY" )
        or return ();
    $self->dump( *PIPE, @_ );
    close PIPE;
}

#
# Name: delete
#
# Description:
#   Returns the count of stanzas that were deleted from the ODM.
#   The arguments for the query can be one of:
#   -q => "string containing query"
#   -q => { queryterm1 => value, queryterm2 => value } # they are ANDed
#   -q => ( queryterm1 => value, queryterm2 => value ) # they are ANDed
#   undef # that is nothing, in which case the contents of the entire
#         # ODM is deleted.
# 
# Arguments:
#    @: A hash representing the query; please see the Description for
#       how to form a query, or the examples below.
#
# Returns:
#    The number of stanzas that were deleted.
#
# Examples:
#    $HACMPport->delete();
#    $HACMPport->delete( -q => "tty = /dev/ttyS0" );
#    $HACMPport->delete( -q => {node => "myNode"} );
#
sub delete
{
    my $self = shift;
    my $QUERY = buildquery( @_ );
    my $count;
return system "ODMDIR=$self->{ODMDIR} odmdelete -o $QUERY -q $self->{_classname}";
    open( PIPE,
      "ODMDIR=$self->{ODMDIR} odmdelete -o $self->{_classname} $QUERY |" )
        or return ();
    while(<PIPE>)
    {
		if ( /\s(\d+)\sobjects deleted/ ) { $count = $1 }
    }
    close PIPE;
    return $count;
}

sub stream2hashes(;*)
{
    my $fh = qualify_to_ref( shift||"STDIN", caller);
    my @result = ();
    my $hash;

    while(<$fh>)
    {
    	chomp;
        /^\s*$/			        and push @result, $hash;
        /^\w+:/			        and $hash = {};
        /^\t(\w+) = "?([^"]*)"?$/	and $hash->{$1} = $2;
    }
    push @result, $hash;
    shift @result unless ( defined $result[0] );
    return @result;
}

sub buildquery(\@)
{
    my $array = shift;
    my $QUERY = '';

    if ( defined ($array->[0]) && $array->[0] =~ /^(-q|-query)$/ )
    {
        shift @{$array};
        $QUERY = '-q "' . hash2query( shift @{$array}) . '" ';
    }
    
    return $QUERY;
}

sub hash2query
{
    my ( $key, $value );
    my $result = "";
    my $hash;

    if ( ref($_[0]) eq "HASH" )
    {
        $hash = $_[0];
    }
    elsif ( 1 == scalar( @_ ) )
    {
        return $_[0];
    }
    else
    {
        my %hash = @_;
        $hash = \%hash;
    }

    if ( ($key, $value) = each %{$hash} ) 
    {
        $value =~ s/'/''/g;
        $value =~ s/^\s*"(.*)"\s*$/'$1'/;
        $result = $key. " = " . $value;
    }

    while (( $key, $value ) = each %{$hash} )
    {
        $value =~ s/'/''/g;
        $value =~ s/^\s*"(.*)"\s*$/'$1'/;
        $result .= " AND " . $key . " = " . $value;
    }
    return $result;
}

sub parseclass(;*)
{
    my $fh = qualify_to_ref( shift||"STDIN", caller);
    my %hash;

    while (<$fh>)
    {
        /(char|vchar|nchar|longchar|binary|method)\s+(\w+)\s*\[(\d+)\]/
            or $hash{$2} = { type=>$1, size=>$3 };
        /(short|long|long64|int64|ODM_LONG_LONG|method)\s+(\w+)/
            or $hash{$2} = { type=>$1 };
#        /link (\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s*\[(\d)\]/
#           or $hash{$5}= {type=>"link"};
    }

    return %hash;

#    char DescriptorName [ DescriptorSize ];
#    
#    vchar DescriptorName [ DescriptorSize ];
#    
#    binary DescriptorName [ DescriptorSize ];
#    
#    short DescriptorName ;
#    
#    long DescriptorName ;
#    
#    long64 or int64 or ODM_LONG_LONG DescriptorName ;
#    
#    method DescriptorName ;
#    
#    link StdClassName StdClassName ColName DescriptorName ;
#    

}
# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__