XS-Framework

 view release on metacpan or  search on metacpan

lib/XS/Framework/Manual/SVAPI/Stash.pod  view on Meta::CPAN

This method creates new C<Object>, which is blessed into to the current package
(C<Stash>).

    Object bless (const Sv& what) const;

This C<bless> method version works somewhat similiar to the following Perl
construction

    my $class = ...;
    my $obj = ...;
    return bless $obj => $class;

i.e. if C<what> is already an object, it is blessed into the C<Stash>,
otherwise new C<RV*> created from the C<what> argument, and the
blessed object returned.

=head2 add_const_sub()

    void add_const_sub (const panda::string_view& name, const Sv& val);
    
Creates subroutine C<name> that returns constant C<val> eligible for compile-time inlining (like newCONSTSUB). C<val> is retained and made readonly.

lib/XS/Framework/Manual/Typemap.pod  view on Meta::CPAN

In that case SV* pointing to C<undef> is created, and it is blessed into the specified
package name. This is needed to follow standart Perl inheritance model, i.e. respect
when the current class might be derived in Perl or xs-adapter. In other words it
works similar to:

    package My::XXX;

    sub new {
        my $class = shift;
        my $obj = {};
        return bless $obj => $class;
    }

    package My::YYY;
    use base qw/My::XXX;

    my $obj_a = My::XXX->new;
    my $obj_b = My::YYY->new;

=item it might be already blessed Perl object

lib/XS/Framework/Manual/recipe07.pod  view on Meta::CPAN

=cut

=head1 C3 mixin introduction

Let's assume there is a Server with core functions defined in basic class.

    package MyBase {
        sub new {
            my $class = shift;
            return bless {} => $class;
        };
        sub on_client {
            my ($self, $client) = @_;
            print "MyBase::on_client\n";
            if ($client->{status} eq 'authorized'){ $client->{send} = '[welcome]' }
            elsif ($client->{status} eq 'not_authorized') { $client->{send} = '[disconnect]' };
        }
    }

The package is responsible for constructing object and send to client either
C<[welcome]> string upon successful login and C<[disconnect]> upon login falure.
It is desirable to have dedicated logging and authorizing components.

    package MyLogger {
        use base qw/MyBase/;    # (1)

        sub new {
            my $class = shift;
            my $obj = $class->next::method(@_) // {};   # (2)
            return bless $obj => $class;
        }
        sub on_client {
            my ($self, $client) = @_;
            print "MyLogger::on_client\n";  # (3)
            print "client ", $client->{id}, ", status = ", $client->{status}, "\n";
            $self->next::method($client);   # (4)
            print "client ", $client->{id}, ", status = ", $client->{status}, "\n";
        }
    }

    package MyAuth {
        use base qw/MyBase/;    # (5)

        sub new {
            my $class = shift;
            my $obj = $class->next::method(@_) // {};   # (6)
            return bless $obj => $class;
        }
        sub on_client {
            my ($self, $client) = @_;
            print "MyAuth::on_client\n";    # (7)
            if ($client->{id} < 0) { $client->{status} = 'not_authorized'; }
            else { $client->{status} = 'authorized'; }
            $self->next::method($client);   # (8)
        }
    };

t/cookbook/recipe07.t  view on Meta::CPAN

use strict;
use warnings;
BEGIN { require "./t/cookbook/TestCookbook.pm"; }

package MyBase {
    sub new {
        my $class = shift;
        return bless {} => $class;
    };
    sub on_client {
        my ($self, $client) = @_;
        print "MyBase::on_client\n";
        if ($client->{status} eq 'authorized'){ $client->{send} = '[welcome]' }
        elsif ($client->{status} eq 'not_authorized') { $client->{send} = '[disconnect]' };
    }
};

package MyLogger {
    use base qw/MyBase/;

    sub new {
        my $class = shift;
        my $obj = $class->next::method(@_) // {};
        return bless $obj => $class;
    }
    sub on_client {
        my ($self, $client) = @_;
        print "MyLogger::on_client\n";
        print "client ", $client->{id}, ", status = ", $client->{status}, "\n";
        $self->next::method($client);
        print "client ", $client->{id}, ", status = ", $client->{status}, "\n";
    }
};

package MyAuth {
    use base qw/MyBase/;

    sub new {
        my $class = shift;
        my $obj = $class->next::method(@_) // {};
        return bless $obj => $class;
    }
    sub on_client {
        my ($self, $client) = @_;
        print "MyAuth::on_client\n";
        if ($client->{id} < 0) { $client->{status} = 'not_authorized'; }
        else { $client->{status} = 'authorized'; }
        $self->next::method($client);
    }
};

package MyXServer {
    use base qw/MyLogger MyAuth MyBase/;
    sub new {
        my $class = shift;
        my $obj = $class->next::method(@_) // {};
        return bless $obj => $class;
    }
};

my $client = {status => 'connected', id => 10};
my $server = MyXServer->new;
$server->on_client($client);

print "\nLet's try in XS\n";

my $client2 = MyTest::Cookbook::Client07->new(10);

 view all matches for this distribution
 view release on metacpan -  search on metacpan