1# *********************************************************************** 2# Report * 3# * 4# Discussion: * 5# * 6# Input: * 7# Output: * 8# Manager: D. Huggins (email removed) * 9# Company: Full-Duplex Communications Corporation * 10# http://www.full-duplex.com * 11# http://www.in-brandon.com * 12# Start: Wednesday, 17 January, 2007 * 13# Version: 1.004 * 14# Release: 07.07.09.09:06 * 15# Status: PRODUCTION * 16# *********************************************************************** 17 18# All rights reserved by Full-Duplex Communications Corporation 19# Copyright 2003 - 2007 20package Text::Report; 21 22$Text::Report::VERSION = '1.004'; 23@Text::Report::ISA = qw(Text); 24 25 26BEGIN 27{ 28 eval "use Storable qw(store retrieve dclone)"; 29 $Text::Report::stor_loaded = $@ ? 0 : 1; 30}; 31 32use strict; 33# use warnings; 34 35use vars qw/ $VERSION @ISA/; 36 37# use Data::Dumper; 38use Carp; 39 40 41our $AUTOLOAD; 42 43 44my %debug_lev = 45 ( 46 'off' => 0, 47 'notice' => 1, 48 'warning' => 2, 49 'error' => 3, 50 'critical' => 4, 51 ); 52 531; 54 55 56# autoindex => 1/0, # Report.pm sets print order of blocks based upon 57# creation (defblock()) order; DEFAULT=1 (strongly recommended) 58# logfh => *FH 59# debug => ['off' | 'notice' | ...] str # Sets debug level; Default is 'critical' 60# debugv => 1/0 # carp longmess | shortmess 61# autoindex => 1/0 # If set (DEFAULT), Report.pm will index block print 62# order in the same order as the block was defblock'd 63sub new 64{ 65 my $class = shift; 66 my %this = @_; 67 68 my $self = {}; 69 70 $self->{_page}{_index} = 0; 71 72 $self->{_page}{_line} = 73 { 74 'dotted_line' => '.', 75 'dbl_line' => '=', 76 'single_line' => '-', 77 'under_line' => '_', 78 'blank_line' => ' ', 79 }; 80 81 bless $self, $class; 82 83 # --- Build the default _report --- # 84 $self->_default_report('report'); 85 86 # --- Changed 'Log' to 'logfh' in v1.003 --- # 87 if($this{Log}){$this{logfh} = $this{Log};} 88 89 # ---------------------------------------- # 90 # --- Either we get a FH or use STDOUT --- # 91 # ---------------------------------------- # 92 $self->{_log}{_file} = ref $this{logfh} ? $this{logfh} : \*STDOUT; 93 $self->{_debug}{_lev} = $this{debug} ? $debug_lev{$this{debug}} : 1; 94 $self->{_debug}{_verbose} = $this{debugv} ? 1 : 0; 95 96 # ------------------------------------------------ # 97 # --- $this{autoindex} can only be set on init --- # 98 # ------------------------------------------------ # 99 $self->{_page}{_profile}{report}{autoindex} = $this{autoindex} ? $this{autoindex} : 1; 100 101 delete $this{logfh}; delete $this{debug}; delete $this{debugv}; 102 103 # --- Build the default _block --- # 104 $self->_default_block('_block'); 105 106 # ---------------------------------------------------- # 107 # --- Build the report page layout w/modifications --- # 108 # --- to the default block, if any --- # 109 # ---------------------------------------------------- # 110 $self->configure(%this); 111 112 return $self; 113} 114 115# --- Define Report Properties --- # 116# width => int, # Report width DEFAULT=80 117# asis => 1/0, # Report.pm sets all block titles to caps & adds underline; DEFAULT=0 118# debug => [off|notice|error|warning|critical] # Level of debug; DEFAULT='warning' 119# debugv => 1/0 # Verbose mode using carp(longmess|shortmess) 120# blockPad => {top => int, bottom => int} # Set global block padding 121# column => int => {width => int, align => 'left', head => 'str'} 122# useColHeaders => 1/0 # Off (DEFAULT) means that no col headers will be printed or auto generated 123# sortby => int # Col number to sort 2-dimensional array; Zero for no sort oder 124sub configure 125{ 126 my $self = shift; 127 128 my %this = @_ ? @_ : return(undef); 129 130 my @idx = keys %{$self->{_page}{_profile}{report}}; 131 132 for(@idx) 133 { 134 next if /^autoindex$/; 135 if(defined $this{$_}){$self->{_page}{_profile}{report}{$_} = $this{$_}} 136 } 137 138 $self->{_debug}{_lev} = $debug_lev{ $this{debug} } if defined $this{debug} && 139 $this{debug} =~ /^(off|notice|error|warning|critical)$/i; 140 $self->{_debug}{_verbose} = $this{debugv} if defined $this{debugv}; 141 142 143 # --- To use or not to use Headers --- # 144 $self->{_block}{_profile}{'_block'}{useColHeaders} = $this{useColHeaders} 145 if defined $this{useColHeaders}; 146 147 # --- Set column to sort by (zero/undef = no sort) --- # 148 $self->{_block}{_profile}{'_block'}{sortby} = $this{sortby} 149 if defined $this{sortby} && $this{sortby} =~ /^\d+$/; 150 151 if(defined $this{width}) 152 { 153 # --- Set default page width --- # 154 $self->{_page}{_profile}{report}{width} = $this{width}; 155 # --- Set default block col width --- # 156 $self->{_block}{_profile}{'_block'}{column}{1}{width} = $this{width}; 157 } 158 159 # -------------------------------------------------- # 160 # --- Overwrite any existing (eg default _block) --- # 161 # --- col def's --- # 162 # -------------------------------------------------- # 163 if($this{column}) 164 { 165 return undef unless $this{column} =~ /HASH/; 166 # --- Test keys - Expect int --- # 167 my @int = keys %{$this{column}} || return undef; 168 for(@int){return undef unless /^\d+$/;} 169 delete $self->{_block}{_profile}{'_block'}{column}; # reset 170 171 foreach my $col(keys %{$this{column}}) 172 { 173 $self->setcol('_block', $col, %{$this{column}{$col}}); 174 } 175 } 176 177 if(defined $this{blockPad}) 178 { 179 eval{ 180 for(keys %{$self->{_block}{_profile}{'_block'}{pad}}) 181 { 182 $self->{_block}{_profile}{'_block'}{pad}{$_} = $this{blockPad}{$_} 183 if defined $this{blockPad}{$_}; 184 }}; 185 186 if($@) 187 { 188 $self->_debug(4, "configure(pad => {top => int, bottom => int}) syntax - $@"); 189 return undef; 190 } 191 } 192 193 $self; 194} 195 196# --- Define Block Properties --- # 197# name => 'sd1', # No name, no define 198# title => 'Sample Data One', # DEFAULT - undef 199# order => $order_idx++, # Block print order, only used if new(autoindex => 0) 200# sortby => 1, # Column to sort. DEFAULT=0 (no sorting) 201# sorttype => 'alpha', # DEFAULT: 'alpha' | 'numeric' 202# orderby => 'ascending', # DEFAULT: 'ascending' | 'descending' 203# useColHeaders => 0, # Set to 1 to display headers & header underlines at col head 204# column => {1 => {width => 10, align => 'left', head => 'ColOne',},}, # head is opt 205# cols => int GT zero # Tell Report.pm to autocreate x number of cols; Used INSTEAD of columns{} 206# pad => {top => int, bottom => int} # Number of blank lines to pad beginning & end of block 207# columnWidth => int GT zero # Set block default widths 208# columnAlign => [left|right|center] # Set block default alignments 209sub defblock # Define Block - New blocks only 210{ 211 my $self = shift; 212 my %this = @_; 213 214 # -------------------------- # 215 # --- Need a block name --- # 216 # -------------------------- # 217 unless(defined $this{name}) 218 { 219 $self->_debug(3, 220 "defblock() Attempt to create a block with no \'name\'. ". 221 "Modify the default block using setblock() or call defblock() ". 222 "using defblock( name => \'block_name\')"); 223 224 return(undef); 225 } 226 227 # ------------------------------------------- # 228 # --- Use configure() to alter the global --- # 229 # --- properties of the default '_block' --- # 230 # ------------------------------------------- # 231 if($this{name} =~ /^\_block/) 232 { 233 $self->_debug(3, 234 "defblock(name => \'_block\') Attempt to create a block with default block name. ". 235 "Modify the default block using configure() or call defblock() ". 236 "using defblock( name => \'block_name\')"); 237 238 return(undef); 239 } 240 241 my $blockname = $this{name}; 242 243 my $cols; 244 245 # ------------------------------------------------ # 246 # --- Do not allow the caller to use defblock --- # 247 # --- if it has already been def'd. Send the --- # 248 # --- caller to delblock() --- # 249 # ------------------------------------------------ # 250 if(defined $self->{_block}{_profile}{$blockname}) 251 { 252 $self->_debug(2, 253 "defblock() Attempt to create an already defined block. ". 254 "Modify block using setblock() or delete block first using ". 255 "delblock(\'block_name\')"); 256 257 return(undef); 258 } 259 260 # --------------------------- # 261 # --- Assign the defaults --- # 262 # --------------------------- # 263 unless(defined $self->{_block}{_profile}{$blockname}) 264 { 265 $self->_assign_def_block($blockname); 266 } 267 268 # ------------------------- # 269 # --- Block-end padding --- # 270 # ------------------------- # 271 eval{ 272 if(defined $this{pad}{top} && $this{pad}{top} =~ /^\d+$/) 273 { 274 $self->{_block}{_profile}{$blockname}{pad}{top} = $this{pad}{top}; 275 } 276 else 277 { 278 $self->{_block}{_profile}{$blockname}{pad}{top} = $self->{_block}{_profile}{'_block'}{pad}{top}; 279 } 280 if(defined $this{pad}{bottom} && $this{pad}{bottom} =~ /^\d+$/) 281 { 282 $self->{_block}{_profile}{$blockname}{pad}{bottom} = $this{pad}{bottom}; 283 } 284 else 285 { 286 $self->{_block}{_profile}{$blockname}{pad}{bottom} = $self->{_block}{_profile}{'_block'}{pad}{bottom}; 287 }}; 288 289 # --- Trap incomplete hash --- # 290 if($@){$self->_debug(4, "defblock(pad => {top => int, bottom => int}) syntax - $@"); return undef} 291 292 # ------------------- # 293 # --- Block Title --- # 294 # ------------------- # 295 $self->{_block}{_profile}{$blockname}{title} = $this{title} || undef; 296 297 # -------------------------------------------------- # 298 # --- Does caller want us to automatically build --- # 299 # --- headers for this block? setcol() handles --- # 300 # --- the rest --- # 301 # -------------------------------------------------- # 302 if(defined $this{useColHeaders}) 303 { 304 $self->{_block}{_profile}{$blockname}{useColHeaders} = $this{useColHeaders}; 305 } 306 else 307 { 308 $self->{_block}{_profile}{$blockname}{useColHeaders} = $self->{_block}{_profile}{'_block'}{useColHeaders} 309 } 310 311 # --------------------------------------------- # 312 # --- Did the caller pass default alignment --- # 313 # --- &/or col width? If so, get these set --- # 314 # --- before cols are built --- # 315 # --------------------------------------------- # 316 if(defined $this{columnWidth} && $this{columnWidth} =~ /^\d+$/ && $this{columnWidth} > 0) 317 { 318 $self->{_block}{_profile}{$blockname}{width} = $this{columnWidth}; 319 320 # ------------------------------------------- # 321 # --- Col 1 is pre-defined at 'center'/80 --- # 322 # --- Adjust here --- # 323 # ------------------------------------------- # 324 $self->{_block}{_profile}{$blockname}{'column'}{1}{'width'} = $this{columnWidth}; 325 326 } 327 else 328 { 329 $self->{_block}{_profile}{$blockname}{width} = $self->{_page}{_profile}{report}{width}; 330 } 331 332 if(defined $this{columnAlign} && $this{columnAlign} =~ /^(left|right|center)$/i) 333 { 334 $self->{_block}{_profile}{$blockname}{align} = lc($this{columnAlign}); 335 336 # ------------------------------------------- # 337 # --- Col 1 is pre-defined at 'center'/80 --- # 338 # --- Adjust here --- # 339 # ------------------------------------------- # 340 $self->{_block}{_profile}{$blockname}{'column'}{1}{'align'} = lc($this{columnAlign}); 341 } 342 343 # -------------------------------------------------- # 344 # --- Overwrite any existing (eg default _block) --- # 345 # --- col def's --- # 346 # -------------------------------------------------- # 347 if($this{column}) 348 { 349 delete $self->{_block}{_profile}{$blockname}{column}; # reset 350 351 foreach my $col(keys %{$this{column}}) 352 { 353 $self->setcol($blockname, $col, %{$this{column}{$col}}); 354 } 355 } 356 # ----------------------------------------------------------------------- # 357 # --- Allow caller to generate cols using preset default width, align --- # 358 # --- Column widths are calc'd by dividing the current page width by --- # 359 # --- number of columns unless we are passed a columnWidth. An --- # 360 # --- attempt is made to use it. If the total width is GT the page --- # 361 # --- width, then we revert to calc'ing using prev formula --- # 362 # ----------------------------------------------------------------------- # 363 elsif(defined $this{cols} && $this{cols} =~ /^\d+$/ && $this{cols} > 0) 364 { 365 # --- Clear existing columns --- # 366 delete $self->{_block}{_profile}{$blockname}{column}; # reset 367 368 # ----------------------------------------------- # 369 # --- Next, make sure all of this is going to --- # 370 # --- fit on the report page --- # 371 # ----------------------------------------------- # 372 my $pg_width = $self->{_page}{_profile}{report}{width}; 373 my $tl_block_width = $this{cols} * ($self->{_block}{_profile}{$blockname}{width}); 374 375 # ------------------------------- # 376 # --- If it doesn't, force it --- # 377 # ------------------------------- # 378 if($tl_block_width > $pg_width) 379 { 380 # -------------------------------------------------- # 381 # --- Recalc col width based upon the page width --- # 382 # --- divided by number of cols requested --- # 383 # -------------------------------------------------- # 384 eval{$self->{_block}{_profile}{$blockname}{width} = 385 ($self->{_page}{_profile}{report}{width} / $this{cols});}; 386 387 # --- $this{cols} is > zero, so shouldn't be a prob --- # 388 if($@){$self->_debug(2, "Col width 102 calc err for block ($blockname) - $@");} 389 390 # --- Clean up --- # 391 $self->{_block}{_profile}{$blockname}{width} = 392 sprintf("%0.0f\n", $self->{_block}{_profile}{$blockname}{width}); 393 394 # --- Adjust --- # 395 $self->{_block}{_profile}{$blockname}{width} -= 2; 396 397 $self->_debug(1, "Calculated col width = ". 398 "$self->{_block}{_profile}{$blockname}{width} for block ($blockname)"); 399 } 400 401 for(my $i = 1; $i <= $this{cols}; $i++) 402 { 403 $self->setcol($blockname, $i, 404 width => $self->{_block}{_profile}{$blockname}{width}, 405 align => $self->{_block}{_profile}{$blockname}{align}, 406 head => $this{head}->[$i-1], 407 ); 408 } 409 } 410 # --- Otherwise use the default: 1 col, center, 80 chars wide --- # 411 412 413 # ----------------------------------- # 414 # --- Determine block print order --- # 415 # ----------------------------------- # 416 if($self->{_page}{_profile}{report}{autoindex}) 417 { 418 # --- Add auto print sequence to _order --- # 419 $self->{_order}{_block}{$self->{_page}{_index}++} = $blockname; 420 } 421 else 422 { 423 unless($this{order} =~ /^\d+$/) 424 { 425 $self->_debug(3, 426 "defblock(order) Need print order sequence number to process block ". 427 "$blockname. Call defblock() using defblock(order => int)"); 428 429 return(undef); 430 } 431 432 $self->{_order}{_block}{$this{order}} = $blockname; 433 } 434 435 # --------------------------------- # 436 # --- Define column to sort on --- # 437 # --- The DEFAULT is no sorting --- # 438 # --------------------------------- # 439 if(defined $this{sortby} && $this{sortby} =~ /^\d+$/) 440 { 441 $self->{_block}{_profile}{$blockname}{sortby} = $this{sortby}; 442 } 443 444 # --------------------------------- # 445 # --- Define sort type --- # 446 # --------------------------------- # 447 if(defined $this{sorttype} && $this{sorttype} =~ /^(alpha|numeric)$/i) 448 { 449 $self->{_block}{_profile}{$blockname}{sorttype} = lc($this{sorttype}); 450 } 451 452 # -------------------------------- # 453 # --- Define sort direction --- # 454 # -------------------------------- # 455 if(defined $this{orderby} && $this{orderby} =~ /^(ascending|descending)$/i) 456 { 457 $self->{_block}{_profile}{$blockname}{orderby} = lc($this{orderby}); 458 } 459 460 $self; 461} 462# --- Alter An Existing Block's Properties --- # 463# title => 'Sample Data One', # DEFAULT - undef 464# order => $order_idx++, # Block print order, only used if new(autoindex => 0) 465# sortby => 1, # Column to sort. DEFAULT=0 466# sorttype => 'alpha', # DEFAULT: 'alpha' | 'numeric' 467# orderby => 'ascending', # DEFAULT: 'ascending' | 'descending' 468# pad => {top => int, bottom => int} # Number of blank lines to pad beginning & end of block 469# useColHeaders => 1/0 # Turn on/off column headers & their assoc underlines 470sub setblock 471{ 472 my $self = shift; 473 474 my %this = @_ ? @_ : return(undef); 475 476 my $blockname; 477 478 return undef unless $blockname = $this{name}; 479 480 # ----------------------------------------- # 481 # --- Do not modify the default '_block --- # 482 # --- here - Use configure() --- # 483 # ----------------------------------------- # 484 return undef if $blockname =~ /^\_block$/; 485 486 # --------------------------------------------------------- # 487 # --- This method is only for modifying existing blocks --- # 488 # --------------------------------------------------------- # 489 unless(defined $self->{_block}{_profile}{$blockname}) 490 { 491 $self->_debug(3, "setblock() Attempt to modify a non-defined block. ". 492 "Create block using defblock()"); 493 return undef; 494 } 495 496 # ------------------------- # 497 # --- Block-end padding --- # 498 # ------------------------- # 499 eval{ 500 if(defined $this{pad}{top} && $this{pad}{top} =~ /^\d+$/) 501 { 502 $self->{_block}{_profile}{$blockname}{pad}{top} = $this{pad}{top}; 503 } 504 else 505 { 506 $self->{_block}{_profile}{$blockname}{pad}{top} = $self->{_block}{_profile}{_block}{pad}{top}; 507 } 508 if(defined $this{pad}{bottom} && $this{pad}{bottom} =~ /^\d+$/) 509 { 510 $self->{_block}{_profile}{$blockname}{pad}{bottom} = $this{pad}{bottom}; 511 } 512 else 513 { 514 $self->{_block}{_profile}{$blockname}{pad}{bottom} = $self->{_block}{_profile}{_block}{pad}{bottom}; 515 }}; 516 517 # --- Trap incomplete hash --- # 518 if($@){$self->_debug(4, "setblock(pad => {top => int, bottom => int}) syntax - $@"); return undef} 519 520 # ------------------- # 521 # --- Block Title --- # 522 # ------------------- # 523 $self->{_block}{_profile}{$blockname}{title} = $this{title} if defined $this{title}; 524 525 # ---------------------- # 526 # --- Column Headers --- # 527 # ---------------------- # 528 $self->{_block}{_profile}{$blockname}{useColHeaders} = $this{useColHeaders} if defined $this{useColHeaders}; 529 530 # ----------------------------------- # 531 # --- Determine block print order --- # 532 # ----------------------------------- # 533 if(defined $this{order} && $this{order} =~ /^\d+$/) 534 { 535 if($self->{_page}{_profile}{report}{autoindex}) 536 { 537 $self->_debug(2, 'setblock() Cannot set order if Report object init\'d with autoindex. '. 538 'Create Text::Report->new(autoindex => 0) the default is on'); 539 } 540 else{$self->{_order}{_block}{$this{order}} = $blockname;} 541 } 542 543 # --------------------------------- # 544 # --- Define column to sort on --- # 545 # --- The DEFAULT is no sorting --- # 546 # --------------------------------- # 547 if(defined $this{sortby} && $this{sortby} =~ /^\d+$/) 548 { 549 $self->{_block}{_profile}{$blockname}{sortby} = $this{sortby}; 550 } 551 552 # -------------------------------- # 553 # --- Define sort type --- # 554 # -------------------------------- # 555 if(defined $this{sorttype} && $this{sorttype} =~ /^(alpha|numeric)$/i) 556 { 557 $self->{_block}{_profile}{$blockname}{sorttype} = lc($this{sorttype}); 558 } 559 560 # -------------------------------- # 561 # --- Define sort direction --- # 562 # -------------------------------- # 563 if(defined $this{orderby} && $this{orderby} =~ /^(ascending|descending)$/i) 564 { 565 $self->{_block}{_profile}{$blockname}{orderby} = lc($this{orderby}); 566 } 567 568 $self; 569} 570# Set/change Column Properties 571# $obj->setcol($blockname, $colnumber, align => [left|right|center], width => int, head => 'str') 572# align => [left|right|center] # 573# width => int GT zero # 574# head => 'str' # Column header 575sub setcol 576{ 577 my $self = shift; 578 my $blockname = shift; 579 my $number = shift; 580 581 my %this = @_ ? @_ : return(undef); 582 583 return undef unless $number =~ /^\d+$/; 584 585 unless(defined $blockname){$blockname = '_block';} 586 587 588 # ---------------------------------------- # 589 # --- If the caller has not def'd this --- # 590 # --- $blockname, right back at 'em --- # 591 # ---------------------------------------- # 592 unless(defined $self->{_block}{_profile}{$blockname}) 593 { 594 $self->_debug(3, "setcol() Attempt to modify a non-defined block. ". 595 "Create block first using defblock()"); 596 return undef; 597 } 598 599 if(defined $this{align} && $this{align} =~ /^(left|right|center)$/i) 600 { 601 $self->{_block}{_profile}{$blockname}{column}{$number}{align} = lc($this{align}); 602 } 603 else # use our built-in default 604 { 605 unless(exists $self->{_block}{_profile}{$blockname}{column}{$number}{align}) 606 { 607 $self->{_block}{_profile}{$blockname}{column}{$number}{align} = $self->{_block}{_profile}{$blockname}{align}; 608 $self->_debug(1, "setcol(align) param not set for col number \"$number\". ". 609 "Defining col align as \"$self->{_block}{_profile}{$blockname}{align}\""); 610 } 611 } 612 613 if(defined $this{width} && $this{width} =~ /^\d+$/ && $this{width} > 0) 614 { 615 $self->{_block}{_profile}{$blockname}{column}{$number}{width} = $this{width}; 616 } 617 else 618 { 619 unless(exists $self->{_block}{_profile}{$blockname}{column}{$number}{width}) 620 { 621 $self->{_block}{_profile}{$blockname}{column}{$number}{width} = $self->{_block}{_profile}{$blockname}{width}; 622 $self->_debug(1, "setcol(width) param not set for col number \"$number\". ". 623 "Defining col width as \"$self->{_block}{_profile}{$blockname}{width}\""); 624 } 625 } 626 627 if(defined $this{head}) 628 { 629 $self->{_block}{_profile}{$blockname}{column}{$number}{head} = $this{head}; 630 } 631 else 632 { 633 if($self->{_block}{_profile}{$blockname}{useColHeaders}) 634 { 635 unless(exists $self->{_block}{_profile}{$blockname}{column}{$number}{head}) 636 { 637 $self->{_block}{_profile}{$blockname}{column}{$number}{head} = $number; 638 $self->_debug(1, "setcol(\'block_name\', col_num, head => ". 639 "\"Header Title\") param not set \& \'useColHeaders\' flag ". 640 "is set. Defining col header as \"$number\""); 641 } 642 } 643 } 644 645 $self; 646} 647 648# Insert a page separation line 649# order => int # unless autoindex is set 650# pad => {top => int, bottom => int} 651# width => int # override the default width (page width) 652sub insert 653{ 654 my $self = shift; 655 my $line_type = shift; 656 my %this = @_; 657 658 my $blockname; 659 660 # ----------------------------------- # 661 # --- Determine block print order --- # 662 # ----------------------------------- # 663 if($self->{_page}{_profile}{report}{autoindex}) 664 { 665 $blockname = "__separator_$self->{_page}{_index}"; 666 667 # ----------------------------------------- # 668 # --- Add auto print sequence to _order --- # 669 # ----------------------------------------- # 670 $self->{_order}{_block}{$self->{_page}{_index}++} = $blockname; 671 } 672 else 673 { 674 unless($this{order} =~ /^\d+$/) 675 { 676 $self->_debug(3, 677 "insert(order) Need print order sequence number to process ". 678 "separator. Call insert() using insert(\'line_type\', order => int)"); 679 680 return(undef); 681 } 682 683 $blockname = "__separator_$this{order}"; 684 685 $self->{_order}{_block}{$this{order}} = $blockname; 686 } 687 688 # --- Create a new block --- # 689 $self->_default_block($blockname); 690 691 # --- No headers will be used --- # 692 $self->{_block}{_profile}{$blockname}{useColHeaders} = 0; 693 694 # --- Set width - either by callers specs or use page def --- # 695 $self->{_block}{_profile}{$blockname}{width} = $this{width} || $self->{_page}{_profile}{report}{width}; 696 697 # --- Reset, if necessary, the col width --- # 698 $self->setcol($blockname, 1, width => $self->{_block}{_profile}{$blockname}{width}); 699 700 # ------------------------------------ # 701 # --- Set padding if any requested --- # 702 # --- --- # 703 # --- We don't use the default pad --- # 704 # --- here. The caller must --- # 705 # --- specifically request padding --- # 706 # ------------------------------------ # 707 my @insert; 708 709 if(defined $this{pad}) 710 { 711 eval{ 712 for(1 .. $this{pad}{top}) 713 {push(@insert, [$self->_draw_line('blank_line', $self->{_page}{_profile}{report}{width})]);} 714 715 push(@insert, [$self->_draw_line($line_type, $self->{_page}{_profile}{report}{width})]); 716 717 for(1 .. $this{pad}{bottom}) 718 {push(@insert, [$self->_draw_line('blank_line', $self->{_page}{_profile}{report}{width})]);}}; 719 } 720 else 721 { 722 push(@insert, [$self->_draw_line($line_type, $self->{_page}{_profile}{report}{width})]); 723 } 724 725 $self->fill_block($blockname, @insert); 726 $self; 727} 728########################### 729# $obj->fill_block('named_block', @AoA) 730# 731# Fill formatted, named block w/data 732# passed to us in table form where 733# @_ = [array1],[array2],[array3]... 734sub fill_block 735{ 736 my $self = shift; 737 my $blockname = shift; 738 my @table = @_; # AoA 739 740 unless(defined $self->{_block}{_profile}{$blockname}) 741 { 742 $self->_debug(3, "fill_block() Attempt to fill a non-defined block. ". 743 "Create block first using defblock()"); 744 return undef; 745 } 746 747 my @fCol; my @csv; 748 749 my %align = (left => '<', center => '|', right => '>', ); 750 751 my @col_head; 752 753 foreach my $col(sort _numeric(keys %{$self->{_block}{_profile}{$blockname}{column}})) 754 { 755 # ---------------------- # 756 # --- Column attribs --- # 757 # ---------------------- # 758 my $align = $align{ $self->{_block}{_profile}{$blockname}{column}{$col}{align} }; 759 my $width = $self->{_block}{_profile}{$blockname}{column}{$col}{width}; 760 761 # ---------------------- # 762 # --- Column header --- # 763 # ---------------------- # 764 if(defined $self->{_block}{_profile}{$blockname}{column}{$col}{head}) 765 { 766 push(@col_head, $self->{_block}{_profile}{$blockname}{column}{$col}{head}); 767 } 768 769 push(@fCol, '@'.$align x $width); 770 } 771 772 my $columns = join(" ", @fCol); 773 774 775 my $format = 'formline <<"END", @data;'."\n".'$columns'."\n"."END"; 776 777 # ------------------------------------------------------------ # 778 # --- Build title & column headers first time through only --- # 779 # ------------------------------------------------------------ # 780 unless($self->{_block}{_profile}{$blockname}{_append}) 781 { 782 $self->{_block}{_profile}{$blockname}{_append} = 1; 783 # ------------------- # 784 # --- Place Title --- # 785 # ------------------- # 786 if($self->{_block}{_profile}{$blockname}{title}) 787 { 788 unless($self->{_page}{_profile}{report}{asis}) 789 { 790 # --- Store title & header data in {hdata} --- # 791 # --- to retain for template building --- # 792 push(@{$self->{_block}{_profile}{$blockname}{hdata}}, uc($self->{_block}{_profile}{$blockname}{title})); 793 794 # --- Title Underline --- # 795 my @chars = split('', $self->{_block}{_profile}{$blockname}{title}); # Get char count 796 push(@{$self->{_block}{_profile}{$blockname}{hdata}}, ($self->_draw_line('single_line', scalar(@chars)))); 797 798 push(@csv, uc($self->{_block}{_profile}{$blockname}{title})); 799 } 800 else 801 { 802 push(@{$self->{_block}{_profile}{$blockname}{hdata}}, $self->{_block}{_profile}{$blockname}{title}); 803 push(@csv, $self->{_block}{_profile}{$blockname}{title}); 804 } 805 806 # --------------------------- # 807 # --- Pad the block title --- # 808 # --- CONSTANT --- # 809 # --------------------------- # 810 unless($self->{_page}{_profile}{report}{asis}) 811 { 812 push(@{$self->{_block}{_profile}{$blockname}{hdata}}, ($self->_draw_line('blank_line', 1))); 813 } 814 } 815 816 if($self->{_block}{_profile}{$blockname}{useColHeaders}) 817 { 818 # ---------------------------- # 819 # --- Build Column Headers --- # 820 # ---------------------------- # 821 my @data = @col_head; 822 823 eval $format; 824 825 if($@){$self->_debug(3, "Internal/system Error - $@");} # Who the hell knows? 826 827 chomp($^A); 828 push(@{$self->{_block}{_profile}{$blockname}{hdata}}, $^A); 829 $^A = ''; 830 831 # -------------------------------- # 832 # --- Column Header Underlines --- # 833 # -------------------------------- # 834 my @col_underline; 835 836 my $i = 0; 837 for(@col_head) 838 { 839 my $chars = $self->{_block}{_profile}{$blockname}{column}{++$i}{width}; # Width of col 840 push(@col_underline, ($self->_draw_line('under_line', $chars))); 841 } 842 843 @data = (); # reset data 844 845 @data = @col_underline; 846 847 eval $format; 848 849 if($@){$self->_debug(3, "Internal/system Error - $@");} 850 851 chomp($^A); 852 push(@{$self->{_block}{_profile}{$blockname}{hdata}}, $^A); 853 $^A = ''; 854 } 855 856 if(@col_head > 1){push(@csv, join(',', @col_head));} 857 if(@col_head == 1){push(@csv, $col_head[0]);} 858 } 859 860 my @sorted = $self->_sort($blockname, @table); 861 862 # ---------------------------- # 863 # --- Add the data portion --- # 864 # ---------------------------- # 865 my $debug = 0; 866 867 foreach my $block(@sorted) 868 { 869 my @data = @{$block}; 870 871 push(@csv, join(',', @{$block})); 872 873 eval $format; 874 875 # ------------------------------------------ # 876 # --- This should never happen, but then --- # 877 # --- what do i know --- # 878 # ------------------------------------------ # 879 if($@) 880 { 881 $self->_debug(4, 'Internal/system Error - Data format failure. Please '. 882 'contact your system administrator. I\'m sure he\'ll know what to do.'. 883 "ABEND - $@"); 884 885 die $@; 886 } 887 888 chomp($^A); push(@{$self->{_block}{_profile}{$blockname}{data}}, $^A); 889 $^A = ''; 890 } 891 # ---------------------- # 892 # --- Store csv data --- # 893 # ---------------------- # 894 for(@csv){push(@{$self->{_block}{_profile}{$blockname}{_csv}}, $_);} 895 896 $self; 897} 898 899# $obj->report('get'); # Return report lines w/in array 900# $obj->report('print'); # STDOUT 901# $obj->report('csv'); # Retrieve csv data 902sub report 903{ 904 my $self = shift; 905 906 my %this; my @page = (); 907 908 $this{lc(shift)} = 1; 909 910 911 if(defined $self->{_order}{_block}) 912 { 913 # ---------------------------------------- # 914 # --- If a named block has no 'order', --- # 915 # --- it will be silently ignored --- # 916 # ---------------------------------------- # 917 BLOCK: foreach my $key(sort _numeric(keys %{$self->{_order}{_block}})) 918 { 919 my $blockname = $self->{_order}{_block}{$key}; 920 921 if($this{'csv'}) 922 { 923 push(@page, $self->{_block}{_profile}{$blockname}{_csv}); 924 next BLOCK; 925 } 926 927 # ----------------------- # 928 # --- Top pad, if any --- # 929 # ----------------------- # 930 if(defined $self->{_block}{_profile}{$blockname}{pad}{top} && $self->{_block}{_profile}{$blockname}{pad}{top} > 0) 931 { 932 if($this{'print'}){print "\n" x $self->{_block}{_profile}{$blockname}{pad}{top};} 933 else 934 { 935 for(1 .. $self->{_block}{_profile}{$blockname}{pad}{top}) 936 { 937 push(@page, " "); 938 } 939 } 940 } 941 942 # --- Top-of-block data --- # 943 if(exists $self->{_block}{_profile}{$blockname}{hdata}) 944 { 945 for(@{$self->{_block}{_profile}{$blockname}{hdata}}) 946 { 947 if($this{'print'}){print "$_\n";} 948 else{push(@page, $_);} 949 } 950 } 951 # --- Collected data --- # 952 for(@{$self->{_block}{_profile}{$blockname}{data}}) 953 { 954 if($this{'print'}){print "$_\n";} 955 else{push(@page, $_);} 956 } 957 958 # -------------------------- # 959 # --- Bottom pad, if any --- # 960 # -------------------------- # 961 if(defined $self->{_block}{_profile}{$blockname}{pad}{bottom} && $self->{_block}{_profile}{$blockname}{pad}{bottom} > 0) 962 { 963 if($this{'print'}){print "\n" x $self->{_block}{_profile}{$blockname}{pad}{bottom};} 964 else 965 { 966 for(1 .. $self->{_block}{_profile}{$blockname}{pad}{bottom}) 967 { 968 push(@page, " "); 969 } 970 } 971 } 972 } 973 } 974 # --- No order, no laundry --- # 975 else 976 { 977 $self->_debug(3, 'Block print order has not been set. Either create Report object using '. 978 'Text::Report->new(autoindex => 1) or use $obj->defblock(order => int).'. 979 "Cannot print report"); 980 $self->{_err} = 1; 981 push(@{$self->{_errors}}, ["Block print order has not been set. Cannot print report"]); 982 983 return undef; 984 } 985 986 return @page ? @page : undef; 987} 988# Use this meth to retrieve csv data for block(s) 989# use $obj->report('csv') to retrieve csv data 990# for entire report 991# $obj->get_csv(blockname1, blockname2, ...); 992sub get_csv 993{ 994 my $self = shift; 995 996 my @list; 997 998 for(@_ ? @_ : return(undef)) 999 { 1000 push(@list, $self->{_block}{_profile}{$_}{_csv}); 1001 } 1002 1003 return(@list); 1004} 1005 1006# --------------------------------------------------- # 1007# --- Reset Named Block to orig default settings. --- # 1008# --- Overrides any changes made to '_block' --- # 1009# --------------------------------------------------- # 1010 1011# $obj->rst_block($block_name) 1012# Resets named block to defaults 1013# If $block_name does not exist, creates new block $block_name and applies defaults. 1014sub rst_block 1015{ 1016 my $self = shift; 1017 1018 $self->_default_block((shift)); 1019 1020 $self; 1021} 1022 1023# $obj->del_block($block_name) 1024# Deletes Named Block 1025sub del_block 1026{ 1027 my $self = shift; 1028 my $blockname = shift; 1029 1030 delete $self->{_block}{_profile}{$blockname}; 1031 1032 $self; 1033} 1034 1035# $obj->clr_block_data($block_name) 1036# Clears data & csv data from Named Block 1037sub clr_block_data 1038{ 1039 my $self = shift; 1040 my $blockname = shift; 1041 1042 delete $self->{_block}{_profile}{$blockname}{data}; 1043 delete $self->{_block}{_profile}{$blockname}{_csv}; 1044 # delete $self->{_block}{_profile}{(shift)}{hdata}; 1045 1046 $self; 1047} 1048 1049# $obj->clr_block_headers($block_name) 1050# Clears hdata (header data) from Named Block 1051sub clr_block_headers 1052{ 1053 my $self = shift; 1054 my $blockname = shift; 1055 1056 delete $self->{_block}{_profile}{$blockname}{hdata}; 1057 1058 # --- Reset "header set" flag --- # 1059 $self->{_block}{_profile}{$blockname}{_append} = undef; 1060 1061 $self; 1062} 1063 1064# $obj->named_blocks 1065# Returns an array of all named_block's defined 1066sub named_blocks 1067{ 1068 return(keys %{shift->{_block}{_profile}}); 1069} 1070 1071# $obj->linetypes 1072# Returns an array of avail line types 1073sub linetypes 1074{ 1075 return keys %{shift->{_page}{_line}}; 1076} 1077 1078# Maybe someday: 1079# sub order 1080# { 1081# my $self = shift; 1082# my %order = @_; 1083# 1084# # --- Cannot change order if autoindex is set --- # 1085# if($self->{_page}{_profile}{report}{autoindex}) 1086# { 1087# # ERROR 1088# return(undef); 1089# } 1090# 1091# $self->{_order}{_block} = \%order; 1092# } 1093 1094# ----------------------------------- # 1095# --- Private methods & functions --- # 1096# ----------------------------------- # 1097sub _sort 1098{ 1099 my $self = shift; 1100 my $blockname = shift; 1101 my @table = @_; 1102 1103 return @table unless $self->{_block}{_profile}{$blockname}{sortby}; # 0="Don't sort" 1104 1105 my %idx; my $rec = 0; 1106 1107 # ------------------------------------------ # 1108 # --- Caller refers to 1st col as col 1, --- # 1109 # --- we refer to it as element zero --- # 1110 # ------------------------------------------ # 1111 my $sort_col = ($self->{_block}{_profile}{$blockname}{sortby} - 1); 1112 1113 for my $row(@table){$idx{$rec++} = $row->[$sort_col];} 1114 1115 my @sorted; 1116 1117 # ------------------------- # 1118 # --- Sort numerically --- # 1119 # ------------------------- # 1120 if($self->{_block}{_profile}{$blockname}{sorttype} =~ /numeric/) 1121 { 1122 # ------------------------------- # 1123 # --- Sort in decending order --- # 1124 # ------------------------------- # 1125 if($self->{_block}{_profile}{$blockname}{orderby} =~ /descending/) 1126 { 1127 foreach my $key(sort { $idx{$b} <=> $idx{$a} } keys %idx) 1128 { 1129 push(@sorted, $table[$key]); 1130 } 1131 } 1132 # ------------------------------- # 1133 # --- Sort in ascending order --- # 1134 # ------------------------------- # 1135 else 1136 { 1137 foreach my $key(sort { $idx{$a} <=> $idx{$b} } keys %idx) 1138 { 1139 push(@sorted, $table[$key]); 1140 } 1141 } 1142 } 1143 # ---------------------------- # 1144 # --- Sort alphabetically --- # 1145 # ---------------------------- # 1146 else 1147 { 1148 # ------------------------------- # 1149 # --- Sort in decending order --- # 1150 # ------------------------------- # 1151 if($self->{_block}{_profile}{$blockname}{orderby} =~ /descending/) 1152 { 1153 foreach my $key(sort { $idx{$b} cmp $idx{$a} } keys %idx) 1154 { 1155 push(@sorted, $table[$key]); 1156 } 1157 } 1158 # ------------------------------- # 1159 # --- Sort in ascending order --- # 1160 # ------------------------------- # 1161 else 1162 { 1163 foreach my $key(sort { $idx{$a} cmp $idx{$b} } keys %idx) 1164 { 1165 push(@sorted, $table[$key]); 1166 } 1167 } 1168 } 1169 1170 return(@sorted); 1171} 1172 1173sub _draw_line 1174{ 1175 my $self = shift; 1176 my $type = shift; 1177 my $length = shift; 1178 1179 unless($length =~ /\d+/ && $length > 0) 1180 { 1181 $self->_debug(3, "Cannot _draw_line() $type - Line length = $length"); 1182 return(undef); 1183 } 1184 1185 unless($self->{_page}{_line}{$type}) 1186 { 1187 $self->_debug(3, "Cannot _draw_line() $type - ". 1188 "Do not know how to make type ($type)\; For ". 1189 "a list of valid line types call linetypes()"); 1190 1191 return(undef); 1192 } 1193 1194 else 1195 { 1196 return($self->{_page}{_line}{$type} x $length); 1197 } 1198} 1199 1200sub _debug 1201{ 1202 my $self = shift; 1203 my ($level, $msg) = @_; 1204 1205 my %err_lev = 1206 (4 => 'Critical:', 3 => 'Error:', 2 => 'Warn:', 1 => 'Notice:'); 1207 1208 return unless $self->{_debug}{_lev}; 1209 1210 my $fh = $self->{_log}{_file}; 1211 1212 if($level >= $self->{_debug}{_lev}) 1213 { 1214 if($self->{_debug}{_verbose}) 1215 { 1216 print($fh Carp::longmess("$err_lev{$level} $msg\n"), "\n"); 1217 } 1218 else{print($fh Carp::shortmess("$err_lev{$level} $msg\n"), "\n");} 1219 } 1220} 1221 1222sub _numeric{$a <=> $b;} 1223 1224sub _default_block 1225{ 1226 my $self = shift; 1227 1228 $self->{_block}{_profile}{(shift)} = 1229 { 1230 column => {1 => {width => 80, align => 'center'},}, 1231 sortby => 0, # No sort 1232 sorttype => 'alpha', 1233 orderby => 'ascending', 1234 title => undef, 1235 useColHeaders => 0, 1236 width => 12, # Global col width setting 1237 align => 'center', # Global alignment setting 1238 # Number of blank lines to add to start|end-of-block 1239 pad => {top => 0, bottom => 1}, 1240 }; 1241} 1242# ----------------------------------------- # 1243# --- Assuming that the caller may not --- # 1244# --- have access to 'Storable' declone --- # 1245# ----------------------------------------- # 1246sub _assign_def_block 1247{ 1248 my $self = shift; 1249 my $blockname = shift; 1250 1251 $self->{_block}{_profile}{$blockname}{width} = 1252 $self->{_block}{_profile}{'_block'}{width}; 1253 $self->{_block}{_profile}{$blockname}{align} = 1254 $self->{_block}{_profile}{'_block'}{align}; 1255 $self->{_block}{_profile}{$blockname}{sortby} = 1256 $self->{_block}{_profile}{'_block'}{sortby}; 1257 $self->{_block}{_profile}{$blockname}{sorttype} = 1258 $self->{_block}{_profile}{'_block'}{sorttype}; 1259 $self->{_block}{_profile}{$blockname}{orderby} = 1260 $self->{_block}{_profile}{'_block'}{orderby}; 1261 $self->{_block}{_profile}{$blockname}{useColHeaders} = 1262 $self->{_block}{_profile}{'_block'}{useColHeaders}; 1263 $self->{_block}{_profile}{$blockname}{title} = 1264 $self->{_block}{_profile}{'_block'}{title}; 1265 1266 for(keys%{$self->{_block}{_profile}{'_block'}{pad}}) 1267 { 1268 $self->{_block}{_profile}{$blockname}{pad}{$_} = 1269 $self->{_block}{_profile}{'_block'}{pad}{$_}; 1270 } 1271 1272 for my $col(keys%{$self->{_block}{_profile}{'_block'}{column}}) 1273 { 1274 for my $t(keys%{$self->{_block}{_profile}{'_block'}{column}{$col}}) 1275 { 1276 $self->{_block}{_profile}{$blockname}{column}{$col}{$t} = 1277 $self->{_block}{_profile}{'_block'}{column}{$col}{$t}; 1278 } 1279 } 1280 1281 $self; 1282} 1283 1284sub _default_report 1285{ 1286 my $self = shift; 1287 1288 $self->{_page}{_profile}{(shift)} = 1289 { 1290 width => 80, # Width of report in characters 1291 asis => 0, # Report.pm sets all block titles to caps & adds underline 1292 autoindex => 1, # Let us do the indexing for you 1293 }; 1294} 1295 1296sub AUTOLOAD 1297{ 1298 my $self = shift; 1299 my %profile; 1300 1301 my $type = shift; 1302 1303 if($type){$profile{$type} = 1;} 1304 1305 my %this = @_; 1306 1307 return if $AUTOLOAD =~ /::DESTROY$/; 1308 1309 my $meth = $AUTOLOAD; $meth =~ s/.*://; # Just the method, not the pkg 1310 1311 unless($meth =~ /^profile/){$self->_debug(3, "Bad method - $meth"); return(undef);} 1312 1313 unless($Text::Report::stor_loaded) 1314 { 1315 $self->_debug(3, 'Cannot load module Storable; In order to use '. 1316 '"NamedPages", Storable.pm must be installed & in @INC'); 1317 return(undef); 1318 } 1319 1320 unless(defined $this{path}){$this{path} = '/tmp';} 1321 1322 # --- Clean path --- # 1323 $this{path} =~ s|^(.*)/$|$1|; 1324 1325 1326 # --- Test path --- # 1327 unless(-e $this{path}) 1328 { 1329 $self->_debug(3, "Cannot access profile storage area\; Path ". 1330 "($this{path}) does not exist"); 1331 return(undef); 1332 } 1333 1334 # my $sid = int(time); 1335 1336 my $tmp = "$this{path}/stor.test.".int(time); 1337 1338 # --- Test creat Rights --- # 1339 unless(open F, "+>$tmp") 1340 { 1341 $self->_debug(3, "Insufficient file creation rights in profile ". 1342 "storage area - Path ($this{path})"); 1343 return(undef); 1344 } 1345 1346 $self->_debug(1, "Created tmp file $tmp"); 1347 1348 close F; 1349 1350 # --- Clean up --- # 1351 my @ret = grep{unlink} $tmp; 1352 1353 $self->_debug(1, "Removed tmp file(s)".join(', ', @ret)); 1354 1355 1356 # --- Test name --- # 1357 if($this{name}) 1358 { 1359 # --- No spaces allowed --- # 1360 while($this{name} =~ s/\s+//g){}; 1361 1362 # --- No special chars --- # 1363 unless($this{name} =~ /^\w+$/ && $this{name} !~ /^$/) 1364 { 1365 $self->_debug(3, "No empty strings or special chars allowed in profile ". 1366 "name($this{name})\; Create a name that conforms to UNIX file ". 1367 "naming standards"); 1368 return(undef); 1369 } 1370 } 1371 else 1372 { 1373 $self->_debug(2, "No profile name passed as \$obj->profile(\'load\', name => ". 1374 "\'myname\')\; Assigning default profile name \'default\'"); 1375 1376 $this{name} = 'default'; 1377 } 1378 1379 # $obj->profile('load', name => 'str'); 1380 # $obj->profile('save', name => 'str'); 1381 if($profile{load}) 1382 { 1383 my $msg = "Cannot load stored profile ($this{name})"; 1384 1385 # --- Don't overwrite ourselves --- # 1386 # --- in case of failure --- # 1387 my $temp; 1388 1389 eval{$temp->{_block} = retrieve("$this{path}/stor.rpt\.$this{name}\.\_block");}; 1390 1391 $self->_debug(4, "$msg\; $@"), return undef if $@; 1392 1393 eval{$temp->{_page} = retrieve("$this{path}/stor.rpt\.$this{name}\.\_page");}; 1394 1395 $self->_debug(4, "$msg\; $@"), return undef if $@; 1396 1397 eval{$temp->{_order} = retrieve("$this{path}/stor.rpt\.$this{name}\.\_order");}; 1398 1399 $self->_debug(4, "$msg\; $@"), return undef if $@; 1400 1401 $self->{_block} = $temp->{_block}; 1402 $self->{_page} = $temp->{_page}; 1403 $self->{_order} = $temp->{_order}; 1404 1405 return(1); 1406 } 1407 if($profile{save}) 1408 { 1409 # stor.rpt.<name>._block 1410 my $temp; 1411 1412 $temp->{_block} = dclone($self->{_block}); 1413 1414 # --- Save just the skeleton --- # 1415 for(keys %{$temp->{_block}{_profile}}) 1416 { 1417 delete $temp->{_block}{_profile}{$_}{data} unless /^\_/; # Save the separators 1418 delete $temp->{_block}{_profile}{$_}{_csv}; 1419 } 1420 1421 store($temp->{_block}, "$this{path}/stor.rpt\.$this{name}\.\_block"); 1422 store($self->{_page}, "$this{path}/stor.rpt\.$this{name}\.\_page"); 1423 store($self->{_order}, "$this{path}/stor.rpt\.$this{name}\.\_order"); 1424 1425 return(1); 1426 } 1427 1428 return(undef); 1429} 1430 1431 1432 1433__END__ 1434 1435=pod 1436 1437=head1 NAME 1438 1439Text::Report - Perl extension for generating mixed columnar formatted reports and report templates 1440 1441 1442=head1 VERSION 1443 1444Version 1.003 1445 1446 1447=head1 SYNOPSIS 1448 1449 1450 use Text::Report; 1451 1452 # Let's build a simple report complete with title lines, footer 1453 # and two disparate data sets in tabular form 1454 1455 # Create a new report object: 1456 $rpt = Text::Report->new(debug => 'error', debugv => 1); 1457 1458 1459 # Create a title block: 1460 $rpt->defblock(name => 'title_lines'); 1461 1462 # Create a separator: 1463 $rpt->insert('dbl_line'); 1464 1465 # Create a data block: 1466 $rpt->defblock(name => 'data1', 1467 title => 'Statistical Analysis Of Gopher Phlegm Over Time', 1468 useColHeaders => 1, 1469 sortby => 1, 1470 sorttype => 'alpha', 1471 orderby => 'ascending', 1472 columnWidth => 14, 1473 columnAlign => 'left', 1474 pad => {top => 2, bottom => 2},); 1475 1476 # Create another data block: 1477 $rpt->defblock(name => 'data2', 1478 title => 'Resultant Amalgamum Firnunciation Per Anum', 1479 useColHeaders => 1, 1480 sortby => 1, 1481 sorttype => 'numeric', 1482 orderby => 'ascending', 1483 columnWidth => 10, 1484 columnAlign => 'right', 1485 pad => {top => 2, bottom => 2},); 1486 1487 # Create a separator: 1488 $rpt->insert('dotted_line'); 1489 1490 # Create a footer block: 1491 $rpt->defblock(name => 'footer'); 1492 1493 # Add column headers: 1494 @header = qw(gopher_a gopher_b gopher_c bobs_pudding); 1495 @header2 = qw(avg mean meaner meanest outraged paralyzed); 1496 1497 $i = 0; 1498 for(@header){$rpt->setcol('data1', ++$i, head => $_);} 1499 1500 $i = 0; 1501 for(@header2){$rpt->setcol('data2', ++$i, head => $_);} 1502 1503 # Change column settings for 'bobs_pudding' data: 1504 $rpt->setcol('data1', 4, align => 'right', width => 16); 1505 1506 @data = ( 1507 ['a1', 'a2', 'a3', 'b4'], 1508 ['b1', 'b2', 'b3', 'c4'], 1509 ['c1', 'c2', 'c3', 'c4'],); 1510 1511 @data2 = ( 1512 ['562.93', '121.87', '53.95', '46.05', '39.00', '129.00'], 1513 ['123.62', '191.25', '14.62', '52.58', '63.14', '256.32'],); 1514 1515 # Fill our blocks with some useful data: 1516 $rpt->fill_block('title_lines', ['Simple Report'], ['Baltimore Zoological Research Lab']); 1517 $rpt->fill_block('data1', @data); 1518 $rpt->fill_block('data2', @data2); 1519 $rpt->fill_block('footer', ['Acme Cardboard - All Rights Reserved'], ['Apache Junction, Arizona']); 1520 1521 # Get our formatted report: 1522 @report = $rpt->report('get'); 1523 1524 # Print report: 1525 for(@report){print $_, "\n";} 1526 1527 1528 1529 Simple Report 1530 Baltimore Zoological Research Lab 1531 1532 ================================================================================ 1533 1534 1535 1536 STATISTICAL ANALYSIS OF GOPHER PHLEGM OVER TIME 1537 ----------------------------------------------- 1538 1539 gopher_a gopher_b gopher_c bobs_pudding 1540 ______________ ______________ ______________ ________________ 1541 a1 a2 a3 b4 1542 b1 b2 b3 c4 1543 c1 c2 c3 c4 1544 1545 1546 1547 1548 RESULTANT AMALGAMUM FIRNUNCIATION PER ANUM 1549 ------------------------------------------ 1550 1551 avg mean meaner meanest outraged paralyzed 1552 __________ __________ __________ __________ __________ __________ 1553 123.62 191.25 14.62 52.58 63.14 256.32 1554 562.93 121.87 53.95 46.05 39.00 129.00 1555 1556 1557 ................................................................................ 1558 1559 Acme Cardboard - All Rights Reserved 1560 Apache Junction, Arizona 1561 1562 1563 1564 1565 Beautiful isn't it. And the coolest thing... 1566 You can save the report template and use it over and over and over... 1567 1568 1569=head1 DESCRIPTION 1570 1571Being a Practical Reporting language, it only seems fitting that one should be able to generate 1572nicely formatted reports with Perl without ever having to do this stuff (and worse) 1573 1574 format = 1575 @<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<< @||||||||||| @>>>>> $@###.## 1576 $bla, $foo, $blek, $bar, $gnu 1577 . 1578 1579over and over again. 1580 1581And clearing accumulators and writing vast amounts of polemic, convoluted code and cursing. And slamming doors and kicking things that bark and meow. And eventually, while sobbing uncontrollably, copying and pasting the stuff into a spreadsheet at 3:30 A.M.. I have seen this. Ugly stuff. Gives me the creeps. 1582 1583Well guess what? This type of aberrant behavior will soon be a thing of the past. You may even tear page 168 out of your (2nd edition) Camel Book now. Sure, go ahead. What, it's not your book? Ahh, do it anyway. Whoever does own it will thank you. Unless it's a library book. Then you've got problems. 1584 1585With Text::Report you can create beautiful text based reports on the fly and even collect csv data for retrieval just in case you still have some primal urge to do the spreadsheet thing. You will never have to touch another perl "format" function ever again. 1586 1587Just initialize a new report object, tweak the global settings to your liking, create page title and footer blocks, some separators, and data blocks (tabular data) to your heart's content. When you're done building you can save the report template to be used later for the same type of report or you can begin stuffing table data into your data blocks. And that's it. You can now print the report or write it to a file. 1588 1589Text::Report will very likely get you so excited that you will mistakenly phone up family members and try to explain it to them. 1590 1591 1592 1593 1594 1595 1596=head1 METHODS 1597 1598=over 4 1599 1600=item new() 1601 1602=over 6 1603 1604The C<new> method creates a new report object instance and defines 1605the attributes of the object. 1606Attributes are passed as key => value pairs: 1607 1608=back 1609 1610=over 6 1611 1612=item logfh => \*HANDLE 1613 1614If supplied, 'logfh' directs logging (debug) output to the file handle, 1615otherwise output is to *STDOUT. 1616 1617=item debug => ['off' | 'notice' | 'warning' | 'error' | 'critical'] 1618 1619If supplied, 'debug' sets the level (and amount) of messaging. Setting 1620debug to 'off' will give you a nice quiet run, however when running complex 1621reports, this feature becomes darned handy. The default is set to 'critical' 1622(minimum verbosity). 1623 1624 1625=item debugv => [0 | 1] 1626 1627If supplied, 'debugv' sets the level of Carp'ing. If false, we use Carp::shortmess 1628and if true we use Carp::longmess. 1629 1630 1631=item autoindex => [0 | 1] 1632 1633If false, 'autoindex' will be turned off and you will need to supply a unique 1634index value for each report component used. 1635 1636Not pretty. 1637 1638It is strongly recommended that you let Text::Report do the indexing for you. 1639The only requirement on your part for autoindexing is to create the report blocks 1640(using the $obj->defblock() method) in the order that you want them to appear in 1641the report. 1642 1643The default is set to true. I personally don't mess with it that often, although 1644there have been times when it became essential. Hence its availability. 1645 1646=back 1647 1648The following options let you diddle with the global report defaults. Keep 1649in mind that you may also specify these locally as well which, I find, is 1650easier for most reports. These options are also available using the method 1651$obj->configure(). 1652 1653=over 6 1654 1655=item width => n 1656 1657Change the width of the formatted (final) report to the number 'n' 1658characters specified. The default is set to 80 characters. 1659 1660=item asis => [0 | 1] 1661 1662Normally Text::Report sets all block titles to uppercase and adds underlines 1663to the column headers. 1664 1665You may have it your way, however, and specify that you want the report headers 1666left just the way that you pass them to Text::Report by setting asis => 1. 1667 1668I think that the report is easier to read with capitalised 1669headers. 1670 1671The default is off. (which means that Text::Report will do it his way) 1672 1673=item column => {'n' => {width => 'x', align => ['left' | 'right' | 'center'], head => 'string'}} 1674 1675You may change the default column properties by passing the above hash ref 1676where n = the column number and x = column width and 'string' is whatever you 1677want for that column header. 1678 1679=item useColHeaders => [0 | 1] 1680 1681By turning useColHeaders on you will either be expected to supply column headers 1682for each data block or the system will provide you with it's own. In the form of 1683'1', '2', '3' ... 1684 1685The initial setting is off. 1686 1687In title, footer, and separator data blocks you want to turn headers off. When 1688creating data tables you would, perhaps want this turned on. 1689 1690=item sortby => n 1691 1692The column number 'n' to sort by. The default is 0 (zero) which means "no sorting 1693please" 1694 1695 Here are the default settings: 1696 1697 $rpt = Text::Report->new ( 1698 { # DEFAULTS 1699 debug => 'critical', 1700 debugv => 0, 1701 width => 80, 1702 autoindex => 1, 1703 asis => 0, 1704 logfh => \*STDOUT, 1705 blockPad => {top => 0, bottom => 1}, 1706 useColHeaders => 0, 1707 sortby => 0, 1708 } 1709 ); 1710 1711=back 1712 1713=item configure() 1714 1715=over 6 1716 1717The C<configure> method is used to tweak global report settings. 1718 1719(You may also use the following options with new()) 1720 1721=back 1722 1723=over 6 1724 1725=item width => n 1726 1727Change the width of the formatted (final) report to the number 'n' 1728characters specified. The default is set to 80 characters. 1729 1730=item asis => [0 | 1] 1731 1732Normally Text::Report sets all block titles to uppercase and adds underlines 1733to the column headers. 1734 1735You may have it your way, however, and specify that you want the report headers 1736left just the way that you pass them to Text::Report by setting asis => 1. 1737 1738The default is off. (which means that Text::Report will do it his way) 1739 1740=item column => {'n' => {width => 'x', align => ['left' | 'right' | 'center'], head => 'string'}} 1741 1742You may change the default column properties by passing the above hash ref 1743where n = the column number and x = column width and 'string' is whatever you 1744want for that column header. 1745 1746=item useColHeaders => [0 | 1] 1747 1748By turning useColHeaders on you will either be expected to supply column headers 1749for each data block or the system will provide you with it's own. In the form of 1750'A', 'B', 'C' ... 1751 1752The initial setting is off. 1753 1754In title, footer, and separator data blocks you want to turn headers off. When 1755creating data tables you would, perhaps want this turned on. 1756 1757=item sortby => n 1758 1759The column number 'n' to sort by. The default is 0 (zero). 1760 1761 1762=back 1763 1764=item defblock() 1765 1766=over 6 1767 1768The C<defblock> method names and sets parameters for a particular 1769report block such as number of columns, sort column, default column 1770alignment (which can also be set using setcol() method), et al. 1771 1772This is where you create a data block. It will usually be a table structure 1773that you will use to display all of that data you have been collecting from 1774some petri dish in some dark lab somewhere. 1775 1776=back 1777 1778=over 6 1779 1780=item name => 'string' 1781 1782The name of the block you are about to define. 1783 1784=item title => 'string' 1785 1786The title to display for the block you are about to define. You would not use this 1787if you were creating a report title or some other data that you did not want a 1788label for. 1789 1790=item order => 'n' 1791 1792Where n is a unique integer. 1793 1794This is the order in which the data block you are creating will appear 1795in your report. Use this option *only* if you have set new(autoindex => 0) 1796and only if you enjoy that feeling you get when you repeatedly shut 1797the car door on your fingers. 1798 1799=item sortby => 'n' 1800 1801Where n is an integer. 1802 1803This designates the column in this data block that will be used 1804for sorting. 1805 1806=item sorttype => ['alpha' | 'numeric'] 1807 1808This tells Text::Report how you want to sort the column for this 1809data block. 1810 1811=item orderby => ['ascending' | 'descending'] 1812 1813This tells Text::Report in what order you want to sort the column 1814for this data block. 1815 1816=item useColHeaders => [0 | 1] 1817 1818Set to true to display headers & header underlines at the head 1819of each column. 1820 1821=item column => {'n' => {width => 'xx', align => ['left' | 'right' | 'center'], head => 'string'}} 1822 1823Configure column where 'n' is column number, 'xx' is the width of the column and 1824'string' is the header string for this column and is optional. 1825 1826=item cols => positive integer 1827 1828Automatically generates columns using preset default width and alignment. 1829 1830I love automation. 1831 1832This feature is handy for homogenous column data (ie; x number of columns each the 1833same width), but it will truncate data if you get carried away with trying to stuff 1834more chars per line than the report width is set for. 1835 1836If you have debug set correctly, it will tell you how to make adjustments to make 1837everything fit. 1838 1839B<Use the debug feature!> I built it for a reason. Building complex reports 1840will be so much easier if you B<use the debug feature>. 1841 1842=item pad => {top => 'n', bottom => 'n'} 1843 1844Block padding - where 'n' is the number of blank lines to pad the top & bottom of 1845the block. 1846 1847=item columnWidth => 'n' 1848 1849Set the default column width for this block to 'n' characters wide. 1850 1851=item columnAlign => ['left' | 'right' | 'center'] 1852 1853Set the default alignment for every column in the block. 1854 1855Handy. 1856 1857This sets the alignment for every column defined or about to be defined. If you 1858have six columns and five need left alignment and one needs center, then set 1859columnAlign => 'left' and only explicitly set the sixth column, using 1860setcol($blockname, $col_num, align => 'center'). 1861 1862 1863=back 1864 1865=item setblock() 1866 1867=over 6 1868 1869The C<setblock> method gives you the opportunity to alter an existing data block's properties with the exception of the block name. 1870 1871=back 1872 1873=over 6 1874 1875=item title => 'string' 1876 1877The title to display for the block you are about to define. You would not use this 1878if you were creating a report title or some other data that you did not want a 1879label for. 1880 1881=item order => 'n' 1882 1883Where n is a unique integer. 1884 1885This is the order in which the data block you are creating will appear 1886in your report. Use this option *only* if you have set new(autoindex => 0). 1887 1888=item sortby => 'n' 1889 1890Where n is an integer. 1891 1892This designates the column in this data block that will be used 1893for sorting. A zero would mean no sorting. 1894 1895=item sorttype => ['alpha' | 'numeric'] 1896 1897This tells Text::Report how you want to sort the column for this 1898data block. 1899 1900=item orderby => ['ascending' | 'descending'] 1901 1902This tells Text::Report in what order you want to sort the column 1903for this data block. 1904 1905=item pad => {top => 'n', bottom => 'n'} 1906 1907Block padding - where 'n' is the number of blank lines to pad the top & bottom of 1908the block. 1909 1910=item useColHeaders => [0 | 1] 1911 1912Set to true to display headers & header underlines at the head 1913of each column. 1914 1915 1916=back 1917 1918=item setcol($blockname, $colnumber, ...) 1919 1920=over 6 1921 1922The C<setcol> method allows you to set and change certain column properties. 1923 1924=back 1925 1926=over 6 1927 1928=item $blockname 1929 1930Block name must be supplied as arg zero. 1931 1932=item $colnumber 1933 1934Column number must be supplied as arg 1. 1935 1936=item align => ['left' | 'right' | 'center'] 1937 1938Specifies the justification of a column field. 1939 1940=item width => n 1941 1942Change the width of the designated column to the number 'n' 1943characters specified. 1944 1945=item head => 'str' 1946 1947Column header as a string. 1948 1949 1950=back 1951 1952=item insert($linetype, ...) 1953 1954=over 6 1955 1956The C<insert> method allows you to insert a block to be used as a separator where $linetype is either 'dotted_line' | 'dbl_line' | 'single_line' | 'under_line' | 'blank_line'. 1957 1958=back 1959 1960=over 6 1961 1962=item order => 'n' 1963 1964Where n is a unique integer. 1965 1966This is the order in which the separator you are creating will appear 1967in your report. Use this option *only* if you have set new(autoindex => 0). 1968 1969=item pad => {top => 'n', bottom => 'n'} 1970 1971Padding - where 'n' is the number of blank lines to pad the top & bottom of 1972the separator. 1973 1974=item width => n 1975 1976Make the width of the separator the number 'n' characters specified. 1977 1978 1979=back 1980 1981=item fill_block($blockname, @AoA) 1982 1983=over 6 1984 1985The C<fill_block> method is where the pudding meets the highway. The data sent, as a 3-dimensional array or table, is parsed according to the properties that were set when the block was defined in defblock() or the default properties that were set at the global or report level. 1986 1987=back 1988 1989=over 6 1990 1991=item $blockname 1992 1993Block name must be supplied as arg zero. 1994 1995=item @AoA 1996 1997Each primary element in the data array contains the table row while the elements contained in the row elements contains each field value in the row as: 1998 1999 @AoA = ( 2000 ['data', 'data', 'data', 'data'], 2001 ['data', 'data', 'data', 'data'],); 2002 2003 2004 2005=back 2006 2007=item report(['get' | 'print' | 'csv']) 2008 2009=over 6 2010 2011The C<report> method is how you retrieve the final, formatted report or csv data. The report is returned as an array where each element is a row or line of the report. The csv data is returned as an AoA. 2012 2013=back 2014 2015=over 6 2016 2017=item 'get' 2018 2019Using the 'get' argument, the report is returned as an array with each element containing a line in the report. 2020 2021 @report = $rpt->report('get'); 2022 for(@report){print $_, "\n";} 2023 2024=item 'csv' 2025 2026Using the 'csv' argument, the csv data is returned as an array of arrays. 2027 2028 @csv = $rpt->report('csv'); 2029 for(@csv){for(@{$_}){print $_, "\n";}} 2030 2031=item 'print' 2032 2033Using the 'print' argument, the report is printed to STDOUT. 2034 2035 2036=back 2037 2038=back 2039 2040 2041=head1 MISCELLANEOUS METHODS 2042 2043=over 4 2044 2045 2046=item get_csv(@listofblocknames) 2047 2048=over 6 2049 2050The C<get_csv> method returns csv data in an array of arrays. 2051 2052=back 2053 2054=over 6 2055 2056=item @listofblocknames 2057 2058One or more block names to retrieve csv data 2059 2060 @csv = $rpt->get_csv('block1', 'block2'); 2061 for(@csv){for(@{$_}){print $_, "\n";}} 2062 2063 2064=back 2065 2066=item rst_block($block_name) 2067 2068=over 6 2069 2070The C<rst_block> method resets named block to defaults. If $block_name does not exist, creates new block $block_name and applies defaults. 2071 2072=back 2073 2074=over 6 2075 2076=item $block_name 2077 2078Must supply a valid block name as an argument. 2079 2080 2081=back 2082 2083=item del_block($block_name) 2084 2085=over 6 2086 2087The C<del_block> method deletes named block. 2088 2089=back 2090 2091=over 6 2092 2093=item $block_name 2094 2095Must supply a valid block name as an argument. 2096 2097 2098=back 2099 2100=item clr_block_data($block_name) 2101 2102=over 6 2103 2104The C<clr_block_data> method clears report data & csv data from block $block_name. 2105 2106=back 2107 2108=over 6 2109 2110=item $block_name 2111 2112Must supply a valid block name as an argument. 2113 2114 2115=back 2116 2117=item clr_block_headers($block_name) 2118 2119=over 6 2120 2121The C<clr_block_headers> method clears header data from block $block_name. 2122 2123=back 2124 2125=over 6 2126 2127=item $block_name 2128 2129Must supply a valid block name as an argument. 2130 2131 2132=back 2133 2134=item named_blocks() 2135 2136=over 6 2137 2138The C<named_blocks> method returns an array list of all defined named blocks. 2139 2140No arguments 2141 2142 2143=back 2144 2145=item linetypes() 2146 2147=over 6 2148 2149The C<linetypes> method returns an array list of all predefined line types. 2150 2151No arguments 2152 2153=back 2154 2155=back 2156 2157 2158=head1 EXAMPLES 2159 2160=over 4 2161 2162 2163Example 1 2164 2165Generate a report of gas price comparisons on a per zip code basis 2166using Ashish Kasturia's Gas::Prices L<http://search.cpan.org/~ashoooo/Gas-Prices-0.0.4/lib/Gas/Prices.pm> 2167 2168 use Gas::Prices; 2169 use Text::Report; 2170 2171 2172 # --- US zip code list 2173 my @code = qw(85202 85001 85201); 2174 2175 2176 # --- Create our report object 2177 my $rpt = Text::Report->new(debug => 'off', width => 95); 2178 2179 # --- Define a block for the title area accepting the current 2180 # --- default width of 95 chars and centered justification 2181 $rpt->defblock(name => 'pageHead'); 2182 2183 # --- Add two lines to block 'pageHead' 2184 $rpt->fill_block('pageHead', ["Gasoline Pricing At Stations By Zip Code"],[scalar(localtime(int(time)))]); 2185 2186 # --- Insert a text decoration 2187 # --- We are using the autoindex feature and allowing Text::Report 2188 # --- to keep track of the order in which our blocks appear. We determine 2189 # --- that order by the order in which we call defblock() or insert() 2190 $rpt->insert('dbl_line'); 2191 2192 2193 # --- We have data returning for 3 different zip codes and want to present 2194 # --- that data as pricing per zip code in one report. Create 3 blocks, 2195 # --- using each zip code as part of the block name. The structure will be 2196 # --- the same for each block in this case. 2197 foreach my $zip(@code) 2198 { 2199 $rpt->defblock(name => 'station_data'.$zip, 2200 column => 2201 { 2202 1 => {width => 20, align => 'left', head => 'Station'}, 2203 2 => {width => 35, align => 'left', head => 'Address'}, 2204 3 => {width => 7, align => 'right', head => 'Regular'}, 2205 4 => {width => 7, align => 'right', head => 'Plus'}, 2206 5 => {width => 7, align => 'right', head => 'Premium'}, 2207 6 => {width => 7, align => 'right', head => 'Diesel'}, 2208 }, 2209 # Block title 2210 title => "Station Comparison For Zip Code $zip", 2211 # Yes, use column headers 2212 useColHeaders => 1, 2213 # Yes "sort" using column 1 2214 sortby => 1, 2215 # Sort alphabetically 2216 sorttype => 'alpha', 2217 # Sort low to high 2218 orderby => 'ascending', 2219 # pad these blocks with 2 blank lines on top and bottom 2220 pad => {top => 2, bottom => 2},); 2221 } 2222 2223 # --- Now that we've constructed the report template, all that's left is to 2224 # --- fetch and add the data 2225 2226 foreach my $zip(@code) 2227 { 2228 my $gasprice = Gas::Prices->new($zip); 2229 2230 my $stations = $gasprice->get_stations; 2231 2232 sleep 3; 2233 2234 my @data; 2235 2236 foreach my $gas(@{$stations}) 2237 { 2238 # Remove state & zip (personal preference) 2239 $gas->{station_address} =~ s/(.*?)\,\s+\w{2}\s+\d{5}/$1/; 2240 2241 push(@data, [ 2242 $gas->{station_name}, 2243 $gas->{station_address}, 2244 $gas->{unleaded_price}, 2245 $gas->{plus_price}, 2246 $gas->{premium_price}, 2247 $gas->{diesel_price}]); 2248 } 2249 2250 $rpt->fill_block('station_data'.$zip, @data); 2251 } 2252 2253 # --- Get the formatted report & print to screen 2254 my @report = $rpt->report('get'); 2255 for(@report){print $_, "\n";} 2256 2257 exit(1); 2258 2259Here is the resultant output from example 1: 2260 2261 Gasoline Pricing At Stations By Zip Code 2262 Mon Jul 9 10:13:33 2007 2263 2264 =============================================================================================== 2265 2266 2267 2268 STATION COMPARISON FOR ZIP CODE 85202 2269 ------------------------------------- 2270 2271 Station Address Regular Plus Premium Diesel 2272 ____________________ ___________________________________ _______ _______ _______ _______ 2273 7-ELEVEN 815 S DOBSON RD, MESA 2.799 N/A N/A N/A 2274 7-ELEVEN 2050 W GUADALUPE RD, MESA 2.799 N/A N/A N/A 2275 7-ELEVEN 1210 W GUADALUPE RD, MESA 2.879 N/A N/A N/A 2276 7-ELEVEN 815 S ALMA SCHOOL RD, MESA 2.819 N/A 3.059 N/A 2277 CHEVRON 1205 W BASELINE RD, MESA 2.859 N/A 3.099 2.939 2278 CHEVRON 1808 E BROADWAY RD, TEMPE 2.839 2.969 3.139 N/A 2279 CHEVRON 414 W GUADALUPE RD, MESA 2.779 2.919 3.019 N/A 2280 CIRCLE K 751 N ARIZONA AVE, GILBERT 2.779 2.979 3.089 2.899 2281 CIRCLE K 2196 E APACHE BLVD, TEMPE 2.799 2.929 N/A N/A 2282 CIRCLE K 2012 W SOUTHERN AVE, MESA 2.759 2.889 N/A 2.949 2283 CIRCLE K 2808 S DOBSON RD, MESA 2.779 2.929 3.099 2.899 2284 Circle K 417 S Dobson Rd, Mesa 2.799 2.929 3.099 N/A 2285 Circle K 1145 W Main St, Mesa 2.799 2.929 3.099 N/A 2286 Circle K 1955 W UNIVERSITY DR, Mesa 2.799 N/A N/A N/A 2287 Circle K 735 W Broadway Rd, Mesa 2.819 2.949 3.119 N/A 2288 MOBIL 1817 W BASELINE RD, MESA 2.899 N/A N/A N/A 2289 Quik Trip 1331 S COUNTRY CLUB DR, Mesa 2.799 2.899 2.999 N/A 2290 Quik Trip 2311 W BROADWAY RD, Mesa 2.799 2.899 2.999 N/A 2291 SHELL 2180 E BROADWAY RD, TEMPE 2.899 2.999 3.129 2.999 2292 SHELL 2165 E BASELINE RD, TEMPE 2.909 3.009 N/A N/A 2293 Shell 1810 S COUNTRY CLUB DR, Mesa 2.799 2.799 2.929 2.849 2294 Shell 1158 W UNIVERSITY DR, Mesa 2.999 3.009 2.879 N/A 2295 Shell 2005 W BROADWAY RD, Mesa 2.819 2.799 3.129 2.949 2296 Shell 6349 S MCCLINTOCK DR, Tempe 2.799 2.799 3.119 2.829 2297 Texaco 2816 S COUNTRY CLUB DR, Mesa 2.789 N/A N/A 2.899 2298 UNBRANDED 2997 N ALMA SCHOOL RD, CHANDLER 2.779 N/A N/A N/A 2299 Unbranded 1510 S COUNTRY CLUB DR, Mesa 2.809 N/A 2.809 3.049 2300 Unbranded 756 W SOUTHERN AVE, Mesa 2.699 N/A N/A 2.899 2301 Unbranded 1821 S COUNTRY CLUB DR, Mesa 2.829 2.959 2.899 N/A 2302 Unbranded 5201 S MCCLINTOCK DR, Tempe 2.789 2.899 2.999 N/A 2303 2304 2305 2306 2307 STATION COMPARISON FOR ZIP CODE 85001 2308 ------------------------------------- 2309 2310 Station Address Regular Plus Premium Diesel 2311 ____________________ ___________________________________ _______ _______ _______ _______ 2312 CHEVRON 2402 E WASHINGTON ST, PHOENIX 2.899 N/A 3.139 2.999 2313 CIRCLE K 699 E BUCKEYE RD, PHOENIX 2.839 2.969 N/A N/A 2314 CIRCLE K 602 N 1ST AVE, PHOENIX 2.779 2.909 3.079 N/A 2315 Circle K 1501 W Mcdowell Rd, Phoenix 2.759 2.909 3.099 2.949 2316 Circle K 309 E Osborn Rd, Phoenix 2.759 2.909 N/A 2.949 2317 Circle K 614 W ROOSEVELT ST, Phoenix 2.759 N/A 3.059 N/A 2318 Circle K 702 W Mcdowell Rd, Phoenix 2.779 N/A 3.099 N/A 2319 Circle K 10 E BUCKEYE RD, Phoenix 2.819 N/A N/A N/A 2320 Circle K 2400 E Mcdowell Rd, Phoenix 2.779 2.949 3.119 N/A 2321 Circle K 1602 E Washington St, Phoenix 2.879 3.029 3.199 N/A 2322 Circle K 1732 W VAN BUREN ST, Phoenix 2.839 2.969 3.139 N/A 2323 Circle K 1342 W THOMAS RD, Phoenix 2.779 N/A N/A N/A 2324 Circle K 1945 E Van Buren St, Phoenix 2.879 3.029 3.199 N/A 2325 Circle K 1834 W Grant St, Phoenix 2.839 2.969 N/A N/A 2326 Circle K 1523 E MCDOWELL RD, Phoenix 2.789 2.759 N/A N/A 2327 Circle K 1001 N 16Th St, Phoenix 2.879 3.029 N/A N/A 2328 Circle K 2041 W Van Buren St, Phoenix 2.839 2.969 N/A N/A 2329 Circle K 1007 N 7Th St, Phoenix 2.879 N/A N/A N/A 2330 Circle K 702 E Mcdowell Rd, Phoenix 2.819 2.969 3.119 N/A 2331 Circle K 2535 N CENTRAL AVE, Phoenix 2.899 N/A N/A N/A 2332 Circle K 966 E Van Buren St, Phoenix 2.859 3.009 N/A N/A 2333 Circle K 2850 N 7Th St, Phoenix 2.859 3.029 N/A N/A 2334 Phillips 66 1045 N 24TH ST, Phoenix 2.799 N/A N/A 2.899 2335 SHELL 305 E THOMAS RD, PHOENIX 2.899 N/A N/A N/A 2336 Shell 922 N 7TH ST, Phoenix 2.879 2.989 N/A N/A 2337 Shell 2401 E VAN BUREN ST, Phoenix 2.849 N/A N/A 3.079 2338 UNBRANDED 2817 N 7TH ST, PHOENIX 2.839 N/A N/A N/A 2339 UNBRANDED 125 E MCDOWELL RD, PHOENIX 2.819 N/A N/A N/A 2340 Unbranded 2045 S 7TH AVE, Phoenix 2.959 2.949 2.989 2.959 2341 Unbranded 1919 S 7TH ST, Phoenix 2.899 N/A N/A 3.299 2342 2343 2344 2345 2346 STATION COMPARISON FOR ZIP CODE 85201 2347 ------------------------------------- 2348 2349 Station Address Regular Plus Premium Diesel 2350 ____________________ ___________________________________ _______ _______ _______ _______ 2351 7-ELEVEN 815 S ALMA SCHOOL RD, MESA 2.819 N/A 3.059 N/A 2352 7-ELEVEN 815 S DOBSON RD, MESA 2.799 N/A N/A N/A 2353 7-ELEVEN 758 E BROWN RD, MESA 2.859 2.959 N/A N/A 2354 ARCO 25 W MCKELLIPS RD, MESA 2.799 N/A N/A N/A 2355 CHEVRON 808 E MCKELLIPS RD, MESA 2.869 2.999 3.099 2.939 2356 CIRCLE K 2196 E APACHE BLVD, TEMPE 2.799 2.929 N/A N/A 2357 Chevron 357 N Stapley Dr, Mesa 2.839 N/A 3.099 N/A 2358 Circle K 735 W Broadway Rd, Mesa 2.819 2.949 3.119 N/A 2359 Circle K 11 E Mckellips Rd, Mesa 2.779 N/A N/A N/A 2360 Circle K 1550 N Country Club Dr, Mesa 2.779 N/A N/A N/A 2361 Circle K 410 N Center St, Mesa 2.779 N/A 3.099 2.849 2362 Circle K 1205 E BROADWAY RD, Mesa 2.799 N/A N/A N/A 2363 Circle K 417 S Dobson Rd, Mesa 2.799 2.929 3.099 N/A 2364 Circle K 1145 W Main St, Mesa 2.799 2.929 3.099 N/A 2365 Circle K 1154 W 8Th St, Mesa 2.799 2.929 3.099 N/A 2366 Circle K 1955 W UNIVERSITY DR, Mesa 2.799 N/A N/A N/A 2367 Circle K 330 E BROADWAY RD, Mesa 2.799 2.929 N/A N/A 2368 Circle K 1160 E UNIVERSITY DR, Mesa 2.879 N/A N/A N/A 2369 Circle K 310 N Mesa Dr, Mesa 2.819 N/A N/A N/A 2370 Quik Trip 517 W MCKELLIPS RD, Mesa 2.799 2.899 2.999 N/A 2371 Quik Trip 1331 S COUNTRY CLUB DR, Mesa 2.799 2.899 2.999 N/A 2372 Quik Trip 2311 W BROADWAY RD, Mesa 2.799 2.899 2.999 N/A 2373 Quik Trip 816 W UNIVERSITY DR, Mesa 2.799 2.899 2.999 N/A 2374 SHELL 1957 N COUNTRY CLUB DR, MESA 2.999 N/A N/A 2.969 2375 SHELL 16 W MCKELLIPS RD, MESA 2.889 2.989 N/A 2.939 2376 Shell 2174 E University Dr, Tempe 2.819 2.779 2.929 2.949 2377 Shell 2005 W BROADWAY RD, Mesa 2.819 2.799 3.129 2.949 2378 Shell 1158 W UNIVERSITY DR, Mesa 2.999 3.009 2.879 N/A 2379 Texaco 1601 N BEELINE HWY, Scottsdale 2.899 2.999 3.089 N/A 2380 Unbranded 756 W SOUTHERN AVE, Mesa 2.699 N/A N/A 2.899 2381 2382 2383More examples will be added over time and will be made available at L<http://www.full-duplex.com/svcs04.html> somewhere on the page. 2384 2385=back 2386 2387 2388=head1 TODO 2389 2390Page breaks and pagination. I originally developed Text::Report for electronic media and really had no need to introduce the added overhead and complexity of page numbering, order and vertical sizing. I have used Text::Report in a line-printer environment and everything looks great, however paginating for precut paper presents issues. The need to laser print, at least for me and those who I know are using this package, has not yet presented itself. 2391 2392I tell you this only so that you know that I know that Text::Report is lacking a bit in the hardcopy print arena. 2393 2394=head1 BUGS 2395 2396None that I'm aware of at the moment, but as sure as The Sun Also Rises, someone, perhaps soon, will discover what I will call "some new features". Some features may require adjustments. Some features may require removal. I am preparing myself for the inevitable. 2397 2398You may report any bugs or feature requests to 2399C<bug-text-report at rt.cpan.org>, or through the web interface at 2400L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Text-Report>. 2401I will be notified, and then you'll automatically be notified of progress on 2402your bug as I make changes. 2403 2404=head1 SUPPORT 2405 2406You can find documentation for this module with the perldoc command. 2407 2408 perldoc Text::Report 2409 2410You can also look for information at: 2411 2412=over 4 2413 2414=item * AnnoCPAN: Annotated CPAN documentation 2415 2416L<http://annocpan.org/dist/Text-Report> 2417 2418=item * CPAN Ratings 2419 2420L<http://cpanratings.perl.org/d/Text-Report> 2421 2422=item * RT: CPAN's request tracker 2423 2424L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-Report> 2425 2426=item * Search CPAN 2427 2428L<http://search.cpan.org/dist/Text-Report> 2429 2430=back 2431 2432=head1 ACKNOWLEDGEMENTS 2433 2434=head1 SEE ALSO 2435 2436CPAN - http://search.cpan.org/ 2437 2438=head1 AUTHOR 2439 2440David Huggins, (davidius AT cpan DOT org), L<http://www.full-duplex.com>, L<http://www.in-brandon.com> 2441 2442=head1 COPYRIGHT AND LICENSE 2443 2444Copyright (C) 2007 by Full-Duplex Communications, Inc. All rights reserved. 2445 2446 This program is free software; you can redistribute it and/or modify 2447 it under the terms of the GNU General Public License as published by 2448 the Free Software Foundation; either version 2 of the License, or 2449 (at your option) any later version. 2450 2451 This program is distributed in the hope that it will be useful, 2452 but WITHOUT ANY WARRANTY; without even the implied warranty of 2453 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 2454 GNU General Public License for more details. 2455 2456If you need a copy of the GNU General Public License write to the Free Software 2457Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 2458 2459=cut 2460