view release on metacpan or  search on metacpan

lib/Class/Accessor/TrackDirty.pm  view on Meta::CPAN

our $REVERT = 'revert';

{
    my %package_info;
    sub _package_info($) {
        my $package = shift;
        $package_info{$package} ||= {tracked_fields => {}, fields => {}};
    }
}

sub _is_different_deeply($$) {
    my ($ref_x, $ref_y) = @_;
    (freeze $ref_x) ne (freeze $ref_y);
}

sub _is_different($$) {
    my ($x, $y) = @_;
    if (defined $x && defined $y) {
        if (ref $x && ref $y) {
            return _is_different_deeply $x, $y;
        } else {
            return ref $x || ref $y || $x ne $y;
        }
    } else {
        return defined $x || defined $y;
    }
}

sub _make_tracked_accessor($$) {
    no strict 'refs';
    my ($package, $name) = @_;

    *{"$package\::$name"} = sub {
        my $self = shift;

        # getter
        my $value;
        if (exists $self->{$name}) {
            $value = $self->{$name};

lib/Class/Accessor/TrackDirty.pm  view on Meta::CPAN

            $value = ($self->{$name} = dclone $value) if ref $value;
        }

        # setter
        $self->{$name} = $_[0] if @_;

        return $value;
    };
}

sub _make_accessor($$) {
    no strict 'refs';
    my ($package, $name) = @_;

    *{"$package\::$name"} = sub {
        my $self = shift;
        my $value = $self->{$name};
        $self->{$name} = $_[0] if @_;
        $value;
    };
}

sub _mk_tracked_accessors($@) {
    my $package = shift;
    _make_tracked_accessor $package => $_ for @_;
    @{(_package_info $package)->{tracked_fields}}{@_} = (1,) x @_;
}

sub _mk_helpers($) {
    no strict 'refs';
    my $package = shift;
    my ($tracked_fields, $fields) =
        @{_package_info $package}{qw(tracked_fields fields)};

    # cleate helper methods
    *{"$package\::$FROM_HASH"} = sub {
        my $package = shift;
        my %modified = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;

lib/Class/Accessor/TrackDirty.pm  view on Meta::CPAN

        my $self = shift;
        exists $self->{$RESERVED_FIELD} ? 0 : 1;
    };

    *{"$package\::$REVERT"} = sub {
        my $self = shift;
        delete $self->{$_} for keys %$tracked_fields;
    };
}

sub _mk_accessors($@) {
    my $package = shift;
    _make_accessor $package => $_ for @_;
    @{(_package_info $package)->{fields}}{@_} = (1,) x @_;
}

sub _mk_new($) {
    no strict 'refs';
    my $package = shift;

    *{"$package\::$NEW"} = sub {
        my $package = shift;
        my %modified = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;

        bless \%modified => $package;
    };
}