Webpacus/Model/Databases.pm

package Webpacus::Model::Databases;

use strict;
use warnings;
use base 'Catalyst::Model';
use Text::Iconv;

=head1 NAME

Webpacus::Model::Databases - Catalyst Model to represent available databases

=head1 SYNOPSIS

See L<Webpacus>

=head1 DESCRIPTION

Get databases from config

=cut

sub new {
        my ( $self, $c, $config ) = @_;

        $self = $self->NEXT::new($c, $config);
        $self->config($config);

        # get databases from config
        $self->{databases} = $c->config->{databases} or
                $c->log->fail("didn't find databases in config");
        $self->{log} = $c->log;

        my $from = $c->config->{config_encoding};
        my $to = $c->config->{catalyst_encoding};

        $self->{iconv} = new Text::Iconv($from, $to) if ($from && $to);

        return $self;
}

=head1 convert

Convert encodings from C<config_encoding> to C<catalyst_encoding>

  my $utf8 = $self->convert('foobar');

=cut

sub convert {
        my $self = shift;
        my $val = shift || return;
        return $val unless ($self->{iconv});

        return $self->{iconv}->convert($val);
}

=head1 list_inputs

Returns list of databases with C<input>, C<name>, C<prefix> defined in
Webpacus configuration file C<config.yml> under C<databases>

  my @dbs = $c->comp('Model::Databases')->list_inputs;

=cut

sub list_inputs {
        my $self = shift;

        my @databases;

        # convert to resonable format for TT
        foreach my $db (keys %{ $self->{databases} }) {
                my $d = $self->{databases}->{$db} || die;
                my $inputs = $d->{input} || next;
                $inputs = [ $inputs ] if (ref($inputs) ne 'ARRAY');

                foreach my $i ( @{ $inputs } ) {
                        my $el = {
                                input   => $self->convert( $i->{name} ),
                                name    => $self->convert( $d->{name} || $d ),
                                prefix  => $self->convert( $db . '/' . $i->{name} ),
                        };
                        push @databases, $el;
                }
        }

        return @databases;
}

=head1 list

Returns just of just unique databases with C<name> and C<prefix>.

 my @dbs = $c->comp('Model::Databases')->list;

You can also return just databases that have C<input> defined (that are not
empty databases used for agregation) if you add option C<require_input>.

 my @db_2 = $c->comp('Model::Databases')->list( require_input => 1 );

=cut

sub list {
        my $self = shift;

        my $args = shift;

        my @databases;

        foreach my $db (keys %{ $self->{databases} }) {
                my $d = $self->{databases}->{$db} || die;

                if ($args->{require_input}) {
                        next unless ($d->{input});
                }

                my $el = {
                        name    => $self->convert( $d->{name} || $db ),
                        prefix  => $self->convert( $db ),
                };
                push @databases, $el;
        }

        return @databases;
}

=head1 AUTHOR

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

=head1 LICENSE

This library is free software, you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
1	package Webpacus::Model::Databases;
2
3	use strict;
4	use warnings;
5	use base 'Catalyst::Model';
6	use Text::Iconv;
7
8	=head1 NAME
9
10	Webpacus::Model::Databases - Catalyst Model to represent available databases
11
12	=head1 SYNOPSIS
13
14	See L<Webpacus>
15
16	=head1 DESCRIPTION
17
18	Get databases from config
19
20	=cut
21
22	sub new {
23	my ( $self, $c, $config ) = @_;
24
25	$self = $self->NEXT::new($c, $config);
26	$self->config($config);
27
28	# get databases from config
29	$self->{databases} = $c->config->{databases} or
30	$c->log->fail("didn't find databases in config");
31	$self->{log} = $c->log;
32
33	my $from = $c->config->{config_encoding};
34	my $to = $c->config->{catalyst_encoding};
35
36	$self->{iconv} = new Text::Iconv($from, $to) if ($from && $to);
37
38	return $self;
39	}
40
41	=head1 convert
42
43	Convert encodings from C<config_encoding> to C<catalyst_encoding>
44
45	my $utf8 = $self->convert('foobar');
46
47	=cut
48
49	sub convert {
50	my $self = shift;
51	my $val = shift \|\| return;
52	return $val unless ($self->{iconv});
53
54	return $self->{iconv}->convert($val);
55	}
56
57	=head1 list_inputs
58
59	Returns list of databases with C<input>, C<name>, C<prefix> defined in
60	Webpacus configuration file C<config.yml> under C<databases>
61
62	my @dbs = $c->comp('Model::Databases')->list_inputs;
63
64	=cut
65
66	sub list_inputs {
67	my $self = shift;
68
69	my @databases;
70
71	# convert to resonable format for TT
72	foreach my $db (keys %{ $self->{databases} }) {
73	my $d = $self->{databases}->{$db} \|\| die;
74	my $inputs = $d->{input} \|\| next;
75	$inputs = [ $inputs ] if (ref($inputs) ne 'ARRAY');
76
77	foreach my $i ( @{ $inputs } ) {
78	my $el = {
79	input => $self->convert( $i->{name} ),
80	name => $self->convert( $d->{name} \|\| $d ),
81	prefix => $self->convert( $db . '/' . $i->{name} ),
82	};
83	push @databases, $el;
84	}
85	}
86
87	return @databases;
88	}
89
90	=head1 list
91
92	Returns just of just unique databases with C<name> and C<prefix>.
93
94	my @dbs = $c->comp('Model::Databases')->list;
95
96	You can also return just databases that have C<input> defined (that are not
97	empty databases used for agregation) if you add option C<require_input>.
98
99	my @db_2 = $c->comp('Model::Databases')->list( require_input => 1 );
100
101	=cut
102
103	sub list {
104	my $self = shift;
105
106	my $args = shift;
107
108	my @databases;
109
110	foreach my $db (keys %{ $self->{databases} }) {
111	my $d = $self->{databases}->{$db} \|\| die;
112
113	if ($args->{require_input}) {
114	next unless ($d->{input});
115	}
116
117	my $el = {
118	name => $self->convert( $d->{name} \|\| $db ),
119	prefix => $self->convert( $db ),
120	};
121	push @databases, $el;
122	}
123
124	return @databases;
125	}
126
127	=head1 AUTHOR
128
129	Dobrica Pavlinusic, C< <<dpavlin@rot13.org>> >
130
131	=head1 LICENSE
132
133	This library is free software, you can redistribute it and/or modify
134	it under the same terms as Perl itself.
135
136	=cut
137
138	1;