mirror of
https://github.com/upx/upx.git
synced 2025-08-11 22:52:30 +08:00
New upstream version.
committer: mfx <mfx> 1101602738 +0000
This commit is contained in:
Markus F.X.J. Oberhumer
@ -7,8 +7,8 @@
|
||||
### ###
|
||||
##############################################################
|
||||
|
||||
## $Revision: 2.57 $
|
||||
## $Date: 2004/07/10 19:38:37 $
|
||||
## $Revision: 2.58 $
|
||||
## $Date: 2004/11/07 15:28:35 $
|
||||
## $Author: fluffy $
|
||||
##
|
||||
|
||||
@ -17,8 +17,8 @@ use strict;
|
||||
use File::Basename qw( fileparse );
|
||||
use Getopt::Long qw( GetOptions );
|
||||
use Text::Wrap qw( );
|
||||
use User::pwent qw( getpwnam );
|
||||
use Time::Local qw( timegm );
|
||||
use User::pwent qw( getpwnam );
|
||||
|
||||
# The Plan:
|
||||
#
|
||||
@ -141,7 +141,7 @@ use Time::Local qw( timegm );
|
||||
# Globals --------------------------------------------------------------------
|
||||
|
||||
# In case we have to print it out:
|
||||
my $VERSION = '$Revision: 2.57 $';
|
||||
my $VERSION = '$Revision: 2.58 $';
|
||||
$VERSION =~ s/\S+\s+(\S+)\s+\S+/$1/;
|
||||
|
||||
## Vars set by options:
|
||||
@ -955,7 +955,20 @@ sub pretty_file_list {
|
||||
# -------------------------------------
|
||||
|
||||
sub output_tagdate {
|
||||
# NOT YET DONE
|
||||
my $self = shift;
|
||||
my ($fh, $time, $tag) = @_;
|
||||
|
||||
my ($y, $m, $d, $H, $M, $S) = (gmtime($time))[5,4,3,2,1,0];
|
||||
|
||||
# Ideally, this would honor $UTC_Times and use +HH:MM syntax
|
||||
my $isoDate = sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ",
|
||||
$y + 1900, $m + 1, $d, $H, $M, $S);
|
||||
|
||||
print $fh "<tagdate>\n";
|
||||
print $fh "<tagisodate>$isoDate</tagisodate>\n";
|
||||
print $fh "<tagdatetag>$tag</tagdatetag>\n";
|
||||
print $fh "</tagdate>\n\n";
|
||||
return;
|
||||
}
|
||||
|
||||
# -------------------------------------
|
||||
@ -1051,11 +1064,6 @@ sub _revision_is_wanted {
|
||||
my $follow_branches = $self->{follow_branches};
|
||||
my $follow_only = $self->{follow_only};
|
||||
|
||||
#print STDERR "IG: ", join(',', keys %{$self->{ignore_tags}}), "\n";
|
||||
#print STDERR "IX: ", join(',', @{$qunk->{tags}}), "\n" if defined $qunk->{tags};
|
||||
#print STDERR "IQ: ", join(',', keys %{$qunk->{branch_numbers}}), "\n" if defined $qunk->{branch_numbers};
|
||||
#use Data::Dumper; print STDERR Dumper $qunk;
|
||||
|
||||
for my $ignore_tag (keys %{$self->{ignore_tags}}) {
|
||||
return
|
||||
if defined $qunk->{tags} and grep $_ eq $ignore_tag, @{$qunk->{tags}};
|
||||
@ -1095,12 +1103,13 @@ sub _revision_is_wanted {
|
||||
($branch_number . ".") ) {
|
||||
if ( $followsub ) {
|
||||
return 1;
|
||||
} elsif (length($revision) == length($branch_number)+2 ) {
|
||||
# } elsif ( length($revision) == length($branch_number)+2 ) {
|
||||
} elsif ( substr($revision, length($branch_number)+1) =~ /^\d+$/ ) {
|
||||
return 1;
|
||||
}
|
||||
} elsif ( length($branch_number) > length($revision)
|
||||
and
|
||||
$No_Ancestors ) {
|
||||
! $No_Ancestors ) {
|
||||
# Non-trivial case: check if rev is ancestral to branch
|
||||
|
||||
# r_left still has the trailing "."
|
||||
@ -1213,13 +1222,13 @@ my $self = shift; my $class = ref $self;
|
||||
# XML output includes everything else, we might as well make
|
||||
# it always include Day Of Week too, for consistency.
|
||||
my $authorhash = $changelog{$time};
|
||||
if ($Show_Tag_Dates) {
|
||||
if ( $Show_Tag_Dates || $XML_Output ) {
|
||||
my %tags;
|
||||
while (my ($author,$mesghash) = each %$authorhash) {
|
||||
while (my ($msg,$qunk) = each %$mesghash) {
|
||||
foreach my $qunkref2 (@$qunk) {
|
||||
for my $qunkref2 (@$qunk) {
|
||||
if (defined ($qunkref2->tags)) {
|
||||
foreach my $tag (@{$qunkref2->tags}) {
|
||||
for my $tag (@{$qunkref2->tags}) {
|
||||
$tags{$tag} = 1;
|
||||
}
|
||||
}
|
||||
@ -1924,22 +1933,38 @@ sub grand_poobah { $_[0]->{grand_poobah} }
|
||||
sub read_changelog {
|
||||
my ($self, $command) = @_;
|
||||
|
||||
# my $grand_poobah = CVS::Utils::ChangeLog::EntrySet->new;
|
||||
|
||||
local (*READER, *WRITER);
|
||||
my $pid;
|
||||
if (! $Input_From_Stdin) {
|
||||
my $Log_Source_Command = join(' ', @$command);
|
||||
&main::debug ("(run \"${Log_Source_Command}\")\n");
|
||||
open (LOG_SOURCE, "$Log_Source_Command |")
|
||||
or die "unable to run \"${Log_Source_Command}\"";
|
||||
pipe(READER, WRITER)
|
||||
or die "Couldn't form pipe: $!\n";
|
||||
$pid = fork;
|
||||
die "Couldn't fork: $!\n"
|
||||
if ! defined $pid;
|
||||
if ( ! $pid ) { # child
|
||||
open STDOUT, '>&=' . fileno WRITER
|
||||
or die "Couldn't dup stderr to ", fileno WRITER, "\n";
|
||||
# strangely, some perls give spurious warnings about STDIN being opened
|
||||
# for output only these close calls precede the STDOUT reopen above.
|
||||
# I think they must be reusing fd 1.
|
||||
close READER;
|
||||
close STDIN;
|
||||
|
||||
exec @$command;
|
||||
}
|
||||
|
||||
close WRITER;
|
||||
|
||||
&main::debug ("(run \"@$command\")\n");
|
||||
}
|
||||
else {
|
||||
open (LOG_SOURCE, "-") or die "unable to open stdin for reading";
|
||||
open READER, '-' or die "unable to open stdin for reading";
|
||||
}
|
||||
|
||||
binmode LOG_SOURCE;
|
||||
binmode READER;
|
||||
|
||||
XX_Log_Source:
|
||||
while (<LOG_SOURCE>) {
|
||||
while (<READER>) {
|
||||
chomp;
|
||||
s!\r$!!;
|
||||
|
||||
@ -1967,17 +1992,19 @@ sub read_changelog {
|
||||
# log message texts:
|
||||
$self->{rev_msg} .= $_ . "\n"; # Normally, just accumulate the message...
|
||||
} else {
|
||||
my $noadd = 0;
|
||||
if ( ! $self->{rev_msg}
|
||||
or $self->{rev_msg} =~ /^\s*(\.\s*)?$/
|
||||
or index($self->{rev_msg}, EMPTY_LOG_MESSAGE) > -1 ) {
|
||||
# ... until a msg separator is encountered:
|
||||
# Ensure the message contains something:
|
||||
$self->clear_msg
|
||||
$self->clear_msg, $noadd = 1
|
||||
if $Prune_Empty_Msgs;
|
||||
$self->{rev_msg} = "[no log message]\n";
|
||||
}
|
||||
|
||||
$self->add_file_entry;
|
||||
$self->add_file_entry
|
||||
unless $noadd;
|
||||
|
||||
if ( $_ eq FILE_SEPARATOR ) {
|
||||
$self->clear_file;
|
||||
@ -1987,9 +2014,15 @@ sub read_changelog {
|
||||
}
|
||||
}
|
||||
|
||||
close LOG_SOURCE
|
||||
or die sprintf("Problem reading log input (exit/signal/core: %d/%d/%d)\n",
|
||||
$? >> 8, $? & 127, $? & 128);
|
||||
close READER
|
||||
or die "Couldn't close pipe reader: $!\n";
|
||||
if ( defined $pid ) {
|
||||
my $rv;
|
||||
waitpid $pid, 0;
|
||||
0 == $?
|
||||
or $!=1, die sprintf("Problem reading log input (pid/exit/signal/core: %d/%d/%d/%d)\n",
|
||||
$pid, $? >> 8, $? & 127, $? & 128);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
@ -2126,9 +2159,8 @@ sub read_file_path {
|
||||
($base, undef, undef) = fileparse($path);
|
||||
|
||||
my $xpath = $Case_Insensitive ? lc($path) : $path;
|
||||
if ( grep index($path, $_) > -1, @Ignore_Files ) {
|
||||
return;
|
||||
}
|
||||
return
|
||||
if grep $path =~ /$_/, @Ignore_Files;
|
||||
}
|
||||
|
||||
$self->{filename} = $path;
|
||||
@ -2398,7 +2430,7 @@ sub derive_changelog {
|
||||
my $accumulation_date = maybe_grab_accumulation_date;
|
||||
if ($accumulation_date) {
|
||||
# Insert -d immediately after 'cvs log'
|
||||
my $Log_Date_Command = "-d\'>${accumulation_date}\'";
|
||||
my $Log_Date_Command = "-d>${accumulation_date}";
|
||||
|
||||
my ($log_index) = grep $command->[$_] eq 'log', 0..$#$command;
|
||||
splice @$command, $log_index+1, 0, $Log_Date_Command;
|
||||
@ -2455,6 +2487,7 @@ sub common_path_prefix {
|
||||
}
|
||||
|
||||
# -------------------------------------
|
||||
|
||||
sub parse_options {
|
||||
# Check this internally before setting the global variable.
|
||||
my $output_file;
|
||||
@ -2604,7 +2637,7 @@ sub parse_options {
|
||||
)
|
||||
or die "options parsing failed\n";
|
||||
|
||||
push @log_source_command, map "'$_'", @ARGV;
|
||||
push @log_source_command, map "$_", @ARGV;
|
||||
|
||||
## Check for contradictions...
|
||||
|
||||
@ -2857,7 +2890,8 @@ times.
|
||||
=item B<-I> I<REGEXP>, B<--ignore> I<REGEXP>
|
||||
|
||||
Ignore files whose names match I<REGEXP>. This option may be used multiple
|
||||
times.
|
||||
times. The regexp is a perl regular expression. It is matched as is; you may
|
||||
want to prefix with a ^ or suffix with a $ to anchor the match.
|
||||
|
||||
=item B<-C>, B<--case-insensitive>
|
||||
|
||||
@ -3037,6 +3071,14 @@ systems) for more information.
|
||||
|
||||
Note that the rules for quoting under windows shells are different.
|
||||
|
||||
=item *
|
||||
|
||||
To run in an automated environment such as CGI or PHP, suidperl may be needed
|
||||
in order to execute as the correct user to enable /cvsroot read lock files to
|
||||
be written for the 'cvs log' command. This is likely just a case of changing
|
||||
the /usr/bin/perl command to /usr/bin/suidperl, and explicitly declaring the
|
||||
PATH variable.
|
||||
|
||||
=back
|
||||
|
||||
=head1 EXAMPLES
|
||||
@ -3098,6 +3140,8 @@ Contributions from
|
||||
|
||||
=item Terry Kane
|
||||
|
||||
=item Pete Kempf
|
||||
|
||||
=item Akos Kiss
|
||||
|
||||
=item Claus Klein
|
||||
@ -3120,7 +3164,11 @@ Contributions from
|
||||
|
||||
=item Thomas Parmelan
|
||||
|
||||
=item Johanne Stezenbach
|
||||
=item Jordan Russell
|
||||
|
||||
=item Jacek Sliwerski
|
||||
|
||||
=item Johannes Stezenbach
|
||||
|
||||
=item Joseph Walton
|
||||
|
||||
|
||||
Reference in New Issue
Block a user