# -*- Perl -*-
#
# File:  ClearCase/View/Info.pm
# Desc:  Parse output from ClearCase commands.
# Auth:  Chris Cobb
# Date:  Thu Sep 27 16:13:49 2001
# Stat:  Prototype
#
# Note:  Objects of this class are not useful. This "factory" class 
#        instantiates 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 ClearCase::View::Info;
#
#        $objRef = new ClearCase::View::Info( $text );
#  or    $objRef = new ClearCase::View::Info( @text );
#
#        $objRef = run ClearCase::View::Info( $ClearToolCmd );
#  or    $objRef = run ClearCase::View::Info( $ClearToolCmd, $matchCriteria );
#
#  or    $ClearView = "ClearCase::View::Info";
#        $ClearView->run( $ClearToolCmd );
#

package ClearCase::View::Info;
 use strict;

 my $PACK = __PACKAGE__;
 use vars qw( $VERSION @ISA );
 $VERSION = '0.03';
#@ISA     = qw( );

 use PTools::Loader;
 use PTools::Proc::Backtick;

 my $AtriaBin  = "/usr/atria/bin";
 my $ClearTool = "$AtriaBin/cleartool";


sub setView { $_[0]->{_view} = $_[1] }
sub getView { return( $_[0]->{_view}   || "" ) }
sub inView  { return( $_[0]->{_view} ? 1 : 0 ) }
sub noView  { return( $_[0]->{_view} ? 0 : 1 ) }

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

   *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 );

  # DON'T DO THIS. Let it return a new List object
  # 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] =~ /^(.*)( "|:)/;

    $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.
    #
    # FIX: change this to the "ViewList", "ViewType" pairing
    #      that is now used everywhere else.
    #
    $module = "ViewList"  if ($module eq "Tag");
    $module = "List"      if ($module eq "Properties");

    ##$module =~ s/Tag/View/;

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

    } elsif ( ( $text[0] =~ m#^(\*|\s)\s(\S+)\s+(\S+)$# )
      and     ( $text[1] =~ m#^Created\s# )    ) {

	$module = "ViewList";           # -pro [ -full ]  { viewtag | * }
    }

    #_________________________________________________________
    # Attempt to load a "ClearCase::View::Info..." module. If 
    # that fails then abort with an appropriate error message.
    #
    my $moduleClass   = $PACK ."::". $module;
    my($err,@errArgs) = PTools::Loader->use( $moduleClass );

    $err and PTools::Loader->abort( $err, @errArgs );

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


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

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

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

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

    my(@result) = ();

    $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;

    $obj->setErr( $cmdRef->status );

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