]> git.donarmstrong.com Git - perltidy.git/commitdiff
changed get_perltidy.pl from symlink to file
authorSteve Hancock <perltidy@users.sourceforge.net>
Sun, 4 Dec 2022 02:33:45 +0000 (18:33 -0800)
committerSteve Hancock <perltidy@users.sourceforge.net>
Sun, 4 Dec 2022 02:33:45 +0000 (18:33 -0800)
dev-bin/get_perltidy.pl [changed from symlink to file mode: 0755]

deleted file mode 120000 (symlink)
index ea3e5ecbf022f9dbe5f15692a3a5b858a2d628ef..0000000000000000000000000000000000000000
+++ /dev/null
@@ -1 +0,0 @@
-/home/steve/bin/get_perltidy.pl
\ No newline at end of file
new file mode 100755 (executable)
index 0000000000000000000000000000000000000000..3810b5218ec9daca040cefb54788acebaf2e61b7
--- /dev/null
@@ -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 <<EOM;
+Error: did not find 'pm2pl' with the perltidy git directory set as:
+'$PERLTIDY_GIT'
+Please update this directory in $0
+EOM
+}
+
+my $usage = <<EOM;
+
+This script will use pm2pl to get a copy of the latest perltidy.pl
+after first making a backup of any existing perltidy.pl
+usage:
+
+  perl get_perltidy.pl [-h -b -D
+
+  -h prints this help
+  -b=backup option:
+    =0 never backup
+    =1 always backup [DEFAULT]
+    =2 backup if there is a change
+  -D=0 for DEVEL_MODE => 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;
+}