code all now works

Proc-ProcessTable-InfoString/Makefile.PL

@@ -4,25 +4,25 @@ use warnings;
 use ExtUtils::MakeMaker;
 
 my %WriteMakefileArgs = (
-    NAME             => 'Proc::ProcessTable::InfoString',
+						 NAME             => 'Proc::ProcessTable::InfoString',
-    AUTHOR           => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
+						 AUTHOR           => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
-    VERSION_FROM     => 'lib/Proc/ProcessTable/InfoString.pm',
+						 VERSION_FROM     => 'lib/Proc/ProcessTable/InfoString.pm',
-    ABSTRACT_FROM    => 'lib/Proc/ProcessTable/InfoString.pm',
+						 ABSTRACT_FROM    => 'lib/Proc/ProcessTable/InfoString.pm',
-    LICENSE          => 'artistic_2',
+						 LICENSE          => 'artistic_2',
-    MIN_PERL_VERSION => '5.006',
+						 MIN_PERL_VERSION => '5.006',
-    CONFIGURE_REQUIRES => {
+						 CONFIGURE_REQUIRES => {
-        'ExtUtils::MakeMaker' => '0',
+												'ExtUtils::MakeMaker' => '0',
-    },
+												},
-    TEST_REQUIRES => {
+						 TEST_REQUIRES => {
-        'Test::More' => '0',
+										   'Test::More' => '0',
-    },
+										   },
-    PREREQ_PM => {
+						 PREREQ_PM => {
-        #'ABC'              => '1.6',
+									   'Term::ANSIColor' => '4.06',
-        #'Foo::Bar::Module' => '5.0401',
+									   'Proc::ProcessTable' => '0.59',
-    },
+									   },
-    dist  => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+						 dist  => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
-    clean => { FILES => 'Proc-ProcessTable-InfoString-*' },
+						 clean => { FILES => 'Proc-ProcessTable-InfoString-*' },
-);
+						 );
 
 # Compatibility with old versions of ExtUtils::MakeMaker
 unless (eval { ExtUtils::MakeMaker->VERSION('6.64'); 1 }) {
@@ -36,10 +36,10 @@ unless (eval { ExtUtils::MakeMaker->VERSION('6.55_03'); 1 }) {
 }
 
 delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
-    unless eval { ExtUtils::MakeMaker->VERSION('6.52'); 1 };
+unless eval { ExtUtils::MakeMaker->VERSION('6.52'); 1 };
 delete $WriteMakefileArgs{MIN_PERL_VERSION}
-    unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 };
+unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 };
 delete $WriteMakefileArgs{LICENSE}
-    unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 };
+unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 };
 
 WriteMakefile(%WriteMakefileArgs);

Proc-ProcessTable-InfoString/lib/Proc/ProcessTable/InfoString.pm

@@ -3,18 +3,19 @@ package Proc::ProcessTable::InfoString;
 use 5.006;
 use strict;
 use warnings;
+use Term::ANSIColor;
 
 =head1 NAME
 
-Proc::ProcessTable::InfoString - The great new Proc::ProcessTable::InfoString!
+Proc::ProcessTable::InfoString - Greats a PS like stat string showing various symbolic represenation of various flags/state as well as the wchan.
 
 =head1 VERSION
 
-Version 0.01
+Version 0.0.1
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.0.1';
 
 
 =head1 SYNOPSIS
@@ -24,29 +25,200 @@ Quick summary of what the module does.
 Perhaps a little code snippet.
 
     use Proc::ProcessTable::InfoString;
+    use Proc::ProcessTable;
 
-    my $foo = Proc::ProcessTable::InfoString->new();
+    my $is = Proc::ProcessTable::InfoString->new();
-    ...
 
-=head1 EXPORT
+    my $p = Proc::ProcessTable->new( 'cache_ttys' => 1 );
+    my $pt = $p->table;
 
-A list of functions that can be exported.  You can delete this section
+    foreach my $proc ( @{ $pt } ){
-if you don't export anything, such as for a purely object-oriented module.
+        print $proc->pid.' '.$is->info( $proc )."\n";
+    }
 
-=head1 SUBROUTINES/METHODS
+=head1 METHODS
 
-=head2 function1
+=head2 new
+
+This initiates the object.
+
+One argument is taken and that is a optional hash reference.
+
+=head3 args hash
+
+This will be passed to L<Term::ANSIColor>.
+
+If not specified, no ANSI color codes are used.
+
+The return string is terminated by a ANSI color reset character.
+
+=head4 flags_color
+
+The color to use for the flags section of the string.
+
+=head4 wchan_color
+
+The color to use for the wait channel section of the string.
 
 =cut
 
-sub function1 {
+sub new {
+	my %args;
+	if (defined($_[1])) {
+		%args= %{$_[1]};
+	}
+
+	my $self = {
+				};
+	bless $self;
+
+	my @args_feed=(
+				   'flags_color',
+				   'wchan_color',
+				   );
+
+	foreach my $feed ( @args_feed ){
+		$self->{$feed}=$args{$feed};
+	}
+
+	return $self;
 }
 
-=head2 function2
+=head2 info
 
 =cut
 
-sub function2 {
+sub info {
+	my $self=$_[0];
+	my $proc=$_[1];
+
+	# make sure we got the required bits for proceeding
+	if (
+		( ! defined( $proc ) ) ||
+		( ref( $proc ) ne 'Proc::ProcessTable::Process' )
+		){
+		return '';
+	}
+	my %flags;
+	$flags{is_session_leader}=0;
+	$flags{is_being_forked}=0;
+	$flags{working_on_exiting}=0;
+	$flags{has_controlling_terminal}=0;
+	$flags{is_locked}=0;
+	$flags{traced_by_debugger}=0;
+	$flags{is_stopped}=0;
+	$flags{is_kern_proc}=0;
+	$flags{posix_advisory_lock}=0;
+
+	if ( $^O =~ /freebsd/ ) {
+		if ( hex($proc->flags) & 0x00002 ) {
+			$flags{controlling_tty_active}=1;
+		}
+		if ( hex($proc->flags) & 0x00000002 ) {
+			$flags{is_session_leader}=1;
+		}
+		#if ( hex($proc->flags) &  ){$flags{is_being_forked}=1; }
+		if ( hex($proc->flags) & 0x02000 ) {
+			$flags{working_on_exiting}=1;
+		}
+		if ( hex($proc->flags) & 0x00002 ) {
+			$flags{has_controlling_terminal}=1;
+		}
+		if ( hex($proc->flags) & 0x00000004 ) {
+			$flags{is_locked}=1;
+		}
+		if ( hex($proc->flags) & 0x00800 ) {
+			$flags{traced_by_debugger}=1;
+		}
+		if ( hex($proc->flags) & 0x00001 ) {
+			$flags{posix_advisory_lock}=1;
+		}
+	}
+
+	my $info=$proc->{state};
+	if (
+		$info eq 'sleep'
+		) {
+		$info='S';
+	} elsif (
+			 $info eq 'zombie'
+			 ) {
+		$info='Z';
+	} elsif (
+			 $info eq 'wait'
+			 ) {
+		$info='W';
+	} elsif (
+			 $info eq 'run'
+			 ) {
+		$info='R';
+	}
+
+	#add initial color if needed
+	if ( defined( $self->{flags_color} ) ){
+		$info=color( $self->{flags_color} ).$info;
+	}
+
+	#checks if it is swapped out
+	if (
+		( $proc->{state} ne 'zombie' ) &&
+		( $proc->{rss} == '0' ) &&
+		( $flags{is_kern_proc} == '0' )
+		) {
+		$info=$info.'O';
+	}
+
+	#handles the various flags
+	if ( $flags{working_on_exiting} ) {
+		$info=$info.'E';
+	}
+	if ( $flags{is_session_leader} ) {
+		$info=$info.'s';
+	}
+	if ( $flags{is_locked} || $flags{posix_advisory_lock} ) {
+		$info=$info.'L';
+	}
+	if ( $flags{has_controlling_terminal} ) {
+		$info=$info.'+';
+	}
+	if ( $flags{is_being_forked} ) {
+		$info=$info.'F';
+	}
+	if ( $flags{traced_by_debugger} ) {
+		$info=$info.'X';
+	}
+
+	# adds the initial color reset if needed
+	if ( defined( $self->{flags_color} ) ){
+		$info=$info.color( 'reset' );
+	}
+	$info=$info.' ';
+
+
+	# adds the second color if needed
+	if ( defined( $self->{wchan_color} ) ){
+		$info=$info.color( $self->{wchan_color} );
+	}
+
+	# adds the wait channel
+	if ( $^O =~ /linux/ ) {
+		my $wchan='';
+		if ( -e '/proc/'.$proc->{pid}.'/wchan') {
+			open( my $wchan_fh, '<', '/proc/'.$proc->{pid}.'/wchan' );
+			$wchan=readline( $wchan_fh );
+			close( $wchan_fh );
+		}
+		$info=$info.$wchan;
+	} else {
+		$info=$info.$proc->{wchan};
+	}
+
+	# adds the second color reset if needed
+	if ( defined( $self->{wchan_color} ) ){
+		$info=$info.color( 'reset' );
+	}
+
+	return $info;
 }
 
 =head1 AUTHOR