=encoding UTF-8

=head1 NAME

Protobuf::Message - Base class for Protocol Buffer messages

=head1 VERSION

version 0.08

=head1 SYNOPSIS

    # This class is not used directly. Instead, use classes generated
    # from your .proto files.

    # Example assuming MyPackage::MyMessage is generated:
    # use MyPackage::MyMessage;

    # my $msg = MyPackage::MyMessage->new(field1 => 'value1');
    # $msg->field2(123);

    # my $binary = $msg->serialize;
    # my $decoded = MyPackage::MyMessage->parse($binary);

    # is($decoded->field1, 'value1', 'Field 1 matches');

=head1 DESCRIPTION

C<Protobuf::Message> is the base class for all Perl classes generated from Protocol Buffer message definitions. It provides the core functionality for creating, manipulating, serializing, and deserializing messages.

You should not use this class directly. Instead, compile your C<.proto> files using C<protoc> with the C<protoc-gen-perl-pb> plugin, which will generate subclasses of C<Protobuf::Message> with methods specific to your message fields.

The underlying implementation uses the C<upb> library, and most method calls are dispatched to highly optimized C functions via L<XS>.

=head1 ATTRIBUTES

Message classes generated by the plugin will have attributes corresponding to the fields defined in the C<.proto> file. These are not defined directly in this base class but are injected by L<Protobuf::ClassGenerator> based on the message descriptor.

=head1 METHODS

== Class Methods

=head2 new(%args)

    my $msg = MyGeneratedMessage->new(
        field_a => 'hello',
        nested_msg => { inner_field => 123 },
        repeated_field => [1, 2, 3],
    );

Creates a new message instance. Fields can be initialized using key-value pairs.

This method cannot be called on C<Protobuf::Message> directly; it must be called on a generated subclass.

=head2 parse($binary_data)

    my $msg = MyGeneratedMessage->parse($binary_string);

Parses a binary string (wire format) and returns a new message instance.

=head2 parse_from($binary_data)

    $msg->parse_from($binary_string);

Parses a binary string and merges its fields into the existing message instance.

=head2 merge_from($other_msg)

    $msg->merge_from($other_msg);

Deep-merges the fields from C<$other_msg> into the current message. C<$other_msg> must be of the same type.

=head2 copy_from($other_msg)

    $msg->copy_from($other_msg);

Deep-copies the fields from C<$other_msg> into the current message, clearing any existing fields first.

=head2 from_json($json_string)

    my $msg = MyGeneratedMessage->from_json($json_string);

Parses a JSON string representing the message and returns a new message instance.

=head2 descriptor()

    my $mdef = MyGeneratedMessage->descriptor;
    print $mdef->full_name;

Returns the L<Protobuf::Descriptor::MessageDef> object for this message type.

== Instance Methods

Most field-specific methods (getters, setters, etc.) are dynamically generated in subclasses. The methods listed below are common to all messages.

=head2 get($field_name)

Generic accessor to get a field's value. Prefer using the field-specific methods in generated classes (e.g., C<< $msg->my_field >>).

=head2 set($field_name, $value)

Generic accessor to set a field's value. Prefer using the field-specific methods in generated classes (e.g., C<< $msg->my_field('new_value') >>).

=head2 has_field($field_name)

Returns true if the specified singular field is set. Prefer C<< $msg->has_my_field >>.

=head2 clear_field($field_name)

Clears the specified field. Prefer C<< $msg->clear_my_field >>.

=head2 serialize()

    my $binary_string = $msg->serialize;

Serializes the message to the binary wire format.

=head2 to_text()

    my $text_format = $msg->to_text;

Converts the message to the Protocol Buffer TextFormat. Useful for debugging.

=head2 to_json()

    my $json_string = $msg->to_json;

Converts the message to its JSON representation.

=head2 unknown_fields()

Returns a L<Protobuf::UnknownFieldSet> object representing any fields encountered during parsing that were not defined in the message's descriptor.

=head2 fields()

    my @fields = $msg->fields;

Returns a list of L<Protobuf::Descriptor::Field> objects for all fields that are currently set in the message.

=head2 CLONE()

Throws an error. Protobuf messages cannot be directly cloned, especially across threads, due to the underlying C structures and arena management.

=head2 DESTROY()

Internal method to clean up the underlying C<upb_Message> and related resources.

=head1 ADVANCED METHODS

These methods are for more specialized use cases.

=head2 set_oneof($oneof_name, $value)

Sets a value within a C<oneof> group. This method attempts to coerce the given C<$value> into the first field within the named C<oneof> group that can accept it. Returns the name of the field that was set.

=head2 which_oneof($oneof_name)

Returns the name of the field that is currently set within the specified C<oneof> group, or C<undef> if no field is set.

=head2 audit_integrity()

Internal method for debugging memory and object cache integrity.

=head2 get_fingerprint()

Returns a unique fingerprint string for the message instance, often related to its memory location in the arena. Useful for debugging and tracking object identity in shared memory scenarios.

=head2 freeze_to_shared($path, $size)

(Experimental) Serializes and copies the message into a shared memory segment (C<tmpfs>) at the given C<$path>, with a maximum C<$size>. Returns a new instance backed by the shared arena.

=head2 thaw_from_shared($class, $path, $size)

(Experimental) Attaches to an existing shared memory segment at C<$path> and attempts to reify a message of type C<$class> from it.

=head2 to_perl()

Converts the message to a Perl hash/array structure. L<Protobuf::WKT::Struct> has a specialized version.

=head2 from_perl($hashref)

Populates the message fields from a Perl hashref.

=head2 validate()

(Placeholder) Validates the message content based on any defined constraints.

=head2 coerce_to($target_class)

(Placeholder) Attempts to coerce the current message to an instance of C<$target_class>.

=head2 to_text_with_unknowns()

(Placeholder) Converts the message to TextFormat, including a representation of any unknown fields. Currently alias to C<to_text()>.

=head2 to_wire()

Alias for C<serialize()>. Returns the binary wire format.

=head2 to_json_streaming()

(Placeholder) Returns a JSON representation of the message, potentially optimized for streaming. Currently alias to C<to_json()>.

=head2 to_json_compact()

Returns a JSON representation of the message without extra whitespace.

=head2 dependency_graph()

(Placeholder) Returns a structure representing the dependencies of this message type.

=head2 perf_profile()

(Placeholder) Returns a hash containing performance metrics related to this message.

=head2 reset_connection()

(Placeholder) Resets any connection-related state within the message object.

=head1 MEMORY MANAGEMENT

C<Protobuf::Message> instances are typically allocated on a L<Protobuf::Arena>. The arena manages the memory for the message and all its submessages. When the arena is freed (usually when the top-level message object goes out of scope), all associated memory is reclaimed.

=head1 SEE ALSO

L<Protobuf>, L<Protobuf::DescriptorPool>, L<Protobuf::Arena>, L<Protobuf::Descriptor>

=head1 AUTHOR

C.J. Collier <cjac@google.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2026 by Google LLC.

This is free software; you can redistribute it and/or modify it under
the terms of the BSD 3-Clause License.

=cut

package Protobuf::Message;

use strict;
require Protobuf;
use warnings;
use Carp qw(croak);

our $VERSION = '0.08';

use Protobuf::Internal::Repeated;
use Protobuf::Internal::Map;

sub _engine {
    my ($class_or_self, $profile) = @_;
    if (ref($class_or_self)) {
        return $class_or_self->{_engine} if $class_or_self->{_engine};
    }
    my $name = ($profile && $profile eq 'pure_perl') ? 'pure_perl' : undef;
    return Protobuf->get_engine($name);
}

sub new {
    my $class = shift;
    my $args;
    if (@_ == 1 && ref($_[0]) eq 'HASH') {
        $args = $_[0];
    } else {
        $args = { @_ };
    }

    croak("Protobuf::Message->new cannot be called directly. Use a generated subclass.")
        if $class eq 'Protobuf::Message';

    my $mdef = $class->descriptor;
    croak("Class $class does not have a descriptor") unless $mdef;

    my $profile_str = delete $args->{profile} || 'balanced';
    my $engine = $class->_engine($profile_str);

    my $flags = 0;
    if ($profile_str eq 'write_heavy') {
        $flags = Protobuf::Internal::PROFILE_WRITE_HEAVY();
    } elsif ($profile_str eq 'read_heavy') {
        $flags = Protobuf::Internal::PROFILE_READ_HEAVY();
    } elsif ($profile_str eq 'zero_copy') {
        $flags = Protobuf::Internal::PROFILE_ZERO_COPY();
    }

    my $self = $engine->create_message($class, $mdef, delete $args->{arena}, $flags);
    $self->{_engine} = $engine;

    $self->from_perl($args) if keys %$args;

    return $self;
}

sub DESTROY {
    my ($self) = @_;
    return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
    # Only call XS free if it's an XS-backed object
    if (exists $self->{_engine} && defined $self->{_engine} && $self->{_engine}->isa('Protobuf::Engine::XS')) {
        _xs_free($self);
    }
    return;
}
sub CLONE_SKIP { 1 }

sub get {
    my ($self, $field_name) = @_;
    return $self->_engine->get($self, $field_name);
}

sub set {
    my ($self, $field_name, $value) = @_;
    return $self->_engine->set($self, $field_name, $value);
}

sub has {
    my ($self, $field_name) = @_;
    return $self->_engine->has($self, $field_name);
}

sub clear {
    my ($self, $field_name) = @_;
    return $self->_engine->clear($self, $field_name);
}

sub set_oneof {
    my ($self, $oneof_name, $value) = @_;
    my $mdef = $self->descriptor;
    my $oneof = $mdef->find_oneof_by_name($oneof_name);
    croak("Oneof '$oneof_name' not found") unless $oneof;

    my %type_priority = (
        11 => 1, # MESSAGE
        1  => 2, 2 => 2, 3 => 2, 4 => 2, 5 => 2, 6 => 2, 7 => 2, 13 => 2, 15 => 2, 16 => 2, 17 => 2, 18 => 2, # Numeric
        14 => 3, # ENUM
        8  => 4, # BOOL
        9  => 5, 12 => 5, # STRING, BYTES
    );

    my @sorted_fields = sort {
        my $p_a = $type_priority{$a->type_number} || 6;
        my $p_b = $type_priority{$b->type_number} || 6;
        $p_a <=> $p_b;
    } $oneof->fields;

    foreach my $f (@sorted_fields) {
        my $method = $f->name;
        eval {
            $self->$method($value);
            return 1;
        };
        if (!$@) {
            return $f->name; # Successfully set
        }
    }
    croak("Could not coerce value into any field of oneof '$oneof_name'");
    return;
}

sub has_field {
    my ($self, $field_name) = @_;
    if ($self->_engine->isa('Protobuf::Engine::XS')) {
        return _xs_has($self, $field_name);
    } else {
        return $self->has($field_name);
    }
}

sub clear_field {
    my ($self, $field_name) = @_;
    if ($self->_engine->isa('Protobuf::Engine::XS')) {
        return _xs_clear($self, $field_name);
    } else {
        return $self->clear($field_name);
    }
}

sub which_oneof {
    my ($self, $oneof_name) = @_;
    if ($self->_engine->isa('Protobuf::Engine::XS')) {
        return _xs_which_oneof($self, $oneof_name);
    } else {
        my $mdef = $self->descriptor;
        my $oneof = $mdef->find_oneof_by_name($oneof_name);
        croak("Oneof '$oneof_name' not found") unless $oneof;

        foreach my $f ($oneof->fields) {
            if ($self->has($f->name)) {
                return $f->name;
            }
        }
        return undef;
    }
}

sub serialize {
    my ($self) = @_;
    return $self->_engine->serialize($self);
}

sub encode { shift->serialize(@_) }

sub audit_integrity {
    my ($self) = @_;
    return _xs_audit_integrity($self);
}

sub get_fingerprint {
    my ($self) = @_;
    return _xs_get_fingerprint($self);
}

sub validate {
    my ($self) = @_;
    return _xs_validate($self);
}

sub coerce_to {
    my ($self, $target_class) = @_;
    return _xs_coerce_to($self, $target_class);
}

sub to_perl {
    my ($self) = @_;
    return $self->_engine->to_perl($self);
}

sub to_hashref {
    my ($self) = @_;
    return $self->to_perl();
}

sub from_perl {
    my ($self, $data) = @_;
    croak('Message::from_perl expects a HASH ref') unless ref($data) eq 'HASH';
    foreach my $key (keys %$data) {
        if ($self->can($key)) {
            $self->$key($data->{$key});
        } else {
            croak("No such field or method: $key");
        }
    }
    return $self;
}

sub to_text {
    my ($self) = @_;
    return $self->_engine->to_text($self);
}

sub to_text_with_unknowns {
    my ($self) = @_;
    return $self->to_text();
}

sub to_wire {
    my ($self) = @_;
    return $self->serialize();
}

sub to_json {
    my ($self) = @_;
    return $self->_engine->to_json($self);
}

sub toJSON { shift->to_json(@_) }

sub to_handle {
    my ($self, $fh, %options) = @_;
    croak("Invalid file handle") unless defined $fh;
    # TODO: Engine delegation for to_handle
    if (($options{format} || 'binary') eq 'json') {
        return _xs_json_to_handle($self, $fh);
    }
    return _xs_to_handle($self, $fh, $options{length_prefixed} || 0);
}

sub from_handle {
    my ($class, $fh, %options) = @_;
    croak("Invalid file handle") unless defined $fh;
    # TODO: Engine delegation for from_handle
    return _xs_from_handle($class, $fh, $options{length_prefixed} || 0);
}

sub to_json_streaming {
    my ($self) = @_;
    return $self->to_json();
}

sub to_json_compact {
    my ($self) = @_;
    my $json = $self->to_json();
    $json =~ s/\s+//g;
    return $json;
}

sub from_json {
    my ($class, $json_data, $options) = @_;
    return $class->_engine->from_json($class, $json_data, $options);
}

sub fromJSON { shift->from_json(@_) }

sub unknown_fields {
    my ($self) = @_;
    if ($self->_engine->isa('Protobuf::Engine::XS')) {
        return _xs_unknown_fields($self);
    } else {
        require Protobuf::UnknownFieldSet;
        return bless { _msg => $self }, 'Protobuf::UnknownFieldSet';
    }
}

sub dependency_graph {
    my ($self) = @_;
    return { root => ref($self), children => [] };
}

sub perf_profile {
    my ($self) = @_;
    return { serialize_time => 0, deserialize_time => 0, field_access_avg => 0 };
}

sub reset_connection {
    my ($self) = @_;
    return 1;
}

sub parse {
    my ($class, $data, $options) = @_;
    my $profile = (ref($options) eq 'HASH') ? $options->{profile} : undef;
    my $engine = $class->_engine($profile);
    my $self = $engine->parse($class, $data, $options);
    $self->{_engine} = $engine;
    return $self;
}

sub decode { shift->parse(@_) }

sub parse_from {
    my ($self, $data) = @_;
    if ($self->_engine->isa('Protobuf::Engine::XS')) {
        _xs_clear_memoization_cache($self);
        return _xs_parse_from($self, $data);
    } else {
        return $self->_engine->parse_into($self, $data);
    }
}

sub merge_from {
    my ($self, $other) = @_;
    croak("Argument to merge_from must be a Protobuf::Message")
        unless eval { $other->isa('Protobuf::Message') };
    _xs_clear_memoization_cache($self) if $self->_engine->isa('Protobuf::Engine::XS');
    return $self->_engine->merge($self, $other);
}

sub copy_from {
    my ($self, $other) = @_;
    croak("Argument to copy_from must be a Protobuf::Message")
        unless eval { $other->isa('Protobuf::Message') };
    _xs_clear_memoization_cache($self) if $self->_engine->isa('Protobuf::Engine::XS');
    return $self->_engine->copy($self, $other);
}

sub fields {
    my ($self) = @_;
    if ($self->_engine->isa('Protobuf::Engine::XS')) {
        my $fields_rv = _xs_fields($self);
        return wantarray ? @$fields_rv : $fields_rv;
    } else {
        my $mdef = $self->{_mdef};
        my $fields = $self->{_fields};
        my @res;
        foreach my $name (keys %$fields) {
            my $fdef = $mdef->find_field_by_name($name);
            push @res, $fdef if $fdef;
        }
        return wantarray ? @res : \@res;
    }
}

sub freeze_to_shared {
    my ($self, $path, $size) = @_;
    $size ||= 1024 * 1024;
    my $arena = Protobuf::Arena->new_tmpfs($path, $size);
    my $shared_msg = _xs_migrate_to_arena($self, $arena);
    return $shared_msg;
}

sub thaw_from_shared {
    my ($class, $path, $size) = @_;
    $size ||= 1024 * 1024;
    my $arena = Protobuf::Arena->attach_tmpfs($path, $size);
    return _xs_find_in_shared_arena($class, $arena);
}

sub detach {
    my $self = shift;
    return _xs_detach($self);
}

sub attach {
    my ($class, $info, $arena) = @_;
    return _xs_attach($class, $info, $arena);
}

sub arena {
    my $self = shift;
    return _xs_get_arena($self);
}

sub FREEZE {
    my ($self, $serializer) = @_;
    if (ref($self) eq 'HASH' || (eval { Scalar::Util::reftype($self) } || '') eq 'HASH') {
        $self->{'_serialized'} = $self->serialize();
        return ($self->{'_serialized'});
    }
    return ($self->serialize());
}

sub THAW {
    my ($class_or_self, $serializer, @args) = @_;
    my $serialized = $args[0];
    if (!defined($serialized) && ref($class_or_self) && (eval { Scalar::Util::reftype($class_or_self) } || '') eq 'HASH') {
        $serialized = delete $class_or_self->{'_serialized'};
        delete $class_or_self->{'_upb_ptr'};
        delete $class_or_self->{'_mdef_ptr'};
        delete $class_or_self->{'_arena_sv'};
        delete $class_or_self->{'_engine'};
    }
    if (defined $serialized && length($serialized)) {
        my $class = ref($class_or_self) || $class_or_self;
        return $class->parse($serialized);
    }
    return $class_or_self;
}

1;
