Webpacus/Model/Databases.pm

package Webpacus::Model::Databases;

use strict;
use warnings;
use base 'Catalyst::Model';
use Encode qw/decode/;

=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;

        $self->{config_encoding} = $c->config->{config_encoding} and
                $c->log->debug("using config encoding ", $self->{config_encoding});

        return $self;
}

=head1 convert

Convert encodings from C<config_encoding>

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

=cut

sub convert {
        my $self = shift;
        my $val = shift || return;
        my $encoding = $self->{config_encoding} || return $val;
        return decode($encoding, $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	dpavlin	271	package Webpacus::Model::Databases;
2
3			use strict;
4			use warnings;
5			use base 'Catalyst::Model';
6	dpavlin	349	use Encode qw/decode/;
7	dpavlin	271
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	dpavlin	353	$self->{config_encoding} = $c->config->{config_encoding} and
34			$c->log->debug("using config encoding ", $self->{config_encoding});
35	dpavlin	271
36			return $self;
37			}
38
39			=head1 convert
40
41	dpavlin	349	Convert encodings from C<config_encoding>
42	dpavlin	271
43			my $utf8 = $self->convert('foobar');
44
45			=cut
46
47			sub convert {
48			my $self = shift;
49			my $val = shift \|\| return;
50	dpavlin	353	my $encoding = $self->{config_encoding} \|\| return $val;
51	dpavlin	349	return decode($encoding, $val);
52	dpavlin	271	}
53
54			=head1 list_inputs
55
56			Returns list of databases with C<input>, C<name>, C<prefix> defined in
57			Webpacus configuration file C<config.yml> under C<databases>
58
59			my @dbs = $c->comp('Model::Databases')->list_inputs;
60
61			=cut
62
63			sub list_inputs {
64			my $self = shift;
65
66			my @databases;
67
68			# convert to resonable format for TT
69			foreach my $db (keys %{ $self->{databases} }) {
70			my $d = $self->{databases}->{$db} \|\| die;
71			my $inputs = $d->{input} \|\| next;
72			$inputs = [ $inputs ] if (ref($inputs) ne 'ARRAY');
73
74			foreach my $i ( @{ $inputs } ) {
75			my $el = {
76			input => $self->convert( $i->{name} ),
77			name => $self->convert( $d->{name} \|\| $d ),
78			prefix => $self->convert( $db . '/' . $i->{name} ),
79			};
80			push @databases, $el;
81			}
82			}
83
84			return @databases;
85			}
86
87			=head1 list
88
89			Returns just of just unique databases with C<name> and C<prefix>.
90
91	dpavlin	329	my @dbs = $c->comp('Model::Databases')->list;
92
93			You can also return just databases that have C<input> defined (that are not
94			empty databases used for agregation) if you add option C<require_input>.
95
96			my @db_2 = $c->comp('Model::Databases')->list( require_input => 1 );
97
98	dpavlin	271	=cut
99
100			sub list {
101			my $self = shift;
102
103	dpavlin	329	my $args = shift;
104
105	dpavlin	271	my @databases;
106
107			foreach my $db (keys %{ $self->{databases} }) {
108			my $d = $self->{databases}->{$db} \|\| die;
109
110	dpavlin	329	if ($args->{require_input}) {
111			next unless ($d->{input});
112			}
113
114	dpavlin	271	my $el = {
115			name => $self->convert( $d->{name} \|\| $db ),
116			prefix => $self->convert( $db ),
117			};
118			push @databases, $el;
119			}
120
121			return @databases;
122			}
123
124			=head1 AUTHOR
125
126			Dobrica Pavlinusic, C< <<dpavlin@rot13.org>> >
127
128			=head1 LICENSE
129
130			This library is free software, you can redistribute it and/or modify
131			it under the same terms as Perl itself.
132
133			=cut
134
135			1;