segunda-feira, 22 de novembro de 2010

Prototype maker 2.0

There is no patter alignment anymore .. !

# Create the prototypes for all functions
# on a given C source file
use strict;
use warnings;

my @ctypes = qw(
    void
    unsigned 
    signed 
    long 
    short 
    int 
    float 
    double 
    struct 
    char
    static
    const
);

my @contents = <>;

for my $line (0 .. $#contents) {
    my $lref = \$contents[$line];
    my $prot = '';
    for my $type (@ctypes) {
        if ($$lref =~ /^$type/) {
             while ($contents[$line] !~ /\{/) { # seek for {
                $prot .= "$contents[$line++] ";
            }
            chop $prot;            # the last space
            $prot =~ s/\n//go;     # remove LFs 
            $prot =~ s/\w*,/, /go; # remove argument intentifiers
            $prot =~ s/\w*\)/)/go; # remove the last argument 
            $prot .= ';';           # append a semicolon 
            print $prot, "\n";
            next;
        }
    }
}

sábado, 20 de novembro de 2010

Perl script to generate basic prototypes..

Typedefs are not supported and you need to code your
functions with follow patter:
type
function_indetifier (list_of_parameters)
{ ... hereafter makes no difference

usage: cat souce.c | perl prot.pl > prots.txt
then copy and paste where you want...




# Create the prototypes for all functions
# on a given C source file
use strict;
use warnings;

my @ctypes = qw(
    unsigned 
    signed 
    long 
    short 
    int 
    float 
    double 
    struct 
    char
    static
    const
);

my @contents = <>;

for my $line (0 .. $#contents) {
    my $lref = \$contents[$line];
    my $prot = '';
    for (@ctypes) {
        if ($$lref =~ /^$_/) {    
            my $func = $contents[++$line];
            $func =~ s/\w*,/,/g;
            $func =~ s/\w*\)/)/g;
            $prot = "$$lref $func;";
            $prot =~ s/\n//g;
            print "$prot\n";
            next;
        }
    }
}
           
test: http://ideone.com/5tE0F
note: I will coment that hash implementation soon..

quarta-feira, 10 de novembro de 2010

Mini web server in perl (really small han?)

use strict;
use warnings;
use LWP;
use HTTP::Daemon;

# the parameters are 
# the user/group user to restrict permissions, the port (default 80)
# the local addres (default locahost)
# respectivaly
my ($userg, $port, $laddres) = @ARGV;
$userg or die 'You need to suply a nonroot user/group as first parameter'; 
my ($user, $group) = split ('/', $userg);

$port = 80 unless $port;
$laddres = 'localhost' unless $laddres;

my $server = new HTTP::Daemon (
    LocalAddr => $laddres,
    LocalPort => $port,
    Listen => 5,
    Reuse => 1,
) || die $!;

$> = getpwnam $user || die $!; 
$) = getgrnam $group || die $!; 


while (my $con = $server->accept()) {
    my $pid = fork();
    if (!$pid) { 
        my $req = $con->get_request();
        print $req->as_string();
        my $file = $req->url();
        $file =~ s/^.//g;    
        $con->send_file_response($file);
    } elsif ($pid) { next;  
    } else { print STDERR "fork: $!\n" };
}