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