examples/perllinetype.pl

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 # For each line in a perl script, write to STDOUT lines of the form
   5 # line number : line type : line text
   6 #
   7 # usage:
   8 # perllinetype myfile.pl >myfile.new
   9 # perllinetype <myfile.pl >myfile.new
  10 #
  11 # This file is one of the examples distributed with perltidy and is a
  12 # simple demonstration of using a callback object with Perl::Tidy.
  13 #
  14 # Steve Hancock, July 2003
  15 #
  16 use Getopt::Std;
  17 use Perl::Tidy;
  18 use IO::File;
  19 $| = 1;
  20 use vars qw($opt_h);
  21 my $usage = <<EOM;
  22    usage: perllinetype filename >outfile
  23 EOM
  24 getopts('h') or die "$usage";
  25 if ($opt_h) { die $usage }
  26
  27 # Make the source for perltidy, which will be a filehandle
  28 # or just '-' if the source is stdin
  29 my ($file, $fh, $source);
  30 if ( @ARGV == 0 ) {
  31     $source = '-';
  32 }
  33 elsif ( @ARGV == 1 ) {
  34     $file = $ARGV[0];
  35     $fh = IO::File->new( $file, 'r' );
  36     unless ($fh) { die "cannot open '$file': $!\n" }
  37     $source = $fh;
  38 }
  39 else { die $usage }
  40
  41 # make the callback object
  42 my $formatter = MyFormatter->new();
  43
  44 my $dest;
  45
  46 # start perltidy, which will start calling our write_line()
  47 my $err=perltidy(
  48     'formatter'   => $formatter,     # callback object
  49     'source'      => $source,
  50     'destination' => \$dest,         # (not really needed)
  51     'argv'        => "-npro -se",    # dont need .perltidyrc
  52                                      # errors to STDOUT
  53 );
  54 if ($err) {
  55     die "Error calling perltidy\n";
  56 }
  57 $fh->close() if $fh;
  58
  59 package MyFormatter;
  60
  61 sub new {
  62     my ($class) = @_;
  63     bless {}, $class;
  64 }
  65
  66 sub write_line {
  67
  68     # This is called from perltidy line-by-line
  69     my $self              = shift;
  70     my $line_of_tokens    = shift;
  71     my $line_type         = $line_of_tokens->{_line_type};
  72     my $input_line_number = $line_of_tokens->{_line_number};
  73     my $input_line        = $line_of_tokens->{_line_text};
  74     print "$input_line_number:$line_type:$input_line";
  75 }
  76
  77 # called once after the last line of a file
  78 sub finish_formatting {
  79     my $self = shift;
  80     return;
  81 }