view release on metacpan or  search on metacpan

lib/AsposeSlidesCloud/ClassRegistry.pm  view on Meta::CPAN

    'VbaReference' => {  },
    'VideoExportOptions' => { 'Format' => 'mpeg4', },
    'VideoFrame' => { 'Type' => 'VideoFrame', },
    'ViewProperties' => {  },
    'Workbook' => { 'Type' => 'Workbook', },
    'XYSeries' => {  },
    'XamlExportOptions' => { 'Format' => 'xaml', },
    'XpsExportOptions' => { 'Format' => 'xps', },
    'ZoomFrame' => { 'Type' => 'ZoomFrame', },
    'ZoomObject' => {  },
);

sub has_class {
    my ($self, $name) = @_;
    return exists $determiners{$name};
}

sub is_subclass {
    my ($self, $subclass, $class) = @_;
    if ($subclass eq $class) {
        return 1;
    }
    for(keys %hierarchy) {
        if ($hierarchy{$_} eq $class && $self->is_subclass($subclass, $_)) {
            return 1;
        }
    }
    return 0;
}

sub get_class_name {
    my ($self, $name, $data) = @_;
    my $descendant = $self->get_subclass_name($name, $data);
    if ($descendant) {
        return $descendant;
    }
    return $name;
}

sub get_subclass_name {
    my ($self, $name, $data) = @_;
    for(keys %hierarchy) {
        if ($hierarchy{$_} eq $name) {
            my $descendant = $self->get_subclass_name($_, $data);
            if ($descendant) {
                return $descendant;
            }
            if ($self->is_instance_of($_, $data)) {
                return $_;
            }
        }
    }
    return "";
}

sub is_instance_of {
    my ($self, $name, $data) = @_;
    if (!exists $determiners{$name} || !keys %{$determiners{$name}}) {
        return 0;
    }
    my $data_decoded = $data;
    if (ref $data ne "HASH") {
        $data_decoded = decode_json($data);
    }
    for(keys %{$determiners{$name}}) {
        if (!$self->value_exists($_, ${$determiners{$name}}{$_}, $data_decoded)) {
            return 0;
        }
    }
    return 1;
}

sub value_exists {
    my ($self, $key, $value, $data) = @_;
    if (%$data{$key} && %$data{$key} eq $value) {
        return 1;
    }
    my $lckey = lcfirst($key);
    if (%$data{$lckey} && %$data{$lckey} eq $value) {
        return 1;
    }
    my $uckey = ucfirst($key);
    if (%$data{$uckey} && %$data{$uckey} eq $value) {
        return 1;
    }
    return 0;
}

1;