The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Sys::Trace;
use strict;
use Sys::Trace::Results;

our $VERSION = "0.03";

=head1 NAME

Sys::Trace - Interface to system call tracing interfaces

=head1 SYNOPSIS

  use Sys::Trace;

  my $trace = Sys::Trace->new(exec => [qw(ls foo)]);

  $trace->start; # Returns a PID which you can watch
  $trace->wait;  # Alternatively call this to wait on the PID

  my $result = $trace->results; # Returns a Sys::Trace::Results object

  use Cwd;
  print $result->files(getcwd . "/"); # Should show an attempt to look at "foo"
                                      # in the current directory (i.e. "ls
                                      # foo", above)

=head1 DESCRIPTION

Provides a way to programmatically run or trace a program and see the system
calls it makes.

This can be useful during testing as a way to ensure a particular file is
actually opened, or another hard to test interaction actually occurs.

Currently supported tracing mechanisms are ktrace, strace and truss.

=head1 METHODS

=cut

our @INTERFACES = qw(
  Sys::Trace::Impl::Strace
  Sys::Trace::Impl::Ktrace
  Sys::Trace::Impl::Truss
);

our @ISA;

my $interface_class = "";

=head2 new(%args)

Keys in C<%args> can be:

=over 4

=item *

B<exec>: Program and arguments to execute

=item *

B<pid>: PID of program to trace

=item *

B<follow_forks>: Follow child processes too (default is 1, set to 0 to disable)

=back

Only one of exec or pid must be provided.

=cut

sub new {
  my($class, %args) = @_;

  if(!$interface_class) {
    for my $interface(@INTERFACES) {
      my $file = $interface;
      $file  =~ s{::}{/}g;
      $file .= ".pm";
      eval { require $file } or next;

      if($interface->usable) {
        $interface_class = $interface;
        @ISA = $interface_class;
        last;
      }
    }
  }

  if(!$interface_class) {
    require Carp;
    Carp::croak("No interface for system call tracing is available on this platform");
  }

  # Default to following forks
  $args{follow_forks} = 1 unless exists $args{follow_forks};

  return $class->SUPER::new(%args);
}

=head2 start

Start running the trace.

=cut

sub start {
  my($self) = @_;

  if(!defined $self->pid(fork)) {
    die "Unable to fork: $!";
  }

  return $self->pid if $self->pid; # parent
  $self->run;
}

=head2 wait

Wait for the trace to finish

=cut

sub wait {
  my($self) = @_;

  $? if waitpid $self->pid, 0;
}

=head2 results

Return a L<Sys::Trace::Results> object populated with the results of the trace.

=cut

sub results {
  my($self) = @_;

  return Sys::Trace::Results->new($self);
}

1;

__END__

=head1 BUGS

This does what I wanted, it is probably woefully incomplete in places.

See L<http://github.com/dgl/perl-Sys-Trace>.

=head1 LICENSE

This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Do What The Fuck You Want To Public License, Version 2, as
published by Sam Hocevar. See http://sam.zoy.org/wtfpl/COPYING or
L<Software::License::WTFPL_2> for more details.

=head1 AUTHOR

David Leadbeater E<lt>L<dgl@dgl.cx>E<gt>, 2010