view release on metacpan or  search on metacpan

lib/Convert/Pheno/BFF/ToPXF.pm  view on Meta::CPAN

    # ========
    # diseases
    # ========
    _map_diseases( $self, $bff, $pxf );

    # ===============
    # medicalActions
    # ===============
    _map_medical_actions( $self, $bff, $pxf );

    # =================================================
    # Phenopacket payload preserved under info.phenopacket
    # =================================================
    _map_phenopacket_payload( $self, $bff, $pxf );

    # =====
    # files
    # =====
    # (Not mapped, see original code comments)

    # =========
    # metaData
    # =========
    _map_metaData( $self, $bff, $pxf );

# =========
# exposures
# =========

# Phenopackets v2 does not define an "exposures" field in the Phenopacket schema.
#
# Sept 2023 -> pxf-tools error:
#   Message type "org.phenopackets.schema.v2.Phenopacket" has no field named "exposures".
#   Available fields: ['id', 'subject', 'phenotypicFeatures', 'measurements', 'biosamples',
#                      'interpretations', 'diseases', 'medicalActions', 'files', 'metaData']
#
# Explanation provided by @gsfk (issue #4): Exposure was proposed for v2 but not
# adopted and later removed (ga4gh/phenopacket-schema@cb8bf58). Some documentation
# still incorrectly lists it.
#
# Do not map exposures; this block is legacy.
# Tracking: https://github.com/CNAG-Biomedical-Informatics/convert-pheno/issues/4
# Observed Sept 2023; reconfirmed Feb 2026

#   $pxf->{exposures} =
#
#      [
#        map {
#            {
#                type       => $_->{exposureCode},
#                occurrence => { timestamp => $_->{date} }
#            }
#        } @{ $bff->{exposures} }
#      ]
#      if exists $bff->{exposures};

    #######################################
    # END MAPPING TO PHENOPACKET V2 TERMS #
    #######################################

    _strip_private_keys($pxf);

    return $pxf;
}

sub _map_id {
    my ( $self, $bff, $pxf ) = @_;

    # ==
    # id
    # ==
    $pxf->{id} =
      $self->{test}
      ? undef
      : 'phenopacket_id.' . generate_random_alphanumeric_string(8);
}

sub _map_subject {
    my ( $self, $bff, $pxf ) = @_;

    my $vitalStatus = _resolve_vitalStatus( $self, $bff );

    # =======
    # subject
    # =======
    $pxf->{subject} = {
        id          => $bff->{id},
        vitalStatus => $vitalStatus,
    };

    my $sex = _map_sex( $bff->{sex} );
    $pxf->{subject}{sex} = $sex if defined $sex;

    my $dateOfBirth = _get_phenopacket_info_term( $bff, 'dateOfBirth' );
    $pxf->{subject}{dateOfBirth} = $dateOfBirth if defined $dateOfBirth;

    # karyotypicSex
    $pxf->{subject}{karyotypicSex} = $bff->{karyotypicSex}
      if exists $bff->{karyotypicSex};
}

sub _map_phenotypic_features {
    my ( $self, $bff, $pxf ) = @_;

 # ===================
 # phenotypicFeatures
 # ===================
 # Assign transformed 'phenotypicFeatures' to $pxf, only if it's defined in $bff
    $pxf->{phenotypicFeatures} = [
        map {
            my $feature = _clone_data($_);
            my %mapped;

            $mapped{type} = _clone_data( $feature->{featureType} )
              if exists $feature->{featureType};
            $mapped{excluded} =
              exists $feature->{excluded}
              ? $feature->{excluded}
              : JSON::PP::false();
            $mapped{severity} = _clone_data( $feature->{severity} )
              if exists $feature->{severity};

lib/Convert/Pheno/BFF/ToPXF.pm  view on Meta::CPAN

    my ( $self, $bff, $pxf ) = @_;

    # =========
    # metaData
    # =========
    # Depending on the origion (redcap) , _info and resources may exist
    $pxf->{metaData} =
        $self->{test} ? undef
      : defined( _get_phenopacket_info_term( $bff, 'metaData' ) )
      ? _clone_data( _get_phenopacket_info_term( $bff, 'metaData' ) )
      : get_metaData($self);
}

#----------------------------------------------------------------------
# Helper subs
#----------------------------------------------------------------------

sub _get_phenopacket_info_term {
    my ( $bff, $term ) = @_;

    return unless exists $bff->{info} && ref( $bff->{info} ) eq 'HASH';

    return $bff->{info}{phenopacket}{$term}
      if exists $bff->{info}{phenopacket}
      && ref( $bff->{info}{phenopacket} ) eq 'HASH'
      && exists $bff->{info}{phenopacket}{$term};

    return $bff->{info}{$term} if exists $bff->{info}{$term};

    return;
}

sub _resolve_vitalStatus {
    my ( $self, $bff ) = @_;

    my $vitalStatus = _get_phenopacket_info_term( $bff, 'vitalStatus' );
    return _clone_data($vitalStatus) if defined $vitalStatus;

    return { status => $self->{default_vital_status} || 'ALIVE' };
}

sub _clone_data {
    my ($data) = @_;
    return undef unless defined $data;

    if ( ref($data) eq 'HASH' ) {
        return { map { $_ => _clone_data( $data->{$_} ) } keys %{$data} };
    }

    if ( ref($data) eq 'ARRAY' ) {
        return [ map { _clone_data($_) } @{$data} ];
    }

    if ( blessed($data) && blessed($data) eq 'JSON::PP::Boolean' ) {
        return $data ? JSON::PP::true() : JSON::PP::false();
    }

    return $data;
}

sub _strip_private_keys {
    my ($data) = @_;
    return unless defined $data;

    if ( ref($data) eq 'HASH' ) {
        for my $key ( keys %{$data} ) {
            if ( $key =~ /^_/ ) {
                delete $data->{$key};
                next;
            }
            _strip_private_keys( $data->{$key} );
        }
        return;
    }

    if ( ref($data) eq 'ARRAY' ) {
        _strip_private_keys($_) for @{$data};
        return;
    }

    return;
}

sub _map_sex {
    my ($sex) = @_;
    return 'UNKNOWN_SEX' unless defined $sex;

    my $id    = ref($sex) eq 'HASH' ? $sex->{id}    : undef;
    my $label = ref($sex) eq 'HASH' ? $sex->{label} : $sex;

    return 'MALE'   if defined $id && $id eq 'NCIT:C20197';
    return 'FEMALE' if defined $id && $id eq 'NCIT:C16576';

    return 'MALE'        if defined $label && $label =~ /^male$/i;
    return 'FEMALE'      if defined $label && $label =~ /^female$/i;
    return 'OTHER_SEX'   if defined $label && $label =~ /^other(?:_sex)?$/i;
    return 'UNKNOWN_SEX' if defined $label
      && $label =~ /^(?:unknown(?:[_ ]sex)?|not available)$/i;

    return 'UNKNOWN_SEX';
}

sub _looks_like_pxf_time_element {
    my ($time) = @_;
    return 0 unless ref($time) eq 'HASH';

    return scalar grep { exists $time->{$_} }
      qw(age ageRange gestationalAge interval ontologyClass timestamp);
}

sub _map_time_element_to_pxf {
    my ($time) = @_;
    return unless defined $time;

    return _clone_data($time) if _looks_like_pxf_time_element($time);

    if ( !ref($time) ) {
        return {
            timestamp => $time =~ /^\d{4}-\d{2}-\d{2}$/
            ? map_iso8601_date2timestamp($time)
            : $time,
        };
    }

    return _clone_data($time) unless ref($time) eq 'HASH';

    if ( exists $time->{iso8601duration} ) {
        return { age => _clone_data($time) };
    }

    if ( exists $time->{weeks} || exists $time->{days} ) {
        return { gestationalAge => _clone_data($time) };
    }

    if ( exists $time->{id} ) {
        return { ontologyClass => _clone_data($time) };
    }