break_long_quotes.pl [plain text]
use strict;
use Getopt::Std;
$| = 1;
use vars qw($opt_l $opt_h);
my $usage = <<EOM;
usage: break_long_quotes.pl [ -ln ] filename >outfile
where n=line length (default 72)
EOM
getopts('hl:') or die "$usage";
if ($opt_h) { die $usage }
if ( !defined $opt_l ) {
$opt_l = 70;
}
else {
$opt_l =~ /^\d+$/ or die "$usage";
}
unless ( @ARGV == 1 ) { die $usage }
my $file = $ARGV[0];
scan_file( $file, $opt_l );
sub scan_file {
my ( $file, $line_length ) = @_;
use Perl::Tidy;
use IO::File;
my $fh = IO::File->new( $file, 'r' );
unless ($fh) { die "cannot open '$file': $!\n" }
my $formatter = MyWriter->new($line_length);
my $err=perltidy(
'formatter' => $formatter, 'source' => $fh,
'argv' => "-npro -se", );
if ($err){
die "Error calling perltidy\n";
}
$fh->close();
}
package MyWriter;
sub new {
my ( $class, $line_length ) = @_;
my $comment_block = "";
bless {
_rcomment_block => \$comment_block,
_maximum_comment_length => 0,
_max_quote_length => $line_length,
_in_hanging_side_comment => 0,
}, $class;
}
sub write_line {
my $self = shift;
my $line_of_tokens = shift;
my $line_type = $line_of_tokens->{_line_type};
my $input_line_number = $line_of_tokens->{_line_number};
my $input_line = $line_of_tokens->{_line_text}; my $rtoken_type = $line_of_tokens->{_rtoken_type}; my $rtokens = $line_of_tokens->{_rtokens}; my $starting_in_quote =
$line_of_tokens->{_starting_in_quote}; my $ending_in_quote = $line_of_tokens->{_ending_in_quote}; my $max_quote_length = $self->{_max_quote_length};
chomp $input_line;
if ( $line_type eq 'CODE' && @$rtoken_type ) {
my $jmax = @$rtoken_type - 1;
my $leading_whitespace = ( $input_line =~ /^(\s*)/ ) ? $1 : "";
if ($starting_in_quote) {$leading_whitespace=""};
my $new_line = $leading_whitespace;
for ( my $j = 0 ; $j <= $jmax ; $j++ ) {
my $token = $$rtokens[$j];
if ( $$rtoken_type[$j] eq 'Q'
&& !( $j == 0 && $starting_in_quote )
&& !( $j == $jmax && $ending_in_quote )
&& ( length($token) > $max_quote_length ) )
{
my $quote_char = substr( $token, 0, 1 );
if ( $quote_char eq '"' || $quote_char eq '\'' ) {
my $check_char = substr( $token, -1, 1 );
if ( $check_char ne $quote_char ) {
die <<EOM;
programming error at line $input_line
starting quote character is <<$quote_char>> but ending quote character is <<$check_char>>
quoted string is:
$token
EOM
} $token =
break_at_blanks( $token, $quote_char, $max_quote_length );
} } $new_line .= $token;
}
$input_line = $new_line;
}
$self->print($input_line."\n");
return;
}
sub break_at_blanks {
my ( $str, $quote_char, $max_length ) = @_;
my $blank = ' ';
my $prev_char = "";
my @break_after_pos;
my $quote_pos = -1;
while ( ( $quote_pos = index( $str, $blank, 1 + $quote_pos ) ) >= 0 ) {
if ( $quote_pos > 0 ) {
next if ( substr( $str, $quote_pos - 1, 1 ) eq '\\' );
}
push @break_after_pos, $quote_pos;
} push @break_after_pos, length($str);
my $starting_pos = 0;
my $new_str = "";
for ( my $i = 1 ; $i < @break_after_pos ; $i++ ) {
my $pos = $break_after_pos[$i];
my $length = $pos - $starting_pos;
if ( $length > $max_length - 1 ) {
$pos = $break_after_pos[ $i - 1 ];
$new_str .= substr( $str, $starting_pos, $pos - $starting_pos + 1 )
. "$quote_char . $quote_char";
$starting_pos = $pos + 1;
} } my $pos = length($str);
$new_str .= substr( $str, $starting_pos, $pos );
return $new_str;
}
sub print {
my ( $self, $input_line ) = @_;
print $input_line;
}
sub finish_formatting {
my $self = shift;
$self->flush_comments();
}