# -*- Perl -*-
#
# File:  ClearCase/Vob/Info.pm
# Desc:  Parse output from ClearCase "cleartool" command interpreter.
# Date:  Thu Sep 27 16:13:49 2001
# Stat:  Prototype
#
#        This is a "factory" class that instantiates various objects
#        depending on the "$text" string or "@text" array passed to
#        the "parse" method, or resulting from the "run" method. Any
#        arbitrary text can be "parsed," the assumption being that it
#        was generated by running "cleartool" subcommands.
#
# Note:  This class starts a UNIQUE "cleartool" command process for each
#        and every subcommand that is run. For performance improvements
#        the "ClearCase::Proc::ClearTool" and "MultiSite::Proc::MultiTool"
#        classes should be used. These create a persistent process and 
#        provide hooks for using this parser class (or another parser).
#
# WARN:  Given the widely varing types of output generated by the
#        ClearCase and MultiSite systems, these classes could easily
#        violate the Liskov Substitution Principle. Make sure that
#        any methods are available for ALL of the parser Subclasses.
#        See the base class "ClearCase::Vob::Info::InfoBase" for the
#        currently defined methods.
#
#        Liskov Substitution Principle ("LSP"):
#         "Subclasses should be substitutable for their base classes."
#
# Synopsis:
#        use ClearCase::Vob::Info;
#
#  Create a variable for use as a "cleartool" command output parser.
#  Functions in this class can be invoked as "class" or "object" methods.
#
#        $ctObj = new ClearCase::Vob::Info;          # for "object" methods
#
#  or    $ClearTool = "ClearCase::View::Info";       # for "class" methods
#
#
#  Run a "cleartool" command interpreter and parse the output. Remember,
#  a separate cleartool process is created for each command that is run.
#
#        $objRef = $ctObj->run( $ClearCaseCmd );         # "object" methods
#  or    $objRef = $ctObj->run( $ClearCaseCmd, $matchCriteria );
#
#        $objRef = $ClearTool->run( $ClearCaseCmd );     # "class" methods
#  or    $objRef = $ClearTool->run( $ClearCaseCmd, $matchCriteria );
#
#
#  Attempt to parse arbitrary text w/out running a cleartool process.
#
#        $objRef = $ctObj->parse( $text );               # "object" methods
#  or    $objRef = $ctObj->parse( @text );
#
#        $objRef = new ClearCase::Vob::Info( $text );    # "class" methods
#  or    $objRef = new ClearCase::Vob::Info( @text );
#
#        $objRef = $ClearTool->parse( $text );           # "class" methods
#  or    $objRef = $ClearTool->parse( @text );
#
#
#  Determine if the current process is running under a ClearCase view.
#  Collecting this is a performance hit, so get the context as needed.
#
#        $ctObj->getViewContext;      # Determine the view context
#
#        $ctObj->getView;             # returns "" or current view name
#  or    $ctObj->inView;              # returns 0 or 1
#  or    $ctObj->noView;              # returns 0 or 1
#
#  Determine the current ClearCase version. Collecting this is a 
#  performance hit, so get the context as needed.
#
#        $ctObj->getVersionContext;   # Determine the version context
#
#        $ctObj->atVer( 3 );          # returns 0 or 1
#        $ctObj->atVer( 6 );          # returns 0 or 1
#
#        $ctObj->isVer( "3.2" );        # returns 0 or 1
#        $ctObj->isVer( "2003.06.00" ); # returns 0 or 1
#

package ClearCase::Vob::Info;
 use strict;

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

 use ClearCase::Vob::Info::InfoBase;  # include mixin class
 use PTools::Loader;                  # demand-load Perl modules
 use PTools::Proc::Backtick;          # run a child process

 my($AtriaHome,$AtriaJava);
 if ($AtriaHome = $ENV{CLEARCASEHOME}) {
     $ENV{ATRIAHOME} = $AtriaHome;
 } elsif ($AtriaHome = $ENV{ATRIAHOME}) {
     # nothing else to do here if env already set
 } elsif (-d "/opt/rational/clearcase") {
     $AtriaHome = "/opt/rational/clearcase";   # home location for V6+
     $ENV{ATRIAHOME} = $AtriaHome;
 } else {
     $AtriaHome = "/usr/atria";                # home location for V2+
     $ENV{ATRIAHOME} = $AtriaHome;
 }
 if ($AtriaHome eq "/opt/rational/clearcase") {
     $AtriaJava  = "$AtriaHome/java";          # only available at V6+
 }
 my $AtriaBin    = "$AtriaHome/bin";
 my $AtriaConfig = "$AtriaHome/config";
 my $AtriaEtc    = "$AtriaHome/etc";
 my $AtriaLib    = "$AtriaHome/lib";
 my $AtriaShip   = "$AtriaHome/shipping";
 my $AtriaShlib  = "$AtriaHome/shlib";

 my $ClearTool    = "$AtriaBin/cleartool";
 my $MultiTool    = "$AtriaBin/multitool";

 my $DefaultClass = $PACK ."::List";
 my $CtVersion    = "";
 my $CtBaseVer    = "";


sub setView { $_[0]->{_view} = $_[1] || "" }   # both set and return arg

# 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( $CtVersion || "" )    }
sub getBaseVer   { return( $CtBaseVer || "" )    }
sub atBaseVer    { return( $_[1] == $CtBaseVer ) }  # E.g.:   atVer( 3     );
sub isVer        { return( $_[1] eq $CtVersion ) }  # E.g.:   isVer( "3.2" );
sub minVer       { return( $_[1] <= $CtBaseVer ) }  # 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   { $AtriaHome   }
sub getAtriaBin    { $AtriaBin    }
sub getAtriaConfig { $AtriaConfig }
sub getAtriaEtc    { $AtriaEtc    }
sub getAtriaJava   { $AtriaJava   }
sub getAtriaLib    { $AtriaLib    }
sub getAtriaShip   { $AtriaShip   }
sub getAtriaShlib  { $AtriaShlib  }

sub getClearTool   { $ClearTool   }
sub getMultiTool   { $MultiTool   }

*parse     = \&new;

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

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

    ## my $self = $class->SUPER::new();
    ## my $count = $#text;
    ## print "DEBUG: \$#text = $count\n";

    return $self  unless @text;
    return $self  if ($text[0] eq "" and $#text == 0);
    #return undef unless @text;

    ## print "DEBUG: CHECKPOINT(1)\n";

    $self->set('_orig', \@text);

    (@text) = split('\n', $text[0]) if $#text == 0;
    # Fix this for later use?
    my $oidPattern = "\\(([0-9a-f]*)([:.])";

    ## print "DEBUG: text[0]='$text[0]'\n";
    ## print "DEBUG: text[1]='$text[1]'\n";
    ## print "DEBUG: text[2]='$text[2]'\n";
    ## print "DEBUG: text[3]='$text[3]'\n";
    ## print "DEBUG: UNDEF\n" unless defined $text[0];

    # Attempt to determine what type of object to create based
    # on the first few characters in the "@text" string/array.
    #
    # WARN: The following was fixed to parse the following
    # syntax ... how to ensure it doesn't break something else??
    #     text='label type "APACHE_PRE_2.0.36_DROP" (locked)'
    # with the change being the trailing           ^^^^^^^^^ characters
    #
  # my($module) = $text[0] =~ /^(.*) (["(])/;
    my($module) = $text[0] =~ /^([^"]*) (["(])/;  # now handles '... (locked)'

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

    ## print "$PACK DEBUG(1):   text='$text[0]'\n";
    ## print "$PACK DEBUG(1): module='$module'\n";
    ## if ($text[0] =~ /^branch/) { 
    ## 	foreach (@text) { print " TEXT: $_\n"; }; die;
    ## }
    #_________________________________________________________
    # Based just on the string values, some module names would
    # be semantically ambiguous ... so do a little fixup here.
    #
    $module =~ s/^Branch(Type)?.*/BranchList/;
    $module =~ s/TriggerType/TriggerList/;
    $module =~ s/Hyperlink/HyperlinkType/ unless $module eq "HyperlinkType";
    $module =~ s/LabelType/LabelList/;
    $module =~ s/(ForVob)?Replica/ReplicaList/;
    $module =~ /LabelList$/             and $module = "LabelList";
    $module =~ /^ClearcaseVersion/      and $module = "ClearcaseVersion";
    $module =~ /^(Directory)?Version/   and $module = "ElementList"
    	unless $module eq "VersionedObjectBase";
    $module =~ /^(Directory)?Element/   and $module = "ElementList";
    $module =~ /^(File)?Element/        and $module = "ElementList";
    $module =~ /^ViewPrivateDirectory$/ and $module = "ElementList";
    $module =~ /^ViewPrivateFile$/      and $module = "ElementList";

    $text[0]=~ /^Tag/                   and $module = "VersionedObjectBase";
    $text[0]=~ /^Client: (.+)/          and $module = "HostInfo";
    $text[0]=~ /^\d\d-\w{3}(\.\d\d:\d\d|-\d{4}|-\d\d\.\d\d:\d\d:\d\d)\s{3}/ 
	and $module = "HistoryList";

    if ($module ne "List") {
	# do nothing                  # already determined module name

    } elsif ($text[0] =~ m#@@/main$# and $text[1] =~ m#@@/#) {
	$module = "ElementVtree";

    } elsif ($text[0] =~ m#^  master replica:# and $text[3] =~ m#@\d+@/#) {
	$module = "HyperlinkType";

    } elsif ($text[0] =~ m#^  owner:# and $text[2] =~ m#@\d+@/#) {
	$module = "HyperlinkType";

    } elsif ( ($text[0] eq "") and ($text[3] =~ /^oid=.*\s*dbid=/) ) {
 	$module = "Dump";
    }
    $module =~ s#[^\w\d]#_#g;    # eliminate syntax errors in 'use' statement


  # Did we arrive at the anticipated result?
  # print "DEBUG(3) module='$module'  in '$PACK'\n";
  # print "DEBUG(3) txt[0]='$text[0]'\n";

  ##print "DEBUG(3) txt[1]='$text[1]'\n";
  ##print "DEBUG(3) txt[2]='$text[2]'\n";
  ##die "count='$#text'";
    #_________________________________________________________
    # Attempt to load a "ClearCase..." module. If that fails
    # then abort with an appropriate error message.
    #
    my $origMode = PTools::Loader->generror("0");  # disable auto abort ...
    my $retry    = 1;                              # wheather retrying or not!

    my $moduleClass   = "$PACK" ."::". $module;
    my($err,@errArgs) = PTools::Loader->use( $moduleClass );

    if ($err and $retry and $err =~ m#^Can't locate#) {
	#
	# If module not found, revert to default "List" module
	# but, if that fails, abort with the ORIGINAL $err.
	#
	$moduleClass = $DefaultClass;

        my($err2,@errArgs2) = PTools::Loader->use( $moduleClass );

	if ($err2) {
	    $class->printErrorText( @text );
	    PTools::Loader->abort( $err, @errArgs );  # abort w/orig "$err"
	}

    } elsif ($err) {
	$class->printErrorText( @text );
	PTools::Loader->abort( $err, @errArgs );
    }

    PTools::Loader->generror( $origMode );            # restore orig mode!

    # Okay ... we successfully loaded an Info Class. 
    # Return an instantiated object that contains either 
    # 1)  one or more attributes parsed from the text, or
    # 2)  a simple "List" w/one text line per array element
    #
    return $ moduleClass->new( @text );
}

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

    print "Error parsing text parameter in '$PACK'\n\n";
    print "--- Unparsed text follows ". ("-" x 30) ."\n";
    foreach (@text) { print "$_\n"; }
    print "--- End of unparsed text ". ("-" x 30) ."\n";
    print "\n";

    return;
}

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

    $match    ||= "";
    $match      = "" if $match eq "-all";
    $noObject ||= "";

    my $cmdObj = PTools::Proc::Backtick->run( $ClearTool, $subcmd );

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

    my(@result) = ();

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

    return( @result ) if $noObject;

    my $obj = $class->new( @result );
    ##print "obj='$obj'\n";

    $obj->setCmd( $subcmd )                 if $obj->can('setCmd');
    $obj->setMatch( "/$match/" ) if $match and $obj->can('setMatch');

    return $obj;
}

sub getViewContext
{   my($self) = @_;
    #
    # This is the "correct" way to determine the current view context.
    # It returns the proper ViewTag when the current working directory
    # happens to be in a view other than the currently "set" view name.
    #
 ## print "***********************************************\n";
 ## print "DEBUG: running 'cleartool pwv' in class '$PACK'\n";
 ## print "***********************************************\n";

    my $cmdObj = PTools::Proc::Backtick->run( $ClearTool, "pwv" );

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

    my $result  = $cmdObj->result;
    my($wvName) = $result =~ m#Working directory view: (.*)#mo;
    my($svName) = $result =~ m#Set view: (.*)#mo;

    $svName = undef if $svName eq "** NONE **";       # not in a view

    my $viewName = ($wvName eq "** NONE **" ? $svName : $wvName); # in a view

    ref $self and $self->setView( $viewName );        # set view name
    return $viewName;                                 # return view name
}

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

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

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

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

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

    #print "DEBUG: BaseVer='$CtBaseVer'   ctVersion='$CtVersion'\n";
    #print $versObj->dump;

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

__END__

=head1 NAME

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

=head1 VERSION

This document describes version 0.21, released June, 2004.

This module has been tested with ClearCase and MultiSite versions 
4.2 through 6.0.

=head1 DEPENDENCIES

Dependencies for this class include the following.

  1)  Rational's ClearCase "cleartool" command interpreter.

  2)  Additional Perl modules including the following.
      PTools::Loader,  PTools::Proc::Backtick

=head1 SYNOPSIS

 use ClearCase::Vob::Info;

 $ctObj = new ClearCase::Vob::Info;              # "object" methods
 $ClearTool = "ClearCase::View::Info";           # "class" methods

 $objRef = $ctObj->run( $ClearCaseCmd );         # "object" methods
 $objRef = $ctObj->run( $ClearCaseCmd, $matchCriteria );

 $objRef = $ClearTool->run( $ClearCaseCmd );     # "class" methods
 $objRef = $ClearTool->run( $ClearCaseCmd, $matchCriteria );

 $objRef = $ctObj->parse( $text );               # "object" methods
 $objRef = $ctObj->parse( @text );

 $objRef = new ClearCase::Vob::Info( $text );    # "class" methods
 $objRef = new ClearCase::Vob::Info( @text );

 $objRef = $ClearTool->parse( $text );           # "class" methods
 $objRef = $ClearTool->parse( @text );


 $ctObj->getViewContext;      # returns "" or current view name

 $ctObj->getView;             # returns result from last getViewContext
 $ctObj->inView;              # returns 0 or 1 from last getViewContext
 $ctObj->noView;              # returns 0 or 1 from last getViewContext


 $ctObj->getVersionContext;   # returns ClearCase version string

 $ctObj->atVer( 3 );          # returns 0 or 1 from last getVersionContext
 $ctObj->atVer( 6 );

 $ctObj->isVer( "3.2" );      # returns 0 or 1 from last getVersionContext
 $ctObj->isVer( "2003.06.00" );


=head1 DESCRIPTION

This class starts a I<unique> 'cleartool' command process for I<each
and every subcommand> that is run. For performance improvements
the B<ClearCase::Proc::ClearTool> and B<MultiSite::Proc::MultiTool>
classes should be used. These create a persistent process and 
provide hooks for using this parser class (or another parser).

Given the widely varing types of output generated by the
ClearCase and MultiSite systems, these classes could easily
violate the Liskov Substitution Principle. Make sure that
any methods are available for ALL of the parser Subclasses.
See the base class B<ClearCase::Vob::Info::InfoBase> for the
currently defined methods.

  Liskov Substitution Principle ("LSP"):
  "Subclasses should be substitutable for their base classes."

Output from the following cleartool/multitool subcommands is recognized 
and automatically parsed into unique objects. 

                                                              works w/
 cleartool commands currently parsed into unique objects     multitool?
 ----------------------------------------------------------  ----------
 ct describe -l [-local] brtype:$branchname                     yes
 ct describe -l hlink:Type@LinkID[@/vobtag[/subdir/path]]       yes
 ct describe -l [-local] lbtype:$labelname                      yes
 ct describe -l [-local] trtype:$triggername                    yes
 ct describe -l [-local] replica:${repltag}@$vobtag             yes
 ct describe -l [-local] vob:$vobtag                            yes
 ct describe -l [-local] { $element | <wildcard> }              yes

 ct dump [-l] $element                                          no
 ct hostinfo -l                                                 no
 ct lshistory [-l] { $element | <wildcard> }                    no
 ct lsreplica -l [ -invob $vobtag ]                             yes

 ct lstype -l [-local] -kind brtype [ -invob $vobtag ]          yes
 ct lstype -l [-local] -kind lbtype [ -invob $vobtag ]          yes
 ct lstype -l [-local] -kind trtype [ -invob $vobtag ]          yes
 ct lstype -l brtype:${branchname}@${vobtag}                    yes
 ct lstype -l lbtype:${labelname}@${vobtag}                     yes
 ct lstype -l trtype:${triggername}@${vobtag}                   yes

 ct lsview -l [ -properties [ -full ]] [ $viewtag [ ... ]]      no
 ct lsview -l [ -host $hostname ]                               no

 ct lsvob  -l $vobtag                                           no
 ct lsvtree [-s] [-nrecurse] [-all] [-obs] [-merge] $element    no
 ct -version                                                    yes
 ct -verall                                                     yes

Output from all other commands is placed into a default 'List' object.
This is useful for '-short' listings that result in lists of items.
See the first code snippet in EXAMPLES section, below. 

                                                              works w/
 cleartool commands that return a "List" object              multitool?
 ----------------------------------------------------------  ----------
 ct describe -s brtype:$branchname                              yes
 ct describe -s replica:${repltag}@$vobtag                      yes
 ct lsview -s                                                   no

For commands that do not generate any text output, the result is 
ignored and no object is created.

To reiterate,
the object B<methods> for each resulting object are defined in the base
class B<ClearCase::Vob::InfoBase> while each of the various B<attributes> 
are created by the particular subclasses during parsing. While parsing 
the resulting output, any unknown or unrecognized text is placed in an 
attribute and the text is available via the B<getUnparsed> method.


=head2 Constructor

=over 4

=item new

Create a variable for use as a 'cleartool' command output parser.
Functions in this class can be invoked as 'class' or 'object' methods.

 $ctObj = new ClearCase::Vob::Info;              # "object" methods
 $ClearTool = "ClearCase::View::Info";           # "class" methods

 $objRef = new ClearCase::Vob::Info( $text );    # "class" methods
 $objRef = new ClearCase::Vob::Info( @text );

=back

=head2 Methods

=over 4

=item run ( ClearCaseCommand [, MatchCriteria ] )

Run a 'cleartool' command interpreter and parse the output. Remember,
a separate cleartool process is created for each command that is run.

 $objRef = $ctObj->run( $ClearCaseCmd );         # "object" methods
 $objRef = $ctObj->run( $ClearCaseCmd, $matchCriteria );

 $objRef = $ClearTool->run( $ClearCaseCmd );     # "class" methods
 $objRef = $ClearTool->run( $ClearCaseCmd, $matchCriteria );

=item parse ( Text )

Attempt to parse arbitrary text w/out running a cleartool process.

 $objRef = $ctObj->parse( $text );               # "object" methods
 $objRef = $ctObj->parse( @text );

 $objRef = new ClearCase::Vob::Info( $text );    # "class" methods
 $objRef = new ClearCase::Vob::Info( @text );

 $objRef = $ClearTool->parse( $text );           # "class" methods
 $objRef = $ClearTool->parse( @text );

=item getViewContext

Determine if the current process is running under a ClearCase view.

This method performs the I<correct> processing to determine the current
view context. It returns the proper I<View Tag> when the current working 
directory happens to be in a view other than the currently 'set' view name.

Since this adds overhead it is a separate method from the B<getView>
method, described below. As such, if a script that uses this class
changes the working directory to various I<View Tags> during execution,
the B<getViewContext> method should be used to determine the current view 
context for a given viewspace subdirectory.

Due to the performance penalty, this method must be invoked directly,
before calling the following methods.

=item getView

=item inView

=item noView

Determine if the current process is running under a ClearCase view 
based on the results of the last B<getViewContext> call.

Examples:

 $ctObj->getViewContext;  # Determine the view context

 $ctObj->getView;         # returns result from last getViewContext
 $ctObj->inView;          # returns 0 or 1 from last getViewContext
 $ctObj->noView;          # returns 0 or 1 from last getViewContext


=item getVersionContext

Determine the current ClearCase (or MultiSite) version.

Due to the performance penalty, this method must be invoked directly,
before calling the following methods.

=item getVersion

Return the entire version string obtained from the "-verall" subcommand.

=item getBaseVer

Return only the B<major> version number obtained from the "-verall" subcommand.

=item atVer

Determine if the B<major> version is B<exactly> a certain level or not.

=item isVer

Determine if the B<entire> version string is equal to a specific value.

=item minVer

=item atLeastVer

Determine if the B<major> version is B<at least> a certain level or not.

I.e., if the current major version is 4, than B<minVer> (and B<atLeastVer>)
will return B<true> for arguments 2, 3 and 4, but will return B<false>
for arguments 5 and greater.

Examples:

 $ctObj->getVersionContext;   # Determine the version context

 $ctObj->atVer( 3 );          # returns 0 or 1 from last getVersionContext
 $ctObj->atVer( 6 );

 $ctObj->isVer( "3.2" );      # returns 0 or 1 from last getVersionContext
 $ctObj->isVer( "2003.06.00" );

=item getAtriaHome

=item getAtriaBin

=item getAtriaHome

=item getAtriaBin

=item getAtriaConfig

=item getAtriaEtc

=item getAtriaJava

=item getAtriaLib

=item getAtriaShip

=item getAtriaShlib

=item getClearTool

=item getMultiTool

Return the current directory paths, relative to B<AtriaHome>. Note that 
the B<ATRIAHOME> environment variable, when set, will override any attempts
by this class to determine the correct value for the B<AtriaHome> directory.

Examples:

 $atriaHome = $ctObj->getAtriaHome;
 $atriaBin  = $ctObj->getAtriaBin;

 $cleartool = $ctObj->getClearTool
 $multitool = $ctObj->getMultiTool

=back

=head1 INHERITANCE

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

=head1 SEE ALSO

See L<ClearCase::Vob::Info::InfoBase>, L<PTools::Loader> and
L<PTools::Proc::Backtick>.

=head1 AUTHOR

Chris Cobb

=head1 COPYRIGHT

Copyright (c) 2002-2004 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

