opset results from the CPAN

opset

Language-MPI

view release on metacpan or search on metacpan


Processor for the Message Parsing Interpreter text
composition language, based on the MPI found in MU* online
environments, adapted for more general semantics.

http://en.wikipedia.org/wiki/Message_Parsing_Interpreter

=head1 USAGE

	use Language::MPI;
	$node = new Language::MPI($noderef);
	$node->setvar("varname", "varval");
	$results = $node->parse("tick {set:varname,{time:}} tock");
	$val = $node->readvar("varname");

MPI assumes an operating environment consisting of a set
of nodes each of which has a set of named properties.  How
these nodes and properties are stored and structured is up
to the application except that:

=over

=item * noderefs are perl scalars used by application
supplied functions.  Something with a printable value is
encouraged but not required.

=item * properties may be identified by and resolve to
plain text strings.

=back

MPI, in the interest of more general usage, expects some
support subroutines to be supplied by app to access nodes
and properties.  Should any of these not be supplied, errors
are trapped to prevent crashing.  Functions not needing
these should still work properly.  Should the application
designer wish, app data to be passed to these callbacks may
be set into and read from the object by the setvar() and
readvar() methods.

=over

=item mpi_neighbors($thisnode, $pattern, $obj)

$thisnode is a noderef.
$pattern is a string pattern used to specify which nodes
'neighboring' the current node are of interest.
returns list of noderefs;

=item mpi_prop($thisnode, $propname, $obj)

$propname is the string name of a property.
returns propval;

=item mpi_props($thisnode, $proppat, $obj)

$propat is a string specifier to a property directory or a
subset of properties.
returns list of propnames;

=item mpi_propset($thisnode, $propname, $val, $obj)

=back

=head1 INSTALATION

	perl Makefile.PL
	make
	make install

Or simply copy the MPI.pm file to Language/ under the perl
modules directory.  README and the man file for this package
exist as pod data in MPI.pm.

=head1 STATUS

Some MPI standard functions incomplete or unimplimented.  Testing incomplete.

=head1 Etc

This code developed using perl 5.8.8.  Might work with perl
5.6.0 or older with proper libraries.  Uses strict and warning.

Copyright (c)2007 Peter Hanely. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 LANGUAGE

=head2 VARS

=over

=item Variable names of alphabetic characters are general MPI use.

=item Names beginning with an underscore "_" are reserved
for mpi internal variables and should not be used by the
application.

=item Names beginning with "\" are suggested for application
values placed in the mpi object.

=cut

use strict;
use warnings;
# warning good for debug, but produce noise from good code
no warnings qw(uninitialized);
#use Carp;

package Language::MPI;

our ($VERSION, @ISA, @EXPORT_OK, $perl_list);
#use vars qw($VERSION, @ISA, @EXPORT_OK, $perl_list);

BEGIN
{
  require Exporter;
  our ($VERSION, @ISA, @EXPORT_OK);

  @ISA = qw(Exporter);

lib/Language/MPI.pm view on Meta::CPAN


=head2 {count:array}

=cut

sub func_count
{ my ($this, $val) = @_;
  my (@arry);
  @arry = &unpack_list($val->[0]);
  return (scalar (@arry));
}

=head2 {date:}

=cut

sub func_date
{ my ($sec, $min, $hour, $mday, $mon, $year) = gmtime (time());
  if ($year < 1000) { $year += 1900; }
  $mon++;
  "$mon/$mday/$year";
}

sub func_debug
{ }

sub func_debugif
{ }

=head2 {dec:var,dec}

=cut

sub func_dec
{ my ($this, $val) = @_;
  my ($var, $inc) = @$val;
  $inc = $inc || 1;
  $this->{$var} -= $inc;
}

=head2 {default:var1,var2...}

=cut

sub func_default
{ my ($this, $val) = @_;
  my ($indx) = 0;
  while (($indx < @$val) && !($val->[$indx])) { $indx ++ }
  if ($indx < @$val) { $val->[$indx]; }
  else { ""; }
}

=head2 {delprop:var[,obj]}

=cut

sub func_delprop
{ my ($this, $val) = @_;
  my ($prop, $obj) = @$val;
  $obj = $obj || $this->{'_node'};
  if (defined &mpi_propset)
  { eval (&mpi_propset($obj, $prop, "", $this)); }
}

=head2 {dice:range[,count[,bonus]]}

=cut

sub func_dice
{ my ($this, $val) = @_;
  my ($range, $count, $bonus) = @$val;
  my ($indx, $tot);
  if ($count <= 0) { $count = 1; }
  for ($indx = 0; $indx < $count; $indx ++)
  { $tot += int(rand($range)+1); }
  $tot+$bonus;
}

=head2 {dist:x1,y2...}

=cut

sub func_dist
{ my ($this, $val) = @_;
  my ($x1, $y1, $z1, $x2, $y2, $z2) = @$val;
  if (@$val == 4)
  { ($x2, $y2) = ($z1, $x2); }
  my ($dx, $dy, $dz) = ($x2-$x1, $y2-$y1, $z2-$z1);
  sqrt($dx*$dx + $dy*$dy + $dz*$dz);
}

=head2 {div:num,num1...}

=cut

sub func_div
{ my ($this, $val) = @_;
  int($val->[0]/$val->[1]);
}

=head2 {eq:var1,var2}

=cut

sub func_eq
{ my ($this, $val) = @_;
  $val->[0] eq $val->[1];
}

sub func_escape
{ }

=head2 {eval:vars...}

=cut

sub func_eval
{ my ($this, $val) = @_;
  my ($tot, $param);
  foreach $param(@$val)
  { $tot .= &parse($this, $param); }
  $tot;

lib/Language/MPI.pm view on Meta::CPAN

{ my ($this, $val) = @_;
  my ($list, $obj) = @$val;
  my (@list, $i);
  $obj = $obj || $this->{"_node"};
  @list = eval{&mpi_props($obj, $list, $this)};
  eval(&mpi_prop($obj, $list[int(rand @list)], $this));
}

=head2 {secs:}

=cut

sub func_secs
{ time(); }

sub func_select
{ }

=head2 {set:var,val}

=cut

sub func_set
{ my ($this, $val) = @_;
  my ($var, $v) = @$val;
  if ($var =~ /^[a..zA..Z]/) # some vars are reserved for engine use
  { $this->{$var} = $v; }
}

=head2 {sign:num}

=cut

sub func_sign
{ my ($this, $val) = @_;
  $val->[0] <=> 0;
}

=head2 {smatch:string,pattern}

=cut

sub func_smatch
{ my ($this, $val) = @_;
  my ($str, $pat) = @$val;
  $str =~ /($pat)/;
  $1
}

sub func_stimestr
{ }

=head2 {store:val,property[,node]}

=cut

sub func_store
{ my ($this, $val) = @_;
  my ($str, $prop, $obj) = @$val;
  $obj = $obj || $this->{'_node'};
  eval {&mpi_propset($obj, $prop, $str, $this)} || "";
}

=head2 {strip:string}

=cut

sub func_strip
{ my ($this, $val) = @_;
  chomp $val->[0];
  $val->[0] =~ s/^\s*//;
  $val->[0] =~ s/\s*$//;
  $val->[0];
}

=head2 {strlen:string}

=cut

sub func_strlen
{ my ($this, $val) = @_;
  length $val->[0];
}

=head2 {sublist:list,pos1,pos2[,sep]}

=cut

sub func_sublist
{ my ($this, $val) = @_;
  my ($list, $pos1, $pos2, $sep) = @$val;
  my @list = &unpack_list($list, $sep);
  if (!defined($pos2)) { $pos2 = @list; }
  &pack_list( splice( @list, $pos1+1, $pos2-$pos1) );
}

=head2 {subst:string,old,new}

=cut

sub func_subst
{ my ($this, $val) = @_;
  my ($str, $old, $new) = @$val;
  $str =~ s/$old/$new/g;
  $str;
}

=head2 {subt:num1,num2...}

=cut

sub func_subt
{ my ($this, $val) = @_;
  my ($num, $tot);
  $tot = shift @$val;
  foreach $num (@$val)
  { $tot -= $num; }
  $tot;
}

=head2 {time:}

lib/Language/MPI.pm view on Meta::CPAN

      $this->{$var} = $params->[$i];
    }
    $result = &parse($this, $this->{"_f_$function"});
    foreach $var(split /:/, $this->{"_f_$function v"})
    { $this->{$var} = $save{$var}; }
  }
  else
  { ($params, $remainder) = &parse_parameters($this, $text);
    $result = join (',', @$params);
  }
  ($result, $remainder);
}

=head2 $mpi->parse(string);

Processes a string for MPI codes

=cut

# parse a text block.  simular to parse_parameter, except not terminating at ','
sub parse
{ my ($this, $text) = @_;
  my ($result, $value, $term);
  # while we have unprocessed text
  #   find MPI, if any.
  #   preceeding text copied to result.
  #   MPI evaluated and retuned values added to result.

  $term = "zz"; # meaningless except not null
  while ($term)
  { ($value, $text, $term) = &parse_parameter($this, $text);
    $result .= $value.$term;
  }

  $result;
}

1;

__END__

use Language::MPI;

# dummy test callbacks
package Language::MPI;

sub mpi_neighbors 
{ my ($thisnode, $pattern) = @_;
  "neighbors:$thisnode,$pattern";
}
sub mpi_prop
{ my ($thisnode, $propname) = @_;
  "$thisnode/$propname";
}

sub mpi_props
{ my ($thisnode, $proppat) = @_;
  ("propa", "propb", "propc");
}

sub mpi_propset
{ my ($thisnode, $propname, $val) = @_;
  "$thisnode,$propname,$val";
}

package main;

$mpi = new Language::MPI('dummy node');

@tests =
( 'plain text, no MPI',
  '{toupper:lower to upper}',
  '1+2 = {add:1,2} = 2+1',
  '{tolower:{toupper:lower to upper to lower}}',
  '{for:i,1,4,1,{v:i} }',
  
  '{abs:-2}',
  '{add:1,2,3}',
  '{and:2,4,6}',
  '{attr:attribute...,text}',
  '{mklist:list,items}',
  '{set:list,{mklist:list,items}}',
  '{count:{v:list}',
  '{date:}',
  '{set:var,1}',
  '{v:var}',
  '{dec:var,2}',
  '{inc:var,4}',
  '{default:1,2}',
  '{dice:6,3,2}',
  '{dist:3,4}',
  '{div:81,9,3}',
  '{eq:var1,var1}',
  '{eval:vars...}',
  '{foreach:var,{v:list},:{v:var}:}',
  '{ge:2,2}',
  '{gt:2,1}',
  '{if:true,true statement,false statement}',
  '{insrt:string1,ing}',
  '{lcommon:{v:list},{mklist:items}}',
  '{le:1,2}',
  '{lmember:{v:list},items}',
  '{lit:{a:dummy,mpi}}',
  '{max:1,2,3}',
  '{min:1,2,3}',
  '{mod:9,4}',
  '{mult:2,4,8}',
  '{ne:var1,var2}',
  '::{nl:}::',
  '{not:true}',
  '{null:a big statement to execute but not keep a value from...}',
  '{or:1,2,0}',
  '{secs:}',
  '{sign:-100}',
  '{smatch:string,ing}',
  '{strip:  string   }',
  '{strlen:string}',
  '{subst:string,ing,ung}',
  '{subt:100,50,25}',
  '{time:}',
  '{version:}',

( run in 1.239 second using v1.01-cache-2.11-cpan-71847e10f99 )