Even though I haven't programmed in C for a long time, I could get Perl2 compiled and running (a 387k binary!) in just a couple hours this afternoon on Cygwin.

.Can I throw out the in-house malloc and other hand-rolled memory management code? What else can I do away with? How about all of the variant hardware #defines Larry had to make? Can't I simplify the code by aiming for one modern OS (Linux?) and Dockerizing it? And how about all that K&R C? Boy does that take me back... Can I shrink the binary by modernizing the code?

$ perl2 -v
This is perl 2, subversion 1 (v2.0.1)

Copyright 1987-2019, Larry Wall

Perl may be copied only under the terms of either the Artistic License
or the GNU GPL (https://www.gnu.org/licenses/gpl.html).

Documentation for Perl should be found on this system via "man perl".
Point your browser at http://www.perl.org/, the Perl Home Page.

Patch level: 0
[download]

I needed GCC, make, and byacc (softlinked to 'yacc'). Then, I had to make a few edits:

1. stab.c: commented out extern errno and replaced it with: int errno;

2. perl.h: commented out the #ifdef that declared sprintf().

3. perl.h: commented out the declaration of times().

4. perly.c: I changed the -v message to look more Perl-like.

I might have made two earlier edits, but they were along the same lines of removing conflicting or redundant declarations.

And now, as a reward, I've got perl 2 running on Cygwin on my laptop! I have to say, it was worth the effort!

Onward to hack!

-rwxrwxr-x+ 1 rje None 387058 Mar 26 17:52 perl2.exe
[download]

Try to find a number that takes more than eleven steps.

use v5.10;
use strict;
use warnings;
use List::Util qw(product);

sub per {
    my ($n) = @_;
    return if $n < 10;
    my $p = product split //, $n;
    return $p, per($p);
}

my @steps = per 277777788888899;
my $steps = @steps;

say "$steps steps";
say for @steps;
[download]

Feel free to localize it using the constants at the beginning. Adding the floating point left as an exercise for the reader.

It's been a practice for me, too, because of Function::Parameters.

IPC::Msg as a fork safe queue. Couple caveats that make it less cool, the by-default maximum queue size seems to be very small. Configurable though by changing /proc/sys/kernel/msgmnb which is the max size in bytes of an individual queue up to 2^31 - 1 on my system at least. Check with  ipcs -l . You also have to delete the queue when finished. Or not if you want to use it later. You can also find the same queue in different scripts with ftok, not shown. You can also see queue sizes / number of messages with ipcs command, add flags to pull off different messages from the queue. You don't always have to do FIFO, you can add different kinds of messages to the same queue, and you can block or not block if you want to have multiple queues being worked at the same time.

For complex data structures you would need to serialize or pack / unpack which other cpan modules may already address and better. Message queues are already documented in perlipc, but a little sugar show show versatile it can be. Basically add or remove from the queue with any child process not worrying about blocking / synchronization issues, but you can accidentally destroy the queue before it is empty, or leave an empty or not-empty queue hanging around that you would have to delete with icprm command.

#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
use IPC::SysV qw/IPC_PRIVATE S_IRUSR S_IWUSR IPC_NOWAIT/;
use IPC::Msg;
$|++;

use constant MSG_BYTES => 1024;

my $q = IPC::Msg->new(IPC_PRIVATE,S_IRUSR|S_IWUSR);

sub quit { $q->remove; }
$SIG{INT} = \&quit;

sub enqueue {
    my $msg = shift;
    my $msg_type = shift // 1; # Used for message selection, see msgsn
+d(2)
    $q->snd($msg_type,$msg,IPC_NOWAIT) || die $!;
}

sub dequeue {
    my $type = shift // 1; # See msgop(2)
    my $msg;
    $q->rcv($msg,MSG_BYTES,$type,IPC_NOWAIT);
    #if ($!) { warn "$$ - $!" }
    return $msg // undef;
}

sub dequeue_block {
    my $msg;
    my $type = shift // 1; # See msgop(2)
    $q->rcv($msg,MSG_BYTES,$type);
    #if ($!) { warn "$$ - $!" }
    return $msg // undef;
}

sub isEmpty {
    my $stat = $q->stat;
    return $stat->qnum == 0;
}

sub isPrime {
    my $num = shift;
    return 1 if ($num < 4);
    return 0 if ($num %2 == 0);
    for (my $i=3; $i <= sqrt($num); $i+=2) {
        return 0 if $num % $i == 0;
    }
    return 1;
}

my $n_workers = shift // die ;

enqueue($_) for (1..2_000_000);

my $parent = $$;

for (my $i=1; $i<$n_workers && $$ == $parent; $i++) {
    fork // die;
}

while (my $data = dequeue()) {
    if (isPrime($data)) {
        print "Prime: $data\n";
    }
}

END {
    if ($$ == $parent) {
       1 until wait == -1;
       quit;
    }
}
[download]

• Num Procs: Time(seconds)
• 2^0 : 55.171
• 2^1 : 35.073
• 2^2 : 21.455
• 2^3 : 15.121
• 2^4 : 12.380
• 2^5 : 11.080

Update 2019-02-04 - You can't wait on grandchildren, changed code to only fork from parent. Fixed spelling of empty.

Type::Tiny is probably best known as a way of having Moose-like type constraints in Moo, but it can be used for so much more. This is the seventh in a series of posts showing other things you can use Type::Tiny for. This article along with the earlier ones in the series can be found on my blog and in the Cool Uses for Perl section of PerlMonks.

For small projects, the type constraints in Types::Standard and other CPAN type libraries are probably enough to satisfy your needs. You can do things like:

   use Types::Common::Numeric qw(PositiveInt);
   
   has user_id => (
      is   => 'ro',
      isa  => PositiveInt,
   );
[download]

However for larger apps, say you need to check user identity numbers in an handful of places throughout your code and you use PositiveInt everywhere, then if you ever feel the need to change the constraint for them, you'll need to hunt through your code to look for every use of PositiveInt, make sure it's not being used for some other reason (like to check an age or a counter), and update it.

So it is helpful to make your own application-specific type library. You can define your own UserId type constraint, and use that everywhere. If the format of your identifiers ever changes, you only need to change the definition of the type constraint.

Moose-Like Syntax

   package MyApp::Types {
      use Type::Library
         -base,
         -declare => qw(
            UserId
            UserIdList
         );
      use Type::Utils -all;
      
      BEGIN {
         extends qw(
            Types::Standard
            Types::Common::Numeric
            Types::Common::String
         );
      };
      
      declare UserId,
         as PositiveInt,
         where { $_ > 1000 };
      
      declare UserIdList,
         as ArrayRef[UserId];
      
      ...;
   }
[download]

Using -base from Type::Library sets your package up as an exporter that inherits from Type::Library. Using -declare allows the type constraints there to be written as barewords in the rest of the package. Importing from Type::Utils gives you a bunch of helpful keywords that can be useful for defining your type constraints. (These keywords will be pretty familiar to people who have defined their own type constraints in Moose or MooseX::Types, but personally I prefer not to use them. I'll show you how to write this type library without the keywords from Type::Utils later.)

The extends statement imports all the type constraints from the given type libraries, so all those types are added to this library. Putting it in a BEGIN block allows them to be written as barewords too.

And then we define a couple of type constraints. Hopefully that part is pretty self-explanatory. The declare, as, and where keywords are some of the things exported by Type::Utils.

Now your application code can just do:

Your type library is also the perfect place to define any application-wide type coercions. For example:

   declare User, as InstanceOf['MyApp::User'];
   
   coerce User,
      from UserId, via { MyApp::Utils::find_user_by_id($_) };
   
   coerce UserId,
      from User, via { $_->user_id };
[download]

Bare Bones Syntax

Although Type::Tiny supports this Moose-like syntax for defining type constraints, I personally find the Type::Utils DSL a little unnecessary. Here's another way you can write the same type library:

   package MyApp::Types {
      use Type::Library -base;
      use Type::Utils (); # don't import any keywords
      
      BEGIN {
         # Type::Utils is still the easiest way to do this part!
         Type::Utils::extends(qw(
            Types::Standard
            Types::Common::Numeric
            Types::Common::String
         ));
      };
      
      my $userid = __PACKAGE__->add_type({
         name       => 'UserId',
         parent     => PositiveInt,
         constraint => '$_ > 1000',
      });
      
      my $user = __PACKAGE__->add_type({
         name       => 'User',
         parent     => InstanceOf['MyApp::User'],
      });
      
      $userid->coercion->add_type_coercions(
         $user   => '$_->user_id'
      );
      $user->coercion->add_type_coercions(
         $userid => 'MyApp::Utils::find_user_by_id($_)',
      );
      
      __PACKAGE__->add_type({
         name       => 'UserIdList',
         parent     => ArrayRef[$userid],
         coercion   => 1,
      });     
      
      ...;
      
      __PACKAGE__->make_immutable;
   }
[download]

Defining types this way exposes some parts of Type::Tiny which are subtly different from Moose. For example, coercions and contraints can be expressed as strings of Perl code. This allows Type::Tiny to optimize some of the Perl code it generates, avoiding the overhead of a function call. Notice also the coerce => 1 when defining UserIdList. This allows UserIdList to inherit ArrayRef's automatic ability to coerce one level deep.

Calling make_immutable on the package allows Type::Coercion to further optimize coercions for all the types in the library and prevents code outside the library from changing the global coercions you've defined.

   # Imagine this is some code in a class...
   #
   
   use MyApp::Types qw( UserId Str );
   
   # This will die because UserId is immutable now.
   UserId->coercion->add_type_coercions(Str, sub { ... });
   
   # This will work, and only affect this one attribute.
   has user_id => (
      is     => 'ro',
      isa    => UserId->plus_coercions(Str, sub { ... }),
      coerce => 1,
   );
[download]

So this method of defining type libraries might look a little less clean, but it has advantages. And as I said, it's how I prefer to do things.

Defining Utility Functions

All Type::Library-based type libraries automatically inherit from Exporter::Tiny and can also be used to define utility functions. Just define a normal Perl sub in the package and add:

I recommend using lower-case function names with underscores to separate words to make them visually distinct from camel-case type constraint names.

To avoid creating a confusing package with a mishmash of unrelated functions, this feature should probably only be used to export functions which are vaguely related to types — validation functions, coercion functions, etc.

Type::Tiny is probably best known as a way of having Moose-like type constraints in Moo, but it can be used for so much more. This is the sixth in a series of posts showing other things you can use Type::Tiny for. This article along with the earlier ones in the series can be found on my blog and in the Cool Uses for Perl section of PerlMonks.

While Types::Standard provides all the type constraints Moose users will be familiar with (and a few more) there are other type libraries you can use instead of or as well as Types::Standard.

Types::Path::Tiny

If your attribute or parameter needs to accept a file or directory name, I'd strongly recommend using Types::Path::Tiny. It provides Path, File, and Dir types, plus Abs* versions of them which coerce given filenames into absolute paths. The Path::Tiny objects it coerces strings into provide a bunch of helpful methods for manipulating files.

   package MyApp::Config {
      use Moo;
      use Types::Path::Tiny qw(AbsFile);
      use JSON::MaybeXS qw(decode_json);
      has config_file => (
         is      => 'ro',
         isa     => AbsFile->where(q{ $_->basename =~ q/\.json$/ }),
         coerce  => 1,
      );
      sub get_hash {
         my $self = shift;
         decode_json( $self->config_file->slurp_utf8 );
      }
   }
[download]

Nice? Types::Path::Tiny is my personal favourite third-party type library. If you're writing an application that needs to deal with files, use it.

Types::Common::String and Types::Common::Numeric

Types::Common::String provides a bunch of type constraints more specific than the standard Str type. If you have indicated that an attribute or parameter should be a string, it's pretty rare that you really want to allow any string. You might want to constrain it more. This type library has types like NonEmptyStr and UpperCaseStr.

Types::Common::Numeric does the same for numbers, giving you type constraints like PositiveInt and IntRange[1,10].

Both of these libraries come bundled with Type::Tiny, so if you're already using Types::Standard, won't add any extra dependencies to your code.

Types::TypeTiny

This is a type library created for Type::Tiny's internal use and gives you types like ArrayLike, HashLike, and CodeLike which allow overloaded objects.

Again it's bundled with Type::Tiny, so won't add any extra dependencies.

Types::DateTime

A type library for DateTime objects, allowing them to be coerced from strings.

   has start_date => (
      is      => 'ro',
      isa     => DateTimeUTC,
      coerce  => 1,
   );
[download]

The above will not only coerce the attribute to a DateTime object, but coerce it to the correct timezone.

This service requires you to have an account with Ally. Their investment API is new. I don't work for them or have any professional relationship but they are often mentioned as the best online bank in the US, I've been a customer since they were GMAC (20 years), and they really came through for me once so I have no reservations in recommending them and sharing some code to use their services.

I had trouble getting streaming to work which was embarassing because it's supposed to be the part of Perl I'm good at. :P pmqs, haukex bliako, kschwab, and vr all stepped up to help and solved my trouble. My new trouble is a websocket client—a cat to skin later—which led me back to Mojolicious. I knew it had some server support so I figured the example code might show client code. I was pleasantly shocked to see it supports it completely via its own client Mojo::UserAgent. All hail sri!

I was even happier to see the client supports gzip content, even in streams. Might be more confusing code for some but for me it was much easier to follow. I have hesitated to move some of my personal code/practices to Mojo but this is probably the shove I needed.

Since the problem is now solved with both libraries, I figured I should share some of the code here. Both rely on the terrific WWW::OAuth. There is a fair bit of identical boilerplate for the arguments and environment.

WWW::Mechanize (LWP::UserAgent)

#!/usr/bin/env perl
use 5.10.0;
use strictures;
use WWW::Mechanize; # LWP::UserAgent is almost the same here.
use WWW::OAuth;
use Compress::Zlib;

my @symbols = grep /\A[A-Z.]+\z/, @ARGV;
die "Give a list of symbols; e.g., AAPL GHII AMZN XOM DIS PBF BABA JD 
+AMD VOO\n"
    unless @symbols;

my $sym = join ",", @symbols;

die "Missing ENV values: ALLY_CLIENT_ID ALLY_CLIENT_SECRET ALLY_TOKEN 
+ALLY_TOKEN_SECRET\n"
    unless $ENV{ALLY_CLIENT_ID}
    and $ENV{ALLY_CLIENT_SECRET}
    and $ENV{ALLY_TOKEN}
    and $ENV{ALLY_TOKEN_SECRET};

my $oauth = WWW::OAuth->new(
    client_id => $ENV{ALLY_CLIENT_ID},
    client_secret => $ENV{ALLY_CLIENT_SECRET},
    token => $ENV{ALLY_TOKEN},
    token_secret => $ENV{ALLY_TOKEN_SECRET} );

my $mech = WWW::Mechanize->new( autocheck => undef );
$mech->add_handler( request_prepare => sub { $oauth->authenticate($_[0
+]) } );

my $gunzip = inflateInit( WindowBits => 16 + MAX_WBITS )
            or die "Cannot create a inflation stream\n";

$mech->add_handler (
    response_data => sub {
    my ( $response, $ua, $h, $data ) = @_;
    $response->content(undef); # Else will append.
    my ( $buffer, $status ) = $gunzip->inflate($data);
    die "zlib error: $status" if length $status;
    say $buffer;
    });

$mech->get("https://stream.tradeking.com/v1/market/quotes?symbols=$sym
+");

__END__
[download]

Mojo::UserAgent

#!/usr/bin/env perl
use 5.10.0;
use strictures;
use Mojo::UserAgent;
use WWW::OAuth;

my @symbols = grep /\A[A-Z.]+\z/, @ARGV;
die "Give a list of symbols; e.g., AAPL GHII AMZN XOM DIS PBF BABA JD 
+AMD VOO\n"
    unless @symbols;

my $sym = join ",", @symbols;

die "Missing ENV values: ALLY_CLIENT_ID ALLY_CLIENT_SECRET ALLY_TOKEN 
+ALLY_TOKEN_SECRET\n"
    unless $ENV{ALLY_CLIENT_ID}
    and $ENV{ALLY_CLIENT_SECRET}
    and $ENV{ALLY_TOKEN}
    and $ENV{ALLY_TOKEN_SECRET};

my $oauth = WWW::OAuth->new(
    client_id => $ENV{ALLY_CLIENT_ID},
    client_secret => $ENV{ALLY_CLIENT_SECRET},
    token => $ENV{ALLY_TOKEN},
    token_secret => $ENV{ALLY_TOKEN_SECRET} );

my $ua = Mojo::UserAgent->new( max_response_size => 0 ); # Stream mean
+s no max.
$ua->on( start => sub { $oauth->authenticate( $_[1]->req ) } ); # OAut
+h all requests.

my $tx = $ua->build_tx( GET => "https://stream.tradeking.com/v1/market
+/quotes?symbols=$sym" );

$tx->res->content
    ->unsubscribe("read")
    ->on( read => sub {
        my ( $content, $bytes ) = @_;
        say $bytes;
      });

$tx = $ua->start($tx);

__END__
[download]

After reading bliako's post, I was curious.

I wanted to experiment a bit with his "I want to be asked for a password/key at encryption stage and then asked just once" requirement. I didn't get it working with PAR, or any ability to also encrypt used modules, so it's not acceptable as an answer there. Might be useful to play with though. Works in a way that's similar to Acme::Bleach, other than I don't overwrite the original file. You'll need to have a working openssl binary in your PATH somewhere.

Feedback welcome.

package AESFilter;
use IPC::Open2;
our $openssl="openssl enc -aes-256-cbc -a";
our $marker = '#AESFilter';

sub encrypt {
    $_[0]=~s/$marker//gs;
    my $pid=open2(my $rdr,my $wrt,"$openssl 2>>/dev/null");
    print $wrt $_[0];
    close $wrt;
    my $output;
    while(<$rdr>) {$output.=$_};
    close $rdr;
    waitpid($pid,0);
    my $status=$?>>8;
    if ($status !=0) {
        die("Exit status $status from openssl, encryption failed\n");
    }
    return $output;
}

sub decrypt {
    my $pid=open2(my $rdr,my $wrt,"$openssl -d 2>>/dev/null");
    print $wrt $_[0]."\n";
    close $wrt;
    my $output;
    while(<$rdr>) {$output.=$_};
    close $rdr;
    waitpid($pid,0);
    my $status=$?>>8;
    if ($status != 0) {
        die("Exit status $status from openssl, decryption failed\n");
    }
    return $output;
}

open(IN,$0) or die "Can't open [$0]: $!\n";
my $prior='';
my $code='';
my $seen=0;
while(<IN>) {
    if ($seen) { 
        chomp;
        $code .= $_;
        next;
    }
    $prior .= $_;
    if (/use AESFilter;/) { $seen=1}
}
close IN;
if ($code =~ s/^$marker//gm) {
    my $clear=decrypt($code);
    eval($prior.$clear);
    print STDERR $@ if $@;
    exit;
}
my $outfile=$0.".enc";
die "Encrypted file [$outfile] already exists\n" if (-e $outfile);
my $encrypted=encrypt($code);
open(OUT,">$outfile") or die "Can't open [$outfile] for write: $!\n";
printf OUT "%s%s\n%s",$prior,$marker,$encrypted;
close OUT;
exit;
1;
[download]

To play with it, create a script like what's below. The first time you run it, it will create an encrypted script, with an extension of ".enc". So, if your script is called "foo", it creates a new file called "foo.enc" that's encrypted. It's calling openssl to get a password, so you'll be prompted for a password.

#!/usr/bin/perl
# so that you don't have to install AESFilter.pm, just 
# have it in your current dir
use lib ".";
# anything before the next line will be in the output in cleartext
# ...anything after will be encrypted
use AESFilter;
print "test123\n";
print "again\n";
for ("one","two","three","four") {
    print $_."\n";
}
[download]

#!/usr/bin/perl
# so that you don't have to install AESFilter.pm, just
# have it in your current dir
use lib ".";
# anything before the next line will be in the output in cleartext
# anything after will be encrypted
use AESFilter;
#AESFilter
U2FsdGVkX1/CjxWDKOh4Xdw/7c0PoKnkUFQsf5gxo3F7RXqcEtmdsAgeEmb1g/QO
qd82hklpUxP/SNzbs34Z2NdzEStaDpeTlke1unf18gAw/2hlu78CIIItHVuAZlrH
ovJhqCBhP0Rck1RwXt3cJw==
[download]

An internet search didn't show up an example of inserting data into a PostgreSQL array (quite a few for retrieving data, though), so I thought I'd post this here.

create table my_table(
id serial,
description varchar(255),
associated_str_data varchar(255)[],
associated_int_data integer[]);
[download]

my $desc = "A description";
my @assoc_str_data = ("string 1", "string 2");
my @assoc_int_data = (1,2,3);
$dbh->do("insert into my_table(description, associated_str_data, assoc
+iated_int_data) values (?,?,?)",
         undef, $desc, \@assoc_str_data, \@assoc_int_data);
[download]

Checking the result in psql shows the data inserted OK:

# select * from my_table;
 id |  description  |   associated_str_data   | associated_int_data
----+---------------+-------------------------+---------------------
  2 | A description | {"string 1","string 2"} | {1,2,3}
(1 row)
[download]

dont know if is so cool.. anyway I was playing with cron entries while I discovered Algorithm::Cron and it's cool method next_time that suddenly provoked a oneliner moment: perl -MAlgorithm::Cron -E "say scalar localtime (Algorithm::Cron->new(base => 'local',crontab => $ARGV[0])->next_time(time)) " "0 9 12 4 *" which prints Fri Apr 12 09:00:00 2019

But this was not cool enough. The following program by other hand parse a cron file or the output of cron -l or some input pasted and shows an ordered list of next commands cron will run.

It accepts input from a pipe, from a file with -f filename and if nothing was given it expects some input to be pasted followed by CTRL-Z or CTRL-D (windows or linux).

Instead of the above input you can use -c "crontab-entry" to parse a solitary crontab entry.

And dulcis in fundo, with the -n N parameter the program will show next N occurrences of the scheduled programs

use strict;
use warnings;
use Getopt::Long;
use Algorithm::Cron;

my $file;
my $howmany;
my $crontab;
my $help;
my @lines;

my $helptext = "USAGE:\n $0 [ [-f filename | -c STRING] -n N]\n\n".
            " $0 -f filename\n".
            " $0 -f filename -n 2\n".
            " crontab -l | $0 \n".
            " crontab -l | $0 -n 2\n".
            " cat filename | $0\n".
            " cat filename | $0 -n 3\n".
            " $0 -c 'crontab entry'\n".
            " $0 -c 'crontab entry' -n 5\n".
            " $0  (paste some content followed by CTRL-D or CTRL-Z on 
+a newline)\n".
            " $0  -n 4 (paste some content followed by CTRL-D or CTRL-
+Z on a newline)\n".
            " $0 -h (print this help)\n";
            
GetOptions ("f|file=s" => \$file,
            "n=i"   => \$howmany,
            "c|crontab=s"    => \$crontab,
            "h|help"  => \$help)  
    or die( $helptext );

print $helptext and exit if $help;    

if ( $crontab )    { @lines = $crontab }
elsif ( $file and -e -f -r $file){
    open my $fh, '<', $file or die;
    @lines = <$fh>;
}
else{ @lines = <> }

foreach my $line ( 
            sort { 
                Algorithm::Cron->new( base => 'local',
                crontab => join' ',(split /\s+|\t/,$a)[0..4])->next_ti
+me(time)
                <=>
                Algorithm::Cron->new( base => 'local',
                crontab => join' ',(split /\s+|\t/,$b)[0..4])->next_ti
+me(time)
            } 
            grep { /^(\d|\*)/ } @lines 
){
    my @parts = split /\s+|\t/,$line;
    my $now = time;
    my $repeat = $howmany;
    print scalar localtime ( Algorithm::Cron->new( base => 'local',
                            crontab => join' ', @parts[0..4])->next_ti
+me($now)
    );
    print " => ( @parts[0..4] )",($crontab ? "" : " => @parts[5..$#par
+ts]"),"\n";
    if ( --$repeat ){
        while( $repeat > 0){
            $now = Algorithm::Cron->new( base => 'local',
                        crontab => join' ', @parts[0..4])->next_time( 
+$now );
            print scalar localtime ( Algorithm::Cron->new( base => 'lo
+cal',
                            crontab => join' ', @parts[0..4])->next_ti
+me($now)
            );
            print "\n";
            $repeat--;        
        }
    }
}


[download]

given a sample file the following example show the usage:

cat crontab.txt

# Crontab Environmental settings
SHELL=/bin/bash
PATH=/sbin:/bin:/usr/sbin:/usr/bin
MAILTO=root
00 3 * 7 0 /path/to/command
#15 20 * 1-7 * /path/to/command2
*/30 7,21 1-15 1 * /path/to/another/command
# m h dom mon dow user  command
21 *    * * *   root    cd / && run-parts --report /etc/cron.hourly
0,30 6    * * *   root    test -x /usr/sbin/blah
#47 6    * * 7   root    test -x /usr/sbin/anacron || ( cd / && run-pa
+rts --report /etc/cron.weekly )
52 6    1 * *   root    test -x /usr/sbin/blahblah || ( cd / && run-pa
+rts )


cat crontab.txt | perl cron-explain.pl

Tue Nov 27 14:21:00 2018 => ( 21 * * * * ) => root cd / && run-parts -
+-report /etc/cron.hourly
Wed Nov 28 06:00:00 2018 => ( 0,30 6 * * * ) => root test -x /usr/sbin
+/blah
Sat Dec  1 06:52:00 2018 => ( 52 6 1 * * ) => root test -x /usr/sbin/b
+lahblah || ( cd / && run-parts )
Tue Jan  1 07:00:00 2019 => ( */30 7,21 1-15 1 * ) => /path/to/another
+/command
Sun Jul  7 03:00:00 2019 => ( 00 3 * 7 0 ) => /path/to/command


cat crontab.txt | perl cron-explain.pl -n 3

Tue Nov 27 14:21:00 2018 => ( 21 * * * * ) => root cd / && run-parts -
+-report /etc/cron.hourly
Tue Nov 27 15:21:00 2018
Tue Nov 27 16:21:00 2018
Wed Nov 28 06:00:00 2018 => ( 0,30 6 * * * ) => root test -x /usr/sbin
+/blah
Wed Nov 28 06:30:00 2018
Thu Nov 29 06:00:00 2018
Sat Dec  1 06:52:00 2018 => ( 52 6 1 * * ) => root test -x /usr/sbin/b
+lahblah || ( cd / && run-parts )
Tue Jan  1 06:52:00 2019
Fri Feb  1 06:52:00 2019
Tue Jan  1 07:00:00 2019 => ( */30 7,21 1-15 1 * ) => /path/to/another
+/command
Tue Jan  1 07:30:00 2019
Tue Jan  1 21:00:00 2019
Sun Jul  7 03:00:00 2019 => ( 00 3 * 7 0 ) => /path/to/command
Sun Jul 14 03:00:00 2019
Sun Jul 21 03:00:00 2019


perl cron-explain.pl -c "2-5 9 12 4 *" -n 4

Fri Apr 12 09:02:00 2019 => ( 2-5 9 12 4 * )
Fri Apr 12 09:03:00 2019
Fri Apr 12 09:04:00 2019
Fri Apr 12 09:05:00 2019

[download]

have fun!

L*

A couple of days ago i looked into GeoIP in Perl+PostgreSQL+GeoIP = Awesome!. Since then i have learned that the GeoIP lists i was using were out of support. The new public lists are in a new format. So i took the opportunity to rewrite the whole thing and do pretty much everything with Perl, not using external commands like "unzip" and "wget". This should make things a bit more portable.

I'm sorry, it isn't written "nice" and isn't really documented. I designed it as a cron job for a single private server ;-)

I'm still calling the perl interpreter from a bash script so i can set the correct environment variables and stuff. But it's a lot smaller now:

#!/usr/bin/env bash

. ~/.bashrc_activestate

cd /home/myuser/src/geoip

perl updategeoip.pl
[download]

The database tables stays exactly the same as in the last post, here again for reference:

CREATE TABLE geoip
(
  netblock cidr NOT NULL,
  country_code text NOT NULL,
  country_name text NOT NULL,
  CONSTRAINT geoip_pk PRIMARY KEY (netblock)
  USING INDEX TABLESPACE "NAMEOFINDEXTABLESPACE"
)
WITH (
  OIDS=FALSE
)
TABLESPACE "NAMEOFDATATABLESPACE";
ALTER TABLE geoip OWNER TO "mydatabaseuser";
[download]

And here is the new all-in-one script:

This script uses the newish "GeoLite2" databases from MaxMind. If you use them, please make sure you comply to the open source licensing stated on their official page

EDIT: WARNING, THIS USES A LEGACY DATABASE THAT IS NOT UPDATED ANYMORE. Please take a look at GeoIP revisited for an updated version that uses an up-to-date version of the MaxMind GeoIP database.

Sometimes you have to work with GeoIP, e.g. mapping an IP address to the origin country. Be it for legal reasons (geoblocking) or just so you know where your target audience is coming from.

You could just make online lookups for every request. But if you are running a PostgreSQL database backend anyway, there is a simple way to do it in DB, since PostgreSQL supports a CIDR column type.

First, let us define a database table:

CREATE TABLE geoip
(
  netblock cidr NOT NULL,
  country_code text NOT NULL,
  country_name text NOT NULL,
  CONSTRAINT geoip_pk PRIMARY KEY (netblock)
  USING INDEX TABLESPACE "NAMEOFINDEXTABLESPACE"
)
WITH (
  OIDS=FALSE
)
TABLESPACE "NAMEOFDATATABLESPACE";
ALTER TABLE geoip OWNER TO "mydatabaseuser";
[download]

Next, we need a bash script we can run from crontab for our daily update:

Of course, now that the up-to-date geoip lists are in the database, it's even possible to use an ON INSERT OR UPDATE trigger to any table that needs geoip data. But that i will leave as an excercise for the reader...

I've been interested in space stuff as far back as i can remember. Quite a while back, Scott Manley had a series on the Youtubes explaining how to calculate orbital changes and i implemented this in Javascript on my Blog.

But i always wanted a command line tool in Perl, so lets get to implementing it. It's not the nicest piece of code and it isn't optimizing the transfer burn (check the different options when to do the burns to minimize Delta-V), nor does it try for things like three or (more) burns/multiple intermediate orbits. But it gives a rough idea of "how bad did they miss the target orbit".

Here is the code (long, so in a "readmore" tag):

The basic commandline is perl lithobreak.pl 1000/e0.5/0 1000/1000/10

First argumnent is the source orbit (initial orbit), the second is the target orbit. You can define each orbit in two ways, either using periapsis/apoapsis/inclination or semimajor-axis/eccentricity/inclination. All measurements in kilometers above earth surface. This example uses both:

1. Source orbit of 1000/e0.5/0: Semi major axis of 1000km, "e" defined eccentricity mode with an eccentricity of 0.5, and an inclination of 0 degrees. Internally, this gets converted to a periapsis of 500km and an apoapsis of 1500km. Could have also been written as 500/1500/0
2. Target orbit of 1000/1000/10: Circular orbit of 1000km with a 10 degree inclination. Could have also been written as 1000/e0/10.

Note: when using ap/per mode, don't worry about using the wrong order, it gets sorted out internally.

And here is the result of our calculation:

Constants:
   Earth radius: 6371000 meter
   Earth mass: 5.97219e+24 kg
   Gravity: 6.67384e-11
   mu: 398574405096000

Source orbit is using eccentricity notation, converting...
Converting to meter...
Adding earth radius...
Orbital parameters for Source orbit:
   Periapsis: 6871000 m
   Apoapsis: 7871000 m
   Inclination: 0 deg

Converting to meter...
Adding earth radius...
Orbital parameters for Target orbit:
   Periapsis: 7371000 m
   Apoapsis: 7371000 m
   Inclination: 10 deg

Calculating semi major axis...
Defining Hohman orbit...
Orbital parameters for Hohman orbit:
   Periapsis: 6871000 m
   Apoapsis: 7371000 m
   Inclination: 0 deg

Calculating first burn...
Data for burn at source orbit periapsis:
   Speed before burn: 7870.39409917514 m/s
   Speed after burn: 7748.85334888779 m/s
   Required Delta-V: 121.540750287353 m/s

Calculating second burn...
Need to include plane change in second burn...
Data for burn at Hohman orbit apoapsis:
   Speed before burn: 7223.22227109049 m/s
   Speed after burn: 7353.45599234394 m/s
   Inclination before burn: 0 deg
   Inclination after burn: 10 deg
   Inclination change: 10 deg
   Required Delta-V: 1277.04850388302 m/s

Total Delta-V requirement: 1398.58925417037 m/s
[download]

Yeah, 1.3km/s required Delta-V. Not good. Better call our Kerbals to build us a new sat, this one isn't going to make it...

After inspiration by Your Mother and some slight hacking, I'm very proud to announce HTTP::Request::FromCurl, together with its companion online site at https://corion.net/curl2lwp.psgi. The module and included curl2lwp program allow you to easily convert curl command lines to Perl code that uses LWP::UserAgent resp. WWW::Mechanize.

Some code:

curl2lwp.pl -X GET -A xpcurl/1.0 https://perlmonks.org/
[download]

outputs the following code:

    my $ua = WWW::Mechanize->new();
    my $r = HTTP::Request->new(
        'GET' => 'https://perlmonks.org/',
        [
            'Accept' => '*/*',
            'Host' => 'perlmonks.org:443',
            'User-Agent' => 'curl/1.0',
        ],

    );
    my $res = $ua->request( $r,  );
[download]

The online version creates a bit more code, as the output there is likely not consumed by advanced Perl programmers.

The module parses a subset of the valid curl command lines and generates equivalent code for LWP::UserAgent for it. Support for other HTTP user agents (Mojo::UserAgent, AnyEvent::HTTP, HTTP::Future) is not yet implemented but I welcome contributions there.

The app driving the online interface is not yet released onto CPAN, but as it is mostly HTML scaffolding and some Javascript, it should be released fairly soon.

As I continue my pilgrimage to becoming passably proficient with Mojo and Google Cloud Services I have been tinkering away with WebService::GoogleAPI::Client and as a working example I was reasonably happy with the ease with which I could produce a basic Google API Explorer that presents the method and parameters of all the Google Discoverable API Endpoints. This is proving a handy starting point to constructing working examples accessing the APIS.

I plan to extend this to firstly include required scopes, then provide OpenAPI YAML and perhaps ultimately replicate many of the features of Google's API Explorer.

You can see the Mojo Application running as a Hypnotoad socket served application under CPANEL/WHM hosted environment at https://pscott.com.au.

Today I'm working on the Google Drive API Example available in the Github Repo as a demo of an alternative approach to using a dedicated CPAN module such as the just released Net::Google::Drive

If anybody has any interesting use cases requiring access to Google Cloud Services let me know. I'm trying to add a new example every few days.