The Labs.Com Issue_08_SWIG

TPJ: Issue_08_SWIG

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

1. Makefile
2. elapsed-1.tmp
3. elapsed-2.tmp
4. elapsed-3.tmp
5. elapsed-a.pl
6. elapsed-b.pl
7. elapsed.c
8. elapsed.pm
9. elapsed_wrap.doc
10. gettime-1.tmp
11. gettime-2.tmp
12. gettime-3.tmp
13. gettime-a.pl
14. gettime-b.pl
15. gettime.i
16. gettime.pm
17. gettime_wrap.doc
18. greet.pl
19. hello.c
20. hello.pm
21. hello_wrap.doc
22. pull_section.pl
23. pull_sub.pl
24. sample1.txt
25. sample2.txt
26. test1.pl
27. test2.pl
28. test3.pl
29. top-1.tmp
30. top.i
31. top.pm
32. top_wrap.doc
33. More Samples on SWIG

Makefile

Issue_08_SWIG 2. elapsed-1.tmp

elapsed-1.tmp

Issue_08_SWIG 3. elapsed-2.tmp

elapsed-2.tmp

Issue_08_SWIG 4. elapsed-3.tmp

elapsed-3.tmp

Issue_08_SWIG 5. elapsed-a.pl

Download elapsed-a.pl

#!/usr/local/bin/perl -w

use strict;

use elapsed;

if (0) {

my $a = elapsed::elapsed_seconds();

sleep(1);

my $b = elapsed::elapsed_seconds();

sleep(1);

my $c = elapsed::elapsed_seconds();

printf("a is %g.\n", $a);

printf("b is %g.\n", $b);

printf("c is %g.\n", $c);

}

my $max = @ARGV ? shift : 3000;

for(0..$max) {

printf("%4d: loop time is %g.\n", $_, elapsed::elapsed_seconds\

());

}

Issue_08_SWIG 6. elapsed-b.pl

Download elapsed-b.pl

#!/usr/bin/perl -w

#

# Use the first N elements of the Fibonacci sequence to approximate

# the Golden Mean.

#

use strict;

use elapsed;

my $before = elapsed::elapsed_seconds();

my $N = @ARGV ? shift : 20;        # Take either the first argument or\

20.

my ($n1, $n2) = (1, 1);

printf("%2d:  %10d\n", 1, $n1);

printf("%2d:  %10d  %.10g\n", 2, $n2, $n2/$n1);

for (3..$N) {

($n1, $n2) = ($n2, $n1 + $n2);

printf("%2d:  %10d  %.10g\n", $_, $n2, $n2/$n1);

}

my $after = elapsed::elapsed_seconds();

printf("Elapsed time is %g seconds.\n", $after - $before);

Issue_08_SWIG 7. elapsed.c

Download elapsed.c

#include <sys/time.h>

/*

Return the number of seconds since the first time elapsed_seconds()

was called.

*/

float

elapsed_seconds(void)

{

static struct timeval then = {0, 0};

struct timeval  now;

/*

* The first time we're called note the time and then return 0\

.

*/

if (then.tv_sec == 0) {

(void) gettimeofday(&then, 0);

return (0);

}

/*

* On subsequent calls return the elapsed time as a floating p\

oint

* number.

*/

(void) gettimeofday(&now, 0);

return (now.tv_sec - then.tv_sec

+ (now.tv_usec - then.tv_usec) / 1000000.0);

}

Issue_08_SWIG 8. elapsed.pm

Download elapsed.pm

# This file was automatically generated by SWIG

package elapsed;

require Exporter;

require DynaLoader;

@ISA = qw(Exporter DynaLoader);

package elapsedc;

bootstrap elapsed;

var_elapsed_init();

@EXPORT = qw( );

# ---------- BASE METHODS -------------

package elapsed;

sub TIEHASH {

my ($classname,$obj) = @_;

return bless $obj, $classname;

}

sub CLEAR { }

# ------- FUNCTION WRAPPERS --------

package elapsed;

*elapsed_seconds = *elapsedc::elapsed_seconds;

# ------- VARIABLE STUBS --------

package elapsed;

1;

Issue_08_SWIG 9. elapsed_wrap.doc

elapsed_wrap.doc

Issue_08_SWIG 10. gettime-1.tmp

gettime-1.tmp

Issue_08_SWIG 11. gettime-2.tmp

gettime-2.tmp

Issue_08_SWIG 12. gettime-3.tmp

gettime-3.tmp

Issue_08_SWIG 13. gettime-a.pl

Download gettime-a.pl

#!/usr/bin/perl -w

use gettime;

my $tv  = new timeval();                # Allocate a timeval structure

gettime::gettimeofday($tv, undef)       # Note undef maps to a null po\

inter

&& warn("gettimeofday() failed, errno = $gettime::errn\

o.\n");

printf("Time is %d.%06d\n",

$tv->{tv_sec},          # It is the shadow option that allo\

ws these

$tv->{tv_usec});        # symbolic references to structure \

fields.

Issue_08_SWIG 14. gettime-b.pl

Download gettime-b.pl

#!/usr/bin/perl -w

use gettime;

my $tv  = new timeval();                # Allocate timeval structure.

$tv->{tv_sec} = $tv->{tv_usec} = 0;        # Turn back the clock\

.

if (gettime::settimeofday($tv, undef)) {# Will fail unless running as \

root

warn("settimeofday() failed, errno = $gettime::errno.\n");

$gettime::errno = 0;                # This will fail since it \

is readonly

}

Issue_08_SWIG 15. gettime.i

gettime.i

Issue_08_SWIG 16. gettime.pm

Download gettime.pm

# This file was automatically generated by SWIG

package gettime;

require Exporter;

require DynaLoader;

@ISA = qw(Exporter DynaLoader);

package gettimec;

bootstrap gettime;

var_gettime_init();

@EXPORT = qw( );

# ---------- BASE METHODS -------------

package gettime;

sub TIEHASH {

my ($classname,$obj) = @_;

return bless $obj, $classname;

}

sub CLEAR { }

############# Class : timeval ##############

package timeval;

@ISA = qw( gettime );

%OWNER = ();

%BLESSEDMEMBERS = (

);

%ITERATORS = ();

sub new {

my $self = shift;

my @args = @_;

$self = gettimec::new_timeval(@args);

return undef if (!defined($self));

bless $self, "timeval";

$OWNER{$self} = 1;

my %retval;

tie %retval, "timeval", $self;

return bless \%retval,"timeval";

}

sub DESTROY {

my $self = tied(%{$_[0]});

delete $ITERATORS{$self};

if (exists $OWNER{$self}) {

gettimec::delete_timeval($self);

delete $OWNER{$self};

}

}

sub DISOWN {

my $self = shift;

my $ptr = tied(%$self);

delete $OWNER{$ptr};

};

sub ACQUIRE {

my $self = shift;

my $ptr = tied(%$self);

$OWNER{$ptr} = 1;

};

sub FETCH {

my ($self,$field) = @_;

my $member_func = "gettimec::timeval_${field}_get";

my $val = &$member_func($self);

if (exists $BLESSEDMEMBERS{$field}) {

return undef if (!defined($val));

my %retval;

tie %retval,$BLESSEDMEMBERS{$field},$val;

return bless \%retval, $BLESSEDMEMBERS{$field};

}

return $val;

}

sub STORE {

my ($self,$field,$newval) = @_;

my $member_func = "gettimec::timeval_${field}_set";

if (exists $BLESSEDMEMBERS{$field}) {

&$member_func($self,tied(%{$newval}));

} else {

&$member_func($self,$newval);

}

}

sub FIRSTKEY {

my $self = shift;

$ITERATORS{$self} = ['tv_sec', 'tv_usec', ];

my $first = shift @{$ITERATORS{$self}};

return $first;

}

sub NEXTKEY {

my $self = shift;

$nelem = scalar @{$ITERATORS{$self}};

if ($nelem > 0) {

my $member = shift @{$ITERATORS{$self}};

return $member;

} else {

$ITERATORS{$self} = ['tv_sec', 'tv_usec', ];

return ();

}

}

############# Class : timezone ##############

package timezone;

@ISA = qw( gettime );

%OWNER = ();

%BLESSEDMEMBERS = (

);

%ITERATORS = ();

sub new {

my $self = shift;

my @args = @_;

$self = gettimec::new_timezone(@args);

return undef if (!defined($self));

bless $self, "timezone";

$OWNER{$self} = 1;

my %retval;

tie %retval, "timezone", $self;

return bless \%retval,"timezone";

}

sub DESTROY {

my $self = tied(%{$_[0]});

delete $ITERATORS{$self};

if (exists $OWNER{$self}) {

gettimec::delete_timezone($self);

delete $OWNER{$self};

}

}

sub DISOWN {

my $self = shift;

my $ptr = tied(%$self);

delete $OWNER{$ptr};

};

sub ACQUIRE {

my $self = shift;

my $ptr = tied(%$self);

$OWNER{$ptr} = 1;

};

sub FETCH {

my ($self,$field) = @_;

my $member_func = "gettimec::timezone_${field}_get";

my $val = &$member_func($self);

if (exists $BLESSEDMEMBERS{$field}) {

return undef if (!defined($val));

my %retval;

tie %retval,$BLESSEDMEMBERS{$field},$val;

return bless \%retval, $BLESSEDMEMBERS{$field};

}

return $val;

}

sub STORE {

my ($self,$field,$newval) = @_;

my $member_func = "gettimec::timezone_${field}_set";

if (exists $BLESSEDMEMBERS{$field}) {

&$member_func($self,tied(%{$newval}));

} else {

&$member_func($self,$newval);

}

}

sub FIRSTKEY {

my $self = shift;

$ITERATORS{$self} = ['tz_minuteswest', 'tz_dsttime', ];

my $first = shift @{$ITERATORS{$self}};

return $first;

}

sub NEXTKEY {

my $self = shift;

$nelem = scalar @{$ITERATORS{$self}};

if ($nelem > 0) {

my $member = shift @{$ITERATORS{$self}};

return $member;

} else {

$ITERATORS{$self} = ['tz_minuteswest', 'tz_dsttime', ];

return ();

}

}

# ------- FUNCTION WRAPPERS --------

package gettime;

sub gettimeofday {

my @args = @_;

$args[0] = tied(%{$args[0]});

$args[1] = tied(%{$args[1]});

my $result = gettimec::gettimeofday(@args);

return $result;

}

sub settimeofday {

my @args = @_;

$args[0] = tied(%{$args[0]});

$args[1] = tied(%{$args[1]});

my $result = gettimec::settimeofday(@args);

return $result;

}

# ------- VARIABLE STUBS --------

package gettime;

*errno = *gettimec::errno;

1;

Issue_08_SWIG 17. gettime_wrap.doc

gettime_wrap.doc

Issue_08_SWIG 18. greet.pl

Download greet.pl

#!/usr/local/bin/perl -w

use strict;

use hello;

printf("The DEFAULT constant is \"%s\".\n", $hello::DEFAULT);

hello::greeting(0);

hello::greeting(1);

hello::greeting(2);

$hello::subject = "oyster";

hello::greeting(3);

hello::greeting('a');

Issue_08_SWIG 19. hello.c

Download hello.c

#include <stdio.h>

#define        DEFAULT        "world"        /* The default subject */

char *subject = 0;        /* A user defined subject */

void

greeting(unsigned number)

{

char        *whom = subject ? subject : DEFAULT;

switch(number) {

case 0:

printf("Hello\n");

break;

case 1:

printf("Hello %s\n", whom);

break;

default:

printf("Hello %ss\n", whom);

break;

}

}

Issue_08_SWIG 20. hello.pm

Download hello.pm

# This file was automatically generated by SWIG

package hello;

require Exporter;

require DynaLoader;

@ISA = qw(Exporter DynaLoader);

package helloc;

bootstrap hello;

var_hello_init();

@EXPORT = qw( );

# ---------- BASE METHODS -------------

package hello;

sub TIEHASH {

my ($classname,$obj) = @_;

return bless $obj, $classname;

}

sub CLEAR { }

# ------- FUNCTION WRAPPERS --------

package hello;

*greeting = *helloc::greeting;

# ------- VARIABLE STUBS --------

package hello;

*DEFAULT = *helloc::DEFAULT;

*subject = *helloc::subject;

1;

Issue_08_SWIG 21. hello_wrap.doc

hello_wrap.doc

Issue_08_SWIG 22. pull_section.pl

Download pull_section.pl

#!/usr/bin/perl -w

use strict;

my $sect = shift;

die("Must provide a section name on the command line.\n")        unles\

s $sect;

my $echo = 0;

while(<>) {

$echo = 0        if /^#\s*SECTION/;

print if $echo;

$echo = 1        if /^#\s*SECTION\s*=\s*$sect\b/;

}

Issue_08_SWIG 23. pull_sub.pl

Download pull_sub.pl

#!/usr/bin/perl -w

use strict;

my $sub = shift;

die("Must provide a subroutine name on the command line.\n")        un\

less $sub;

my $echo = 0;

while(<>) {

$echo = 1        if /^sub\s+$sub\b/;

print if $echo;

$echo = 0        if /^}/;

}

Issue_08_SWIG 24. sample1.txt

sample1.txt

Issue_08_SWIG 25. sample2.txt

sample2.txt

Issue_08_SWIG 26. test1.pl

Download test1.pl

#!/usr/local/bin/perl -w

use strict;

use top;

my $clear = "\n";

if (@ARGV && $ARGV[0] =~ /-c/) {

$clear = `clear`;

}

my($statics) = new statics();

my($si)             = new system_info();

my($ps)             = new process_select();

$ps->{idle}     =  1;

$ps->{"system"} =  0;

$ps->{uid}      = -1;

my $r = top::machine_init($statics);

print("machine_init($statics) => $r.\n");

hash_dump("statics", $statics);

my(@procstates) = names($statics->{procstate_names});

my(@cpustates)  = names($statics->{cpustate_names});

my(@swap)       = names($statics->{swap_names});

my(@memory)     = names($statics->{memory_names});

top::get_system_info($si);

for (0 .. 200000) {

sleep(1);

top::get_system_info($si);

my $handle = top::get_process_info($si, $ps);

if (0) {

hash_dump("system info", $si);

} else {

print $clear;

}

#

# Here is the load average

#

print("load averages");

for my $i (0 .. 2) {

my $value = top::ptrvalue($si->{load_avg},$i);

printf("%s %5.2f", $i == 0 ? ":" : ",", $value);

}

printf("\t\t\t\t       %2d:%02d:%02d\n", reverse((localtime())\

[0..2]));

#

# Proc states.

#

printf("%d processes: ", $si->{p_total});

for my $i (0 .. $#procstates) {

my $value = top::ptrvalue($si->{procstates},$i);

next        unless $value;

printf("%d%s", $value, $procstates[$i]);

}

print("\n");

#

# Take care of cpu states.

#

my $sum = 0;

for my $i (0 .. $#cpustates) {

$sum += top::ptrvalue($si->{cpustates}, $i);

}

$sum /= 100.0;

for my $i (0 .. $#cpustates) {

my $percent = top::ptrvalue($si->{cpustates},$i)/$s\

um;

my $value   = $percent == 100.0

? "100"

: sprintf("%4.1f", $percent);

printf("%s %4s%% %s",

$i == 0 ? "CPU states:" : ",", $value,

$cpustates[$i]);

}

print("\n");

#

# Here comes memory information.

#

print("Mem: ");

for my $i (0 .. $#memory) {

my $value = top::ptrvalue($si->{memory},$i);

next        if $value == 0;

print(memfix("$value$memory[$i]"));

}

print("\n");

#

# Now for swap information.

#

print("Swap: ");

for my $i (0 .. $#swap) {

my $value = top::ptrvalue($si->{swap},$i);

next        if $value == 0;

print(memfix("$value$swap[$i]"));

}

print("\n");

print("    ", top::full_format_header("USERNAME"), "\n");

for my $p (1 .. $si->{p_total}) {

printf("%2d: %s\n",

$p, top::full_format_next_process($handle));

}

}

sub memfix ($) {

my $label = shift;

if ( $label =~ m/(\d+)K/ && $1 > 8192 ) {

my $M = int($1 / 1024);

$label =~ s#$1K#${M}M#;

}

return $label;

}

sub names ($) {

my $ref   = shift;

my @names = ();

for my $i (0..100) {

my $val = top::ptrvalue($ref, $i);

last if $val eq "NULL";

push(@names, $val);

}

return(@names);

}

sub hash_dump ($$) {

my $name = shift;

my $href = shift;

printf("$name is $href.\n");

my $key;

for $key (sort(keys(%$href))) {

my $ref = ref($href->{$key});

if ($ref eq "ARRAY") {

printf("   %-16s (%s)\n", $key,

join(", ", @{$href->{$key}}));

} elsif ($ref eq "charPtrPtr") {

printf("   %-16s %s:\n", $key, $href->{$key\

});

for my $i (0..20) {

my $val = top::ptrvalue($href->{$ke\

y},$i);

last if $val eq "NULL";

printf("    %2d: \"%s\"\n", $i, $val);

}

} else {

printf("   %-16s %s\n", $key, $href->{$key}\

);

}

}

}

Issue_08_SWIG 27. test2.pl

Download test2.pl

#!/usr/local/bin/perl -w

use strict;

use top;

#

# Create instances of the data structures that we'll be using.

#

my($statics) = new statics();                # contains field names

my($si)             = new system_info();        # contains field data

my($ps)             = new process_select();        # contains array of\

process listings

$ps->{idle}     =  1;

$ps->{"system"} =  0;

$ps->{uid}      = -1;

#

# Initialize the machine characteristics structure

# and pull the field names for later use. The

# routine name() pulls strings from the array until

# NULL is encountered.

#

top::machine_init($statics);

my(@procstates) = names($statics->{procstate_names});

my(@cpustates)  = names($statics->{cpustate_names});

my(@memory)     = names($statics->{memory_names});

top::get_system_info($si);

for (0 .. 60) {

sleep(1);

top::get_system_info($si);

my $handle = top::get_process_info($si, $ps);

#

# Here is the load average

#

print("load averages");

for my $i (0 .. 2) {

my $value = top::ptrvalue($si->{load_avg},$i);

printf("%s %5.2f", $i == 0 ? ":" : ",", $value);

}

printf("\t\t\t\t       %2d:%02d:%02d\n", reverse((localtime())\

[0..2]));

#

# Proc states.

#

printf("%d processes: ", $si->{p_total});

for my $i (0 .. $#procstates) {

my $value = top::ptrvalue($si->{procstates},$i);

printf("%d%s", $value, $procstates[$i])        if $val\

ue;

}

print("\n");

#

# Take care of cpu states.

#

my $sum = 0;

for my $i (0 .. $#cpustates) {

$sum += top::ptrvalue($si->{cpustates}, $i);

}

$sum /= 100.0;

for my $i (0 .. $#cpustates) {

my $percent = top::ptrvalue($si->{cpustates},$i)/$s\

um;

my $value   = $percent == 100.0

? "100"

: sprintf("%4.1f", $percent);

printf("%s %4s%% %s",

$i == 0 ? "CPU states:" : ",", $value,

$cpustates[$i]);

}

print("\n");

#

# Here comes memory information.

#

print("Mem:  ");

for my $i (0 .. $#memory) {

my $value = top::ptrvalue($si->{memory},$i);

print("$value$memory[$i]")        if $value;

}

print("\n");

print("    ", top::full_format_header("USERNAME"), "\n");

for my $p (1 .. $si->{p_total}) {

printf("%2d: %s\n",

$p, top::full_format_next_process($handle));

}

}

sub names ($) {

my $ref   = shift;

my @names = ();

for my $i (0..100) {

my $val = top::ptrvalue($ref, $i);

last if $val eq "NULL";

push(@names, $val);

}

return(@names);

}

Issue_08_SWIG 28. test3.pl

Download test3.pl

#!/usr/local/bin/perl -w

use strict;

use top;        # treated like any other module

sub memfix ($) {

my $label = shift;

if ( $label =~ m/(\d+)K/ && $1 > 8192 ) {

my $M = int($1 / 1024);

$label =~ s#$1K#${M}M#;

}

return $label;

}

sub names ($) {

my $ref          = shift;

my @names = ();

for(my $i = 0; 1; $i++) {

my $val = top::ptrvalue($ref, $i);

last if $val eq "NULL";

push(@names, $val);

}

return(@names);

}

# SECTION = INIT

my $clear = `clear`;

my($statics) = new statics();                # contains the OS specifi\

c field names

my($si)             = new system_info();        # contains the raw sys\

tem information

my($ps)             = new process_select();        # used to store pro\

cess information

$ps->{idle}        =  1;

$ps->{"system"} =  0;

$ps->{uid}        = -1;

#

#        Get the field names and extract them from their respective

#        null-terminated lists.

#

top::machine_init($statics);

my(@procstates) = names($statics->{procstate_names});

my(@cpustates)        = names($statics->{cpustate_names});

my(@memory)        = names($statics->{memory_names});

# SECTION = LOOP

#

# For 60 seconds we will emulate top's basic display.

#

top::get_system_info($si);

for (0 .. 60) {

sleep(1);

#

# Get the info and clear the screen

#

top::get_system_info($si);

my $handle = top::get_process_info($si, $ps);

print $clear;

#

# Print the load average line

# "load averages:  0.02,  0.05,         0.01                  \

20:43:09"

#

print("load averages");

for my $i (0 .. 2) {

my $value = top::ptrvalue($si->{load_avg},$i);

printf("%s %5.2f", $i == 0 ? ":" : ",", $value);

}

printf("\t\t\t\t       %2d:%02d:%02d\n", reverse((localtime())\

[0..2]));

#

# Proc states.

# "34 processes: 1 running, 32 sleeping, 1 stopped,"

#

printf("%d processes: ", $si->{p_total});

for my $i (0 .. $#procstates) {

my $value = top::ptrvalue($si->{procstates},$i);

next        unless $value;

printf("%d%s", $value, $procstates[$i]);

}

print("\n");

#

# Take care of cpu states.

# "CPU states:        2.3% user,  0.0% nice,        1.5% syste\

m,  0.0% interrupt, 96.2% idle"

#

my $sum = 0;

for my $i (0 .. $#cpustates) {

$sum += top::ptrvalue($si->{cpustates}, $i);

}

$sum /= 100.0;

for my $i (0 .. $#cpustates) {

my $percent = top::ptrvalue($si->{cpustates},$i)/$s\

um;

my $value   = $percent == 100.0

? "100"

: sprintf("%4.1f", $percent);

printf("%s %4s%% %s",

$i == 0 ? "CPU states:" : ",", $value,

$cpustates[$i]);

}

print("\n");

#

# Here comes memory information.

# "Mem: 25M Active, 3752K Inact, 14M Wired, 8M Cache, 7323K Bu\

f, 8M Free"

#

print("Mem: ");

for my $i (0 .. $#memory) {

my $value = top::ptrvalue($si->{memory},$i);

next        if $value == 0;

print(memfix("$value$memory[$i]"));

}

print("\n");

#

# Now for the process listings.

# "29938 root     28   0  1204K  1648K RUN      0:00 20.31%  0\

.99% perl"

#

print("\n");

print(top::full_format_header("USERNAME"), "\n");

for my $p (1 .. $si->{p_total}) {

print(top::full_format_next_process($handle), "\n");

}

}

Issue_08_SWIG 29. top-1.tmp

top-1.tmp

Issue_08_SWIG 30. top.i

top.i

Issue_08_SWIG 31. top.pm

Download top.pm

# This file was automatically generated by SWIG

package top;

require Exporter;

require DynaLoader;

@ISA = qw(Exporter DynaLoader);

package topc;

bootstrap top;

var_top_init();

@EXPORT = qw( );

# ---------- BASE METHODS -------------

package top;

sub TIEHASH {

my ($classname,$obj) = @_;

return bless $obj, $classname;

}

sub CLEAR { }

############# Class : statics ##############

package statics;

@ISA = qw( top );

%OWNER = ();

%BLESSEDMEMBERS = (

);

%ITERATORS = ();

sub new {

my $self = shift;

my @args = @_;

$self = topc::new_statics(@args);

return undef if (!defined($self));

bless $self, "statics";

$OWNER{$self} = 1;

my %retval;

tie %retval, "statics", $self;

return bless \%retval,"s