lib/Display.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Display.pm,v $
   4
   5 Simple and consistant display routines for Perl
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.45 $
  18
  19 =item Created
  20
  21 Fri Mar 12 10:17:44 PST 2004
  22
  23 =item Modified
  24
  25 $Date: 2013/05/30 15:48:06 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 This module seeks to make writing output simpler and more consistant. Messages
  32 are classified as display (informational - always displayed), verbose (written
  33 only if $verbose is set) and debug (written only if $debug is set). There are
  34 also routines for error(s) and warning(s) which support optional parameters for
  35 error number and warning number. If error number is specified then the process
  36 is also terminated.
  37
  38  display "message";
  39  verbose "$n records processed";
  40  verbose2 "Processing record #$recno";
  41  warning "Unable to find record", 1;
  42  debug "Reached here...";
  43  error "Can't continue", 2;
  44
  45 =head2 DESCRIPTION
  46
  47 This module implements several routines to provide and easy and
  48 consistant interface to writing output in Perl. Perl has lots of ways
  49 to do such things but these methods seek to be self explainitory and
  50 to provide convenient parameters and defaults so as to make coding
  51 easier.
  52
  53 There are also some other routines, i.e. get_debug, that will return
  54 $debug in case you want to execute other Perl code only when
  55 debugging:
  56
  57   if (get_debug) {
  58     foreach (@output_line) {
  59       debug $_;
  60     } # foreach
  61   } # if
  62
  63 By default these routines write lines complete with the terminating
  64 "\n". I find that this is most often what you are doing. There are
  65 corresponding <routine>_nolf versions for display and verbose in case
  66 you wish to not terminate lines. Or use the new say function.
  67
  68 Also, routines like display support a file handle parameter if you
  69 wish to say display into a file - Default STDOUT.
  70
  71 Both version and debug support levels and have convienence functions:
  72 verbose1, debug2. Three levels of conienence functions are supplied
  73 although an unlimited amount can be supported directly through
  74 verbose/debug. See documentaton for those functions for details.
  75
  76 =head1 ROUTINES
  77
  78 The following routines are exported:
  79
  80 =cut
  81
  82 package Display;
  83
  84 use strict;
  85 use warnings;
  86
  87 use base 'Exporter';
  88
  89 use FindBin;
  90 use File::Spec;
  91 use Term::ANSIColor qw(color);
  92 use Carp;
  93 use Config;
  94
  95 our @EXPORT = qw (
  96   debug debug1 debug2 debug3
  97   display
  98   display_err
  99   display_error
 100   display_nolf
 101   error
 102   get_debug
 103   get_me
 104   get_trace
 105   get_verbose
 106   say
 107   set_debug
 108   set_me
 109   set_trace
 110   set_verbose
 111   trace
 112   trace_enter
 113   trace_exit
 114   verbose verbose1 verbose2 verbose3
 115   verbose_nolf
 116   warning
 117 );
 118
 119 my ($me, $verbose, $debug, $trace);
 120
 121 BEGIN {
 122   $me = $FindBin::Script;
 123   $me =~ s/\.pl$//;
 124
 125   $verbose = $ENV{VERBOSE};
 126   $debug   = $ENV{DEBUG};
 127   $trace   = $ENV{TRACE};
 128 } # BEGIN
 129
 130 sub display_err ($;$$);
 131
 132 sub debug ($;$$$) {
 133   my ($msg, $handle, $nolinefeed, $level) = @_;
 134
 135 =pod
 136
 137 =head2 debug[1-3] ($msg, $handle, $nolinefeed, $level)
 138
 139 Write $msg to $handle (default STDERR) with a "\n" unless $nolinefeed
 140 is defined. Messages are written only if written if $debug is set and
 141 =< $level. $level defaults to 1.
 142
 143 debug1, debug2 and debug3 are setup as convienence functions that are
 144 equivalent to calling debug with $level set to 1, 2 or 3 respectively
 145
 146 Parameters:
 147
 148 =for html <blockquote>
 149
 150 =over
 151
 152 =item $msg:
 153
 154 Message to display
 155
 156 =item $handle:
 157
 158 File handle to display to (Default: STDERR)
 159
 160 =item $nolinefeed:
 161
 162 If defined no linefeed is displayed at the end of the message.
 163
 164 =item $level
 165
 166 If defined, if $level =< $debug then the debug message is displayed.
 167
 168 =back
 169
 170 =for html </blockquote>
 171
 172 Returns:
 173
 174 =for html <blockquote>
 175
 176 =over
 177
 178 =item Nothing
 179
 180 =back
 181
 182 =for html </blockquote>
 183
 184 =cut
 185
 186   return
 187     unless $debug;
 188
 189   return
 190     if $debug == 0;
 191
 192   $level ||= 1;
 193   $msg   ||= '';
 194
 195   if (($handle and -t $handle) or (-t *STDERR)) {
 196     $msg = color ('cyan')
 197          . $me
 198          . color ('reset')
 199          . ': '
 200          . color ('magenta')
 201          . "DEBUG"
 202          . color ('reset')
 203          . ": $msg";
 204   } else {
 205     $msg = "$me: DEBUG: $msg";
 206   } # if
 207
 208   display_err $msg, $handle, $nolinefeed if $debug and $level <= $debug;
 209
 210   return;
 211 } # debug
 212
 213 sub debug1 ($;$$) {
 214   my ($msg, $handle, $nolinefeed) = @_;
 215
 216   debug $msg, $handle, $nolinefeed, 1;
 217
 218   return;
 219 } # debug1
 220
 221 sub debug2 ($;$$) {
 222   my ($msg, $handle, $nolinefeed) = @_;
 223
 224   debug $msg, $handle, $nolinefeed, 2;
 225
 226   return;
 227 } # debug1
 228
 229 sub debug3 ($;$$) {
 230   my ($msg, $handle, $nolinefeed) = @_;
 231
 232   debug $msg, $handle, $nolinefeed, 2;
 233
 234   return;
 235 } # debug1
 236
 237 sub display (;$$$) {
 238   my ($msg, $handle, $nolinefeed) = @_;
 239
 240 =pod
 241
 242 =head2 display ($msg, $handle, $nolinefeed)
 243
 244 Write $msg to $handle (default STDOUT) with a "\n" unless $nolinefeed
 245 is defined.
 246
 247 Parameters:
 248
 249 =for html <blockquote>
 250
 251 =over
 252
 253 =item $msg:
 254
 255 Message to display
 256
 257 =item $handle:
 258
 259 File handle to display to (Default: STDOUT)
 260
 261 =item $nolinefeed:
 262
 263 If defined no linefeed is displayed at the end of the message.
 264
 265 =back
 266
 267 =for html </blockquote>
 268
 269 Returns:
 270
 271 =for html <blockquote>
 272
 273 =over
 274
 275 =item Nothing
 276
 277 =back
 278
 279 =for html </blockquote>
 280
 281 =cut
 282
 283   $msg  ||= '';
 284   $handle = *STDOUT unless $handle;
 285
 286   print $handle $msg;
 287   print $handle "\n" unless $nolinefeed;
 288
 289   return;
 290 } # display
 291
 292 sub display_err ($;$$) {
 293   my ($msg, $handle, $nolinefeed) = @_;
 294
 295 =pod
 296
 297 =head2 display_err ($msg, $handle, $nolinefeed)
 298
 299 Displays $msg to STDERR
 300
 301 Parameters:
 302
 303 =for html <blockquote>
 304
 305 =over
 306
 307 =item $msg:
 308
 309 Message to display
 310
 311 =item $handle:
 312
 313 File handle to display to (Default: STDOUT)
 314
 315 =item $nolinefeed:
 316
 317 If defined no linefeed is displayed at the end of the message.
 318
 319 =back
 320
 321 =for html </blockquote>
 322
 323 Returns:
 324
 325 =for html <blockquote>
 326
 327 =over
 328
 329 =item Nothing
 330
 331 =back
 332
 333 =for html </blockquote>
 334
 335 =cut
 336
 337   $msg  ||= '';
 338   $handle = *STDERR if !$handle;
 339
 340   print $handle $msg;
 341   print $handle "\n" if !$nolinefeed;
 342
 343   return;
 344 } # display_err
 345
 346 sub display_error ($;$$$) {
 347   my ($msg, $errno, $handle, $nolinefeed) = @_;
 348
 349 =pod
 350
 351 =head2 display_error ($msg, $errno, $handle, $nolinefeed)
 352
 353 Displays colorized $msg to STDERR
 354
 355 Parameters:
 356
 357 =for html <blockquote>
 358
 359 =over
 360
 361 =item $msg:
 362
 363 Message to display
 364
 365 =item $errno
 366
 367 Error no to display (if any)
 368
 369 =item $handle:
 370
 371 File handle to display to (Default: STDOUT)
 372
 373 =item $nolinefeed:
 374
 375 If defined no linefeed is displayed at the end of the message.
 376
 377 =back
 378
 379 =for html </blockquote>
 380
 381 Returns:
 382
 383 =for html <blockquote>
 384
 385 =over
 386
 387 =item Nothing
 388
 389 =back
 390
 391 =for html </blockquote>
 392
 393 =cut
 394
 395   $msg ||= '';
 396
 397   unless ($errno) {
 398     if (($handle and -t $handle) or (-t *STDERR) and ($Config{perl} ne 'ratlperl')) {
 399       $msg = color ('cyan')
 400            . $me
 401            . color ('reset')
 402            . ': '
 403            . color ('red')
 404            . 'ERROR'
 405            . color ('reset')
 406            . ": $msg";
 407     } else {
 408       $msg = "$me: ERROR: $msg";
 409     } # if
 410   } else {
 411     if (($handle and -t $handle) or (-t *STDERR) and ($Config{perl} ne 'ratlperl')) {
 412       $msg = color ('cyan')
 413            . $me
 414            . color ('reset')
 415            . ': '
 416            . color ('red')
 417            . "ERROR #$errno"
 418            . color ('reset')
 419            . ": $msg";
 420     } else {
 421       $msg = "$me: ERROR #$errno: $msg";
 422     } # if
 423   } # if
 424
 425   display_err $msg, $handle, $nolinefeed;
 426
 427   return;
 428 } # display_error
 429
 430 sub display_nolf ($;$) {
 431   my ($msg, $handle) = @_;
 432
 433 =pod
 434
 435 =head2 display_nolf ($msg, $handle)
 436
 437 Equivalent of display ($msg, $handle, "nolf").
 438
 439 Parameters:
 440
 441 =for html <blockquote>
 442
 443 =over
 444
 445 =item $msg:
 446
 447 Message to display
 448
 449 =item $handle:
 450
 451 File handle to display to (Default: STDOUT)
 452
 453 =back
 454
 455 =for html </blockquote>
 456
 457 Returns:
 458
 459 =for html <blockquote>
 460
 461 =over
 462
 463 =item Nothing
 464
 465 =back
 466
 467 =for html </blockquote>
 468
 469 =cut
 470
 471   display $msg, $handle, "nolf";
 472
 473   return;
 474 } # display_nolf
 475
 476 sub error ($;$$$) {
 477   my ($msg, $errno, $handle, $nolinefeed) = @_;
 478
 479 =pod
 480
 481 =head2 error ($msg, $errno, $handle, $nolinefeed)
 482
 483 Write $msg to $handle (default STDERR) with a "\n" unless $nolinefeed
 484 is defined. Preface message with "<script name>: ERROR: " so that
 485 error messages are clearly distinguishable. If $errno is specified it
 486 is included and the process it terminated with the exit status set to
 487 $errno.
 488
 489 Parameters:
 490
 491 =for html <blockquote>
 492
 493 =over
 494
 495 =item $msg:
 496
 497 Message to display
 498
 499 =item $handle:
 500
 501 File handle to display to (Default: STDOUT)
 502
 503 =item $nolinefeed:
 504
 505 If defined no linefeed is displayed at the end of the message.
 506
 507 =back
 508
 509 =for html </blockquote>
 510
 511 Returns:
 512
 513 =for html <blockquote>
 514
 515 =over
 516
 517 =item Nothing
 518
 519 =back
 520
 521 =for html </blockquote>
 522
 523 =cut
 524
 525   display_error $msg, $errno, $handle, $nolinefeed;
 526
 527   exit $errno if $errno;
 528
 529   return;
 530 } # error
 531
 532 sub get_debug {
 533
 534 =pod
 535
 536 =head2 get_debug
 537
 538 Returns $debug.
 539
 540 Parameters:
 541
 542 =for html <blockquote>
 543
 544 None
 545
 546 =for html </blockquote>
 547
 548 Returns:
 549
 550 =for html <blockquote>
 551
 552 =over
 553
 554 =item $debug
 555
 556 =back
 557
 558 =for html </blockquote>
 559
 560 =cut
 561
 562   return $debug;
 563 } # get_debug
 564
 565 sub get_trace {
 566
 567 =pod
 568
 569 =head2 get_trace
 570
 571 Returns $trace.
 572
 573 Parameters:
 574
 575 =for html <blockquote>
 576
 577 None
 578
 579 =for html </blockquote>
 580
 581 Returns:
 582
 583 =for html <blockquote>
 584
 585 =over
 586
 587 =item $trace
 588
 589 =back
 590
 591 =for html </blockquote>
 592
 593 =cut
 594
 595   return $trace;
 596 } # get_trace
 597
 598 sub get_verbose {
 599
 600 =pod
 601
 602 =head2 get_verbose
 603
 604 Returns $verbose.
 605
 606 Parameters:
 607
 608 =for html <blockquote>
 609
 610 None
 611
 612 =for html </blockquote>
 613
 614 Returns:
 615
 616 =for html <blockquote>
 617
 618 =over
 619
 620 =item $verbose
 621
 622 =back
 623
 624 =for html </blockquote>
 625
 626 =cut
 627
 628   return $verbose;
 629 } # set_verbose
 630
 631 sub set_debug {
 632   my ($newValue) = @_;
 633
 634 =pod
 635
 636 =head2 set_debug
 637
 638 Sets $debug.
 639
 640 Parameters:
 641
 642 =for html <blockquote>
 643
 644 =over
 645
 646 =item newValue
 647
 648 New value to set $verbose to. If not specified then $verbose is set to
 649 1. The only other sensible value would be 0 to turn off verbose.
 650
 651 =back
 652
 653 =for html </blockquote>
 654
 655 Returns:
 656
 657 =for html <blockquote>
 658
 659 =over
 660
 661 =item Old setting of $verbose
 662
 663 =back
 664
 665 =for html </blockquote>
 666
 667 =cut
 668
 669   my $returnValue = $debug ? $debug : 0;
 670
 671   $debug = defined $newValue ? $newValue : 1;
 672
 673   return $returnValue;
 674 } # set_debug
 675
 676 sub get_me () {
 677
 678 =pod
 679
 680 =head2 get_me ($me)
 681
 682 Gets $me which is used by error. Module automatically calculates the
 683 basename of the script that called it.
 684
 685 Parameters:
 686
 687 =over
 688
 689 =item none
 690
 691 =back
 692
 693 Returns:
 694
 695 =for html <blockquote>
 696
 697 =over
 698
 699 =item $me
 700
 701 =back
 702
 703 =for html </blockquote>
 704
 705 =cut
 706
 707   return $me;
 708 } # get_me
 709
 710 sub set_me {
 711   my ($whoami) = @_;
 712
 713 =pod
 714
 715 =head2 set_me ($me)
 716
 717 Sets $me which is used by error. Module automatically calculates the
 718 basename of the script that called it.
 719
 720 Parameters:
 721
 722 =over
 723
 724 =item $me
 725
 726 String to set $me as
 727
 728 =back
 729
 730 Returns:
 731
 732 =for html <blockquote>
 733
 734 =over
 735
 736 =item Nothing
 737
 738 =back
 739
 740 =for html </blockquote>
 741
 742 =cut
 743
 744   $me = $whoami;
 745
 746   return;
 747 } # set_me
 748
 749 sub set_trace (;$) {
 750   my ($newValue) = @_;
 751
 752 =pod
 753
 754 =head2 set_trace
 755
 756 Sets $trace.
 757
 758 Parameters:
 759
 760 =for html <blockquote>
 761
 762 =over
 763
 764 =item newValue
 765
 766 New value to set $trace to. If not specified then $trace is set to
 767 1. The only other sensible value would be 0 to turn off trace.
 768
 769 =back
 770
 771 =for html </blockquote>
 772
 773 Returns:
 774
 775 =for html <blockquote>
 776
 777 =over
 778
 779 =item Old setting of $trace
 780
 781 =back
 782
 783 =for html </blockquote>
 784
 785 =cut
 786
 787   my $returnValue = $trace ? $trace : 0;
 788
 789   $trace = defined $newValue ? $newValue : 1;
 790
 791   return $returnValue;
 792 } # set_trace
 793
 794 sub set_verbose (;$) {
 795   my ($newValue) = @_;
 796
 797 =pod
 798
 799 =head2 set_verbose
 800
 801 Sets $verbose.
 802
 803 Parameters:
 804
 805 =for html <blockquote>
 806
 807 =over
 808
 809 =item newValue
 810
 811 New value to set $verbose to. If not specified then $verbose is set to
 812 1. The only other sensible value would be 0 to turn off verbose.
 813
 814 =back
 815
 816 =for html </blockquote>
 817
 818 Returns:
 819
 820 =for html <blockquote>
 821
 822 =over
 823
 824 =item Old setting of $verbose
 825
 826 =back
 827
 828 =for html </blockquote>
 829
 830 =cut
 831
 832   my $returnValue = $verbose ? $verbose : 0;
 833
 834   $verbose = defined $newValue ? $newValue : 1;
 835
 836   return $returnValue;
 837 } # set_verbose
 838
 839 sub trace (;$$) {
 840   my ($msg, $type) = @_;
 841
 842 =pod
 843
 844 =head2 trace
 845
 846 Emit trace statements from within a subroutine
 847
 848 Parameters:
 849
 850 =for html <blockquote>
 851
 852 =over
 853
 854 =item msg
 855
 856 Optional message to display
 857
 858 =item type
 859
 860 Optional prefix to message. Used by trace_enter and trace_exit. If not
 861 specified the string "In " is used.
 862
 863 =back
 864
 865 =for html </blockquote>
 866
 867 Returns:
 868
 869 =for html <blockquote>
 870
 871 =over
 872
 873 =item Name of the calling subroutine, if known
 874
 875 =back
 876
 877 =for html </blockquote>
 878
 879 =cut
 880
 881   return
 882     unless $trace;
 883
 884   $msg    = $msg  ? ": $msg" : '';
 885   $type ||= 'In';
 886
 887   croak 'Type should be ENTER, EXIT or undef'
 888     unless $type eq 'ENTER' ||
 889            $type eq 'EXIT'  ||
 890            $type eq 'In';
 891
 892   my $stack = $type eq 'In' ? 1 : 2;
 893
 894   my ($package, $filename, $line, $subroutine) = caller ($stack);
 895
 896   if ($subroutine) {
 897     $subroutine =~ s/^main:://
 898   } else {
 899     $subroutine = 'main';
 900   } # if
 901
 902   if (-t STDOUT) {
 903     display color ('cyan')
 904           . "$type "
 905           . color ('yellow')
 906           . color ('bold')
 907           . $subroutine
 908           . color ('reset')
 909           . $msg;
 910   } else {
 911     display "$type $subroutine$msg";
 912   } # if
 913
 914   return $subroutine;
 915 } # trace
 916
 917 sub trace_enter (;$) {
 918   my ($msg) = @_;
 919
 920 =pod
 921
 922 =head2 trace_enter
 923
 924 Emit enter trace for a subroutine
 925
 926 Parameters:
 927
 928 =for html <blockquote>
 929
 930 =over
 931
 932 =item msg
 933
 934 Optional message to display along with "ENTER <sub>"
 935
 936 =back
 937
 938 =for html </blockquote>
 939
 940 Returns:
 941
 942 =for html <blockquote>
 943
 944 =over
 945
 946 =item Name of the calling subroutine, if known
 947
 948 =back
 949
 950 =for html </blockquote>
 951
 952 =cut
 953
 954   return trace $msg, "ENTER";
 955 } # trace_enter
 956
 957 sub trace_exit (;$) {
 958   my ($msg) = @_;
 959
 960 =pod
 961
 962 =head2 trace_exit
 963
 964 Emit exit trace for a subroutine
 965
 966 Parameters:
 967
 968 =for html <blockquote>
 969
 970 =over
 971
 972 =item msg
 973
 974 Optional message to display along with "EXIT <sub>". Useful in
 975 distinguishing multiple exit/returns.
 976
 977 =back
 978
 979 =for html </blockquote>
 980
 981 Returns:
 982
 983 =for html <blockquote>
 984
 985 =over
 986
 987 =item none
 988
 989 =back
 990
 991 =for html </blockquote>
 992
 993 =cut
 994
 995   trace $msg, "EXIT";
 996
 997   return
 998 } # trace_exit
 999
1000 sub verbose ($;$$$) {
1001   my ($msg, $handle, $nolinefeed, $level) = @_;
1002
1003 =pod
1004
1005 =head2 verbose[1-3] ($msg, $handle, $nolinefeed, $level)
1006
1007 Write $msg to $handle (default STDOUT) with a "\n" unless $nolinefeed
1008 is defined. Messages are written only if written if $verbose is set
1009 and <= $level. $level defaults to 1.
1010
1011 verbose1, verbose2 and verbose3 are setup as convienence functions
1012 that are equivalent to calling verbose with $level set to 1, 2 or 3
1013 respectively
1014
1015 Parameters:
1016
1017 =for html <blockquote>
1018
1019 =over
1020
1021 =item $msg
1022
1023 Message to display
1024
1025 =item $handle
1026
1027 File handle to display to (Default: STDOUT)
1028
1029 =item $nolinefeed
1030
1031 If defined no linefeed is displayed at the end of the message.
1032
1033 =item $level
1034
1035 If defined, if $level <= $verbose then the verbose message is
1036 displayed.
1037
1038 =back
1039
1040 =for html </blockquote>
1041
1042 Returns:
1043
1044 =for html <blockquote>
1045
1046 =over
1047
1048 =item Nothing
1049
1050 =back
1051
1052 =for html </blockquote>
1053
1054 =cut
1055
1056   $level   ||= 1;
1057   $verbose ||= 0;
1058
1059   display $msg, $handle, $nolinefeed if $verbose and $level <= $verbose;
1060
1061   return;
1062 } # verbose
1063
1064 sub verbose1 ($;$$) {
1065   my ($msg, $handle, $nolinefeed) = @_;
1066
1067   verbose $msg, $$handle, $nolinefeed, 1;
1068
1069   return;
1070 } # verbose1
1071
1072 sub verbose2 ($;$$) {
1073   my ($msg, $handle, $nolinefeed) = @_;
1074
1075   verbose $msg, $handle, $nolinefeed, 2;
1076
1077   return;
1078 } # verbose1
1079
1080 sub verbose3 ($;$$) {
1081   my ($msg, $handle, $nolinefeed) = @_;
1082
1083   verbose $msg, $handle, $nolinefeed, 3;
1084
1085   return;
1086 } # verbose1
1087
1088 sub verbose_nolf ($;$) {
1089   my ($msg, $handle) = @_;
1090
1091 =pod
1092
1093 =head2 verbose_nolf ($msg, $handle)
1094
1095 Equivalent of verbose ($msg, $handle, "nolf")
1096
1097 Parameters:
1098
1099 =for html <blockquote>
1100
1101 =over
1102
1103 =item $msg
1104
1105 Message to display
1106
1107 =item $handle
1108
1109 File handle to display to (Default: STDOUT)
1110
1111 =back
1112
1113 =for html </blockquote>
1114
1115 Returns:
1116
1117 =for html <blockquote>
1118
1119 =over
1120
1121 =item Nothing
1122
1123 =back
1124
1125 =for html </blockquote>
1126
1127 =cut
1128
1129   verbose $msg, $handle, "nolf";
1130
1131   return;
1132 } # verbose_nolf
1133
1134 sub warning ($;$$$) {
1135   my ($msg, $warnno, $handle, $nolinefeed) = @_;
1136
1137 =pod
1138
1139 =head2 warning  ($msg, $handle, $nolinefeed)
1140
1141 Write $msg to $handle (default STDERR) with a "\n" unless $nolinefeed
1142 is defined. Preface message with "<script name>: WARNING: " so that
1143 warning messages are clearly distinguishable.
1144
1145 Parameters:
1146
1147 =for html <blockquote>
1148
1149 =over
1150
1151 =item $msg:
1152
1153 Message to display
1154
1155 =item $handle:
1156
1157 File handle to display to (Default: STDOUT)
1158
1159 =item $nolinefeed:
1160
1161 If defined no linefeed is displayed at the end of the message.
1162
1163 =back
1164
1165 =for html </blockquote>
1166
1167 Returns:
1168
1169 =for html <blockquote>
1170
1171 =over
1172
1173 =item Nothing
1174
1175 =back
1176
1177 =for html </blockquote>
1178
1179 =cut
1180
1181   $msg ||= '';
1182
1183   unless ($warnno) {
1184     if (($handle and -t $handle) or (-t *STDERR) and ($Config{perl} ne 'ratlperl')) {
1185       $msg = color ('cyan')
1186            . $me
1187            . color ('reset')
1188            . ": "
1189            . color ('yellow')
1190            . "WARNING"
1191            . color ('reset')
1192            . ": $msg";
1193     } else {
1194       $msg = "$me: WARNING: $msg";
1195     } # if
1196   } else {
1197     if (($handle and -t $handle) or (-t *STDERR) and ($Config{perl} ne 'ratlperl')) {
1198       $msg = color ('cyan')
1199            . $me
1200            . color ('reset')
1201            . ": "
1202            . color ('yellow')
1203            . "WARNING #$warnno"
1204            . color ('reset')
1205            . ": $msg";
1206     } else {
1207       $msg = "$me: WARNING #$warnno: $msg";
1208     } # if
1209   } # if
1210
1211   display_err $msg, $handle, $nolinefeed;
1212
1213   return;
1214 } # warning
1215
1216 1;
1217
1218 =pod
1219
1220 =head1 CONFIGURATION AND ENVIRONMENT
1221
1222 DEBUG: If set then $debug is set to this level.
1223
1224 VERBOSE: If set then $verbose is set to this level.
1225
1226 TRACE: If set then $trace is set to this level.
1227
1228 =head1 DEPENDENCIES
1229
1230 =head2 Perl Modules
1231
1232 L<File::Spec|File::Spec>
1233
1234 L<Term::ANSIColor|Term::ANSIColor>
1235
1236 =head1 INCOMPATABILITIES
1237
1238 None yet...
1239
1240 =head1 BUGS AND LIMITATIONS
1241
1242 There are no known bugs in this module.
1243
1244 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1245
1246 =head1 LICENSE AND COPYRIGHT
1247
1248 This Perl Module is freely available; you can redistribute it and/or
1249 modify it under the terms of the GNU General Public License as
1250 published by the Free Software Foundation; either version 2 of the
1251 License, or (at your option) any later version.
1252
1253 This Perl Module is distributed in the hope that it will be useful,
1254 but WITHOUT ANY WARRANTY; without even the implied warranty of
1255 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1256 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
1257 details.
1258
1259 You should have received a copy of the GNU General Public License
1260 along with this Perl Module; if not, write to the Free Software Foundation,
1261 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1262 reserved.
1263
1264 =cut