Welcome To Our Shell

Mister Spy & Souheyl Bypass Shell

#!/opt/perl_5.8.8/bin/perl -w

use strict;
use Getopt::Long qw(GetOptions);
use Pod::Usage qw(pod2usage);
#use ClearCase::CtCmd qw(cleartool);
#use ClearCase::MtCmd qw(multitool);
use File::Temp qw(tempfile);

our $VERSION = '1.0';

# default options
my %opt = (
);
unless(GetOptions(\%opt, qw(
  help!
  man!
  branch=s
  dryrun!
))) {
  pod2usage(-exitval => 1, -verbose => 0);
}

if($opt{help}) {
  print "\n$0 Version $VERSION\n\n";
  pod2usage(-exitval => 0, -verbose => 0);
}
if($opt{man}) {
  pod2usage(-exitval => 0, -verbose => 3);
}


#***************************************************************

$main::DIFF  = "/opt/TWWfsw/bin/gnudiff";
$main::PATCH = "/opt/TWWfsw/bin/gpatch";

my $merge_obj = SCMerge->new();
#use Data::Dumper; print Dumper(\%opt); exit;
$merge_obj->diff($opt{'branch'},$opt{'main'},$opt{'dryrun'});

   $merge_obj->log("--------------------------------------");
   if ($merge_obj->log() =~ /ERROR/) {
      $merge_obj->log("ERROR. Not correctly merged.");
   } else {
      $merge_obj->log("Merge OK.");
   }



#***************************************************************

package SCMerge;

use strict;
use Data::Dumper;
#use ClearCase::CtCmd qw(cleartool);

sub new {

   my $class = shift;
   my $self  = {};
   bless($self,$class);
   return($self);
   
}

#*********************************************************************

sub diff {

   my $self    = shift;
   my $branch  = shift;
   my $dry_run = shift;

   $self->{'LOG'} = "";

   my $status; my $stdout; my $stderr; my $changed_elements; my $text;
   my $pre; my $file; my $element; my $o; my $label;

   if (!$branch) {
      $self->log("ERROR: Branch must be given.\n");
      return(1100);
   }

# the standard remark, used via checkout
   my $remark =
    "Changes from taskbranch $branch applied an re-merged by scmerge.";

   if ($dry_run) {
      $self->log("scmerge DRYRUN\n\n");
   } else {
      $self->log("scmerge RUN\n\n");
   }

#  Compute the label of the task branch merger

   ($status,$label,$stderr) = cleartool(
       "describe -fmt '\%\[hlink:DELIVERED_TO\]p\n' brtype:$branch");
   if ($status) {
      $self->log("ERROR. Cleartool Error. Status: $status\n$stderr");
      return(1199);
   }

#  if this label is not found, the task branch is not yet merged

   if ($label !~ s/lbtype\:(.*?)\@/$1/s) {
      $self->log("ERROR: Branch $branch not merged.");
      return(1101);
   }

#  Compute the list of all elements that have changed from predecessor
#  version of merge point to the merge point version

   ($status,$changed_elements,$stderr) = cleartool(
                "find -avob -element 'brtype($branch)' " .
                "-version 'lbtype($label)' -print");
   if ($status) {
      $self->log("ERROR. Cleartool Error. Status: $status\n$stderr");
      return(1199);
   }
   
#  List of all changed elements at merge

   foreach $file (sort split(/\n/,$changed_elements)) {

#  Computing of predecessor and elementname

      ($status,$pre,$stderr) = cleartool("describe -fmt \"\%En|\%PVn\" $file");
      if ($status) {
         $self->log("ERROR. Cleartool Error. Status: $status\n$stderr");
         return(1199);
      }
      if ($pre =~ /^(.*)\|(.*)$/) {
         $element = $1;
         $pre     = $1 . "\@\@" . $2;
      }

#  If we dry run

      if ($dry_run) {
         $self->log("Dryrun. Element $file would be changed.");
      }

#  if we have a directory 

      elsif (-d $element and -d $file) {
         $text = cleartool("diff -serial $pre $file");
         ($status,$stdout,$stderr) = cleartool("co -c '$remark' $element");
         if ($status) {
            $self->log("ERROR. Cleartool Error. Status: $status\n$stderr");
            return(1199);
         }
         while ($text =~ s/\n *\< *(.*?) (\S+) +(\S+)\n/\n/s) {
            $o = $1;
            if (!(-f "$element/$o")) {
               $self->log("ERROR. File $element/$o does not exist, cannot be deleted.\n");
            } else {
               ($status,$pre,$stderr) = cleartool("rmname $element/$2");
               if ($status) {
                  $self->log("ERROR. Cleartool Error. Status: $status\n$stderr");
                  return(1199);
               }
            }
         }
         while ($text =~ s/\n *\> *(.*?) (\S+) +(\S+)\n/\n/s) {
            $o = $1;
            if (-f "$file/$o") {
               $self->log("ERROR. File $element/$o exists, cannot be hardlinked.\n");
            } else {
               ($status,$pre,$stderr) = cleartool("ln $element/$2 .");
               if ($status) {
                  $self->log("ERROR. Cleartool Error. Status: $status\n$stderr");
                  return(1199);
               }
            }
         }

      }

# if we have a file

      elsif (-f $element and -f $file) {
         system("$main::DIFF -u $pre $file > $element.PATCH &> /dev/null");
         if (!(-f "$element.PATCH")) {
            $self->log("ERROR: Patch $element.PATCH could not be stored.");
         } else {
            ($status,$stdout,$stderr) = cleartool("co -c '$remark' $element");
            if ($status) {
               $self->log("ERROR. Cleartool Error. Status: $status\n$stderr");
               return(1199);
            }
            system("$main::PATCH $element $element.PATCH &> $element.ERROR");
            open(FFILE,"<$element.ERROR");
            $o = join("",<FFILE>);
            close(FFILE);
            unlink("$element.ERROR");
            if ($o =~ /\S/) {
               $self->log("ERROR. PATCH not successful with Element $element.\n");
            } else {
               $self->log("Element $element successfully patched.\n");
            }
         }
      }


#  if it happens to be $element and $file are directory/file resp. vice versa

      elsif ((-d $element and -f $file) or (-d $element and -f $file)) { 
         $self->log("ERROR: Element $element and $file are of different type");
     
      }


# if the item cannot be found in v2

      else {
         $self->log("ERROR: Element $element not found or wrong type.");
      }


   }

   if ($self->log() =~ /ERROR/) {
      $self->log("ERROR. Not correctly merged.");
   } else {
      $self->log("Merge OK.");
   }

   return($self->{'LOG'});

   
}

#*********************************************************************


sub log {

   my $self = shift;
   my $text = shift;

   if ($text) {
      $self->{'LOG'} = $self->{'LOG'} . $text . "\n";
      print $text . "\n";
   }

   return($self->{'LOG'});


}


#*********************************************************************


sub xxcleartool {

   my $o = shift;
   open(FFILE,">tmp.1");
   print FFILE "ct " . $o . "\n";
   close(FFILE);
   system("tcsh tmp.1 > tmp.2");
   open(FFILE,"<tmp.2");
   $o = join("",<FFILE>);
   close(FFILE);
   return($o);
   
}




1;

 





__END__

=head1 NAME

scmerge

=head1 SYNOPSIS

B<scmerge> S<{ B<-help> | B<-man> }>

=head1 DESCRIPTION

=head1 OPTIONS

=over 4

=item B<-help>

perl scmerge --branch <branch> --main <main> [--dryrun]

=item B<-man>

Show this detailed manual.

=back

=head1 ENVIRONMENT

=head1 FILES

=head1 SEE ALSO

L<ClearCase::CtCmd>, L<ClearCase::MtCmd>

=cut