summaryrefslogtreecommitdiff
path: root/bin/cle.pl
diff options
context:
space:
mode:
Diffstat (limited to 'bin/cle.pl')
-rwxr-xr-xbin/cle.pl289
1 files changed, 0 insertions, 289 deletions
diff --git a/bin/cle.pl b/bin/cle.pl
deleted file mode 100755
index 03f8785f7cd..00000000000
--- a/bin/cle.pl
+++ /dev/null
@@ -1,289 +0,0 @@
-eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
- & eval 'exec perl -S $0 $argv:q'
- if 0;
-
-# ******************************************************************
-# Author: Chad Elliott
-# Date: 6/18/2002
-# $Id$
-# ******************************************************************
-
-use strict;
-use Cwd;
-use File::Basename;
-use Sys::Hostname;
-
-if ( $^O eq 'VMS' ) {
- require VMS::Filespec;
- import VMS::Filespec qw(unixpath);
-}
-
-unshift(@INC, getExecutePath($0) . 'ChangeLogEditor');
-
-require ChangeLogEdit;
-require EmailTranslator;
-
-# ************************************************************
-# Subroutine Section
-# ************************************************************
-
-sub which {
- my($prog) = shift;
- my($exec) = $prog;
- my($part) = '';
- if ( $^O eq 'VMS' ) {
- my($envSep) = ';';
- if (defined $ENV{'PATH'}) {
- foreach $part (split(/$envSep/, $ENV{'PATH'})) {
- $part .= "$prog";
- if ( -x $part ) {
- $exec = $part;
- last;
- }
- }
- }
- }
- else {
- my($envSep) = ($^O eq 'MSWin32' ? ';' : ':');
- if (defined $ENV{'PATH'}) {
- foreach $part (split(/$envSep/, $ENV{'PATH'})) {
- $part .= "/$prog";
- if ( -x $part ) {
- $exec = $part;
- last;
- }
- }
- }
- }
-
- return $exec;
-}
-
-
-sub getExecutePath {
- my($prog) = shift;
- my($loc) = '';
-
- if ( $^O eq 'VMS' ) {
- if ($prog ne basename($prog)) {
- my($dir) = unixpath( dirname($prog) );
- if ($prog =~ /^[\/\\]/) {
- $loc = $dir;
- }
- else {
- $loc = unixpath(getcwd()) . $dir;
- }
- }
- else {
- $loc = unixpath( dirname(which($prog)) );
- }
-
- if ($loc eq '.') {
- $loc = unixpath( getcwd() );
- }
- } else {
- if ($prog ne basename($prog)) {
- if ($prog =~ /^[\/\\]/ ||
- $prog =~ /^[A-Za-z]:[\/\\]?/) {
- $loc = dirname($prog);
- }
- else {
- $loc = getcwd() . '/' . dirname($prog);
- }
- }
- else {
- $loc = dirname(which($prog));
- }
-
- $loc =~ s/\/\.$//;
-
- if ($loc eq '.') {
- $loc = getcwd();
- }
-
- if ($loc ne '') {
- $loc .= '/';
- }
- }
-
- return $loc;
-}
-
-sub getDefaultDomain {
- my($domain) = undef;
- my($host) = hostname();
-
- if (defined $host) {
- ## First try the hostname
- if ($host =~ /[^\.]+\.(.*)/) {
- $domain = $1;
- }
- else {
- ## Next try the hosts file
- my($hosts) = ($^O eq 'MSWin32' ?
- "$ENV{SystemRoot}/system32/drivers/etc/hosts" :
- '/etc/hosts');
- my($fh) = new FileHandle();
- if (open($fh, $hosts)) {
- while(<$fh>) {
- if (/$host\.(.*)/) {
- $domain = $1;
- last;
- }
- }
- close($fh);
- }
-
- if (!defined $domain) {
- ## Next try ipconfig on Windows
- if ($^O eq 'MSWin32') {
- if (open($fh, 'ipconfig /all |')) {
- while(<$fh>) {
- if (/Primary\s+DNS\s+Suffix[^:]+:\s+(.*)/) {
- $domain = $1;
- }
- elsif (/DNS\s+Suffix\s+Search[^:]+:\s+(.*)/) {
- $domain = $1;
- }
- }
- close($fh);
- }
- }
- else {
- ## Try /etc/resolv.conf on UNIX
- if (open($fh, '/etc/resolv.conf')) {
- while(<$fh>) {
- if (/search\s+(.*)/) {
- $domain = $1;
- last;
- }
- }
- close($fh);
- }
- }
- }
- }
- }
- return $domain;
-}
-
-
-sub usageAndExit {
- my($arg) = shift;
- my($base) = basename($0);
- if (defined $arg) {
- print "$arg\n\n";
- }
- print "Usage: $base [ChangeLog File] [user name] [email address]\n" .
- " " . (' ' x length($base)) . "[-d <dir1 dir2 ... dirN>]\n\n" .
- " Uses cvs to determine which files are modified or added\n" .
- " and generates a bare ChangeLog entry based on those files.\n" .
- " This script should be run at the same directory level in\n" .
- " which the ChangeLog exists. The entry is prepended to the\n" .
- " existing ChangeLog.\n" .
- "\n" .
- " Email addresses are generated with a certain set of\n" .
- " defaults and can be modified using various environment\n" .
- " variables. By default email addresses are generated\n" .
- " using the user last name followed by an underscore and\n" .
- " the first initial of the user first name followed by the\n" .
- " email domain.\n" .
- "\n" .
- " REPLYTO If this environment variable is set, the value\n" .
- " is used as the email address.\n" .
- " CL_USERNAME This environment variable is used to override\n" .
- " the user name (obtained from the password file).\n" .
- "\n" .
- " The user name and email address can be passed as a parameter to\n" .
- " this script. If either is not passed, then the script will try\n" .
- " to determine it automatically.\n" .
- "\n" .
- " If -d is used, everything on the command line after it is\n" .
- " considered a directory or file to be considered in the\n" .
- " ChangeLog entry.\n";
- exit(0);
-}
-
-
-# ************************************************************
-# Subroutine Section
-# ************************************************************
-
-my($file) = undef;
-my($name) = undef;
-my($email) = undef;
-my(@dirs) = ();
-my($restdirs) = 0;
-
-foreach my $arg (@ARGV) {
- if ($restdirs) {
- push(@dirs, $arg);
- }
- elsif ($arg eq '-h') {
- usageAndExit();
- }
- elsif ($arg eq '-d') {
- $restdirs = 1;
- }
- elsif ($arg =~ /^\-/) {
- usageAndExit("Unrecognized parameter: $arg");
- }
- elsif (!defined $file) {
- $file = $arg;
- }
- elsif (!defined $name) {
- $name = $arg;
- }
- elsif (!defined $email) {
- $email = $arg;
- }
-}
-
-if (!defined $file) {
- $file = 'ChangeLog';
-}
-if (!defined $name) {
- my(@pwd) = ();
- if (defined $ENV{CL_USERNAME}) {
- $pwd[6] = $ENV{CL_USERNAME};
- }
- else {
- if ($^O eq 'MSWin32' || $^O eq 'cygwin') {
- $pwd[6] = 'unknown';
- }
- else {
- @pwd = getpwuid($<);
- $pwd[6] =~ s/,//g;
- }
- }
- $name = $pwd[6];
-}
-
-if (!defined $email) {
- my($trans) = new EmailTranslator(getDefaultDomain());
- $email = $trans->translate($name);
-}
-
-my($editor) = new ChangeLogEdit($name, $email);
-my($status, $error, $unknown) = $editor->edit($file, @dirs);
-
-if (defined $unknown) {
- my(@uarray) = @$unknown;
- if ($#uarray >= 0) {
- print "WARNING: The following files are unknown to the ",
- "revsion control system:\n";
- foreach my $unk (@uarray) {
- print "$unk\n";
- }
- print "\n";
- }
-}
-
-if ($status) {
- print "You are now ready to edit the $file.\n";
-}
-else {
- print "$error\n";
-}
-
-exit($status ? 0 : 1);
View Lorry Controller Status