use 5.005; use ExtUtils::MakeMaker; use strict; my %interface = ( 'cpu' => [qw(flags total user nice sys idle frequency)], 'mem' => [qw(flags total used free shared buffer cached user locked)], 'proc_mem' => [qw(flags size vsize resident share rss rss_rlim)], 'proc_time' => [qw(flags start_time rtime utime stime cutime cstime timeout it_real_value frequency)], 'proc_map' => [qw(flags number total size)], 'proc_args' => [qw(flags size)], 'proc_uid' => [qw(flags uid:int euid:int gid:int egid:int pid:int ppid:int pgrp:int session:int tty:int tpgid:int priority:int nice:int)], 'map_entry' => [], 'swap' => [qw(flags total used free pagein pageout)], 'proc_segment' => [qw(flags text_rss shlib_rss data_rss stack_rss dirty_size start_code end_code start_stack)], 'proc_state' => [qw(flags)], 'netload' => [qw(flags if_flags mtu subnet address packets_in packets_out packets_total bytes_in bytes_out bytes_total errors_in errors_out errors_total collisions)], 'mountlist' => [qw(flags number total size)], 'proclist' => [qw(flags number total size)], 'mountentry' => [], 'fsusage' => [qw(flags blocks bfree bavail files ffree)], 'uptime' => [qw(flags)], 'loadavg' => [qw(flags nr_running nr_tasks last_pid)], ); open TYPEMAP, ">typemap.gtop" or die $!; open BOOTINC, ">gtop.boot" or die $!; open BOOTXS, ">gtopxs.boot" or die $!; open XS, ">xs.gtop" or die $!; open POD, ">GTop.pod" or die $!; open TEST, ">test.gtop" or die $!; print BOOTXS "static void boot_GTop_interface(void)\n{\n"; print TEST <<'EOF'; use strict; use ExtUtils::testlib; use GTop (); my $gtop = GTop->new; EOF print POD <new; =head1 DESCRIPTION Perl interface to libgtop: http://home-of-linux.org/gnome/libgtop/ =head1 CLASSES EOF my %constructors = map {$_,1} qw(mountlist proclist proc_map mountentry proc_args map_entry); my %notunion = map {$_,1} qw(mountentry map_entry); use constant IS_SOLARIS => $^O eq 'solaris'; for my $if (sort keys %interface) { local *FH; (my $leaf = $if) =~ s/_(.)/uc $1/e; my $class = sprintf "GTop::%s", ucfirst $leaf; (my $typedef = $class) =~ s/:/_/g; print BOOTXS " boot_GTop_$if();\n"; print TYPEMAP "$class\tT_PTROBJ\n"; print BOOTINC "typedef glibtop_$if * $typedef;\n"; print BOOTINC qq(\#include "$if.boot"\n); my(@args) = ('','','','()'); if ($if =~ /^proc_/) { @args = (', pid', 'pid_t pid', '($pid)', '($$)'); } elsif ($if =~ /^netload/) { @args = (', interface', 'char * interface', '($interface)', '(\'eth0\')'); } elsif ($if =~ /^mountlist/) { @args = (', all_fs', 'int all_fs', '($all_fs)', '(1)'); } elsif ($if =~ /^fsusage/) { @args = (', disk', 'char *disk', '($disk)', '(\'/\')'); } print XS <$if$args[3]; print "$if\\n"; for (qw(@{ $interface{$if} })) { s/:\\w+\$//; printf " %s => %d\\n", \$_, \$$if->\$_(); } EOF unless ($notunion{$if}) { print POD "\n=head2 $class\n"; print POD "\n my \$$if = \$gtop->$if$args[2];\n\n"; print POD "=over 4\n"; } open FH, ">$if.boot" or die $!; if (IS_SOLARIS) { for my $entry (@{ $interface{$if} }) { my $type = 'u_int64_t'; if ($entry =~ s/:(\w+)$//) { $type = $1; } my $field = $entry; my $xsname = "XS_glibtop_${if}_$field"; print FH <$field)); XSRETURN(1); } EOF } } print FH "static void boot_GTop_$if (void)\n{\n"; for my $entry (@{ $interface{$if} }) { my $type = 'u_int64_t'; if ($entry =~ s/:(\w+)$//) { $type = $1; } my $field = $entry; my $method = join '::', $class, $field; my $xsname = "XS_glibtop_${if}_$field"; if (IS_SOLARIS) { print FH qq{ newXS("$method", $xsname, __FILE__);\n}; } else { print FH qq{ newGTopXS_$type("$method", glibtop_$if, $field);\n}; } unless ($notunion{$if}) { print POD "\n=item $field\n\n"; print POD " my \$$field = \$$if->$field;\n"; } } print FH qq{ newXS("$class\::DESTROY", XS_GTop_destroy, __FILE__);\n} unless $notunion{$if}; print FH "\n}\n"; print POD "\n=back\n" unless $notunion{$if}; } print BOOTXS "\n}\n"; print POD < '-g', CC => 'insure gcc', LD => 'insure gcc', ); } WriteMakefile( @insure, NAME => 'GTop', VERSION_FROM => 'GTop.pm', INC => $GTOP_INCLUDE . $ginc, LIBS => [$GTOP_LIB . "-lgtop -lgtop_sysdeps -lgtop_common -lglib $xlibs"], TYPEMAPS => [qw(typemap.gtop typemap)], clean => { FILES => "@{[<*.boot>, <*.gtop>]}", }, 'macro' => { CVSROOT => 'modperl.com:/local/cvs_repository', }, ); sub MY::postamble { return <<'EOF'; cvs_tag : cvs -d $(CVSROOT) tag v$(VERSION_SYM) . @echo update GTop.pm VERSION now EOF }