/[webpac2]/trunk/lib/WebPAC/Output.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Output.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 924 by dpavlin, Wed Oct 31 00:26:45 2007 UTC revision 1069 by dpavlin, Tue Nov 27 23:54:43 2007 UTC
# Line 4  use warnings; Line 4  use warnings;
4  use strict;  use strict;
5    
6  use Carp qw/confess/;  use Carp qw/confess/;
7    use Data::Dump qw/dump/;
8    
9  =head1 NAME  =head1 NAME
10    
11  WebPAC::Output - The great new WebPAC::Output!  WebPAC::Output - The great new WebPAC::Output!
12    
 =head1 VERSION  
   
 Version 0.01  
   
13  =cut  =cut
14    
 our $VERSION = '0.01';  
   
15  =head1 SYNOPSIS  =head1 SYNOPSIS
16    
17  Common routines for output formats  Common routines for output formats
# Line 25  Common routines for output formats Line 20  Common routines for output formats
20    
21  =head2 ds_to_hash  =head2 ds_to_hash
22    
23    my $hash = $self->ds_to_hash( $ds, 'display' );    my $hash = $self->ds_to_hash( $ds, 'display'
24            disable_key_mungle => 0,
25            singe_values = 0,
26      );
27    
28  =cut  =cut
29    
30  sub ds_to_hash {  sub ds_to_hash {
31          my $self = shift;          my $self = shift;
32    
33          my ( $ds, $type ) = @_;          my $ds = shift || confess "need ds";
34            my $type = shift || confess "need type";
35    
36          confess "need ds" unless $ds;          my $opt = {@_};
         confess "need type" unless $type;  
37    
38          my $hash;          my $hash;
39    
40          foreach my $t ( keys %$ds ) {          foreach my $t ( keys %$ds ) {
41                  my $name = lc($t);                  my $name = $t;
42                  $name =~ s/\W+/_/g;                  if ( ! $opt->{disable_key_mungle} ) {
43                            $name = lc($name);
44                            $name =~ s/\W+/_/g;
45                    }
46    
47                    my $v = $ds->{$t} || die "bug";
48    
49                  # FIXME get rid of non hash values in data_structure for consistency?                  # FIXME get rid of non hash values in data_structure for consistency?
50                  next unless ref($ds->{$t}) eq 'HASH';                  next unless ref($v) eq 'HASH';
51    
52                  if ( defined( $ds->{$t}->{$type} ) ) {                  if ( defined( $v->{$type} ) ) {
53                          $hash->{$name} = $ds->{$t}->{$type};                          if ( $opt->{single_values} && ref($v->{$type}) eq 'ARRAY' ) {
54                                    $hash->{$name} = join(' ', map {
55                                            if(ref($_)) {
56                                                    dump($_);
57                                            } else {
58                                                    $_;
59                                            }
60                                    } @{ $v->{$type} });
61                            } else {
62                                    $hash->{$name} = $v->{$type};
63                            }
64                  }                  }
65          }          }
66    
Legend:
Removed from v.924  
changed lines
  Added in v.1069
  ViewVC Help
Powered by ViewVC 1.1.26