view release on metacpan or  search on metacpan

lib/App/Iops.pm  view on Meta::CPAN

Actually executes whatever action was requested.

=head1 THANKS TO

Thanks to the following people:

=over

=item Alan Haggai Alavi

=back

=cut

use strict;

use English '-no_match_vars';
use Getopt::Long ();
use Pod::Usage ();

sub new {
    my $class = shift;
    my $self = {
        pid        => undef,
        strace_pid => undef,
        strace_fh  => undef,
        files      => {},
        prev       => '',
        @_
    };
    bless $self, $class;

    $self->_read_arguments( @_ );

    return $self;
}

sub run {
    my $self = shift;

    if ($self->{help}) {
        Pod::Usage::pod2usage(
            -exitval => 0,
            -verbose => 2,
        );
    }
    else {
        $self->_proc_readlinks;
        $self->_open_strace_pid;
        $self->_watch_iops;
    }

    # NEVER REACHED
    return;
}

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

    $OUTPUT_AUTOFLUSH = -t STDOUT;

    local $/ = "\n";
    while ( my $iop = readline $self->{strace_fh} ) {
        chomp $iop;

        my ( $op, $fd, $fn );
        if ( ( $fd ) = $iop =~ /^close\(([0-9]+)/ ) {
            $self->{files}{$fd} ||= readlink( "/proc/$self->{pid}/fd/$fd" );
            $self->_iop( 'close ' . ( defined $self->{files}{$fd} ? $self->{files}{$fd} : $fd ) );
            delete $self->{files}{$fd};
        }
        elsif ( ( $op, $fd ) = $iop =~ /^(\w+)\(([0-9]+)/ ) {
            $fn = $self->{files}{$fd} ||= readlink( "/proc/$self->{pid}/fd/$fd" );
            my $color = $op eq 'read' ? "\e[33m" : "\e[31m";
            $self->_iop( "$color$op\e[0m " . ( defined $fn ? $fn : $fd ) );
        }
        elsif ( ( $op, $fn ) = $iop =~ /^(\w+)\("([^"]+)/ ) {
            $self->_iop( "$op $fn" );
        }
    }

    return;
}

sub _read_arguments {
    my $self = shift;

    local @ARGV = @_;
    Getopt::Long::GetOptions(
        $self,
        'help',
        'pid=i',
    )
      or Pod::Usage::pod2usage(
          -exitval => 2,
          -verbose => 2,
      );
    if (@ARGV) {
        Pod::Usage::pod2usage(
            -exitval => 2,
            -verbose => 2,
        );
    }

    return;
}

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

    opendir FD, "/proc/$self->{pid}/fd"
      or die "Can't open /proc/$self->{pid}/fd: $ERRNO";
    my %files;
    for ( readdir FD ) {
        next if $_ eq '.' || $_ eq '..';

        my $link = readlink "/proc/$self->{pid}/fd/$_";
        if ( ! defined $link ) {
            $link = $_;
        }