lib/WebPAC/Output.pm

package WebPAC::Output;

use warnings;
use strict;

use Carp qw/confess/;
use Data::Dump qw/dump/;

=head1 NAME

WebPAC::Output - The great new WebPAC::Output!

=cut

=head1 SYNOPSIS

Common routines for output formats

=head1 FUNCTIONS

=head2 ds_to_hash

  my $hash = $self->ds_to_hash( $ds, 'display'
        disable_key_mungle => 0,
        singe_values = 0,
  );

=cut

sub ds_to_hash {
        my $self = shift;

        my $ds = shift || confess "need ds";
        my $type = shift || confess "need type";

        my $opt = {@_};

        my $hash;

        foreach my $t ( keys %$ds ) {
                my $name = $t;
                if ( ! $opt->{disable_key_mungle} ) {
                        $name = lc($name);
                        $name =~ s/\W+/_/g;
                }

                my $v = $ds->{$t} || die "bug";

                # FIXME get rid of non hash values in data_structure for consistency?
                next unless ref($v) eq 'HASH';

                if ( defined( $v->{$type} ) ) {
                        if ( $opt->{single_values} && ref($v->{$type}) eq 'ARRAY' ) {
                                $hash->{$name} = join(' ', map {
                                        if(ref($_)) {
                                                dump($_);
                                        } else {
                                                $_;
                                        }
                                } @{ $v->{$type} });
                        } else {
                                $hash->{$name} = $v->{$type};
                        }
                }
        }

        return $hash;
}


=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005-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
1	dpavlin	1	package WebPAC::Output;
2
3			use warnings;
4			use strict;
5
6	dpavlin	913	use Carp qw/confess/;
7	dpavlin	1069	use Data::Dump qw/dump/;
8	dpavlin	913
9	dpavlin	1	=head1 NAME
10
11			WebPAC::Output - The great new WebPAC::Output!
12
13			=cut
14
15			=head1 SYNOPSIS
16
17	dpavlin	913	Common routines for output formats
18	dpavlin	1
19	dpavlin	913	=head1 FUNCTIONS
20	dpavlin	1
21	dpavlin	913	=head2 ds_to_hash
22	dpavlin	1
23	dpavlin	1068	my $hash = $self->ds_to_hash( $ds, 'display'
24	dpavlin	1069	disable_key_mungle => 0,
25			singe_values = 0,
26	dpavlin	1068	);
27	dpavlin	1
28	dpavlin	913	=cut
29	dpavlin	1
30	dpavlin	913	sub ds_to_hash {
31			my $self = shift;
32	dpavlin	1
33	dpavlin	1068	my $ds = shift \|\| confess "need ds";
34			my $type = shift \|\| confess "need type";
35	dpavlin	1
36	dpavlin	1068	my $opt = {@_};
37	dpavlin	1
38	dpavlin	913	my $hash;
39	dpavlin	1
40	dpavlin	913	foreach my $t ( keys %$ds ) {
41	dpavlin	1068	my $name = $t;
42			if ( ! $opt->{disable_key_mungle} ) {
43			$name = lc($name);
44			$name =~ s/\W+/_/g;
45			}
46	dpavlin	1
47	dpavlin	1069	my $v = $ds->{$t} \|\| die "bug";
48
49	dpavlin	913	# FIXME get rid of non hash values in data_structure for consistency?
50	dpavlin	1069	next unless ref($v) eq 'HASH';
51	dpavlin	1
52	dpavlin	1069	if ( defined( $v->{$type} ) ) {
53			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	dpavlin	913	}
65			}
66	dpavlin	1
67	dpavlin	913	return $hash;
68	dpavlin	1	}
69
70	dpavlin	924
71	dpavlin	1	=head1 AUTHOR
72
73			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
74
75			=head1 COPYRIGHT & LICENSE
76
77	dpavlin	913	Copyright 2005-2007 Dobrica Pavlinusic, All Rights Reserved.
78	dpavlin	1
79			This program is free software; you can redistribute it and/or modify it
80			under the same terms as Perl itself.
81
82			=cut
83
84			1; # End of WebPAC::Output