package Local::QueryLibrary; use strict; use warnings; use Data::Printer; our $VERSION = 0.0.3; # CPAN version has not been updated since 2004 =head1 NAME SQL::Library - A module for managing simple SQL libraries stored in INI-like files. =head1 VERSION This document refers to version 0.0.3 of SQL::Library. =head1 SYNOPSIS Modification of CPAN SQL::Library - uses its new() and retr() methods and adds a new function in new() to ensure unique entity_name entries. Original SQL::Library silently ignored duplicate entries eg [find_stuff] .... [find_stuff] and appended content of duplicate entry to content of initial entry: $self->{'contents'}->{$curr_name} .= $_; # $curr_name = entity_name of SQL query only includes retr() & elements(), not other methods such as set(), drop(), etc =cut sub new { my $proto = shift; my $options = shift; my $self = { 'options' => $options, 'contents' => undef }; my $curr_name = ''; my @lib_arr = (); if ( ref $self->{'options'}->{'lib'} eq 'ARRAY' ) { # Could be a filehandle or a string. if ( @{ $self->{'options'}->{'lib'} } == 1 ) { @lib_arr = split /(?<=\n)/, $self->{'options'}->{'lib'}->[0]; } else { @lib_arr = @{ $self->{'options'}->{'lib'} }; } } else { open LIB, $self->{'options'}->{'lib'} or die "Cannot open $self->{'options'}->{'lib'}: $!"; @lib_arr = ; close LIB; } #------------------------------------------------------------------------------- my %seen = (); # new code to check for duplicate entries - see below #------------------------------------------------------------------------------- foreach ( @lib_arr ) # each line of library(s) content { next if m{^\s*$}; next if m{^\s*#}; next if m{^\s*//}; if ( m{^\[([^\]]+)\]} ) # gets entity_name of entry eg [find_stuff] { $curr_name = $1; # p $curr_name; #------------------------------------------------------------------------------- die 'already have entry for ' . $curr_name if $seen{$curr_name}++; #------------------------------------------------------------------------------- next; } if ( $curr_name ) { $self->{'contents'}->{$curr_name} .= $_; } } bless $self, $proto; return $self; } =item $OBJ-Eretr( NAME ) Returns the library entry referenced by NAME. =cut sub retr { my ( $self, $entity_name ) = @_; return $self->{'contents'}->{$entity_name}; } sub elements { my $self = shift; return sort keys %{$self->{'contents'}}; } 1;