Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

PlusPlus.pm

by Anonymous Monk
on Jan 08, 2001 at 19:21 UTC ( #50490=sourcecode: print w/replies, xml ) Need Help??
Category: Syntax
Author/Contact Info Dmitry Ovsyanko, do@rambler.ru
Description: This is an OO preprocessor for Perl. It features the class definitions, 'with' statement and many more...
package PlusPlus;
 
use strict;
use Carp;
use vars qw($VERSION);
 
$VERSION = '1.10';
 
use Filter::Util::Call;
 
sub import {
    my ($type) = @_;
    filter_add (bless {oo => 'none', export => [], export_ok => [], is
+a => ['Exporter']});
}
 
sub filter {
    my $self = shift;
    $_ = translate_oneline ($_, $self) if my ($status) = filter_read (
+);
    unless ($status) {
        if ($self -> {oo} eq 'none') {
            return 0;
        } else {
            $_ = '';
            $_ .= 'sub new {my $class = shift; my $self = {}; bless ($
+self, $class); eval {init (@_)}; return $self}; ';
            $_ .= '@ISA = qw(' . join (' ', @{$self -> {isa}})  . '); 
+@EXPORT = qw(' . join (' ', @{$self -> {export}}) . '); @EXPORT_OK = 
+qw('
. join (' ', @{$self -> {export_ok}}) . "); 1;\n";
            $self -> {oo} = 'none';
            return 1;
        }
    }
    return $status;
}
 
sub list_to_nested_hashes {
 my $parts = shift;
 my $str = shift @$parts;
 foreach (@$parts) { $str = "\$\{$str\}\{'$_'\}" };
 return $str;
};
 
sub list_to_method {
    my $parts = shift;
    my $str = shift @$parts;
    my $method = pop @$parts;
    $str .= ' -> ';
    $str .= join (' -> ', (map {"{'$_'}"} @$parts)) . ' -> ' if @$part
+s;
    $str .= $method;
    return $str;
};
 
sub code_parse_fields_and_methods {
    return 0 unless shift =~ /([\$]\w+)(\.\$?\w+)+|\$\.\w+(\.\$?\w+)*/
+;
    my $r =  {pre => $`, match => $&, post => $'};
    my @parts = split (/\./, $r -> {match});
    $r -> {parts} = \@parts;
 package PlusPlus;
 
use strict;
use Carp;
use vars qw($VERSION);
 
$VERSION = '1.10';
 
use Filter::Util::Call;
 
sub import {
    my ($type) = @_;
    filter_add (bless {oo => 'none', export => [], export_ok => [], is
+a => ['Exporter']});
}
 
sub filter {
    my $self = shift;
    $_ = translate_oneline ($_, $self) if my ($status) = filter_read (
+);
    unless ($status) {
        if ($self -> {oo} eq 'none') {
            return 0;
        } else {
            $_ = '';
            $_ .= 'sub new {my $class = shift; my $self = {}; bless ($
+self, $class); eval {init (@_)}; return $self}; ';
            $_ .= '@ISA = qw(' . join (' ', @{$self -> {isa}})  . '); 
+@EXPORT = qw(' . join (' ', @{$self -> {export}}) . '); @EXPORT_OK = 
+qw('
. join (' ', @{$self -> {export_ok}}) . "); 1;\n";
            $self -> {oo} = 'none';
            return 1;
        }
    }
    return $status;
}
 
sub list_to_nested_hashes {
 my $parts = shift;
 my $str = shift @$parts;
 foreach (@$parts) { $str = "\$\{$str\}\{'$_'\}" };
 return $str;
};
 
sub list_to_method {
    my $parts = shift;
    my $str = shift @$parts;
    my $method = pop @$parts;
    $str .= ' -> ';
    $str .= join (' -> ', (map {"{'$_'}"} @$parts)) . ' -> ' if @$part
+s;
    $str .= $method;
    return $str;
};
 
sub code_parse_fields_and_methods {
    return 0 unless shift =~ /([\$]\w+)(\.\$?\w+)+|\$\.\w+(\.\$?\w+)*/
+;
    my $r =  {pre => $`, match => $&, post => $'};
    my @parts = split (/\./, $r -> {match});
    $r -> {parts} = \@parts;
    return $r;
};
 
sub code_translate_fields_and_methods {
    my $src_line = shift;
    while (1) {
        last unless (my $parsed = code_parse_fields_and_methods ($src_
+line));
        my $str = ($parsed -> {post} =~ /^\s*\(/ ?
            list_to_method ($parsed -> {parts}) :
            list_to_nested_hashes ($parsed -> {parts})
        );
        $src_line = $parsed -> {pre} . $str . $parsed -> {post}
    }
    return $src_line;
};
 
sub code_translate_fields_and_methods {
    my $src_line = shift;
    while (1) {
        last unless (my $parsed = code_parse_fields_and_methods ($src_
+line));
        my $str = ($parsed -> {post} =~ /^\s*\(/ ?
            list_to_method ($parsed -> {parts}) :
            list_to_nested_hashes ($parsed -> {parts})
        );
        $src_line = $parsed -> {pre} . $str . $parsed -> {post}
    }
    return $src_line;
};
 
sub translate_oneline {
    local $_ = shift;
    my $cntxt = shift;
 
    if (s/class\s+([\w\:]+)\s*(\([^\)]+\))?\s*\;/package $1; use Expor
+ter; use vars qw(\@ISA \@EXPORT \@EXPORT_OK);/) {
        $cntxt -> {oo} = 'class';
        foreach my $ancestor (split /,/, $2) {
            $ancestor =~ s /[\s\(\)]//g;
            push @{$cntxt -> {isa}}, $ancestor;
        }
    }
 
    if (s/module\s+([\w\:]+)\s*(\([^\)]+\))?\s*\;/package $1; use Expo
+rter; use vars qw(\@ISA \@EXPORT \@EXPORT_OK);/) {
        $cntxt -> {oo} = 'module';
        foreach my $ancestor (split /,/, $2) {
            $ancestor =~ s /[\s\(\)]//g;
            push @{$cntxt -> {isa}}, $ancestor;
        }
    }
 
    s/method\s+(\w+)\s*\{/sub $1 { my \$self = shift; my \$__with__pre
+fix__ = \$self; /;
 
    if (s/(export_ok|export)\s+sub\s+(\w+)/sub $2/) {
        my $name = $2;
        push @{$cntxt -> {export_ok}}, $name if ($1 eq 'export_ok');
        push @{$cntxt -> {export}},    $name if ($1 eq 'export');
    }
 
    s/new\s+([\w\:]+)/ $1 -> new/g;
    s/with([^\{]+)\{/do { my \$__with__prefix__ = $1\;/g;
    s/\$\./\$__with__prefix__\./g;
    code_translate_fields_and_methods ($_);
};
Replies are listed 'Best First'.
Downvotes with No Comments (Was Re: PlusPlus.pm)
by salvadors (Pilgrim) on Jan 14, 2001 at 17:58 UTC

    So, why exactly does this have a Rep of -7?

    Surely at least one of the people downvoting it could have posted something saying "This is bad, because ...."?

    Is it just because no-one can understand what this does? Or because it it's a really longwinded way of doing nothing|something standard|somethign that can be done much easier|something on CPAN? Or because it's a security risk? Or what?

    Or is it just because someone voted it down, it appeared in Worst Nodes, and some other people thought, "That must be bad, I'll vote it down too"?

    If something is really bad, and just gets downvoted with no comments, then most readers won't realise, as you can't see the reputation until you've voted, or unless you visit Worst Nodes.

    I don't think there should be a rule that says you can't downvote without a comment, but I'd maybe say that the first person to downvote should have to explain why. Or at least something that stops something getting to -7 without anyone having responded to the post at all.

    Tony

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://50490]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (1)
As of 2022-07-03 00:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My most frequent journeys are powered by:









    Results (103 votes). Check out past polls.

    Notices?