r1670@llin: dpavlin | 2007-11-28 00:13:29 +0100

 - WebPAC::Output::Excel

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@1068 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/Makefile.PL b/Makefile.PL
index 51f7a34..ae09ada 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -5,7 +5,7 @@ use inc::Module::Install;
 
 
 name   'WebPAC';
-version        '2.33';
+version        '2.34_1';
 license        'GPL';
 
 requires       'YAML';
@@ -38,36 +38,30 @@ requires    'JSON';
 requires       'File::Spec';
 requires       'Sort::External';
 
-features(
-       'WebPAC::Output::Webpacus and WebPAC::Output::Jifty' => [
-               -default => 0,
-               recommends('Jifty'),
-       ],
-);
-
 features(
        'WebPAC::Input::XML' => [
                -default => 0,
                recommends('XML::Simple'),
                recommends('File::Find'),
        ],
-);
-
-features(
        'WebPAC::Input::PDF' => [
                -default => 0,
                recommends('CAM::PDF'),
        ],
-);
-
-features(
        'WebPAC::Output::Estraier' => [
                -default => 0,
                recommends('Search::Estraier' => 0.06),
        ],
+       'WebPAC::Output::Webpacus and WebPAC::Output::Jifty' => [
+               -default => 0,
+               recommends('Jifty'),
+       ],
+       'WebPAC::Output::Excel' => [
+               -default => 0,
+               recommends('Spreadsheet::WriteExcel'),
+       ],
 );
 
-
 build_requires 'Test::More';
 
 clean_files('WebPAC-* pod2html Makefile tags');

diff --git a/conf/llin.yml b/conf/llin.yml
index 9d33595..1429de7 100644 (file)
--- a/conf/llin.yml
+++ b/conf/llin.yml
@@ -403,3 +403,15 @@ databases:
         path: '/data/Webpacus2'
         model: 'Webpacus::Model::UFO'
 
+  csv:
+    name: 'CSV Excel export'
+    input:
+      - name: peri
+        module: 'WebPAC::Input::ISIS'
+        path: '/data/isis_data/ffps-peri/PERI'
+#        encoding: 'cp852'
+        normalize:
+          path: 'conf/normalize/common.pl'
+    output:
+      - module: 'Excel'
+        path: 'out/peri.xls'

diff --git a/conf/log.conf b/conf/log.conf
index d564f97..0237883 100644 (file)
--- a/conf/log.conf
+++ b/conf/log.conf
@@ -54,6 +54,7 @@ log4perl.logger.WebPAC.Input.PDF=DEBUG
 #log4perl.logger.WebPAC.Output.KinoSearch=DEBUG
 #log4perl.logger.WebPAC.Output.Webpacus=DEBUG
 log4perl.logger.WebPAC.Output.Jifty=DEBUG
+log4perl.logger.WebPAC.Output.Excel=DEBUG
 
 #log4perl.logger.WebPAC.Search.Estraier=DEBUG
 

diff --git a/conf/normalize/csv_ff-peri.pl b/conf/normalize/csv_ff-peri.pl
index c65cd69..f9bb095 100644 (file)
--- a/conf/normalize/csv_ff-peri.pl
+++ b/conf/normalize/csv_ff-peri.pl
@@ -1,3 +1,5 @@
+sub csv { to('csv',@_) }
+
 if ( rec('200','a') ) {
 
 ## 022

diff --git a/lib/WebPAC/Common.pm b/lib/WebPAC/Common.pm
index 9989ee5..9bc6157 100644 (file)
--- a/lib/WebPAC/Common.pm
+++ b/lib/WebPAC/Common.pm
@@ -2,6 +2,7 @@ package WebPAC::Common;
 use Exporter 'import';
 @EXPORT = qw/
        force_array
+       dump
 /;
 
 use warnings;

diff --git a/lib/WebPAC/Output.pm b/lib/WebPAC/Output.pm
index ee35e7d..e0d4812 100644 (file)
--- a/lib/WebPAC/Output.pm
+++ b/lib/WebPAC/Output.pm
@@ -25,23 +25,28 @@ Common routines for output formats
 
 =head2 ds_to_hash
 
-  my $hash = $self->ds_to_hash( $ds, 'display' );
+  my $hash = $self->ds_to_hash( $ds, 'display'
+       disable_key_mungle => 1,
+  );
 
 =cut
 
 sub ds_to_hash {
        my $self = shift;
 
-       my ( $ds, $type ) = @_;
+       my $ds = shift || confess "need ds";
+       my $type = shift || confess "need type";
 
-       confess "need ds" unless $ds;
-       confess "need type" unless $type;
+       my $opt = {@_};
 
        my $hash;
 
        foreach my $t ( keys %$ds ) {
-               my $name = lc($t);
-               $name =~ s/\W+/_/g;
+               my $name = $t;
+               if ( ! $opt->{disable_key_mungle} ) {
+                       $name = lc($name);
+                       $name =~ s/\W+/_/g;
+               }
 
                # FIXME get rid of non hash values in data_structure for consistency?
                next unless ref($ds->{$t}) eq 'HASH';

diff --git a/lib/WebPAC/Output/Excel.pm b/lib/WebPAC/Output/Excel.pm
new file mode 100644 (file)
index 0000000..d422746
--- /dev/null
+++ b/lib/WebPAC/Output/Excel.pm
@@ -0,0 +1,155 @@
+package WebPAC::Output::Excel;
+
+use warnings;
+use strict;
+
+use WebPAC::Common;
+use base qw/WebPAC::Common WebPAC::Output Class::Accessor/;
+__PACKAGE__->mk_accessors(qw(
+path
+filter
+
+workbook
+worksheet
+line
+));
+
+use Spreadsheet::WriteExcel;
+use File::Slurp;
+
+=head1 NAME
+
+WebPAC::Output::Excel - Create binary Excel file
+
+=cut
+
+=head1 SYNOPSIS
+
+Create Excel output for export into other systems from C<csv()> constructs
+with columns named C<A>..C<Z> (or whatever L<Spreadsheet::WriteExcel> supports)
+
+=head1 FUNCTIONS
+
+=head2 new
+
+ my $out = new WebPAC::Output::Excel({
+       path => '/path/to/file.xls',
+       filter => 'csv',
+ });
+
+Options are:
+
+=over 4
+
+=item path
+
+path to Excel file
+
+=item filter
+
+select name of variable from C<< to('csv','A',...) >> constructs used by
+L<WebPAC::Normalize>
+
+=back
+
+=head2 init
+
+  $out->init;
+
+=cut
+
+sub init {
+       my $self = shift;
+       my $log = $self->_get_logger;
+
+       if ( ! $self->path ) {
+               $log->logwarn("need path for ", __PACKAGE__);
+               return 0;
+       }
+
+       $self->workbook( Spreadsheet::WriteExcel->new( $self->path ) ) ||
+               $log->logdie("can't open ", $self->path,": $!");
+
+       $self->worksheet( $self->workbook->add_worksheet() ) ||
+               $log->logdie("can't add_worksheet");
+
+       $self->line( 1 );
+
+       $self->filter( 'csv' ) unless $self->filter;
+
+       return 1;
+}
+
+
+=head2 add
+
+Adds one entry to database.
+
+  $out->add( 42, $ds );
+
+Returns number of columns added
+
+=cut
+
+sub add {
+       my $self = shift;
+
+       my ( $id, $ds ) = @_;
+
+       my $log = $self->_get_logger;
+       $log->logdie("need id") unless defined $id;
+       $log->logdie("need ds") unless $ds;
+
+       $log->debug("id: $id ds = ",sub { dump($ds) });
+
+       my $l = $self->line;
+
+       my $cols = 0;
+
+       my $hash = $self->ds_to_hash( $ds, $self->filter, disable_key_mungle => 1 );
+       $log->debug("hash from ",$self->filter," = ", sub { dump( $hash ) });
+
+       my $worksheet = $self->worksheet || $log->logconfess("no worksheet?");
+       foreach my $col ( sort grep { /^[A-Z]/ } keys %$hash ) {
+               my $val = $hash->{$col};
+               $log->debug("$col$l|$val");
+               $worksheet->write( $col . $l , $val );
+#                      || $log->logdie("can't add ", $col, $l, '|', $val, ": $!");
+               $cols++;
+       }
+
+       $self->line( $l + 1 ) if $cols;
+
+       return $cols;
+}
+
+=head2 finish
+
+ $out->finish;
+
+=cut
+
+sub finish {
+       my $self = shift;
+
+       my $log = $self->_get_logger();
+
+       $self->workbook->close() ||
+               $log->logdie("can't close Excel file ", $self->path, ": $!");
+
+}
+
+=head1 AUTHOR
+
+Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of WebPAC::Output::Excel

diff --git a/t/5-output-excel.t b/t/5-output-excel.t
new file mode 100755 (executable)
index 0000000..d588645
--- /dev/null
+++ b/t/5-output-excel.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+use strict;
+use blib;
+
+use Test::More tests => 14;
+
+BEGIN {
+use_ok( 'WebPAC::Test' );
+use_ok( 'WebPAC::Output::Excel' );
+}
+
+my $path = "$abs_path/out/test.xls";
+
+ok(my $out = new WebPAC::Output::Excel({ path => $path, %LOG }), "new");
+
+ok( $out->init, 'init' );
+
+throws_ok { $out->add( ) } qr/need id/, 'add without params';
+throws_ok { $out->add( 42 ) } qr/need ds/, 'add without ds';
+
+foreach my $line ( 1 .. 5 ) {
+       my $ds;
+       foreach my $col ( 'A' .. 'Z' ) {
+               $ds->{ $col } = { csv => $line . $col };
+       }
+       ok( $out->add( $line, $ds ), "add $line" );
+}
+
+ok( $out->finish );
+
+ok( -e $out->path, "created $path" );
+
+cmp_ok( $out->path, 'eq', $path, 'path' );
+