1#!/usr/bin/perl -w 2use 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# 16use Getopt::Std; 17use Perl::Tidy; 18use IO::File; 19$| = 1; 20use vars qw($opt_h); 21my $usage = <<EOM; 22 usage: perllinetype filename >outfile 23EOM 24getopts('h') or die "$usage"; 25if ($opt_h) { die $usage } 26 27# Make the source for perltidy, which will be a filehandle 28# or just '-' if the source is stdin 29my ($file, $fh, $source); 30if ( @ARGV == 0 ) { 31 $source = '-'; 32} 33elsif ( @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} 39else { die $usage } 40 41# make the callback object 42my $formatter = MyFormatter->new(); 43 44my $dest; 45 46# start perltidy, which will start calling our write_line() 47my $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); 54if ($err) { 55 die "Error calling perltidy\n"; 56} 57$fh->close() if $fh; 58 59package MyFormatter; 60 61sub new { 62 my ($class) = @_; 63 bless {}, $class; 64} 65 66sub 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 78sub finish_formatting { 79 my $self = shift; 80 return; 81} 82