rlp.pl

use v5.10.0;
use strict;
use warnings;
use Data::Dumper;

my $default = 50;
sub lol {
    say STDERR "default: $default";
    my ($intensity) = ("foo 123" =~ m{^foo (\d+)?$});
    return {
        intensity => ( defined $intensity ? $intensity : $default ),
    };
}

my $x = lol();
say Dumper($x);

The intensity for sense criteria that have no intensity attached

my $default_intensity=50;

The prodecdure below, readMessages, reads messaages from the

passed filename. If there are multiple blocks, it picks one at

random. Parses the selected message block and returns it in the

form:

{

file => "/var/lib/mooix/concrete/room/look.msg.jbo",

messages => [

{

criteria => [

{ type => "sense", intensity => 50, text => "see", },

{ type => "session", intensity => 50, text => "session", },

],

text => ".i do zvati $this\n$this->description$details$contents$exits$build",

},

{

criteria => [

{ type => "session", intensity => 50, text => "session", },

],

text => ".i manku",

},

],

session => 1,

senses => [ "see" ],

}

See the main sub for details here.

The outer session is true (aka 1) if there are any session type

criteria in any of the messages. It's for quick reference.

The outer senses bit lists every sense used in every criteria in

the message block, for quick reference later. It is the same as

the criteria's text for every sense type message criteria, but

without repeats.

sub readMessages {
my $this = shift;
my $fieldname = shift;

print STDERR "In msg on concrete/thing: readMessages: fieldname: $fieldname\n" if $this->debug(2);

$this->croak( "In msg on concrete/thing: readMessages: passed a bad field name $fieldname\n" ) if $fieldname =~ m{^\s*$};

my $fieldfile = $this->fieldfile( $fieldname );

print STDERR "In msg on concrete/thing: readMessages: fieldfile: $fieldfile\n" if $this->debug(2);

$this->croak( "In msg on concrete/thing: readMessages: can't find field for field name $fieldname\n" ) if ! $fieldfile;

Break the field into blocks

my @blocks = split( /\n\n/, $this->$fieldname );

print STDERR "In msg on concrete/thing: readMessages: blocks: ".Dumper(@blocks)."\n" if $this->debug(3);

print STDERR "locks: ".Dumper(@blocks)."\n";

Pick one at random

my $block = $blocks[rand(@blocks)];

my @criterion;

print STDERR "default: $default_intensity\n";

foreach my $line (split( /\n/, $block )) {
print STDERR "line: $line\n";
my ( $criterionText, $text ) = ( $line =~ m{^([^:]): *(.)$} );

foreach my $criteriaText (split( /,/, $criterionText)) {
  my ( $type, $intensity ) = ( $criteriaText =~ m{^([^(]+)\(?([0-9]+)?\)?$} );
  push @criterion, { type => $type,
    intensity => ( defined $intensity ? $intensity : $default_intensity ),
    text => $criteriaText };
}

}

return \@criterion;

}