view release on metacpan or  search on metacpan

lib/Acme/Chef.pm  view on Meta::CPAN

sub compile {
   my $proto = shift;
   my $class = ref $proto || $proto;

   my $code = shift;
   defined $code or croak "compile takes one argument: a code string.";

   my $self = {};

   bless $self => $class;

   my @paragraphs = $self->_get_paragraphs( $code );
   my @recipes    = $self->_paragraphsToRecipes(\@paragraphs);

   $_->compile() foreach @recipes;

   $self->{start_recipe} = $recipes[0]->recipe_name();

   $self->{recipes} = {
                        map { ($_->recipe_name(), $_) } @recipes
                      };

   return $self;
}


=item execute
 
Takes no arguments. Runs the program and returns its output.

=cut

sub execute {
   my $self = shift;

   my $start_recipe = $self->{recipes}->{ $self->{start_recipe} }->new();

   $start_recipe->execute($self->{recipes});

   return $start_recipe->output();   
}


=item dump
 
Takes one optional argument. If it equals 'autorun',
dump returns a string that, when evaluated, executes
the program and returns the output.

If the argument does not equal 'autorun', a different
string is returned that reconstructs the Acme::Chef
object.

=cut

sub dump {
   my $self = shift;
   my $type = shift;
   $type = '' if not defined $type;

   local $@ = undef;
   require Data::Dumper;

   my $dumper = Data::Dumper->new([$self], ['self']);
   $dumper->Indent(0);
   $dumper->Purity(1);

   my $dump = $dumper->Dump();

   if ($type =~ /^autorun$/) {
      $dump = 'do{my ' . $dump . ' bless $self => "' . (__PACKAGE__) . '"; $self->execute();} ';
   } else {
      $dump = 'do{my ' . $dump . ' bless $self => "' . (__PACKAGE__) . '";} ';
   }

   return $dump;
}


# private function _get_paragraphs

sub _get_paragraphs {
   my $self = shift;

   my $string = shift;

   $string =~ s/^\s+//;
   $string =~ s/\s+$//;

   return split /\n{2,}/, $string;
}


# private function _paragraphsToRecipes
# 
# Constructs recipes from an array ref of paragraphs.

sub _paragraphsToRecipes {
   my $self = shift;

   my $paragraphs = shift;
   $paragraphs = shift if not defined $paragraphs or not ref $paragraphs;

   while (chomp @$paragraphs) {}

   my @recipes;

   my $paragraph_no = 0;
   while (@$paragraphs) {
      my $recipe_name = shift @$paragraphs;
      $paragraph_no++;
      $recipe_name =~ /^[ ]*([\-\w][\- \w]*)\.[ ]*$/
        or croak "Invalid recipe name specifier in paragraph no. $paragraph_no.";
      $recipe_name = lc($1);

      last unless @$paragraphs;
      my $comments = shift @$paragraphs;
      $paragraph_no++;
      my $ingredients;
      if ( $comments =~ /^[ ]*Ingredients\.[ ]*\n/ ) {
         $ingredients = $comments;