1 #####################################################################
3 # the Perl::Tidy::LineSink class supplies a write_line method for
6 #####################################################################
8 package Perl::Tidy::LineSink;
11 our $VERSION = '20230309';
15 # Catch any undefined sub calls so that we are sure to get
16 # some diagnostic information. This sub should never be called
17 # except for a programming error.
19 return if ( $AUTOLOAD =~ /\bDESTROY$/ );
20 my ( $pkg, $fname, $lno ) = caller();
21 my $my_package = __PACKAGE__;
23 ======================================================================
24 Error detected in package '$my_package', version $VERSION
25 Received unexpected AUTOLOAD call for sub '$AUTOLOAD'
26 Called from package: '$pkg'
27 Called from File '$fname' at line '$lno'
28 This error is probably due to a recent programming change
29 ======================================================================
36 # required to avoid call to AUTOLOAD in some versions of perl
41 my ( $class, @args ) = @_;
45 line_separator => undef,
46 is_encoded_data => undef,
48 my %args = ( %defaults, @args );
50 my $output_file = $args{output_file};
51 my $line_separator = $args{line_separator};
52 my $is_encoded_data = $args{is_encoded_data};
56 my $output_file_open = 0;
58 ( $fh, $output_file ) =
59 Perl::Tidy::streamhandle( $output_file, 'w', $is_encoded_data );
60 unless ($fh) { Perl::Tidy::Die("Cannot write to output stream\n"); }
61 $output_file_open = 1;
65 _output_file => $output_file,
66 _output_file_open => $output_file_open,
67 _line_separator => $line_separator,
68 _is_encoded_data => $is_encoded_data,
72 sub set_line_separator {
73 my ( $self, $val ) = @_;
74 $self->{_line_separator} = $val;
80 my ( $self, $line ) = @_;
81 my $fh = $self->{_fh};
83 my $line_separator = $self->{_line_separator};
84 if ( defined($line_separator) ) {
86 $line .= $line_separator;
89 $fh->print($line) if ( $self->{_output_file_open} );
94 sub close_output_file {
97 # Only close physical files, not STDOUT and other objects
98 my $output_file = $self->{_output_file};
99 if ( $output_file ne '-' && !ref $output_file ) {
100 $self->{_fh}->close() if $self->{_output_file_open};