root/lang/perl/Moxy/trunk/lib/Moxy.pm @ 4978

Revision 4978, 4.7 kB (checked in by tokuhirom, 6 years ago)

lang/perl/Moxy: Checking in changes prior to tagging of version 0.08. Changelog diff is:

=== Changes
==================================================================
--- Changes (revision 5235)
+++ Changes (local)
@@ -1,5 +1,11 @@

Revision history for Moxy


+0.08
+
+ - (INCOMPATIBLE CHANGE) plugin hook point is all changed.
+ - internal code is utf-8 instead of euc-jp.
+ - Moxy::Plugin::Application is direct access to the server.
+

0.07


Unknown target: CHANGES.

Line 
1package Moxy;
2use strict;
3use warnings;
4require Class::Accessor::Fast;
5use base qw/Class::Accessor::Fast/;
6
7our $VERSION = '0.08';
8
9__PACKAGE__->mk_accessors(qw/config/);
10
11use Path::Class;
12use YAML;
13use Encode;
14use FindBin;
15use UNIVERSAL::require;
16use Carp;
17use Log::Dispatch;
18use Scalar::Util qw/blessed/;
19my $TERM_ANSICOLOR_ENABLED = eval { use Term::ANSIColor; 1; };
20
21sub new {
22    my ($class, $config) = @_;
23
24    my $self = bless { config => $config, }, $class;
25
26    $self->{logger} = Log::Dispatch->new;
27
28    $self->_init_server;
29
30    $self->_load_plugins;
31
32    $self->_init_ua_info;
33
34    $self->_init_storage;
35
36    $self->_init_logger;
37
38    return $self;
39}
40
41sub run {
42    my $self = shift;
43
44    $self->{server}->run($self);
45}
46
47sub _load_plugins {
48    my $self = shift;
49
50    for my $plugin (@{$self->config->{plugins}}) {
51        $self->log(debug => "load plugin: $plugin->{module}");
52
53        my $module = "Moxy::Plugin::" . $plugin->{module};
54        $module->require or die $@;
55        $module->register($self);
56    }
57}
58
59sub assets_path {
60    my $self = shift;
61
62    return $self->{__assets_path} ||= do {
63        $self->config->{global}->{assets_path}
64            || dir( $FindBin::RealBin, 'assets' )->stringify;
65    };
66}
67
68# -------------------------------------------------------------------------
69
70sub ua_list {
71    my $self = shift;
72    return $self->{__ua_list} ||= YAML::LoadFile( file( $self->assets_path, qw/common useragent.yaml/)->stringify );
73}
74
75sub _init_ua_info {
76    my $self = shift;
77
78    my $ua_hash;
79    for my $agents (values %{$self->ua_list}) {
80        for my $ua (@{$agents}) {
81            $ua_hash->{$ua->{agent}} = $ua;
82        }
83    }
84    $self->{__ua_hash} = $ua_hash;
85}
86
87sub get_ua_info {
88    my ($self, $ua) = @_;
89
90    return $self->{__ua_hash}->{$ua||''};
91}
92
93# -------------------------------------------------------------------------
94
95sub _init_server {
96    my $self = shift;
97
98    my $conf = $self->{config}->{global}->{server};
99
100    my $proto = $conf->{module} ? "Moxy::Server::$conf->{module}" : "Moxy::Server::HTTPProxy";
101
102    $self->log(debug => "SETUP $proto");
103
104    $proto->use or die $@;
105    my $server = $proto->new($self, $conf);
106    $self->{server} = $server;
107}
108
109# -------------------------------------------------------------------------
110
111sub _init_storage {
112    my ($self, ) = @_;
113
114    my $mod = $self->{config}->{global}->{storage}->{module};
115       $mod = $mod ? "Moxy::Storage::$mod" : 'Moxy::Storage::DBM_File';
116    $mod->use or die $@;
117    $self->{storage} = $mod->new($self, $self->{config}->{global}->{storage} || {});
118}
119
120sub storage { shift->{storage} }
121
122# -------------------------------------------------------------------------
123
124sub _init_logger {
125    my ($self, ) = @_;
126
127    for my $target (@{$self->config->{global}->{log}->{targets}}) {
128        $target->{module}->use or die $@;
129        $self->{logger}->add( $target->{module}->new( %{ $target->{conf} } ) );
130    }
131}
132
133sub log {
134    my ($self, $level, $msg, %opt) = @_;
135
136    # hack to get the original caller as Plugin or Server
137    my $caller = $opt{caller};
138    unless ($caller) {
139        my $i = 0;
140        while (my $c = caller($i++)) {
141            last if $c !~ /Plugin|Server/;
142            $caller = $c;
143        }
144        $caller ||= caller(0);
145    }
146
147    chomp($msg);
148    if ( $self->config->{global}->{log}->{encoding} ) {
149        $msg = Encode::decode_utf8($msg) unless utf8::is_utf8($msg);
150        $msg = Encode::encode( $self->config->{global}->{log}->{encoding}, $msg );
151    }
152
153    $self->{logger}->log(level => $level, message => "$caller [$level] $msg\n");
154}
155
156# -------------------------------------------------------------------------
157
158sub register_hook {
159    my ($self, @hooks) = @_;
160
161    while ( my ( $hook, $callback ) = splice( @hooks, 0, 2 ) ) {
162        croak "invalid args for register_hook" unless ref $callback eq 'CODE';
163
164        push @{ $self->{hooks}->{$hook} }, $callback;
165    }
166}
167
168sub run_hook {
169    my ($self, $hook, @args) = @_;
170
171    $self->log(debug => "Run hook: $hook");
172    for my $action (@{$self->{hooks}->{$hook}}) {
173        $action->($self, @args);
174    }
175}
176
177sub run_hook_and_get_response {
178    my ($self, $hook, @args) = @_;
179
180    $self->log(debug => "Run hook and get response: $hook");
181    for my $action (@{$self->{hooks}->{$hook}}) {
182        my $response = $action->($self, @args);
183        return $response if blessed $response && $response->isa('HTTP::Response');
184    }
185    return; # not finished yet
186}
187
188sub get_hooks {
189    my ($self, $hook) = @_;
190
191    my $hooks = $self->{hooks}->{$hook};
192    return unless $hooks;
193    return wantarray ? @$hooks : $hooks;
194}
195
1961;
197__END__
198
199=head1 NAME
200
201Moxy - Mobile web development proxy
202
203=head1 DESCRIPTION
204
205Moxy is a mobile web development proxy.
206
207=head1 AUTHOR
208
209    Kan Fushihara
210    Tokuhiro Matsuno
211
212=head1 SEE ALSO
213
214L<http://coderepos.org/share/wiki/ssb>
Note: See TracBrowser for help on using the browser.