package Safelib::AL3::Parser ; use strict ; use warnings ; use Carp ; use File::Slurp ; use Data::Dumper ; $Data::Dumper::Indent = 1 ; #$Data::Dumper::Sortkeys = # sub { return [grep { /^\d/ || /CHILD/ } keys %{$_[0]}] } ; use Safelib::AL3::DB ; # this hash of hashes describes how to parse each al3 record my %rec_descs ; my %parent_recs ; sub new { my( $class, %opts ) = @_ ; my $self = bless {}, $class ; exists $opts{ al3_text } || exists $opts{ al3_file } or croak "Missing 'al3_text' and 'al3_file'" ; my $al3_text = $opts{ al3_text } ; if ( $al3_text && !ref $al3_text eq 'SCALAR' ) { $al3_text = \$al3_text ; } $al3_text ||= read_file( $opts{ al3_file }, scalar_ref => 1 ) ; $self->{al3_text} = $al3_text ; $self->{al3_file} = $opts{ al3_file } || '' ; %rec_descs = get_default_rec_descs() ; if ( my $spec_file = $opts{ spec_file } ) { load_al3_specs_from_file( $spec_file ) ; } else { load_al3_specs_from_db() ; } return $self ; } sub parse { my( $self ) = @_ ; my $al3_tree ; while( 1 ) { my $curr_rec = $self->get_next_record() ; last unless( $curr_rec ) ; my $curr_type = $self->{curr_type} ; next if $rec_descs{$curr_type}{skip} ; # see if a message record. if so, just save it in the tree. if ( $curr_type eq '1MHG' ) { push( @{$al3_tree->{'1MHG'}}, $curr_rec ) ; next ; } # see if a transaction record. if so, just save it in the tree. if ( $curr_type eq '2TRG' ) { push( @{$al3_tree->{'1MHG'}[-1]{CHILD}{'2TRG'}}, $curr_rec ) ; # reset the parent recs for this transaction. parent links can't # happen outside the current transaction. %parent_recs = ( '2TRG' => [ $curr_rec ] ) ; next ; } my $parent_rec = $self->find_parent_record( $curr_type, $curr_rec ) ; unless( $parent_rec ) { # we don't seem to have a parent record for this link. default to 2TRG and warn. warn <{link_type} index $self->{link_index} File: $self->{al3_file} $self->{rec_text} POLICY: $parent_recs{'2TRG'}[-1]{CHILD}{'5BIS'}{CHILD}{'5BPI'}{policy_number} WARN $parent_rec = $parent_recs{'2TRG'}[-1] ; } if( $rec_descs{$curr_type}{is_list} ) { push( @{$parent_rec->{CHILD}{$curr_type}}, $curr_rec ) ; } else { warn "Multiple records of $curr_type found" if $parent_rec->{CHILD}{$curr_type} ; $parent_rec->{CHILD}{$curr_type} = $curr_rec ; } } if ( $self->{curr_rec} ) { print <{curr_type}\n$self->{rec_text} File: $self->{al3_file} DIE print "LEN left: ", length ${$self->{al3_text}}, "\n" ; } return $al3_tree ; } sub find_parent_record { my( $self, $curr_type, $curr_rec ) = @_ ; my $parent_type ; if ( $parent_type = $rec_descs{ $curr_type }{parent} ) { #print "curr $curr_type parent $parent_type\n" ; #print Dumper \%parent_recs ; return $parent_recs{$parent_type}[-1] ; } my $link_type = $self->{link_type} ; unless( $link_type ) { return $parent_recs{'2TRG'}[-1] ; } return $parent_recs{$link_type}[$self->{link_index} - 1] ; } sub get_next_record { my( $self ) = @_ ; my $al3_text = $self->{al3_text} ; # if there is no text left, we hit end of the AL3 input unless( length ${$al3_text} ) { delete( $self->{curr_rec} ) ; return ; } print "SHORT [${al3_text}]\n" if length ${$al3_text} < 10 ; # get the record type and length from the first 7 chars my ( $curr_type, $rec_len ) = unpack 'A4A3', ${$al3_text}; $self->{curr_type} = $curr_type ; # get the record text and chop it from the AL3 text #print "TYPE $curr_type LEN [$rec_len]\n" ; #print "$curr_type NOT NUMBER [$rec_len]\n" # if $rec_len =~ /\D/ || length $rec_len == 0 ; my $rec_text = substr( ${$al3_text}, 0, $rec_len, '' ) ; #print "TYPE $curr_type REC [$rec_text]\n" ; $self->{rec_text} = $rec_text ; # we need the description hash for this record type my $rec_desc = $rec_descs{ $curr_type } ; # break the record into its fields and store them in a hash print Dumper $rec_desc, return unless $rec_desc->{fields} ; # the record text is padded as unpack will die if record is too short # for the unpack format. csc sends an older AL3 format and we have # the newer spec which has longer records. my $unpack_format = $rec_desc->{format} ; $rec_text .= ' ' x 300 ; my %fields ; @fields{ @{$rec_desc->{fields}} } = unpack( $unpack_format, $rec_text ) ; while( my( $key, $val ) = each %fields ) { next unless $val eq '' || $val =~ /^\?+$/ ; delete $fields{ $key } ; } # see if this is a record with a long header which contains a link to # its parent record if ( $unpack_format =~ /^x30/i ) { push( @{$parent_recs{$curr_type}}, \%fields ) ; #print Dumper \%fields ; my $header = parse_data_header( substr( $rec_text, 0, 30 ) ) ; my $parent_type = $header->{parent_type} ; # see if we found a parent link if ( $parent_type =~ /^\d[A-Z]{3}/ ) { $self->{link_type} = $parent_type ; $self->{link_index} = $header->{parent_rec_num} ; #print "LINK $parent_type IND $self->{link_index}\n" ; } else { $self->{link_type} = '' ; } } #print Dumper \%fields ; # save and return the new record return( $self->{curr_rec} = \%fields ) ; } sub parse_control_header { my( $text ) = @_ ; my %fields ; @fields{ qw( ff grp_vers ) } = unpack( 'x7A1A1', $text ) ; return \%fields ; } sub parse_data_header { my( $text ) = @_ ; my %fields ; @fields{ qw( ff grp_vers proc_level rec_num parent_type parent_proc_level parent_rec_num ) } = unpack( 'x7A1A1x1A2A4A4A2A4', $text ) ; return \%fields ; } # unpack formats and field lists to parse the INAME fields my %iname_descs = ( 'P' => { # personal fields => [ qw( prefix first middle last suffix ) ], format => 'x1A9A15A11A20A4', }, 'C' => { fields => [ qw( name abbrev ) ], format => 'x1A51A8', }, 'F' => { # family fields => [ qw( prefix first last suffix ) ], format => 'x1A9A26A20A4', }, 'G' => { # generic fields => [ qw( first second ) ], format => 'x1A30A29', }, ) ; sub parse_iname { my( $iname_text ) = @_ ; #print "INAME [$iname_text]\n" ; my( $iname_type ) = unpack( 'A', $iname_text ) ; my $iname_desc = $iname_descs{ $iname_type } ; #print "FORMAT $iname_desc->{format}\n" ; my %fields ; @fields{ @{$iname_desc->{fields}} } = unpack( $iname_desc->{format}, $iname_text ) ; return \%fields ; } sub load_al3_specs_from_db { my $al3_fld_rows = load_al3_formats_from_db() ; foreach my $fld_row ( @{$al3_fld_rows} ) { my $fld_name = $fld_row->{fld_name} ; $fld_name =~ tr/ //d ; my $rec_type = $fld_row->{rec_type} ; my $rec_desc = $rec_descs{$rec_type} ; if ( $fld_row->{fld_num} == 0 ) { $rec_desc->{format} = '' ; $rec_desc->{fields} = [] ; } my $format ; if ( $fld_name ) { push @{$rec_desc->{fields}}, $fld_name ; $format = 'A' ; } else { $format = 'x' ; } $rec_desc->{format} .= "$format$fld_row->{fld_len}" ; } # print Dumper \%rec_descs ; } sub load_al3_specs_from_file { my( $spec_file ) = @_ ; my %file_specs = eval read_file( $spec_file ) ; while( my( $rec_type, $rec_desc ) = each %file_specs ) { @{$rec_descs{ $rec_type }}{ qw( format fields ) } = @{$rec_desc}{ qw( format fields ) } ; } } sub get_default_rec_descs { return ( '1MHG' => { children => { '2TRG' => 1, '3MTG' => 1, }, is_list => 1, fields => [ qw( header message_address_origination message_address_destination password_user system_type_code interface_software_revision_level message_sequence_number count_unit_code special_handling message_standard_revision_level network_reference_number message_transmission_datetime contract_number ) ], format => 'A10A18A18x10A12A6A4A6x13A1A10A2x1x4x6A20x20A15A20', }, '2TRG' => { children => { '2TCG' => 1, '2GCG' => 1, '5BIS' => 1, '5AOI' => 1, '9AOI' => 1, '9BIS' => 1, }, is_list => 1, fields => [ qw( header transaction_structure_standard_version_number application_software_revision_level transaction_image automation_level transaction_category policy_type_routing_code line_of_business_routing_code transaction_function processing_cycle_status initial_transaction_mode special_response_option error_processing_option formal_transaction_address_sender informal_transaction_address_sender formal_transaction_address_recipient informal_transaction_address_recipient special_handling origination_reference_information transaction_sequence_number processing_cycle_number reference_transaction_sequence_number response_automation_level cyclebusiness_purpose synchronization_field segment_level_code segmented_transaction_counter segmented_transaction_total_pieces quote_date transaction_date transaction_effective_date ) ], format => 'A10A2A8A1A1A2A1A5A3A1A1A1A1A10A25A10A25A10A25A4x6A4A4x6A1A3A10A1A3A3A8x1A8A8', }, '2TCG' => { parent => '2TRG', skip => 1, fields => [ qw( header policy_number_replace_flag ) ], }, '2GCG' => { parent => '2TRG', skip => 1, fields => [ qw( header ) ], format => 'A10', }, '3MTG' => { parent => '1MHG', skip => 1, fields => [ qw( header total_data_in_message additional_data_flag communications_text_flag communications_text ) ], format => 'A10A8A1A1A220', }, '5AOI' => { is_list => 1, fields => [ qw( header interest_id_number nature_of_interest_code interest_rank interest_is_payor_indicator additionalother_interest_name policy_frequency_code policy_requiredissued_code certificate_frequency_code certificate_requiredissued_code bill_frequency_code informational_billing_indicator interest_holder_account_number fixed_identifier policy_date_requiredissued certificate_date interest_end_date percentage_of_interest lien_amount workers_compensation_coverage_indicator ) ], format => 'A30A3A2A2A1A60A1A1x6A1A1x6A1A1x14x6A25A5A8A8A8A5A8A1', }, '5BIS' => { parent => '2TRG', children => { '5BPI' => 1, '9BIS' => 1, }, fields => [ qw( header insured's_name company's_id_for_insured agency's_id_for_insured legal_entity_code number_of_member_and_managers ) ], format => 'A30A60A30A30A2A5x15x0x0', }, '5BPI' => { children => { '5DRV' => 1, '5PAY' => 1, '6PDA' => 1, '5LAG' => 1, '5RMK' => 1, '5PPH' => 1, '6CVH' => 1, }, fields => [ qw( header policy_number company_code line_of_business_code line_of_business_subcode producer_subcode original_policy_inception_date renewal_term current_term_amount net_change_amount other_insurance_with_company_code signed_by_code short_term_premium_method_code billing_method_code payor_code new_account_indicator language_code company_product_code nominal_term_amount written_amount mail_to_code billing_account_number policy_version group_id printed_documents_requested renewal_billing_method_code renewal_payor_code customer_servicing_code state_licensing_number signature_form_type_code date_form_signed policy_effective_date policy_expiration_date rate_date risk_new_to_agency servicingproducing_branch_responsible_person1 servicingproducing_branch_responsible_person2 underwriting_or_carrier_office_code premium_originally_quoted national_producer_number commission_premium minimum_premium state_producer_number taxing_location_code insureds_original_inception_date continuous_insurance_code tier_code ) ], format => 'A30A25x10A6A5A4x6x6A8A8A3A12A12A1A1A1A1A2A1A1A4A12A12x6A1x3x6A20A4A20A1A1A2A1A10A3A8A8A8A8A1A1A1A1A12A9A12A12A9A5A8x1x3A5A5x0x0x0x0', }, '5DRV' => { children => { '5RMK' => 1, '6PDR' => 1, }, is_list => 1, fields => [ qw( header agency_driver's_number company_driver's_number driver's_name social_security_number driver's_license_number licensed_state driver_sex_code license_class_code driver_type_code fixed_identifier date_of_birth date_first_licensed_in_current_state date_licensed date_hired international_driver's_license motorcycle_date_licensed education_level_code current_address_time citizenship_country ) ], format => 'A30A4A4A60A9A25A2x6x6A1A1x6A1A5A8A8A8A8A1A8x2A5A2A3', }, '5LAG' => { children => { '5VEH' => 1, '5PPS' => 1, '6HRU' => 1, }, is_list => 1, fields => [ qw( header location_number street_address_line1 street_address_line2 city stateprovince_abbreviation zip_code county_name tax_code countytown_code risk_location_code country fixed_identifier address_line3 address_line4 fire_district_name fire_district_code_number legal_description place_code section township country_name_code ) ], format => 'A30A4A30A30A19A2A9A19A5A5A1A20A5A30A30A15A5A60A5A30A30A3', }, '5PAY' => { fields => [ qw( header payment_plan_code day_of_month_due deposit_amount percent_down_payment number_of_payments number_of_months_between_payments installment_fee installment_percentage amount_collected_by_agent method_of_payment_code payment_currency_code next_term_payment_plan_code required_deposit_amount ) ], format => 'A30A2A2A12A3A2A2A5A4A12A5A2A2A12x6', }, '5PPH' => { fields => [ qw( header company_code company_name policy_number policy_terminated_code policy_transfer_indicator line_of_business_code line_of_business_subcode prior_carrier_amount_of_coverage years_with_prior_company expiration_date_of_prior_policy inception_date_of_prior_policy no_prior_coverage_insurance liability_per_person_amount liability_per_accident_amount total_paid_loss_amount reserve_total_amount policy_terminated_reason policy_year clue_reference_number ) ], format => 'A30A6A20A25A1A1x6x6A5A4A12A3A8A8A1A12A12A12A12A30A4A10', }, '5PPI' => { is_list => 1, fields => [ qw( header item_description fixed_identifier item_number property_class_code settlement_type_code first_qualifier_type_code second_qualifier_type_code third_qualifier_type_code professionalcommercial_use_indicator exhibited_indicator inout_of_vault_indicator blanket_indicator model territory_code location_number_current location_number_previous valuation_date manufacturer's_name serial_number appraisal_indicator item_value year_of_manufacture ) ], format => 'A30x3x15A150x6x8A5A4A2A2A2A2A2A1A1A1A1A20A3A4A4A8A40A25x1A1A10A4', }, '5PPS' => { children => { '5PPI' => 1, '6CVH' => 1, }, is_list => 1, fields => [ qw( header summary_number property_class_code settlement_type_code first_qualifier_type_code second_qualifier_type_code third_qualifier_type_code professionalcommercial_use_indicator exhibited_indicator total_items_per_summary_group inout_of_vault_indicator blanket_indicator territory_code location_number_current location_number_previous total_value_per_summary_group ) ], format => 'A30A2A2x3x9A2A2A2A2A1A1x5A4A1A1A3A4A4A11', }, '5RMK' => { is_list => 1, fields => [ qw( header data_element_referenced remarks_number remarks_impact_indicator remarks_text ) ], format => 'A30A2A2A1A160', }, '5VEH' => { children => { '6PVH' => 1, '6CVA' => 1, '5AOI' => 1, '9AOI' => 1, }, is_list => 1, fields => [ qw( header company_vehicle_number agency_vehicle_number vehicle_year vehicle_make vehicle_model vehicle_body_type_code vin vehicle_registration_state rating_territory cost_new new_car_indicator vehicle_altered_indicator value_of_alterations vehicle_length fixed_identifier license_plate_registration_number license_plate_expiration_date garaging_location_number_current total_vehicle_full_term_amount total_vehicle_net_change_amount license_plate_effective_date garaging_location_number_previous registered_vehicle_indicator gvwgcw present_value_amount hi_theft_indicator appraisal_amount appraisal_date ) ], format => 'A30A4A4A4A20A20A5A25A2A4A8A1A1A7A2A5A10A8A4A12A12A8A4A1A10A8A1A7A8', }, '6CVA' => { is_list => 1, fields => [ qw( header coverage_code_personal_automobile rate full_term_premium form_number limit1 limit2 deductible option_code1 benefits_code1 option_code2 benefits_code2 option_code3 benefits_code3 deductible_type_code discount_or_surcharge_information_premium coverage_code_description coverage_effective_date coverage_expiration_date form_edition_date number_of_1 number_of_2 number_of_3 ) ], format => 'A30A5x6x6x3A10A12x12x2A10x6A8A8A6x3A2A2A2A2A2A2A2A12A60A8A8A8A5A5A5', }, '6CVH' => { is_list => 1, fields => [ qw( header coverage_code percent_of_coinsurance rate full_term_premium net_change_premium order_of_processing form_number homeowner's_limit1 first_deductible_type_code second_deductible_type_code third_deductible_type_code number_of first_type_of_code second_type_of_code third_type_of_code fourth_type_of_code territory_zone yesno_indicator numeric_value_field description_field numeric_value_format_code homeowner's_limit2 coverage_effective_date coverage_expiration_date form_edition_date umbrella_limit deductible_basis_code first_deductible second_deductible third_deductible coverage_category_code discount_or_surcharge_information_premium ) ], format => 'A30A5x6x6A3A10A12A12A2A10x6A8x5x5x5A2A2A2A3A2A2A2A2A3A1A10A54A1A8A8A8A8A10A5A7A7A7A1A12', }, '6HRU' => { children => { '6CVH' => 1, '5AOI' => 1, '9AOI' => 1, }, is_list => 1, fields => [ qw( header homeowners_policy_type_code construction_type_code year_built number_of_families number_of_rooms residence_type_code number_of_fire_divisions units_within_fire_divisions dwelling_use_code dwelling_rented_to_others protection_class_grade protection_class_improved_indicator territory_code dwelling_location_code hydrant_distance fire_station_distance rating_method_code fireec_rate number_of_apartments ol&t_code fire_district_name fire_district_code_number protection_device_code_temperaturefire protection_device_code_burglar protection_device_code_smoke protection_device_code_sprinkler swimming_pool_code primary_heat_source_code roof_type_code under_construction_indicator business_conducted_on_premises_indicator supplemental_heat_source_code additional_residence_indicator additional_residence_carrier_code additional_residence_policy_number hillsideslope_indicator principal_unitatrisk_indicator thermostatically_controlled_central_heat_indicator door_lock_code fire_extinguisher_indicator daytime_occupancy_indicator visibility_indicator premium_group year_of_occupancy number_of_acres exterior_paint_year earthquake_retrofitbolt_indicator building_effectiveness_grade_type_code building_code_effectiveness_grade storm_shutters_indicator diving_board_indicator purchase_date location_number_current location_number_previous pool_slide_indicator oil_storage_tank_location occupancy_type_code consecutive_months_occupied_each_year wiring_last_inspected_date wiring_improvement_year wiring_improvement_code plumbing_improvement_year plumbing_improvement_code heating_improvement_year heating_improvement_code roofing_improvement_year roofing_improvement_code ul_approval_class homeowners_rating_credit_code homeowners_rating_credit_code homeowners_rating_credit_code homeowners_rating_credit_code homeowners_rating_credit_code homeowners_rating_credit_code homeowners_rating_credit_code homeowners_rating_credit_code building_code_effectiveness_grade_inspection roofing_material_impact_resistive hurricane_resistive_glass_indicator date_heating_system_last_serviced number_of_amps_electric_system circuit_breakers_indicator fuses_indicator plumbing_system_any_known_leaks_indicator condition_of_roof condition_of_plumbing_system mr7984_number_of_part_time_employees_see_6reg_group wiring_type_code buildings_number_of_open_sides payor_code primary_construction_type_percentage siding_type_code siding_type_percentage year_eifs_installed construction_reason_code approved_fence_height_indicator fuel_line_location_code visible_from_road_indicator type_of_business_code day_care_number_of_children trampoline_safety_net_indicator fuel_tank_company_name fuel_tank_aggregate_limit fuel_tank_cleanupsublimit community_name total_number_of_residents_in_household annual_length_time_unoccupied roof_deck_attachment_code windhail_underwriting_association_eligibility ) ], format => 'A30A2A1A4A1A3x9x9A2A3A2A1A2A4A1A3x2A1A4A2A1A9A3A2A15A5A1A1A1A1A1x3x3x3A1x3A1A1A1x1A1A1A6A25A1A1A1A1A1A1A1A3A4x1x1A2x1A4A1A1A2A1A1A8A4A4A1A3A1A2A8A4A1A4A1A4A1A4A1A2A5A5A5A5A5A5A5A5A1A1A1A8A3A1A1x1A1A1A1A1x0A4A1A2A3A1A3A4A1A1A1A1A2A2A1A20A8A8A30A2A2A4A1', }, '6PDA' => { is_list => 1, fields => [ qw( header vehicle_number_company exception_code driving_record_code accident_time total_amount_of_damage bi_indicator bi_amount medical_payments_amount property_damage_liability_amount collision_amount collision_deductible other_physical_damage_amount surcharge_points accidentviolation_description iteration_number company_driver_number pip_amount fixed_identifier place_of_incident paid_loss_date conviction_date accidentviolation_date ) ], format => 'A30x6A4A1A5A4A8A1A8A8A8A8A7A8A2x6x6A40A3A4A8A5A20A8A8A8', }, '6PDR' => { fields => [ qw( header driver_marital_status_code resident_custody_indicator driver_relationship_to_applicant_code vehicle_principally_driven occupation_class_code driver_training_indicator good_student_indicator distant_student_indicator physical_impairmentmedicationtreatment_indicator defensive_driver_indicator mature_driver_indicator driver's_occupation_description license_restricted_indicator good_driver_indicator good_student_date company_vehicle_number_for_owned_vehicles owned_vehicle_indicator company_vehicle_number_for_owned_vehicles owned_vehicle_indicator company_vehicle_number_for_owned_vehicles owned_vehicle_indicator company_vehicle_number_for_owned_vehicles owned_vehicle_indicator company_vehicle_number_for_owned_vehicles owned_vehicle_indicator company_vehicle_number_for_owned_vehicles owned_vehicle_indicator driver_training_completion_date defensive_driver_date mature_driver_date good_student_expiration_date defensive_driver_expiration_date mature_driver_expiration_date motorcycle_driver_training_indicator total_license_points adjusted_total_license_points public_transportation_indicator military_branch military_rank vehicle_at_base_indicator description_of_special_equipment description_of_medication_treatment explanation_of_driving_without_insurance work_loss_declined_indicator ) ], format => 'A30A1A1A1A4A2A1A1A1A1A1x6A1x6A15A1x6x6x6A1A8A4A1A4A1A4A1A4A1A4A1A4A1A8A8A8A8A8A8A1A2A2A1A5A30A1A60A30A60A1', }, '6PVH' => { fields => [ qw( header number_of_cylinders horsepowerdisplacement physical_damage_symbol physical_damage_rate_class_code governing_driver garaging_code leased_vehicle_indicator nonowned_vehicle_indicator principal_antitheft_device_code seen_car_indicator multicar_discount_code damageability_code bumper_discount_indicator vehicle_performance_code pricing_code passive_restraint_code miles_driven_one_way_to_work use_code days_driven_per_week carpool_indicator odometer_reading estimated_annual_mileage driver_number1 driver_1_percent driver_number2 driver_2_percent driver_number3 driver_3_percent driver_number4 driver_4_percent driver_number5 driver_5_percent existing_unrepaired_damage_indicator commuting_destination_territory_code residual_market_facility_indicator antitheft_device_percent_credit antilock_brake_code number_of_axles maximum_speed number_of_youthful_operators traction_control number_of_weeks_per_month driver_number6 driver_6_percent principal_operator_indicator daytime_running_light_indicator vehicle_salvage_title_number engine_type_code date_purchased vehicle_leased_date bi_pd_symbol med_pay_pip_symbol salvaged_indicator collision_symbol comprehensiveother_than_collision_symbol excluded_driver_one excluded_driver_two modification_special_equipment_description modification_special_equipment_cost existing_unrepaired_damage_description rate_class_code ) ], format => 'A30A2A4x4A2x8A8A4A1A1A1A1x8A1A1A1A1A1A1A1A3A1A1A1A6A5A4A3A4A3A4A3A4A3A4A3A1A4A1x7x7x1x1x1x1x1x1x1A2A1A2A2A1A1x3A1A4A3A1A1A15A1x2A8A8A3A3A1A3A3A4A4A30A8A30A9', }, '9AOI' => { is_list => 1, fields => [ qw( header street_address_line1 street_address_line2 city stateprovince_abbreviation zip_code telephone_number interest's_alternate_telephone_number address_line3 address_line4 interest's_telephone_extension_number interest's_extension_for_the_alternate_telephone_number country_name_code telephone_number_type_code alternate_telephone_number_type_code ) ], format => 'A30A30A30A19A2A9A14A14A30A30A10A10A3A1A1', }, '9BIS' => { fields => [ qw( header street_address_line1 street_address_line2 city stateprovince_abbreviation zip_code insured's_telephone_number insured's_alternate_telephone_number county_name tax_code country_name_code insured's_telephone_number_type_code address_line3 address_line4 insured's_alternate_telephone_number_type_code insured's_telephone_number_extension insured's_alternate_telephone_number_extension coinsured's_telephone_number coinsured's_alternate_telephone_number coinsured's_telephone_number_type_code coinsured's_alternate_telephone_number_type_code coinsured's_telephone_number_extension coinsured's_alternate_telephone_number_extension insured's_alternate_telephone_number_2 insured's_alternate_telephone_number_2_type_code insured's_alternate_telephone_number_2_extension education_level_code citizenship_country ) ], format => 'A30A30A30A19A2A9A14A14A19A6A3A1A30A30A1A10A10A14A14A1A1A10A10A14A1A10x2A5A3', }, ) ; } 1 ; # sub build_tree { # my( $self, $parent_type, $parent_rec ) = @_ ; # # get the children types for the parent record # my $child_types = $rec_descs{ $parent_type }{children} ; # # loop over the next records until we find one that isn't a child of this # # parent record # #print "\n\nPARENT $parent_type\n" ; # #print Dumper $child_types ; # # clear the parents for a new transaction # print Dumper \%parent_recs if $parent_type eq '2TRG' && %parent_recs ; # %parent_recs = () if $parent_type eq '2TRG' ; # # get the current or a new record # # if no record, we are at end of input # #print "TYPE $curr_type\n" ; # # if the current record isn't a child of this parent, return so the # # previous parent can handle it. # return unless $child_types->{$curr_type} ; # # see if this child record is a list or a single record # # we processed this record so delete it from the object and we will # # get a new one # delete $self->{curr_rec} ; # if( $child_types ) { # $self->build_tree( $curr_type, $curr_rec ) ; # } # } # #print Dumper $self->{tree} ; # }