pm2pl

   1 #!/usr/bin/env perl
   2 use strict;
   3 use Getopt::Long;
   4
   5 my $usage = <<EOM;
   6
   7 This script will recombine the perltidy binary script and all of its modules
   8 into a single, monolithic script.
   9
  10 Run this from the perltidy main installation directory.  It reads
  11 bin/perltidy and lib/*.pm and by default writes a file 'perltidy-VERSION.pl' in the
  12 current directory.
  13
  14 usage:
  15   perl pm2pl [-h -o ofile ]
  16
  17   -h prints this help
  18   -o set output file      [ default is 'perltidy-VERSION.pl' ]
  19   -D set DEVEL_MODE => 1  [ for extra testing when debugging ]
  20 EOM
  21
  22 my @option_string = qw(
  23   h
  24   o:s
  25   D
  26 );
  27
  28 my %Opts = ();
  29 if ( !GetOptions( \%Opts, @option_string ) ) {
  30     die "Programming Bug: error in setting default options";
  31 }
  32
  33 if ( $Opts{h} ) {
  34     print $usage;
  35     exit 1;
  36 }
  37
  38 # This should work for a system with File::Spec,
  39 # and for older Windows/Unix systems without File::Spec.
  40 my $script  = 'bin/perltidy';
  41 my @modules = qw(
  42   lib/Perl/Tidy.pm
  43   lib/Perl/Tidy/Debugger.pm
  44   lib/Perl/Tidy/DevNull.pm
  45   lib/Perl/Tidy/Diagnostics.pm
  46   lib/Perl/Tidy/FileWriter.pm
  47   lib/Perl/Tidy/Formatter.pm
  48   lib/Perl/Tidy/HtmlWriter.pm
  49   lib/Perl/Tidy/IOScalar.pm
  50   lib/Perl/Tidy/IOScalarArray.pm
  51   lib/Perl/Tidy/IndentationItem.pm
  52   lib/Perl/Tidy/LineBuffer.pm
  53   lib/Perl/Tidy/LineSink.pm
  54   lib/Perl/Tidy/LineSource.pm
  55   lib/Perl/Tidy/Logger.pm
  56   lib/Perl/Tidy/Tokenizer.pm
  57   lib/Perl/Tidy/VerticalAligner.pm
  58   lib/Perl/Tidy/VerticalAligner/Alignment.pm
  59   lib/Perl/Tidy/VerticalAligner/Line.pm
  60 );
  61
  62 # try to make the pathnames system independent
  63 eval "use File::Spec;";
  64 my $missing_file_spec = $@;
  65 unless ($missing_file_spec) {
  66     $script = File::Spec->catfile( split '/', $script );
  67     foreach my $module (@modules) {
  68         $module = File::Spec->catfile( split '/', $module );
  69     }
  70 }
  71
  72 my $VERSION = get_version("lib/Perl/Tidy.pm");
  73 my $outfile = "perltidy-$VERSION.pl";
  74 if ( $Opts{o} ) { $outfile = $Opts{o} }
  75 my $fh_out;
  76 open( $fh_out, ">", $outfile ) or die "can't open file '$outfile' : $!\n";
  77 print "Creating standalone perltidy script '$outfile' ....";
  78
  79 # first, open the script and copy the first (hash-bang) line
  80 # (Note: forward slashes in file names here will work in Windows)
  81 my $fh_in;
  82 open( $fh_in, "<", $script ) or die "can't open script file '$script' : $!\n";
  83 my $hash_bang = <$fh_in>;
  84 $fh_out->print($hash_bang);
  85
  86 # then copy all modules
  87 my $changed_count;
  88 foreach my $module (@modules) {
  89     my $fh_module;
  90     open( $fh_module, '<', $module )
  91       or die "can't open my module file '$module' : $!\n";
  92     while (<$fh_module>) {
  93         last if /^\s*__END__\s*$/;
  94         my $line = $_;
  95         if (   $Opts{'D'}
  96             && $line =~
  97             /^(\s*use\s+constant\s+(?:DEVEL)_[A-Z]+\s*)=>\s*(-?\d*);(.*)$/ )
  98         {
  99             if ( $2 != '1' ) {
 100                 $changed_count++;
 101                 $line = <<EOM;
 102 $1=> 1;$3
 103 EOM
 104             }
 105         }
 106
 107         $fh_out->print($line) unless $line =~ /^use Perl::Tidy/;
 108     }
 109     $fh_module->close();
 110 }
 111
 112 # then, copy the rest of the script except for the 'use PerlTidy' statement
 113 while (<$fh_in>) {
 114     last if /^\s*__END__\s*$/;
 115     $fh_out->print($_) unless $_ =~ /^use Perl::Tidy/;
 116 }
 117 $fh_in->close();
 118 $fh_out->close();
 119 chmod 0755, $outfile;
 120
 121 print " OK\n";
 122 if ($changed_count) {
 123     print <<EOM;
 124 $changed_count lines changed to DEVEL_MODE => 1
 125 EOM
 126 }
 127
 128 sub get_version {
 129     my ($file) = @_;
 130     my $fh;
 131     open( $fh, "<", $file ) || die "cannot open $fh: $!\n";
 132     while ( my $line = <$fh> ) {
 133
 134         # Looking for something simple like this, with or without quotes,
 135         # with semicolon and no sidecomments:
 136         #                     $VERSION   =   "20180202.245"  ;
 137         #                 our $VERSION   =    20104202       ;
 138         if ( $line =~
 139             /^((our)?\s*\$VERSION\s*=\s*\'?)  ([^'#]+)   (\'?) \s* ;/x )
 140         {
 141             $VERSION = $3;
 142             last;
 143         }
 144     }
 145     return $VERSION;
 146 }