From: Steve Hancock Date: Sun, 4 Dec 2022 02:33:45 +0000 (-0800) Subject: changed get_perltidy.pl from symlink to file X-Git-Tag: 20221112.02~26 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=0d2db366e3c619d077b5d0ccc9b4ab19bc9861f8;p=perltidy.git changed get_perltidy.pl from symlink to file --- diff --git a/dev-bin/get_perltidy.pl b/dev-bin/get_perltidy.pl deleted file mode 120000 index ea3e5ecb..00000000 --- a/dev-bin/get_perltidy.pl +++ /dev/null @@ -1 +0,0 @@ -/home/steve/bin/get_perltidy.pl \ No newline at end of file diff --git a/dev-bin/get_perltidy.pl b/dev-bin/get_perltidy.pl new file mode 100755 index 00000000..3810b521 --- /dev/null +++ b/dev-bin/get_perltidy.pl @@ -0,0 +1,123 @@ +#!/usr/bin/perl -w +use strict; +use warnings; +use Getopt::Long; + +#--------------------------------------------------------- +# Define the git home of perltidy on this computer: +my $PERLTIDY_GIT = '/home/steve/src/perldev/perltidy/git'; + +#--------------------------------------------------------- + +my $pm2pl = $PERLTIDY_GIT . '/pm2pl'; +if ( !-e $pm2pl ) { + die < 0, + -D=1 for DEVEL_MODE => 1 [DEFAULT] +EOM + +my @option_string = qw( + h + b:i + D:i +); + +my %Opts = (); +if ( !GetOptions( \%Opts, @option_string ) ) { + print STDERR "Exiting due to error in options\n"; + exit 1; +} + +if ( $Opts{h} ) { + print $usage; + exit 1; +} + +my $Dflag = '-D'; +if ( defined( $Opts{D} ) && $Opts{D} eq '0' ) { + $Dflag = ""; + print "turning off -D\n"; +} + +my $backup_option = 1; +if ( defined( $Opts{b} ) ) { + $backup_option = $Opts{b}; + if ( $backup_option < 0 || $backup_option > 2 ) { + print STDERR "unexpected -b: expecting 0,1,2 but got $backup_option\n"; + exit 1; + } +} + +if ($backup_option) { + my $basename = 'perltidy.pl'; + + # make a backup + my $bname; + if ( -e $basename ) { + my $ext; + for ( my $j = 1 ; $j <= 999 ; $j++ ) { + $ext = 'ba' . $j; + $bname = "$basename.$ext"; + next if ( -e $bname || -e $bname . ".gz" ); + system "mv $basename $bname"; + last; + } + if ( !$bname ) { + die "too many backup versions of $basename - move some\n"; + } + } + + # get the latest version of perltidy with DEVEL_MODE => 1 + my $msg = get_latest_perltidy($Dflag); + + if ( $backup_option == 2 ) { + use File::Compare; + my $diff = compare( $bname, $basename ); + if ( !$diff ) { + print "perltidy.pl unchanged, no backup saved\n"; + system "mv $bname $basename"; + $bname = ""; + } + } + + if ($bname) { + print "Moved $basename -> $bname\n"; + print $msg; + } +} + +sub get_latest_perltidy { + my ($Dflag) = @_; + use Cwd qw(getcwd); + my $starting_dir = getcwd(); + my $dir = $PERLTIDY_GIT; + use File::Temp qw/ tempfile tempdir /; + my ( $fh_tmp, $tmpfile ) = tempfile(); + chdir $dir; + my $ofile = $starting_dir . '/perltidy.pl'; + system "./pm2pl $Dflag -o $ofile >$tmpfile"; + chdir $starting_dir; + open my $fh, '<', $tmpfile or die "Can't open $tmpfile: $!"; + unlink $tmpfile; + my $msg = do { local $/; <$fh> }; + return $msg; +}