Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\scripts\TableOut.pm

#
#  $Header: TableOut.pm 30-aug-01.11:36:58 asawant Exp $
#
#
# Copyright (c) 2001, Oracle Corporation.  All rights reserved.  
#
#    NAME
#      TableOut.pm - Table Out
#
#    DESCRIPTION
#      The class provides a generic way to output a data table to a file.
#    The user must provide all appropriate elements listed bellow:
#    - Table Header, Table Footer, Line Prefix, Line Sufix, Line Separator,
#    Column Prefix, Column Sufix, Column Separator. 
#      See that the column prefix and the column sufix are per column, 
#    and are provided as an array reference. If there are no column 
#    sufixes or prefixes, passing in a non reference type, will cause them 
#    to be ignored (do not pass in an empty array).
#      The output file is opened at creation time, and data is pumped to the
#    file at every call of add_line(). Very little (almost none) verification
#    and validation of data is currently done, so sending in fewer columns of
#    data, invalid data, etc, may cause malfunction. To end data pumping and 
#    add all the remaining apprpriate tags, call end_data().
#
#    NOTES
#      No extra punctuation or formating is added, so don't expect to see 
#      newlines added for you (use a \n in the string where you want a 
#      new line).
#
#    MODIFIED   (MM/DD/YY)
#     asawant    08/30/01 - Adding defined checks for every element of the conf
#     asawant    08/01/01 - Fixing validation code.
#     asawant    06/18/01 - Creation
#
#

package TableOut;
use strict;
use IO::File;
use File::Copy;

# The object properties for an object of this class are:
# (
#  file_handle_ref => a reference to the IO:File object (file handle)
#  config_hash_ref => a reference to the config hash
#  not_first_line  => bit used to add/omit a the line separator
#  is_open => is file open
# )

# Trace is Off by default
my $TRACE_ON = 0;
sub trace 
{
  if($TRACE_ON) 
  {
    print "DEBUG: $_[0]"."\n";
  };
}

sub ToggleTrace 
{
  $TRACE_ON = 1 - $TRACE_ON;
}

# Usage : new(class, err_ref, file_name, config_hash_ref)
# The config_hash is a read only parameter (the package won't change it) like:
# {
#   "table_header" => <table_header>,
#   "table_footer" => <table_footer>,
#   "line_prefix" => <line_prefix>,
#   "line_sufix"  => <line_sufix>,
#   "line_separator => <line_separator>,
#   "columns" => 
#     [["col1_prefix", "col1_sufix], ... ,["coln_prefix", "coln_sufix"]]
#   "column_separator"=> <column_separator>
# }
# Returns a reference to a new object of this class. If there is any failure
# returns undef.
sub new 
{
  my ($class, $err_ref, $file_name, $config_hash_ref) = @_;
  my %object_vars = 
  (
    file_name => undef,
    file_handle_ref => undef,
    config_hash_ref => undef,
    not_first_line => 0,
    is_open => 0
  );
  
  my $self = {%object_vars};

trace("TableOut: $class");
  bless $self, $class;

$self->{file_name} = $file_name;
  $self->{config_hash_ref} = $config_hash_ref;  # all the other parameters

trace("Do validation of all required input params.");
  unless(defined($self->{file_name}) && defined($self->{config_hash_ref})
    && exists($self->{config_hash_ref}{table_header})
    && exists($self->{config_hash_ref}{table_footer})
    && exists($self->{config_hash_ref}{line_prefix})
    && exists($self->{config_hash_ref}{line_sufix})
    && exists($self->{config_hash_ref}{line_separator})
    && exists($self->{config_hash_ref}{columns})
    && exists($self->{config_hash_ref}{column_separator}))
  {
    $$err_ref = "Incomplete list of parameters.\n";
    return(undef);
  };

trace("Opening the output file: $self->{file_name}");
  $self->{file_handle_ref} = new IO::File;
  unless($self->{file_handle_ref}->open(">".$self->{file_name})) 
  {
    $$err_ref = "$!\nFailed opening file.\n";
    return undef;
  };
  $self->{is_open} = 1;

if(defined($self->{config_hash_ref}{table_header}))
  {
    trace("Print header to out file: $self->{config_hash_ref}{table_header}");
    unless(print {$self->{file_handle_ref}} 
      $self->{config_hash_ref}{table_header})
    {
      $$err_ref = "$!\nFailed while printing to file.\n";
      $self->{file_handle_ref}->close();
      return undef;
    }
  }

return $self;
}

# Usage: add_line(self, err_ref, line_data_ref)
# Input: reference to array containing row of column data
# Returns "1" on success or "0" on failure.
# Comments: no check is done as to the data existing or not, invalid data
# rows will cause unexepected and possible erroneous behavior. If fewer
# columns are passed in, only those will be printed out.
sub add_line 
{
  my ($self, $err_ref, $line_data_ref) = @_;

# If there is a line separator
  if(defined($self->{config_hash_ref}{line_separator}))
  {
    # If this is not the first line
    if($self->{not_first_line})
    {
      trace("Print line separator.");
      unless(print {$self->{file_handle_ref}} 
        $self->{config_hash_ref}{line_separator}) 
      {
        $$err_ref = "$!\nFailed while printing to file.\n";
        return 0;
      }
    } 
    else 
    {
      $self->{not_first_line} = 1;
    }
  }

if(defined($self->{config_hash_ref}{line_prefix}))
  {
    trace("Print line prefix: $self->{config_hash_ref}{line_prefix}");
    unless(print {$self->{file_handle_ref}} 
      $self->{config_hash_ref}{line_prefix})
    {
      $$err_ref = "$!\nFailed while printing to file.\n";
      return 0;
    }
  }

for (my $col_count = 0; $col_count < @$line_data_ref; ) 
  {

# Verify that column has prefix and/or sufix
    if(ref($self->{config_hash_ref}{columns})) 
    {
      trace("Print column $col_count prefix.");
      unless(print {$self->{file_handle_ref}} 
        ${$self->{config_hash_ref}{columns}}[$col_count][0]) 
      {
        $$err_ref = "$!\nFailed while printing to file.\n";
        return 0;
      }
    }

trace("Print column $col_count data: ${@$line_data_ref}[$col_count]");
    unless(print {$self->{file_handle_ref}} ${@$line_data_ref}[$col_count]) 
    {
      $$err_ref = "$!\nFailed while printing to file.\n";
      return 0;
    }

# Verify that column has prefix and/or sufix
    if(ref($self->{config_hash_ref}{columns})) 
    {
      trace("Print column $col_count sufix.");
      unless(print {$self->{file_handle_ref}} 
        ${$self->{config_hash_ref}{columns}}[$col_count][1]) 
      {
        $$err_ref = "$!\nFailed while printing to file.\n";
        return 0;
      }
    }

# Verify if there is a column separator and that this is the last column
    if((defined($self->{config_hash_ref}{column_separator})) &&
      (++$col_count != @$line_data_ref))
    {
      trace("Print column separator.");
      unless(print {$self->{file_handle_ref}} 
        $self->{config_hash_ref}{column_separator}) 
      {
        $$err_ref = "$!\nFailed while printing to file.\n";
        return 0;
      }
    }
  }

# If there is a line sufix
  if(defined($self->{config_hash_ref}{line_sufix}))
  {
    trace("Print line sufix: $self->{config_hash_ref}{line_sufix}");
    unless(print {$self->{file_handle_ref}} 
      $self->{config_hash_ref}{line_sufix}) 
    {
      $$err_ref = "$!\nFailed while printing to file.\n";
      return 0;
    }
  }

return(1);
}

# Usage end_data(self, err_ref)
# End the data streaming.
# Returns "1" on success or "0" on failure.
sub end_data 
{
  my ($self, $err_ref) = @_;

# If there is a file footer
  if(defined($self->{config_hash_ref}{table_footer}))
  {
    trace("Print file footer.");
    unless(print {$self->{file_handle_ref}} 
      $self->{config_hash_ref}{table_footer}) 
    {
      $$err_ref = "$!\nFailed while printing to file.\n";
      $self->end_force();
      return 0;
    }
  }

$self->{is_open} = 0;  # file is (will be in next cmd) closed
  unless($self->{file_handle_ref}->close()) 
  {
    $$err_ref = "$!\nFailed while closing file.\n";
    return 0;
  }
  return 1;
}

# Usage: end_force(self)
# This function just closes the output files. This is an abrupt close, and
# should be used only when things go wrong (errouneous situations).
# Always returns 1.
sub end_force 
{
  my ($self) = @_;
  if($self->{is_open}) 
  {
    $self->{file_handle_ref}->close();
  };
  return 1;
};

# So the require or use succeeds
1;

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de