MOON
Server: Apache
System: Linux server1.studioinfinity.com.br 2.6.32-954.3.5.lve1.4.90.el6.x86_64 #1 SMP Tue Feb 21 12:26:30 UTC 2023 x86_64
User: artinside (517)
PHP: 7.4.33
Disabled: exec,passthru,shell_exec,system
Upload Files
File: //usr/local/lib64/perl5/Cpanel/Class.pm
package Cpanel::Class;

use strict;
use warnings;

use Scalar::Util 'blessed', 'reftype';
use Carp 'confess';
use Cpanel::Class::Meta::Class;
use XSLoader ();

our $VERSION = '1.0.5';

XSLoader::load 'Cpanel::Class', $VERSION;

# Utils

sub load_class {
    my $class = shift;
    return 1 if is_class_loaded($class);
    my $file = $class . '.pm';
    $file =~ s{::}{/}g;
    eval { CORE::require($file) };

    1;
}

sub is_class_loaded {
    my $class = shift;
    no strict 'refs';
    return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"};
    foreach ( keys %{"${class}::"} ) {
        next if substr( $_, -2, 2 ) eq '::';
        return 1 if defined &{"${class}::$_"};
    }
    return 0;
}

my @exported_subs = qw{ has before around after extends };

sub import {
    my $caller = caller;

    my $meta = Cpanel::Class::Meta::Class->new( { package => $caller } );

    foreach my $sub (@exported_subs) {
        $meta->add_method( $sub => \&{$sub} );
    }

    Cpanel::Class::load_class('Cpanel::Class::Object');
    $meta->superclasses('Cpanel::Class::Object') if !$meta->superclasses;

    strict->import;
    warnings->import;
}

sub unimport {
    no strict 'refs';
    my $class = caller();

    foreach my $name (@exported_subs) {
        if ( defined &{ $class . '::' . $name } ) {
            my $keyword = \&{ $class . '::' . $name };

            my ($pkg_name) = Cpanel::Class::get_code_info($keyword);
            next if $@;
            next if $pkg_name ne 'Cpanel::Class';

            delete ${ $class . '::' }{$name};
        }
    }
}

sub extends {
    my $caller = caller();
    Cpanel::Class::load_class($_) foreach (@_);
    $caller->meta->superclasses(@_);
}

sub has($;%) {
    my ( $attr, %meta ) = @_;
    my $caller = caller();
    $caller->meta->add_attribute( $attr, %meta );
}

sub around(@) {
    my $code   = pop @_;
    my $caller = caller();
    $caller->meta->add_around_method_modifier( $_, $code ) foreach (@_);
}

sub after(@) {
    my $code   = pop @_;
    my $caller = caller();
    $caller->meta->add_after_method_modifier( $_, $code ) foreach (@_);
}

sub before(@) {
    my $code   = pop @_;
    my $caller = caller();
    $caller->meta->add_before_method_modifier( $_, $code ) foreach (@_);
}

1;
__END__

=head1 NAME

Cpanel::Class - Tool to help organize and build perl classes

=head2 Utility functions

=over 4

=item load_class ($class_name)

    This will load a given C<$class_name> and if it does not have an
    already initialized metaclass, then it will intialize one for it.

=item is_class_loaded ($class_name)

    This will return a boolean depending on if the C<$class_name> has
    been loaded.

These functions are not exported

=back

=head1 has - Create attributes

=over 4

=item has $name => %options

=back

is => ('rw'|'ro')

    The is option accepts either rw (for read/write) or ro (for read only). These will
    create either a read/write accessor or a read-only accessor respectively, using the
    same name as the $name of the attribute.

default

    Change the default value of an attribute.

lazy => (1|0)

    This will tell the class to not create this slot until absolutely necessary. If an
    attribute is marked as lazy it must have a default supplied.

handles => ARRAY | HASH

    The handles option provides Cpanel::Class classes with automated delegation features.

    ARRAY

        This is the most common usage for handles. You basically pass a list of method names
        to be delegated, and Cpanel::Class will install a delegation method for each one.

    HASH

        Instead of a list of method names, you pass a HASH ref where each key is the method
        name you want installed locally, and its value is the name of the original method in
        the class being delegated to.

auto_deref => (1|0)

        This tells the accessor whether to automatically dereference the value returned. Only
        works for arrayref or hashref.

weak_ref => (1|0)

        This will tell the class to store the value of this attribute as a weakened reference.

trigger => $code_ref

        The trigger option is a CODE reference which will be called after the value of the
        attribute is set. The CODE ref will be passed the instance itself, the updated value
        and the attribute meta-object (this is for more advanced fiddling and can typically
        be ignored). You cannot have a trigger on a read-only attribute.

clearer => 'method_name'

        Create a method that will delete/undefine an attribute

required => (1|0)

        This marks the attribute as being required. This means a defined value must be supplied during class construction, and the attribute may never be set to undef with an accessor.

builder => 'method_name'

    The value of this key is the name of the method that will be called to obtain the value used to initialize the attribute. This should be a method in the class associated with the attribute, not a method in the attribute class itself.

has is exported by default.

=head1 Method modifiers

=head3 before

    When writing a "before" hook you can catch the call to an inherited method or a method in the same class,
    and execute some code before the inherited method is called.

  Example:

  package Foo;
  use Cpanel::Class;

  sub method { return 4; }

  package Bar;
  use Cpanel::Class;
  extends 'Foo';

  before 'method' => sub {
    my ($self, @args) = @_;
    # ... here some stuff to do before Foo::method is called
  };


=head3 after

    When writing an "after" hook you can catch the call to an inherited method or a method in the same class and
    execute some code after the original method is executed. You receive in your
    hook the result of the mother's method.

  Example:

  package Foo;
  use Cpanel::Class;

  sub method { return 4; }

  package Bar;
  use Cpanel::Class;
  extends 'Foo';

  my $flag;

  after 'method' => sub {
    my ($self, @args) = @_;
    $flag = 1;
  };

=head3 around

    When writing an "around" hook you can catch the call to an inherited method or a method in the same class and
    actually redefine it on-the-fly.

    You get the code reference to the parent's method and its arguments, and can
    do what you want then.

  Example:

  package Foo;
  use Cpanel::Class;

  sub method { return 4; }

  package Bar;
  use Cpanel::Class;
  extends 'Foo';

  around 'method' => sub {
    my $orig = shift;
    my ($self, @args) = @_;

    my $res = $self->$orig(@args);
    return $res + 3;
  }


=head1 meta

meta gives access to the Classes' Meta Object Protocal

=head2 Meta Object Protocal

A meta object protocol is an API to an object system.

To be more specific, it is a set of abstractions of the components of
an object system (typically things like; classes, object, methods,
object attributes, etc.). These abstractions can then be used to both
inspect and manipulate the object system which they describe.

=over 4

=item ->meta->get_attribute($attr_name)

    Creates attributes just like the has key word

=item ->meta->get_method_map

    Returns a hashref of all method and code from the class

=item ->meta->add_method($name => $coderef)

    Add a method to the class

=item ->meta->get_method_list

    Returns an array method names from the class

=item ->meta->get_method($method_name)

    Returns coderef of a given method

=item ->meta->has_method($method_name)

    Returns true if the method exists in the class otherwise false

=item ->meta->remove_method($method_name)

    Remove the method from the class

=item ->meta->superclasses

    Returns the @ISA list of superclasses

=item ->meta->class_precedence_list

    Returns the list of all Classes in the Class hierarchy. Duplicates are possible.

=item ->meta->linearized_isa

    Returns the list of all Classes in the Classes hierarchy. It removes duplicates

=item ->meta->subclasses

    Returns the list of all Classes that inherit from the current class

=item ->meta->name

    Returns the name of the current class

=item ->meta->version

    Returns the VERSION of the class

=item ->meta->authority

    Returns the Authority of the class

=item ->meta->identifier

    Returns a concatenation of name, version and authority seperated by dashes

=back

meta is inherited from Cpanel::Class::Object

=cut