# -*- Perl -*-
#
# File:  MultiSite/Vob/Info.pm
# Desc:  Convert output from ClearCase/MultiSite commands into objects.
# Auth:  Chris Cobb
# Date:  Thu Sep 27 16:13:49 2001
# Stat:  Prototype
#
# Note:  Objects of this class are not useful. This "factory" class 
#        manufactures various objects depending on the "$text" string.
#
# WARN:  Given the widely varing types of output generated by the
#        ClearCase and MultiSite systems, these classes definitely
#        violate the Liskov Substitution Principle. Make sure you know
#        what methods are available for the types of text you parse.
#
# Synopsis:
#        use MultiSite::Vob::Info;
#
#        $objRef = new MultiSite::Vob::Info( $text );
#  or    $objRef = new MultiSite::Vob::Info( @text );
#
#        $objRef = run MultiSite::Vob::Info( $MultiToolCmd );
#  or    $objRef = run MultiSite::Vob::Info( $MultiToolCmd, $matchCriteria );
#
#  or    $MultiTool = "MultiSite::Vob::Info";
#        $MultiTool->run( $MultiToolCmd );
#

package MultiSite::Vob::Info;
 use strict;

 my $PACK = __PACKAGE__;
 use vars qw( $VERSION @ISA );
 $VERSION = '0.03';
 @ISA     = qw( ClearCase::Vob::Info::InfoBase );

 use ClearCase::Vob::Info::InfoBase;  # include mixin class
 use PTools::Loader;
 use PTools::Proc::Backtick;

my $AtriaHome;
if (-d "/opt/rational/clearcase") {
     $AtriaHome = "/opt/rational/clearcase";   # home location for V6+
} else {
     $AtriaHome = "/usr/atria";                # home location for V2+
}
my $AtriaBin  = "$AtriaHome/bin";
my $MultiTool = "$AtriaBin/multitool";
my $MsVersion = "";
my $MsBaseVer = "";


sub name  { return("") }
sub count { return(0)  }
   
sub setView { $_[0]->{_view} = $_[1] }

# The following are valid after calling "getViewContext"
#
sub getView { return( $_[0]->{_view}   || "" ) }
sub inView  { return( $_[0]->{_view} ? 1 : 0 ) }
sub noView  { return( $_[0]->{_view} ? 0 : 1 ) }

*notinView = \&noView;
*notInView = \&noView;

# The following are valid after calling "getVersionContext"
#
sub getVersion   { return( $MsVersion || "" )    }
sub getBaseVer   { return( $MsBaseVer || "" )    }
sub atBaseVer    { return( $_[1] == $MsBaseVer ) }  # E.g.:   atVer( 3     );
sub isVer        { return( $_[1] eq $MsVersion ) }  # E.g.:   isVer( "3.2" );
sub minVer       { return( $_[1] <= $MsBaseVer ) }  # E.g.:  minVer( 4     );

*atLeastVer = \&minVer;

# Notes:   If the current BaseVer is 4, then
#
#             atLeastVer( n )     is TRUE  for n = 2, 3, and 4
#                                 is FALSE for n = 5, 6, etc.


sub setAtriaHome { $AtriaHome = $_[1] if $_[1]              }
sub setAtriaBin  { $AtriaBin  = $_[1] if $_[1]              }
sub getAtriaHome { return( $AtriaHome || "/usr/atria" )     }
sub getAtriaBin  { return( $AtriaBin  || "/usr/atria/bin" ) }

*parse = \&new;

sub new
{   my($class,@text) = @_;

    my $self = bless {}, ref($class)||$class;

    my $view = $ENV{CLEARCASE_ROOT} ||"";
    #____________________________________________
    # Warn: this next bit is UXSCM/jazz specific
    #
    $view =~ s#/view/##;
    $view = $ENV{SCMVIEW} || $view;
    #____________________________________________
    $self->setView( $view );

    return $self  unless scalar @text;
    #return undef unless scalar @text;

    # Attempt to determine what type of object to create based
    # on the first few characters in the "@text" string/array.
    #
  # my($module) = $text[0] =~ /^(.*) "/;
    my($module) = $text[0] =~ /^([^"]*) (["(])/;  # now handles '... (locked)'

    $module   ||= "List";
    my(@module) = split(' ', $module);
    $module = "";
    foreach (@module) { $module .= ucfirst( lc ); }

    #_________________________________________________________
    # Based just on the string values, some module names would
    # be semantically ambiguous ... so do a little fixup here.
    #
    $module =~ s/(ForVob)?Replica/ReplicaList/;
    $module =~ /^MultisiteVersion/      and $module = "MultisiteVersion";

    #_________________________________________________________
    # First attempt to load a "MultiSite..." module. If that fails
    # then attempt to load a "ClearCase..." module. No luck? Abort.
    #
    my $moduleClass   = $PACK ."::". $module;
    my($err,@errArgs) = PTools::Loader->use( $moduleClass );

    if ($err) {
	my $moduleClass2    = "ClearCase::Vob::Info::$module";
    	my($err2,@errArgs2) = PTools::Loader->use( $moduleClass2 );
	#
	# If we can't find *anything* to load, abort with the
	# original error message ... is this too confusing?
	#

	#print "DEBUG $PACK: module='$module'\n";
	#print "DEBUG $PACK: text[0]='$text[0]'\n";

	$err2 and PTools::Loader->abort( $err, @errArgs );
        $err2  or $moduleClass = $moduleClass2;
    }

    # Okay ... we successfully loaded an Info class. 
    # Return an instantiated object.
    #
    return $moduleClass->new( @text );
}

sub run
{   my($class,$subcmd,$match,$noObject) = @_;

    return undef unless $subcmd;
    $match ||= "";
    $noObject ||= "";

    my $cmdRef = Proc::Backtick->run( $MultiTool, $subcmd );

    my($stat,$err) = $cmdRef->status;
    $stat and die "$err ($stat)";

    my(@result) = ();
    $match   = "" if $match eq "-all";

    $stat   or (@result) = split("\n", $cmdRef->result);
    $match and (@result) = grep /$match/, @result;

    return( @result ) if $noObject;

    my $obj = $class->new( @result );
    $obj->set('_cmd',  $subcmd);
    $obj->set('_match',"/$match/") if $match;

    return $obj;
}

sub getVersionContext
{   my($self) = @_;

    my $versObj = $self->run( "-verall" );

    my($stat,$err) = $self->status;
    $stat and die "$err ($stat)";

    $MsVersion = $versObj->get('version');

    if ( $MsVersion =~ /^(20\d\d\.)?([^\.]*)/ ) {
	$MsBaseVer = $2;
    }

  # print "DEBUG: BaseVer='$CtBaseVer'   ctVersion='$MsVersion'\n";

    return $MsVersion;
}
#_________________________
1; # Required by require()

__END__

=head1 NAME

MultiSite::Vob::Info - Parse output from Rational's ClearCase "multitool" command interpreter.

=head1 VERSION

This document describes version 0.03, released May, 2004.

=head1 DEPENDENCIES

This class depends upon the B<PTools::Loader> and B<PTools::Proc::Backtick> 
classes.

=head1 SYNOPSIS

See the B<ClearCase::Vob::Info> class.

=head1 DESCRIPTION

See the B<ClearCase::Vob::Info> class.

=head1 INHERITANCE

This class inherits from B<ClearCase::Vob::Info::InfoBase>.

=head1 SEE ALSO

See L<ClearCase::Proc::ClearTool>, L<ClearCase::Vob::Info>
and L<ClearCase::Vob::Info::InfoBase>.

=head1 AUTHOR

Chris Cobb, E<lt>chris@ccobb.netE<gt>

=head1 COPYRIGHT

Copyright (c) 2002 by Hewlett-Packard. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
