Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Pamilla web

  • Loading branch information...
commit 2321d7a70469b9e16a3751983303c82625d7e8d8 1 parent 7d19d38
@mj41 authored
View
4 Changes
@@ -0,0 +1,4 @@
+This file documents the revision history for Pamilla (Personal Manager Pearl).
+
+0.01 2009-08-18 11:46:01
+ - initial revision, generated by Catalyst
View
20 Makefile.PL
@@ -0,0 +1,20 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+# IMPORTANT: if you delete this file your app will not work as
+# expected. You have been warned.
+use inc::Module::Install;
+
+name 'Pamilla';
+all_from 'lib/Pamilla.pm';
+
+requires 'Catalyst::Runtime' => '5.80007';
+requires 'Catalyst::Plugin::ConfigLoader';
+requires 'Catalyst::Plugin::Static::Simple';
+requires 'Catalyst::Action::RenderView';
+requires 'parent';
+requires 'Config::General'; # This should reflect the config file format you've chosen
+ # See Catalyst::Plugin::ConfigLoader for supported formats
+catalyst;
+
+install_script glob('script/*.pl');
+auto_install;
+WriteAll;
View
66 lib/DictAgent.pm
@@ -0,0 +1,66 @@
+package DictAgent;
+
+use strict;
+use warnings;
+use Carp qw(verbose carp croak);
+
+sub new {
+ my $class = shift;
+ my $params = shift;
+
+ my $self = {};
+ $self->{debug} = $params->{debug};
+ $self->{dump_prev_caller_str} = '';
+
+ bless $self, $class;
+ return $self;
+}
+
+
+sub debug {
+ my $self = shift;
+ if (@_) { $self->{debug} = shift }
+ return $self->{debug};
+}
+
+
+sub raw_dump {
+ my $self = shift;
+ my $caller_offset = shift;
+
+ require Data::Dumper;
+
+ my $cal = (caller(1+$caller_offset))[3];
+ my $line = (caller(0+$caller_offset))[2];
+ my $caller_str = "on $cal line $line";
+
+ if ( $caller_str eq $self->{dump_prev_caller_str} ) {
+ print "Dumper used $caller_str:\n";
+ } else {
+ $self->{dump_prev_caller_str} = $caller_str;
+ }
+ print Data::Dumper::Dumper( @_ );
+ return 1;
+}
+
+
+sub dump {
+ my $self = shift;
+ return $self->raw_dump( 0, @_ );
+}
+
+
+sub edump {
+ my $self = shift;
+ $self->raw_dump( 1, @_ );
+
+ print "Exiting, edump used on ";
+ my $cal = (caller 1)[3];
+ my $line = (caller 0)[2];
+ print "$cal line $line.\n";
+ exit;
+}
+
+
+
+1;
View
31 lib/DictAgent/Plugin/SeznamCz.pm
@@ -0,0 +1,31 @@
+package DictAgent::Plugin::SeznamCz;
+
+use utf8;
+use strict;
+use warnings;
+use Carp qw(verbose carp croak);
+
+use base 'DictAgent::PluginBase';
+
+
+sub run {
+ my ( $self, $word ) = @_;
+ my $debug = $self->{debug};
+
+ return undef unless $word;
+
+ my $url_base = 'http://slovnik.seznam.cz/?q=%s&lang=en_cz';
+ my $url = sprintf( $url_base, $word );
+
+ my $cache_fn_suffix = $word;
+ $cache_fn_suffix =~ s{[ \\\/\;\:\}\{\]\[\>\<\= ]}{_}gx;
+ $cache_fn_suffix .= '.html';
+
+ my $tree = $self->get_tree_from_cached_url( $url, $cache_fn_suffix );
+
+ my $content = $tree->look_down('_tag', 'div', 'id', 'content' );
+ return undef unless $content;
+ return $content->as_HTML;
+}
+
+1;
View
155 lib/DictAgent/PluginBase.pm
@@ -0,0 +1,155 @@
+package DictAgent::PluginBase;
+
+use strict;
+use warnings;
+use Carp qw(verbose carp croak);
+use utf8;
+
+use base 'DictAgent';
+
+
+sub new {
+ my $class = shift;
+ my $params = shift;
+
+ my $self = $class->SUPER::new( $params, @_ );
+
+ $self->{web_robot} = $params->{web_robot};
+
+ if ( $params->{web} ) {
+ $self->{web_name} = $params->{web};
+
+ # use lowercassed class name as web_name
+ } else {
+ my ( $web_name ) = $class =~ /([^\:]+)$/;
+ $web_name = lc($web_name);
+ $self->{web_name} = $web_name;
+ }
+
+ $self->{online} = $params->{online};
+ $self->{online} = 1 unless defined $params->{online};
+
+ bless $self, $class;
+
+ $self->initialize();
+
+ return $self;
+}
+
+
+sub plugin_status {
+ return 1;
+}
+
+
+sub initialize {
+ my $self = shift;
+
+ return 1 unless $self->plugin_status();
+ $self->purge_cache() if $self->{online};
+
+ return 1;
+}
+
+
+sub get_tree_from_cached_url {
+ my ( $self, $url, $cache_fn_suffix ) = @_;
+
+ my $page = $self->get_cached( $url, $cache_fn_suffix );
+
+ my $tree = HTML::TreeBuilder->new_from_content( $page );
+ $tree->ignore_ignorable_whitespace(0);
+ $tree->no_space_compacting(1);
+
+ return $tree;
+}
+
+
+sub run {
+ my ( $self, $sel_sport, $sel_region, $sel_liga ) = @_;
+ croak "Plugin should implement this method.";
+}
+
+
+sub normalize_base {
+ my $self = shift;
+ my $str = shift;
+ my $in = $str;
+
+ return '' unless $str;
+
+ $str =~ s{^\s+}{};
+ $str =~ s{\s+$}{};
+
+ #print "'$in' ---> '$str'\n";
+ return $str;
+}
+
+
+# web_robot
+
+sub init_user_agent {
+ my $self = shift;
+ return $self->{web_robot}->init_user_agent( @_ );
+}
+
+
+sub response_get {
+ my $self = shift;
+ return $self->{web_robot}->response_get( $self->{web_name}, @_ );
+}
+
+
+sub get_cached {
+ my $self = shift;
+ return $self->{web_robot}->get_cached( $self->{web_name}, @_ );
+}
+
+
+sub purge_cache {
+ my $self = shift;
+ return $self->{web_robot}->purge_cache( $self->{web_name}, @_ );
+}
+
+
+sub raw_dump {
+ my $self = shift;
+ my $caller_offset = shift;
+
+ require Data::Dumper;
+
+ my $cal = (caller(1+$caller_offset))[3];
+ my $line = (caller(0+$caller_offset))[2];
+ my $caller_str = "on $cal line $line";
+
+ my $print_caller_info_line = 0;
+ unless ( $caller_str eq $self->{dump_prev_caller_str} ) {
+ $self->{dump_prev_caller_str} = $caller_str;
+ # TODO co kdyz se zmeni typ, to pak bude jen prvni info zavadejici
+ $print_caller_info_line = 1;
+ }
+
+ my $is_tree = 0;
+ my $first = $_[0];
+ if ( ref $first eq 'ARRAY' && ref($first->[0]) eq 'HTML::Element' ) {
+ print "Dumping HTML::Element array $caller_str:\n" if $print_caller_info_line;
+ my $num = 0;
+ foreach my $elem ( @$first ) {
+ print "element num: $num\n";
+ $elem->dump;
+ print "\n";
+ $num++;
+ }
+ } elsif ( ref $first eq 'HTML::Element' ) {
+ print "Dumping HTML::Element object $caller_str:\n" if $print_caller_info_line;
+ $first->dump;
+
+ } else {
+ print "Dumping perl structure $caller_str:\n" if $print_caller_info_line;
+ print Data::Dumper::Dumper( @_ );
+ }
+ return 1;
+}
+
+
+1;
View
71 lib/Pamilla.pm
@@ -0,0 +1,71 @@
+package Pamilla;
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime 5.80;
+
+# Set flags and add plugins for the application
+#
+# -Debug: activates the debug mode for very useful log messages
+# ConfigLoader: will load the configuration from a Config::General file in the
+# application's home directory
+# Static::Simple: will serve static files from the application's root
+# directory
+
+use parent qw/Catalyst/;
+use Catalyst qw/
+ -Debug
+ StackTrace
+
+ ConfigLoader
+ Static::Simple
+/;
+our $VERSION = '0.01';
+
+# Configure the application.
+#
+# Note that settings in pamilla.conf (or other external
+# configuration file that you set up manually) take precedence
+# over this when using ConfigLoader. Thus configuration
+# details given here can function as a default configuration,
+# with an external configuration file acting as an override for
+# local deployment.
+
+__PACKAGE__->config(
+ 'name' => 'Pamilla',
+ 'default_view' => 'TT'
+);
+
+# Start the application
+__PACKAGE__->setup();
+
+
+=head1 NAME
+
+Pamilla - Catalyst based application
+
+=head1 SYNOPSIS
+
+ script/pamilla_server.pl
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 SEE ALSO
+
+L<Pamilla::Controller::Root>, L<Catalyst>
+
+=head1 AUTHOR
+
+Catalyst developer
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
View
199 lib/Pamilla/Controller/Dictionary.pm
@@ -0,0 +1,199 @@
+package Pamilla::Controller::Dictionary;
+
+use strict;
+use warnings;
+use Carp qw(carp croak);
+use parent 'Catalyst::Controller';
+
+use FindBin qw($RealBin);
+use JSON;
+use Time::HiRes qw(sleep time);
+
+use WWW::RobotBase;
+use DictAgent;
+
+sub get_dict_html {
+ my ( $self, $c, $word ) = @_;
+
+ my $debug = 1;
+ my $command = 'cache';
+
+ my $plugin_name = 'SeznamCz';
+ my $web = lc( $plugin_name );
+ my $full_plugin_name = 'DictAgent::Plugin::' . $plugin_name;
+
+ unless ( $self->{web_robot_obj} ) {
+ my $temp_dir = $RealBin . '/../../pamilla-data/temp-files/';
+ mkdir $temp_dir unless -d $temp_dir;
+ my $cache_dir = $temp_dir . 'cache/';
+ mkdir $cache_dir unless -d $cache_dir;
+ return undef unless -d $cache_dir;
+
+ my $web_robot_obj = WWW::RobotBase->new( {
+ 'debug' => $debug,
+ 'temp_dir' => $temp_dir,
+ } );
+ $self->{web_robot_obj} = $web_robot_obj;
+
+ eval "require $full_plugin_name" or croak $@ . "\n in plugin $plugin_name.";
+
+ }
+
+ my $online = ( $command eq 'online' );
+ my $plugin_obj = $full_plugin_name->new( {
+ web_robot => $self->{web_robot_obj},
+ online => $online,
+ debug => $debug,
+ } );
+ unless ( $plugin_obj->plugin_status() ) {
+ return undef;
+ }
+
+ my $html = $plugin_obj->run( $word );
+ return $html;
+}
+
+
+
+sub save_new_word {
+ my ( $self, $c, $word, $timestamp, $data_dir ) = @_;
+
+ my $fpath = $data_dir . 'data/dictionary.json';
+
+ my $data = [];
+
+ my $fh;
+ if ( -f $fpath ) {
+ unless ( open($fh,'<:utf8',$fpath) ) {
+ return 0;
+ }
+ my $json = do { local $/; <$fh> };
+ close $fh;
+ $data = from_json( $json );
+ }
+
+ push @$data, [ $word, $timestamp ];
+
+ unless ( open($fh,'>:utf8', $fpath) ) {
+ return 0;
+ }
+
+ my $new_json = to_json( $data );
+ print $fh $new_json;
+ close $fh;
+
+ return 1;
+}
+
+
+
+sub process_text {
+ my ( $self, $c, $data, $text, $timestamp, $data_dir ) = @_;
+
+ my $word = $text;
+
+ # Probably hacking on code.
+ return 1 if $word =~ /\$/;
+
+ $word =~ s{ [\s\.\!\?\,\:\;\"]+$}{}x;
+ $word =~ s{^[\s\.\!\?\,\:\;\"]+ }{}x;
+ $word = lc($word);
+
+ return 1 unless $word;
+ return 1 if length($word) > 25;
+
+ $data->{html} = "word: '$word'<br />\n";
+ $data->{html} .= $self->get_dict_html( $c, $word );
+ $c->log->info( substr( $data->{html}, 0, 100) );
+
+ $self->save_new_word( $c, $word, $timestamp, $data_dir );
+
+ return 1;
+}
+
+
+
+sub index : Path {
+ my ( $self, $c, @arg ) = @_;
+
+ my $start_time = time();
+
+ my $params = $c->request->params;
+
+ my $data = {};
+ $c->stash->{data} = $data;
+
+ my $prev_req_aborted = $params->{prev_req_aborted};
+
+ $data->{html} = '';
+
+ my $data_dir = $RealBin . '/../../pamilla-data/';
+ my $fh;
+
+ my $sl_data;
+ my $sl_fpath = $data_dir . 'web_dictionary.json';
+ if ( open($fh,'<:utf8',$sl_fpath) ) {
+ my $json = do { local $/; <$fh> };
+ #$data->{html} .= $json;
+ close $fh;
+
+ $sl_data = from_json( $json );
+ }
+
+
+ my $clb_fpath = $data_dir . 'clipboard.json';
+
+ # Should be shorter than timeout_time variable in js/ajax.php.
+ while ( time() - $start_time < 10 - 0.25 ) {
+ my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks ) = stat( $clb_fpath );
+
+ my $changed = 0;
+ # File changed.
+ if ( !$sl_data->{mtime} || $sl_data->{mtime} != $mtime || $prev_req_aborted ) {
+ if ( open($fh,'<:utf8',$clb_fpath) ) {
+ my $json = do { local $/; <$fh> };
+ close $fh;
+ my $clb_data = from_json( $json );
+
+ # Data are for as and text changed.
+ if ( $clb_data->{selected} eq 'dictionary' && ( $prev_req_aborted || (not defined $sl_data->{clipboard_text}) || $sl_data->{clipboard_text} ne $clb_data->{clipboard_text}) ) {
+ $changed = 1;
+
+ $self->process_text(
+ $c,
+ $data,
+ $clb_data->{clipboard_text},
+ $clb_data->{timestamp},
+ $data_dir
+ );
+ $sl_data->{clipboard_text} = $clb_data->{clipboard_text};
+ }
+
+ } else {
+ $data->{html} .= 'err:' . $! . " '$clb_fpath'";
+ last;
+ }
+
+ # Save new values. Value of clipboard_text probably set earlier.
+ $sl_data->{mtime} = $mtime;
+ if ( open($fh,'>:utf8', $sl_fpath) ) {
+ my $new_sl_data = to_json( $sl_data );
+ print $fh $new_sl_data;
+ close $fh;
+ }
+
+ last if $changed;
+ }
+ sleep(0.25);
+ }
+
+ if ( $params->{ot} && $params->{ot} eq 'html' ) {
+ use Data::Dumper;
+ $c->stash->{ot} = Dumper( $c->stash->{data} );
+ return;
+ }
+
+ $c->forward('Pamilla::View::JSON');
+}
+
+1;
View
61 lib/Pamilla/Controller/Root.pm
@@ -0,0 +1,61 @@
+package Pamilla::Controller::Root;
+
+use strict;
+use warnings;
+use parent 'Catalyst::Controller';
+
+#
+# Sets the actions in this controller to be registered with no prefix
+# so they function identically to actions created in MyApp.pm
+#
+__PACKAGE__->config->{namespace} = '';
+
+=head1 NAME
+
+Pamilla::Controller::Root - Root Controller for Pamilla
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 METHODS
+
+=cut
+
+=head2 index
+
+=cut
+
+sub index :Path :Args(0) {
+ my ( $self, $c ) = @_;
+
+ #$c->response->body( 'zzzz' );
+ $c->stash->{template} = 'index.tt2';
+}
+
+sub default :Path {
+ my ( $self, $c ) = @_;
+ $c->response->body( 'Page not found' );
+ $c->response->status(404);
+}
+
+=head2 end
+
+Attempt to render a view, if needed.
+
+=cut
+
+sub end : ActionClass('RenderView') {}
+
+=head1 AUTHOR
+
+Catalyst developer
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
View
37 lib/Pamilla/View/JSON.pm
@@ -0,0 +1,37 @@
+package Pamilla::View::JSON;
+
+use base 'Catalyst::View::JSON';
+use strict;
+
+=head1 NAME
+
+Pamilla::View::JSON - TapTinder JSON Site View
+
+=head1 SYNOPSIS
+
+See L<Pamilla>
+
+=head1 DESCRIPTION
+
+Pamilla JSON Site View.
+
+=cut
+
+__PACKAGE__->config({
+ #allow_callback => 1, # defaults to 0
+ #callback_param => 'cb', # defaults to 'callback'
+ expose_stash => [ qw(data ot) ], # defaults to everything
+ #no_x_json_header => 1,
+});
+
+=head1 AUTHOR
+
+Michal Jurosz <mj@mj41.cz>
+
+=head1 LICENSE
+
+This file is part of Pamilla. See L<Pamilla> license.
+
+=cut
+
+1;
View
44 lib/Pamilla/View/TT.pm
@@ -0,0 +1,44 @@
+package Pamilla::View::TT;
+
+use base 'Catalyst::View::TT';
+use strict;
+
+=head1 NAME
+
+Pamilla::View::TT - Pamilla TT (Template Toolkit) Site View
+
+=head1 SYNOPSIS
+
+See L<Pamilla>
+
+=head1 DESCRIPTION
+
+Pamilla TT Site View.
+
+=cut
+
+__PACKAGE__->config({
+ CATALYST_VAR => 'c',
+ INCLUDE_PATH => [
+ Pamilla->path_to( 'root', 'src' ),
+ Pamilla->path_to( 'root', 'lib' )
+ ],
+ PRE_PROCESS => 'config/main',
+ WRAPPER => 'site/wrapper',
+ ERROR => 'error.tt2',
+ TIMER => 0,
+ TEMPLATE_EXTENSION => '.tt2',
+ #COMPILE_DIR => '/tmp/Pamilla/cache',
+});
+
+=head1 AUTHOR
+
+Michal Jurosz <mj@mj41.cz>
+
+=head1 LICENSE
+
+This file is part of Pamilla. See L<Pamilla> license.
+
+=cut
+
+1;
View
218 lib/WWW/RobotBase.pm
@@ -0,0 +1,218 @@
+package WWW::RobotBase;
+
+use strict;
+use warnings;
+use Carp qw(verbose carp croak);
+
+use LWP::UserAgent;
+use HTML::TreeBuilder;
+use HTTP::Request;
+use HTTP::Request::Common;
+use HTTP::Cookies;
+use Encode;
+use Time::HiRes qw(time sleep);
+
+
+sub new {
+ my $class = shift;
+ my $params = shift;
+
+ my $self = {};
+ $self->{debug} = $params->{debug};
+ $self->{last_download_time} = 0;
+ $self->{sleep_time} = $params->{sleep_time} || 1.0;
+ $self->{timeout} = $params->{timeout} || 10*60;
+ $self->{user_agent} = undef;
+ $self->{user_agent_web_name} = '';
+ $self->{temp_dir} = $params->{temp_dir} || './temp/';
+ $self->{cache_dir_base} = $params->{cache_dir_base} || $self->{temp_dir} . 'cache/';
+ $self->{cookies_dir_base} = $params->{cookies_dir_base} || $self->{temp_dir} . 'cookies/';
+
+ bless $self, $class;
+ return $self;
+}
+
+
+sub debug {
+ my $self = shift;
+ if (@_) { $self->{debug} = shift }
+ return $self->{debug};
+}
+
+
+sub dumper {
+ my $self = shift;
+ require Data::Dumper;
+ print Data::Dumper::Dumper( @_ );
+}
+
+sub init_user_agent {
+ my ( $self ) = @_;
+
+ $self->{user_agent} = LWP::UserAgent->new(
+ agent => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; cs; rv:1.9) Gecko/2008052906 Firefox/3.0',
+ keep_alive => 1,
+ timeout => 300
+ );
+ $self->{user_agent}->default_header('Accept-Language' => "en-us;q=0.7,en;q=0.3,cs");
+
+ #Host ent.ro.vutbr.cz
+ #User-Agent Mozilla/5.0 (Windows; U; Windows NT 5.1; cs; rv:1.9) Gecko/2008052906 Firefox/3.0
+ #Accept */*
+ #Accept-Language cs,en-us;q=0.7,en;q=0.3
+ #Accept-Encoding gzip,deflate
+ #Accept-Charset ISO-8859-2,utf-8;q=0.7,*;q=0.7
+ #Keep-Alive 300
+ #Connection keep-alive
+ #Referer https://ent.ro.vutbr.cz/vyvoj/jurosz/studis/student.phtml?sn=individualni_plan_nepov
+ return 1;
+}
+
+
+sub get_web_cache_dir {
+ my ( $self, $web_name ) = @_;
+ return $self->{cache_dir_base} . $web_name . '/';
+}
+
+
+# nutne zavolat vzdy, kdyz se zmeni web
+sub web_change {
+ my ( $self, $web_name ) = @_;
+
+ # pokud uz user agent existuje tak zmenime cookie
+ # slo by pouzit i stejnou, ale kvuli mazani takhle
+ if ( $self->{user_agent} ) {
+ my $cookie_fp = $self->{cookies_dir_base} . $web_name . ".txt";
+ my $cookie_jar = HTTP::Cookies->new(
+ file => $cookie_fp,
+ autosave => 1,
+ hide_cookie2 => 1
+ );
+ $self->{user_agent}->cookie_jar( $cookie_jar );
+ }
+
+ # zmenime cache adresar a pripadne vytvorime
+ $self->{web_cache_fn_base} = $self->get_web_cache_dir( $web_name );
+ mkdir( $self->{web_cache_fn_base} ) unless -d $self->{web_cache_fn_base};
+
+ # smazeme, sice pri stridani dvou webu bude bez pauzy, ale k tomu by dochaze nemelo
+ $self->{last_download_time} = 0;
+
+ $self->{user_agent_web_name} = $web_name;
+}
+
+
+# smaze cookie
+sub clear_cookie {
+ my $self = shift;
+ return $self->{user_agent}->cookie_jar()->clear;
+}
+
+
+sub purge_cache {
+ my ( $self, $web_name ) = @_;
+
+ my $web_cache_dir = $self->get_web_cache_dir( $web_name );
+ return 1 unless -d $web_cache_dir ;
+
+ opendir( my $dir_handle, $web_cache_dir ) or croak "Can't open '$web_cache_dir'.\n$!";
+
+ while ( my $file = readdir($dir_handle) ) {
+ my $file_path = $web_cache_dir . $file;
+ next unless -f $file_path;
+ unlink( $file_path );
+ }
+ return 1;
+}
+
+
+# TODO
+# nastavi referer
+sub set_referer {
+ my ( $self, $referer_url ) = @_;
+ return $self->{user_agent}->default_header( 'Referer', $referer_url );
+}
+
+
+# nutne zavolat vzdy predtim nez pouzijeme user agenta
+sub before_agent_use {
+ my ( $self, $web_name ) = @_;
+
+ # pauza mezi stahovanim
+ if ( $self->{last_download_time} + $self->{sleep_time} > time() ) {
+ my $rand_coeficient = rand(5) / 10;
+ my $sleep_time = $self->{sleep_time} * ( 1 + $rand_coeficient );
+ my $to_sleep = ( $self->{last_download_time} + $self->{sleep_time} ) - time();
+ $to_sleep = 0 if $to_sleep < 0;
+ printf( "Sleeping %3.2f (%2.1f) s ...\n" , $to_sleep, $rand_coeficient );
+ sleep( $to_sleep );
+ }
+ $self->{last_download_time} = time();
+
+ # pokud user agent neexistuje, tak jej vytvorime
+ unless ( defined $self->{user_agent} ) {
+ $self->init_user_agent();
+ # prvni spusteni je vpodstate take zmena webu
+ $self->web_change( $web_name );
+ }
+
+ return 1;
+}
+
+
+# vraci primo response objekt, nepouziva cache
+sub response_get {
+ my ( $self, $web_name, $url ) = @_;
+
+ $self->before_agent_use( $web_name );
+ print "Getting online from url '$url'.\n";
+ my $response = $self->{user_agent}->get( $url );
+ return $response;
+}
+
+
+
+sub get_cached {
+ my ( $self, $web_name, $url, $cache_fn_suffix, $timeout ) = @_;
+ $timeout = $self->{timeout} unless defined $timeout;
+
+ # TODO $timeout, mtime souboru
+
+ $self->web_change( $web_name ) unless $web_name eq $self->{user_agent_web_name};
+ my $cache_fn = $self->{web_cache_fn_base} . $cache_fn_suffix;
+
+ my $page;
+ unless ( -f $cache_fn ) {
+ $self->before_agent_use( $web_name );
+
+ # nefunguje, kvuli decode_content
+ #my $res = $self->{user_agent}->get($url, ':content_file' => $cache_fn) || die $!;
+
+ #print "Getting online from url '$url'.\n";
+ my $res = $self->{user_agent}->get($url);
+ #$res->decoded_content();
+ my $page = $res->content();
+ open( my $out, '>:utf8', $cache_fn ) or croak "Nelze otevrit '$cache_fn' pro zapis.\n$!";
+ binmode( $out );
+ print $out $page;
+ close $page;
+ return decode_utf8 $page;
+
+ # TODO
+ #$page = $res->content;
+ #return $page;
+
+ } else {
+ #print "Loading from cache file '$cache_fn'.\n";
+ }
+
+ local $/ = undef;
+ my $fh;
+ open( $fh, '<:utf8', $cache_fn ) || die $!;
+ binmode( $fh );
+ $page = <$fh>;
+ return decode_utf8 $page;
+}
+
+
+1;
View
1  pamilla.yml
@@ -0,0 +1 @@
+name: Pamilla
View
230 root/css/base.css
@@ -0,0 +1,230 @@
+body {
+ margin: 0.5em;
+ padding: 0;
+ font-family: tahoma, arial, helvetica, geneva, sans-serif;
+ color: #000000;
+ background-color: #f5f5f5;
+ font-size: 90%; /* TODO */
+}
+
+h1 {
+ font-size: 140%;
+ font-weight: bold;
+}
+
+h2 {
+ font-size: 120%;
+ font-weight: bold;
+}
+
+h3 {
+ font-weight: bold;
+}
+
+a:link {
+ text-decoration: none;
+ color: #0000FF;
+}
+
+a:visited {
+ text-decoration: none;
+ color: #0000FF;
+}
+
+a:hover {
+ text-decoration: underline;
+ color: #FF0000;
+}
+
+th {
+ font-weight: bold;
+ color: #000000;
+ background-color: #D3DCE3;
+}
+
+hr {
+ color: #666666;
+ background-color: #666666;
+ border: 0;
+ height: 1px;
+}
+
+form {
+ padding: 0;
+ margin: 0;
+ display: inline;
+}
+
+textarea {
+ overflow: visible;
+ height: 8em;
+}
+
+fieldset {
+ margin-top: 1em;
+ border: #686868 solid 1px;
+ padding: 0.5em;
+ background-color: #E5E5E5;
+}
+
+fieldset fieldset {
+ margin: 0.8em;
+}
+
+fieldset legend {
+ background-color: transparent;
+}
+
+/* buttons in some browsers (eg. Konqueror) are block elements,
+ this breaks design */
+button {
+ display: inline;
+}
+
+table caption,
+table th,
+table td {
+ padding: 0.1em 0.5em 0.1em 0.5em;
+ margin: 0.1em;
+ vertical-align: top;
+}
+
+.red {
+ color: red;
+}
+
+img,
+input,
+select,
+button {
+ vertical-align: middle;
+}
+
+/* even table rows 2,4,6,8,... */
+table tr.even th,
+table tr.even {
+ background-color: #E5E5E5;
+ text-align: left;
+}
+
+/* odd table rows 1,3,5,7,... */
+table tr.odd th,
+table tr.odd {
+ background-color: #D5D5D5;
+ text-align: left;
+}
+
+table tr.even_err th,
+table tr.even_err {
+ background-color: #ffcaba;
+ text-align: left;
+}
+
+table tr.odd_err th,
+table tr.odd_err {
+ background-color: #ffddd3;
+ text-align: left;
+}
+
+/* marked tbale rows */
+table tr.marked th,
+table tr.marked {
+ background-color: #FFCC99;
+}
+
+/* hovered table rows */
+table tr.odd:hover,
+table tr.even:hover,
+table tr.odd:hover th,
+table tr.even:hover th,
+table tr.hover th,
+table tr.hover {
+ background-color: #CCFFCC;
+}
+
+
+table td.ok {
+ color: green;
+}
+
+table td.err {
+ font-family: "Courier New", Courier, monospace;
+ color: red;
+ font-weight: bold;
+}
+
+.tblHeader {
+ background-color: #D0DCE0;
+ font-weight: bold;
+ color: #000000;
+}
+
+table.data {
+ margin: 3px 0;
+}
+
+.error_bar {
+ color: red;
+ font-weight: bold;
+ margin: 10px 0 20px 0;
+}
+
+.pages {
+ margin: 0 1em;
+ padding: 10px 0;
+ font-weight: bold;
+}
+.pages span.text {
+ margin-right: 1em;
+}
+.pages a, .pages span.a, .pages .a-arrow {
+ margin: 2px;
+ padding: 3px 5px;
+ border: 1px solid #5a84ae;
+}
+.pages a.arrow, .pages span.a-arrow {
+ margin: 0 1em;
+ padding: 0px 5px 1px 5px;
+}
+.pages span.a-arrow {
+ color: grey;
+ background-color: #F5F5F5;
+ border-color: grey;
+}
+
+.pages a:hover {
+ color: black;
+ background-color: #d0dce0;
+ border-color: #024082;
+ text-decoration: none;
+}
+.pages .selected {
+ color: white;
+ background-color: #5a84ae;
+}
+
+ul.menu li {
+ margin: 0.5em;
+}
+
+#footer {
+ border-top: 1px solid #d3dce3;
+ border-bottom: 1px solid #d3dce3;
+ margin: 1.5em 0px 1em 0px;
+ padding: 0.3em 1em 0.25em 1em;
+ text-align: right;
+ font-size: 90%;
+}
+
+.nav {
+ margin: 0.8em 0;
+}
+
+.footinfo {
+ margin: 0.5em 0 0.5em 0;
+}
+
+h1.table, h2.table, h3.table {
+ margin: 0;
+ padding: 0;
+}
View
96 root/js/ajax.js
@@ -0,0 +1,96 @@
+var gl_url_www = 'http://localhost:8080';
+var timeout_time = 15;
+var timeoutId;
+var prev_req_aborted = 0;
+
+function callInProgress( req ) {
+ switch ( req.readyState ) {
+ case 1, 2, 3:
+ return true;
+ break;
+
+ // case 4 and 0
+ default:
+ return false;
+ break;
+ }
+}
+
+
+function gen_request(handler,method,url,content) {
+ var req = null;
+ if ( window.XMLHttpRequest ) {
+ req = new XMLHttpRequest();
+ } else if (window.ActiveXObject) {
+ req = new ActiveXObject("Microsoft.XMLHTTP");
+ }
+ if (req == null) return false;
+
+ req.onreadystatechange = function() {
+ handler(req);
+ }
+ timeoutId = window.setTimeout(
+ function() {
+ if ( !callInProgress(req) ) {
+ req.abort();
+ prev_req_aborted = 1;
+ dictionary_request();
+ }
+
+ },
+ timeout_time * 1000
+ );
+
+ req.open("GET",url,true);
+ req.send(content);
+ return true;
+}
+
+
+
+function handle_dictionary(req) {
+ if ( req.readyState==4 && req.status==200 ) {
+ var response_data;
+ if ( req.responseText == '' ) return false;
+ try {
+ eval( 'response_data='+req.responseText+';' );
+ } catch(e){
+ return false;
+ }
+ if ( response_data['data']['html'] ) {
+ document.getElementById('dictionary_div').innerHTML = response_data['data']['html'];
+ }
+
+ window.clearTimeout(timeoutId);
+ dictionary_request();
+
+ return true;
+ }
+ return false;
+}
+
+
+function dictionary_request() {
+ url = gl_url_www+'/dictionary';
+ if ( prev_req_aborted ) {
+ url += '?prev_req_aborted=1';
+ prev_req_aborted = 0;
+ }
+ if ( !gen_request(handle_dictionary, 'GET', url, null )) {
+ dictionary_settimeout(1);
+ prev_req_aborted = 1;
+ return false;
+ }
+ return true;
+}
+
+
+function dictionary_settimeout(secs) {
+ window.setTimeout("dictionary_request("+secs+")", secs*1000);
+}
+
+
+function dictionary_start(secs) {
+ document.getElementById('dictionary_div').innerHTML = "no data ...";
+ dictionary_request();
+}
View
20 root/lib/config/main
@@ -0,0 +1,20 @@
+[% # config/main
+ #
+ # This is the main configuration template which is processed before
+ # any other page, by virtue of it being defined as a PRE_PROCESS
+ # template. This is the place to define any extra template variables,
+ # macros, load plugins, and perform any other template setup.
+
+ IF c.debug;
+ # define a debug() macro directed to Catalyst's log
+ MACRO debug(message) CALL c.log.debug(message);
+ END;
+
+ # load up any other configuration items
+ PROCESS config/url;
+
+ # set defaults for variables, etc.
+ DEFAULT
+ message = 'There is no message';
+
+-%]
View
25 root/lib/site/html
@@ -0,0 +1,25 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en" dir="ltr">
+<head>
+ <meta http-equiv="Content-Type" content="text/html; charset=iso8859-1" />
+ <title>[% IF title %][% title %] - [% END %][% IF title != site.title %][% site.title %][% END %]</title>
+ <link rel="shortcut icon" href="[%+ site.r_url.base %]favicon.ico" />
+ <link rel="stylesheet" type="text/css" href="[%+ site.r_url.base %]css/base.css" />
+ <script type="text/javascript" src="js/ajax.js"></script>
+</head>
+<body>
+<h1 class="title">[% title or site.title %]</h1>
+[% IF error %]
+<div class="error_bar">
+<ul>
+<li><div class=error>[% error %]</div></li>
+</ul>
+</div>
+[% END -%]
+[% content %]
+[% IF c.debug && ot # TODO %]
+<pre>[% ot | html %]</pre>
+[% END %]
+[% site.before_body_end %]
+</body>
+</html>
View
8 root/lib/site/wrapper
@@ -0,0 +1,8 @@
+[% IF template.name.match('\.(css|js|txt)');
+ debug("Passing page through as text: $template.name");
+ content;
+ ELSE;
+ debug("Applying HTML page layout wrappers to $template.name\n");
+ content WRAPPER site/html;
+ END;
+-%]
View
1  root/src/dictionary/index.tt2
@@ -0,0 +1 @@
+refresh: [% data %]
View
14 root/src/error.tt2
@@ -0,0 +1,14 @@
+[% META title = 'Pamilla Catalyst/TT Error' %]
+<p>
+ An error has occurred. We're terribly sorry about that, but it's
+ one of those things that happens from time to time. Let's just
+ hope the developers test everything properly before release...
+</p>
+<p>
+ Here's the error message, on the off-chance that it means something
+ to you: <span class="error">[% error %]</span>
+</p>
+<p>
+ Try to send useful report to <a href="mailto:pamilla-bug@mj41.cz">pamilla-bug@mj41.cz</a>
+ or patch to <a href="mailto:patch-bug@mj41.cz">patch-bug@mj41.cz</a> . Thank you.
+</p>
View
7 root/src/index.tt2
@@ -0,0 +1,7 @@
+---
+<div id="dictionary_div">
+</div>
+---
+
+<script type="text/javascript">dictionary_start(0);</script>
+
View
37 script/pamilla_cgi.pl
@@ -0,0 +1,37 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
+
+use strict;
+use warnings;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Pamilla;
+
+Pamilla->run;
+
+1;
+
+=head1 NAME
+
+pamilla_cgi.pl - Catalyst CGI
+
+=head1 SYNOPSIS
+
+See L<Catalyst::Manual>
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as a cgi script.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
View
85 script/pamilla_create.pl
@@ -0,0 +1,85 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+eval "use Catalyst::Helper;";
+
+if ($@) {
+ die <<END;
+To use the Catalyst development tools including catalyst.pl and the
+generated script/myapp_create.pl you need Catalyst::Helper, which is
+part of the Catalyst-Devel distribution. Please install this via a
+vendor package or by running one of -
+
+ perl -MCPAN -e 'install Catalyst::Devel'
+ perl -MCPANPLUS -e 'install Catalyst::Devel'
+END
+}
+
+my $force = 0;
+my $mech = 0;
+my $help = 0;
+
+GetOptions(
+ 'nonew|force' => \$force,
+ 'mech|mechanize' => \$mech,
+ 'help|?' => \$help
+ );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } );
+
+pod2usage(1) unless $helper->mk_component( 'Pamilla', @ARGV );
+
+1;
+
+=head1 NAME
+
+pamilla_create.pl - Create a new Catalyst Component
+
+=head1 SYNOPSIS
+
+pamilla_create.pl [options] model|view|controller name [helper] [options]
+
+ Options:
+ -force don't create a .new file where a file to be created exists
+ -mechanize use Test::WWW::Mechanize::Catalyst for tests if available
+ -help display this help and exits
+
+ Examples:
+ pamilla_create.pl controller My::Controller
+ pamilla_create.pl -mechanize controller My::Controller
+ pamilla_create.pl view My::View
+ pamilla_create.pl view MyView TT
+ pamilla_create.pl view TT TT
+ pamilla_create.pl model My::Model
+ pamilla_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
+ dbi:SQLite:/tmp/my.db
+ pamilla_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
+ dbi:Pg:dbname=foo root 4321
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Create a new Catalyst Component.
+
+Existing component files are not overwritten. If any of the component files
+to be created already exist the file will be written with a '.new' suffix.
+This behavior can be suppressed with the C<-force> option.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
View
79 script/pamilla_fastcgi.pl
@@ -0,0 +1,79 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+
+BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Pamilla;
+
+my $help = 0;
+my ( $listen, $nproc, $pidfile, $manager, $detach, $keep_stderr );
+
+GetOptions(
+ 'help|?' => \$help,
+ 'listen|l=s' => \$listen,
+ 'nproc|n=i' => \$nproc,
+ 'pidfile|p=s' => \$pidfile,
+ 'manager|M=s' => \$manager,
+ 'daemon|d' => \$detach,
+ 'keeperr|e' => \$keep_stderr,
+);
+
+pod2usage(1) if $help;
+
+Pamilla->run(
+ $listen,
+ { nproc => $nproc,
+ pidfile => $pidfile,
+ manager => $manager,
+ detach => $detach,
+ keep_stderr => $keep_stderr,
+ }
+);
+
+1;
+
+=head1 NAME
+
+pamilla_fastcgi.pl - Catalyst FastCGI
+
+=head1 SYNOPSIS
+
+pamilla_fastcgi.pl [options]
+
+ Options:
+ -? -help display this help and exits
+ -l -listen Socket path to listen on
+ (defaults to standard input)
+ can be HOST:PORT, :PORT or a
+ filesystem path
+ -n -nproc specify number of processes to keep
+ to serve requests (defaults to 1,
+ requires -listen)
+ -p -pidfile specify filename for pid file
+ (requires -listen)
+ -d -daemon daemonize (requires -listen)
+ -M -manager specify alternate process manager
+ (FCGI::ProcManager sub-class)
+ or empty string to disable
+ -e -keeperr send error messages to STDOUT, not
+ to the webserver
+
+=head1 DESCRIPTION
+
+Run a Catalyst application as fastcgi.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
View
160 script/pamilla_server.pl
@@ -0,0 +1,160 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+
+BEGIN {
+ $ENV{CATALYST_ENGINE} ||= 'HTTP';
+ $ENV{CATALYST_SCRIPT_GEN} = 39;
+ require Catalyst::Engine::HTTP;
+}
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+my $debug = 0;
+my $fork = 0;
+my $help = 0;
+my $host = 'localhost';
+my $port = $ENV{PAMILLA_PORT} || $ENV{CATALYST_PORT} || 8080;
+my $keepalive = 0;
+my $restart = $ENV{PAMILLA_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
+my $background = 0;
+my $pidfile = undef;
+
+my $check_interval;
+my $file_regex;
+my $watch_directory;
+my $follow_symlinks;
+
+my @argv = @ARGV;
+
+GetOptions(
+ 'debug|d' => \$debug,
+ 'fork|f' => \$fork,
+ 'help|?' => \$help,
+ 'host=s' => \$host,
+ 'port|p=s' => \$port,
+ 'keepalive|k' => \$keepalive,
+ 'restart|r' => \$restart,
+ 'restartdelay|rd=s' => \$check_interval,
+ 'restartregex|rr=s' => \$file_regex,
+ 'restartdirectory=s@' => \$watch_directory,
+ 'followsymlinks' => \$follow_symlinks,
+ 'background' => \$background,
+ 'pidfile=s' => \$pidfile,
+);
+
+pod2usage(1) if $help;
+
+if ( $debug ) {
+ $ENV{CATALYST_DEBUG} = 1;
+}
+
+# If we load this here, then in the case of a restarter, it does not
+# need to be reloaded for each restart.
+require Catalyst;
+
+# If this isn't done, then the Catalyst::Devel tests for the restarter
+# fail.
+$| = 1 if $ENV{HARNESS_ACTIVE};
+
+my $runner = sub {
+ # This is require instead of use so that the above environment
+ # variables can be set at runtime.
+ require Pamilla;
+
+ Pamilla->run(
+ $port, $host,
+ {
+ argv => \@argv,
+ 'fork' => $fork,
+ keepalive => $keepalive,
+ background => $background,
+ pidfile => $pidfile,
+ }
+ );
+};
+
+if ( $restart ) {
+ die "Cannot run in the background and also watch for changed files.\n"
+ if $background;
+
+ require Catalyst::Restarter;
+
+ my $subclass = Catalyst::Restarter->pick_subclass;
+
+ my %args;
+ $args{follow_symlinks} = 1
+ if $follow_symlinks;
+ $args{directories} = $watch_directory
+ if defined $watch_directory;
+ $args{sleep_interval} = $check_interval
+ if defined $check_interval;
+ $args{filter} = qr/$file_regex/
+ if defined $file_regex;
+
+ my $restarter = $subclass->new(
+ %args,
+ start_sub => $runner,
+ argv => \@argv,
+ );
+
+ $restarter->run_and_watch;
+}
+else {
+ $runner->();
+}
+
+1;
+
+=head1 NAME
+
+pamilla_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+pamilla_server.pl [options]
+
+ Options:
+ -d -debug force debug mode
+ -f -fork handle each request in a new process
+ (defaults to false)
+ -? -help display this help and exits
+ -host host (defaults to all)
+ -p -port port (defaults to 3000)
+ -k -keepalive enable keep-alive connections
+ -r -restart restart when files get modified
+ (defaults to false)
+ -rd -restartdelay delay between file checks
+ (ignored if you have Linux::Inotify2 installed)
+ -rr -restartregex regex match files that trigger
+ a restart when modified
+ (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
+ -restartdirectory the directory to search for
+ modified files, can be set mulitple times
+ (defaults to '[SCRIPT_DIR]/..')
+ -follow_symlinks follow symlinks in search directories
+ (defaults to false. this is a no-op on Win32)
+ -background run the process in the background
+ -pidfile specify filename for pid file
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst Testserver for this application.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
View
53 script/pamilla_test.pl
@@ -0,0 +1,53 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Catalyst::Test 'Pamilla';
+
+my $help = 0;
+
+GetOptions( 'help|?' => \$help );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+print request($ARGV[0])->content . "\n";
+
+1;
+
+=head1 NAME
+
+pamilla_test.pl - Catalyst Test
+
+=head1 SYNOPSIS
+
+pamilla_test.pl [options] uri
+
+ Options:
+ -help display this help and exits
+
+ Examples:
+ pamilla_test.pl http://localhost/some_action
+ pamilla_test.pl /some_action
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst action from the command line.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
View
8 t/01app.t
@@ -0,0 +1,8 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+BEGIN { use_ok 'Catalyst::Test', 'Pamilla' }
+
+ok( request('/')->is_success, 'Request should succeed' );
View
10 t/02pod.t
@@ -0,0 +1,10 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => 'Test::Pod 1.14 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_files_ok();
View
10 t/03podcoverage.t
@@ -0,0 +1,10 @@
+#!C:\strawberry\perl\bin\perl.exe -w
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
+
+all_pod_coverage_ok();
Please sign in to comment.
Something went wrong with that request. Please try again.