#!/usr/local/bin/perl -w
# Manage naming conventions for type creation.
# NOTE: this same trigger is called for 'mktype', 'rntype', and 'rmtype' ops.

# Allow knowledgeable users to short-circuit the trigger with this EV.
BEGIN { exit 0 if $ENV{CLEARCASE_SKIP_MKTYPE_PRE} }

# Conceptually this is "use constant MSWIN ..." but ccperl can't do that.
# Perl 5.005 and above uses MSWin32, prior versions use Windows_NT. 
sub MSWIN { ($^O || $ENV{OS}) =~ /MSWin32|Windows_NT/i ? 1 : 0 }

# On Windows we must rely on PATH to find cleartool. On Unix,
# /usr/atria/bin/cleartool is always a valid path so we use it.
my $CT = MSWIN() ? 'cleartool' : '/usr/atria/bin/cleartool';

# Vobadm can make/remove any type (handled with -nuser, redundant here).
# exit 0 if $ENV{CLEARCASE_USER} =~ /^vobadm/;

# Determine what type of type is being made ...
# CLEARCASE_{BR,LB,AT}TYPE is set for that type creation, while
# NEW_TYPE is set during a rename.
my $type_name = $ENV{CLEARCASE_NEW_TYPE} ||
	       $ENV{CLEARCASE_LBTYPE} ||
	       $ENV{CLEARCASE_BRTYPE} ||
	       $ENV{CLEARCASE_ATTYPE};

# If this vob has an admin vob and the branch type has been created
# there, allow the automatic "pull" to go ahead by exiting with 0.
if ($ENV{CLEARCASE_VOB_PN}) {
   if (my(@adms) = grep /^->/, qx($CT desc -s -ahl AdminVOB vob:$ENV{CLEARCASE_VOB_PN})) {
      if (my $adm = (split(' ', $adms[0]))[1]) {
	 chomp $adm;
	 # It's not easy to derive whether we're making a 'brtype', 'lbtype',
	 # etc. Have to look for the CLEARCASE_*TYPE EV that's non-null.
	 my $kind;
	 while (($ev, $val) = each %ENV) {
	    if ($val && $ev =~ m/^CLEARCASE_(..TYPE)$/) {
	       $kind = lc $1;
	       last;
	    }
	 }
	 # Note: $adm already has vob: prefix on it, so don't add it here.
	 my $nul = MSWIN() ? 'NUL' : '/dev/null';
	 exit 0 if !system("$CT lst \"$kind:$type_name\@$adm\" >$nul 2>&1");
      }
   }
}

# We enforce slightly different rules for label, branch, and other 
# (generally attr) types. Start with the ClearCase convention of upper-
# case for labels and lower for branches; extend this to require
# mixed case for attributes.

# These users are allowed to create types which don't start with their
# username but they still must conform to the other standards. Thus
# they form a class between regular users and vobadm.
my $trusted_users = '';

if ($ENV{CLEARCASE_MTYPE} =~ /label/) {
   die "Error: $ENV{CLEARCASE_MTYPE}s must be upper-case! ($type_name)\n"
	 if uc($type_name) ne $type_name;
   # Now exit 0 if everything's ok.
   exit 0 if $trusted_users && $ENV{CLEARCASE_USER} =~ /^($trusted_users)$/i;
   my $u_user = uc($ENV{CLEARCASE_USER});
   exit 0 if $type_name =~ /^${u_user}_/;
   die qq(Error: user $ENV{CLEARCASE_MTYPE}s must match ${u_user}_*\n);
} elsif ($ENV{CLEARCASE_MTYPE} =~ /attr/) {
   die "Error: $ENV{CLEARCASE_MTYPE}s must be mixed-case! ($type_name)\n"
	 if lc($type_name) eq $type_name || uc($type_name) eq $type_name;
} else {
   die "Error: $ENV{CLEARCASE_MTYPE}s must be lower-case! ($type_name)\n"
	 if lc($type_name) ne $type_name;
   # Now exit 0 if everything's ok.
   exit 0 if $trusted_users && $ENV{CLEARCASE_USER} =~ /^($trusted_users)$/i;
   my $l_user = lc($ENV{CLEARCASE_USER});
   exit 0 if $type_name =~ /^${l_user}_/;
   die qq(Error: user $ENV{CLEARCASE_MTYPE}s must match ${l_user}_*\n);
}

__END__

=head1 DESCRIPTION

This trigger manages naming conventions for type creation. It enforces
the standard convention of uppercase label names and lowercase branch
names. It also extends this to require mixed-case attribute names.

Also, metadata types created by regular users must be prepended with
their user ID's.

=head1 AUTHOR

David Boyce (dsb@cleartool.com)

=head1 COPYRIGHT

Copyright (c) 1998-2002 David Boyce (dsb@cleartool.com), Clear Guidance
Consulting.  All rights reserved.