view release on metacpan or  search on metacpan

lib/Apache2/Translation.pm  view on Meta::CPAN

       add_note(config=>(ref $c
			 ? $c->[1]."\t".$c->[0]
			 : $MATCHED_URI."\t$c"));
     }
     $need_m2s++;
     return 1;
   },

   fixup=>sub {
     my ($action, $what)=@_;
     add_note(fixup=>$what);
     $need_fixup++;
     return 1;
   },

   fixupconfig=>sub {
     my ($action, $what)=@_;
     foreach my $c (handle_eval( $what )) {
       add_note(fixupconfig=>(ref $c
			      ? $c->[1]."\t".$c->[0]
			      : $MATCHED_URI."\t$c"));
     }
     $need_fixup++;
     return 1;
   },

   key=>sub {
     my ($action, $what)=@_;
     $KEY=handle_eval( $what );
     return 1;
   },

   state=>sub {
     my ($action, $what)=@_;
     $what=lc handle_eval( $what );
     if( exists $states{$what} ) {
       $STATE=$states{$what};
     } else {
       $r->warn(__PACKAGE__.": invalid state $what");
     }
     return 1;
   },

   error=>sub {
     my ($action, $what)=@_;
     my ($code, $msg)=handle_eval( $what );
     die Apache2::Translation::Error->new( code=>$code||500,
					   msg=>$msg||'unspecified error' );
   },

   redirect=>sub {
     my ($action, $what)=@_;
     my ($loc, $code)=handle_eval( $what );
     die Apache2::Translation::Error->new( msg=>"Action REDIRECT: location not set" )
       unless( length $loc );
     die Apache2::Translation::Error->new( loc=>$loc, code=>$code||302 );
   },

   call=>sub {
     my ($action, $what)=@_;
     local @ARGV;
     ($what, @ARGV)=handle_eval( $what );
     my @l=$cf->{provider}->fetch( $KEY, $what );
     @l=$cf->{provider}->fetch( '*', $what ) unless( @l );
     process( @l );
     return 1;
   },

   restart=>sub {
     my ($action, $what)=@_;
     if( length $what ) {
       my @l=handle_eval( $what );
       if( length $l[0] ) {
	 $r->uri($l[0]);
       } else {
	 $l[0]=$r->uri;
       }
       $l[1]=$cf->{key} unless( defined $l[1] );
       $l[2]='' unless( defined $l[2] );
       ($MATCHED_URI, $KEY, $MATCHED_PATH_INFO)=@l[0..2];
       $MATCHED_URI=~s!/+!/!g;
       die Apache2::Translation::Error->new( code=>Apache2::Const::HTTP_BAD_REQUEST,
					     msg=>"BAD REQUEST: $MATCHED_URI" )
	 unless( $MATCHED_URI=~m!^/! or $MATCHED_URI eq '*' );
     }
     $STATE=PREPROC;
     $skip_uri_cut++;
     return 0;
   },

   done=>sub {
     my ($action, $what)=@_;
     $STATE=$next_state{$STATE};
     return 0;
   },

   last=>sub {
     my ($action, $what)=@_;
     return 0;
   },
  );

sub handle_action {
  my ($a)=@_;
  if( $a=~/\A(?:(\w+)(?::\s*(.+))?)|(.+)\Z/s ) {
    my ($action, $what)=(defined $1 ? lc($1) : 'do',
			 defined $1 ? $2 : $3);

    warn "Action: $action: $what\n" if($DEBUG);

    if( exists $action_dispatcher{$action} ) {
      return $action_dispatcher{$action}->($action, $what);
    }
  }

  $r->warn(__PACKAGE__.": UNKNOWN ACTION '$a' skipped");
  return 1;
}

sub process {
  my $rec=shift;