Acme-CPANModulesBundle-Import-PerlDancerAdvent-2018

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

                            Preamble

  The license agreements of most software companies try to keep users
at the mercy of those companies.  By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users.  The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.

  When we speak of free software, we are referring to freedom, not
price.  Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.

  To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.

LICENSE  view on Meta::CPAN

Program or a portion of it, either verbatim or with modifications.  Each
licensee is addressed as "you".

  1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program.  You may charge a fee for the physical act of
transferring a copy.

  2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:

    a) cause the modified files to carry prominent notices stating that
    you changed the files and the date of any change; and

    b) cause the whole of any work that you distribute or publish, that
    in whole or in part contains the Program or any part thereof, either

LICENSE  view on Meta::CPAN


    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

    d) You may charge a fee for the physical act of transferring a
    copy, and you may at your option offer warranty protection in
    exchange for a fee.

Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.

  3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:

LICENSE  view on Meta::CPAN

    years, to give any third party free (except for a nominal charge
    for the cost of distribution) a complete machine-readable copy of the
    corresponding source code, to be distributed under the terms of
    Paragraphs 1 and 2 above; or,

    c) accompany it with the information you received as to where the
    corresponding source code may be obtained.  (This alternative is
    allowed only for noncommercial distribution and only if you
    received the program in object code or executable form alone.)

Source code for a work means the preferred form of the work for making
modifications to it.  For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.

  4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer

devdata/http_advent.perldancer.org_2018_16  view on Meta::CPAN

    return 0;
}

sub get_invalid_queues( $self, @queues ) {
    my %queue_map;
    @queue_map{ @QUEUE_TYPES } = (); 
    my @invalid_queues = grep !exists $queue_map{ $_ }, @queues;
    return @invalid_queues;
}</pre>

<p>With that in place, it was easy for our <code>queue_job()</code> method to throw an error if the developer tried to add a job to an invalid queue:</p>
<pre class="prettyprint">sub queue_job( $self, $args ) {
    my $job_name = $args-&gt;{ name     } or die "queue_job(): must define job name!";
    my $guid     = $args-&gt;{ guid     } or die "queue_job(): must have GUID to process!";
    my $title    = $args-&gt;{ title    } // $job_name;
    my $queue    = $args-&gt;{ queue    } // 'default';
    my $job_args = $args-&gt;{ job_args };

    die "queue_job(): Invalid job queue '$queue' specified" 
        if $self-&gt;has_invalid_queues( $queue );

devdata/http_advent.perldancer.org_2018_16  view on Meta::CPAN

<p>In our base model class (Moose-based), we would create an attribute for our job runner:</p>
<pre class="prettyprint">has 'job_runner' =&gt; (
    is      =&gt; 'ro',
    isa     =&gt; 'MyJob::JobQueue',
    lazy    =&gt; 1,
    default =&gt; sub( $self ) { return MyJob::JobQueue-&gt;new-&gt;runner; },
);</pre>

<p>And in the models themselves, creating a new queueable task was as easy as:</p>
<pre class="prettyprint">$self-&gt;runner-&gt;add_task( InstantXML =&gt; 
    sub( $job, $request_path, $guid, $company_db, $force, $die_on_error = 0 ) {
        $job-&gt;note( 
            request_path =&gt; $request_path,
            feed_id      =&gt; 2098,
            group        =&gt; $company_db,
        );
        MyJob::Models::FooBar-&gt;new( request_path =&gt; 
          $request_path )-&gt;generate_xml({
            pdf_guid     =&gt; $guid,
            group        =&gt; $company_db,
            force        =&gt; $force,
            die_on_error =&gt; $die_on_error,
        });
});</pre>

<h2><a name="running_jobs"></a>Running Jobs</h2>

<p>Starting a job from Dancer was super easy:</p>
<pre class="prettyprint">use Dancer2;
use MyJob::JobQueue;

sub job_queue {

devdata/http_advent.perldancer.org_2018_16  view on Meta::CPAN

    my $notes = $job-&gt;info-&gt;{ notes };
    my $title = $notes-&gt;{ title };
    my $guid  = $notes-&gt;{ guid };

    $job-&gt;on( spawn =&gt; sub( $job, $pid ) {  
        $0 = "$title $guid";
        $logger-&gt;info( 
            "$title: Created child process $pid for job $id by parent $$ - $guid");
    });
        
    $job-&gt;on( failed =&gt; sub( $job, $error ) {
        chomp $error;
        $logger-&gt;error( $error );
    });
});</pre>

<p>To help us for future capacity planning, we want our workers to tell us if they are running at peak capacity, so log when this event occurs:</p>
<pre class="prettyprint">$worker-&gt;on( busy =&gt; sub( $worker ) {
    my $max = $worker-&gt;status-&gt;{ jobs };
    $logger-&gt;log( "$0: Running at capacity (performing $max jobs)." );
});</pre>

<p>Now, we apply the configuration (read below) to the worker. When the worker starts, it tells us information about how it was configured (this was really useful during development):</p>

devdata/http_advent.perldancer.org_2018_18  view on Meta::CPAN

sub opt_desc {
    return (
        [ 'directory|d', 'Application directory' ],
        # More options...
    );
}

sub validate_args {
    my ( $self, $opt, $args ) = @_;
    $opts-&gt;{'directory'}
        or $self-&gt;usage_error('You did not provide a directory');

    path( $opt-&gt;{'directory'} )-&gt;is_dir
        or $self-&gt;usage_error('Path provided is not a directory');
}

sub execute {
    my ( $self, $opt, $args ) = @_;
    my $dir = $opts-&gt;{'directory'};
    # Implement the application activation
    # (Whatever that means...)
}

1;</pre>

devdata/http_advent.perldancer.org_2018_18  view on Meta::CPAN

sub execute {
  my ( $self, $opt, $args ) = @_;

  # Do whatever you want in this area, before we generate

  # For example, let's make sure the application
  # matches a certain naming convention

  my $app_name = $opt-&gt;{'application'};
  $app_name =~ /^My::Company::App::/
    or $self-&gt;usage_error('App must be prefixed by "My::Company::App");

  # Maybe check we are only scaffolding in a particular directory
  cwd() eq '/opt/my_company/webapps/'
      or $self-&gt;usage_error('Only create apps in our webapps directory');

  # At this point, we can run the original scaffolding
  $self-&gt;SUPER::execute( $opt, $args );

  # Now we finished generating, but we can contineu customizing what we have
}

1;</pre>

<p>Writing your own generation on top of the existing generation allows

devdata/http_advent.perldancer.org_2018_19  view on Meta::CPAN

<p>The first one defines our root application logger. The first parameter after the equals sign says
what is the minimum level we should log. Since we are saying the minimum log level should be <code>DEBUG</code>,
any messages from Dancer2 itself, and anything logged at the <code>core</code> level will be ignored.</p>
<p>After the minimum log level is a comma-separated list of appenders to write to. For now, we will create a
single appender named <code>LOG1</code> (we will see how to add a second appender below).  This will write
to a file in the <i>logs/</i> directory named <i>mylog.log</i>, using the <a href="https://metacpan.org/pod/Log::Log4perl::Appender::File">Log::Log4perl::Appender::File</a>
appender. When the app is started, it will append to an existing log file of that name (or create the file
if necessary), and will write to it with a format specified by <a href="https://metacpan.org/pod/Log::Log4perl::Layout::PatternLayout">Log::Log4perl::Layout::PatternLayout</a>.</p>
<p>Each appender can have its own configuration directives. Please consult the pod for each appender for a list
of its configuration parameters.</p>
<p>Next, we have to tell our application that we are using <code>Dancer2::Logger::Log4perl</code> as our preferred logger.
Edit your <i>environments/development.yml</i> file, and comment out the <code>logger: "console"</code> line. Replace it
with the following:</p>
<pre class="prettyprint">logger: log4perl
log: core
engines:
   logger:
      log4perl:
         config_file: log4perl.conf</pre>

<p>This tells Dancer2 to use <code>Dancer2::Logger::Log4perl</code> as its logging engine, and to send all levels of message to

devdata/http_advent.perldancer.org_2018_19  view on Meta::CPAN

};</pre>

<p>Start your application and visit <code>http://localhost:5000/</code>. You will see the following in your <i>logs/mylog.log</i> file:</p>
<pre class="prettyprint">2018/12/18 21:36:02 DEBUG I'M IN UR INDEX</pre>

<h2><a name="hey__i_can_t_see_my_log_messages_on_the_screen_"></a>Hey, I can't see my log messages on the screen!</h2>

<p>That's because we didn't add a screen appender! With Log4perl, adding another appender is easy. Let's
add another section to our <i>log4perl.conf</i> file:</p>
<pre class="prettyprint">log4perl.appender.SCREEN         = Log::Log4perl::Appender::Screen
log4perl.appender.SCREEN.stderr  = 0
log4perl.appender.SCREEN.layout  = Log::Log4perl::Layout::PatternLayout
log4perl.appender.SCREEN.layout.ConversionPattern = %m %n</pre>

<p>This creates another appender named <code>SCREEN</code>. We then need to tell our root logger to use this appender
as well:</p>
<pre class="prettyprint">log4perl.rootLogger = DEBUG, LOG1, SCREEN</pre>

<p>Now, restart your application, and visit a route that has logging installed, and you will see your log
message not only goes to the <i>logs/mylog.log</i> file, but also displays on the console running your
application. Easy!</p>

devdata/http_advent.perldancer.org_2018_19  view on Meta::CPAN

the logging configuration you think you are using. The default configuration file for the development
environment, for example, logs only to the console. If you put your Log4perl configuration in <i>config.yml</i>
and don't change your development configuration file, your Log4perl configuration will be passed over
for the default console logger.</p>
<p>From my own experience, <b>always</b> configure your logger in your environment-specific configuration, unless
you use the same configuration across all environments (I don't endorse this practice).</p>
</li>
<li><a name="item_Core_level_messages_are_passed_as_log_level_trace__but_will_not_be_passed_unless_Dancer2_s_log_level_is_core_"></a><b>Core level messages are passed as log level trace, but will not be passed unless Dancer2's log level is core.</b>
<p>Since <code>core</code> doesn't have a good corresponding level in Log4perl, <code>core</code> level messages are sent 
over to Log4perl at the <code>trace</code> log level. This <b>only</b> happens when you set Dancer2's log level in your
<i>config.yml</i> file to <code>core</code> however. So your preferred log level setting is respected, even if <code>core</code> level 
messages have to be reported at a different level.</p>
</li>
<li><a name="item__code_log__code__should_be_set_a_lower_priority_than_the_lowest_priority_as_set_in_your_Log4perl_configuration_"></a><b><code>log</code> should be set a lower priority than the lowest priority as set in your Log4perl configuration.<...
<p>If it isn't, the log messages will not be passed to Log4perl.</p>
</li>
</ul>
<h2><a name="conclusion"></a>Conclusion</h2>

<p>If Log4perl is all the logging you need in your Dancer2 applications, then <code>Dancer2::Logger::Log4perl</code> is well worth
a look. It gives you much of the functionality available to Log4perl while using the logging syntax built into Dancer2.

devdata/http_advent.perldancer.org_2018_21  view on Meta::CPAN

    my $message = body_parameters-&gt;get( 'message' );

    # Now, your code to do something with the form info:
    # - Put it in a database
    # - email it
    # - etc. etc.
};</pre>

<p>We look to see if either of the spam-catching form fields is populated. If either one of them is populated,
we educate the bot in <a href="https://en.wikipedia.org/wiki/Three_Laws_of_Robotics">Asimov's Three Laws of Robotics</a>. 
If not, we are reasonably certain we are dealing with a human, and we continue on our merry way.</p>
<h2><a name="front_end_magic"></a>Front-end magic</h2>

<p>The front end is where things get a little more interesting (note: I have deliberately omitted any styling for
the sake of brevity):</p>
<pre class="prettyprint">&lt;form method="post" action="/contact" id="contact"&gt;
    &lt;label for="name"&gt;Name&lt;/label&gt;
    &lt;input type="text" name="name" id="name" placeholder="First and last name"&gt;

    &lt;label for="email"&gt;Email Address&lt;/label&gt;
    &lt;input type="text" name="email" id="email" placeholder="someone@example.com"&gt;

devdata/http_advent.perldancer.org_2018_22  view on Meta::CPAN

<p>Way back then, we used to write code to check all of our arguments.</p>
<p>If we had a route that includes some ID, we would check that we
received it and that it matches the type we want. We would then decide
what to do if it doesn't match. Over time, we would clean up and
refactor, and try to reuse the checking code.</p>
<p>For example:</p>
<pre class="prettyprint">use Dancer2;
get '/:id' =&gt; sub {
    my $id = route_parameters-&gt;{'id'};
    if ( $id !~ /^[0-9]+$/ ) {
        send_error 'Bad ID' =&gt; 400;
    }

    # optional
    my $action = query_parameters-&gt;{'action'};
    unless ( defined $action &amp;&amp; length $action ) {
        send_error 'Bad Action' =&gt; 400;
    }

    # use $id and maybe $action
};</pre>

<p>The more parameters we have, the more annoying it is to write these
tests.</p>
<p>But what's more revealing here is that this validation code is not
actually part of our web code. It's input validation <i>for</i> our web
code.</p>

devdata/http_advent.perldancer.org_2018_22  view on Meta::CPAN

    'optional' =&gt; [ 'body', 'sid', 'SHA1' ],
] =&gt; sub {...};</pre>

<p>In this form, the parameter <code>format</code> can be provided either in the
query string or in the body, because your route might be either a
<b>GET</b> or a <b>POST</b>.</p>
<h3><a name="register_type_actions"></a>Register type actions</h3>

<p>Type checking itself is the main role of this plugin, but you can also
control how it behaves.</p>
<p>The default action to perform when a type check fails is to error out,
but you can decide to act differently by registering a different
action.</p>
<pre class="prettyprint">register_type_action 'SoftError' =&gt; sub {
    my ( $self, $details ) = @_;

    warning "Parameter $details-&gt;{'name'} from $details-&gt;{'source'} "
          . "failed checking for type $details-&gt;{'type'}, called "
          . "action $details-&gt;{'action'}";

    return;

devdata/http_advent.perldancer.org_2018_23  view on Meta::CPAN

<pre class="prettyprint"># config.yml (these are the defaults)
engines:
  logger:
    Console::Colored:
      colored_origin: "cyan"
      colored_levels:
        core: "bold bright_white"
        debug: "bold bright_blue"
        info: "bold green"
        warning: "bold yellow"
        error: "bold yellow on_red"
      colored_messages:
        core: "bold bright_white"
        debug: "bold bright_blue"
        info: "bold green"
        warning: "bold yellow"
        error: "bold yellow on_red"</pre>

<img src="/images/2018/23/log-1.png">

<p>The <code>colored_origin</code> refers to the part of the message that shows the package that this
message originated in, as well as the file name and line.</p>
<pre class="prettyprint">&gt;&gt; Dancer2 v0.207000 server 28764 listening on http://0.0.0.0:3000
[main:28764] debug @2018-12-19 20:31:06&gt; Hello World in test.pl l. 6
 ^^^^                                                   ^^^^^^^    ^</pre>

<p>The <code>colored_levels</code> are the log levels themselves.</p>

t/00-compile.t  view on Meta::CPAN

use File::Spec;
use IPC::Open3;
use IO::Handle;

open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";

my @warnings;
for my $lib (@module_files)
{
    # see L<perlfaq8/How can I capture STDERR from an external command?>
    my $stderr = IO::Handle->new;

    diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} }
            $^X, @switches, '-e', "require q[$lib]"))
        if $ENV{PERL_COMPILE_TEST_DEBUG};

    my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]");
    binmode $stderr, ':crlf' if $^O eq 'MSWin32';
    my @_warnings = <$stderr>;
    waitpid($pid, 0);
    is($?, 0, "$lib loaded ok");

    shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/
        and not eval { +require blib; blib->VERSION('1.01') };

    if (@_warnings)
    {
        warn @_warnings;
        push @warnings, @_warnings;



( run in 1.516 second using v1.01-cache-2.11-cpan-49f99fa48dc )