Skip to content

Commit

Permalink
Item1509: perltidy and remove comment-out code
Browse files Browse the repository at this point in the history 
git-svn-id: http://svn.foswiki.org/trunk@4384 0b4bb1d4-4e5a-0410-9cc4-b2b747904278
  • Loading branch information
MichaelTempest authored and MichaelTempest committed Jul 2, 2009
1 parent 3e2bada commit 135dbfe
Showing 1 changed file with 74 additions and 62 deletions.
136 changes: 74 additions & 62 deletions core/tools/extender.pl
View file
Expand Up @@ -36,11 +36,11 @@ package Foswiki::Extender;

no warnings 'redefine';

my $noconfirm = 0;
my $downloadOK = 0;
my $noconfirm = 0;
my $downloadOK = 0;
my $alreadyUnpacked = 0;
my $reuseOK = 0;
my $inactive = 0;
my $reuseOK = 0;
my $inactive = 0;
my $session;
my %available;
my $lwp;
Expand Down Expand Up @@ -189,16 +189,14 @@ sub remap {
}

sub compare_versions {
my ($a, $op, $b) = @_;
my ( $a, $op, $b ) = @_;

return 0 if not defined $op or not exists $STRINGOPMAP{$op};
return 0 if not defined $op or not exists $STRINGOPMAP{$op};
my $string_op = $STRINGOPMAP{$op};
#print "|$a$op$b|=>";
#my $field_length = max_field_length($a, $b);
#$a = string_comparable_version($a, $field_length);
#$b = string_comparable_version($b, $field_length);

my $largest_char = chr(255);

#print "|$a$op$b|=>";

my $largest_char = chr(255);

# remove leading and trailing whitespace
# because ' X' should compare equal to 'X'
Expand All @@ -207,22 +205,22 @@ sub compare_versions {
$b =~ s/^\s+//;
$b =~ s/\s+$//;

# $Rev$ without a number should compare higher than anything else
$a =~ s/^\$Rev:?\s*\$$/$largest_char/;
$b =~ s/^\$Rev:?\s*\$$/$largest_char/;
# $Rev$ without a number should compare higher than anything else
$a =~ s/^\$Rev:?\s*\$$/$largest_char/;
$b =~ s/^\$Rev:?\s*\$$/$largest_char/;

# remove the SVN marker text from the version number, if it is there
$a =~ s/^\$Rev: (\d+) \$$/$1/;
$b =~ s/^\$Rev: (\d+) \$$/$1/;

# swap the day-of-month and year around for ISO dates
my $isoDatePattern = qr/^\d{1,2}-\d{1,2}-\d{4}$/;
if ($a =~ $isoDatePattern and $b =~ $isoDatePattern) {
$a =~ s/^(\d+)-(\d+)-(\d+)$/$3-$2-$1/;
$b =~ s/^(\d+)-(\d+)-(\d+)$/$3-$2-$1/;
}
# Change separator characters to be the same,
# swap the day-of-month and year around for ISO dates
my $isoDatePattern = qr/^\d{1,2}-\d{1,2}-\d{4}$/;
if ( $a =~ $isoDatePattern and $b =~ $isoDatePattern ) {
$a =~ s/^(\d+)-(\d+)-(\d+)$/$3-$2-$1/;
$b =~ s/^(\d+)-(\d+)-(\d+)$/$3-$2-$1/;
}

# Change separator characters to be the same,
# because X-Y-Z should compare equal to X.Y.Z
# and combine adjacent separators,
# because '6 jun 2009' should compare equal to '6 jun 2009'
Expand All @@ -231,12 +229,14 @@ sub compare_versions {
$b =~ s([ ./_-]+)($separator)g;

# Replace month-names with numbers and swap day-of-month and year
# around to make them sortable as strings
# around to make them sortable as strings
# but only do this if both versions look like a date
my $datePattern = qr(\b\d{1,2}$separator$MNAME$separator\d{4}\b);
if ( $a =~ $datePattern and $b =~ $datePattern ) {
$a =~ s/(\d+)$separator($MNAME)$separator(\d+)/$3.$separator.$N2M{ lc($2) }.$separator.$1/ge;
$b =~ s/(\d+)$separator($MNAME)$separator(\d+)/$3.$separator.$N2M{ lc($2) }.$separator.$1/ge;
$a =~
s/(\d+)$separator($MNAME)$separator(\d+)/$3.$separator.$N2M{ lc($2) }.$separator.$1/ge;
$b =~
s/(\d+)$separator($MNAME)$separator(\d+)/$3.$separator.$N2M{ lc($2) }.$separator.$1/ge;
}

# convert to lowercase
Expand All @@ -254,37 +254,39 @@ sub compare_versions {

# work out how many characters there are in the longest sequence
# of digits between the two versions
my ($maxDigits) = reverse sort(
map { length($_) }
($a =~ /(\d+)/g),
($b =~ /(\d+)/g),
);
my ($maxDigits) =
reverse
sort( map { length($_) } ( $a =~ /(\d+)/g ), ( $b =~ /(\d+)/g ), );

# justify digit sequences so that they compare correctly.
# E.g. '063' lt '103'
$a =~ s/(\d+)/sprintf('%0'.$maxDigits.'u', $1)/ge;
$b =~ s/(\d+)/sprintf('%0'.$maxDigits.'u', $1)/ge;

# there is no need to justify non-digit sequences
# because 'alpha' compares less than 'beta'

# X should compare greater than X-beta1
# so append a high-value character to the
# non-beta version if one version looks like
# a beta and the other does not
if ($a =~ /^$b$separator?beta/) {
if ( $a =~ /^$b$separator?beta/ ) {

# $a is beta of $b
# $b should compare greater than $a
$b .= $largest_char;
}
elsif ($b =~ /^$a$separator?beta/) {
elsif ( $b =~ /^$a$separator?beta/ ) {

# $b is beta of $a
# $a should compare greater than $b
$a .= $largest_char;
}

my $comparison = "'$a' $string_op '$b'";
my $result = eval $comparison;
#print "[$comparison]->$result\n";
my $result = eval $comparison;

#print "[$comparison]->$result\n";
return $result;
}

Expand All @@ -304,7 +306,7 @@ sub check_dep {
# try to load the module
my $module = $dep->{name};
eval "require $module";
if ( $@ ) {
if ($@) {
$ok = 0;
( $msg = $@ ) =~ s/ in .*$/\n/s;
return ( $ok, $msg );
Expand All @@ -314,19 +316,20 @@ sub check_dep {
{
no strict 'refs';
$moduleVersion = ${"${module}::VERSION"};

# remove the SVN marker text from the version number, if it is there
$moduleVersion =~ s/^\$Rev: (\d+) \$$/$1/;
}

# check if the version satisfies the prerequisite
if ( defined $dep->{version} and $dep->{version} ne '') {
if ( defined $dep->{version} and $dep->{version} ne '' ) {

# the version field is in fact a condition
if ( $dep->{version} =~ /^\s*(?:>=?)?\s*([0-9a-z._-]+)/ ) {

# Condition is >0 or >= 1.3
my $requiredVersion = $1;
if ( compare_versions($moduleVersion, '<', $requiredVersion) ) {
if ( compare_versions( $moduleVersion, '<', $requiredVersion ) ) {

# But module doesn't meet this condition
$msg = "$module version $requiredVersion required"
Expand All @@ -340,7 +343,7 @@ sub check_dep {
# Condition is < 2.7
my $requiredVersion = $1;

if ( compare_versions($moduleVersion, '>=', $requiredVersion) ) {
if ( compare_versions( $moduleVersion, '>=', $requiredVersion ) ) {

# But module doesn't meet this condition
$ok = 0;
Expand Down Expand Up @@ -711,12 +714,11 @@ sub unzip {
my $archive = shift;

eval 'require Archive::Zip';
if ( $@ ) {
my $zip = Archive::Zip->new();
if ($@) {
my $zip = Archive::Zip->new();
my $err = $zip->read($archive);
if ( $err ) {
print STDERR "Could not openzip file $archive ("
. $err . "\n";
if ($err) {
print STDERR "Could not openzip file $archive (" . $err . "\n";
return 0;
}

Expand Down Expand Up @@ -754,7 +756,7 @@ sub untar {
my $compressed = ( $archive =~ /z$/i ) ? 'z' : '';

eval 'require Archive::Tar';
if ( $@ ) {
if ($@) {
my $tar = Archive::Tar->new();
my $numberOfFiles = $tar->read( $archive, $compressed );
unless ( $numberOfFiles > 0 ) {
Expand Down Expand Up @@ -871,19 +873,21 @@ sub _uninstall {
return 1 if $inactive;
my $reply = ask("Are you SURE you want to uninstall $MODULE?");
if ($reply) {
if (defined &Foswiki::preuninstall) {
if ( defined &Foswiki::preuninstall ) {
Foswiki::preuninstall();
} elsif (defined &TWiki::preuninstall) {
}
elsif ( defined &TWiki::preuninstall ) {
TWiki::preuninstall();
}
foreach $file ( keys %$MANIFEST ) {
if ( -e $file ) {
unlink($file);
}
}
if (defined &Foswiki::postuninstall) {
if ( defined &Foswiki::postuninstall ) {
Foswiki::postuninstall();
} elsif (defined &TWiki::postuninstall) {
}
elsif ( defined &TWiki::postuninstall ) {
TWiki::postuninstall();
}
print "### $MODULE uninstalled ###\n";
Expand All @@ -910,14 +914,16 @@ sub _emplace {
print "Install $target, permissions $MANIFEST->{$file}->{perms}\n";
unless ($inactive) {
if ( -e $target ) {
# Save current permissions, remove write protect for Windows sake,
# Back up the file and then restore the original permissions
my $mode = (stat($file))[2];
chmod( oct(600), "$target");
chmod( oct(600), "$target.bak") if ( -e "$target.bak");

# Save current permissions, remove write protect for Windows sake,
# Back up the file and then restore the original permissions
my $mode = ( stat($file) )[2];
chmod( oct(600), "$target" );
chmod( oct(600), "$target.bak" ) if ( -e "$target.bak" );
if ( File::Copy::move( $target, "$target.bak" ) ) {
chmod( $mode, "$target.bak");
} else {
chmod( $mode, "$target.bak" );
}
else {
print STDERR "Could not create $target.bak: $!\n";
}
}
Expand Down Expand Up @@ -1043,31 +1049,36 @@ sub _install {
{
no strict 'refs';
$moduleVersion = ${"${path}::VERSION"};

# remove the SVN marker text from the version number, if it is there
$moduleVersion =~ s/^\$Rev: (\d+) \$$/$1/;
}

if ($moduleVersion) {
return 0
unless ask( "$MODULE version $moduleVersion is already installed."
. " Are you sure you want to re-install this module?" );
unless ask(
"$MODULE version $moduleVersion is already installed."
. " Are you sure you want to re-install this module?"
);
print "I will keep a backup of any files I overwrite.";
}
}

if ($alreadyUnpacked) {
print "Archive has already been unpacked.\n";
} else {
}
else {
print "Fetching the archive for $path.\n";
my $archive = getArchive($MODULE);

unless ($archive) {
print STDERR "Unable to locate suitable archive for install";
return 0;
}
if (defined &Foswiki::preinstall) {
if ( defined &Foswiki::preinstall ) {
Foswiki::preinstall();
} elsif (defined &TWiki::preinstall) {
}
elsif ( defined &TWiki::preinstall ) {
TWiki::preinstall();
}
my $tmpdir = unpackArchive($archive);
Expand All @@ -1082,7 +1093,8 @@ sub _install {
}
if ( defined &Foswiki::postinstall ) {
Foswiki::postinstall();
} elsif( defined &TWiki::postinstall ) {
}
elsif ( defined &TWiki::postinstall ) {
TWiki::postinstall();
}

Expand Down

0 comments on commit 135dbfe

Please sign in to comment.