← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:13 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Perl/Tidy.pm
StatementsExecuted 772 statements in 93.6ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.84ms1.96msPerl::Tidy::::BEGIN@78 Perl::Tidy::BEGIN@78
111628┬Ás1.00msPerl::Tidy::::BEGIN@76 Perl::Tidy::BEGIN@76
111484┬Ás484┬ÁsPerl::Tidy::Tokenizer::::BEGIN@29596 Perl::Tidy::Tokenizer::BEGIN@29596
11193┬Ás93┬ÁsPerl::Tidy::Formatter::::BEGIN@6198 Perl::Tidy::Formatter::BEGIN@6198
11190┬Ás90┬ÁsPerl::Tidy::Formatter::::BEGIN@8401 Perl::Tidy::Formatter::BEGIN@8401
11186┬Ás86┬ÁsPerl::Tidy::Formatter::::BEGIN@13836 Perl::Tidy::Formatter::BEGIN@13836
11150┬Ás50┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4762 Perl::Tidy::HtmlWriter::BEGIN@4762
11130┬Ás30┬ÁsPerl::Tidy::Formatter::::BEGIN@13541 Perl::Tidy::Formatter::BEGIN@13541
11128┬Ás28┬ÁsPerl::Tidy::Formatter::::BEGIN@8312 Perl::Tidy::Formatter::BEGIN@8312
11122┬Ás22┬ÁsPerl::Tidy::::BEGIN@215 Perl::Tidy::BEGIN@215
11117┬Ás48┬ÁsPerl::Tidy::Formatter::::BEGIN@5950 Perl::Tidy::Formatter::BEGIN@5950
11116┬Ás23┬ÁsPerl::Tidy::::BEGIN@81 Perl::Tidy::BEGIN@81
11116┬Ás86┬ÁsPerl::Tidy::Tokenizer::::BEGIN@27475 Perl::Tidy::Tokenizer::BEGIN@27475
11115┬Ás15┬ÁsPerl::Tidy::Formatter::::BEGIN@17043 Perl::Tidy::Formatter::BEGIN@17043
11115┬Ás44┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22672 Perl::Tidy::Tokenizer::BEGIN@22672
11114┬Ás14┬ÁsPerl::Tidy::::BEGIN@56 Perl::Tidy::BEGIN@56
11114┬Ás14┬ÁsPerl::Tidy::Formatter::::BEGIN@14914 Perl::Tidy::Formatter::BEGIN@14914
11114┬Ás14┬ÁsPerl::Tidy::VerticalAligner::::BEGIN@20752 Perl::Tidy::VerticalAligner::BEGIN@20752
11112┬Ás12┬ÁsPerl::Tidy::Formatter::::BEGIN@15938 Perl::Tidy::Formatter::BEGIN@15938
11112┬Ás69┬ÁsPerl::Tidy::FileWriter::::BEGIN@22177 Perl::Tidy::FileWriter::BEGIN@22177
11112┬Ás12┬ÁsPerl::Tidy::Formatter::::BEGIN@11610 Perl::Tidy::Formatter::BEGIN@11610
11111┬Ás11┬ÁsPerl::Tidy::Formatter::::BEGIN@8152 Perl::Tidy::Formatter::BEGIN@8152
11111┬Ás53┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22598 Perl::Tidy::Tokenizer::BEGIN@22598
11111┬Ás44┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22666 Perl::Tidy::Tokenizer::BEGIN@22666
11111┬Ás46┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19322 Perl::Tidy::VerticalAligner::Line::BEGIN@19322
11111┬Ás110┬ÁsPerl::Tidy::::BEGIN@2125 Perl::Tidy::BEGIN@2125
11111┬Ás42┬ÁsPerl::Tidy::::BEGIN@75 Perl::Tidy::BEGIN@75
11111┬Ás38┬ÁsPerl::Tidy::::BEGIN@77 Perl::Tidy::BEGIN@77
11111┬Ás58┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22580 Perl::Tidy::Tokenizer::BEGIN@22580
11111┬Ás29┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19319 Perl::Tidy::VerticalAligner::Line::BEGIN@19319
11111┬Ás72┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19077 Perl::Tidy::IndentationItem::BEGIN@19077
11110┬Ás45┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4522 Perl::Tidy::HtmlWriter::BEGIN@4522
11110┬Ás22┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19496Perl::Tidy::VerticalAligner::Alignment::BEGIN@19496
11110┬Ás61┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19320 Perl::Tidy::VerticalAligner::Line::BEGIN@19320
11110┬Ás48┬ÁsPerl::Tidy::IOScalar::::BEGIN@3659 Perl::Tidy::IOScalar::BEGIN@3659
11110┬Ás63┬ÁsPerl::Tidy::Logger::::BEGIN@4303 Perl::Tidy::Logger::BEGIN@4303
11110┬Ás22┬ÁsPerl::Tidy::::BEGIN@59 Perl::Tidy::BEGIN@59
11110┬Ás10┬ÁsPerl::Tidy::Formatter::::BEGIN@12316 Perl::Tidy::Formatter::BEGIN@12316
11110┬Ás10┬ÁsPerl::Tidy::Formatter::::BEGIN@12798 Perl::Tidy::Formatter::BEGIN@12798
11110┬Ás40┬ÁsPerl::Tidy::Formatter::::BEGIN@5952 Perl::Tidy::Formatter::BEGIN@5952
11110┬Ás51┬ÁsPerl::Tidy::Formatter::::BEGIN@5944 Perl::Tidy::Formatter::BEGIN@5944
11110┬Ás2.07msPerl::Tidy::Formatter::::BEGIN@5980 Perl::Tidy::Formatter::BEGIN@5980
1119┬Ás72┬ÁsPerl::Tidy::::BEGIN@79 Perl::Tidy::BEGIN@79
1119┬Ás39┬ÁsPerl::Tidy::IOScalarArray::::BEGIN@3743 Perl::Tidy::IOScalarArray::BEGIN@3743
1119┬Ás38┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19334 Perl::Tidy::VerticalAligner::Line::BEGIN@19334
1119┬Ás4.38msPerl::Tidy::Tokenizer::::BEGIN@22601 Perl::Tidy::Tokenizer::BEGIN@22601
1119┬Ás110┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4525 Perl::Tidy::HtmlWriter::BEGIN@4525
1119┬Ás50┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22581 Perl::Tidy::Tokenizer::BEGIN@22581
1119┬Ás41┬ÁsPerl::Tidy::Formatter::::BEGIN@5979 Perl::Tidy::Formatter::BEGIN@5979
1119┬Ás38┬ÁsPerl::Tidy::Formatter::::BEGIN@5956 Perl::Tidy::Formatter::BEGIN@5956
1119┬Ás45┬ÁsPerl::Tidy::Tokenizer::::BEGIN@23592 Perl::Tidy::Tokenizer::BEGIN@23592
1118┬Ás8┬ÁsPerl::Tidy::Formatter::::BEGIN@10806 Perl::Tidy::Formatter::BEGIN@10806
1118┬Ás42┬ÁsPerl::Tidy::Formatter::::BEGIN@5946 Perl::Tidy::Formatter::BEGIN@5946
1118┬Ás38┬ÁsPerl::Tidy::::BEGIN@61 Perl::Tidy::BEGIN@61
1118┬Ás44┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22582 Perl::Tidy::Tokenizer::BEGIN@22582
1118┬Ás201┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22644 Perl::Tidy::Tokenizer::BEGIN@22644
1118┬Ás43┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4955 Perl::Tidy::HtmlWriter::BEGIN@4955
1118┬Ás8┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22575 Perl::Tidy::Tokenizer::BEGIN@22575
1118┬Ás580┬ÁsPerl::Tidy::VerticalAligner::::BEGIN@19616 Perl::Tidy::VerticalAligner::BEGIN@19616
1118┬Ás72┬ÁsPerl::Tidy::::BEGIN@64 Perl::Tidy::BEGIN@64
1118┬Ás43┬ÁsPerl::Tidy::Formatter::::BEGIN@5945 Perl::Tidy::Formatter::BEGIN@5945
1118┬Ás45┬ÁsPerl::Tidy::Logger::::BEGIN@4339 Perl::Tidy::Logger::BEGIN@4339
1118┬Ás41┬ÁsPerl::Tidy::VerticalAligner::::BEGIN@19600 Perl::Tidy::VerticalAligner::BEGIN@19600
1118┬Ás24┬ÁsPerl::Tidy::::BEGIN@60 Perl::Tidy::BEGIN@60
1118┬Ás40┬ÁsPerl::Tidy::Formatter::::BEGIN@5948 Perl::Tidy::Formatter::BEGIN@5948
1118┬Ás45┬ÁsPerl::Tidy::Formatter::::BEGIN@6282 Perl::Tidy::Formatter::BEGIN@6282
1118┬Ás53┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22583 Perl::Tidy::Tokenizer::BEGIN@22583
1118┬Ás45┬ÁsPerl::Tidy::Formatter::::BEGIN@5949 Perl::Tidy::Formatter::BEGIN@5949
1118┬Ás43┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22584 Perl::Tidy::Tokenizer::BEGIN@22584
1118┬Ás19┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19380 Perl::Tidy::VerticalAligner::Line::BEGIN@19380
1118┬Ás8┬ÁsPerl::Tidy::Formatter::::BEGIN@5940 Perl::Tidy::Formatter::BEGIN@5940
1118┬Ás42┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4956 Perl::Tidy::HtmlWriter::BEGIN@4956
1118┬Ás37┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19506Perl::Tidy::VerticalAligner::Alignment::BEGIN@19506
1117┬Ás45┬ÁsPerl::Tidy::Formatter::::BEGIN@5947 Perl::Tidy::Formatter::BEGIN@5947
1117┬Ás42┬ÁsPerl::Tidy::Formatter::::BEGIN@6298 Perl::Tidy::Formatter::BEGIN@6298
1117┬Ás41┬ÁsPerl::Tidy::Formatter::::BEGIN@6302 Perl::Tidy::Formatter::BEGIN@6302
1117┬Ás43┬ÁsPerl::Tidy::Tokenizer::::BEGIN@23593 Perl::Tidy::Tokenizer::BEGIN@23593
1117┬Ás38┬ÁsPerl::Tidy::Formatter::::BEGIN@5951 Perl::Tidy::Formatter::BEGIN@5951
1117┬Ás40┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19501Perl::Tidy::VerticalAligner::Alignment::BEGIN@19501
1117┬Ás36┬ÁsPerl::Tidy::Formatter::::BEGIN@6292 Perl::Tidy::Formatter::BEGIN@6292
1117┬Ás40┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19503Perl::Tidy::VerticalAligner::Alignment::BEGIN@19503
1117┬Ás37┬ÁsPerl::Tidy::Formatter::::BEGIN@6288 Perl::Tidy::Formatter::BEGIN@6288
1117┬Ás36┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22671 Perl::Tidy::Tokenizer::BEGIN@22671
1117┬Ás16┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19542Perl::Tidy::VerticalAligner::Alignment::BEGIN@19542
1117┬Ás35┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4961 Perl::Tidy::HtmlWriter::BEGIN@4961
1117┬Ás40┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22665 Perl::Tidy::Tokenizer::BEGIN@22665
1117┬Ás36┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19505Perl::Tidy::VerticalAligner::Alignment::BEGIN@19505
1117┬Ás39┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19324 Perl::Tidy::VerticalAligner::Line::BEGIN@19324
1117┬Ás49┬ÁsPerl::Tidy::Formatter::::BEGIN@6295 Perl::Tidy::Formatter::BEGIN@6295
1117┬Ás37┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19079 Perl::Tidy::IndentationItem::BEGIN@19079
1117┬Ás40┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19323 Perl::Tidy::VerticalAligner::Line::BEGIN@19323
1117┬Ás38┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19326 Perl::Tidy::VerticalAligner::Line::BEGIN@19326
1117┬Ás7┬ÁsPerl::Tidy::Formatter::::BEGIN@11861 Perl::Tidy::Formatter::BEGIN@11861
1117┬Ás38┬ÁsPerl::Tidy::Formatter::::BEGIN@6283 Perl::Tidy::Formatter::BEGIN@6283
1117┬Ás36┬ÁsPerl::Tidy::Formatter::::BEGIN@6289 Perl::Tidy::Formatter::BEGIN@6289
1117┬Ás39┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19078 Perl::Tidy::IndentationItem::BEGIN@19078
1117┬Ás36┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19507Perl::Tidy::VerticalAligner::Alignment::BEGIN@19507
1116┬Ás36┬ÁsPerl::Tidy::Formatter::::BEGIN@5954 Perl::Tidy::Formatter::BEGIN@5954
1116┬Ás35┬ÁsPerl::Tidy::Formatter::::BEGIN@6291 Perl::Tidy::Formatter::BEGIN@6291
1116┬Ás36┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4957 Perl::Tidy::HtmlWriter::BEGIN@4957
1116┬Ás38┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4963 Perl::Tidy::HtmlWriter::BEGIN@4963
1116┬Ás40┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19080 Perl::Tidy::IndentationItem::BEGIN@19080
1116┬Ás36┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19083 Perl::Tidy::IndentationItem::BEGIN@19083
1116┬Ás36┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19090 Perl::Tidy::IndentationItem::BEGIN@19090
1116┬Ás36┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19502Perl::Tidy::VerticalAligner::Alignment::BEGIN@19502
1116┬Ás39┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19325 Perl::Tidy::VerticalAligner::Line::BEGIN@19325
1116┬Ás46┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19327 Perl::Tidy::VerticalAligner::Line::BEGIN@19327
1116┬Ás34┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19330 Perl::Tidy::VerticalAligner::Line::BEGIN@19330
1116┬Ás37┬ÁsPerl::Tidy::Formatter::::BEGIN@5957 Perl::Tidy::Formatter::BEGIN@5957
1116┬Ás36┬ÁsPerl::Tidy::Formatter::::BEGIN@6284 Perl::Tidy::Formatter::BEGIN@6284
1116┬Ás36┬ÁsPerl::Tidy::Formatter::::BEGIN@6287 Perl::Tidy::Formatter::BEGIN@6287
1116┬Ás35┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4958 Perl::Tidy::HtmlWriter::BEGIN@4958
1116┬Ás35┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4959 Perl::Tidy::HtmlWriter::BEGIN@4959
1116┬Ás36┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19084 Perl::Tidy::IndentationItem::BEGIN@19084
1116┬Ás37┬ÁsPerl::Tidy::Formatter::::BEGIN@5953 Perl::Tidy::Formatter::BEGIN@5953
1116┬Ás36┬ÁsPerl::Tidy::Formatter::::BEGIN@5955 Perl::Tidy::Formatter::BEGIN@5955
1116┬Ás35┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19086 Perl::Tidy::IndentationItem::BEGIN@19086
1116┬Ás48┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19087 Perl::Tidy::IndentationItem::BEGIN@19087
1116┬Ás35┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22667 Perl::Tidy::Tokenizer::BEGIN@22667
1116┬Ás40┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22670 Perl::Tidy::Tokenizer::BEGIN@22670
1116┬Ás36┬ÁsPerl::Tidy::Tokenizer::::BEGIN@23594 Perl::Tidy::Tokenizer::BEGIN@23594
1116┬Ás36┬ÁsPerl::Tidy::VerticalAligner::Alignment::::BEGIN@19504Perl::Tidy::VerticalAligner::Alignment::BEGIN@19504
1116┬Ás6┬ÁsPerl::Tidy::VerticalAligner::::BEGIN@19595 Perl::Tidy::VerticalAligner::BEGIN@19595
1116┬Ás35┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19329 Perl::Tidy::VerticalAligner::Line::BEGIN@19329
1116┬Ás35┬ÁsPerl::Tidy::Formatter::::BEGIN@6290 Perl::Tidy::Formatter::BEGIN@6290
1116┬Ás35┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19095 Perl::Tidy::IndentationItem::BEGIN@19095
1116┬Ás36┬ÁsPerl::Tidy::Tokenizer::::BEGIN@23595 Perl::Tidy::Tokenizer::BEGIN@23595
1116┬Ás36┬ÁsPerl::Tidy::VerticalAligner::::BEGIN@19601 Perl::Tidy::VerticalAligner::BEGIN@19601
1116┬Ás34┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4962 Perl::Tidy::HtmlWriter::BEGIN@4962
1116┬Ás34┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19093 Perl::Tidy::IndentationItem::BEGIN@19093
1116┬Ás35┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19331 Perl::Tidy::VerticalAligner::Line::BEGIN@19331
1116┬Ás34┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19085 Perl::Tidy::IndentationItem::BEGIN@19085
1116┬Ás36┬ÁsPerl::Tidy::VerticalAligner::::BEGIN@19602 Perl::Tidy::VerticalAligner::BEGIN@19602
1116┬Ás34┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19332 Perl::Tidy::VerticalAligner::Line::BEGIN@19332
1116┬Ás39┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19333 Perl::Tidy::VerticalAligner::Line::BEGIN@19333
1116┬Ás34┬ÁsPerl::Tidy::HtmlWriter::::BEGIN@4960 Perl::Tidy::HtmlWriter::BEGIN@4960
1116┬Ás35┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19082 Perl::Tidy::IndentationItem::BEGIN@19082
1116┬Ás35┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19092 Perl::Tidy::IndentationItem::BEGIN@19092
1116┬Ás35┬ÁsPerl::Tidy::Tokenizer::::BEGIN@22675 Perl::Tidy::Tokenizer::BEGIN@22675
1116┬Ás34┬ÁsPerl::Tidy::IndentationItem::::BEGIN@19094 Perl::Tidy::IndentationItem::BEGIN@19094
1116┬Ás34┬ÁsPerl::Tidy::VerticalAligner::::BEGIN@19603 Perl::Tidy::VerticalAligner::BEGIN@19603
1116┬Ás35┬ÁsPerl::Tidy::VerticalAligner::Line::::BEGIN@19328 Perl::Tidy::VerticalAligner::Line::BEGIN@19328
1116┬Ás6┬ÁsPerl::Tidy::::CORE:subst Perl::Tidy::CORE:subst (opcode)
1113┬Ás3┬ÁsPerl::Tidy::::BEGIN@57 Perl::Tidy::BEGIN@57
2111┬Ás1┬ÁsPerl::Tidy::::CORE:substcont Perl::Tidy::CORE:substcont (opcode)
0000s0sPerl::Tidy::Debugger::::close_debug_file Perl::Tidy::Debugger::close_debug_file
0000s0sPerl::Tidy::Debugger::::new Perl::Tidy::Debugger::new
0000s0sPerl::Tidy::Debugger::::really_open_debug_file Perl::Tidy::Debugger::really_open_debug_file
0000s0sPerl::Tidy::Debugger::::write_debug_entry Perl::Tidy::Debugger::write_debug_entry
0000s0sPerl::Tidy::DevNull::::close Perl::Tidy::DevNull::close
0000s0sPerl::Tidy::DevNull::::new Perl::Tidy::DevNull::new
0000s0sPerl::Tidy::DevNull::::print Perl::Tidy::DevNull::print
0000s0sPerl::Tidy::Diagnostics::::new Perl::Tidy::Diagnostics::new
0000s0sPerl::Tidy::Diagnostics::::set_input_file Perl::Tidy::Diagnostics::set_input_file
0000s0sPerl::Tidy::Diagnostics::::write_diagnostics Perl::Tidy::Diagnostics::write_diagnostics
0000s0sPerl::Tidy::::Die Perl::Tidy::Die
0000s0sPerl::Tidy::::Exit Perl::Tidy::Exit
0000s0sPerl::Tidy::FileWriter::::decrement_output_line_number Perl::Tidy::FileWriter::decrement_output_line_number
0000s0sPerl::Tidy::FileWriter::::get_consecutive_nonblank_lines Perl::Tidy::FileWriter::get_consecutive_nonblank_lines
0000s0sPerl::Tidy::FileWriter::::get_output_line_number Perl::Tidy::FileWriter::get_output_line_number
0000s0sPerl::Tidy::FileWriter::::new Perl::Tidy::FileWriter::new
0000s0sPerl::Tidy::FileWriter::::report_line_length_errors Perl::Tidy::FileWriter::report_line_length_errors
0000s0sPerl::Tidy::FileWriter::::require_blank_code_lines Perl::Tidy::FileWriter::require_blank_code_lines
0000s0sPerl::Tidy::FileWriter::::reset_consecutive_blank_lines Perl::Tidy::FileWriter::reset_consecutive_blank_lines
0000s0sPerl::Tidy::FileWriter::::tee_off Perl::Tidy::FileWriter::tee_off
0000s0sPerl::Tidy::FileWriter::::tee_on Perl::Tidy::FileWriter::tee_on
0000s0sPerl::Tidy::FileWriter::::want_blank_line Perl::Tidy::FileWriter::want_blank_line
0000s0sPerl::Tidy::FileWriter::::write_blank_code_line Perl::Tidy::FileWriter::write_blank_code_line
0000s0sPerl::Tidy::FileWriter::::write_code_line Perl::Tidy::FileWriter::write_code_line
0000s0sPerl::Tidy::FileWriter::::write_line Perl::Tidy::FileWriter::write_line
0000s0sPerl::Tidy::FileWriter::::write_logfile_entry Perl::Tidy::FileWriter::write_logfile_entry
0000s0sPerl::Tidy::Formatter::::DESTROY Perl::Tidy::Formatter::DESTROY
0000s0sPerl::Tidy::Formatter::::__ANON__[:5961] Perl::Tidy::Formatter::__ANON__[:5961]
0000s0sPerl::Tidy::Formatter::::__ANON__[:7683] Perl::Tidy::Formatter::__ANON__[:7683]
0000s0sPerl::Tidy::Formatter::::__ANON__[:7694] Perl::Tidy::Formatter::__ANON__[:7694]
0000s0sPerl::Tidy::Formatter::::_decrement_count Perl::Tidy::Formatter::_decrement_count
0000s0sPerl::Tidy::Formatter::::_increment_count Perl::Tidy::Formatter::_increment_count
0000s0sPerl::Tidy::Formatter::::accumulate_block_text Perl::Tidy::Formatter::accumulate_block_text
0000s0sPerl::Tidy::Formatter::::accumulate_csc_text Perl::Tidy::Formatter::accumulate_csc_text
0000s0sPerl::Tidy::Formatter::::add_closing_side_comment Perl::Tidy::Formatter::add_closing_side_comment
0000s0sPerl::Tidy::Formatter::::balance_csc_text Perl::Tidy::Formatter::balance_csc_text
0000s0sPerl::Tidy::Formatter::::bias_table_key Perl::Tidy::Formatter::bias_table_key
0000s0sPerl::Tidy::Formatter::::black_box Perl::Tidy::Formatter::black_box
0000s0sPerl::Tidy::Formatter::::break_all_chain_tokens Perl::Tidy::Formatter::break_all_chain_tokens
0000s0sPerl::Tidy::Formatter::::break_equals Perl::Tidy::Formatter::break_equals
0000s0sPerl::Tidy::Formatter::::check_for_long_gnu_style_lines Perl::Tidy::Formatter::check_for_long_gnu_style_lines
0000s0sPerl::Tidy::Formatter::::check_for_new_minimum_depth Perl::Tidy::Formatter::check_for_new_minimum_depth
0000s0sPerl::Tidy::Formatter::::check_options Perl::Tidy::Formatter::check_options
0000s0sPerl::Tidy::Formatter::::clear_breakpoint_undo_stack Perl::Tidy::Formatter::clear_breakpoint_undo_stack
0000s0sPerl::Tidy::Formatter::::comma_arrow_count Perl::Tidy::Formatter::comma_arrow_count
0000s0sPerl::Tidy::Formatter::::compactify_table Perl::Tidy::Formatter::compactify_table
0000s0sPerl::Tidy::Formatter::::compare_indentation_levels Perl::Tidy::Formatter::compare_indentation_levels
0000s0sPerl::Tidy::Formatter::::complain Perl::Tidy::Formatter::complain
0000s0sPerl::Tidy::Formatter::::copy_old_breakpoints Perl::Tidy::Formatter::copy_old_breakpoints
0000s0sPerl::Tidy::Formatter::::correct_lp_indentation Perl::Tidy::Formatter::correct_lp_indentation
0000s0sPerl::Tidy::Formatter::::create_one_line_block Perl::Tidy::Formatter::create_one_line_block
0000s0sPerl::Tidy::Formatter::::destroy_one_line_block Perl::Tidy::Formatter::destroy_one_line_block
0000s0sPerl::Tidy::Formatter::::do_uncontained_comma_breaks Perl::Tidy::Formatter::do_uncontained_comma_breaks
0000s0sPerl::Tidy::Formatter::::dump_want_left_space Perl::Tidy::Formatter::dump_want_left_space
0000s0sPerl::Tidy::Formatter::::dump_want_right_space Perl::Tidy::Formatter::dump_want_right_space
0000s0sPerl::Tidy::Formatter::::excess_line_length Perl::Tidy::Formatter::excess_line_length
0000s0sPerl::Tidy::Formatter::::extract_token Perl::Tidy::Formatter::extract_token
0000s0sPerl::Tidy::Formatter::::find_token_starting_list Perl::Tidy::Formatter::find_token_starting_list
0000s0sPerl::Tidy::Formatter::::finish_formatting Perl::Tidy::Formatter::finish_formatting
0000s0sPerl::Tidy::Formatter::::finish_lp_batch Perl::Tidy::Formatter::finish_lp_batch
0000s0sPerl::Tidy::Formatter::::flush Perl::Tidy::Formatter::flush
0000s0sPerl::Tidy::Formatter::::get_AVAILABLE_SPACES_to_go Perl::Tidy::Formatter::get_AVAILABLE_SPACES_to_go
0000s0sPerl::Tidy::Formatter::::get_RECOVERABLE_SPACES Perl::Tidy::Formatter::get_RECOVERABLE_SPACES
0000s0sPerl::Tidy::Formatter::::get_SPACES Perl::Tidy::Formatter::get_SPACES
0000s0sPerl::Tidy::Formatter::::get_added_semicolon_count Perl::Tidy::Formatter::get_added_semicolon_count
0000s0sPerl::Tidy::Formatter::::get_count Perl::Tidy::Formatter::get_count
0000s0sPerl::Tidy::Formatter::::get_maximum_fields_wanted Perl::Tidy::Formatter::get_maximum_fields_wanted
0000s0sPerl::Tidy::Formatter::::get_opening_indentation Perl::Tidy::Formatter::get_opening_indentation
0000s0sPerl::Tidy::Formatter::::get_saw_brace_error Perl::Tidy::Formatter::get_saw_brace_error
0000s0sPerl::Tidy::Formatter::::get_seqno Perl::Tidy::Formatter::get_seqno
0000s0sPerl::Tidy::Formatter::::in_same_container Perl::Tidy::Formatter::in_same_container
0000s0sPerl::Tidy::Formatter::::insert_additional_breaks Perl::Tidy::Formatter::insert_additional_breaks
0000s0sPerl::Tidy::Formatter::::insert_final_breaks Perl::Tidy::Formatter::insert_final_breaks
0000s0sPerl::Tidy::Formatter::::insert_new_token_to_go Perl::Tidy::Formatter::insert_new_token_to_go
0000s0sPerl::Tidy::Formatter::::is_essential_whitespace Perl::Tidy::Formatter::is_essential_whitespace
0000s0sPerl::Tidy::Formatter::::is_unbalanced_batch Perl::Tidy::Formatter::is_unbalanced_batch
0000s0sPerl::Tidy::Formatter::::is_unbreakable_container Perl::Tidy::Formatter::is_unbreakable_container
0000s0sPerl::Tidy::Formatter::::leading_spaces_to_go Perl::Tidy::Formatter::leading_spaces_to_go
0000s0sPerl::Tidy::Formatter::::lookup_opening_indentation Perl::Tidy::Formatter::lookup_opening_indentation
0000s0sPerl::Tidy::Formatter::::make_alignment_patterns Perl::Tidy::Formatter::make_alignment_patterns
0000s0sPerl::Tidy::Formatter::::make_bli_pattern Perl::Tidy::Formatter::make_bli_pattern
0000s0sPerl::Tidy::Formatter::::make_block_brace_vertical_tightness_pattern Perl::Tidy::Formatter::make_block_brace_vertical_tightness_pattern
0000s0sPerl::Tidy::Formatter::::make_block_pattern Perl::Tidy::Formatter::make_block_pattern
0000s0sPerl::Tidy::Formatter::::make_closing_side_comment_list_pattern Perl::Tidy::Formatter::make_closing_side_comment_list_pattern
0000s0sPerl::Tidy::Formatter::::make_closing_side_comment_prefix Perl::Tidy::Formatter::make_closing_side_comment_prefix
0000s0sPerl::Tidy::Formatter::::make_else_csc_text Perl::Tidy::Formatter::make_else_csc_text
0000s0sPerl::Tidy::Formatter::::make_format_skipping_pattern Perl::Tidy::Formatter::make_format_skipping_pattern
0000s0sPerl::Tidy::Formatter::::make_static_block_comment_pattern Perl::Tidy::Formatter::make_static_block_comment_pattern
0000s0sPerl::Tidy::Formatter::::make_static_side_comment_pattern Perl::Tidy::Formatter::make_static_side_comment_pattern
0000s0sPerl::Tidy::Formatter::::match_opening_and_closing_tokens Perl::Tidy::Formatter::match_opening_and_closing_tokens
0000s0sPerl::Tidy::Formatter::::max Perl::Tidy::Formatter::max
0000s0sPerl::Tidy::Formatter::::maximum_line_length Perl::Tidy::Formatter::maximum_line_length
0000s0sPerl::Tidy::Formatter::::maximum_line_length_for_level Perl::Tidy::Formatter::maximum_line_length_for_level
0000s0sPerl::Tidy::Formatter::::maximum_number_of_fields Perl::Tidy::Formatter::maximum_number_of_fields
0000s0sPerl::Tidy::Formatter::::min Perl::Tidy::Formatter::min
0000s0sPerl::Tidy::Formatter::::new Perl::Tidy::Formatter::new
0000s0sPerl::Tidy::Formatter::::new_lp_indentation_item Perl::Tidy::Formatter::new_lp_indentation_item
0000s0sPerl::Tidy::Formatter::::note_added_semicolon Perl::Tidy::Formatter::note_added_semicolon
0000s0sPerl::Tidy::Formatter::::note_deleted_semicolon Perl::Tidy::Formatter::note_deleted_semicolon
0000s0sPerl::Tidy::Formatter::::note_embedded_tab Perl::Tidy::Formatter::note_embedded_tab
0000s0sPerl::Tidy::Formatter::::output_line_to_go Perl::Tidy::Formatter::output_line_to_go
0000s0sPerl::Tidy::Formatter::::pad_array_to_go Perl::Tidy::Formatter::pad_array_to_go
0000s0sPerl::Tidy::Formatter::::pad_token Perl::Tidy::Formatter::pad_token
0000s0sPerl::Tidy::Formatter::::prepare_for_new_input_lines Perl::Tidy::Formatter::prepare_for_new_input_lines
0000s0sPerl::Tidy::Formatter::::previous_nonblank_token Perl::Tidy::Formatter::previous_nonblank_token
0000s0sPerl::Tidy::Formatter::::print_line_of_tokens Perl::Tidy::Formatter::print_line_of_tokens
0000s0sPerl::Tidy::Formatter::::recombine_breakpoints Perl::Tidy::Formatter::recombine_breakpoints
0000s0sPerl::Tidy::Formatter::::reduce_lp_indentation Perl::Tidy::Formatter::reduce_lp_indentation
0000s0sPerl::Tidy::Formatter::::report_definite_bug Perl::Tidy::Formatter::report_definite_bug
0000s0sPerl::Tidy::Formatter::::reset_block_text_accumulator Perl::Tidy::Formatter::reset_block_text_accumulator
0000s0sPerl::Tidy::Formatter::::restore_current_token Perl::Tidy::Formatter::restore_current_token
0000s0sPerl::Tidy::Formatter::::rtoken_length Perl::Tidy::Formatter::rtoken_length
0000s0sPerl::Tidy::Formatter::::save_current_token Perl::Tidy::Formatter::save_current_token
0000s0sPerl::Tidy::Formatter::::save_opening_indentation Perl::Tidy::Formatter::save_opening_indentation
0000s0sPerl::Tidy::Formatter::::scan_list Perl::Tidy::Formatter::scan_list
0000s0sPerl::Tidy::Formatter::::secret_operator_whitespace Perl::Tidy::Formatter::secret_operator_whitespace
0000s0sPerl::Tidy::Formatter::::send_lines_to_vertical_aligner Perl::Tidy::Formatter::send_lines_to_vertical_aligner
0000s0sPerl::Tidy::Formatter::::set_adjusted_indentation Perl::Tidy::Formatter::set_adjusted_indentation
0000s0sPerl::Tidy::Formatter::::set_block_text_accumulator Perl::Tidy::Formatter::set_block_text_accumulator
0000s0sPerl::Tidy::Formatter::::set_bond_strengths Perl::Tidy::Formatter::set_bond_strengths
0000s0sPerl::Tidy::Formatter::::set_closing_breakpoint Perl::Tidy::Formatter::set_closing_breakpoint
0000s0sPerl::Tidy::Formatter::::set_comma_breakpoints Perl::Tidy::Formatter::set_comma_breakpoints
0000s0sPerl::Tidy::Formatter::::set_comma_breakpoints_do Perl::Tidy::Formatter::set_comma_breakpoints_do
0000s0sPerl::Tidy::Formatter::::set_continuation_breaks Perl::Tidy::Formatter::set_continuation_breaks
0000s0sPerl::Tidy::Formatter::::set_fake_breakpoint Perl::Tidy::Formatter::set_fake_breakpoint
0000s0sPerl::Tidy::Formatter::::set_for_semicolon_breakpoints Perl::Tidy::Formatter::set_for_semicolon_breakpoints
0000s0sPerl::Tidy::Formatter::::set_forced_breakpoint Perl::Tidy::Formatter::set_forced_breakpoint
0000s0sPerl::Tidy::Formatter::::set_leading_whitespace Perl::Tidy::Formatter::set_leading_whitespace
0000s0sPerl::Tidy::Formatter::::set_logical_breakpoints Perl::Tidy::Formatter::set_logical_breakpoints
0000s0sPerl::Tidy::Formatter::::set_logical_padding Perl::Tidy::Formatter::set_logical_padding
0000s0sPerl::Tidy::Formatter::::set_nobreaks Perl::Tidy::Formatter::set_nobreaks
0000s0sPerl::Tidy::Formatter::::set_non_alignment_flags Perl::Tidy::Formatter::set_non_alignment_flags
0000s0sPerl::Tidy::Formatter::::set_ragged_breakpoints Perl::Tidy::Formatter::set_ragged_breakpoints
0000s0sPerl::Tidy::Formatter::::set_vertical_alignment_markers Perl::Tidy::Formatter::set_vertical_alignment_markers
0000s0sPerl::Tidy::Formatter::::set_vertical_tightness_flags Perl::Tidy::Formatter::set_vertical_tightness_flags
0000s0sPerl::Tidy::Formatter::::set_white_space_flag Perl::Tidy::Formatter::set_white_space_flag
0000s0sPerl::Tidy::Formatter::::split_words Perl::Tidy::Formatter::split_words
0000s0sPerl::Tidy::Formatter::::starting_one_line_block Perl::Tidy::Formatter::starting_one_line_block
0000s0sPerl::Tidy::Formatter::::store_token_to_go Perl::Tidy::Formatter::store_token_to_go
0000s0sPerl::Tidy::Formatter::::study_list_complexity Perl::Tidy::Formatter::study_list_complexity
0000s0sPerl::Tidy::Formatter::::table_columns_available Perl::Tidy::Formatter::table_columns_available
0000s0sPerl::Tidy::Formatter::::terminal_type Perl::Tidy::Formatter::terminal_type
0000s0sPerl::Tidy::Formatter::::token_length Perl::Tidy::Formatter::token_length
0000s0sPerl::Tidy::Formatter::::token_sequence_length Perl::Tidy::Formatter::token_sequence_length
0000s0sPerl::Tidy::Formatter::::total_line_length Perl::Tidy::Formatter::total_line_length
0000s0sPerl::Tidy::Formatter::::trim Perl::Tidy::Formatter::trim
0000s0sPerl::Tidy::Formatter::::undo_ci Perl::Tidy::Formatter::undo_ci
0000s0sPerl::Tidy::Formatter::::undo_forced_breakpoint_stack Perl::Tidy::Formatter::undo_forced_breakpoint_stack
0000s0sPerl::Tidy::Formatter::::undo_lp_ci Perl::Tidy::Formatter::undo_lp_ci
0000s0sPerl::Tidy::Formatter::::unstore_token_to_go Perl::Tidy::Formatter::unstore_token_to_go
0000s0sPerl::Tidy::Formatter::::want_blank_line Perl::Tidy::Formatter::want_blank_line
0000s0sPerl::Tidy::Formatter::::warning Perl::Tidy::Formatter::warning
0000s0sPerl::Tidy::Formatter::::we_are_at_the_last_line Perl::Tidy::Formatter::we_are_at_the_last_line
0000s0sPerl::Tidy::Formatter::::write_diagnostics Perl::Tidy::Formatter::write_diagnostics
0000s0sPerl::Tidy::Formatter::::write_line Perl::Tidy::Formatter::write_line
0000s0sPerl::Tidy::Formatter::::write_logfile_entry Perl::Tidy::Formatter::write_logfile_entry
0000s0sPerl::Tidy::Formatter::::write_unindented_line Perl::Tidy::Formatter::write_unindented_line
0000s0sPerl::Tidy::HtmlWriter::::__ANON__[:4680] Perl::Tidy::HtmlWriter::__ANON__[:4680]
0000s0sPerl::Tidy::HtmlWriter::::__ANON__[:4690] Perl::Tidy::HtmlWriter::__ANON__[:4690]
0000s0sPerl::Tidy::HtmlWriter::::__ANON__[:5185] Perl::Tidy::HtmlWriter::__ANON__[:5185]
0000s0sPerl::Tidy::HtmlWriter::::__ANON__[:5210] Perl::Tidy::HtmlWriter::__ANON__[:5210]
0000s0sPerl::Tidy::HtmlWriter::::add_toc_item Perl::Tidy::HtmlWriter::add_toc_item
0000s0sPerl::Tidy::HtmlWriter::::change_anchor_names Perl::Tidy::HtmlWriter::change_anchor_names
0000s0sPerl::Tidy::HtmlWriter::::check_RGB Perl::Tidy::HtmlWriter::check_RGB
0000s0sPerl::Tidy::HtmlWriter::::check_options Perl::Tidy::HtmlWriter::check_options
0000s0sPerl::Tidy::HtmlWriter::::close_html_file Perl::Tidy::HtmlWriter::close_html_file
0000s0sPerl::Tidy::HtmlWriter::::escape_html Perl::Tidy::HtmlWriter::escape_html
0000s0sPerl::Tidy::HtmlWriter::::finish_formatting Perl::Tidy::HtmlWriter::finish_formatting
0000s0sPerl::Tidy::HtmlWriter::::make_abbreviated_names Perl::Tidy::HtmlWriter::make_abbreviated_names
0000s0sPerl::Tidy::HtmlWriter::::make_frame Perl::Tidy::HtmlWriter::make_frame
0000s0sPerl::Tidy::HtmlWriter::::make_getopt_long_names Perl::Tidy::HtmlWriter::make_getopt_long_names
0000s0sPerl::Tidy::HtmlWriter::::markup_html_element Perl::Tidy::HtmlWriter::markup_html_element
0000s0sPerl::Tidy::HtmlWriter::::markup_tokens Perl::Tidy::HtmlWriter::markup_tokens
0000s0sPerl::Tidy::HtmlWriter::::new Perl::Tidy::HtmlWriter::new
0000s0sPerl::Tidy::HtmlWriter::::pod_to_html Perl::Tidy::HtmlWriter::pod_to_html
0000s0sPerl::Tidy::HtmlWriter::::set_default_color Perl::Tidy::HtmlWriter::set_default_color
0000s0sPerl::Tidy::HtmlWriter::::set_default_properties Perl::Tidy::HtmlWriter::set_default_properties
0000s0sPerl::Tidy::HtmlWriter::::write_frame_html Perl::Tidy::HtmlWriter::write_frame_html
0000s0sPerl::Tidy::HtmlWriter::::write_line Perl::Tidy::HtmlWriter::write_line
0000s0sPerl::Tidy::HtmlWriter::::write_style_sheet_data Perl::Tidy::HtmlWriter::write_style_sheet_data
0000s0sPerl::Tidy::HtmlWriter::::write_style_sheet_file Perl::Tidy::HtmlWriter::write_style_sheet_file
0000s0sPerl::Tidy::HtmlWriter::::write_toc_html Perl::Tidy::HtmlWriter::write_toc_html
0000s0sPerl::Tidy::IOScalar::::close Perl::Tidy::IOScalar::close
0000s0sPerl::Tidy::IOScalar::::getline Perl::Tidy::IOScalar::getline
0000s0sPerl::Tidy::IOScalar::::new Perl::Tidy::IOScalar::new
0000s0sPerl::Tidy::IOScalar::::print Perl::Tidy::IOScalar::print
0000s0sPerl::Tidy::IOScalarArray::::close Perl::Tidy::IOScalarArray::close
0000s0sPerl::Tidy::IOScalarArray::::getline Perl::Tidy::IOScalarArray::getline
0000s0sPerl::Tidy::IOScalarArray::::new Perl::Tidy::IOScalarArray::new
0000s0sPerl::Tidy::IOScalarArray::::print Perl::Tidy::IOScalarArray::print
0000s0sPerl::Tidy::IndentationItem::::decrease_AVAILABLE_SPACES Perl::Tidy::IndentationItem::decrease_AVAILABLE_SPACES
0000s0sPerl::Tidy::IndentationItem::::decrease_SPACES Perl::Tidy::IndentationItem::decrease_SPACES
0000s0sPerl::Tidy::IndentationItem::::get_ALIGN_PAREN Perl::Tidy::IndentationItem::get_ALIGN_PAREN
0000s0sPerl::Tidy::IndentationItem::::get_ARROW_COUNT Perl::Tidy::IndentationItem::get_ARROW_COUNT
0000s0sPerl::Tidy::IndentationItem::::get_AVAILABLE_SPACES Perl::Tidy::IndentationItem::get_AVAILABLE_SPACES
0000s0sPerl::Tidy::IndentationItem::::get_CI_LEVEL Perl::Tidy::IndentationItem::get_CI_LEVEL
0000s0sPerl::Tidy::IndentationItem::::get_CLOSED Perl::Tidy::IndentationItem::get_CLOSED
0000s0sPerl::Tidy::IndentationItem::::get_COMMA_COUNT Perl::Tidy::IndentationItem::get_COMMA_COUNT
0000s0sPerl::Tidy::IndentationItem::::get_HAVE_CHILD Perl::Tidy::IndentationItem::get_HAVE_CHILD
0000s0sPerl::Tidy::IndentationItem::::get_INDEX Perl::Tidy::IndentationItem::get_INDEX
0000s0sPerl::Tidy::IndentationItem::::get_LEVEL Perl::Tidy::IndentationItem::get_LEVEL
0000s0sPerl::Tidy::IndentationItem::::get_MARKED Perl::Tidy::IndentationItem::get_MARKED
0000s0sPerl::Tidy::IndentationItem::::get_RECOVERABLE_SPACES Perl::Tidy::IndentationItem::get_RECOVERABLE_SPACES
0000s0sPerl::Tidy::IndentationItem::::get_SEQUENCE_NUMBER Perl::Tidy::IndentationItem::get_SEQUENCE_NUMBER
0000s0sPerl::Tidy::IndentationItem::::get_SPACES Perl::Tidy::IndentationItem::get_SPACES
0000s0sPerl::Tidy::IndentationItem::::get_STACK_DEPTH Perl::Tidy::IndentationItem::get_STACK_DEPTH
0000s0sPerl::Tidy::IndentationItem::::get_STARTING_INDEX Perl::Tidy::IndentationItem::get_STARTING_INDEX
0000s0sPerl::Tidy::IndentationItem::::increase_RECOVERABLE_SPACES Perl::Tidy::IndentationItem::increase_RECOVERABLE_SPACES
0000s0sPerl::Tidy::IndentationItem::::new Perl::Tidy::IndentationItem::new
0000s0sPerl::Tidy::IndentationItem::::permanently_decrease_AVAILABLE_SPACES Perl::Tidy::IndentationItem::permanently_decrease_AVAILABLE_SPACES
0000s0sPerl::Tidy::IndentationItem::::set_ARROW_COUNT Perl::Tidy::IndentationItem::set_ARROW_COUNT
0000s0sPerl::Tidy::IndentationItem::::set_CLOSED Perl::Tidy::IndentationItem::set_CLOSED
0000s0sPerl::Tidy::IndentationItem::::set_COMMA_COUNT Perl::Tidy::IndentationItem::set_COMMA_COUNT
0000s0sPerl::Tidy::IndentationItem::::set_HAVE_CHILD Perl::Tidy::IndentationItem::set_HAVE_CHILD
0000s0sPerl::Tidy::IndentationItem::::set_MARKED Perl::Tidy::IndentationItem::set_MARKED
0000s0sPerl::Tidy::IndentationItem::::set_RECOVERABLE_SPACES Perl::Tidy::IndentationItem::set_RECOVERABLE_SPACES
0000s0sPerl::Tidy::IndentationItem::::tentatively_decrease_AVAILABLE_SPACES Perl::Tidy::IndentationItem::tentatively_decrease_AVAILABLE_SPACES
0000s0sPerl::Tidy::LineBuffer::::get_line Perl::Tidy::LineBuffer::get_line
0000s0sPerl::Tidy::LineBuffer::::new Perl::Tidy::LineBuffer::new
0000s0sPerl::Tidy::LineBuffer::::peek_ahead Perl::Tidy::LineBuffer::peek_ahead
0000s0sPerl::Tidy::LineSink::::close_output_file Perl::Tidy::LineSink::close_output_file
0000s0sPerl::Tidy::LineSink::::close_tee_file Perl::Tidy::LineSink::close_tee_file
0000s0sPerl::Tidy::LineSink::::new Perl::Tidy::LineSink::new
0000s0sPerl::Tidy::LineSink::::really_open_tee_file Perl::Tidy::LineSink::really_open_tee_file
0000s0sPerl::Tidy::LineSink::::tee_off Perl::Tidy::LineSink::tee_off
0000s0sPerl::Tidy::LineSink::::tee_on Perl::Tidy::LineSink::tee_on
0000s0sPerl::Tidy::LineSink::::write_line Perl::Tidy::LineSink::write_line
0000s0sPerl::Tidy::LineSource::::close_input_file Perl::Tidy::LineSource::close_input_file
0000s0sPerl::Tidy::LineSource::::get_line Perl::Tidy::LineSource::get_line
0000s0sPerl::Tidy::LineSource::::new Perl::Tidy::LineSource::new
0000s0sPerl::Tidy::Logger::::ask_user_for_bug_report Perl::Tidy::Logger::ask_user_for_bug_report
0000s0sPerl::Tidy::Logger::::black_box Perl::Tidy::Logger::black_box
0000s0sPerl::Tidy::Logger::::block_log_output Perl::Tidy::Logger::block_log_output
0000s0sPerl::Tidy::Logger::::brace_warning Perl::Tidy::Logger::brace_warning
0000s0sPerl::Tidy::Logger::::complain Perl::Tidy::Logger::complain
0000s0sPerl::Tidy::Logger::::finish Perl::Tidy::Logger::finish
0000s0sPerl::Tidy::Logger::::get_saw_brace_error Perl::Tidy::Logger::get_saw_brace_error
0000s0sPerl::Tidy::Logger::::get_use_prefix Perl::Tidy::Logger::get_use_prefix
0000s0sPerl::Tidy::Logger::::get_warning_count Perl::Tidy::Logger::get_warning_count
0000s0sPerl::Tidy::Logger::::increment_brace_error Perl::Tidy::Logger::increment_brace_error
0000s0sPerl::Tidy::Logger::::interrupt_logfile Perl::Tidy::Logger::interrupt_logfile
0000s0sPerl::Tidy::Logger::::logfile_output Perl::Tidy::Logger::logfile_output
0000s0sPerl::Tidy::Logger::::make_line_information_string Perl::Tidy::Logger::make_line_information_string
0000s0sPerl::Tidy::Logger::::new Perl::Tidy::Logger::new
0000s0sPerl::Tidy::Logger::::report_definite_bug Perl::Tidy::Logger::report_definite_bug
0000s0sPerl::Tidy::Logger::::report_possible_bug Perl::Tidy::Logger::report_possible_bug
0000s0sPerl::Tidy::Logger::::resume_logfile Perl::Tidy::Logger::resume_logfile
0000s0sPerl::Tidy::Logger::::unblock_log_output Perl::Tidy::Logger::unblock_log_output
0000s0sPerl::Tidy::Logger::::warning Perl::Tidy::Logger::warning
0000s0sPerl::Tidy::Logger::::we_are_at_the_last_line Perl::Tidy::Logger::we_are_at_the_last_line
0000s0sPerl::Tidy::Logger::::write_column_headings Perl::Tidy::Logger::write_column_headings
0000s0sPerl::Tidy::Logger::::write_logfile_entry Perl::Tidy::Logger::write_logfile_entry
0000s0sPerl::Tidy::Tokenizer::::DESTROY Perl::Tidy::Tokenizer::DESTROY
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:22588] Perl::Tidy::Tokenizer::__ANON__[:22588]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24021] Perl::Tidy::Tokenizer::__ANON__[:24021]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24025] Perl::Tidy::Tokenizer::__ANON__[:24025]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24050] Perl::Tidy::Tokenizer::__ANON__[:24050]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24164] Perl::Tidy::Tokenizer::__ANON__[:24164]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24184] Perl::Tidy::Tokenizer::__ANON__[:24184]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24196] Perl::Tidy::Tokenizer::__ANON__[:24196]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24221] Perl::Tidy::Tokenizer::__ANON__[:24221]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24228] Perl::Tidy::Tokenizer::__ANON__[:24228]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24235] Perl::Tidy::Tokenizer::__ANON__[:24235]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24242] Perl::Tidy::Tokenizer::__ANON__[:24242]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24278] Perl::Tidy::Tokenizer::__ANON__[:24278]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24400] Perl::Tidy::Tokenizer::__ANON__[:24400]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24429] Perl::Tidy::Tokenizer::__ANON__[:24429]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24448] Perl::Tidy::Tokenizer::__ANON__[:24448]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24465] Perl::Tidy::Tokenizer::__ANON__[:24465]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24491] Perl::Tidy::Tokenizer::__ANON__[:24491]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24515] Perl::Tidy::Tokenizer::__ANON__[:24515]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24527] Perl::Tidy::Tokenizer::__ANON__[:24527]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24561] Perl::Tidy::Tokenizer::__ANON__[:24561]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24575] Perl::Tidy::Tokenizer::__ANON__[:24575]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24581] Perl::Tidy::Tokenizer::__ANON__[:24581]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24591] Perl::Tidy::Tokenizer::__ANON__[:24591]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24604] Perl::Tidy::Tokenizer::__ANON__[:24604]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24622] Perl::Tidy::Tokenizer::__ANON__[:24622]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24658] Perl::Tidy::Tokenizer::__ANON__[:24658]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24689] Perl::Tidy::Tokenizer::__ANON__[:24689]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24693] Perl::Tidy::Tokenizer::__ANON__[:24693]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24734] Perl::Tidy::Tokenizer::__ANON__[:24734]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24740] Perl::Tidy::Tokenizer::__ANON__[:24740]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24750] Perl::Tidy::Tokenizer::__ANON__[:24750]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24760] Perl::Tidy::Tokenizer::__ANON__[:24760]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24771] Perl::Tidy::Tokenizer::__ANON__[:24771]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24776] Perl::Tidy::Tokenizer::__ANON__[:24776]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24781] Perl::Tidy::Tokenizer::__ANON__[:24781]
0000s0sPerl::Tidy::Tokenizer::::__ANON__[:24786] Perl::Tidy::Tokenizer::__ANON__[:24786]
0000s0sPerl::Tidy::Tokenizer::::_decrement_count Perl::Tidy::Tokenizer::_decrement_count
0000s0sPerl::Tidy::Tokenizer::::_increment_count Perl::Tidy::Tokenizer::_increment_count
0000s0sPerl::Tidy::Tokenizer::::brace_warning Perl::Tidy::Tokenizer::brace_warning
0000s0sPerl::Tidy::Tokenizer::::check_final_nesting_depths Perl::Tidy::Tokenizer::check_final_nesting_depths
0000s0sPerl::Tidy::Tokenizer::::check_prototype Perl::Tidy::Tokenizer::check_prototype
0000s0sPerl::Tidy::Tokenizer::::code_block_type Perl::Tidy::Tokenizer::code_block_type
0000s0sPerl::Tidy::Tokenizer::::complain Perl::Tidy::Tokenizer::complain
0000s0sPerl::Tidy::Tokenizer::::decide_if_code_block Perl::Tidy::Tokenizer::decide_if_code_block
0000s0sPerl::Tidy::Tokenizer::::decrease_nesting_depth Perl::Tidy::Tokenizer::decrease_nesting_depth
0000s0sPerl::Tidy::Tokenizer::::do_quote Perl::Tidy::Tokenizer::do_quote
0000s0sPerl::Tidy::Tokenizer::::do_scan_package Perl::Tidy::Tokenizer::do_scan_package
0000s0sPerl::Tidy::Tokenizer::::do_scan_sub Perl::Tidy::Tokenizer::do_scan_sub
0000s0sPerl::Tidy::Tokenizer::::dump_functions Perl::Tidy::Tokenizer::dump_functions
0000s0sPerl::Tidy::Tokenizer::::dump_token_types Perl::Tidy::Tokenizer::dump_token_types
0000s0sPerl::Tidy::Tokenizer::::error_if_expecting_OPERATOR Perl::Tidy::Tokenizer::error_if_expecting_OPERATOR
0000s0sPerl::Tidy::Tokenizer::::error_if_expecting_TERM Perl::Tidy::Tokenizer::error_if_expecting_TERM
0000s0sPerl::Tidy::Tokenizer::::find_angle_operator_termination Perl::Tidy::Tokenizer::find_angle_operator_termination
0000s0sPerl::Tidy::Tokenizer::::find_here_doc Perl::Tidy::Tokenizer::find_here_doc
0000s0sPerl::Tidy::Tokenizer::::find_next_nonblank_token Perl::Tidy::Tokenizer::find_next_nonblank_token
0000s0sPerl::Tidy::Tokenizer::::find_next_nonblank_token_on_this_line Perl::Tidy::Tokenizer::find_next_nonblank_token_on_this_line
0000s0sPerl::Tidy::Tokenizer::::find_starting_indentation_level Perl::Tidy::Tokenizer::find_starting_indentation_level
0000s0sPerl::Tidy::Tokenizer::::follow_quoted_string Perl::Tidy::Tokenizer::follow_quoted_string
0000s0sPerl::Tidy::Tokenizer::::get_count Perl::Tidy::Tokenizer::get_count
0000s0sPerl::Tidy::Tokenizer::::get_indentation_level Perl::Tidy::Tokenizer::get_indentation_level
0000s0sPerl::Tidy::Tokenizer::::get_input_line_number Perl::Tidy::Tokenizer::get_input_line_number
0000s0sPerl::Tidy::Tokenizer::::get_line Perl::Tidy::Tokenizer::get_line
0000s0sPerl::Tidy::Tokenizer::::get_saw_brace_error Perl::Tidy::Tokenizer::get_saw_brace_error
0000s0sPerl::Tidy::Tokenizer::::guess_if_here_doc Perl::Tidy::Tokenizer::guess_if_here_doc
0000s0sPerl::Tidy::Tokenizer::::guess_if_pattern_or_conditional Perl::Tidy::Tokenizer::guess_if_pattern_or_conditional
0000s0sPerl::Tidy::Tokenizer::::guess_if_pattern_or_division Perl::Tidy::Tokenizer::guess_if_pattern_or_division
0000s0sPerl::Tidy::Tokenizer::::guess_old_indentation_level Perl::Tidy::Tokenizer::guess_old_indentation_level
0000s0sPerl::Tidy::Tokenizer::::increase_nesting_depth Perl::Tidy::Tokenizer::increase_nesting_depth
0000s0sPerl::Tidy::Tokenizer::::increment_brace_error Perl::Tidy::Tokenizer::increment_brace_error
0000s0sPerl::Tidy::Tokenizer::::indicate_error Perl::Tidy::Tokenizer::indicate_error
0000s0sPerl::Tidy::Tokenizer::::initialize_tokenizer_state Perl::Tidy::Tokenizer::initialize_tokenizer_state
0000s0sPerl::Tidy::Tokenizer::::interrupt_logfile Perl::Tidy::Tokenizer::interrupt_logfile
0000s0sPerl::Tidy::Tokenizer::::inverse_pretoken_map Perl::Tidy::Tokenizer::inverse_pretoken_map
0000s0sPerl::Tidy::Tokenizer::::is_non_structural_brace Perl::Tidy::Tokenizer::is_non_structural_brace
0000s0sPerl::Tidy::Tokenizer::::label_ok Perl::Tidy::Tokenizer::label_ok
0000s0sPerl::Tidy::Tokenizer::::make_numbered_line Perl::Tidy::Tokenizer::make_numbered_line
0000s0sPerl::Tidy::Tokenizer::::matching_end_token Perl::Tidy::Tokenizer::matching_end_token
0000s0sPerl::Tidy::Tokenizer::::new Perl::Tidy::Tokenizer::new
0000s0sPerl::Tidy::Tokenizer::::new_statement_ok Perl::Tidy::Tokenizer::new_statement_ok
0000s0sPerl::Tidy::Tokenizer::::numerator_expected Perl::Tidy::Tokenizer::numerator_expected
0000s0sPerl::Tidy::Tokenizer::::ones_count Perl::Tidy::Tokenizer::ones_count
0000s0sPerl::Tidy::Tokenizer::::operator_expected Perl::Tidy::Tokenizer::operator_expected
0000s0sPerl::Tidy::Tokenizer::::pattern_expected Perl::Tidy::Tokenizer::pattern_expected
0000s0sPerl::Tidy::Tokenizer::::peek_ahead_for_n_nonblank_pre_tokens Perl::Tidy::Tokenizer::peek_ahead_for_n_nonblank_pre_tokens
0000s0sPerl::Tidy::Tokenizer::::peek_ahead_for_nonblank_token Perl::Tidy::Tokenizer::peek_ahead_for_nonblank_token
0000s0sPerl::Tidy::Tokenizer::::peeked_ahead Perl::Tidy::Tokenizer::peeked_ahead
0000s0sPerl::Tidy::Tokenizer::::pre_tokenize Perl::Tidy::Tokenizer::pre_tokenize
0000s0sPerl::Tidy::Tokenizer::::prepare_for_a_new_file Perl::Tidy::Tokenizer::prepare_for_a_new_file
0000s0sPerl::Tidy::Tokenizer::::report_definite_bug Perl::Tidy::Tokenizer::report_definite_bug
0000s0sPerl::Tidy::Tokenizer::::report_tokenization_errors Perl::Tidy::Tokenizer::report_tokenization_errors
0000s0sPerl::Tidy::Tokenizer::::report_v_string Perl::Tidy::Tokenizer::report_v_string
0000s0sPerl::Tidy::Tokenizer::::reset_indentation_level Perl::Tidy::Tokenizer::reset_indentation_level
0000s0sPerl::Tidy::Tokenizer::::restore_tokenizer_state Perl::Tidy::Tokenizer::restore_tokenizer_state
0000s0sPerl::Tidy::Tokenizer::::resume_logfile Perl::Tidy::Tokenizer::resume_logfile
0000s0sPerl::Tidy::Tokenizer::::save_tokenizer_state Perl::Tidy::Tokenizer::save_tokenizer_state
0000s0sPerl::Tidy::Tokenizer::::scan_bare_identifier Perl::Tidy::Tokenizer::scan_bare_identifier
0000s0sPerl::Tidy::Tokenizer::::scan_bare_identifier_do Perl::Tidy::Tokenizer::scan_bare_identifier_do
0000s0sPerl::Tidy::Tokenizer::::scan_id Perl::Tidy::Tokenizer::scan_id
0000s0sPerl::Tidy::Tokenizer::::scan_id_do Perl::Tidy::Tokenizer::scan_id_do
0000s0sPerl::Tidy::Tokenizer::::scan_identifier Perl::Tidy::Tokenizer::scan_identifier
0000s0sPerl::Tidy::Tokenizer::::scan_identifier_do Perl::Tidy::Tokenizer::scan_identifier_do
0000s0sPerl::Tidy::Tokenizer::::scan_number Perl::Tidy::Tokenizer::scan_number
0000s0sPerl::Tidy::Tokenizer::::scan_number_do Perl::Tidy::Tokenizer::scan_number_do
0000s0sPerl::Tidy::Tokenizer::::scan_replacement_text Perl::Tidy::Tokenizer::scan_replacement_text
0000s0sPerl::Tidy::Tokenizer::::show_tokens Perl::Tidy::Tokenizer::show_tokens
0000s0sPerl::Tidy::Tokenizer::::tokenize_this_line Perl::Tidy::Tokenizer::tokenize_this_line
0000s0sPerl::Tidy::Tokenizer::::unexpected Perl::Tidy::Tokenizer::unexpected
0000s0sPerl::Tidy::Tokenizer::::warning Perl::Tidy::Tokenizer::warning
0000s0sPerl::Tidy::Tokenizer::::write_diagnostics Perl::Tidy::Tokenizer::write_diagnostics
0000s0sPerl::Tidy::Tokenizer::::write_error_indicator_pair Perl::Tidy::Tokenizer::write_error_indicator_pair
0000s0sPerl::Tidy::Tokenizer::::write_logfile_entry Perl::Tidy::Tokenizer::write_logfile_entry
0000s0sPerl::Tidy::Tokenizer::::write_on_underline Perl::Tidy::Tokenizer::write_on_underline
0000s0sPerl::Tidy::VerticalAligner::Alignment::::DESTROYPerl::Tidy::VerticalAligner::Alignment::DESTROY
0000s0sPerl::Tidy::VerticalAligner::Alignment::::_decrement_countPerl::Tidy::VerticalAligner::Alignment::_decrement_count
0000s0sPerl::Tidy::VerticalAligner::Alignment::::_increment_countPerl::Tidy::VerticalAligner::Alignment::_increment_count
0000s0sPerl::Tidy::VerticalAligner::Alignment::::get_columnPerl::Tidy::VerticalAligner::Alignment::get_column
0000s0sPerl::Tidy::VerticalAligner::Alignment::::get_countPerl::Tidy::VerticalAligner::Alignment::get_count
0000s0sPerl::Tidy::VerticalAligner::Alignment::::get_ending_linePerl::Tidy::VerticalAligner::Alignment::get_ending_line
0000s0sPerl::Tidy::VerticalAligner::Alignment::::get_matching_tokenPerl::Tidy::VerticalAligner::Alignment::get_matching_token
0000s0sPerl::Tidy::VerticalAligner::Alignment::::get_serial_numberPerl::Tidy::VerticalAligner::Alignment::get_serial_number
0000s0sPerl::Tidy::VerticalAligner::Alignment::::get_starting_columnPerl::Tidy::VerticalAligner::Alignment::get_starting_column
0000s0sPerl::Tidy::VerticalAligner::Alignment::::get_starting_linePerl::Tidy::VerticalAligner::Alignment::get_starting_line
0000s0sPerl::Tidy::VerticalAligner::Alignment::::increment_columnPerl::Tidy::VerticalAligner::Alignment::increment_column
0000s0sPerl::Tidy::VerticalAligner::Alignment::::newPerl::Tidy::VerticalAligner::Alignment::new
0000s0sPerl::Tidy::VerticalAligner::Alignment::::restore_columnPerl::Tidy::VerticalAligner::Alignment::restore_column
0000s0sPerl::Tidy::VerticalAligner::Alignment::::save_columnPerl::Tidy::VerticalAligner::Alignment::save_column
0000s0sPerl::Tidy::VerticalAligner::Alignment::::set_columnPerl::Tidy::VerticalAligner::Alignment::set_column
0000s0sPerl::Tidy::VerticalAligner::Alignment::::set_ending_linePerl::Tidy::VerticalAligner::Alignment::set_ending_line
0000s0sPerl::Tidy::VerticalAligner::Alignment::::set_matching_tokenPerl::Tidy::VerticalAligner::Alignment::set_matching_token
0000s0sPerl::Tidy::VerticalAligner::Alignment::::set_starting_columnPerl::Tidy::VerticalAligner::Alignment::set_starting_column
0000s0sPerl::Tidy::VerticalAligner::Alignment::::set_starting_linePerl::Tidy::VerticalAligner::Alignment::set_starting_line
0000s0sPerl::Tidy::VerticalAligner::Line::::DESTROY Perl::Tidy::VerticalAligner::Line::DESTROY
0000s0sPerl::Tidy::VerticalAligner::Line::::_decrement_count Perl::Tidy::VerticalAligner::Line::_decrement_count
0000s0sPerl::Tidy::VerticalAligner::Line::::_increment_count Perl::Tidy::VerticalAligner::Line::_increment_count
0000s0sPerl::Tidy::VerticalAligner::Line::::current_field_width Perl::Tidy::VerticalAligner::Line::current_field_width
0000s0sPerl::Tidy::VerticalAligner::Line::::field_width_growth Perl::Tidy::VerticalAligner::Line::field_width_growth
0000s0sPerl::Tidy::VerticalAligner::Line::::get_alignment Perl::Tidy::VerticalAligner::Line::get_alignment
0000s0sPerl::Tidy::VerticalAligner::Line::::get_alignments Perl::Tidy::VerticalAligner::Line::get_alignments
0000s0sPerl::Tidy::VerticalAligner::Line::::get_available_space_on_right Perl::Tidy::VerticalAligner::Line::get_available_space_on_right
0000s0sPerl::Tidy::VerticalAligner::Line::::get_column Perl::Tidy::VerticalAligner::Line::get_column
0000s0sPerl::Tidy::VerticalAligner::Line::::get_count Perl::Tidy::VerticalAligner::Line::get_count
0000s0sPerl::Tidy::VerticalAligner::Line::::get_indentation Perl::Tidy::VerticalAligner::Line::get_indentation
0000s0sPerl::Tidy::VerticalAligner::Line::::get_is_hanging_side_comment Perl::Tidy::VerticalAligner::Line::get_is_hanging_side_comment
0000s0sPerl::Tidy::VerticalAligner::Line::::get_jmax Perl::Tidy::VerticalAligner::Line::get_jmax
0000s0sPerl::Tidy::VerticalAligner::Line::::get_jmax_original_line Perl::Tidy::VerticalAligner::Line::get_jmax_original_line
0000s0sPerl::Tidy::VerticalAligner::Line::::get_leading_space_count Perl::Tidy::VerticalAligner::Line::get_leading_space_count
0000s0sPerl::Tidy::VerticalAligner::Line::::get_list_type Perl::Tidy::VerticalAligner::Line::get_list_type
0000s0sPerl::Tidy::VerticalAligner::Line::::get_outdent_long_lines Perl::Tidy::VerticalAligner::Line::get_outdent_long_lines
0000s0sPerl::Tidy::VerticalAligner::Line::::get_rfields Perl::Tidy::VerticalAligner::Line::get_rfields
0000s0sPerl::Tidy::VerticalAligner::Line::::get_rpatterns Perl::Tidy::VerticalAligner::Line::get_rpatterns
0000s0sPerl::Tidy::VerticalAligner::Line::::get_rtokens Perl::Tidy::VerticalAligner::Line::get_rtokens
0000s0sPerl::Tidy::VerticalAligner::Line::::get_rvertical_tightness_flags Perl::Tidy::VerticalAligner::Line::get_rvertical_tightness_flags
0000s0sPerl::Tidy::VerticalAligner::Line::::get_starting_column Perl::Tidy::VerticalAligner::Line::get_starting_column
0000s0sPerl::Tidy::VerticalAligner::Line::::increase_field_width Perl::Tidy::VerticalAligner::Line::increase_field_width
0000s0sPerl::Tidy::VerticalAligner::Line::::increment_column Perl::Tidy::VerticalAligner::Line::increment_column
0000s0sPerl::Tidy::VerticalAligner::Line::::new Perl::Tidy::VerticalAligner::Line::new
0000s0sPerl::Tidy::VerticalAligner::Line::::set_alignment Perl::Tidy::VerticalAligner::Line::set_alignment
0000s0sPerl::Tidy::VerticalAligner::Line::::set_alignments Perl::Tidy::VerticalAligner::Line::set_alignments
0000s0sPerl::Tidy::VerticalAligner::Line::::set_column Perl::Tidy::VerticalAligner::Line::set_column
0000s0sPerl::Tidy::VerticalAligner::Line::::set_indentation Perl::Tidy::VerticalAligner::Line::set_indentation
0000s0sPerl::Tidy::VerticalAligner::Line::::set_is_hanging_side_comment Perl::Tidy::VerticalAligner::Line::set_is_hanging_side_comment
0000s0sPerl::Tidy::VerticalAligner::Line::::set_jmax Perl::Tidy::VerticalAligner::Line::set_jmax
0000s0sPerl::Tidy::VerticalAligner::Line::::set_jmax_original_line Perl::Tidy::VerticalAligner::Line::set_jmax_original_line
0000s0sPerl::Tidy::VerticalAligner::Line::::set_leading_space_count Perl::Tidy::VerticalAligner::Line::set_leading_space_count
0000s0sPerl::Tidy::VerticalAligner::Line::::set_list_type Perl::Tidy::VerticalAligner::Line::set_list_type
0000s0sPerl::Tidy::VerticalAligner::Line::::set_outdent_long_lines Perl::Tidy::VerticalAligner::Line::set_outdent_long_lines
0000s0sPerl::Tidy::VerticalAligner::Line::::set_rfields Perl::Tidy::VerticalAligner::Line::set_rfields
0000s0sPerl::Tidy::VerticalAligner::Line::::set_rpatterns Perl::Tidy::VerticalAligner::Line::set_rpatterns
0000s0sPerl::Tidy::VerticalAligner::Line::::set_rtokens Perl::Tidy::VerticalAligner::Line::set_rtokens
0000s0sPerl::Tidy::VerticalAligner::Line::::starting_field_width Perl::Tidy::VerticalAligner::Line::starting_field_width
0000s0sPerl::Tidy::VerticalAligner::::__ANON__[:19607] Perl::Tidy::VerticalAligner::__ANON__[:19607]
0000s0sPerl::Tidy::VerticalAligner::::add_to_group Perl::Tidy::VerticalAligner::add_to_group
0000s0sPerl::Tidy::VerticalAligner::::adjust_side_comment Perl::Tidy::VerticalAligner::adjust_side_comment
0000s0sPerl::Tidy::VerticalAligner::::check_fit Perl::Tidy::VerticalAligner::check_fit
0000s0sPerl::Tidy::VerticalAligner::::check_match Perl::Tidy::VerticalAligner::check_match
0000s0sPerl::Tidy::VerticalAligner::::combine_fields Perl::Tidy::VerticalAligner::combine_fields
0000s0sPerl::Tidy::VerticalAligner::::decide_if_aligned Perl::Tidy::VerticalAligner::decide_if_aligned
0000s0sPerl::Tidy::VerticalAligner::::decide_if_list Perl::Tidy::VerticalAligner::decide_if_list
0000s0sPerl::Tidy::VerticalAligner::::dump_alignments Perl::Tidy::VerticalAligner::dump_alignments
0000s0sPerl::Tidy::VerticalAligner::::dump_array Perl::Tidy::VerticalAligner::dump_array
0000s0sPerl::Tidy::VerticalAligner::::dump_valign_buffer Perl::Tidy::VerticalAligner::dump_valign_buffer
0000s0sPerl::Tidy::VerticalAligner::::eliminate_new_fields Perl::Tidy::VerticalAligner::eliminate_new_fields
0000s0sPerl::Tidy::VerticalAligner::::eliminate_old_fields Perl::Tidy::VerticalAligner::eliminate_old_fields
0000s0sPerl::Tidy::VerticalAligner::::fix_terminal_else Perl::Tidy::VerticalAligner::fix_terminal_else
0000s0sPerl::Tidy::VerticalAligner::::fix_terminal_ternary Perl::Tidy::VerticalAligner::fix_terminal_ternary
0000s0sPerl::Tidy::VerticalAligner::::flush Perl::Tidy::VerticalAligner::flush
0000s0sPerl::Tidy::VerticalAligner::::forget_side_comment Perl::Tidy::VerticalAligner::forget_side_comment
0000s0sPerl::Tidy::VerticalAligner::::get_RECOVERABLE_SPACES Perl::Tidy::VerticalAligner::get_RECOVERABLE_SPACES
0000s0sPerl::Tidy::VerticalAligner::::get_SPACES Perl::Tidy::VerticalAligner::get_SPACES
0000s0sPerl::Tidy::VerticalAligner::::get_STACK_DEPTH Perl::Tidy::VerticalAligner::get_STACK_DEPTH
0000s0sPerl::Tidy::VerticalAligner::::get_extra_leading_spaces Perl::Tidy::VerticalAligner::get_extra_leading_spaces
0000s0sPerl::Tidy::VerticalAligner::::get_leading_string Perl::Tidy::VerticalAligner::get_leading_string
0000s0sPerl::Tidy::VerticalAligner::::get_output_line_number Perl::Tidy::VerticalAligner::get_output_line_number
0000s0sPerl::Tidy::VerticalAligner::::improve_continuation_indentation Perl::Tidy::VerticalAligner::improve_continuation_indentation
0000s0sPerl::Tidy::VerticalAligner::::initialize Perl::Tidy::VerticalAligner::initialize
0000s0sPerl::Tidy::VerticalAligner::::initialize_for_new_group Perl::Tidy::VerticalAligner::initialize_for_new_group
0000s0sPerl::Tidy::VerticalAligner::::join_hanging_comment Perl::Tidy::VerticalAligner::join_hanging_comment
0000s0sPerl::Tidy::VerticalAligner::::level_change Perl::Tidy::VerticalAligner::level_change
0000s0sPerl::Tidy::VerticalAligner::::make_alignment Perl::Tidy::VerticalAligner::make_alignment
0000s0sPerl::Tidy::VerticalAligner::::make_side_comment Perl::Tidy::VerticalAligner::make_side_comment
0000s0sPerl::Tidy::VerticalAligner::::maximum_line_length_for_level Perl::Tidy::VerticalAligner::maximum_line_length_for_level
0000s0sPerl::Tidy::VerticalAligner::::my_flush Perl::Tidy::VerticalAligner::my_flush
0000s0sPerl::Tidy::VerticalAligner::::reduce_valign_buffer_indentation Perl::Tidy::VerticalAligner::reduce_valign_buffer_indentation
0000s0sPerl::Tidy::VerticalAligner::::report_anything_unusual Perl::Tidy::VerticalAligner::report_anything_unusual
0000s0sPerl::Tidy::VerticalAligner::::report_definite_bug Perl::Tidy::VerticalAligner::report_definite_bug
0000s0sPerl::Tidy::VerticalAligner::::restore_alignment_columns Perl::Tidy::VerticalAligner::restore_alignment_columns
0000s0sPerl::Tidy::VerticalAligner::::save_alignment_columns Perl::Tidy::VerticalAligner::save_alignment_columns
0000s0sPerl::Tidy::VerticalAligner::::valign_input Perl::Tidy::VerticalAligner::valign_input
0000s0sPerl::Tidy::VerticalAligner::::valign_output_step_A Perl::Tidy::VerticalAligner::valign_output_step_A
0000s0sPerl::Tidy::VerticalAligner::::valign_output_step_B Perl::Tidy::VerticalAligner::valign_output_step_B
0000s0sPerl::Tidy::VerticalAligner::::valign_output_step_C Perl::Tidy::VerticalAligner::valign_output_step_C
0000s0sPerl::Tidy::VerticalAligner::::valign_output_step_D Perl::Tidy::VerticalAligner::valign_output_step_D
0000s0sPerl::Tidy::VerticalAligner::::warning Perl::Tidy::VerticalAligner::warning
0000s0sPerl::Tidy::VerticalAligner::::write_diagnostics Perl::Tidy::VerticalAligner::write_diagnostics
0000s0sPerl::Tidy::VerticalAligner::::write_logfile_entry Perl::Tidy::VerticalAligner::write_logfile_entry
0000s0sPerl::Tidy::::Warn Perl::Tidy::Warn
0000s0sPerl::Tidy::::Win_Config_Locs Perl::Tidy::Win_Config_Locs
0000s0sPerl::Tidy::::Win_OS_Type Perl::Tidy::Win_OS_Type
0000s0sPerl::Tidy::::__ANON__[:111] Perl::Tidy::__ANON__[:111]
0000s0sPerl::Tidy::::__ANON__[:114] Perl::Tidy::__ANON__[:114]
0000s0sPerl::Tidy::::__ANON__[:125] Perl::Tidy::__ANON__[:125]
0000s0sPerl::Tidy::::__ANON__[:128] Perl::Tidy::__ANON__[:128]
0000s0sPerl::Tidy::::__ANON__[:142] Perl::Tidy::__ANON__[:142]
0000s0sPerl::Tidy::::__ANON__[:145] Perl::Tidy::__ANON__[:145]
0000s0sPerl::Tidy::::__ANON__[:1507] Perl::Tidy::__ANON__[:1507]
0000s0sPerl::Tidy::::__ANON__[:160] Perl::Tidy::__ANON__[:160]
0000s0sPerl::Tidy::::__ANON__[:163] Perl::Tidy::__ANON__[:163]
0000s0sPerl::Tidy::::__ANON__[:2378] Perl::Tidy::__ANON__[:2378]
0000s0sPerl::Tidy::::__ANON__[:2857] Perl::Tidy::__ANON__[:2857]
0000s0sPerl::Tidy::::__ANON__[:331] Perl::Tidy::__ANON__[:331]
0000s0sPerl::Tidy::::_process_command_line Perl::Tidy::_process_command_line
0000s0sPerl::Tidy::::catfile Perl::Tidy::catfile
0000s0sPerl::Tidy::::check_options Perl::Tidy::check_options
0000s0sPerl::Tidy::::check_syntax Perl::Tidy::check_syntax
0000s0sPerl::Tidy::::check_vms_filename Perl::Tidy::check_vms_filename
0000s0sPerl::Tidy::::do_syntax_check Perl::Tidy::do_syntax_check
0000s0sPerl::Tidy::::dump_config_file Perl::Tidy::dump_config_file
0000s0sPerl::Tidy::::dump_defaults Perl::Tidy::dump_defaults
0000s0sPerl::Tidy::::dump_long_names Perl::Tidy::dump_long_names
0000s0sPerl::Tidy::::dump_short_names Perl::Tidy::dump_short_names
0000s0sPerl::Tidy::::expand_command_abbreviations Perl::Tidy::expand_command_abbreviations
0000s0sPerl::Tidy::::fileglob_to_re Perl::Tidy::fileglob_to_re
0000s0sPerl::Tidy::::find_config_file Perl::Tidy::find_config_file
0000s0sPerl::Tidy::::find_file_upwards Perl::Tidy::find_file_upwards
0000s0sPerl::Tidy::::find_input_line_ending Perl::Tidy::find_input_line_ending
0000s0sPerl::Tidy::::generate_options Perl::Tidy::generate_options
0000s0sPerl::Tidy::::get_stream_as_named_file Perl::Tidy::get_stream_as_named_file
0000s0sPerl::Tidy::::is_unix Perl::Tidy::is_unix
0000s0sPerl::Tidy::::look_for_Windows Perl::Tidy::look_for_Windows
0000s0sPerl::Tidy::::make_extension Perl::Tidy::make_extension
0000s0sPerl::Tidy::::parse_args Perl::Tidy::parse_args
0000s0sPerl::Tidy::::perltidy Perl::Tidy::perltidy
0000s0sPerl::Tidy::::process_command_line Perl::Tidy::process_command_line
0000s0sPerl::Tidy::::process_this_file Perl::Tidy::process_this_file
0000s0sPerl::Tidy::::read_config_file Perl::Tidy::read_config_file
0000s0sPerl::Tidy::::readable_options Perl::Tidy::readable_options
0000s0sPerl::Tidy::::show_version Perl::Tidy::show_version
0000s0sPerl::Tidy::::streamhandle Perl::Tidy::streamhandle
0000s0sPerl::Tidy::::strip_comment Perl::Tidy::strip_comment
0000s0sPerl::Tidy::::usage Perl::Tidy::usage
0000s0sPerl::Tidy::::write_logfile_header Perl::Tidy::write_logfile_header
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1#
2############################################################
3#
4# perltidy - a perl script indenter and formatter
5#
6# Copyright (c) 2000-2014 by Steve Hancock
7# Distributed under the GPL license agreement; see file COPYING
8#
9# This program is free software; you can redistribute it and/or modify
10# it under the terms of the GNU General Public License as published by
11# the Free Software Foundation; either version 2 of the License, or
12# (at your option) any later version.
13#
14# This program is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17# GNU General Public License for more details.
18#
19# You should have received a copy of the GNU General Public License along
20# with this program; if not, write to the Free Software Foundation, Inc.,
21# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22#
23# For brief instructions, try 'perltidy -h'.
24# For more complete documentation, try 'man perltidy'
25# or visit http://perltidy.sourceforge.net
26#
27# This script is an example of the default style. It was formatted with:
28#
29# perltidy Tidy.pm
30#
31# Code Contributions: See ChangeLog.html for a complete history.
32# Michael Cartmell supplied code for adaptation to VMS and helped with
33# v-strings.
34# Hugh S. Myers supplied sub streamhandle and the supporting code to
35# create a Perl::Tidy module which can operate on strings, arrays, etc.
36# Yves Orton supplied coding to help detect Windows versions.
37# Axel Rose supplied a patch for MacPerl.
38# Sebastien Aperghis-Tramoni supplied a patch for the defined or operator.
39# Dan Tyrell contributed a patch for binary I/O.
40# Ueli Hugenschmidt contributed a patch for -fpsc
41# Sam Kington supplied a patch to identify the initial indentation of
42# entabbed code.
43# jonathan swartz supplied patches for:
44# * .../ pattern, which looks upwards from directory
45# * --notidy, to be used in directories where we want to avoid
46# accidentally tidying
47# * prefilter and postfilter
48# * iterations option
49#
50# Many others have supplied key ideas, suggestions, and bug reports;
51# see the CHANGES file.
52#
53############################################################
54
55package Perl::Tidy;
56240┬Ás114┬Ás
# spent 14┬Ás within Perl::Tidy::BEGIN@56 which was called: # once (14┬Ás+0s) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 56
use 5.004; # need IO::File from 5.004 or later
# spent 14┬Ás making 1 call to Perl::Tidy::BEGIN@56
57118┬Ás13┬Ás
# spent 3┬Ás within Perl::Tidy::BEGIN@57 which was called: # once (3┬Ás+0s) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 57
BEGIN { $^W = 1; } # turn on warnings
# spent 3┬Ás making 1 call to Perl::Tidy::BEGIN@57
58
59223┬Ás233┬Ás
# spent 22┬Ás (10+11) within Perl::Tidy::BEGIN@59 which was called: # once (10┬Ás+11┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 59
use strict;
# spent 22┬Ás making 1 call to Perl::Tidy::BEGIN@59 # spent 12┬Ás making 1 call to strict::import
60219┬Ás240┬Ás
# spent 24┬Ás (8+16) within Perl::Tidy::BEGIN@60 which was called: # once (8┬Ás+16┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 60
use Exporter;
# spent 24┬Ás making 1 call to Perl::Tidy::BEGIN@60 # spent 16┬Ás making 1 call to Exporter::import
61228┬Ás267┬Ás
# spent 38┬Ás (8+30) within Perl::Tidy::BEGIN@61 which was called: # once (8┬Ás+30┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 61
use Carp;
# spent 38┬Ás making 1 call to Perl::Tidy::BEGIN@61 # spent 30┬Ás making 1 call to Exporter::import
6212┬Ás$|++;
63
641600ns
# spent 72┬Ás (8+64) within Perl::Tidy::BEGIN@64 which was called: # once (8┬Ás+64┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 70
use vars qw{
65 $VERSION
66 @ISA
67 @EXPORT
68 $missing_file_spec
69 $fh_stderr
70132┬Ás2136┬Ás};
# spent 72┬Ás making 1 call to Perl::Tidy::BEGIN@64 # spent 64┬Ás making 1 call to vars::import
71
72111┬Ás@ISA = qw( Exporter );
731800ns@EXPORT = qw( &perltidy );
74
75234┬Ás273┬Ás
# spent 42┬Ás (11+31) within Perl::Tidy::BEGIN@75 which was called: # once (11┬Ás+31┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 75
use Cwd;
# spent 42┬Ás making 1 call to Perl::Tidy::BEGIN@75 # spent 31┬Ás making 1 call to Exporter::import
762133┬Ás21.10ms
# spent 1.00ms (628┬Ás+377┬Ás) within Perl::Tidy::BEGIN@76 which was called: # once (628┬Ás+377┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 76
use IO::File;
# spent 1.00ms making 1 call to Perl::Tidy::BEGIN@76 # spent 100┬Ás making 1 call to Exporter::import
77221┬Ás266┬Ás
# spent 38┬Ás (11+28) within Perl::Tidy::BEGIN@77 which was called: # once (11┬Ás+28┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 77
use File::Basename;
# spent 38┬Ás making 1 call to Perl::Tidy::BEGIN@77 # spent 28┬Ás making 1 call to Exporter::import
782109┬Ás21.98ms
# spent 1.96ms (1.84+119┬Ás) within Perl::Tidy::BEGIN@78 which was called: # once (1.84ms+119┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 78
use File::Copy;
# spent 1.96ms making 1 call to Perl::Tidy::BEGIN@78 # spent 27┬Ás making 1 call to Exporter::import
79253┬Ás2135┬Ás
# spent 72┬Ás (9+63) within Perl::Tidy::BEGIN@79 which was called: # once (9┬Ás+63┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 79
use File::Temp qw(tempfile);
# spent 72┬Ás making 1 call to Perl::Tidy::BEGIN@79 # spent 63┬Ás making 1 call to Exporter::import
80
81
# spent 23┬Ás (16+7) within Perl::Tidy::BEGIN@81 which was called: # once (16┬Ás+7┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 83
BEGIN {
82122┬Ás37┬Ás ( $VERSION = q($Id: Tidy.pm,v 1.74 2014/03/28 13:56:49 perltidy Exp $) ) =~ s/^.*\s+(\d+)\/(\d+)\/(\d+).*$/$1$2$3/; # all one line for MakeMaker
# spent 6┬Ás making 1 call to Perl::Tidy::CORE:subst # spent 1┬Ás making 2 calls to Perl::Tidy::CORE:substcont, avg 650ns/call
831454┬Ás123┬Ás}
# spent 23┬Ás making 1 call to Perl::Tidy::BEGIN@81
84
85sub streamhandle {
86
87 # given filename and mode (r or w), create an object which:
88 # has a 'getline' method if mode='r', and
89 # has a 'print' method if mode='w'.
90 # The objects also need a 'close' method.
91 #
92 # How the object is made:
93 #
94 # if $filename is: Make object using:
95 # ---------------- -----------------
96 # '-' (STDIN if mode = 'r', STDOUT if mode='w')
97 # string IO::File
98 # ARRAY ref Perl::Tidy::IOScalarArray (formerly IO::ScalarArray)
99 # STRING ref Perl::Tidy::IOScalar (formerly IO::Scalar)
100 # object object
101 # (check for 'print' method for 'w' mode)
102 # (check for 'getline' method for 'r' mode)
103 my $ref = ref( my $filename = shift );
104 my $mode = shift;
105 my $New;
106 my $fh;
107
108 # handle a reference
109 if ($ref) {
110 if ( $ref eq 'ARRAY' ) {
111 $New = sub { Perl::Tidy::IOScalarArray->new(@_) };
112 }
113 elsif ( $ref eq 'SCALAR' ) {
114 $New = sub { Perl::Tidy::IOScalar->new(@_) };
115 }
116 else {
117
118 # Accept an object with a getline method for reading. Note:
119 # IO::File is built-in and does not respond to the defined
120 # operator. If this causes trouble, the check can be
121 # skipped and we can just let it crash if there is no
122 # getline.
123 if ( $mode =~ /[rR]/ ) {
124 if ( $ref eq 'IO::File' || defined &{ $ref . "::getline" } ) {
125 $New = sub { $filename };
126 }
127 else {
128 $New = sub { undef };
129 confess <<EOM;
130------------------------------------------------------------------------
131No 'getline' method is defined for object of class $ref
132Please check your call to Perl::Tidy::perltidy. Trace follows.
133------------------------------------------------------------------------
134EOM
135 }
136 }
137
138 # Accept an object with a print method for writing.
139 # See note above about IO::File
140 if ( $mode =~ /[wW]/ ) {
141 if ( $ref eq 'IO::File' || defined &{ $ref . "::print" } ) {
142 $New = sub { $filename };
143 }
144 else {
145 $New = sub { undef };
146 confess <<EOM;
147------------------------------------------------------------------------
148No 'print' method is defined for object of class $ref
149Please check your call to Perl::Tidy::perltidy. Trace follows.
150------------------------------------------------------------------------
151EOM
152 }
153 }
154 }
155 }
156
157 # handle a string
158 else {
159 if ( $filename eq '-' ) {
160 $New = sub { $mode eq 'w' ? *STDOUT : *STDIN }
161 }
162 else {
163 $New = sub { IO::File->new(@_) };
164 }
165 }
166 $fh = $New->( $filename, $mode )
167 or Warn("Couldn't open file:$filename in mode:$mode : $!\n");
168 return $fh, ( $ref or $filename );
169}
170
171sub find_input_line_ending {
172
173 # Peek at a file and return first line ending character.
174 # Quietly return undef in case of any trouble.
175 my ($input_file) = @_;
176 my $ending;
177
178 # silently ignore input from object or stdin
179 if ( ref($input_file) || $input_file eq '-' ) {
180 return $ending;
181 }
182 open( INFILE, $input_file ) || return $ending;
183
184 binmode INFILE;
185 my $buf;
186 read( INFILE, $buf, 1024 );
187 close INFILE;
188 if ( $buf && $buf =~ /([\012\015]+)/ ) {
189 my $test = $1;
190
191 # dos
192 if ( $test =~ /^(\015\012)+$/ ) { $ending = "\015\012" }
193
194 # mac
195 elsif ( $test =~ /^\015+$/ ) { $ending = "\015" }
196
197 # unix
198 elsif ( $test =~ /^\012+$/ ) { $ending = "\012" }
199
200 # unknown
201 else { }
202 }
203
204 # no ending seen
205 else { }
206
207 return $ending;
208}
209
210sub catfile {
211
212 # concatenate a path and file basename
213 # returns undef in case of error
214
21525.10ms122┬Ás
# spent 22┬Ás within Perl::Tidy::BEGIN@215 which was called: # once (22┬Ás+0s) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 215
BEGIN { eval "require File::Spec"; $missing_file_spec = $@; }
# spent 22┬Ás making 1 call to Perl::Tidy::BEGIN@215
# spent 2┬Ás executing statements in string eval
216
217 # use File::Spec if we can
218 unless ($missing_file_spec) {
219 return File::Spec->catfile(@_);
220 }
221
222 # Perl 5.004 systems may not have File::Spec so we'll make
223 # a simple try. We assume File::Basename is available.
224 # return undef if not successful.
225 my $name = pop @_;
226 my $path = join '/', @_;
227 my $test_file = $path . $name;
228 my ( $test_name, $test_path ) = fileparse($test_file);
229 return $test_file if ( $test_name eq $name );
230 return undef if ( $^O eq 'VMS' );
231
232 # this should work at least for Windows and Unix:
233 $test_file = $path . '/' . $name;
234 ( $test_name, $test_path ) = fileparse($test_file);
235 return $test_file if ( $test_name eq $name );
236 return undef;
237}
238
239# Here is a map of the flow of data from the input source to the output
240# line sink:
241#
242# LineSource-->Tokenizer-->Formatter-->VerticalAligner-->FileWriter-->
243# input groups output
244# lines tokens lines of lines lines
245# lines
246#
247# The names correspond to the package names responsible for the unit processes.
248#
249# The overall process is controlled by the "main" package.
250#
251# LineSource is the stream of input lines
252#
253# Tokenizer analyzes a line and breaks it into tokens, peeking ahead
254# if necessary. A token is any section of the input line which should be
255# manipulated as a single entity during formatting. For example, a single
256# ',' character is a token, and so is an entire side comment. It handles
257# the complexities of Perl syntax, such as distinguishing between '<<' as
258# a shift operator and as a here-document, or distinguishing between '/'
259# as a divide symbol and as a pattern delimiter.
260#
261# Formatter inserts and deletes whitespace between tokens, and breaks
262# sequences of tokens at appropriate points as output lines. It bases its
263# decisions on the default rules as modified by any command-line options.
264#
265# VerticalAligner collects groups of lines together and tries to line up
266# certain tokens, such as '=>', '#', and '=' by adding whitespace.
267#
268# FileWriter simply writes lines to the output stream.
269#
270# The Logger package, not shown, records significant events and warning
271# messages. It writes a .LOG file, which may be saved with a
272# '-log' or a '-g' flag.
273
274sub perltidy {
275
276 my %defaults = (
277 argv => undef,
278 destination => undef,
279 formatter => undef,
280 logfile => undef,
281 errorfile => undef,
282 perltidyrc => undef,
283 source => undef,
284 stderr => undef,
285 dump_options => undef,
286 dump_options_type => undef,
287 dump_getopt_flags => undef,
288 dump_options_category => undef,
289 dump_options_range => undef,
290 dump_abbreviations => undef,
291 prefilter => undef,
292 postfilter => undef,
293 );
294
295 # don't overwrite callers ARGV
296 local @ARGV = @ARGV;
297 local *STDERR = *STDERR;
298
299 my %input_hash = @_;
300
301 if ( my @bad_keys = grep { !exists $defaults{$_} } keys %input_hash ) {
302 local $" = ')(';
303 my @good_keys = sort keys %defaults;
304 @bad_keys = sort @bad_keys;
305 confess <<EOM;
306------------------------------------------------------------------------
307Unknown perltidy parameter : (@bad_keys)
308perltidy only understands : (@good_keys)
309------------------------------------------------------------------------
310
311EOM
312 }
313
314 my $get_hash_ref = sub {
315 my ($key) = @_;
316 my $hash_ref = $input_hash{$key};
317 if ( defined($hash_ref) ) {
318 unless ( ref($hash_ref) eq 'HASH' ) {
319 my $what = ref($hash_ref);
320 my $but_is =
321 $what ? "but is ref to $what" : "but is not a reference";
322 croak <<EOM;
323------------------------------------------------------------------------
324error in call to perltidy:
325-$key must be reference to HASH $but_is
326------------------------------------------------------------------------
327EOM
328 }
329 }
330 return $hash_ref;
331 };
332
333 %input_hash = ( %defaults, %input_hash );
334 my $argv = $input_hash{'argv'};
335 my $destination_stream = $input_hash{'destination'};
336 my $errorfile_stream = $input_hash{'errorfile'};
337 my $logfile_stream = $input_hash{'logfile'};
338 my $perltidyrc_stream = $input_hash{'perltidyrc'};
339 my $source_stream = $input_hash{'source'};
340 my $stderr_stream = $input_hash{'stderr'};
341 my $user_formatter = $input_hash{'formatter'};
342 my $prefilter = $input_hash{'prefilter'};
343 my $postfilter = $input_hash{'postfilter'};
344
345 if ($stderr_stream) {
346 ( $fh_stderr, my $stderr_file ) =
347 Perl::Tidy::streamhandle( $stderr_stream, 'w' );
348 if ( !$fh_stderr ) {
349 croak <<EOM;
350------------------------------------------------------------------------
351Unable to redirect STDERR to $stderr_stream
352Please check value of -stderr in call to perltidy
353------------------------------------------------------------------------
354EOM
355 }
356 }
357 else {
358 $fh_stderr = *STDERR;
359 }
360
361 sub Warn ($) { $fh_stderr->print( $_[0] ); }
362
363 sub Exit ($) {
364 if ( $_[0] ) { goto ERROR_EXIT }
365 else { goto NORMAL_EXIT }
366 }
367
368 sub Die ($) { Warn $_[0]; Exit(1); }
369
370 # extract various dump parameters
371 my $dump_options_type = $input_hash{'dump_options_type'};
372 my $dump_options = $get_hash_ref->('dump_options');
373 my $dump_getopt_flags = $get_hash_ref->('dump_getopt_flags');
374 my $dump_options_category = $get_hash_ref->('dump_options_category');
375 my $dump_abbreviations = $get_hash_ref->('dump_abbreviations');
376 my $dump_options_range = $get_hash_ref->('dump_options_range');
377
378 # validate dump_options_type
379 if ( defined($dump_options) ) {
380 unless ( defined($dump_options_type) ) {
381 $dump_options_type = 'perltidyrc';
382 }
383 unless ( $dump_options_type =~ /^(perltidyrc|full)$/ ) {
384 croak <<EOM;
385------------------------------------------------------------------------
386Please check value of -dump_options_type in call to perltidy;
387saw: '$dump_options_type'
388expecting: 'perltidyrc' or 'full'
389------------------------------------------------------------------------
390EOM
391
392 }
393 }
394 else {
395 $dump_options_type = "";
396 }
397
398 if ($user_formatter) {
399
400 # if the user defines a formatter, there is no output stream,
401 # but we need a null stream to keep coding simple
402 $destination_stream = Perl::Tidy::DevNull->new();
403 }
404
405 # see if ARGV is overridden
406 if ( defined($argv) ) {
407
408 my $rargv = ref $argv;
409 if ( $rargv eq 'SCALAR' ) { $argv = $$argv; $rargv = undef }
410
411 # ref to ARRAY
412 if ($rargv) {
413 if ( $rargv eq 'ARRAY' ) {
414 @ARGV = @$argv;
415 }
416 else {
417 croak <<EOM;
418------------------------------------------------------------------------
419Please check value of -argv in call to perltidy;
420it must be a string or ref to ARRAY but is: $rargv
421------------------------------------------------------------------------
422EOM
423 }
424 }
425
426 # string
427 else {
428 my ( $rargv, $msg ) = parse_args($argv);
429 if ($msg) {
430 Die <<EOM;
431Error parsing this string passed to to perltidy with 'argv':
432$msg
433EOM
434 }
435 @ARGV = @{$rargv};
436 }
437 }
438
439 my $rpending_complaint;
440 $$rpending_complaint = "";
441 my $rpending_logfile_message;
442 $$rpending_logfile_message = "";
443
444 my ( $is_Windows, $Windows_type ) = look_for_Windows($rpending_complaint);
445
446 # VMS file names are restricted to a 40.40 format, so we append _tdy
447 # instead of .tdy, etc. (but see also sub check_vms_filename)
448 my $dot;
449 my $dot_pattern;
450 if ( $^O eq 'VMS' ) {
451 $dot = '_';
452 $dot_pattern = '_';
453 }
454 else {
455 $dot = '.';
456 $dot_pattern = '\.'; # must escape for use in regex
457 }
458
459 #---------------------------------------------------------------
460 # get command line options
461 #---------------------------------------------------------------
462 my (
463 $rOpts, $config_file, $rraw_options,
464 $saw_extrude, $saw_pbp, $roption_string,
465 $rexpansion, $roption_category, $roption_range
466 )
467 = process_command_line(
468 $perltidyrc_stream, $is_Windows, $Windows_type,
469 $rpending_complaint, $dump_options_type,
470 );
471
472 #---------------------------------------------------------------
473 # Handle requests to dump information
474 #---------------------------------------------------------------
475
476 # return or exit immediately after all dumps
477 my $quit_now = 0;
478
479 # Getopt parameters and their flags
480 if ( defined($dump_getopt_flags) ) {
481 $quit_now = 1;
482 foreach my $op ( @{$roption_string} ) {
483 my $opt = $op;
484 my $flag = "";
485
486 # Examples:
487 # some-option=s
488 # some-option=i
489 # some-option:i
490 # some-option!
491 if ( $opt =~ /(.*)(!|=.*|:.*)$/ ) {
492 $opt = $1;
493 $flag = $2;
494 }
495 $dump_getopt_flags->{$opt} = $flag;
496 }
497 }
498
499 if ( defined($dump_options_category) ) {
500 $quit_now = 1;
501 %{$dump_options_category} = %{$roption_category};
502 }
503
504 if ( defined($dump_options_range) ) {
505 $quit_now = 1;
506 %{$dump_options_range} = %{$roption_range};
507 }
508
509 if ( defined($dump_abbreviations) ) {
510 $quit_now = 1;
511 %{$dump_abbreviations} = %{$rexpansion};
512 }
513
514 if ( defined($dump_options) ) {
515 $quit_now = 1;
516 %{$dump_options} = %{$rOpts};
517 }
518
519 Exit 0 if ($quit_now);
520
521 # make printable string of options for this run as possible diagnostic
522 my $readable_options = readable_options( $rOpts, $roption_string );
523
524 # dump from command line
525 if ( $rOpts->{'dump-options'} ) {
526 print STDOUT $readable_options;
527 Exit 0;
528 }
529
530 #---------------------------------------------------------------
531 # check parameters and their interactions
532 #---------------------------------------------------------------
533 my $tabsize =
534 check_options( $rOpts, $is_Windows, $Windows_type, $rpending_complaint );
535
536 if ($user_formatter) {
537 $rOpts->{'format'} = 'user';
538 }
539
540 # there must be one entry here for every possible format
541 my %default_file_extension = (
542 tidy => 'tdy',
543 html => 'html',
544 user => '',
545 );
546
547 # be sure we have a valid output format
548 unless ( exists $default_file_extension{ $rOpts->{'format'} } ) {
549 my $formats = join ' ',
550 sort map { "'" . $_ . "'" } keys %default_file_extension;
551 my $fmt = $rOpts->{'format'};
552 Die "-format='$fmt' but must be one of: $formats\n";
553 }
554
555 my $output_extension = make_extension( $rOpts->{'output-file-extension'},
556 $default_file_extension{ $rOpts->{'format'} }, $dot );
557
558 # If the backup extension contains a / character then the backup should
559 # be deleted when the -b option is used. On older versions of
560 # perltidy this will generate an error message due to an illegal
561 # file name.
562 #
563 # A backup file will still be generated but will be deleted
564 # at the end. If -bext='/' then this extension will be
565 # the default 'bak'. Otherwise it will be whatever characters
566 # remains after all '/' characters are removed. For example:
567 # -bext extension slashes
568 # '/' bak 1
569 # '/delete' delete 1
570 # 'delete/' delete 1
571 # '/dev/null' devnull 2 (Currently not allowed)
572 my $bext = $rOpts->{'backup-file-extension'};
573 my $delete_backup = ( $rOpts->{'backup-file-extension'} =~ s/\///g );
574
575 # At present only one forward slash is allowed. In the future multiple
576 # slashes may be allowed to allow for other options
577 if ( $delete_backup > 1 ) {
578 Die "-bext=$bext contains more than one '/'\n";
579 }
580
581 my $backup_extension =
582 make_extension( $rOpts->{'backup-file-extension'}, 'bak', $dot );
583
584 my $html_toc_extension =
585 make_extension( $rOpts->{'html-toc-extension'}, 'toc', $dot );
586
587 my $html_src_extension =
588 make_extension( $rOpts->{'html-src-extension'}, 'src', $dot );
589
590 # check for -b option;
591 # silently ignore unless beautify mode
592 my $in_place_modify = $rOpts->{'backup-and-modify-in-place'}
593 && $rOpts->{'format'} eq 'tidy';
594
595 # Turn off -b with warnings in case of conflicts with other options.
596 # NOTE: Do this silently, without warnings, if there is a source or
597 # destination stream, or standard output is used. This is because the -b
598 # flag may have been in a .perltidyrc file and warnings break
599 # Test::NoWarnings. See email discussion with Merijn Brand 26 Feb 2014.
600 if ($in_place_modify) {
601 if ( $rOpts->{'standard-output'} ) {
602## my $msg = "Ignoring -b; you may not use -b and -st together";
603## $msg .= " (-pbp contains -st; see manual)" if ($saw_pbp);
604## Warn "$msg\n";
605 $in_place_modify = 0;
606 }
607 if ($destination_stream) {
608 ##Warn "Ignoring -b; you may not specify a destination stream and -b together\n";
609 $in_place_modify = 0;
610 }
611 if ( ref($source_stream) ) {
612 ##Warn "Ignoring -b; you may not specify a source array and -b together\n";
613 $in_place_modify = 0;
614 }
615 if ( $rOpts->{'outfile'} ) {
616 ##Warn "Ignoring -b; you may not use -b and -o together\n";
617 $in_place_modify = 0;
618 }
619 if ( defined( $rOpts->{'output-path'} ) ) {
620 ##Warn "Ignoring -b; you may not use -b and -opath together\n";
621 $in_place_modify = 0;
622 }
623 }
624
625 Perl::Tidy::Formatter::check_options($rOpts);
626 if ( $rOpts->{'format'} eq 'html' ) {
627 Perl::Tidy::HtmlWriter->check_options($rOpts);
628 }
629
630 # make the pattern of file extensions that we shouldn't touch
631 my $forbidden_file_extensions = "(($dot_pattern)(LOG|DEBUG|ERR|TEE)";
632 if ($output_extension) {
633 my $ext = quotemeta($output_extension);
634 $forbidden_file_extensions .= "|$ext";
635 }
636 if ( $in_place_modify && $backup_extension ) {
637 my $ext = quotemeta($backup_extension);
638 $forbidden_file_extensions .= "|$ext";
639 }
640 $forbidden_file_extensions .= ')$';
641
642 # Create a diagnostics object if requested;
643 # This is only useful for code development
644 my $diagnostics_object = undef;
645 if ( $rOpts->{'DIAGNOSTICS'} ) {
646 $diagnostics_object = Perl::Tidy::Diagnostics->new();
647 }
648
649 # no filenames should be given if input is from an array
650 if ($source_stream) {
651 if ( @ARGV > 0 ) {
652 Die
653"You may not specify any filenames when a source array is given\n";
654 }
655
656 # we'll stuff the source array into ARGV
657 unshift( @ARGV, $source_stream );
658
659 # No special treatment for source stream which is a filename.
660 # This will enable checks for binary files and other bad stuff.
661 $source_stream = undef unless ref($source_stream);
662 }
663
664 # use stdin by default if no source array and no args
665 else {
666 unshift( @ARGV, '-' ) unless @ARGV;
667 }
668
669 #---------------------------------------------------------------
670 # Ready to go...
671 # main loop to process all files in argument list
672 #---------------------------------------------------------------
673 my $number_of_files = @ARGV;
674 my $formatter = undef;
675 my $tokenizer = undef;
676 while ( my $input_file = shift @ARGV ) {
677 my $fileroot;
678 my $input_file_permissions;
679
680 #---------------------------------------------------------------
681 # prepare this input stream
682 #---------------------------------------------------------------
683 if ($source_stream) {
684 $fileroot = "perltidy";
685
686 # If the source is from an array or string, then .LOG output
687 # is only possible if a logfile stream is specified. This prevents
688 # unexpected perltidy.LOG files.
689 if ( !defined($logfile_stream) ) {
690 $logfile_stream = Perl::Tidy::DevNull->new();
691 }
692 }
693 elsif ( $input_file eq '-' ) { # '-' indicates input from STDIN
694 $fileroot = "perltidy"; # root name to use for .ERR, .LOG, etc
695 $in_place_modify = 0;
696 }
697 else {
698 $fileroot = $input_file;
699 unless ( -e $input_file ) {
700
701 # file doesn't exist - check for a file glob
702 if ( $input_file =~ /([\?\*\[\{])/ ) {
703
704 # Windows shell may not remove quotes, so do it
705 my $input_file = $input_file;
706 if ( $input_file =~ /^\'(.+)\'$/ ) { $input_file = $1 }
707 if ( $input_file =~ /^\"(.+)\"$/ ) { $input_file = $1 }
708 my $pattern = fileglob_to_re($input_file);
709 ##eval "/$pattern/";
710 if ( !$@ && opendir( DIR, './' ) ) {
711 my @files =
712 grep { /$pattern/ && !-d $_ } readdir(DIR);
713 closedir(DIR);
714 if (@files) {
715 unshift @ARGV, @files;
716 next;
717 }
718 }
719 }
720 Warn "skipping file: '$input_file': no matches found\n";
721 next;
722 }
723
724 unless ( -f $input_file ) {
725 Warn "skipping file: $input_file: not a regular file\n";
726 next;
727 }
728
729 # As a safety precaution, skip zero length files.
730 # If for example a source file got clobbered somehow,
731 # the old .tdy or .bak files might still exist so we
732 # shouldn't overwrite them with zero length files.
733 unless ( -s $input_file ) {
734 Warn "skipping file: $input_file: Zero size\n";
735 next;
736 }
737
738 unless ( ( -T $input_file ) || $rOpts->{'force-read-binary'} ) {
739 Warn
740 "skipping file: $input_file: Non-text (override with -f)\n";
741 next;
742 }
743
744 # we should have a valid filename now
745 $fileroot = $input_file;
746 $input_file_permissions = ( stat $input_file )[2] & 07777;
747
748 if ( $^O eq 'VMS' ) {
749 ( $fileroot, $dot ) = check_vms_filename($fileroot);
750 }
751
752 # add option to change path here
753 if ( defined( $rOpts->{'output-path'} ) ) {
754
755 my ( $base, $old_path ) = fileparse($fileroot);
756 my $new_path = $rOpts->{'output-path'};
757 unless ( -d $new_path ) {
758 unless ( mkdir $new_path, 0777 ) {
759 Die "unable to create directory $new_path: $!\n";
760 }
761 }
762 my $path = $new_path;
763 $fileroot = catfile( $path, $base );
764 unless ($fileroot) {
765 Die <<EOM;
766------------------------------------------------------------------------
767Problem combining $new_path and $base to make a filename; check -opath
768------------------------------------------------------------------------
769EOM
770 }
771 }
772 }
773
774 # Skip files with same extension as the output files because
775 # this can lead to a messy situation with files like
776 # script.tdy.tdy.tdy ... or worse problems ... when you
777 # rerun perltidy over and over with wildcard input.
778 if (
779 !$source_stream
780 && ( $input_file =~ /$forbidden_file_extensions/o
781 || $input_file eq 'DIAGNOSTICS' )
782 )
783 {
784 Warn "skipping file: $input_file: wrong extension\n";
785 next;
786 }
787
788 # the 'source_object' supplies a method to read the input file
789 my $source_object =
790 Perl::Tidy::LineSource->new( $input_file, $rOpts,
791 $rpending_logfile_message );
792 next unless ($source_object);
793
794 # Prefilters and postfilters: The prefilter is a code reference
795 # that will be applied to the source before tidying, and the
796 # postfilter is a code reference to the result before outputting.
797 if ($prefilter) {
798 my $buf = '';
799 while ( my $line = $source_object->get_line() ) {
800 $buf .= $line;
801 }
802 $buf = $prefilter->($buf);
803
804 $source_object = Perl::Tidy::LineSource->new( \$buf, $rOpts,
805 $rpending_logfile_message );
806 }
807
808 # register this file name with the Diagnostics package
809 $diagnostics_object->set_input_file($input_file)
810 if $diagnostics_object;
811
812 #---------------------------------------------------------------
813 # prepare the output stream
814 #---------------------------------------------------------------
815 my $output_file = undef;
816 my $actual_output_extension;
817
818 if ( $rOpts->{'outfile'} ) {
819
820 if ( $number_of_files <= 1 ) {
821
822 if ( $rOpts->{'standard-output'} ) {
823 my $msg = "You may not use -o and -st together";
824 $msg .= " (-pbp contains -st; see manual)" if ($saw_pbp);
825 Die "$msg\n";
826 }
827 elsif ($destination_stream) {
828 Die
829"You may not specify a destination array and -o together\n";
830 }
831 elsif ( defined( $rOpts->{'output-path'} ) ) {
832 Die "You may not specify -o and -opath together\n";
833 }
834 elsif ( defined( $rOpts->{'output-file-extension'} ) ) {
835 Die "You may not specify -o and -oext together\n";
836 }
837 $output_file = $rOpts->{outfile};
838
839 # make sure user gives a file name after -o
840 if ( $output_file =~ /^-/ ) {
841 Die "You must specify a valid filename after -o\n";
842 }
843
844 # do not overwrite input file with -o
845 if ( defined($input_file_permissions)
846 && ( $output_file eq $input_file ) )
847 {
848 Die "Use 'perltidy -b $input_file' to modify in-place\n";
849 }
850 }
851 else {
852 Die "You may not use -o with more than one input file\n";
853 }
854 }
855 elsif ( $rOpts->{'standard-output'} ) {
856 if ($destination_stream) {
857 my $msg =
858 "You may not specify a destination array and -st together\n";
859 $msg .= " (-pbp contains -st; see manual)" if ($saw_pbp);
860 Die "$msg\n";
861 }
862 $output_file = '-';
863
864 if ( $number_of_files <= 1 ) {
865 }
866 else {
867 Die "You may not use -st with more than one input file\n";
868 }
869 }
870 elsif ($destination_stream) {
871 $output_file = $destination_stream;
872 }
873 elsif ($source_stream) { # source but no destination goes to stdout
874 $output_file = '-';
875 }
876 elsif ( $input_file eq '-' ) {
877 $output_file = '-';
878 }
879 else {
880 if ($in_place_modify) {
881 $output_file = IO::File->new_tmpfile()
882 or Die "cannot open temp file for -b option: $!\n";
883 }
884 else {
885 $actual_output_extension = $output_extension;
886 $output_file = $fileroot . $output_extension;
887 }
888 }
889
890 # the 'sink_object' knows how to write the output file
891 my $tee_file = $fileroot . $dot . "TEE";
892
893 my $line_separator = $rOpts->{'output-line-ending'};
894 if ( $rOpts->{'preserve-line-endings'} ) {
895 $line_separator = find_input_line_ending($input_file);
896 }
897
898 # Eventually all I/O may be done with binmode, but for now it is
899 # only done when a user requests a particular line separator
900 # through the -ple or -ole flags
901 my $binmode = 0;
902 if ( defined($line_separator) ) { $binmode = 1 }
903 else { $line_separator = "\n" }
904
905 my ( $sink_object, $postfilter_buffer );
906 if ($postfilter) {
907 $sink_object =
908 Perl::Tidy::LineSink->new( \$postfilter_buffer, $tee_file,
909 $line_separator, $rOpts, $rpending_logfile_message, $binmode );
910 }
911 else {
912 $sink_object =
913 Perl::Tidy::LineSink->new( $output_file, $tee_file,
914 $line_separator, $rOpts, $rpending_logfile_message, $binmode );
915 }
916
917 #---------------------------------------------------------------
918 # initialize the error logger for this file
919 #---------------------------------------------------------------
920 my $warning_file = $fileroot . $dot . "ERR";
921 if ($errorfile_stream) { $warning_file = $errorfile_stream }
922 my $log_file = $fileroot . $dot . "LOG";
923 if ($logfile_stream) { $log_file = $logfile_stream }
924
925 my $logger_object =
926 Perl::Tidy::Logger->new( $rOpts, $log_file, $warning_file,
927 $fh_stderr, $saw_extrude );
928 write_logfile_header(
929 $rOpts, $logger_object, $config_file,
930 $rraw_options, $Windows_type, $readable_options,
931 );
932 if ($$rpending_logfile_message) {
933 $logger_object->write_logfile_entry($$rpending_logfile_message);
934 }
935 if ($$rpending_complaint) {
936 $logger_object->complain($$rpending_complaint);
937 }
938
939 #---------------------------------------------------------------
940 # initialize the debug object, if any
941 #---------------------------------------------------------------
942 my $debugger_object = undef;
943 if ( $rOpts->{DEBUG} ) {
944 $debugger_object =
945 Perl::Tidy::Debugger->new( $fileroot . $dot . "DEBUG" );
946 }
947
948 #---------------------------------------------------------------
949 # loop over iterations for one source stream
950 #---------------------------------------------------------------
951
952 # We will do a convergence test if 3 or more iterations are allowed.
953 # It would be pointless for fewer because we have to make at least
954 # two passes before we can see if we are converged, and the test
955 # would just slow things down.
956 my $max_iterations = $rOpts->{'iterations'};
957 my $convergence_log_message;
958 my %saw_md5;
959 my $do_convergence_test = $max_iterations > 2;
960 if ($do_convergence_test) {
961 eval "use Digest::MD5 qw(md5_hex)";
962 $do_convergence_test = !$@;
963
964 # Trying to avoid problems with ancient versions of perl because
965 # I don't know in which version number utf8::encode was introduced.
966 eval { my $string = "perltidy"; utf8::encode($string) };
967 $do_convergence_test = $do_convergence_test && !$@;
968 }
969
970 # save objects to allow redirecting output during iterations
971 my $sink_object_final = $sink_object;
972 my $debugger_object_final = $debugger_object;
973 my $logger_object_final = $logger_object;
974
975 for ( my $iter = 1 ; $iter <= $max_iterations ; $iter++ ) {
976
977 # send output stream to temp buffers until last iteration
978 my $sink_buffer;
979 if ( $iter < $max_iterations ) {
980 $sink_object =
981 Perl::Tidy::LineSink->new( \$sink_buffer, $tee_file,
982 $line_separator, $rOpts, $rpending_logfile_message,
983 $binmode );
984 }
985 else {
986 $sink_object = $sink_object_final;
987 }
988
989 # Save logger, debugger output only on pass 1 because:
990 # (1) line number references must be to the starting
991 # source, not an intermediate result, and
992 # (2) we need to know if there are errors so we can stop the
993 # iterations early if necessary.
994 if ( $iter > 1 ) {
995 $debugger_object = undef;
996 $logger_object = undef;
997 }
998
999 #------------------------------------------------------------
1000 # create a formatter for this file : html writer or
1001 # pretty printer
1002 #------------------------------------------------------------
1003
1004 # we have to delete any old formatter because, for safety,
1005 # the formatter will check to see that there is only one.
1006 $formatter = undef;
1007
1008 if ($user_formatter) {
1009 $formatter = $user_formatter;
1010 }
1011 elsif ( $rOpts->{'format'} eq 'html' ) {
1012 $formatter =
1013 Perl::Tidy::HtmlWriter->new( $fileroot, $output_file,
1014 $actual_output_extension, $html_toc_extension,
1015 $html_src_extension );
1016 }
1017 elsif ( $rOpts->{'format'} eq 'tidy' ) {
1018 $formatter = Perl::Tidy::Formatter->new(
1019 logger_object => $logger_object,
1020 diagnostics_object => $diagnostics_object,
1021 sink_object => $sink_object,
1022 );
1023 }
1024 else {
1025 Die "I don't know how to do -format=$rOpts->{'format'}\n";
1026 }
1027
1028 unless ($formatter) {
1029 Die "Unable to continue with $rOpts->{'format'} formatting\n";
1030 }
1031
1032 #---------------------------------------------------------------
1033 # create the tokenizer for this file
1034 #---------------------------------------------------------------
1035 $tokenizer = undef; # must destroy old tokenizer
1036 $tokenizer = Perl::Tidy::Tokenizer->new(
1037 source_object => $source_object,
1038 logger_object => $logger_object,
1039 debugger_object => $debugger_object,
1040 diagnostics_object => $diagnostics_object,
1041 tabsize => $tabsize,
1042
1043 starting_level => $rOpts->{'starting-indentation-level'},
1044 indent_columns => $rOpts->{'indent-columns'},
1045 look_for_hash_bang => $rOpts->{'look-for-hash-bang'},
1046 look_for_autoloader => $rOpts->{'look-for-autoloader'},
1047 look_for_selfloader => $rOpts->{'look-for-selfloader'},
1048 trim_qw => $rOpts->{'trim-qw'},
1049
1050 continuation_indentation =>
1051 $rOpts->{'continuation-indentation'},
1052 outdent_labels => $rOpts->{'outdent-labels'},
1053 );
1054
1055 #---------------------------------------------------------------
1056 # now we can do it
1057 #---------------------------------------------------------------
1058 process_this_file( $tokenizer, $formatter );
1059
1060 #---------------------------------------------------------------
1061 # close the input source and report errors
1062 #---------------------------------------------------------------
1063 $source_object->close_input_file();
1064
1065 # line source for next iteration (if any) comes from the current
1066 # temporary output buffer
1067 if ( $iter < $max_iterations ) {
1068
1069 $sink_object->close_output_file();
1070 $source_object =
1071 Perl::Tidy::LineSource->new( \$sink_buffer, $rOpts,
1072 $rpending_logfile_message );
1073
1074 # stop iterations if errors or converged
1075 my $stop_now = $logger_object->{_warning_count};
1076 if ($stop_now) {
1077 $convergence_log_message = <<EOM;
1078Stopping iterations because of errors.
1079EOM
1080 }
1081 elsif ($do_convergence_test) {
1082
1083 # Patch for [rt.cpan.org #88020]
1084 # Use utf8::encode since md5_hex() only operates on bytes.
1085 my $digest = md5_hex( utf8::encode($sink_buffer) );
1086 if ( !$saw_md5{$digest} ) {
1087 $saw_md5{$digest} = $iter;
1088 }
1089 else {
1090
1091 # Deja vu, stop iterating
1092 $stop_now = 1;
1093 my $iterm = $iter - 1;
1094 if ( $saw_md5{$digest} != $iterm ) {
1095
1096 # Blinking (oscillating) between two stable
1097 # end states. This has happened in the past
1098 # but at present there are no known instances.
1099 $convergence_log_message = <<EOM;
1100Blinking. Output for iteration $iter same as for $saw_md5{$digest}.
1101EOM
1102 $diagnostics_object->write_diagnostics(
1103 $convergence_log_message)
1104 if $diagnostics_object;
1105 }
1106 else {
1107 $convergence_log_message = <<EOM;
1108Converged. Output for iteration $iter same as for iter $iterm.
1109EOM
1110 $diagnostics_object->write_diagnostics(
1111 $convergence_log_message)
1112 if $diagnostics_object && $iterm > 2;
1113 }
1114 }
1115 } ## end if ($do_convergence_test)
1116
1117 if ($stop_now) {
1118
1119 # we are stopping the iterations early;
1120 # copy the output stream to its final destination
1121 $sink_object = $sink_object_final;
1122 while ( my $line = $source_object->get_line() ) {
1123 $sink_object->write_line($line);
1124 }
1125 $source_object->close_input_file();
1126 last;
1127 }
1128 } ## end if ( $iter < $max_iterations)
1129 } # end loop over iterations for one source file
1130
1131 # restore objects which have been temporarily undefined
1132 # for second and higher iterations
1133 $debugger_object = $debugger_object_final;
1134 $logger_object = $logger_object_final;
1135
1136 $logger_object->write_logfile_entry($convergence_log_message)
1137 if $convergence_log_message;
1138
1139 #---------------------------------------------------------------
1140 # Perform any postfilter operation
1141 #---------------------------------------------------------------
1142 if ($postfilter) {
1143 $sink_object->close_output_file();
1144 $sink_object =
1145 Perl::Tidy::LineSink->new( $output_file, $tee_file,
1146 $line_separator, $rOpts, $rpending_logfile_message, $binmode );
1147 my $buf = $postfilter->($postfilter_buffer);
1148 $source_object =
1149 Perl::Tidy::LineSource->new( \$buf, $rOpts,
1150 $rpending_logfile_message );
1151 while ( my $line = $source_object->get_line() ) {
1152 $sink_object->write_line($line);
1153 }
1154 $source_object->close_input_file();
1155 }
1156
1157 # Save names of the input and output files for syntax check
1158 my $ifname = $input_file;
1159 my $ofname = $output_file;
1160
1161 #---------------------------------------------------------------
1162 # handle the -b option (backup and modify in-place)
1163 #---------------------------------------------------------------
1164 if ($in_place_modify) {
1165 unless ( -f $input_file ) {
1166
1167 # oh, oh, no real file to backup ..
1168 # shouldn't happen because of numerous preliminary checks
1169 Die
1170"problem with -b backing up input file '$input_file': not a file\n";
1171 }
1172 my $backup_name = $input_file . $backup_extension;
1173 if ( -f $backup_name ) {
1174 unlink($backup_name)
1175 or Die
1176"unable to remove previous '$backup_name' for -b option; check permissions: $!\n";
1177 }
1178
1179 # backup the input file
1180 # we use copy for symlinks, move for regular files
1181 if ( -l $input_file ) {
1182 File::Copy::copy( $input_file, $backup_name )
1183 or Die "File::Copy failed trying to backup source: $!";
1184 }
1185 else {
1186 rename( $input_file, $backup_name )
1187 or Die
1188"problem renaming $input_file to $backup_name for -b option: $!\n";
1189 }
1190 $ifname = $backup_name;
1191
1192 # copy the output to the original input file
1193 # NOTE: it would be nice to just close $output_file and use
1194 # File::Copy::copy here, but in this case $output_file is the
1195 # handle of an open nameless temporary file so we would lose
1196 # everything if we closed it.
1197 seek( $output_file, 0, 0 )
1198 or Die "unable to rewind a temporary file for -b option: $!\n";
1199 my $fout = IO::File->new("> $input_file")
1200 or Die
1201"problem re-opening $input_file for write for -b option; check file and directory permissions: $!\n";
1202 binmode $fout;
1203 my $line;
1204 while ( $line = $output_file->getline() ) {
1205 $fout->print($line);
1206 }
1207 $fout->close();
1208 $output_file = $input_file;
1209 $ofname = $input_file;
1210 }
1211
1212 #---------------------------------------------------------------
1213 # clean up and report errors
1214 #---------------------------------------------------------------
1215 $sink_object->close_output_file() if $sink_object;
1216 $debugger_object->close_debug_file() if $debugger_object;
1217
1218 # set output file permissions
1219 if ( $output_file && -f $output_file && !-l $output_file ) {
1220 if ($input_file_permissions) {
1221
1222 # give output script same permissions as input script, but
1223 # make it user-writable or else we can't run perltidy again.
1224 # Thus we retain whatever executable flags were set.
1225 if ( $rOpts->{'format'} eq 'tidy' ) {
1226 chmod( $input_file_permissions | 0600, $output_file );
1227 }
1228
1229 # else use default permissions for html and any other format
1230 }
1231 }
1232
1233 #---------------------------------------------------------------
1234 # Do syntax check if requested and possible
1235 #---------------------------------------------------------------
1236 my $infile_syntax_ok = 0; # -1 no 0=don't know 1 yes
1237 if ( $logger_object
1238 && $rOpts->{'check-syntax'}
1239 && $ifname
1240 && $ofname )
1241 {
1242 $infile_syntax_ok =
1243 check_syntax( $ifname, $ofname, $logger_object, $rOpts );
1244 }
1245
1246 #---------------------------------------------------------------
1247 # remove the original file for in-place modify as follows:
1248 # $delete_backup=0 never
1249 # $delete_backup=1 only if no errors
1250 # $delete_backup>1 always : NOT ALLOWED, too risky, see above
1251 #---------------------------------------------------------------
1252 if ( $in_place_modify
1253 && $delete_backup
1254 && -f $ifname
1255 && ( $delete_backup > 1 || !$logger_object->{_warning_count} ) )
1256 {
1257
1258 # As an added safety precaution, do not delete the source file
1259 # if its size has dropped from positive to zero, since this
1260 # could indicate a disaster of some kind, including a hardware
1261 # failure. Actually, this could happen if you had a file of
1262 # all comments (or pod) and deleted everything with -dac (-dap)
1263 # for some reason.
1264 if ( !-s $output_file && -s $ifname && $delete_backup == 1 ) {
1265 Warn(
1266"output file '$output_file' missing or zero length; original '$ifname' not deleted\n"
1267 );
1268 }
1269 else {
1270 unlink($ifname)
1271 or Die
1272"unable to remove previous '$ifname' for -b option; check permissions: $!\n";
1273 }
1274 }
1275
1276 $logger_object->finish( $infile_syntax_ok, $formatter )
1277 if $logger_object;
1278 } # end of main loop to process all files
1279
1280 NORMAL_EXIT:
1281 return 0;
1282
1283 ERROR_EXIT:
1284 return 1;
1285} # end of main program perltidy
1286
1287sub get_stream_as_named_file {
1288
1289 # Return the name of a file containing a stream of data, creating
1290 # a temporary file if necessary.
1291 # Given:
1292 # $stream - the name of a file or stream
1293 # Returns:
1294 # $fname = name of file if possible, or undef
1295 # $if_tmpfile = true if temp file, undef if not temp file
1296 #
1297 # This routine is needed for passing actual files to Perl for
1298 # a syntax check.
1299 my ($stream) = @_;
1300 my $is_tmpfile;
1301 my $fname;
1302 if ($stream) {
1303 if ( ref($stream) ) {
1304 my ( $fh_stream, $fh_name ) =
1305 Perl::Tidy::streamhandle( $stream, 'r' );
1306 if ($fh_stream) {
1307 my ( $fout, $tmpnam ) = tempfile();
1308 if ($fout) {
1309 $fname = $tmpnam;
1310 $is_tmpfile = 1;
1311 binmode $fout;
1312 while ( my $line = $fh_stream->getline() ) {
1313 $fout->print($line);
1314 }
1315 $fout->close();
1316 }
1317 $fh_stream->close();
1318 }
1319 }
1320 elsif ( $stream ne '-' && -f $stream ) {
1321 $fname = $stream;
1322 }
1323 }
1324 return ( $fname, $is_tmpfile );
1325}
1326
1327sub fileglob_to_re {
1328
1329 # modified (corrected) from version in find2perl
1330 my $x = shift;
1331 $x =~ s#([./^\$()])#\\$1#g; # escape special characters
1332 $x =~ s#\*#.*#g; # '*' -> '.*'
1333 $x =~ s#\?#.#g; # '?' -> '.'
1334 "^$x\\z"; # match whole word
1335}
1336
1337sub make_extension {
1338
1339 # Make a file extension, including any leading '.' if necessary
1340 # The '.' may actually be an '_' under VMS
1341 my ( $extension, $default, $dot ) = @_;
1342
1343 # Use the default if none specified
1344 $extension = $default unless ($extension);
1345
1346 # Only extensions with these leading characters get a '.'
1347 # This rule gives the user some freedom
1348 if ( $extension =~ /^[a-zA-Z0-9]/ ) {
1349 $extension = $dot . $extension;
1350 }
1351 return $extension;
1352}
1353
1354sub write_logfile_header {
1355 my (
1356 $rOpts, $logger_object, $config_file,
1357 $rraw_options, $Windows_type, $readable_options
1358 ) = @_;
1359 $logger_object->write_logfile_entry(
1360"perltidy version $VERSION log file on a $^O system, OLD_PERL_VERSION=$]\n"
1361 );
1362 if ($Windows_type) {
1363 $logger_object->write_logfile_entry("Windows type is $Windows_type\n");
1364 }
1365 my $options_string = join( ' ', @$rraw_options );
1366
1367 if ($config_file) {
1368 $logger_object->write_logfile_entry(
1369 "Found Configuration File >>> $config_file \n");
1370 }
1371 $logger_object->write_logfile_entry(
1372 "Configuration and command line parameters for this run:\n");
1373 $logger_object->write_logfile_entry("$options_string\n");
1374
1375 if ( $rOpts->{'DEBUG'} || $rOpts->{'show-options'} ) {
1376 $rOpts->{'logfile'} = 1; # force logfile to be saved
1377 $logger_object->write_logfile_entry(
1378 "Final parameter set for this run\n");
1379 $logger_object->write_logfile_entry(
1380 "------------------------------------\n");
1381
1382 $logger_object->write_logfile_entry($readable_options);
1383
1384 $logger_object->write_logfile_entry(
1385 "------------------------------------\n");
1386 }
1387 $logger_object->write_logfile_entry(
1388 "To find error messages search for 'WARNING' with your editor\n");
1389}
1390
1391sub generate_options {
1392
1393 ######################################################################
1394 # Generate and return references to:
1395 # @option_string - the list of options to be passed to Getopt::Long
1396 # @defaults - the list of default options
1397 # %expansion - a hash showing how all abbreviations are expanded
1398 # %category - a hash giving the general category of each option
1399 # %option_range - a hash giving the valid ranges of certain options
1400
1401 # Note: a few options are not documented in the man page and usage
1402 # message. This is because these are experimental or debug options and
1403 # may or may not be retained in future versions.
1404 #
1405 # Here are the undocumented flags as far as I know. Any of them
1406 # may disappear at any time. They are mainly for fine-tuning
1407 # and debugging.
1408 #
1409 # fll --> fuzzy-line-length # a trivial parameter which gets
1410 # turned off for the extrude option
1411 # which is mainly for debugging
1412 # scl --> short-concatenation-item-length # helps break at '.'
1413 # recombine # for debugging line breaks
1414 # valign # for debugging vertical alignment
1415 # I --> DIAGNOSTICS # for debugging
1416 ######################################################################
1417
1418 # here is a summary of the Getopt codes:
1419 # <none> does not take an argument
1420 # =s takes a mandatory string
1421 # :s takes an optional string (DO NOT USE - filenames will get eaten up)
1422 # =i takes a mandatory integer
1423 # :i takes an optional integer (NOT RECOMMENDED - can cause trouble)
1424 # ! does not take an argument and may be negated
1425 # i.e., -foo and -nofoo are allowed
1426 # a double dash signals the end of the options list
1427 #
1428 #---------------------------------------------------------------
1429 # Define the option string passed to GetOptions.
1430 #---------------------------------------------------------------
1431
1432 my @option_string = ();
1433 my %expansion = ();
1434 my %option_category = ();
1435 my %option_range = ();
1436 my $rexpansion = \%expansion;
1437
1438 # names of categories in manual
1439 # leading integers will allow sorting
1440 my @category_name = (
1441 '0. I/O control',
1442 '1. Basic formatting options',
1443 '2. Code indentation control',
1444 '3. Whitespace control',
1445 '4. Comment controls',
1446 '5. Linebreak controls',
1447 '6. Controlling list formatting',
1448 '7. Retaining or ignoring existing line breaks',
1449 '8. Blank line control',
1450 '9. Other controls',
1451 '10. HTML options',
1452 '11. pod2html options',
1453 '12. Controlling HTML properties',
1454 '13. Debugging',
1455 );
1456
1457 # These options are parsed directly by perltidy:
1458 # help h
1459 # version v
1460 # However, they are included in the option set so that they will
1461 # be seen in the options dump.
1462
1463 # These long option names have no abbreviations or are treated specially
1464 @option_string = qw(
1465 html!
1466 noprofile
1467 no-profile
1468 npro
1469 recombine!
1470 valign!
1471 notidy
1472 );
1473
1474 my $category = 13; # Debugging
1475 foreach (@option_string) {
1476 my $opt = $_; # must avoid changing the actual flag
1477 $opt =~ s/!$//;
1478 $option_category{$opt} = $category_name[$category];
1479 }
1480
1481 $category = 11; # HTML
1482 $option_category{html} = $category_name[$category];
1483
1484 # routine to install and check options
1485 my $add_option = sub {
1486 my ( $long_name, $short_name, $flag ) = @_;
1487 push @option_string, $long_name . $flag;
1488 $option_category{$long_name} = $category_name[$category];
1489 if ($short_name) {
1490 if ( $expansion{$short_name} ) {
1491 my $existing_name = $expansion{$short_name}[0];
1492 Die
1493"redefining abbreviation $short_name for $long_name; already used for $existing_name\n";
1494 }
1495 $expansion{$short_name} = [$long_name];
1496 if ( $flag eq '!' ) {
1497 my $nshort_name = 'n' . $short_name;
1498 my $nolong_name = 'no' . $long_name;
1499 if ( $expansion{$nshort_name} ) {
1500 my $existing_name = $expansion{$nshort_name}[0];
1501 Die
1502"attempting to redefine abbreviation $nshort_name for $nolong_name; already used for $existing_name\n";
1503 }
1504 $expansion{$nshort_name} = [$nolong_name];
1505 }
1506 }
1507 };
1508
1509 # Install long option names which have a simple abbreviation.
1510 # Options with code '!' get standard negation ('no' for long names,
1511 # 'n' for abbreviations). Categories follow the manual.
1512
1513 ###########################
1514 $category = 0; # I/O_Control
1515 ###########################
1516 $add_option->( 'backup-and-modify-in-place', 'b', '!' );
1517 $add_option->( 'backup-file-extension', 'bext', '=s' );
1518 $add_option->( 'force-read-binary', 'f', '!' );
1519 $add_option->( 'format', 'fmt', '=s' );
1520 $add_option->( 'iterations', 'it', '=i' );
1521 $add_option->( 'logfile', 'log', '!' );
1522 $add_option->( 'logfile-gap', 'g', ':i' );
1523 $add_option->( 'outfile', 'o', '=s' );
1524 $add_option->( 'output-file-extension', 'oext', '=s' );
1525 $add_option->( 'output-path', 'opath', '=s' );
1526 $add_option->( 'profile', 'pro', '=s' );
1527 $add_option->( 'quiet', 'q', '!' );
1528 $add_option->( 'standard-error-output', 'se', '!' );
1529 $add_option->( 'standard-output', 'st', '!' );
1530 $add_option->( 'warning-output', 'w', '!' );
1531
1532 # options which are both toggle switches and values moved here
1533 # to hide from tidyview (which does not show category 0 flags):
1534 # -ole moved here from category 1
1535 # -sil moved here from category 2
1536 $add_option->( 'output-line-ending', 'ole', '=s' );
1537 $add_option->( 'starting-indentation-level', 'sil', '=i' );
1538
1539 ########################################
1540 $category = 1; # Basic formatting options
1541 ########################################
1542 $add_option->( 'check-syntax', 'syn', '!' );
1543 $add_option->( 'entab-leading-whitespace', 'et', '=i' );
1544 $add_option->( 'indent-columns', 'i', '=i' );
1545 $add_option->( 'maximum-line-length', 'l', '=i' );
1546 $add_option->( 'variable-maximum-line-length', 'vmll', '!' );
1547 $add_option->( 'whitespace-cycle', 'wc', '=i' );
1548 $add_option->( 'perl-syntax-check-flags', 'pscf', '=s' );
1549 $add_option->( 'preserve-line-endings', 'ple', '!' );
1550 $add_option->( 'tabs', 't', '!' );
1551 $add_option->( 'default-tabsize', 'dt', '=i' );
1552
1553 ########################################
1554 $category = 2; # Code indentation control
1555 ########################################
1556 $add_option->( 'continuation-indentation', 'ci', '=i' );
1557 $add_option->( 'line-up-parentheses', 'lp', '!' );
1558 $add_option->( 'outdent-keyword-list', 'okwl', '=s' );
1559 $add_option->( 'outdent-keywords', 'okw', '!' );
1560 $add_option->( 'outdent-labels', 'ola', '!' );
1561 $add_option->( 'outdent-long-quotes', 'olq', '!' );
1562 $add_option->( 'indent-closing-brace', 'icb', '!' );
1563 $add_option->( 'closing-token-indentation', 'cti', '=i' );
1564 $add_option->( 'closing-paren-indentation', 'cpi', '=i' );
1565 $add_option->( 'closing-brace-indentation', 'cbi', '=i' );
1566 $add_option->( 'closing-square-bracket-indentation', 'csbi', '=i' );
1567 $add_option->( 'brace-left-and-indent', 'bli', '!' );
1568 $add_option->( 'brace-left-and-indent-list', 'blil', '=s' );
1569
1570 ########################################
1571 $category = 3; # Whitespace control
1572 ########################################
1573 $add_option->( 'add-semicolons', 'asc', '!' );
1574 $add_option->( 'add-whitespace', 'aws', '!' );
1575 $add_option->( 'block-brace-tightness', 'bbt', '=i' );
1576 $add_option->( 'brace-tightness', 'bt', '=i' );
1577 $add_option->( 'delete-old-whitespace', 'dws', '!' );
1578 $add_option->( 'delete-semicolons', 'dsm', '!' );
1579 $add_option->( 'nospace-after-keyword', 'nsak', '=s' );
1580 $add_option->( 'nowant-left-space', 'nwls', '=s' );
1581 $add_option->( 'nowant-right-space', 'nwrs', '=s' );
1582 $add_option->( 'paren-tightness', 'pt', '=i' );
1583 $add_option->( 'space-after-keyword', 'sak', '=s' );
1584 $add_option->( 'space-for-semicolon', 'sfs', '!' );
1585 $add_option->( 'space-function-paren', 'sfp', '!' );
1586 $add_option->( 'space-keyword-paren', 'skp', '!' );
1587 $add_option->( 'space-terminal-semicolon', 'sts', '!' );
1588 $add_option->( 'square-bracket-tightness', 'sbt', '=i' );
1589 $add_option->( 'square-bracket-vertical-tightness', 'sbvt', '=i' );
1590 $add_option->( 'square-bracket-vertical-tightness-closing', 'sbvtc', '=i' );
1591 $add_option->( 'tight-secret-operators', 'tso', '!' );
1592 $add_option->( 'trim-qw', 'tqw', '!' );
1593 $add_option->( 'trim-pod', 'trp', '!' );
1594 $add_option->( 'want-left-space', 'wls', '=s' );
1595 $add_option->( 'want-right-space', 'wrs', '=s' );
1596
1597 ########################################
1598 $category = 4; # Comment controls
1599 ########################################
1600 $add_option->( 'closing-side-comment-else-flag', 'csce', '=i' );
1601 $add_option->( 'closing-side-comment-interval', 'csci', '=i' );
1602 $add_option->( 'closing-side-comment-list', 'cscl', '=s' );
1603 $add_option->( 'closing-side-comment-maximum-text', 'csct', '=i' );
1604 $add_option->( 'closing-side-comment-prefix', 'cscp', '=s' );
1605 $add_option->( 'closing-side-comment-warnings', 'cscw', '!' );
1606 $add_option->( 'closing-side-comments', 'csc', '!' );
1607 $add_option->( 'closing-side-comments-balanced', 'cscb', '!' );
1608 $add_option->( 'format-skipping', 'fs', '!' );
1609 $add_option->( 'format-skipping-begin', 'fsb', '=s' );
1610 $add_option->( 'format-skipping-end', 'fse', '=s' );
1611 $add_option->( 'hanging-side-comments', 'hsc', '!' );
1612 $add_option->( 'indent-block-comments', 'ibc', '!' );
1613 $add_option->( 'indent-spaced-block-comments', 'isbc', '!' );
1614 $add_option->( 'fixed-position-side-comment', 'fpsc', '=i' );
1615 $add_option->( 'minimum-space-to-comment', 'msc', '=i' );
1616 $add_option->( 'outdent-long-comments', 'olc', '!' );
1617 $add_option->( 'outdent-static-block-comments', 'osbc', '!' );
1618 $add_option->( 'static-block-comment-prefix', 'sbcp', '=s' );
1619 $add_option->( 'static-block-comments', 'sbc', '!' );
1620 $add_option->( 'static-side-comment-prefix', 'sscp', '=s' );
1621 $add_option->( 'static-side-comments', 'ssc', '!' );
1622 $add_option->( 'ignore-side-comment-lengths', 'iscl', '!' );
1623
1624 ########################################
1625 $category = 5; # Linebreak controls
1626 ########################################
1627 $add_option->( 'add-newlines', 'anl', '!' );
1628 $add_option->( 'block-brace-vertical-tightness', 'bbvt', '=i' );
1629 $add_option->( 'block-brace-vertical-tightness-list', 'bbvtl', '=s' );
1630 $add_option->( 'brace-vertical-tightness', 'bvt', '=i' );
1631 $add_option->( 'brace-vertical-tightness-closing', 'bvtc', '=i' );
1632 $add_option->( 'cuddled-else', 'ce', '!' );
1633 $add_option->( 'delete-old-newlines', 'dnl', '!' );
1634 $add_option->( 'opening-brace-always-on-right', 'bar', '!' );
1635 $add_option->( 'opening-brace-on-new-line', 'bl', '!' );
1636 $add_option->( 'opening-hash-brace-right', 'ohbr', '!' );
1637 $add_option->( 'opening-paren-right', 'opr', '!' );
1638 $add_option->( 'opening-square-bracket-right', 'osbr', '!' );
1639 $add_option->( 'opening-anonymous-sub-brace-on-new-line', 'asbl', '!' );
1640 $add_option->( 'opening-sub-brace-on-new-line', 'sbl', '!' );
1641 $add_option->( 'paren-vertical-tightness', 'pvt', '=i' );
1642 $add_option->( 'paren-vertical-tightness-closing', 'pvtc', '=i' );
1643 $add_option->( 'stack-closing-block-brace', 'scbb', '!' );
1644 $add_option->( 'stack-closing-hash-brace', 'schb', '!' );
1645 $add_option->( 'stack-closing-paren', 'scp', '!' );
1646 $add_option->( 'stack-closing-square-bracket', 'scsb', '!' );
1647 $add_option->( 'stack-opening-block-brace', 'sobb', '!' );
1648 $add_option->( 'stack-opening-hash-brace', 'sohb', '!' );
1649 $add_option->( 'stack-opening-paren', 'sop', '!' );
1650 $add_option->( 'stack-opening-square-bracket', 'sosb', '!' );
1651 $add_option->( 'vertical-tightness', 'vt', '=i' );
1652 $add_option->( 'vertical-tightness-closing', 'vtc', '=i' );
1653 $add_option->( 'want-break-after', 'wba', '=s' );
1654 $add_option->( 'want-break-before', 'wbb', '=s' );
1655 $add_option->( 'break-after-all-operators', 'baao', '!' );
1656 $add_option->( 'break-before-all-operators', 'bbao', '!' );
1657 $add_option->( 'keep-interior-semicolons', 'kis', '!' );
1658
1659 ########################################
1660 $category = 6; # Controlling list formatting
1661 ########################################
1662 $add_option->( 'break-at-old-comma-breakpoints', 'boc', '!' );
1663 $add_option->( 'comma-arrow-breakpoints', 'cab', '=i' );
1664 $add_option->( 'maximum-fields-per-table', 'mft', '=i' );
1665
1666 ########################################
1667 $category = 7; # Retaining or ignoring existing line breaks
1668 ########################################
1669 $add_option->( 'break-at-old-keyword-breakpoints', 'bok', '!' );
1670 $add_option->( 'break-at-old-logical-breakpoints', 'bol', '!' );
1671 $add_option->( 'break-at-old-ternary-breakpoints', 'bot', '!' );
1672 $add_option->( 'break-at-old-attribute-breakpoints', 'boa', '!' );
1673 $add_option->( 'ignore-old-breakpoints', 'iob', '!' );
1674
1675 ########################################
1676 $category = 8; # Blank line control
1677 ########################################
1678 $add_option->( 'blanks-before-blocks', 'bbb', '!' );
1679 $add_option->( 'blanks-before-comments', 'bbc', '!' );
1680 $add_option->( 'blank-lines-before-subs', 'blbs', '=i' );
1681 $add_option->( 'blank-lines-before-packages', 'blbp', '=i' );
1682 $add_option->( 'long-block-line-count', 'lbl', '=i' );
1683 $add_option->( 'maximum-consecutive-blank-lines', 'mbl', '=i' );
1684 $add_option->( 'keep-old-blank-lines', 'kbl', '=i' );
1685
1686 ########################################
1687 $category = 9; # Other controls
1688 ########################################
1689 $add_option->( 'delete-block-comments', 'dbc', '!' );
1690 $add_option->( 'delete-closing-side-comments', 'dcsc', '!' );
1691 $add_option->( 'delete-pod', 'dp', '!' );
1692 $add_option->( 'delete-side-comments', 'dsc', '!' );
1693 $add_option->( 'tee-block-comments', 'tbc', '!' );
1694 $add_option->( 'tee-pod', 'tp', '!' );
1695 $add_option->( 'tee-side-comments', 'tsc', '!' );
1696 $add_option->( 'look-for-autoloader', 'lal', '!' );
1697 $add_option->( 'look-for-hash-bang', 'x', '!' );
1698 $add_option->( 'look-for-selfloader', 'lsl', '!' );
1699 $add_option->( 'pass-version-line', 'pvl', '!' );
1700
1701 ########################################
1702 $category = 13; # Debugging
1703 ########################################
1704 $add_option->( 'DEBUG', 'D', '!' );
1705 $add_option->( 'DIAGNOSTICS', 'I', '!' );
1706 $add_option->( 'dump-defaults', 'ddf', '!' );
1707 $add_option->( 'dump-long-names', 'dln', '!' );
1708 $add_option->( 'dump-options', 'dop', '!' );
1709 $add_option->( 'dump-profile', 'dpro', '!' );
1710 $add_option->( 'dump-short-names', 'dsn', '!' );
1711 $add_option->( 'dump-token-types', 'dtt', '!' );
1712 $add_option->( 'dump-want-left-space', 'dwls', '!' );
1713 $add_option->( 'dump-want-right-space', 'dwrs', '!' );
1714 $add_option->( 'fuzzy-line-length', 'fll', '!' );
1715 $add_option->( 'help', 'h', '' );
1716 $add_option->( 'short-concatenation-item-length', 'scl', '=i' );
1717 $add_option->( 'show-options', 'opt', '!' );
1718 $add_option->( 'version', 'v', '' );
1719 $add_option->( 'memoize', 'mem', '!' );
1720
1721 #---------------------------------------------------------------------
1722
1723 # The Perl::Tidy::HtmlWriter will add its own options to the string
1724 Perl::Tidy::HtmlWriter->make_getopt_long_names( \@option_string );
1725
1726 ########################################
1727 # Set categories 10, 11, 12
1728 ########################################
1729 # Based on their known order
1730 $category = 12; # HTML properties
1731 foreach my $opt (@option_string) {
1732 my $long_name = $opt;
1733 $long_name =~ s/(!|=.*|:.*)$//;
1734 unless ( defined( $option_category{$long_name} ) ) {
1735 if ( $long_name =~ /^html-linked/ ) {
1736 $category = 10; # HTML options
1737 }
1738 elsif ( $long_name =~ /^pod2html/ ) {
1739 $category = 11; # Pod2html
1740 }
1741 $option_category{$long_name} = $category_name[$category];
1742 }
1743 }
1744
1745 #---------------------------------------------------------------
1746 # Assign valid ranges to certain options
1747 #---------------------------------------------------------------
1748 # In the future, these may be used to make preliminary checks
1749 # hash keys are long names
1750 # If key or value is undefined:
1751 # strings may have any value
1752 # integer ranges are >=0
1753 # If value is defined:
1754 # value is [qw(any valid words)] for strings
1755 # value is [min, max] for integers
1756 # if min is undefined, there is no lower limit
1757 # if max is undefined, there is no upper limit
1758 # Parameters not listed here have defaults
1759 %option_range = (
1760 'format' => [ 'tidy', 'html', 'user' ],
1761 'output-line-ending' => [ 'dos', 'win', 'mac', 'unix' ],
1762
1763 'block-brace-tightness' => [ 0, 2 ],
1764 'brace-tightness' => [ 0, 2 ],
1765 'paren-tightness' => [ 0, 2 ],
1766 'square-bracket-tightness' => [ 0, 2 ],
1767
1768 'block-brace-vertical-tightness' => [ 0, 2 ],
1769 'brace-vertical-tightness' => [ 0, 2 ],
1770 'brace-vertical-tightness-closing' => [ 0, 2 ],
1771 'paren-vertical-tightness' => [ 0, 2 ],
1772 'paren-vertical-tightness-closing' => [ 0, 2 ],
1773 'square-bracket-vertical-tightness' => [ 0, 2 ],
1774 'square-bracket-vertical-tightness-closing' => [ 0, 2 ],
1775 'vertical-tightness' => [ 0, 2 ],
1776 'vertical-tightness-closing' => [ 0, 2 ],
1777
1778 'closing-brace-indentation' => [ 0, 3 ],
1779 'closing-paren-indentation' => [ 0, 3 ],
1780 'closing-square-bracket-indentation' => [ 0, 3 ],
1781 'closing-token-indentation' => [ 0, 3 ],
1782
1783 'closing-side-comment-else-flag' => [ 0, 2 ],
1784 'comma-arrow-breakpoints' => [ 0, 5 ],
1785 );
1786
1787 # Note: we could actually allow negative ci if someone really wants it:
1788 # $option_range{'continuation-indentation'} = [ undef, undef ];
1789
1790 #---------------------------------------------------------------
1791 # Assign default values to the above options here, except
1792 # for 'outfile' and 'help'.
1793 # These settings should approximate the perlstyle(1) suggestions.
1794 #---------------------------------------------------------------
1795 my @defaults = qw(
1796 add-newlines
1797 add-semicolons
1798 add-whitespace
1799 blanks-before-blocks
1800 blanks-before-comments
1801 blank-lines-before-subs=1
1802 blank-lines-before-packages=1
1803 block-brace-tightness=0
1804 block-brace-vertical-tightness=0
1805 brace-tightness=1
1806 brace-vertical-tightness-closing=0
1807 brace-vertical-tightness=0
1808 break-at-old-logical-breakpoints
1809 break-at-old-ternary-breakpoints
1810 break-at-old-attribute-breakpoints
1811 break-at-old-keyword-breakpoints
1812 comma-arrow-breakpoints=5
1813 nocheck-syntax
1814 closing-side-comment-interval=6
1815 closing-side-comment-maximum-text=20
1816 closing-side-comment-else-flag=0
1817 closing-side-comments-balanced
1818 closing-paren-indentation=0
1819 closing-brace-indentation=0
1820 closing-square-bracket-indentation=0
1821 continuation-indentation=2
1822 delete-old-newlines
1823 delete-semicolons
1824 fuzzy-line-length
1825 hanging-side-comments
1826 indent-block-comments
1827 indent-columns=4
1828 iterations=1
1829 keep-old-blank-lines=1
1830 long-block-line-count=8
1831 look-for-autoloader
1832 look-for-selfloader
1833 maximum-consecutive-blank-lines=1
1834 maximum-fields-per-table=0
1835 maximum-line-length=80
1836 memoize
1837 minimum-space-to-comment=4
1838 nobrace-left-and-indent
1839 nocuddled-else
1840 nodelete-old-whitespace
1841 nohtml
1842 nologfile
1843 noquiet
1844 noshow-options
1845 nostatic-side-comments
1846 notabs
1847 nowarning-output
1848 outdent-labels
1849 outdent-long-quotes
1850 outdent-long-comments
1851 paren-tightness=1
1852 paren-vertical-tightness-closing=0
1853 paren-vertical-tightness=0
1854 pass-version-line
1855 recombine
1856 valign
1857 short-concatenation-item-length=8
1858 space-for-semicolon
1859 square-bracket-tightness=1
1860 square-bracket-vertical-tightness-closing=0
1861 square-bracket-vertical-tightness=0
1862 static-block-comments
1863 trim-qw
1864 format=tidy
1865 backup-file-extension=bak
1866 format-skipping
1867 default-tabsize=8
1868
1869 pod2html
1870 html-table-of-contents
1871 html-entities
1872 );
1873
1874 push @defaults, "perl-syntax-check-flags=-c -T";
1875
1876 #---------------------------------------------------------------
1877 # Define abbreviations which will be expanded into the above primitives.
1878 # These may be defined recursively.
1879 #---------------------------------------------------------------
1880 %expansion = (
1881 %expansion,
1882 'freeze-newlines' => [qw(noadd-newlines nodelete-old-newlines)],
1883 'fnl' => [qw(freeze-newlines)],
1884 'freeze-whitespace' => [qw(noadd-whitespace nodelete-old-whitespace)],
1885 'fws' => [qw(freeze-whitespace)],
1886 'freeze-blank-lines' =>
1887 [qw(maximum-consecutive-blank-lines=0 keep-old-blank-lines=2)],
1888 'fbl' => [qw(freeze-blank-lines)],
1889 'indent-only' => [qw(freeze-newlines freeze-whitespace)],
1890 'outdent-long-lines' => [qw(outdent-long-quotes outdent-long-comments)],
1891 'nooutdent-long-lines' =>
1892 [qw(nooutdent-long-quotes nooutdent-long-comments)],
1893 'noll' => [qw(nooutdent-long-lines)],
1894 'io' => [qw(indent-only)],
1895 'delete-all-comments' =>
1896 [qw(delete-block-comments delete-side-comments delete-pod)],
1897 'nodelete-all-comments' =>
1898 [qw(nodelete-block-comments nodelete-side-comments nodelete-pod)],
1899 'dac' => [qw(delete-all-comments)],
1900 'ndac' => [qw(nodelete-all-comments)],
1901 'gnu' => [qw(gnu-style)],
1902 'pbp' => [qw(perl-best-practices)],
1903 'tee-all-comments' =>
1904 [qw(tee-block-comments tee-side-comments tee-pod)],
1905 'notee-all-comments' =>
1906 [qw(notee-block-comments notee-side-comments notee-pod)],
1907 'tac' => [qw(tee-all-comments)],
1908 'ntac' => [qw(notee-all-comments)],
1909 'html' => [qw(format=html)],
1910 'nhtml' => [qw(format=tidy)],
1911 'tidy' => [qw(format=tidy)],
1912
1913 'swallow-optional-blank-lines' => [qw(kbl=0)],
1914 'noswallow-optional-blank-lines' => [qw(kbl=1)],
1915 'sob' => [qw(kbl=0)],
1916 'nsob' => [qw(kbl=1)],
1917
1918 'break-after-comma-arrows' => [qw(cab=0)],
1919 'nobreak-after-comma-arrows' => [qw(cab=1)],
1920 'baa' => [qw(cab=0)],
1921 'nbaa' => [qw(cab=1)],
1922
1923 'blanks-before-subs' => [qw(blbs=1 blbp=1)],
1924 'bbs' => [qw(blbs=1 blbp=1)],
1925 'noblanks-before-subs' => [qw(blbs=0 blbp=0)],
1926 'nbbs' => [qw(blbs=0 blbp=0)],
1927
1928 'break-at-old-trinary-breakpoints' => [qw(bot)],
1929
1930 'cti=0' => [qw(cpi=0 cbi=0 csbi=0)],
1931 'cti=1' => [qw(cpi=1 cbi=1 csbi=1)],
1932 'cti=2' => [qw(cpi=2 cbi=2 csbi=2)],
1933 'icp' => [qw(cpi=2 cbi=2 csbi=2)],
1934 'nicp' => [qw(cpi=0 cbi=0 csbi=0)],
1935
1936 'closing-token-indentation=0' => [qw(cpi=0 cbi=0 csbi=0)],
1937 'closing-token-indentation=1' => [qw(cpi=1 cbi=1 csbi=1)],
1938 'closing-token-indentation=2' => [qw(cpi=2 cbi=2 csbi=2)],
1939 'indent-closing-paren' => [qw(cpi=2 cbi=2 csbi=2)],
1940 'noindent-closing-paren' => [qw(cpi=0 cbi=0 csbi=0)],
1941
1942 'vt=0' => [qw(pvt=0 bvt=0 sbvt=0)],
1943 'vt=1' => [qw(pvt=1 bvt=1 sbvt=1)],
1944 'vt=2' => [qw(pvt=2 bvt=2 sbvt=2)],
1945
1946 'vertical-tightness=0' => [qw(pvt=0 bvt=0 sbvt=0)],
1947 'vertical-tightness=1' => [qw(pvt=1 bvt=1 sbvt=1)],
1948 'vertical-tightness=2' => [qw(pvt=2 bvt=2 sbvt=2)],
1949
1950 'vtc=0' => [qw(pvtc=0 bvtc=0 sbvtc=0)],
1951 'vtc=1' => [qw(pvtc=1 bvtc=1 sbvtc=1)],
1952 'vtc=2' => [qw(pvtc=2 bvtc=2 sbvtc=2)],
1953
1954 'vertical-tightness-closing=0' => [qw(pvtc=0 bvtc=0 sbvtc=0)],
1955 'vertical-tightness-closing=1' => [qw(pvtc=1 bvtc=1 sbvtc=1)],
1956 'vertical-tightness-closing=2' => [qw(pvtc=2 bvtc=2 sbvtc=2)],
1957
1958 'otr' => [qw(opr ohbr osbr)],
1959 'opening-token-right' => [qw(opr ohbr osbr)],
1960 'notr' => [qw(nopr nohbr nosbr)],
1961 'noopening-token-right' => [qw(nopr nohbr nosbr)],
1962
1963 'sot' => [qw(sop sohb sosb)],
1964 'nsot' => [qw(nsop nsohb nsosb)],
1965 'stack-opening-tokens' => [qw(sop sohb sosb)],
1966 'nostack-opening-tokens' => [qw(nsop nsohb nsosb)],
1967
1968 'sct' => [qw(scp schb scsb)],
1969 'stack-closing-tokens' => => [qw(scp schb scsb)],
1970 'nsct' => [qw(nscp nschb nscsb)],
1971 'nostack-opening-tokens' => [qw(nscp nschb nscsb)],
1972
1973 'sac' => [qw(sot sct)],
1974 'nsac' => [qw(nsot nsct)],
1975 'stack-all-containers' => [qw(sot sct)],
1976 'nostack-all-containers' => [qw(nsot nsct)],
1977
1978 'act=0' => [qw(pt=0 sbt=0 bt=0 bbt=0)],
1979 'act=1' => [qw(pt=1 sbt=1 bt=1 bbt=1)],
1980 'act=2' => [qw(pt=2 sbt=2 bt=2 bbt=2)],
1981 'all-containers-tightness=0' => [qw(pt=0 sbt=0 bt=0 bbt=0)],
1982 'all-containers-tightness=1' => [qw(pt=1 sbt=1 bt=1 bbt=1)],
1983 'all-containers-tightness=2' => [qw(pt=2 sbt=2 bt=2 bbt=2)],
1984
1985 'stack-opening-block-brace' => [qw(bbvt=2 bbvtl=*)],
1986 'sobb' => [qw(bbvt=2 bbvtl=*)],
1987 'nostack-opening-block-brace' => [qw(bbvt=0)],
1988 'nsobb' => [qw(bbvt=0)],
1989
1990 'converge' => [qw(it=4)],
1991 'noconverge' => [qw(it=1)],
1992 'conv' => [qw(it=4)],
1993 'nconv' => [qw(it=1)],
1994
1995 # 'mangle' originally deleted pod and comments, but to keep it
1996 # reversible, it no longer does. But if you really want to
1997 # delete them, just use:
1998 # -mangle -dac
1999
2000 # An interesting use for 'mangle' is to do this:
2001 # perltidy -mangle myfile.pl -st | perltidy -o myfile.pl.new
2002 # which will form as many one-line blocks as possible
2003
2004 'mangle' => [
2005 qw(
2006 check-syntax
2007 keep-old-blank-lines=0
2008 delete-old-newlines
2009 delete-old-whitespace
2010 delete-semicolons
2011 indent-columns=0
2012 maximum-consecutive-blank-lines=0
2013 maximum-line-length=100000
2014 noadd-newlines
2015 noadd-semicolons
2016 noadd-whitespace
2017 noblanks-before-blocks
2018 blank-lines-before-subs=0
2019 blank-lines-before-packages=0
2020 notabs
2021 )
2022 ],
2023
2024 # 'extrude' originally deleted pod and comments, but to keep it
2025 # reversible, it no longer does. But if you really want to
2026 # delete them, just use
2027 # extrude -dac
2028 #
2029 # An interesting use for 'extrude' is to do this:
2030 # perltidy -extrude myfile.pl -st | perltidy -o myfile.pl.new
2031 # which will break up all one-line blocks.
2032
2033 'extrude' => [
2034 qw(
2035 check-syntax
2036 ci=0
2037 delete-old-newlines
2038 delete-old-whitespace
2039 delete-semicolons
2040 indent-columns=0
2041 maximum-consecutive-blank-lines=0
2042 maximum-line-length=1
2043 noadd-semicolons
2044 noadd-whitespace
2045 noblanks-before-blocks
2046 blank-lines-before-subs=0
2047 blank-lines-before-packages=0
2048 nofuzzy-line-length
2049 notabs
2050 norecombine
2051 )
2052 ],
2053
2054 # this style tries to follow the GNU Coding Standards (which do
2055 # not really apply to perl but which are followed by some perl
2056 # programmers).
2057 'gnu-style' => [
2058 qw(
2059 lp bl noll pt=2 bt=2 sbt=2 cpi=1 csbi=1 cbi=1
2060 )
2061 ],
2062
2063 # Style suggested in Damian Conway's Perl Best Practices
2064 'perl-best-practices' => [
2065 qw(l=78 i=4 ci=4 st se vt=2 cti=0 pt=1 bt=1 sbt=1 bbt=1 nsfs nolq),
2066q(wbb=% + - * / x != == >= <= =~ !~ < > | & = **= += *= &= <<= &&= -= /= |= >>= ||= //= .= %= ^= x=)
2067 ],
2068
2069 # Additional styles can be added here
2070 );
2071
2072 Perl::Tidy::HtmlWriter->make_abbreviated_names( \%expansion );
2073
2074 # Uncomment next line to dump all expansions for debugging:
2075 # dump_short_names(\%expansion);
2076 return (
2077 \@option_string, \@defaults, \%expansion,
2078 \%option_category, \%option_range
2079 );
2080
2081} # end of generate_options
2082
2083# Memoize process_command_line. Given same @ARGV passed in, return same
2084# values and same @ARGV back.
2085# This patch was supplied by Jonathan Swartz Nov 2012 and significantly speeds
2086# up masontidy (https://metacpan.org/module/masontidy)
2087
20881100nsmy %process_command_line_cache;
2089
2090sub process_command_line {
2091
2092 my (
2093 $perltidyrc_stream, $is_Windows, $Windows_type,
2094 $rpending_complaint, $dump_options_type
2095 ) = @_;
2096
2097 my $use_cache = !defined($perltidyrc_stream) && !$dump_options_type;
2098 if ($use_cache) {
2099 my $cache_key = join( chr(28), @ARGV );
2100 if ( my $result = $process_command_line_cache{$cache_key} ) {
2101 my ( $argv, @retvals ) = @$result;
2102 @ARGV = @$argv;
2103 return @retvals;
2104 }
2105 else {
2106 my @retvals = _process_command_line(@_);
2107 $process_command_line_cache{$cache_key} = [ \@ARGV, @retvals ]
2108 if $retvals[0]->{'memoize'};
2109 return @retvals;
2110 }
2111 }
2112 else {
2113 return _process_command_line(@_);
2114 }
2115}
2116
2117# (note the underscore here)
2118sub _process_command_line {
2119
2120 my (
2121 $perltidyrc_stream, $is_Windows, $Windows_type,
2122 $rpending_complaint, $dump_options_type
2123 ) = @_;
2124
212524.15ms2209┬Ás
# spent 110┬Ás (11+99) within Perl::Tidy::BEGIN@2125 which was called: # once (11┬Ás+99┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 2125
use Getopt::Long;
# spent 110┬Ás making 1 call to Perl::Tidy::BEGIN@2125 # spent 99┬Ás making 1 call to Getopt::Long::import
2126
2127 my (
2128 $roption_string, $rdefaults, $rexpansion,
2129 $roption_category, $roption_range
2130 ) = generate_options();
2131
2132 #---------------------------------------------------------------
2133 # set the defaults by passing the above list through GetOptions
2134 #---------------------------------------------------------------
2135 my %Opts = ();
2136 {
2137 local @ARGV;
2138 my $i;
2139
2140 # do not load the defaults if we are just dumping perltidyrc
2141 unless ( $dump_options_type eq 'perltidyrc' ) {
2142 for $i (@$rdefaults) { push @ARGV, "--" . $i }
2143 }
2144
2145 # Patch to save users Getopt::Long configuration
2146 # and set to Getopt::Long defaults. Use eval to avoid
2147 # breaking old versions of Perl without these routines.
2148 my $glc;
2149 eval { $glc = Getopt::Long::Configure() };
2150 unless ($@) {
2151 eval { Getopt::Long::ConfigDefaults() };
2152 }
2153 else { $glc = undef }
2154
2155 if ( !GetOptions( \%Opts, @$roption_string ) ) {
2156 Die "Programming Bug: error in setting default options";
2157 }
2158
2159 # Patch to put the previous Getopt::Long configuration back
2160 eval { Getopt::Long::Configure($glc) } if defined $glc;
2161 }
2162
2163 my $word;
2164 my @raw_options = ();
2165 my $config_file = "";
2166 my $saw_ignore_profile = 0;
2167 my $saw_extrude = 0;
2168 my $saw_pbp = 0;
2169 my $saw_dump_profile = 0;
2170 my $i;
2171
2172 #---------------------------------------------------------------
2173 # Take a first look at the command-line parameters. Do as many
2174 # immediate dumps as possible, which can avoid confusion if the
2175 # perltidyrc file has an error.
2176 #---------------------------------------------------------------
2177 foreach $i (@ARGV) {
2178
2179 $i =~ s/^--/-/;
2180 if ( $i =~ /^-(npro|noprofile|no-profile)$/ ) {
2181 $saw_ignore_profile = 1;
2182 }
2183
2184 # note: this must come before -pro and -profile, below:
2185 elsif ( $i =~ /^-(dump-profile|dpro)$/ ) {
2186 $saw_dump_profile = 1;
2187 }
2188 elsif ( $i =~ /^-(pro|profile)=(.+)/ ) {
2189 if ($config_file) {
2190 Warn
2191"Only one -pro=filename allowed, using '$2' instead of '$config_file'\n";
2192 }
2193 $config_file = $2;
2194
2195 # resolve <dir>/.../<file>, meaning look upwards from directory
2196 if ( defined($config_file) ) {
2197 if ( my ( $start_dir, $search_file ) =
2198 ( $config_file =~ m{^(.*)\.\.\./(.*)$} ) )
2199 {
2200 $start_dir = '.' if !$start_dir;
2201 $start_dir = Cwd::realpath($start_dir);
2202 if ( my $found_file =
2203 find_file_upwards( $start_dir, $search_file ) )
2204 {
2205 $config_file = $found_file;
2206 }
2207 }
2208 }
2209 unless ( -e $config_file ) {
2210 Warn "cannot find file given with -pro=$config_file: $!\n";
2211 $config_file = "";
2212 }
2213 }
2214 elsif ( $i =~ /^-(pro|profile)=?$/ ) {
2215 Die "usage: -pro=filename or --profile=filename, no spaces\n";
2216 }
2217 elsif ( $i =~ /^-extrude$/ ) {
2218 $saw_extrude = 1;
2219 }
2220 elsif ( $i =~ /^-(pbp|perl-best-practices)$/ ) {
2221 $saw_pbp = 1;
2222 }
2223 elsif ( $i =~ /^-(help|h|HELP|H|\?)$/ ) {
2224 usage();
2225 Exit 0;
2226 }
2227 elsif ( $i =~ /^-(version|v)$/ ) {
2228 show_version();
2229 Exit 0;
2230 }
2231 elsif ( $i =~ /^-(dump-defaults|ddf)$/ ) {
2232 dump_defaults(@$rdefaults);
2233 Exit 0;
2234 }
2235 elsif ( $i =~ /^-(dump-long-names|dln)$/ ) {
2236 dump_long_names(@$roption_string);
2237 Exit 0;
2238 }
2239 elsif ( $i =~ /^-(dump-short-names|dsn)$/ ) {
2240 dump_short_names($rexpansion);
2241 Exit 0;
2242 }
2243 elsif ( $i =~ /^-(dump-token-types|dtt)$/ ) {
2244 Perl::Tidy::Tokenizer->dump_token_types(*STDOUT);
2245 Exit 0;
2246 }
2247 }
2248
2249 if ( $saw_dump_profile && $saw_ignore_profile ) {
2250 Warn "No profile to dump because of -npro\n";
2251 Exit 1;
2252 }
2253
2254 #---------------------------------------------------------------
2255 # read any .perltidyrc configuration file
2256 #---------------------------------------------------------------
2257 unless ($saw_ignore_profile) {
2258
2259 # resolve possible conflict between $perltidyrc_stream passed
2260 # as call parameter to perltidy and -pro=filename on command
2261 # line.
2262 if ($perltidyrc_stream) {
2263 if ($config_file) {
2264 Warn <<EOM;
2265 Conflict: a perltidyrc configuration file was specified both as this
2266 perltidy call parameter: $perltidyrc_stream
2267 and with this -profile=$config_file.
2268 Using -profile=$config_file.
2269EOM
2270 }
2271 else {
2272 $config_file = $perltidyrc_stream;
2273 }
2274 }
2275
2276 # look for a config file if we don't have one yet
2277 my $rconfig_file_chatter;
2278 $$rconfig_file_chatter = "";
2279 $config_file =
2280 find_config_file( $is_Windows, $Windows_type, $rconfig_file_chatter,
2281 $rpending_complaint )
2282 unless $config_file;
2283
2284 # open any config file
2285 my $fh_config;
2286 if ($config_file) {
2287 ( $fh_config, $config_file ) =
2288 Perl::Tidy::streamhandle( $config_file, 'r' );
2289 unless ($fh_config) {
2290 $$rconfig_file_chatter .=
2291 "# $config_file exists but cannot be opened\n";
2292 }
2293 }
2294
2295 if ($saw_dump_profile) {
2296 dump_config_file( $fh_config, $config_file, $rconfig_file_chatter );
2297 Exit 0;
2298 }
2299
2300 if ($fh_config) {
2301
2302 my ( $rconfig_list, $death_message, $_saw_pbp ) =
2303 read_config_file( $fh_config, $config_file, $rexpansion );
2304 Die $death_message if ($death_message);
2305 $saw_pbp ||= $_saw_pbp;
2306
2307 # process any .perltidyrc parameters right now so we can
2308 # localize errors
2309 if (@$rconfig_list) {
2310 local @ARGV = @$rconfig_list;
2311
2312 expand_command_abbreviations( $rexpansion, \@raw_options,
2313 $config_file );
2314
2315 if ( !GetOptions( \%Opts, @$roption_string ) ) {
2316 Die
2317"Error in this config file: $config_file \nUse -npro to ignore this file, -h for help'\n";
2318 }
2319
2320 # Anything left in this local @ARGV is an error and must be
2321 # invalid bare words from the configuration file. We cannot
2322 # check this earlier because bare words may have been valid
2323 # values for parameters. We had to wait for GetOptions to have
2324 # a look at @ARGV.
2325 if (@ARGV) {
2326 my $count = @ARGV;
2327 my $str = "\'" . pop(@ARGV) . "\'";
2328 while ( my $param = pop(@ARGV) ) {
2329 if ( length($str) < 70 ) {
2330 $str .= ", '$param'";
2331 }
2332 else {
2333 $str .= ", ...";
2334 last;
2335 }
2336 }
2337 Die <<EOM;
2338There are $count unrecognized values in the configuration file '$config_file':
2339$str
2340Use leading dashes for parameters. Use -npro to ignore this file.
2341EOM
2342 }
2343
2344 # Undo any options which cause premature exit. They are not
2345 # appropriate for a config file, and it could be hard to
2346 # diagnose the cause of the premature exit.
2347 foreach (
2348 qw{
2349 dump-defaults
2350 dump-long-names
2351 dump-options
2352 dump-profile
2353 dump-short-names
2354 dump-token-types
2355 dump-want-left-space
2356 dump-want-right-space
2357 help
2358 stylesheet
2359 version
2360 }
2361 )
2362 {
2363
2364 if ( defined( $Opts{$_} ) ) {
2365 delete $Opts{$_};
2366 Warn "ignoring --$_ in config file: $config_file\n";
2367 }
2368 }
2369 }
2370 }
2371 }
2372
2373 #---------------------------------------------------------------
2374 # now process the command line parameters
2375 #---------------------------------------------------------------
2376 expand_command_abbreviations( $rexpansion, \@raw_options, $config_file );
2377
2378 local $SIG{'__WARN__'} = sub { Warn $_[0] };
2379 if ( !GetOptions( \%Opts, @$roption_string ) ) {
2380 Die "Error on command line; for help try 'perltidy -h'\n";
2381 }
2382
2383 return (
2384 \%Opts, $config_file, \@raw_options,
2385 $saw_extrude, $saw_pbp, $roption_string,
2386 $rexpansion, $roption_category, $roption_range
2387 );
2388} # end of process_command_line
2389
2390sub check_options {
2391
2392 my ( $rOpts, $is_Windows, $Windows_type, $rpending_complaint ) = @_;
2393
2394 #---------------------------------------------------------------
2395 # check and handle any interactions among the basic options..
2396 #---------------------------------------------------------------
2397
2398 # Since -vt, -vtc, and -cti are abbreviations, but under
2399 # msdos, an unquoted input parameter like vtc=1 will be
2400 # seen as 2 parameters, vtc and 1, so the abbreviations
2401 # won't be seen. Therefore, we will catch them here if
2402 # they get through.
2403
2404 if ( defined $rOpts->{'vertical-tightness'} ) {
2405 my $vt = $rOpts->{'vertical-tightness'};
2406 $rOpts->{'paren-vertical-tightness'} = $vt;
2407 $rOpts->{'square-bracket-vertical-tightness'} = $vt;
2408 $rOpts->{'brace-vertical-tightness'} = $vt;
2409 }
2410
2411 if ( defined $rOpts->{'vertical-tightness-closing'} ) {
2412 my $vtc = $rOpts->{'vertical-tightness-closing'};
2413 $rOpts->{'paren-vertical-tightness-closing'} = $vtc;
2414 $rOpts->{'square-bracket-vertical-tightness-closing'} = $vtc;
2415 $rOpts->{'brace-vertical-tightness-closing'} = $vtc;
2416 }
2417
2418 if ( defined $rOpts->{'closing-token-indentation'} ) {
2419 my $cti = $rOpts->{'closing-token-indentation'};
2420 $rOpts->{'closing-square-bracket-indentation'} = $cti;
2421 $rOpts->{'closing-brace-indentation'} = $cti;
2422 $rOpts->{'closing-paren-indentation'} = $cti;
2423 }
2424
2425 # In quiet mode, there is no log file and hence no way to report
2426 # results of syntax check, so don't do it.
2427 if ( $rOpts->{'quiet'} ) {
2428 $rOpts->{'check-syntax'} = 0;
2429 }
2430
2431 # can't check syntax if no output
2432 if ( $rOpts->{'format'} ne 'tidy' ) {
2433 $rOpts->{'check-syntax'} = 0;
2434 }
2435
2436 # Never let Windows 9x/Me systems run syntax check -- this will prevent a
2437 # wide variety of nasty problems on these systems, because they cannot
2438 # reliably run backticks. Don't even think about changing this!
2439 if ( $rOpts->{'check-syntax'}
2440 && $is_Windows
2441 && ( !$Windows_type || $Windows_type =~ /^(9|Me)/ ) )
2442 {
2443 $rOpts->{'check-syntax'} = 0;
2444 }
2445
2446 # It's really a bad idea to check syntax as root unless you wrote
2447 # the script yourself. FIXME: not sure if this works with VMS
2448 unless ($is_Windows) {
2449
2450 if ( $< == 0 && $rOpts->{'check-syntax'} ) {
2451 $rOpts->{'check-syntax'} = 0;
2452 $$rpending_complaint .=
2453"Syntax check deactivated for safety; you shouldn't run this as root\n";
2454 }
2455 }
2456
2457 # check iteration count and quietly fix if necessary:
2458 # - iterations option only applies to code beautification mode
2459 # - the convergence check should stop most runs on iteration 2, and
2460 # virtually all on iteration 3. But we'll allow up to 6.
2461 if ( $rOpts->{'format'} ne 'tidy' ) {
2462 $rOpts->{'iterations'} = 1;
2463 }
2464 elsif ( defined( $rOpts->{'iterations'} ) ) {
2465 if ( $rOpts->{'iterations'} <= 0 ) { $rOpts->{'iterations'} = 1 }
2466 elsif ( $rOpts->{'iterations'} > 6 ) { $rOpts->{'iterations'} = 6 }
2467 }
2468 else {
2469 $rOpts->{'iterations'} = 1;
2470 }
2471
2472 # check for reasonable number of blank lines and fix to avoid problems
2473 if ( $rOpts->{'blank-lines-before-subs'} ) {
2474 if ( $rOpts->{'blank-lines-before-subs'} < 0 ) {
2475 $rOpts->{'blank-lines-before-subs'} = 0;
2476 Warn "negative value of -blbs, setting 0\n";
2477 }
2478 if ( $rOpts->{'blank-lines-before-subs'} > 100 ) {
2479 Warn "unreasonably large value of -blbs, reducing\n";
2480 $rOpts->{'blank-lines-before-subs'} = 100;
2481 }
2482 }
2483 if ( $rOpts->{'blank-lines-before-packages'} ) {
2484 if ( $rOpts->{'blank-lines-before-packages'} < 0 ) {
2485 Warn "negative value of -blbp, setting 0\n";
2486 $rOpts->{'blank-lines-before-packages'} = 0;
2487 }
2488 if ( $rOpts->{'blank-lines-before-packages'} > 100 ) {
2489 Warn "unreasonably large value of -blbp, reducing\n";
2490 $rOpts->{'blank-lines-before-packages'} = 100;
2491 }
2492 }
2493
2494 # setting a non-negative logfile gap causes logfile to be saved
2495 if ( defined( $rOpts->{'logfile-gap'} ) && $rOpts->{'logfile-gap'} >= 0 ) {
2496 $rOpts->{'logfile'} = 1;
2497 }
2498
2499 # set short-cut flag when only indentation is to be done.
2500 # Note that the user may or may not have already set the
2501 # indent-only flag.
2502 if ( !$rOpts->{'add-whitespace'}
2503 && !$rOpts->{'delete-old-whitespace'}
2504 && !$rOpts->{'add-newlines'}
2505 && !$rOpts->{'delete-old-newlines'} )
2506 {
2507 $rOpts->{'indent-only'} = 1;
2508 }
2509
2510 # -isbc implies -ibc
2511 if ( $rOpts->{'indent-spaced-block-comments'} ) {
2512 $rOpts->{'indent-block-comments'} = 1;
2513 }
2514
2515 # -bli flag implies -bl
2516 if ( $rOpts->{'brace-left-and-indent'} ) {
2517 $rOpts->{'opening-brace-on-new-line'} = 1;
2518 }
2519
2520 if ( $rOpts->{'opening-brace-always-on-right'}
2521 && $rOpts->{'opening-brace-on-new-line'} )
2522 {
2523 Warn <<EOM;
2524 Conflict: you specified both 'opening-brace-always-on-right' (-bar) and
2525 'opening-brace-on-new-line' (-bl). Ignoring -bl.
2526EOM
2527 $rOpts->{'opening-brace-on-new-line'} = 0;
2528 }
2529
2530 # it simplifies things if -bl is 0 rather than undefined
2531 if ( !defined( $rOpts->{'opening-brace-on-new-line'} ) ) {
2532 $rOpts->{'opening-brace-on-new-line'} = 0;
2533 }
2534
2535 # -sbl defaults to -bl if not defined
2536 if ( !defined( $rOpts->{'opening-sub-brace-on-new-line'} ) ) {
2537 $rOpts->{'opening-sub-brace-on-new-line'} =
2538 $rOpts->{'opening-brace-on-new-line'};
2539 }
2540
2541 if ( $rOpts->{'entab-leading-whitespace'} ) {
2542 if ( $rOpts->{'entab-leading-whitespace'} < 0 ) {
2543 Warn "-et=n must use a positive integer; ignoring -et\n";
2544 $rOpts->{'entab-leading-whitespace'} = undef;
2545 }
2546
2547 # entab leading whitespace has priority over the older 'tabs' option
2548 if ( $rOpts->{'tabs'} ) { $rOpts->{'tabs'} = 0; }
2549 }
2550
2551 # set a default tabsize to be used in guessing the starting indentation
2552 # level if and only if this run does not use tabs and the old code does
2553 # use tabs
2554 if ( $rOpts->{'default-tabsize'} ) {
2555 if ( $rOpts->{'default-tabsize'} < 0 ) {
2556 Warn "negative value of -dt, setting 0\n";
2557 $rOpts->{'default-tabsize'} = 0;
2558 }
2559 if ( $rOpts->{'default-tabsize'} > 20 ) {
2560 Warn "unreasonably large value of -dt, reducing\n";
2561 $rOpts->{'default-tabsize'} = 20;
2562 }
2563 }
2564 else {
2565 $rOpts->{'default-tabsize'} = 8;
2566 }
2567
2568 # Define $tabsize, the number of spaces per tab for use in
2569 # guessing the indentation of source lines with leading tabs.
2570 # Assume same as for this run if tabs are used , otherwise assume
2571 # a default value, typically 8
2572 my $tabsize =
2573 $rOpts->{'entab-leading-whitespace'}
2574 ? $rOpts->{'entab-leading-whitespace'}
2575 : $rOpts->{'tabs'} ? $rOpts->{'indent-columns'}
2576 : $rOpts->{'default-tabsize'};
2577 return $tabsize;
2578}
2579
2580sub find_file_upwards {
2581 my ( $search_dir, $search_file ) = @_;
2582
2583 $search_dir =~ s{/+$}{};
2584 $search_file =~ s{^/+}{};
2585
2586 while (1) {
2587 my $try_path = "$search_dir/$search_file";
2588 if ( -f $try_path ) {
2589 return $try_path;
2590 }
2591 elsif ( $search_dir eq '/' ) {
2592 return undef;
2593 }
2594 else {
2595 $search_dir = dirname($search_dir);
2596 }
2597 }
2598}
2599
2600sub expand_command_abbreviations {
2601
2602 # go through @ARGV and expand any abbreviations
2603
2604 my ( $rexpansion, $rraw_options, $config_file ) = @_;
2605 my ($word);
2606
2607 # set a pass limit to prevent an infinite loop;
2608 # 10 should be plenty, but it may be increased to allow deeply
2609 # nested expansions.
2610 my $max_passes = 10;
2611 my @new_argv = ();
2612
2613 # keep looping until all expansions have been converted into actual
2614 # dash parameters..
2615 for ( my $pass_count = 0 ; $pass_count <= $max_passes ; $pass_count++ ) {
2616 my @new_argv = ();
2617 my $abbrev_count = 0;
2618
2619 # loop over each item in @ARGV..
2620 foreach $word (@ARGV) {
2621
2622 # convert any leading 'no-' to just 'no'
2623 if ( $word =~ /^(-[-]?no)-(.*)/ ) { $word = $1 . $2 }
2624
2625 # if it is a dash flag (instead of a file name)..
2626 if ( $word =~ /^-[-]?([\w\-]+)(.*)/ ) {
2627
2628 my $abr = $1;
2629 my $flags = $2;
2630
2631 # save the raw input for debug output in case of circular refs
2632 if ( $pass_count == 0 ) {
2633 push( @$rraw_options, $word );
2634 }
2635
2636 # recombine abbreviation and flag, if necessary,
2637 # to allow abbreviations with arguments such as '-vt=1'
2638 if ( $rexpansion->{ $abr . $flags } ) {
2639 $abr = $abr . $flags;
2640 $flags = "";
2641 }
2642
2643 # if we see this dash item in the expansion hash..
2644 if ( $rexpansion->{$abr} ) {
2645 $abbrev_count++;
2646
2647 # stuff all of the words that it expands to into the
2648 # new arg list for the next pass
2649 foreach my $abbrev ( @{ $rexpansion->{$abr} } ) {
2650 next unless $abbrev; # for safety; shouldn't happen
2651 push( @new_argv, '--' . $abbrev . $flags );
2652 }
2653 }
2654
2655 # not in expansion hash, must be actual long name
2656 else {
2657 push( @new_argv, $word );
2658 }
2659 }
2660
2661 # not a dash item, so just save it for the next pass
2662 else {
2663 push( @new_argv, $word );
2664 }
2665 } # end of this pass
2666
2667 # update parameter list @ARGV to the new one
2668 @ARGV = @new_argv;
2669 last unless ( $abbrev_count > 0 );
2670
2671 # make sure we are not in an infinite loop
2672 if ( $pass_count == $max_passes ) {
2673 local $" = ')(';
2674 Warn <<EOM;
2675I'm tired. We seem to be in an infinite loop trying to expand aliases.
2676Here are the raw options;
2677(rraw_options)
2678EOM
2679 my $num = @new_argv;
2680 if ( $num < 50 ) {
2681 Warn <<EOM;
2682After $max_passes passes here is ARGV
2683(@new_argv)
2684EOM
2685 }
2686 else {
2687 Warn <<EOM;
2688After $max_passes passes ARGV has $num entries
2689EOM
2690 }
2691
2692 if ($config_file) {
2693 Die <<"DIE";
2694Please check your configuration file $config_file for circular-references.
2695To deactivate it, use -npro.
2696DIE
2697 }
2698 else {
2699 Die <<'DIE';
2700Program bug - circular-references in the %expansion hash, probably due to
2701a recent program change.
2702DIE
2703 }
2704 } # end of check for circular references
2705 } # end of loop over all passes
2706}
2707
2708# Debug routine -- this will dump the expansion hash
2709sub dump_short_names {
2710 my $rexpansion = shift;
2711 print STDOUT <<EOM;
2712List of short names. This list shows how all abbreviations are
2713translated into other abbreviations and, eventually, into long names.
2714New abbreviations may be defined in a .perltidyrc file.
2715For a list of all long names, use perltidy --dump-long-names (-dln).
2716--------------------------------------------------------------------------
2717EOM
2718 foreach my $abbrev ( sort keys %$rexpansion ) {
2719 my @list = @{ $$rexpansion{$abbrev} };
2720 print STDOUT "$abbrev --> @list\n";
2721 }
2722}
2723
2724sub check_vms_filename {
2725
2726 # given a valid filename (the perltidy input file)
2727 # create a modified filename and separator character
2728 # suitable for VMS.
2729 #
2730 # Contributed by Michael Cartmell
2731 #
2732 my ( $base, $path ) = fileparse( $_[0] );
2733
2734 # remove explicit ; version
2735 $base =~ s/;-?\d*$//
2736
2737 # remove explicit . version ie two dots in filename NB ^ escapes a dot
2738 or $base =~ s/( # begin capture $1
2739 (?:^|[^^])\. # match a dot not preceded by a caret
2740 (?: # followed by nothing
2741 | # or
2742 .*[^^] # anything ending in a non caret
2743 )
2744 ) # end capture $1
2745 \.-?\d*$ # match . version number
2746 /$1/x;
2747
2748 # normalise filename, if there are no unescaped dots then append one
2749 $base .= '.' unless $base =~ /(?:^|[^^])\./;
2750
2751 # if we don't already have an extension then we just append the extension
2752 my $separator = ( $base =~ /\.$/ ) ? "" : "_";
2753 return ( $path . $base, $separator );
2754}
2755
2756sub Win_OS_Type {
2757
2758 # TODO: are these more standard names?
2759 # Win32s Win95 Win98 WinMe WinNT3.51 WinNT4 Win2000 WinXP/.Net Win2003
2760
2761 # Returns a string that determines what MS OS we are on.
2762 # Returns win32s,95,98,Me,NT3.51,NT4,2000,XP/.Net,Win2003
2763 # Returns blank string if not an MS system.
2764 # Original code contributed by: Yves Orton
2765 # We need to know this to decide where to look for config files
2766
2767 my $rpending_complaint = shift;
2768 my $os = "";
2769 return $os unless $^O =~ /win32|dos/i; # is it a MS box?
2770
2771 # Systems built from Perl source may not have Win32.pm
2772 # But probably have Win32::GetOSVersion() anyway so the
2773 # following line is not 'required':
2774 # return $os unless eval('require Win32');
2775
2776 # Use the standard API call to determine the version
2777 my ( $undef, $major, $minor, $build, $id );
2778 eval { ( $undef, $major, $minor, $build, $id ) = Win32::GetOSVersion() };
2779
2780 #
2781 # NAME ID MAJOR MINOR
2782 # Windows NT 4 2 4 0
2783 # Windows 2000 2 5 0
2784 # Windows XP 2 5 1
2785 # Windows Server 2003 2 5 2
2786
2787 return "win32s" unless $id; # If id==0 then its a win32s box.
2788 $os = { # Magic numbers from MSDN
2789 # documentation of GetOSVersion
2790 1 => {
2791 0 => "95",
2792 10 => "98",
2793 90 => "Me"
2794 },
2795 2 => {
2796 0 => "2000", # or NT 4, see below
2797 1 => "XP/.Net",
2798 2 => "Win2003",
2799 51 => "NT3.51"
2800 }
2801 }->{$id}->{$minor};
2802
2803 # If $os is undefined, the above code is out of date. Suggested updates
2804 # are welcome.
2805 unless ( defined $os ) {
2806 $os = "";
2807 $$rpending_complaint .= <<EOS;
2808Error trying to discover Win_OS_Type: $id:$major:$minor Has no name of record!
2809We won't be able to look for a system-wide config file.
2810EOS
2811 }
2812
2813 # Unfortunately the logic used for the various versions isn't so clever..
2814 # so we have to handle an outside case.
2815 return ( $os eq "2000" && $major != 5 ) ? "NT4" : $os;
2816}
2817
2818sub is_unix {
2819 return
2820 ( $^O !~ /win32|dos/i )
2821 && ( $^O ne 'VMS' )
2822 && ( $^O ne 'OS2' )
2823 && ( $^O ne 'MacOS' );
2824}
2825
2826sub look_for_Windows {
2827
2828 # determine Windows sub-type and location of
2829 # system-wide configuration files
2830 my $rpending_complaint = shift;
2831 my $is_Windows = ( $^O =~ /win32|dos/i );
2832 my $Windows_type = Win_OS_Type($rpending_complaint) if $is_Windows;
2833 return ( $is_Windows, $Windows_type );
2834}
2835
2836sub find_config_file {
2837
2838 # look for a .perltidyrc configuration file
2839 # For Windows also look for a file named perltidy.ini
2840 my ( $is_Windows, $Windows_type, $rconfig_file_chatter,
2841 $rpending_complaint ) = @_;
2842
2843 $$rconfig_file_chatter .= "# Config file search...system reported as:";
2844 if ($is_Windows) {
2845 $$rconfig_file_chatter .= "Windows $Windows_type\n";
2846 }
2847 else {
2848 $$rconfig_file_chatter .= " $^O\n";
2849 }
2850
2851 # sub to check file existence and record all tests
2852 my $exists_config_file = sub {
2853 my $config_file = shift;
2854 return 0 unless $config_file;
2855 $$rconfig_file_chatter .= "# Testing: $config_file\n";
2856 return -f $config_file;
2857 };
2858
2859 my $config_file;
2860
2861 # look in current directory first
2862 $config_file = ".perltidyrc";
2863 return $config_file if $exists_config_file->($config_file);
2864 if ($is_Windows) {
2865 $config_file = "perltidy.ini";
2866 return $config_file if $exists_config_file->($config_file);
2867 }
2868
2869 # Default environment vars.
2870 my @envs = qw(PERLTIDY HOME);
2871
2872 # Check the NT/2k/XP locations, first a local machine def, then a
2873 # network def
2874 push @envs, qw(USERPROFILE HOMESHARE) if $^O =~ /win32/i;
2875
2876 # Now go through the environment ...
2877 foreach my $var (@envs) {
2878 $$rconfig_file_chatter .= "# Examining: \$ENV{$var}";
2879 if ( defined( $ENV{$var} ) ) {
2880 $$rconfig_file_chatter .= " = $ENV{$var}\n";
2881
2882 # test ENV{ PERLTIDY } as file:
2883 if ( $var eq 'PERLTIDY' ) {
2884 $config_file = "$ENV{$var}";
2885 return $config_file if $exists_config_file->($config_file);
2886 }
2887
2888 # test ENV as directory:
2889 $config_file = catfile( $ENV{$var}, ".perltidyrc" );
2890 return $config_file if $exists_config_file->($config_file);
2891
2892 if ($is_Windows) {
2893 $config_file = catfile( $ENV{$var}, "perltidy.ini" );
2894 return $config_file if $exists_config_file->($config_file);
2895 }
2896 }
2897 else {
2898 $$rconfig_file_chatter .= "\n";
2899 }
2900 }
2901
2902 # then look for a system-wide definition
2903 # where to look varies with OS
2904 if ($is_Windows) {
2905
2906 if ($Windows_type) {
2907 my ( $os, $system, $allusers ) =
2908 Win_Config_Locs( $rpending_complaint, $Windows_type );
2909
2910 # Check All Users directory, if there is one.
2911 # i.e. C:\Documents and Settings\User\perltidy.ini
2912 if ($allusers) {
2913
2914 $config_file = catfile( $allusers, ".perltidyrc" );
2915 return $config_file if $exists_config_file->($config_file);
2916
2917 $config_file = catfile( $allusers, "perltidy.ini" );
2918 return $config_file if $exists_config_file->($config_file);
2919 }
2920
2921 # Check system directory.
2922 # retain old code in case someone has been able to create
2923 # a file with a leading period.
2924 $config_file = catfile( $system, ".perltidyrc" );
2925 return $config_file if $exists_config_file->($config_file);
2926
2927 $config_file = catfile( $system, "perltidy.ini" );
2928 return $config_file if $exists_config_file->($config_file);
2929 }
2930 }
2931
2932 # Place to add customization code for other systems
2933 elsif ( $^O eq 'OS2' ) {
2934 }
2935 elsif ( $^O eq 'MacOS' ) {
2936 }
2937 elsif ( $^O eq 'VMS' ) {
2938 }
2939
2940 # Assume some kind of Unix
2941 else {
2942
2943 $config_file = "/usr/local/etc/perltidyrc";
2944 return $config_file if $exists_config_file->($config_file);
2945
2946 $config_file = "/etc/perltidyrc";
2947 return $config_file if $exists_config_file->($config_file);
2948 }
2949
2950 # Couldn't find a config file
2951 return;
2952}
2953
2954sub Win_Config_Locs {
2955
2956 # In scalar context returns the OS name (95 98 ME NT3.51 NT4 2000 XP),
2957 # or undef if its not a win32 OS. In list context returns OS, System
2958 # Directory, and All Users Directory. All Users will be empty on a
2959 # 9x/Me box. Contributed by: Yves Orton.
2960
2961 my $rpending_complaint = shift;
2962 my $os = (@_) ? shift : Win_OS_Type();
2963 return unless $os;
2964
2965 my $system = "";
2966 my $allusers = "";
2967
2968 if ( $os =~ /9[58]|Me/ ) {
2969 $system = "C:/Windows";
2970 }
2971 elsif ( $os =~ /NT|XP|200?/ ) {
2972 $system = ( $os =~ /XP/ ) ? "C:/Windows/" : "C:/WinNT/";
2973 $allusers =
2974 ( $os =~ /NT/ )
2975 ? "C:/WinNT/profiles/All Users/"
2976 : "C:/Documents and Settings/All Users/";
2977 }
2978 else {
2979
2980 # This currently would only happen on a win32s computer. I don't have
2981 # one to test, so I am unsure how to proceed. Suggestions welcome!
2982 $$rpending_complaint .=
2983"I dont know a sensible place to look for config files on an $os system.\n";
2984 return;
2985 }
2986 return wantarray ? ( $os, $system, $allusers ) : $os;
2987}
2988
2989sub dump_config_file {
2990 my $fh = shift;
2991 my $config_file = shift;
2992 my $rconfig_file_chatter = shift;
2993 print STDOUT "$$rconfig_file_chatter";
2994 if ($fh) {
2995 print STDOUT "# Dump of file: '$config_file'\n";
2996 while ( my $line = $fh->getline() ) { print STDOUT $line }
2997 eval { $fh->close() };
2998 }
2999 else {
3000 print STDOUT "# ...no config file found\n";
3001 }
3002}
3003
3004sub read_config_file {
3005
3006 my ( $fh, $config_file, $rexpansion ) = @_;
3007 my @config_list = ();
3008 my $saw_pbp;
3009
3010 # file is bad if non-empty $death_message is returned
3011 my $death_message = "";
3012
3013 my $name = undef;
3014 my $line_no;
3015 while ( my $line = $fh->getline() ) {
3016 $line_no++;
3017 chomp $line;
3018 ( $line, $death_message ) =
3019 strip_comment( $line, $config_file, $line_no );
3020 last if ($death_message);
3021 next unless $line;
3022 $line =~ s/^\s*(.*?)\s*$/$1/; # trim both ends
3023 next unless $line;
3024
3025 # look for something of the general form
3026 # newname { body }
3027 # or just
3028 # body
3029
3030 my $body = $line;
3031 my ($newname);
3032 if ( $line =~ /^((\w+)\s*\{)(.*)\}$/ ) {
3033 ( $newname, $body ) = ( $2, $3, );
3034 }
3035 if ($body) {
3036
3037 if ( !$saw_pbp && $body =~ /-(pbp|perl-best-practices)/ ) {
3038 $saw_pbp = 1;
3039 }
3040
3041 # handle a new alias definition
3042 if ($newname) {
3043 if ($name) {
3044 $death_message =
3045"No '}' seen after $name and before $newname in config file $config_file line $.\n";
3046 last;
3047 }
3048 $name = $newname;
3049
3050 if ( ${$rexpansion}{$name} ) {
3051 local $" = ')(';
3052 my @names = sort keys %$rexpansion;
3053 $death_message =
3054 "Here is a list of all installed aliases\n(@names)\n"
3055 . "Attempting to redefine alias ($name) in config file $config_file line $.\n";
3056 last;
3057 }
3058 ${$rexpansion}{$name} = [];
3059 }
3060
3061 # now do the body
3062 if ($body) {
3063
3064 my ( $rbody_parts, $msg ) = parse_args($body);
3065 if ($msg) {
3066 $death_message = <<EOM;
3067Error reading file '$config_file' at line number $line_no.
3068$msg
3069Please fix this line or use -npro to avoid reading this file
3070EOM
3071 last;
3072 }
3073
3074 if ($name) {
3075
3076 # remove leading dashes if this is an alias
3077 foreach (@$rbody_parts) { s/^\-+//; }
3078 push @{ ${$rexpansion}{$name} }, @$rbody_parts;
3079 }
3080 else {
3081 push( @config_list, @$rbody_parts );
3082 }
3083 }
3084 }
3085 }
3086 eval { $fh->close() };
3087 return ( \@config_list, $death_message, $saw_pbp );
3088}
3089
3090sub strip_comment {
3091
3092 # Strip any comment from a command line
3093 my ( $instr, $config_file, $line_no ) = @_;
3094 my $msg = "";
3095
3096 # check for full-line comment
3097 if ( $instr =~ /^\s*#/ ) {
3098 return ( "", $msg );
3099 }
3100
3101 # nothing to do if no comments
3102 if ( $instr !~ /#/ ) {
3103 return ( $instr, $msg );
3104 }
3105
3106 # handle case of no quotes
3107 elsif ( $instr !~ /['"]/ ) {
3108
3109 # We now require a space before the # of a side comment
3110 # this allows something like:
3111 # -sbcp=#
3112 # Otherwise, it would have to be quoted:
3113 # -sbcp='#'
3114 $instr =~ s/\s+\#.*$//;
3115 return ( $instr, $msg );
3116 }
3117
3118 # handle comments and quotes
3119 my $outstr = "";
3120 my $quote_char = "";
3121 while (1) {
3122
3123 # looking for ending quote character
3124 if ($quote_char) {
3125 if ( $instr =~ /\G($quote_char)/gc ) {
3126 $quote_char = "";
3127 $outstr .= $1;
3128 }
3129 elsif ( $instr =~ /\G(.)/gc ) {
3130 $outstr .= $1;
3131 }
3132
3133 # error..we reached the end without seeing the ending quote char
3134 else {
3135 $msg = <<EOM;
3136Error reading file $config_file at line number $line_no.
3137Did not see ending quote character <$quote_char> in this text:
3138$instr
3139Please fix this line or use -npro to avoid reading this file
3140EOM
3141 last;
3142 }
3143 }
3144
3145 # accumulating characters and looking for start of a quoted string
3146 else {
3147 if ( $instr =~ /\G([\"\'])/gc ) {
3148 $outstr .= $1;
3149 $quote_char = $1;
3150 }
3151
3152 # Note: not yet enforcing the space-before-hash rule for side
3153 # comments if the parameter is quoted.
3154 elsif ( $instr =~ /\G#/gc ) {
3155 last;
3156 }
3157 elsif ( $instr =~ /\G(.)/gc ) {
3158 $outstr .= $1;
3159 }
3160 else {
3161 last;
3162 }
3163 }
3164 }
3165 return ( $outstr, $msg );
3166}
3167
3168sub parse_args {
3169
3170 # Parse a command string containing multiple string with possible
3171 # quotes, into individual commands. It might look like this, for example:
3172 #
3173 # -wba=" + - " -some-thing -wbb='. && ||'
3174 #
3175 # There is no need, at present, to handle escaped quote characters.
3176 # (They are not perltidy tokens, so needn't be in strings).
3177
3178 my ($body) = @_;
3179 my @body_parts = ();
3180 my $quote_char = "";
3181 my $part = "";
3182 my $msg = "";
3183 while (1) {
3184
3185 # looking for ending quote character
3186 if ($quote_char) {
3187 if ( $body =~ /\G($quote_char)/gc ) {
3188 $quote_char = "";
3189 }
3190 elsif ( $body =~ /\G(.)/gc ) {
3191 $part .= $1;
3192 }
3193
3194 # error..we reached the end without seeing the ending quote char
3195 else {
3196 if ( length($part) ) { push @body_parts, $part; }
3197 $msg = <<EOM;
3198Did not see ending quote character <$quote_char> in this text:
3199$body
3200EOM
3201 last;
3202 }
3203 }
3204
3205 # accumulating characters and looking for start of a quoted string
3206 else {
3207 if ( $body =~ /\G([\"\'])/gc ) {
3208 $quote_char = $1;
3209 }
3210 elsif ( $body =~ /\G(\s+)/gc ) {
3211 if ( length($part) ) { push @body_parts, $part; }
3212 $part = "";
3213 }
3214 elsif ( $body =~ /\G(.)/gc ) {
3215 $part .= $1;
3216 }
3217 else {
3218 if ( length($part) ) { push @body_parts, $part; }
3219 last;
3220 }
3221 }
3222 }
3223 return ( \@body_parts, $msg );
3224}
3225
3226sub dump_long_names {
3227
3228 my @names = sort @_;
3229 print STDOUT <<EOM;
3230# Command line long names (passed to GetOptions)
3231#---------------------------------------------------------------
3232# here is a summary of the Getopt codes:
3233# <none> does not take an argument
3234# =s takes a mandatory string
3235# :s takes an optional string
3236# =i takes a mandatory integer
3237# :i takes an optional integer
3238# ! does not take an argument and may be negated
3239# i.e., -foo and -nofoo are allowed
3240# a double dash signals the end of the options list
3241#
3242#---------------------------------------------------------------
3243EOM
3244
3245 foreach (@names) { print STDOUT "$_\n" }
3246}
3247
3248sub dump_defaults {
3249 my @defaults = sort @_;
3250 print STDOUT "Default command line options:\n";
3251 foreach (@_) { print STDOUT "$_\n" }
3252}
3253
3254sub readable_options {
3255
3256 # return options for this run as a string which could be
3257 # put in a perltidyrc file
3258 my ( $rOpts, $roption_string ) = @_;
3259 my %Getopt_flags;
3260 my $rGetopt_flags = \%Getopt_flags;
3261 my $readable_options = "# Final parameter set for this run.\n";
3262 $readable_options .=
3263 "# See utility 'perltidyrc_dump.pl' for nicer formatting.\n";
3264 foreach my $opt ( @{$roption_string} ) {
3265 my $flag = "";
3266 if ( $opt =~ /(.*)(!|=.*)$/ ) {
3267 $opt = $1;
3268 $flag = $2;
3269 }
3270 if ( defined( $rOpts->{$opt} ) ) {
3271 $rGetopt_flags->{$opt} = $flag;
3272 }
3273 }
3274 foreach my $key ( sort keys %{$rOpts} ) {
3275 my $flag = $rGetopt_flags->{$key};
3276 my $value = $rOpts->{$key};
3277 my $prefix = '--';
3278 my $suffix = "";
3279 if ($flag) {
3280 if ( $flag =~ /^=/ ) {
3281 if ( $value !~ /^\d+$/ ) { $value = '"' . $value . '"' }
3282 $suffix = "=" . $value;
3283 }
3284 elsif ( $flag =~ /^!/ ) {
3285 $prefix .= "no" unless ($value);
3286 }
3287 else {
3288
3289 # shouldn't happen
3290 $readable_options .=
3291 "# ERROR in dump_options: unrecognized flag $flag for $key\n";
3292 }
3293 }
3294 $readable_options .= $prefix . $key . $suffix . "\n";
3295 }
3296 return $readable_options;
3297}
3298
3299sub show_version {
3300 print STDOUT <<"EOM";
3301This is perltidy, v$VERSION
3302
3303Copyright 2000-2014, Steve Hancock
3304
3305Perltidy is free software and may be copied under the terms of the GNU
3306General Public License, which is included in the distribution files.
3307
3308Complete documentation for perltidy can be found using 'man perltidy'
3309or on the internet at http://perltidy.sourceforge.net.
3310EOM
3311}
3312
3313sub usage {
3314
3315 print STDOUT <<EOF;
3316This is perltidy version $VERSION, a perl script indenter. Usage:
3317
3318 perltidy [ options ] file1 file2 file3 ...
3319 (output goes to file1.tdy, file2.tdy, file3.tdy, ...)
3320 perltidy [ options ] file1 -o outfile
3321 perltidy [ options ] file1 -st >outfile
3322 perltidy [ options ] <infile >outfile
3323
3324Options have short and long forms. Short forms are shown; see
3325man pages for long forms. Note: '=s' indicates a required string,
3326and '=n' indicates a required integer.
3327
3328I/O control
3329 -h show this help
3330 -o=file name of the output file (only if single input file)
3331 -oext=s change output extension from 'tdy' to s
3332 -opath=path change path to be 'path' for output files
3333 -b backup original to .bak and modify file in-place
3334 -bext=s change default backup extension from 'bak' to s
3335 -q deactivate error messages (for running under editor)
3336 -w include non-critical warning messages in the .ERR error output
3337 -syn run perl -c to check syntax (default under unix systems)
3338 -log save .LOG file, which has useful diagnostics
3339 -f force perltidy to read a binary file
3340 -g like -log but writes more detailed .LOG file, for debugging scripts
3341 -opt write the set of options actually used to a .LOG file
3342 -npro ignore .perltidyrc configuration command file
3343 -pro=file read configuration commands from file instead of .perltidyrc
3344 -st send output to standard output, STDOUT
3345 -se send all error output to standard error output, STDERR
3346 -v display version number to standard output and quit
3347
3348Basic Options:
3349 -i=n use n columns per indentation level (default n=4)
3350 -t tabs: use one tab character per indentation level, not recommeded
3351 -nt no tabs: use n spaces per indentation level (default)
3352 -et=n entab leading whitespace n spaces per tab; not recommended
3353 -io "indent only": just do indentation, no other formatting.
3354 -sil=n set starting indentation level to n; use if auto detection fails
3355 -ole=s specify output line ending (s=dos or win, mac, unix)
3356 -ple keep output line endings same as input (input must be filename)
3357
3358Whitespace Control
3359 -fws freeze whitespace; this disables all whitespace changes
3360 and disables the following switches:
3361 -bt=n sets brace tightness, n= (0 = loose, 1=default, 2 = tight)
3362 -bbt same as -bt but for code block braces; same as -bt if not given
3363 -bbvt block braces vertically tight; use with -bl or -bli
3364 -bbvtl=s make -bbvt to apply to selected list of block types
3365 -pt=n paren tightness (n=0, 1 or 2)
3366 -sbt=n square bracket tightness (n=0, 1, or 2)
3367 -bvt=n brace vertical tightness,
3368 n=(0=open, 1=close unless multiple steps on a line, 2=always close)
3369 -pvt=n paren vertical tightness (see -bvt for n)
3370 -sbvt=n square bracket vertical tightness (see -bvt for n)
3371 -bvtc=n closing brace vertical tightness:
3372 n=(0=open, 1=sometimes close, 2=always close)
3373 -pvtc=n closing paren vertical tightness, see -bvtc for n.
3374 -sbvtc=n closing square bracket vertical tightness, see -bvtc for n.
3375 -ci=n sets continuation indentation=n, default is n=2 spaces
3376 -lp line up parentheses, brackets, and non-BLOCK braces
3377 -sfs add space before semicolon in for( ; ; )
3378 -aws allow perltidy to add whitespace (default)
3379 -dws delete all old non-essential whitespace
3380 -icb indent closing brace of a code block
3381 -cti=n closing indentation of paren, square bracket, or non-block brace:
3382 n=0 none, =1 align with opening, =2 one full indentation level
3383 -icp equivalent to -cti=2
3384 -wls=s want space left of tokens in string; i.e. -nwls='+ - * /'
3385 -wrs=s want space right of tokens in string;
3386 -sts put space before terminal semicolon of a statement
3387 -sak=s put space between keywords given in s and '(';
3388 -nsak=s no space between keywords in s and '('; i.e. -nsak='my our local'
3389
3390Line Break Control
3391 -fnl freeze newlines; this disables all line break changes
3392 and disables the following switches:
3393 -anl add newlines; ok to introduce new line breaks
3394 -bbs add blank line before subs and packages
3395 -bbc add blank line before block comments
3396 -bbb add blank line between major blocks
3397 -kbl=n keep old blank lines? 0=no, 1=some, 2=all
3398 -mbl=n maximum consecutive blank lines to output (default=1)
3399 -ce cuddled else; use this style: '} else {'
3400 -dnl delete old newlines (default)
3401 -l=n maximum line length; default n=80
3402 -bl opening brace on new line
3403 -sbl opening sub brace on new line. value of -bl is used if not given.
3404 -bli opening brace on new line and indented
3405 -bar opening brace always on right, even for long clauses
3406 -vt=n vertical tightness (requires -lp); n controls break after opening
3407 token: 0=never 1=no break if next line balanced 2=no break
3408 -vtc=n vertical tightness of closing container; n controls if closing
3409 token starts new line: 0=always 1=not unless list 1=never
3410 -wba=s want break after tokens in string; i.e. wba=': .'
3411 -wbb=s want break before tokens in string
3412
3413Following Old Breakpoints
3414 -kis keep interior semicolons. Allows multiple statements per line.
3415 -boc break at old comma breaks: turns off all automatic list formatting
3416 -bol break at old logical breakpoints: or, and, ||, && (default)
3417 -bok break at old list keyword breakpoints such as map, sort (default)
3418 -bot break at old conditional (ternary ?:) operator breakpoints (default)
3419 -boa break at old attribute breakpoints
3420 -cab=n break at commas after a comma-arrow (=>):
3421 n=0 break at all commas after =>
3422 n=1 stable: break unless this breaks an existing one-line container
3423 n=2 break only if a one-line container cannot be formed
3424 n=3 do not treat commas after => specially at all
3425
3426Comment controls
3427 -ibc indent block comments (default)
3428 -isbc indent spaced block comments; may indent unless no leading space
3429 -msc=n minimum desired spaces to side comment, default 4
3430 -fpsc=n fix position for side comments; default 0;
3431 -csc add or update closing side comments after closing BLOCK brace
3432 -dcsc delete closing side comments created by a -csc command
3433 -cscp=s change closing side comment prefix to be other than '## end'
3434 -cscl=s change closing side comment to apply to selected list of blocks
3435 -csci=n minimum number of lines needed to apply a -csc tag, default n=6
3436 -csct=n maximum number of columns of appended text, default n=20
3437 -cscw causes warning if old side comment is overwritten with -csc
3438
3439 -sbc use 'static block comments' identified by leading '##' (default)
3440 -sbcp=s change static block comment identifier to be other than '##'
3441 -osbc outdent static block comments
3442
3443 -ssc use 'static side comments' identified by leading '##' (default)
3444 -sscp=s change static side comment identifier to be other than '##'
3445
3446Delete selected text
3447 -dac delete all comments AND pod
3448 -dbc delete block comments
3449 -dsc delete side comments
3450 -dp delete pod
3451
3452Send selected text to a '.TEE' file
3453 -tac tee all comments AND pod
3454 -tbc tee block comments
3455 -tsc tee side comments
3456 -tp tee pod
3457
3458Outdenting
3459 -olq outdent long quoted strings (default)
3460 -olc outdent a long block comment line
3461 -ola outdent statement labels
3462 -okw outdent control keywords (redo, next, last, goto, return)
3463 -okwl=s specify alternative keywords for -okw command
3464
3465Other controls
3466 -mft=n maximum fields per table; default n=40
3467 -x do not format lines before hash-bang line (i.e., for VMS)
3468 -asc allows perltidy to add a ';' when missing (default)
3469 -dsm allows perltidy to delete an unnecessary ';' (default)
3470
3471Combinations of other parameters
3472 -gnu attempt to follow GNU Coding Standards as applied to perl
3473 -mangle remove as many newlines as possible (but keep comments and pods)
3474 -extrude insert as many newlines as possible
3475
3476Dump and die, debugging
3477 -dop dump options used in this run to standard output and quit
3478 -ddf dump default options to standard output and quit
3479 -dsn dump all option short names to standard output and quit
3480 -dln dump option long names to standard output and quit
3481 -dpro dump whatever configuration file is in effect to standard output
3482 -dtt dump all token types to standard output and quit
3483
3484HTML
3485 -html write an html file (see 'man perl2web' for many options)
3486 Note: when -html is used, no indentation or formatting are done.
3487 Hint: try perltidy -html -css=mystyle.css filename.pl
3488 and edit mystyle.css to change the appearance of filename.html.
3489 -nnn gives line numbers
3490 -pre only writes out <pre>..</pre> code section
3491 -toc places a table of contents to subs at the top (default)
3492 -pod passes pod text through pod2html (default)
3493 -frm write html as a frame (3 files)
3494 -text=s extra extension for table of contents if -frm, default='toc'
3495 -sext=s extra extension for file content if -frm, default='src'
3496
3497A prefix of "n" negates short form toggle switches, and a prefix of "no"
3498negates the long forms. For example, -nasc means don't add missing
3499semicolons.
3500
3501If you are unable to see this entire text, try "perltidy -h | more"
3502For more detailed information, and additional options, try "man perltidy",
3503or go to the perltidy home page at http://perltidy.sourceforge.net
3504EOF
3505
3506}
3507
3508sub process_this_file {
3509
3510 my ( $truth, $beauty ) = @_;
3511
3512 # loop to process each line of this file
3513 while ( my $line_of_tokens = $truth->get_line() ) {
3514 $beauty->write_line($line_of_tokens);
3515 }
3516
3517 # finish up
3518 eval { $beauty->finish_formatting() };
3519 $truth->report_tokenization_errors();
3520}
3521
3522sub check_syntax {
3523
3524 # Use 'perl -c' to make sure that we did not create bad syntax
3525 # This is a very good independent check for programming errors
3526 #
3527 # Given names of the input and output files, ($istream, $ostream),
3528 # we do the following:
3529 # - check syntax of the input file
3530 # - if bad, all done (could be an incomplete code snippet)
3531 # - if infile syntax ok, then check syntax of the output file;
3532 # - if outfile syntax bad, issue warning; this implies a code bug!
3533 # - set and return flag "infile_syntax_ok" : =-1 bad 0 unknown 1 good
3534
3535 my ( $istream, $ostream, $logger_object, $rOpts ) = @_;
3536 my $infile_syntax_ok = 0;
3537 my $line_of_dashes = '-' x 42 . "\n";
3538
3539 my $flags = $rOpts->{'perl-syntax-check-flags'};
3540
3541 # be sure we invoke perl with -c
3542 # note: perl will accept repeated flags like '-c -c'. It is safest
3543 # to append another -c than try to find an interior bundled c, as
3544 # in -Tc, because such a 'c' might be in a quoted string, for example.
3545 if ( $flags !~ /(^-c|\s+-c)/ ) { $flags .= " -c" }
3546
3547 # be sure we invoke perl with -x if requested
3548 # same comments about repeated parameters applies
3549 if ( $rOpts->{'look-for-hash-bang'} ) {
3550 if ( $flags !~ /(^-x|\s+-x)/ ) { $flags .= " -x" }
3551 }
3552
3553 # this shouldn't happen unless a temporary file couldn't be made
3554 if ( $istream eq '-' ) {
3555 $logger_object->write_logfile_entry(
3556 "Cannot run perl -c on STDIN and STDOUT\n");
3557 return $infile_syntax_ok;
3558 }
3559
3560 $logger_object->write_logfile_entry(
3561 "checking input file syntax with perl $flags\n");
3562
3563 # Not all operating systems/shells support redirection of the standard
3564 # error output.
3565 my $error_redirection = ( $^O eq 'VMS' ) ? "" : '2>&1';
3566
3567 my ( $istream_filename, $perl_output ) =
3568 do_syntax_check( $istream, $flags, $error_redirection );
3569 $logger_object->write_logfile_entry(
3570 "Input stream passed to Perl as file $istream_filename\n");
3571 $logger_object->write_logfile_entry($line_of_dashes);
3572 $logger_object->write_logfile_entry("$perl_output\n");
3573
3574 if ( $perl_output =~ /syntax\s*OK/ ) {
3575 $infile_syntax_ok = 1;
3576 $logger_object->write_logfile_entry($line_of_dashes);
3577 $logger_object->write_logfile_entry(
3578 "checking output file syntax with perl $flags ...\n");
3579 my ( $ostream_filename, $perl_output ) =
3580 do_syntax_check( $ostream, $flags, $error_redirection );
3581 $logger_object->write_logfile_entry(
3582 "Output stream passed to Perl as file $ostream_filename\n");
3583 $logger_object->write_logfile_entry($line_of_dashes);
3584 $logger_object->write_logfile_entry("$perl_output\n");
3585
3586 unless ( $perl_output =~ /syntax\s*OK/ ) {
3587 $logger_object->write_logfile_entry($line_of_dashes);
3588 $logger_object->warning(
3589"The output file has a syntax error when tested with perl $flags $ostream !\n"
3590 );
3591 $logger_object->warning(
3592 "This implies an error in perltidy; the file $ostream is bad\n"
3593 );
3594 $logger_object->report_definite_bug();
3595
3596 # the perl version number will be helpful for diagnosing the problem
3597 $logger_object->write_logfile_entry(
3598 qx/perl -v $error_redirection/ . "\n" );
3599 }
3600 }
3601 else {
3602
3603 # Only warn of perl -c syntax errors. Other messages,
3604 # such as missing modules, are too common. They can be
3605 # seen by running with perltidy -w
3606 $logger_object->complain("A syntax check using perl $flags\n");
3607 $logger_object->complain(
3608 "for the output in file $istream_filename gives:\n");
3609 $logger_object->complain($line_of_dashes);
3610 $logger_object->complain("$perl_output\n");
3611 $logger_object->complain($line_of_dashes);
3612 $infile_syntax_ok = -1;
3613 $logger_object->write_logfile_entry($line_of_dashes);
3614 $logger_object->write_logfile_entry(
3615"The output file will not be checked because of input file problems\n"
3616 );
3617 }
3618 return $infile_syntax_ok;
3619}
3620
3621sub do_syntax_check {
3622 my ( $stream, $flags, $error_redirection ) = @_;
3623
3624 # We need a named input file for executing perl
3625 my ( $stream_filename, $is_tmpfile ) = get_stream_as_named_file($stream);
3626
3627 # TODO: Need to add name of file to log somewhere
3628 # otherwise Perl output is hard to read
3629 if ( !$stream_filename ) { return $stream_filename, "" }
3630
3631 # We have to quote the filename in case it has unusual characters
3632 # or spaces. Example: this filename #CM11.pm# gives trouble.
3633 my $quoted_stream_filename = '"' . $stream_filename . '"';
3634
3635 # Under VMS something like -T will become -t (and an error) so we
3636 # will put quotes around the flags. Double quotes seem to work on
3637 # Unix/Windows/VMS, but this may not work on all systems. (Single
3638 # quotes do not work under Windows). It could become necessary to
3639 # put double quotes around each flag, such as: -"c" -"T"
3640 # We may eventually need some system-dependent coding here.
3641 $flags = '"' . $flags . '"';
3642
3643 # now wish for luck...
3644 my $msg = qx/perl $flags $quoted_stream_filename $error_redirection/;
3645
3646 unlink $stream_filename if ($is_tmpfile);
3647 return $stream_filename, $msg;
3648}
3649
3650#####################################################################
3651#
3652# This is a stripped down version of IO::Scalar
3653# Given a reference to a scalar, it supplies either:
3654# a getline method which reads lines (mode='r'), or
3655# a print method which reads lines (mode='w')
3656#
3657#####################################################################
3658package Perl::Tidy::IOScalar;
36592285┬Ás285┬Ás
# spent 48┬Ás (10+37) within Perl::Tidy::IOScalar::BEGIN@3659 which was called: # once (10┬Ás+37┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 3659
use Carp;
# spent 48┬Ás making 1 call to Perl::Tidy::IOScalar::BEGIN@3659 # spent 37┬Ás making 1 call to Exporter::import
3660
3661sub new {
3662 my ( $package, $rscalar, $mode ) = @_;
3663 my $ref = ref $rscalar;
3664 if ( $ref ne 'SCALAR' ) {
3665 confess <<EOM;
3666------------------------------------------------------------------------
3667expecting ref to SCALAR but got ref to ($ref); trace follows:
3668------------------------------------------------------------------------
3669EOM
3670
3671 }
3672 if ( $mode eq 'w' ) {
3673 $$rscalar = "";
3674 return bless [ $rscalar, $mode ], $package;
3675 }
3676 elsif ( $mode eq 'r' ) {
3677
3678 # Convert a scalar to an array.
3679 # This avoids looking for "\n" on each call to getline
3680 #
3681 # NOTES: The -1 count is needed to avoid loss of trailing blank lines
3682 # (which might be important in a DATA section).
3683 my @array;
3684 if ( $rscalar && ${$rscalar} ) {
3685 @array = map { $_ .= "\n" } split /\n/, ${$rscalar}, -1;
3686
3687 # remove possible extra blank line introduced with split
3688 if ( @array && $array[-1] eq "\n" ) { pop @array }
3689 }
3690 my $i_next = 0;
3691 return bless [ \@array, $mode, $i_next ], $package;
3692 }
3693 else {
3694 confess <<EOM;
3695------------------------------------------------------------------------
3696expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
3697------------------------------------------------------------------------
3698EOM
3699 }
3700}
3701
3702sub getline {
3703 my $self = shift;
3704 my $mode = $self->[1];
3705 if ( $mode ne 'r' ) {
3706 confess <<EOM;
3707------------------------------------------------------------------------
3708getline call requires mode = 'r' but mode = ($mode); trace follows:
3709------------------------------------------------------------------------
3710EOM
3711 }
3712 my $i = $self->[2]++;
3713 return $self->[0]->[$i];
3714}
3715
3716sub print {
3717 my $self = shift;
3718 my $mode = $self->[1];
3719 if ( $mode ne 'w' ) {
3720 confess <<EOM;
3721------------------------------------------------------------------------
3722print call requires mode = 'w' but mode = ($mode); trace follows:
3723------------------------------------------------------------------------
3724EOM
3725 }
3726 ${ $self->[0] } .= $_[0];
3727}
3728sub close { return }
3729
3730#####################################################################
3731#
3732# This is a stripped down version of IO::ScalarArray
3733# Given a reference to an array, it supplies either:
3734# a getline method which reads lines (mode='r'), or
3735# a print method which reads lines (mode='w')
3736#
3737# NOTE: this routine assumes that there aren't any embedded
3738# newlines within any of the array elements. There are no checks
3739# for that.
3740#
3741#####################################################################
3742package Perl::Tidy::IOScalarArray;
374321.74ms269┬Ás
# spent 39┬Ás (9+30) within Perl::Tidy::IOScalarArray::BEGIN@3743 which was called: # once (9┬Ás+30┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 3743
use Carp;
# spent 39┬Ás making 1 call to Perl::Tidy::IOScalarArray::BEGIN@3743 # spent 30┬Ás making 1 call to Exporter::import
3744
3745sub new {
3746 my ( $package, $rarray, $mode ) = @_;
3747 my $ref = ref $rarray;
3748 if ( $ref ne 'ARRAY' ) {
3749 confess <<EOM;
3750------------------------------------------------------------------------
3751expecting ref to ARRAY but got ref to ($ref); trace follows:
3752------------------------------------------------------------------------
3753EOM
3754
3755 }
3756 if ( $mode eq 'w' ) {
3757 @$rarray = ();
3758 return bless [ $rarray, $mode ], $package;
3759 }
3760 elsif ( $mode eq 'r' ) {
3761 my $i_next = 0;
3762 return bless [ $rarray, $mode, $i_next ], $package;
3763 }
3764 else {
3765 confess <<EOM;
3766------------------------------------------------------------------------
3767expecting mode = 'r' or 'w' but got mode ($mode); trace follows:
3768------------------------------------------------------------------------
3769EOM
3770 }
3771}
3772
3773sub getline {
3774 my $self = shift;
3775 my $mode = $self->[1];
3776 if ( $mode ne 'r' ) {
3777 confess <<EOM;
3778------------------------------------------------------------------------
3779getline requires mode = 'r' but mode = ($mode); trace follows:
3780------------------------------------------------------------------------
3781EOM
3782 }
3783 my $i = $self->[2]++;
3784 return $self->[0]->[$i];
3785}
3786
3787sub print {
3788 my $self = shift;
3789 my $mode = $self->[1];
3790 if ( $mode ne 'w' ) {
3791 confess <<EOM;
3792------------------------------------------------------------------------
3793print requires mode = 'w' but mode = ($mode); trace follows:
3794------------------------------------------------------------------------
3795EOM
3796 }
3797 push @{ $self->[0] }, $_[0];
3798}
3799sub close { return }
3800
3801#####################################################################
3802#
3803# the Perl::Tidy::LineSource class supplies an object with a 'get_line()' method
3804# which returns the next line to be parsed
3805#
3806#####################################################################
3807
3808package Perl::Tidy::LineSource;
3809
3810sub new {
3811
3812 my ( $class, $input_file, $rOpts, $rpending_logfile_message ) = @_;
3813
3814 my $input_line_ending;
3815 if ( $rOpts->{'preserve-line-endings'} ) {
3816 $input_line_ending = Perl::Tidy::find_input_line_ending($input_file);
3817 }
3818
3819 ( my $fh, $input_file ) = Perl::Tidy::streamhandle( $input_file, 'r' );
3820 return undef unless $fh;
3821
3822 # in order to check output syntax when standard output is used,
3823 # or when it is an object, we have to make a copy of the file
3824 if ( ( $input_file eq '-' || ref $input_file ) && $rOpts->{'check-syntax'} )
3825 {
3826
3827 # Turning off syntax check when input output is used.
3828 # The reason is that temporary files cause problems on
3829 # on many systems.
3830 $rOpts->{'check-syntax'} = 0;
3831
3832 $$rpending_logfile_message .= <<EOM;
3833Note: --syntax check will be skipped because standard input is used
3834EOM
3835
3836 }
3837
3838 return bless {
3839 _fh => $fh,
3840 _filename => $input_file,
3841 _input_line_ending => $input_line_ending,
3842 _rinput_buffer => [],
3843 _started => 0,
3844 }, $class;
3845}
3846
3847sub close_input_file {
3848 my $self = shift;
3849
3850 # Only close physical files, not STDIN and other objects
3851 my $filename = $self->{_filename};
3852 if ( $filename ne '-' && !ref $filename ) {
3853 eval { $self->{_fh}->close() };
3854 }
3855}
3856
3857sub get_line {
3858 my $self = shift;
3859 my $line = undef;
3860 my $fh = $self->{_fh};
3861 my $rinput_buffer = $self->{_rinput_buffer};
3862
3863 if ( scalar(@$rinput_buffer) ) {
3864 $line = shift @$rinput_buffer;
3865 }
3866 else {
3867 $line = $fh->getline();
3868
3869 # patch to read raw mac files under unix, dos
3870 # see if the first line has embedded \r's
3871 if ( $line && !$self->{_started} ) {
3872 if ( $line =~ /[\015][^\015\012]/ ) {
3873
3874 # found one -- break the line up and store in a buffer
3875 @$rinput_buffer = map { $_ . "\n" } split /\015/, $line;
3876 my $count = @$rinput_buffer;
3877 $line = shift @$rinput_buffer;
3878 }
3879 $self->{_started}++;
3880 }
3881 }
3882 return $line;
3883}
3884
3885#####################################################################
3886#
3887# the Perl::Tidy::LineSink class supplies a write_line method for
3888# actual file writing
3889#
3890#####################################################################
3891
3892package Perl::Tidy::LineSink;
3893
3894sub new {
3895
3896 my ( $class, $output_file, $tee_file, $line_separator, $rOpts,
3897 $rpending_logfile_message, $binmode )
3898 = @_;
3899 my $fh = undef;
3900 my $fh_tee = undef;
3901
3902 my $output_file_open = 0;
3903
3904 if ( $rOpts->{'format'} eq 'tidy' ) {
3905 ( $fh, $output_file ) = Perl::Tidy::streamhandle( $output_file, 'w' );
3906 unless ($fh) { Perl::Tidy::Die "Cannot write to output stream\n"; }
3907 $output_file_open = 1;
3908 if ($binmode) {
3909 if ( ref($fh) eq 'IO::File' ) {
3910 binmode $fh;
3911 }
3912 if ( $output_file eq '-' ) { binmode STDOUT }
3913 }
3914 }
3915
3916 # in order to check output syntax when standard output is used,
3917 # or when it is an object, we have to make a copy of the file
3918 if ( $output_file eq '-' || ref $output_file ) {
3919 if ( $rOpts->{'check-syntax'} ) {
3920
3921 # Turning off syntax check when standard output is used.
3922 # The reason is that temporary files cause problems on
3923 # on many systems.
3924 $rOpts->{'check-syntax'} = 0;
3925 $$rpending_logfile_message .= <<EOM;
3926Note: --syntax check will be skipped because standard output is used
3927EOM
3928
3929 }
3930 }
3931
3932 bless {
3933 _fh => $fh,
3934 _fh_tee => $fh_tee,
3935 _output_file => $output_file,
3936 _output_file_open => $output_file_open,
3937 _tee_flag => 0,
3938 _tee_file => $tee_file,
3939 _tee_file_opened => 0,
3940 _line_separator => $line_separator,
3941 _binmode => $binmode,
3942 }, $class;
3943}
3944
3945sub write_line {
3946
3947 my $self = shift;
3948 my $fh = $self->{_fh};
3949
3950 my $output_file_open = $self->{_output_file_open};
3951 chomp $_[0];
3952 $_[0] .= $self->{_line_separator};
3953
3954 $fh->print( $_[0] ) if ( $self->{_output_file_open} );
3955
3956 if ( $self->{_tee_flag} ) {
3957 unless ( $self->{_tee_file_opened} ) { $self->really_open_tee_file() }
3958 my $fh_tee = $self->{_fh_tee};
3959 print $fh_tee $_[0];
3960 }
3961}
3962
3963sub tee_on {
3964 my $self = shift;
3965 $self->{_tee_flag} = 1;
3966}
3967
3968sub tee_off {
3969 my $self = shift;
3970 $self->{_tee_flag} = 0;
3971}
3972
3973sub really_open_tee_file {
3974 my $self = shift;
3975 my $tee_file = $self->{_tee_file};
3976 my $fh_tee;
3977 $fh_tee = IO::File->new(">$tee_file")
3978 or Perl::Tidy::Die("couldn't open TEE file $tee_file: $!\n");
3979 binmode $fh_tee if $self->{_binmode};
3980 $self->{_tee_file_opened} = 1;
3981 $self->{_fh_tee} = $fh_tee;
3982}
3983
3984sub close_output_file {
3985 my $self = shift;
3986
3987 # Only close physical files, not STDOUT and other objects
3988 my $output_file = $self->{_output_file};
3989 if ( $output_file ne '-' && !ref $output_file ) {
3990 eval { $self->{_fh}->close() } if $self->{_output_file_open};
3991 }
3992 $self->close_tee_file();
3993}
3994
3995sub close_tee_file {
3996 my $self = shift;
3997
3998 # Only close physical files, not STDOUT and other objects
3999 if ( $self->{_tee_file_opened} ) {
4000 my $tee_file = $self->{_tee_file};
4001 if ( $tee_file ne '-' && !ref $tee_file ) {
4002 eval { $self->{_fh_tee}->close() };
4003 $self->{_tee_file_opened} = 0;
4004 }
4005 }
4006}
4007
4008#####################################################################
4009#
4010# The Perl::Tidy::Diagnostics class writes the DIAGNOSTICS file, which is
4011# useful for program development.
4012#
4013# Only one such file is created regardless of the number of input
4014# files processed. This allows the results of processing many files
4015# to be summarized in a single file.
4016#
4017#####################################################################
4018
4019package Perl::Tidy::Diagnostics;
4020
4021sub new {
4022
4023 my $class = shift;
4024 bless {
4025 _write_diagnostics_count => 0,
4026 _last_diagnostic_file => "",
4027 _input_file => "",
4028 _fh => undef,
4029 }, $class;
4030}
4031
4032sub set_input_file {
4033 my $self = shift;
4034 $self->{_input_file} = $_[0];
4035}
4036
4037# This is a diagnostic routine which is useful for program development.
4038# Output from debug messages go to a file named DIAGNOSTICS, where
4039# they are labeled by file and line. This allows many files to be
4040# scanned at once for some particular condition of interest.
4041sub write_diagnostics {
4042 my $self = shift;
4043
4044 unless ( $self->{_write_diagnostics_count} ) {
4045 open DIAGNOSTICS, ">DIAGNOSTICS"
4046 or death("couldn't open DIAGNOSTICS: $!\n");
4047 }
4048
4049 my $last_diagnostic_file = $self->{_last_diagnostic_file};
4050 my $input_file = $self->{_input_file};
4051 if ( $last_diagnostic_file ne $input_file ) {
4052 print DIAGNOSTICS "\nFILE:$input_file\n";
4053 }
4054 $self->{_last_diagnostic_file} = $input_file;
4055 my $input_line_number = Perl::Tidy::Tokenizer::get_input_line_number();
4056 print DIAGNOSTICS "$input_line_number:\t@_";
4057 $self->{_write_diagnostics_count}++;
4058}
4059
4060#####################################################################
4061#
4062# The Perl::Tidy::Logger class writes the .LOG and .ERR files
4063#
4064#####################################################################
4065
4066package Perl::Tidy::Logger;
4067
4068sub new {
4069 my $class = shift;
4070 my $fh;
4071 my ( $rOpts, $log_file, $warning_file, $fh_stderr, $saw_extrude, ) = @_;
4072
4073 my $fh_warnings = $rOpts->{'standard-error-output'} ? $fh_stderr : undef;
4074
4075 # remove any old error output file if we might write a new one
4076 unless ( $fh_warnings || ref($warning_file) ) {
4077 if ( -e $warning_file ) { unlink($warning_file) }
4078 }
4079
4080 my $logfile_gap =
4081 defined( $rOpts->{'logfile-gap'} )
4082 ? $rOpts->{'logfile-gap'}
4083 : 50;
4084 if ( $logfile_gap == 0 ) { $logfile_gap = 1 }
4085
4086 bless {
4087 _log_file => $log_file,
4088 _logfile_gap => $logfile_gap,
4089 _rOpts => $rOpts,
4090 _fh_warnings => $fh_warnings,
4091 _last_input_line_written => 0,
4092 _at_end_of_file => 0,
4093 _use_prefix => 1,
4094 _block_log_output => 0,
4095 _line_of_tokens => undef,
4096 _output_line_number => undef,
4097 _wrote_line_information_string => 0,
4098 _wrote_column_headings => 0,
4099 _warning_file => $warning_file,
4100 _warning_count => 0,
4101 _complaint_count => 0,
4102 _saw_code_bug => -1, # -1=no 0=maybe 1=for sure
4103 _saw_brace_error => 0,
4104 _saw_extrude => $saw_extrude,
4105 _output_array => [],
4106 }, $class;
4107}
4108
4109sub get_warning_count {
4110 my $self = shift;
4111 return $self->{_warning_count};
4112}
4113
4114sub get_use_prefix {
4115 my $self = shift;
4116 return $self->{_use_prefix};
4117}
4118
4119sub block_log_output {
4120 my $self = shift;
4121 $self->{_block_log_output} = 1;
4122}
4123
4124sub unblock_log_output {
4125 my $self = shift;
4126 $self->{_block_log_output} = 0;
4127}
4128
4129sub interrupt_logfile {
4130 my $self = shift;
4131 $self->{_use_prefix} = 0;
4132 $self->warning("\n");
4133 $self->write_logfile_entry( '#' x 24 . " WARNING " . '#' x 25 . "\n" );
4134}
4135
4136sub resume_logfile {
4137 my $self = shift;
4138 $self->write_logfile_entry( '#' x 60 . "\n" );
4139 $self->{_use_prefix} = 1;
4140}
4141
4142sub we_are_at_the_last_line {
4143 my $self = shift;
4144 unless ( $self->{_wrote_line_information_string} ) {
4145 $self->write_logfile_entry("Last line\n\n");
4146 }
4147 $self->{_at_end_of_file} = 1;
4148}
4149
4150# record some stuff in case we go down in flames
4151sub black_box {
4152 my $self = shift;
4153 my ( $line_of_tokens, $output_line_number ) = @_;
4154 my $input_line = $line_of_tokens->{_line_text};
4155 my $input_line_number = $line_of_tokens->{_line_number};
4156
4157 # save line information in case we have to write a logfile message
4158 $self->{_line_of_tokens} = $line_of_tokens;
4159 $self->{_output_line_number} = $output_line_number;
4160 $self->{_wrote_line_information_string} = 0;
4161
4162 my $last_input_line_written = $self->{_last_input_line_written};
4163 my $rOpts = $self->{_rOpts};
4164 if (
4165 (
4166 ( $input_line_number - $last_input_line_written ) >=
4167 $self->{_logfile_gap}
4168 )
4169 || ( $input_line =~ /^\s*(sub|package)\s+(\w+)/ )
4170 )
4171 {
4172 my $rlevels = $line_of_tokens->{_rlevels};
4173 my $structural_indentation_level = $$rlevels[0];
4174 $self->{_last_input_line_written} = $input_line_number;
4175 ( my $out_str = $input_line ) =~ s/^\s*//;
4176 chomp $out_str;
4177
4178 $out_str = ( '.' x $structural_indentation_level ) . $out_str;
4179
4180 if ( length($out_str) > 35 ) {
4181 $out_str = substr( $out_str, 0, 35 ) . " ....";
4182 }
4183 $self->logfile_output( "", "$out_str\n" );
4184 }
4185}
4186
4187sub write_logfile_entry {
4188 my $self = shift;
4189
4190 # add leading >>> to avoid confusing error messages and code
4191 $self->logfile_output( ">>>", "@_" );
4192}
4193
4194sub write_column_headings {
4195 my $self = shift;
4196
4197 $self->{_wrote_column_headings} = 1;
4198 my $routput_array = $self->{_output_array};
4199 push @{$routput_array}, <<EOM;
4200The nesting depths in the table below are at the start of the lines.
4201The indicated output line numbers are not always exact.
4202ci = levels of continuation indentation; bk = 1 if in BLOCK, 0 if not.
4203
4204in:out indent c b nesting code + messages; (messages begin with >>>)
4205lines levels i k (code begins with one '.' per indent level)
4206------ ----- - - -------- -------------------------------------------
4207EOM
4208}
4209
4210sub make_line_information_string {
4211
4212 # make columns of information when a logfile message needs to go out
4213 my $self = shift;
4214 my $line_of_tokens = $self->{_line_of_tokens};
4215 my $input_line_number = $line_of_tokens->{_line_number};
4216 my $line_information_string = "";
4217 if ($input_line_number) {
4218
4219 my $output_line_number = $self->{_output_line_number};
4220 my $brace_depth = $line_of_tokens->{_curly_brace_depth};
4221 my $paren_depth = $line_of_tokens->{_paren_depth};
4222 my $square_bracket_depth = $line_of_tokens->{_square_bracket_depth};
4223 my $guessed_indentation_level =
4224 $line_of_tokens->{_guessed_indentation_level};
4225 my $rlevels = $line_of_tokens->{_rlevels};
4226 my $rnesting_tokens = $line_of_tokens->{_rnesting_tokens};
4227 my $rci_levels = $line_of_tokens->{_rci_levels};
4228 my $rnesting_blocks = $line_of_tokens->{_rnesting_blocks};
4229
4230 my $structural_indentation_level = $$rlevels[0];
4231
4232 $self->write_column_headings() unless $self->{_wrote_column_headings};
4233
4234 # keep logfile columns aligned for scripts up to 999 lines;
4235 # for longer scripts it doesn't really matter
4236 my $extra_space = "";
4237 $extra_space .=
4238 ( $input_line_number < 10 ) ? " "
4239 : ( $input_line_number < 100 ) ? " "
4240 : "";
4241 $extra_space .=
4242 ( $output_line_number < 10 ) ? " "
4243 : ( $output_line_number < 100 ) ? " "
4244 : "";
4245
4246 # there are 2 possible nesting strings:
4247 # the original which looks like this: (0 [1 {2
4248 # the new one, which looks like this: {{[
4249 # the new one is easier to read, and shows the order, but
4250 # could be arbitrarily long, so we use it unless it is too long
4251 my $nesting_string =
4252 "($paren_depth [$square_bracket_depth {$brace_depth";
4253 my $nesting_string_new = $$rnesting_tokens[0];
4254
4255 my $ci_level = $$rci_levels[0];
4256 if ( $ci_level > 9 ) { $ci_level = '*' }
4257 my $bk = ( $$rnesting_blocks[0] =~ /1$/ ) ? '1' : '0';
4258
4259 if ( length($nesting_string_new) <= 8 ) {
4260 $nesting_string =
4261 $nesting_string_new . " " x ( 8 - length($nesting_string_new) );
4262 }
4263 $line_information_string =
4264"L$input_line_number:$output_line_number$extra_space i$guessed_indentation_level:$structural_indentation_level $ci_level $bk $nesting_string";
4265 }
4266 return $line_information_string;
4267}
4268
4269sub logfile_output {
4270 my $self = shift;
4271 my ( $prompt, $msg ) = @_;
4272 return if ( $self->{_block_log_output} );
4273
4274 my $routput_array = $self->{_output_array};
4275 if ( $self->{_at_end_of_file} || !$self->{_use_prefix} ) {
4276 push @{$routput_array}, "$msg";
4277 }
4278 else {
4279 my $line_information_string = $self->make_line_information_string();
4280 $self->{_wrote_line_information_string} = 1;
4281
4282 if ($line_information_string) {
4283 push @{$routput_array}, "$line_information_string $prompt$msg";
4284 }
4285 else {
4286 push @{$routput_array}, "$msg";
4287 }
4288 }
4289}
4290
4291sub get_saw_brace_error {
4292 my $self = shift;
4293 return $self->{_saw_brace_error};
4294}
4295
4296sub increment_brace_error {
4297 my $self = shift;
4298 $self->{_saw_brace_error}++;
4299}
4300
4301sub brace_warning {
4302 my $self = shift;
43032128┬Ás2115┬Ás
# spent 63┬Ás (10+52) within Perl::Tidy::Logger::BEGIN@4303 which was called: # once (10┬Ás+52┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4303
use constant BRACE_WARNING_LIMIT => 10;
# spent 63┬Ás making 1 call to Perl::Tidy::Logger::BEGIN@4303 # spent 52┬Ás making 1 call to constant::import
4304 my $saw_brace_error = $self->{_saw_brace_error};
4305
4306 if ( $saw_brace_error < BRACE_WARNING_LIMIT ) {
4307 $self->warning(@_);
4308 }
4309 $saw_brace_error++;
4310 $self->{_saw_brace_error} = $saw_brace_error;
4311
4312 if ( $saw_brace_error == BRACE_WARNING_LIMIT ) {
4313 $self->warning("No further warnings of this type will be given\n");
4314 }
4315}
4316
4317sub complain {
4318
4319 # handle non-critical warning messages based on input flag
4320 my $self = shift;
4321 my $rOpts = $self->{_rOpts};
4322
4323 # these appear in .ERR output only if -w flag is used
4324 if ( $rOpts->{'warning-output'} ) {
4325 $self->warning(@_);
4326 }
4327
4328 # otherwise, they go to the .LOG file
4329 else {
4330 $self->{_complaint_count}++;
4331 $self->write_logfile_entry(@_);
4332 }
4333}
4334
4335sub warning {
4336
4337 # report errors to .ERR file (or stdout)
4338 my $self = shift;
43392578┬Ás283┬Ás
# spent 45┬Ás (8+38) within Perl::Tidy::Logger::BEGIN@4339 which was called: # once (8┬Ás+38┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4339
use constant WARNING_LIMIT => 50;
# spent 45┬Ás making 1 call to Perl::Tidy::Logger::BEGIN@4339 # spent 38┬Ás making 1 call to constant::import
4340
4341 my $rOpts = $self->{_rOpts};
4342 unless ( $rOpts->{'quiet'} ) {
4343
4344 my $warning_count = $self->{_warning_count};
4345 my $fh_warnings = $self->{_fh_warnings};
4346 if ( !$fh_warnings ) {
4347 my $warning_file = $self->{_warning_file};
4348 ( $fh_warnings, my $filename ) =
4349 Perl::Tidy::streamhandle( $warning_file, 'w' );
4350 $fh_warnings or Perl::Tidy::Die("couldn't open $filename $!\n");
4351 Perl::Tidy::Warn "## Please see file $filename\n"
4352 unless ref($warning_file);
4353 $self->{_fh_warnings} = $fh_warnings;
4354 }
4355
4356 if ( $warning_count < WARNING_LIMIT ) {
4357 if ( $self->get_use_prefix() > 0 ) {
4358 my $input_line_number =
4359 Perl::Tidy::Tokenizer::get_input_line_number();
4360 if ( !defined($input_line_number) ) { $input_line_number = -1 }
4361 $fh_warnings->print("$input_line_number:\t@_");
4362 $self->write_logfile_entry("WARNING: @_");
4363 }
4364 else {
4365 $fh_warnings->print(@_);
4366 $self->write_logfile_entry(@_);
4367 }
4368 }
4369 $warning_count++;
4370 $self->{_warning_count} = $warning_count;
4371
4372 if ( $warning_count == WARNING_LIMIT ) {
4373 $fh_warnings->print("No further warnings will be given\n");
4374 }
4375 }
4376}
4377
4378# programming bug codes:
4379# -1 = no bug
4380# 0 = maybe, not sure.
4381# 1 = definitely
4382sub report_possible_bug {
4383 my $self = shift;
4384 my $saw_code_bug = $self->{_saw_code_bug};
4385 $self->{_saw_code_bug} = ( $saw_code_bug < 0 ) ? 0 : $saw_code_bug;
4386}
4387
4388sub report_definite_bug {
4389 my $self = shift;
4390 $self->{_saw_code_bug} = 1;
4391}
4392
4393sub ask_user_for_bug_report {
4394 my $self = shift;
4395
4396 my ( $infile_syntax_ok, $formatter ) = @_;
4397 my $saw_code_bug = $self->{_saw_code_bug};
4398 if ( ( $saw_code_bug == 0 ) && ( $infile_syntax_ok == 1 ) ) {
4399 $self->warning(<<EOM);
4400
4401You may have encountered a code bug in perltidy. If you think so, and
4402the problem is not listed in the BUGS file at
4403http://perltidy.sourceforge.net, please report it so that it can be
4404corrected. Include the smallest possible script which has the problem,
4405along with the .LOG file. See the manual pages for contact information.
4406Thank you!
4407EOM
4408
4409 }
4410 elsif ( $saw_code_bug == 1 ) {
4411 if ( $self->{_saw_extrude} ) {
4412 $self->warning(<<EOM);
4413
4414You may have encountered a bug in perltidy. However, since you are using the
4415-extrude option, the problem may be with perl or one of its modules, which have
4416occasional problems with this type of file. If you believe that the
4417problem is with perltidy, and the problem is not listed in the BUGS file at
4418http://perltidy.sourceforge.net, please report it so that it can be corrected.
4419Include the smallest possible script which has the problem, along with the .LOG
4420file. See the manual pages for contact information.
4421Thank you!
4422EOM
4423 }
4424 else {
4425 $self->warning(<<EOM);
4426
4427Oops, you seem to have encountered a bug in perltidy. Please check the
4428BUGS file at http://perltidy.sourceforge.net. If the problem is not
4429listed there, please report it so that it can be corrected. Include the
4430smallest possible script which produces this message, along with the
4431.LOG file if appropriate. See the manual pages for contact information.
4432Your efforts are appreciated.
4433Thank you!
4434EOM
4435 my $added_semicolon_count = 0;
4436 eval {
4437 $added_semicolon_count =
4438 $formatter->get_added_semicolon_count();
4439 };
4440 if ( $added_semicolon_count > 0 ) {
4441 $self->warning(<<EOM);
4442
4443The log file shows that perltidy added $added_semicolon_count semicolons.
4444Please rerun with -nasc to see if that is the cause of the syntax error. Even
4445if that is the problem, please report it so that it can be fixed.
4446EOM
4447
4448 }
4449 }
4450 }
4451}
4452
4453sub finish {
4454
4455 # called after all formatting to summarize errors
4456 my $self = shift;
4457 my ( $infile_syntax_ok, $formatter ) = @_;
4458
4459 my $rOpts = $self->{_rOpts};
4460 my $warning_count = $self->{_warning_count};
4461 my $saw_code_bug = $self->{_saw_code_bug};
4462
4463 my $save_logfile =
4464 ( $saw_code_bug == 0 && $infile_syntax_ok == 1 )
4465 || $saw_code_bug == 1
4466 || $rOpts->{'logfile'};
4467 my $log_file = $self->{_log_file};
4468 if ($warning_count) {
4469 if ($save_logfile) {
4470 $self->block_log_output(); # avoid echoing this to the logfile
4471 $self->warning(
4472 "The logfile $log_file may contain useful information\n");
4473 $self->unblock_log_output();
4474 }
4475
4476 if ( $self->{_complaint_count} > 0 ) {
4477 $self->warning(
4478"To see $self->{_complaint_count} non-critical warnings rerun with -w\n"
4479 );
4480 }
4481
4482 if ( $self->{_saw_brace_error}
4483 && ( $self->{_logfile_gap} > 1 || !$save_logfile ) )
4484 {
4485 $self->warning("To save a full .LOG file rerun with -g\n");
4486 }
4487 }
4488 $self->ask_user_for_bug_report( $infile_syntax_ok, $formatter );
4489
4490 if ($save_logfile) {
4491 my $log_file = $self->{_log_file};
4492 my ( $fh, $filename ) = Perl::Tidy::streamhandle( $log_file, 'w' );
4493 if ($fh) {
4494 my $routput_array = $self->{_output_array};
4495 foreach ( @{$routput_array} ) { $fh->print($_) }
4496 if ( $log_file ne '-' && !ref $log_file ) {
4497 eval { $fh->close() };
4498 }
4499 }
4500 }
4501}
4502
4503#####################################################################
4504#
4505# The Perl::Tidy::DevNull class supplies a dummy print method
4506#
4507#####################################################################
4508
4509package Perl::Tidy::DevNull;
4510sub new { return bless {}, $_[0] }
4511sub print { return }
4512sub close { return }
4513
4514#####################################################################
4515#
4516# The Perl::Tidy::HtmlWriter class writes a copy of the input stream in html
4517#
4518#####################################################################
4519
4520package Perl::Tidy::HtmlWriter;
4521
4522238┬Ás280┬Ás
# spent 45┬Ás (10+35) within Perl::Tidy::HtmlWriter::BEGIN@4522 which was called: # once (10┬Ás+35┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4522
use File::Basename;
# spent 45┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4522 # spent 35┬Ás making 1 call to Exporter::import
4523
4524# class variables
45251600ns
# spent 110┬Ás (9+101) within Perl::Tidy::HtmlWriter::BEGIN@4525 which was called: # once (9┬Ás+101┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4535
use vars qw{
4526 %html_color
4527 %html_bold
4528 %html_italic
4529 %token_short_names
4530 %short_to_long_names
4531 $rOpts
4532 $css_filename
4533 $css_linkname
4534 $missing_html_entities
45351765┬Ás2211┬Ás};
# spent 110┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4525 # spent 101┬Ás making 1 call to vars::import
4536
4537# replace unsafe characters with HTML entity representation if HTML::Entities
4538# is available
4539334┬Ás{ eval "use HTML::Entities"; $missing_html_entities = $@; }
# spent 125┬Ás executing statements in string eval
# includes 3.00ms spent executing 1 call to 1 sub defined therein.
4540
4541sub new {
4542
4543 my ( $class, $input_file, $html_file, $extension, $html_toc_extension,
4544 $html_src_extension )
4545 = @_;
4546
4547 my $html_file_opened = 0;
4548 my $html_fh;
4549 ( $html_fh, my $html_filename ) =
4550 Perl::Tidy::streamhandle( $html_file, 'w' );
4551 unless ($html_fh) {
4552 Perl::Tidy::Warn("can't open $html_file: $!\n");
4553 return undef;
4554 }
4555 $html_file_opened = 1;
4556
4557 if ( !$input_file || $input_file eq '-' || ref($input_file) ) {
4558 $input_file = "NONAME";
4559 }
4560
4561 # write the table of contents to a string
4562 my $toc_string;
4563 my $html_toc_fh = Perl::Tidy::IOScalar->new( \$toc_string, 'w' );
4564
4565 my $html_pre_fh;
4566 my @pre_string_stack;
4567 if ( $rOpts->{'html-pre-only'} ) {
4568
4569 # pre section goes directly to the output stream
4570 $html_pre_fh = $html_fh;
4571 $html_pre_fh->print( <<"PRE_END");
4572<pre>
4573PRE_END
4574 }
4575 else {
4576
4577 # pre section go out to a temporary string
4578 my $pre_string;
4579 $html_pre_fh = Perl::Tidy::IOScalar->new( \$pre_string, 'w' );
4580 push @pre_string_stack, \$pre_string;
4581 }
4582
4583 # pod text gets diverted if the 'pod2html' is used
4584 my $html_pod_fh;
4585 my $pod_string;
4586 if ( $rOpts->{'pod2html'} ) {
4587 if ( $rOpts->{'html-pre-only'} ) {
4588 undef $rOpts->{'pod2html'};
4589 }
4590 else {
4591 eval "use Pod::Html";
4592 if ($@) {
4593 Perl::Tidy::Warn
4594"unable to find Pod::Html; cannot use pod2html\n-npod disables this message\n";
4595 undef $rOpts->{'pod2html'};
4596 }
4597 else {
4598 $html_pod_fh = Perl::Tidy::IOScalar->new( \$pod_string, 'w' );
4599 }
4600 }
4601 }
4602
4603 my $toc_filename;
4604 my $src_filename;
4605 if ( $rOpts->{'frames'} ) {
4606 unless ($extension) {
4607 Perl::Tidy::Warn
4608"cannot use frames without a specified output extension; ignoring -frm\n";
4609 undef $rOpts->{'frames'};
4610 }
4611 else {
4612 $toc_filename = $input_file . $html_toc_extension . $extension;
4613 $src_filename = $input_file . $html_src_extension . $extension;
4614 }
4615 }
4616
4617 # ----------------------------------------------------------
4618 # Output is now directed as follows:
4619 # html_toc_fh <-- table of contents items
4620 # html_pre_fh <-- the <pre> section of formatted code, except:
4621 # html_pod_fh <-- pod goes here with the pod2html option
4622 # ----------------------------------------------------------
4623
4624 my $title = $rOpts->{'title'};
4625 unless ($title) {
4626 ( $title, my $path ) = fileparse($input_file);
4627 }
4628 my $toc_item_count = 0;
4629 my $in_toc_package = "";
4630 my $last_level = 0;
4631 bless {
4632 _input_file => $input_file, # name of input file
4633 _title => $title, # title, unescaped
4634 _html_file => $html_file, # name of .html output file
4635 _toc_filename => $toc_filename, # for frames option
4636 _src_filename => $src_filename, # for frames option
4637 _html_file_opened => $html_file_opened, # a flag
4638 _html_fh => $html_fh, # the output stream
4639 _html_pre_fh => $html_pre_fh, # pre section goes here
4640 _rpre_string_stack => \@pre_string_stack, # stack of pre sections
4641 _html_pod_fh => $html_pod_fh, # pod goes here if pod2html
4642 _rpod_string => \$pod_string, # string holding pod
4643 _pod_cut_count => 0, # how many =cut's?
4644 _html_toc_fh => $html_toc_fh, # fh for table of contents
4645 _rtoc_string => \$toc_string, # string holding toc
4646 _rtoc_item_count => \$toc_item_count, # how many toc items
4647 _rin_toc_package => \$in_toc_package, # package name
4648 _rtoc_name_count => {}, # hash to track unique names
4649 _rpackage_stack => [], # stack to check for package
4650 # name changes
4651 _rlast_level => \$last_level, # brace indentation level
4652 }, $class;
4653}
4654
4655sub add_toc_item {
4656
4657 # Add an item to the html table of contents.
4658 # This is called even if no table of contents is written,
4659 # because we still want to put the anchors in the <pre> text.
4660 # We are given an anchor name and its type; types are:
4661 # 'package', 'sub', '__END__', '__DATA__', 'EOF'
4662 # There must be an 'EOF' call at the end to wrap things up.
4663 my $self = shift;
4664 my ( $name, $type ) = @_;
4665 my $html_toc_fh = $self->{_html_toc_fh};
4666 my $html_pre_fh = $self->{_html_pre_fh};
4667 my $rtoc_name_count = $self->{_rtoc_name_count};
4668 my $rtoc_item_count = $self->{_rtoc_item_count};
4669 my $rlast_level = $self->{_rlast_level};
4670 my $rin_toc_package = $self->{_rin_toc_package};
4671 my $rpackage_stack = $self->{_rpackage_stack};
4672
4673 # packages contain sublists of subs, so to avoid errors all package
4674 # items are written and finished with the following routines
4675 my $end_package_list = sub {
4676 if ($$rin_toc_package) {
4677 $html_toc_fh->print("</ul>\n</li>\n");
4678 $$rin_toc_package = "";
4679 }
4680 };
4681
4682 my $start_package_list = sub {
4683 my ( $unique_name, $package ) = @_;
4684 if ($$rin_toc_package) { $end_package_list->() }
4685 $html_toc_fh->print(<<EOM);
4686<li><a href=\"#$unique_name\">package $package</a>
4687<ul>
4688EOM
4689 $$rin_toc_package = $package;
4690 };
4691
4692 # start the table of contents on the first item
4693 unless ($$rtoc_item_count) {
4694
4695 # but just quit if we hit EOF without any other entries
4696 # in this case, there will be no toc
4697 return if ( $type eq 'EOF' );
4698 $html_toc_fh->print( <<"TOC_END");
4699<!-- BEGIN CODE INDEX --><a name="code-index"></a>
4700<ul>
4701TOC_END
4702 }
4703 $$rtoc_item_count++;
4704
4705 # make a unique anchor name for this location:
4706 # - packages get a 'package-' prefix
4707 # - subs use their names
4708 my $unique_name = $name;
4709 if ( $type eq 'package' ) { $unique_name = "package-$name" }
4710
4711 # append '-1', '-2', etc if necessary to make unique; this will
4712 # be unique because subs and packages cannot have a '-'
4713 if ( my $count = $rtoc_name_count->{ lc $unique_name }++ ) {
4714 $unique_name .= "-$count";
4715 }
4716
4717 # - all names get terminal '-' if pod2html is used, to avoid
4718 # conflicts with anchor names created by pod2html
4719 if ( $rOpts->{'pod2html'} ) { $unique_name .= '-' }
4720
4721 # start/stop lists of subs
4722 if ( $type eq 'sub' ) {
4723 my $package = $rpackage_stack->[$$rlast_level];
4724 unless ($package) { $package = 'main' }
4725
4726 # if we're already in a package/sub list, be sure its the right
4727 # package or else close it
4728 if ( $$rin_toc_package && $$rin_toc_package ne $package ) {
4729 $end_package_list->();
4730 }
4731
4732 # start a package/sub list if necessary
4733 unless ($$rin_toc_package) {
4734 $start_package_list->( $unique_name, $package );
4735 }
4736 }
4737
4738 # now write an entry in the toc for this item
4739 if ( $type eq 'package' ) {
4740 $start_package_list->( $unique_name, $name );
4741 }
4742 elsif ( $type eq 'sub' ) {
4743 $html_toc_fh->print("<li><a href=\"#$unique_name\">$name</a></li>\n");
4744 }
4745 else {
4746 $end_package_list->();
4747 $html_toc_fh->print("<li><a href=\"#$unique_name\">$name</a></li>\n");
4748 }
4749
4750 # write the anchor in the <pre> section
4751 $html_pre_fh->print("<a name=\"$unique_name\"></a>");
4752
4753 # end the table of contents, if any, on the end of file
4754 if ( $type eq 'EOF' ) {
4755 $html_toc_fh->print( <<"TOC_END");
4756</ul>
4757<!-- END CODE INDEX -->
4758TOC_END
4759 }
4760}
4761
4762
# spent 50┬Ás within Perl::Tidy::HtmlWriter::BEGIN@4762 which was called: # once (50┬Ás+0s) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4867
BEGIN {
4763
4764 # This is the official list of tokens which may be identified by the
4765 # user. Long names are used as getopt keys. Short names are
4766 # convenient short abbreviations for specifying input. Short names
4767 # somewhat resemble token type characters, but are often different
4768 # because they may only be alphanumeric, to allow command line
4769 # input. Also, note that because of case insensitivity of html,
4770 # this table must be in a single case only (I've chosen to use all
4771 # lower case).
4772 # When adding NEW_TOKENS: update this hash table
4773 # short names => long names
4774125┬Ás %short_to_long_names = (
4775 'n' => 'numeric',
4776 'p' => 'paren',
4777 'q' => 'quote',
4778 's' => 'structure',
4779 'c' => 'comment',
4780 'v' => 'v-string',
4781 'cm' => 'comma',
4782 'w' => 'bareword',
4783 'co' => 'colon',
4784 'pu' => 'punctuation',
4785 'i' => 'identifier',
4786 'j' => 'label',
4787 'h' => 'here-doc-target',
4788 'hh' => 'here-doc-text',
4789 'k' => 'keyword',
4790 'sc' => 'semicolon',
4791 'm' => 'subroutine',
4792 'pd' => 'pod-text',
4793 );
4794
4795 # Now we have to map actual token types into one of the above short
4796 # names; any token types not mapped will get 'punctuation'
4797 # properties.
4798
4799 # The values of this hash table correspond to the keys of the
4800 # previous hash table.
4801 # The keys of this hash table are token types and can be seen
4802 # by running with --dump-token-types (-dtt).
4803
4804 # When adding NEW_TOKENS: update this hash table
4805 # $type => $short_name
480618┬Ás %token_short_names = (
4807 '#' => 'c',
4808 'n' => 'n',
4809 'v' => 'v',
4810 'k' => 'k',
4811 'F' => 'k',
4812 'Q' => 'q',
4813 'q' => 'q',
4814 'J' => 'j',
4815 'j' => 'j',
4816 'h' => 'h',
4817 'H' => 'hh',
4818 'w' => 'w',
4819 ',' => 'cm',
4820 '=>' => 'cm',
4821 ';' => 'sc',
4822 ':' => 'co',
4823 'f' => 'sc',
4824 '(' => 'p',
4825 ')' => 'p',
4826 'M' => 'm',
4827 'P' => 'pd',
4828 'A' => 'co',
4829 );
4830
4831 # These token types will all be called identifiers for now
4832 # FIXME: could separate user defined modules as separate type
483312┬Ás my @identifier = qw" i t U C Y Z G :: CORE::";
483417┬Ás @token_short_names{@identifier} = ('i') x scalar(@identifier);
4835
4836 # These token types will be called 'structure'
48371500ns my @structure = qw" { } ";
483819┬Ás @token_short_names{@structure} = ('s') x scalar(@structure);
4839
4840 # OLD NOTES: save for reference
4841 # Any of these could be added later if it would be useful.
4842 # For now, they will by default become punctuation
4843 # my @list = qw" L R [ ] ";
4844 # @token_long_names{@list} = ('non-structure') x scalar(@list);
4845 #
4846 # my @list = qw"
4847 # / /= * *= ** **= + += - -= % %= = ++ -- << <<= >> >>= pp p m mm
4848 # ";
4849 # @token_long_names{@list} = ('math') x scalar(@list);
4850 #
4851 # my @list = qw" & &= ~ ~= ^ ^= | |= ";
4852 # @token_long_names{@list} = ('bit') x scalar(@list);
4853 #
4854 # my @list = qw" == != < > <= <=> ";
4855 # @token_long_names{@list} = ('numerical-comparison') x scalar(@list);
4856 #
4857 # my @list = qw" && || ! &&= ||= //= ";
4858 # @token_long_names{@list} = ('logical') x scalar(@list);
4859 #
4860 # my @list = qw" . .= =~ !~ x x= ";
4861 # @token_long_names{@list} = ('string-operators') x scalar(@list);
4862 #
4863 # # Incomplete..
4864 # my @list = qw" .. -> <> ... \ ? ";
4865 # @token_long_names{@list} = ('misc-operators') x scalar(@list);
4866
48671384┬Ás150┬Ás}
# spent 50┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4762
4868
4869sub make_getopt_long_names {
4870 my $class = shift;
4871 my ($rgetopt_names) = @_;
4872 while ( my ( $short_name, $name ) = each %short_to_long_names ) {
4873 push @$rgetopt_names, "html-color-$name=s";
4874 push @$rgetopt_names, "html-italic-$name!";
4875 push @$rgetopt_names, "html-bold-$name!";
4876 }
4877 push @$rgetopt_names, "html-color-background=s";
4878 push @$rgetopt_names, "html-linked-style-sheet=s";
4879 push @$rgetopt_names, "nohtml-style-sheets";
4880 push @$rgetopt_names, "html-pre-only";
4881 push @$rgetopt_names, "html-line-numbers";
4882 push @$rgetopt_names, "html-entities!";
4883 push @$rgetopt_names, "stylesheet";
4884 push @$rgetopt_names, "html-table-of-contents!";
4885 push @$rgetopt_names, "pod2html!";
4886 push @$rgetopt_names, "frames!";
4887 push @$rgetopt_names, "html-toc-extension=s";
4888 push @$rgetopt_names, "html-src-extension=s";
4889
4890 # Pod::Html parameters:
4891 push @$rgetopt_names, "backlink=s";
4892 push @$rgetopt_names, "cachedir=s";
4893 push @$rgetopt_names, "htmlroot=s";
4894 push @$rgetopt_names, "libpods=s";
4895 push @$rgetopt_names, "podpath=s";
4896 push @$rgetopt_names, "podroot=s";
4897 push @$rgetopt_names, "title=s";
4898
4899 # Pod::Html parameters with leading 'pod' which will be removed
4900 # before the call to Pod::Html
4901 push @$rgetopt_names, "podquiet!";
4902 push @$rgetopt_names, "podverbose!";
4903 push @$rgetopt_names, "podrecurse!";
4904 push @$rgetopt_names, "podflush";
4905 push @$rgetopt_names, "podheader!";
4906 push @$rgetopt_names, "podindex!";
4907}
4908
4909sub make_abbreviated_names {
4910
4911 # We're appending things like this to the expansion list:
4912 # 'hcc' => [qw(html-color-comment)],
4913 # 'hck' => [qw(html-color-keyword)],
4914 # etc
4915 my $class = shift;
4916 my ($rexpansion) = @_;
4917
4918 # abbreviations for color/bold/italic properties
4919 while ( my ( $short_name, $long_name ) = each %short_to_long_names ) {
4920 ${$rexpansion}{"hc$short_name"} = ["html-color-$long_name"];
4921 ${$rexpansion}{"hb$short_name"} = ["html-bold-$long_name"];
4922 ${$rexpansion}{"hi$short_name"} = ["html-italic-$long_name"];
4923 ${$rexpansion}{"nhb$short_name"} = ["nohtml-bold-$long_name"];
4924 ${$rexpansion}{"nhi$short_name"} = ["nohtml-italic-$long_name"];
4925 }
4926
4927 # abbreviations for all other html options
4928 ${$rexpansion}{"hcbg"} = ["html-color-background"];
4929 ${$rexpansion}{"pre"} = ["html-pre-only"];
4930 ${$rexpansion}{"toc"} = ["html-table-of-contents"];
4931 ${$rexpansion}{"ntoc"} = ["nohtml-table-of-contents"];
4932 ${$rexpansion}{"nnn"} = ["html-line-numbers"];
4933 ${$rexpansion}{"hent"} = ["html-entities"];
4934 ${$rexpansion}{"nhent"} = ["nohtml-entities"];
4935 ${$rexpansion}{"css"} = ["html-linked-style-sheet"];
4936 ${$rexpansion}{"nss"} = ["nohtml-style-sheets"];
4937 ${$rexpansion}{"ss"} = ["stylesheet"];
4938 ${$rexpansion}{"pod"} = ["pod2html"];
4939 ${$rexpansion}{"npod"} = ["nopod2html"];
4940 ${$rexpansion}{"frm"} = ["frames"];
4941 ${$rexpansion}{"nfrm"} = ["noframes"];
4942 ${$rexpansion}{"text"} = ["html-toc-extension"];
4943 ${$rexpansion}{"sext"} = ["html-src-extension"];
4944}
4945
4946sub check_options {
4947
4948 # This will be called once after options have been parsed
4949 my $class = shift;
4950 $rOpts = shift;
4951
4952 # X11 color names for default settings that seemed to look ok
4953 # (these color names are only used for programming clarity; the hex
4954 # numbers are actually written)
4955224┬Ás279┬Ás
# spent 43┬Ás (8+35) within Perl::Tidy::HtmlWriter::BEGIN@4955 which was called: # once (8┬Ás+35┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4955
use constant ForestGreen => "#228B22";
# spent 43┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4955 # spent 36┬Ás making 1 call to constant::import
4956222┬Ás276┬Ás
# spent 42┬Ás (8+34) within Perl::Tidy::HtmlWriter::BEGIN@4956 which was called: # once (8┬Ás+34┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4956
use constant SaddleBrown => "#8B4513";
# spent 42┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4956 # spent 34┬Ás making 1 call to constant::import
4957221┬Ás266┬Ás
# spent 36┬Ás (6+30) within Perl::Tidy::HtmlWriter::BEGIN@4957 which was called: # once (6┬Ás+30┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4957
use constant magenta4 => "#8B008B";
# spent 36┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4957 # spent 30┬Ás making 1 call to constant::import
4958220┬Ás263┬Ás
# spent 35┬Ás (6+28) within Perl::Tidy::HtmlWriter::BEGIN@4958 which was called: # once (6┬Ás+28┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4958
use constant IndianRed3 => "#CD5555";
# spent 35┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4958 # spent 28┬Ás making 1 call to constant::import
4959220┬Ás263┬Ás
# spent 35┬Ás (6+28) within Perl::Tidy::HtmlWriter::BEGIN@4959 which was called: # once (6┬Ás+28┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4959
use constant DeepSkyBlue4 => "#00688B";
# spent 35┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4959 # spent 28┬Ás making 1 call to constant::import
4960224┬Ás262┬Ás
# spent 34┬Ás (6+28) within Perl::Tidy::HtmlWriter::BEGIN@4960 which was called: # once (6┬Ás+28┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4960
use constant MediumOrchid3 => "#B452CD";
# spent 34┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4960 # spent 28┬Ás making 1 call to constant::import
4961224┬Ás263┬Ás
# spent 35┬Ás (7+28) within Perl::Tidy::HtmlWriter::BEGIN@4961 which was called: # once (7┬Ás+28┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4961
use constant black => "#000000";
# spent 35┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4961 # spent 28┬Ás making 1 call to constant::import
4962220┬Ás262┬Ás
# spent 34┬Ás (6+28) within Perl::Tidy::HtmlWriter::BEGIN@4962 which was called: # once (6┬Ás+28┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4962
use constant white => "#FFFFFF";
# spent 34┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4962 # spent 28┬Ás making 1 call to constant::import
496323.63ms269┬Ás
# spent 38┬Ás (6+31) within Perl::Tidy::HtmlWriter::BEGIN@4963 which was called: # once (6┬Ás+31┬Ás) by Perl::Critic::Policy::CodeLayout::RequireTidyCode::BEGIN@18 at line 4963
use constant red => "#FF0000";
# spent 38┬Ás making 1 call to Perl::Tidy::HtmlWriter::BEGIN@4963 # spent 31┬Ás making 1 call to constant::import
4964
4965 # set default color, bold, italic properties
4966 # anything not listed here will be given the default (punctuation) color --
4967 # these types currently not listed and get default: ws pu s sc cm co p
4968 # When adding NEW_TOKENS: add an entry here if you don't want defaults
4969
4970 # set_default_properties( $short_name, default_color, bold?, italic? );
4971 set_default_properties( 'c', ForestGreen, 0, 0 );
4972 set_default_properties( 'pd', ForestGreen, 0, 1 );
4973 set_default_properties( 'k', magenta4, 1, 0 ); # was SaddleBrown
4974 set_default_properties( 'q', IndianRed3, 0, 0 );
4975 set_default_properties( 'hh', IndianRed3, 0, 1 );
4976 set_default_properties( 'h', IndianRed3, 1, 0 );
4977 set_default_properties( 'i', DeepSkyBlue4, 0, 0 );
4978 set_default_properties( 'w', black, 0, 0 );
4979 set_default_properties( 'n', MediumOrchid3, 0, 0 );
4980 set_default_properties( 'v', MediumOrchid3, 0, 0 );
4981 set_default_properties( 'j', IndianRed3, 1, 0 );
4982 set_default_properties( 'm', red, 1, 0 );
4983
4984 set_default_color( 'html-color-background', white );
4985 set_default_color( 'html-color-punctuation', black );
4986
4987 # setup property lookup tables for tokens based on their short names
4988 # every token type has a short name, and will use these tables
4989 # to do the html markup
4990 while ( my ( $short_name, $long_name ) = each %short_to_long_names ) {
4991 $html_color{$short_name} = $rOpts->{"html-color-$long_name"};
4992 $html_bold{$short_name} = $rOpts->{"html-bold-$long_name"};
4993 $html_italic{$short_name} = $rOpts->{"html-italic-$long_name"};
4994 }
4995
4996 # write style sheet to STDOUT and die if requested
4997 if ( defined( $rOpts->{'stylesheet'} ) ) {
4998 write_style_sheet_file('-');
4999 Perl::Tidy::Exit 0;
5000 }
5001
5002 # make sure user gives a file name after -css
5003 if ( defined( $rOpts->{'html-linked-style-sheet'} ) ) {
5004 $css_linkname = $rOpts->{'html-linked-style-sheet'};
5005 if ( $css_linkname =~ /^-/ ) {
5006 Perl::Tidy::Die "You must specify a valid filename after -css\n";
5007 }
5008 }
5009
5010 # check for conflict
5011 if ( $css_linkname && $rOpts->{'nohtml-style-sheets'} ) {
5012 $rOpts->{'nohtml-style-sheets'} = 0;
5013 warning("You can't specify both -css and -nss; -nss ignored\n");
5014 }
5015
5016 # write a style sheet file if necessary
5017 if ($css_linkname) {
5018
5019 # if the selected filename exists, don't write, because user may
5020 # have done some work by hand to create it; use backup name instead
5021 # Also, this will avoid a potential disaster in which the user
5022 # forgets to specify the style sheet, like this:
5023 # perltidy -html -css myfile1.pl myfile2.pl
5024 # This would cause myfile1.pl to parsed as the style sheet by GetOpts
5025 my $css_filename = $css_linkname;
5026 unless ( -e $css_filename ) {
5027 write_style_sheet_file($css_filename);
5028 }
5029 }
5030 $missing_html_entities = 1 unless $rOpts->{'html-entities'};
5031}
5032
5033sub write_style_sheet_file {
5034
5035 my $css_filename = shift;
5036 my $fh;
5037 unless ( $fh = IO::File->new("> $css_filename") ) {
5038 Perl::Tidy::Die "can't open $css_filename: $!\n";
5039 }
5040 write_style_sheet_data($fh);
5041 eval { $fh->close };
5042}
5043
5044sub write_style_sheet_data {
5045
5046 # write the style sheet data to an open file handle
5047 my $fh = shift;
5048
5049 my $bg_color = $rOpts->{'html-color-background'};
5050 my $text_color = $rOpts->{'html-color-punctuation'};
5051
5052 # pre-bgcolor is new, and may not be defined
5053 my $pre_bg_color = $rOpts->{'html-pre-color-background'};
5054 $pre_bg_color = $bg_color unless $pre_bg_color;
5055
5056 $fh->print(<<"EOM");
5057/* default style sheet generated by perltidy */
5058body {background: $bg_color; color: $text_color}
5059pre { color: $text_color;
5060 background: $pre_bg_color;
5061 font-family: courier;
5062 }
5063
5064EOM
5065
5066 foreach my $short_name ( sort keys %short_to_long_names ) {
5067 my $long_name = $short_to_long_names{$short_name};
5068
5069 my $abbrev = '.' . $short_name;
5070 if ( length($short_name) == 1 ) { $abbrev .= ' ' } # for alignment
5071 my $color = $html_color{$short_name};
5072 if ( !defined($color) ) { $color = $text_color }
5073 $fh->print("$abbrev \{ color: $color;");
5074
5075 if ( $html_bold{$short_name} ) {
5076 $fh->print(" font-weight:bold;");
5077 }
5078
5079 if ( $html_italic{$short_name} ) {
5080 $fh->print(" font-style:italic;");
5081 }
5082 $fh->print("} /* $long_name */\n");
5083 }
5084}
5085
5086sub set_default_color {
5087
5088 # make sure that options hash $rOpts->{$key} contains a valid color
5089 my ( $key, $color ) = @_;
5090 if ( $rOpts->{$key} ) { $color = $rOpts->{$key} }
5091 $rOpts->{$key} = check_RGB($color);
5092}
5093
5094sub check_RGB {
5095
5096 # if color is a 6 digit hex RGB value, prepend a #, otherwise
5097 # assume that it is a valid ascii color name
5098 my ($color) = @_;
5099 if ( $color =~ /^[0-9a-fA-F]{6,6}$/ ) { $color = "#$color" }
5100 return $color;
5101}
5102
5103sub set_default_properties {
5104 my ( $short_name, $color, $bold, $italic ) = @_;
5105
5106 set_default_color( "html-color-$short_to_long_names{$short_name}", $color );
5107 my $key;
5108 $key = "html-bold-$short_to_long_names{$short_name}";
5109 $rOpts->{$key} = ( defined $rOpts->{$key} ) ? $rOpts->{$key} : $bold;
5110 $key = "html-italic-$short_to_long_names{$short_name}";
5111 $rOpts->{$key} = ( defined $rOpts->{$key} ) ? $rOpts->{$key} : $italic;
5112}
5113
5114sub pod_to_html {
5115
5116 # Use Pod::Html to process the pod and make the page
5117 # then merge the perltidy code sections into it.
5118 # return 1 if success, 0 otherwise
5119 my $self = shift;
5120 my ( $pod_string, $css_string, $toc_string, $rpre_string_stack ) = @_;
5121 my $input_file = $self->{_input_file};
5122 my $title = $self->{_title};
5123 my $success_flag = 0;
5124
5125 # don't try to use pod2html if no pod
5126 unless ($pod_string) {
5127 return $success_flag;
5128 }
5129
5130 # Pod::Html requires a real temporary filename
5131 my ( $fh_tmp, $tmpfile ) = tempfile();
5132 unless ($fh_tmp) {
5133 Perl::Tidy::Warn
5134 "unable to open temporary file $tmpfile; cannot use pod2html\n";
5135 return $success_flag;
5136 }
5137
5138 #------------------------------------------------------------------
5139 # Warning: a temporary file is open; we have to clean up if
5140 # things go bad. From here on all returns should be by going to
5141 # RETURN so that the temporary file gets unlinked.
5142 #------------------------------------------------------------------
5143
5144 # write the pod text to the temporary file
5145 $fh_tmp->print($pod_string);
5146 $fh_tmp->close();
5147
5148 # Hand off the pod to pod2html.
5149 # Note that we can use the same temporary filename for input and output
5150 # because of the way pod2html works.
5151 {
5152
5153 my @args;
5154 push @args, "--infile=$tmpfile", "--outfile=$tmpfile", "--title=$title";
5155 my $kw;
5156
5157 # Flags with string args:
5158 # "backlink=s", "cachedir=s", "htmlroot=s", "libpods=s",
5159 # "podpath=s", "podroot=s"
5160 # Note: -css=s is handled by perltidy itself
5161 foreach $kw (qw(backlink cachedir htmlroot libpods podpath podroot)) {
5162 if ( $rOpts->{$kw} ) { push @args, "--$kw=$rOpts->{$kw}" }
5163 }
5164
5165 # Toggle switches; these have extra leading 'pod'
5166 # "header!", "index!", "recurse!", "quiet!", "verbose!"
5167 foreach $kw (qw(podheader podindex podrecurse podquiet podverbose)) {
5168 my $kwd = $kw; # allows us to strip 'pod'
5169 if ( $rOpts->{$kw} ) { $kwd =~ s/^pod//; push @args, "--$kwd" }
5170 elsif ( defined( $rOpts->{$kw} ) ) {
5171 $kwd =~ s/^pod//;
5172 push @args, "--no$kwd";
5173 }
5174 }
5175
5176 # "flush",
5177 $kw = 'podflush';
5178 if ( $rOpts->{$kw} ) { $kw =~ s/^pod//; push @args, "--$kw" }
5179
5180 # Must clean up if pod2html dies (it can);
5181 # Be careful not to overwrite callers __DIE__ routine
5182 local $SIG{__DIE__} = sub {
5183 unlink $tmpfile if -e $tmpfile;
5184 Perl::Tidy::Die $_[0];
5185 };
5186
5187 pod2html(@args);
5188 }
5189 $fh_tmp = IO::File->new( $tmpfile, 'r' );
5190 unless ($fh_tmp) {
5191
5192 # this error shouldn't happen ... we just used this filename
5193 Perl::Tidy::Warn
5194 "unable to open temporary file $tmpfile; cannot use pod2html\n";
5195 goto RETURN;
5196 }
5197
5198 my $html_fh = $self->{_html_fh};
5199 my @toc;
5200 my $in_toc;
5201 my $ul_level = 0;
5202 my $no_print;
5203
5204 # This routine will write the html selectively and store the toc
5205 my $html_print = sub {
5206 foreach (@_) {
5207 $html_fh->print($_) unless ($no_print);
5208 if ($in_toc) { push @toc, $_ }
5209 }
5210 };
5211
5212 # loop over lines of html output from pod2html and merge in
5213 # the necessary perltidy html sections
5214 my ( $saw_body, $saw_index, $saw_body_end );
5215 while ( my $line = $fh_tmp->getline() ) {
5216
5217 if ( $line =~ /^\s*<html>\s*$/i ) {
5218 my $date = localtime;
5219 $html_print->("<!-- Generated by perltidy on $date -->\n");
5220 $html_print->($line);
5221 }
5222
5223 # Copy the perltidy css, if any, after <body> tag
5224 elsif ( $line =~ /^\s*<body.*>\s*$/i ) {
5225 $saw_body = 1;
5226 $html_print->($css_string) if $css_string;
5227 $html_print->($line);
5228
5229 # add a top anchor and heading
5230 $html_print->("<a name=\"-top-\"></a>\n");
5231 $title = escape_html($title);
5232 $html_print->("<h1>$title</h1>\n");
5233 }
5234
5235 # check for start of index, old pod2html
5236 # before Pod::Html VERSION 1.15_02 it is delimited by comments as:
5237 # <!-- INDEX BEGIN -->
5238 # <ul>
5239 # ...
5240 # </ul>
5241 # <!-- INDEX END -->
5242 #
5243 elsif ( $line =~ /^\s*<!-- INDEX BEGIN -->\s*$/i ) {
5244 $in_toc = 'INDEX';
5245
5246 # when frames are used, an extra table of contents in the
5247 # contents panel is confusing, so don't print it
5248 $no_print = $rOpts->{'frames'}
5249 || !$rOpts->{'html-table-of-contents'};
5250 $html_print->("<h2>Doc Index:</h2>\n") if $rOpts->{'frames'};
5251 $html_print->($line);
5252 }
5253
5254 # check for start of index, new pod2html
5255 # After Pod::Html VERSION 1.15_02 it is delimited as:
5256 # <ul id="index">
5257 # ...
5258 # </ul>
5259 elsif ( $line =~ /^\s*<ul\s+id="index">/i ) {
5260 $in_toc = 'UL';
5261 $ul_level = 1;
5262
5263 # when frames are used, an extra table of contents in the
5264 # contents panel is confusing, so don't print it
5265 $no_print = $rOpts->{'frames'}
5266 || !$rOpts->{'html-table-of-contents'};
5267 $html_print->("<h2>Doc Index:</h2>\n") if $rOpts->{'frames'};
5268 $html_print->($line);
5269 }
5270
5271 # Check for end of index, old pod2html
5272 elsif ( $line =~ /^\s*<!-- INDEX END -->\s*$/i ) {
5273 $saw_index = 1;
5274 $html_print->($line);
5275
5276 # Copy the perltidy toc, if any, after the Pod::Html toc
5277 if ($toc_string) {
5278 $html_print->("<hr />\n") if $rOpts->{'frames'};
5279 $html_print->("<h2>Code Index:</h2>\n");
5280 my @toc = map { $_ .= "\n" } split /\n/, $toc_string;
5281 $html_print->(@toc);
5282 }
5283 $in_toc = "";
5284 $no_print = 0;
5285 }
5286
5287 # must track <ul> depth level for new pod2html
5288 elsif ( $line =~ /\s*<ul>\s*$/i && $in_toc eq 'UL' ) {
5289 $ul_level++;
5290 $html_print->($line);
5291 }
5292
5293 # Check for end of index, for new pod2html
5294 elsif ( $line =~ /\s*<\/ul>/i && $in_toc eq 'UL' ) {
5295 $ul_level--;
5296 $html_print->($line);
5297
5298 # Copy the perltidy toc, if any, after the Pod::Html toc
5299 if ( $ul_level <= 0 ) {
5300 $saw_index = 1;
5301 if ($toc_string) {
5302 $html_print->("<hr />\n") if $rOpts->{'frames'};
5303 $html_print->("<h2>Code Index:</h2>\n");
5304 my @toc = map { $_ .= "\n" } split /\n/, $toc_string;
5305 $html_print->(@toc);
5306 }
5307 $in_toc = "";
5308 $ul_level = 0;
5309 $no_print = 0;
5310 }
5311 }
5312
5313 # Copy one perltidy section after each marker
5314 elsif ( $line =~ /^(.*)<!-- pERLTIDY sECTION -->(.*)$/ ) {
5315 $line = $2;
5316 $html_print->($1) if $1;
5317
5318 # Intermingle code and pod sections if we saw multiple =cut's.
5319 if ( $self->{_pod_cut_count} > 1 ) {
5320 my $rpre_string = shift(@$rpre_string_stack);
5321 if ($$rpre_string) {
5322 $html_print->('<pre>');
5323 $html_print->($$rpre_string);
5324 $html_print->('</pre>');
5325 }
5326 else {
5327
5328 # shouldn't happen: we stored a string before writing
5329 # each marker.
5330 Perl::Tidy::Warn
5331"Problem merging html stream with pod2html; order may be wrong\n";
5332 }
5333 $html_print->($line);
5334 }
5335
5336 # If didn't see multiple =cut lines, we'll put the pod out first
5337 # and then the code, because it's less confusing.
5338 else {
5339
5340 # since we are not intermixing code and pod, we don't need
5341 # or want any <hr> lines which separated pod and code
5342 $html_print->($line) unless ( $line =~ /^\s*<hr>\s*$/i );
5343 }
5344 }
5345
5346 # Copy any remaining code section before the </body> tag
5347 elsif ( $line =~ /^\s*<\/body>\s*$/i ) {
5348 $saw_body_end = 1;
5349 if (@$rpre_string_stack) {
5350 unless ( $self->{_pod_cut_count} > 1 ) {
5351 $html_print->('<hr />');
5352 }
5353 while ( my $rpre_string = shift(@$rpre_string_stack) ) {
5354 $html_print->('<