"Fossies" - the Fresh Open Source Software Archive

Member "usr/lib/mysql-zrm/Data/Report/Plugin/Csv.pm" (26 Aug 2013, 3166 Bytes) of package /linux/privat/MySQL-zrm-3.0-release.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Csv.pm" see the Fossies "Dox" file reference documentation.

    1 # Data::Report::Plugin::Csv.pm -- CSV plugin for Data::Report
    2 # RCS Info        : $Id: Csv.pm 3564 2006-09-13 03:27:09Z gsat $
    3 # Author          : Johan Vromans
    4 # Created On      : Thu Jan  5 18:47:37 2006
    5 # Last Modified By: Johan Vromans
    6 # Last Modified On: Mon May 22 17:51:41 2006
    7 # Update Count    : 99
    8 # Status          : Unknown, Use with caution!
    9 
   10 package Data::Report::Plugin::Csv;
   11 
   12 use strict;
   13 use warnings;
   14 use base qw(Data::Report::Base);
   15 
   16 ################ API ################
   17 
   18 my $csv_implementation = 0;
   19 
   20 sub start {
   21     my ($self, @args) = @_;
   22     $self->SUPER::start(@args);
   23     $self->set_separator(",") unless $self->get_separator;
   24     $self->_select_csv_method unless $csv_implementation;
   25     return;
   26 }
   27 
   28 sub finish {
   29     my ($self) = @_;
   30     $self->SUPER::finish();
   31 }
   32 
   33 sub add {
   34     my ($self, $data) = @_;
   35 
   36     my $style = delete($data->{_style});
   37 
   38     my $sep = $self->get_separator;
   39 
   40     $self->SUPER::add($data);
   41 
   42     return unless %$data;
   43 
   44     if ( $style and my $t = $self->_getstyle($style) ) {
   45     return if $t->{ignore};
   46     }
   47 
   48     $self->_checkhdr;
   49 
   50     my $line;
   51 
   52     $line = $self->_csv
   53       ( map {
   54       $data->{$_->{name}} || ""
   55         } @{$self->_get_fields}
   56       );
   57     $self->_print($line, "\n");
   58 }
   59 
   60 sub set_separator { $_[0]->{sep} = $_[1] }
   61 sub get_separator { $_[0]->{sep} || "," }
   62 
   63 ################ Pseudo-Internal (used by Base class) ################
   64 
   65 sub _std_heading {
   66     my ($self) = @_;
   67     my $sep = $self->get_separator;
   68 
   69     $self->_print($self->_csv(map { $_->{title} } @{$self->_get_fields}), "\n");
   70 }
   71 
   72 ################ Internal (used if no alternatives) ################
   73 
   74 sub _csv_internal {
   75     join(shift->get_separator,
   76      map {
   77          # Quotes must be doubled.
   78          s/"/""/g;
   79          # Always quote (compatible with Text::CSV)
   80          $_ = '"' . $_ . '"';
   81          $_;
   82      } @_);
   83 }
   84 
   85 sub _set_csv_method {
   86     my ($self, $class) = @_;
   87     no warnings qw(redefine);
   88 
   89     if ( $class && $class->isa("Text::CSV_XS") ) {
   90 
   91     # Use always_quote to be compatible with Text::CSV.
   92     $csv_implementation = Text::CSV_XS->new
   93       ({ sep_char => $self->get_separator,
   94          always_quote => 1,
   95        });
   96 
   97     # Assign the method.
   98     *_csv = sub {
   99         shift;
  100         $csv_implementation->combine(@_);
  101         $csv_implementation->string;
  102     };
  103     }
  104     elsif ( $class && $class->isa("Text::CSV") ) {
  105 
  106     $csv_implementation = Text::CSV->new;
  107 
  108     # Assign the method.
  109     *_csv = sub {
  110         shift;
  111         $csv_implementation->combine(@_);
  112         $csv_implementation->string;
  113     };
  114     }
  115     else {
  116     # Use our internal method.
  117     *_csv = \&_csv_internal;
  118     $csv_implementation = "Data::Report::Plugin::Csv::_csv_internal";
  119     }
  120 
  121     return $csv_implementation;
  122 }
  123 
  124 sub _select_csv_method {
  125     my $self = shift;
  126 
  127     $csv_implementation = 0;
  128     eval {
  129     require Text::CSV_XS;
  130     $self->_set_csv_method(Text::CSV_XS::);
  131     };
  132     return $csv_implementation if $csv_implementation;
  133 
  134     if ( $self->get_separator eq "," ) {
  135       eval {
  136         require Text::CSV;
  137     $self->_set_csv_method(Text::CSV::);
  138       };
  139     }
  140     return $csv_implementation if $csv_implementation;
  141 
  142     # Use our internal method.
  143     $self->_set_csv_method();
  144 
  145     return $csv_implementation;
  146 }
  147 
  148 1;