view release on metacpan or  search on metacpan

t/Devel-Agent.t  view on Meta::CPAN

    $fh->close;

    $self->start_trace;

    my $cv=AnyEvent->condvar;

    my $check='';
    my $watcher;
    {
    $fh=IO::File->new($path,'<');
    $watcher=AnyEvent->io(
      fh=>$fh,
      poll=>'r',
      cb=>sub {
        my $line=$fh->getline;
        if(defined($line)) {
          $check .=$line;

        } else {
          $fh->close;
          undef $watcher;
          undef $fh;
          $cv->send('test');
        }
      }
    );
    $cv->recv;
    }

    $self->stop_trace;
    diag Dumper($self->trace);
    cmp_ok($str,'eq',$check,'make sure our calls to anyevent work');
  }
  {
    $SET='Pack Testing';
    $TESTS=0;
    my $check;
    sub test_app { \&test_responder }

    sub test_responder {
      my $responder = shift;
      my $writer = $responder->([ 200, [ 'Content-Type', 'text/plain' ]]);
      $check='';
      for(my $id=0;$id<2;++$id) {
        write_chunk($writer,$id);
        write_chunk($writer,$id);
      }
      $writer->close;
    }
    sub write_chunk {
      my ($writer,$id)=@_;
      my $line="Line: $id\n";
      $check .=$line;
      $writer->write($line);
    }
    my $test = Plack::Test->create(\&test_app);
    my $get=GET '/';
    my $res=$test->request($get);
    cmp_ok($res->code,'==',200,'establish a base line that our hello world streaming app is working');
    cmp_ok($res->content,'eq',$check,'ensure that our content is not corrupted');

    
    $DB::AGENT=undef;
    {
    no warnings;
    # force a trace every reqest
    $Plack::Middleware::Devel::Agent::Plack::TRACE_EVERY=1;
    $Plack::Middleware::Devel::Agent::Plack::AGENT_OPTIONS{save_to_stack}=0;
    $Plack::Middleware::Devel::Agent::Plack::AGENT_OPTIONS{on_frame_end}=sub {
      my ($agent,$frame)=@_;
      my $str='';
      my $fh;
      open($fh,'>',\$str);

      flush_row($agent,$frame,$fh);
      $fh->close;
      diag $str;
    };
    $Plack::Middleware::Devel::Agent::Plack::AGENT_OPTIONS{ignore_calling_class_re}=[qr/^Test2::/s,qr/^Test::/,];
    $Plack::Middleware::Devel::Agent::Plack::AGENT_OPTIONS{excludes}->{'Plack::Test::MockHTTP'}=1;
    
    $Plack::Middleware::Devel::Agent::Plack::AFTER_TRACE=sub {
      my ($db,$id,$res,$env)=@_;
      diag Dumper($res);
      $self=$db;
    };
    }

    my $org=$check;
    $test = Plack::Test->create(Plack::Middleware::Devel::Agent::Plack->wrap(\&test_app));
    $get=GET '/';
    $res=$test->request($get);
    $DB::AGENT->stop_trace if defined $DB::AGENT;
    cmp_ok($res->code,'==',200,'should get a code 200');#or die $res->status_line;
    diag $res->content;
    diag Dumper(\%Plack::Middleware::Devel::Agent::Plack::AGENT_OPTIONS);
    diag Dumper(\%Plack::Middleware::Devel::Agent::Plack::SELF_EXCLUDES);


  }
}
sub rebuild_trace {
  my ($frames)=@_;
  my @keys=sort { $a<=>$b } keys $frames->%*;
  my $trace=[];
  foreach my $key (@keys) {
    my $frame=$frames->{$key};

    # stick this in our root execution hook
    push @$trace,$frame if $frame->{depth}==1;
    my $owner_id=$frame->{owner_id};
    
    next unless exists $frames->{$owner_id};
    push $frames->{$owner_id}->{calls}->@*,$frame 
  }
  return $trace;
}

sub gm {