view release on metacpan or  search on metacpan

lib/LRpt/KeySubst.pm  view on Meta::CPAN

  use LRpt::KeySubst;
  
  wkey_subst( @ARGV );
  

=head1 COMMAND LINE OPTIONS

=over 4

=item --keys=name

Name of a file containing actual values for where keys to be put in 
select templates.

=item --help

Prints help screen.

=back

=cut


use vars qw( @EXPORT @ISA );
@ISA = qw(Exporter);
@EXPORT = qw(wkey_subst);


#
# For JarReader
#
our @keys_rules = ( { 'name' => 'name' },
                   { 'name' => 'key' } );

our @sel_rules = ( { 'name' => 'name' },
                  { 'name' => 'select' } );

=head1 METHODS

In this sections you will find a more or less complete listing of all
methods provided by the package. Note that the package itself is not
public so none of those methods are guaranteed to be maintained in future 
(including the package itself).

=cut

############################################################################

=head2 C<wkey_subst>

  wkey_subst( @ARGV );

Main function. @ARGV is processes by standard Getopt::Long module. Meaning 
of each switch is given in L<SYNOPSIS|"SYNOPSIS">.

=cut

############################################################################
sub wkey_subst
{
    local( @ARGV ) = @_;
    my $keys_file    = "";
    my $help         = "";

    GetOptions( "keys=s"    => \$keys_file,
                "help"      => \$help ); 
    if( !$keys_file or $help ){
        print_usage();
        exit( 1 );
    }

    my $key_jr = LRpt::JarReader->new( 'rules'    => \@keys_rules,
                                       'filename' => $keys_file );
    
    $key_jr->read_all();                               
    unshift( @ARGV, "-" ) unless @ARGV;
    while( my $file = shift( @ARGV ) ){
        open( SEL_FILE, "< $file" ) or die "Cannot open $file for reading: $!";
        my $select_jr = LRpt::JarReader->new( 'rules'    => \@sel_rules,
                                              'filehandle' => *SEL_FILE );
    
        $select_jr->read_all(); 

        my @sel_names = $select_jr->get_all_values_of( 'name' );
        foreach my $sel ( @sel_names ){
            my $section = $select_jr->get_section_with( 'name' => $sel );
            my $select = $section->{ 'select' };
            print "name: $sel\n";
            while( $select =~ /--(\w+)--/ ){
                my $key_name = $1;
                my $sect = $key_jr->get_section_with( 'name' => $key_name );
                if( !$sect ){
                     die "Key $key_name not defined or empty value given";
                }else{
                    my $value = $sect->{ 'key' };
                    $select =~ s/--$key_name--/$value/g;
                }
            }
            print "select: $select\n";
            print "%%\n";
        }
        close( SEL_FILE ) or die "Cannot close $file : $!"; 
    }
}

###########################################################################

=head2 C<print_usage>

  print_usage();

Prints usage text

=cut

###########################################################################
sub print_usage
{
    print "Usage:  $0 --help --keys=<name> filenames\n"; 
    print "\n";
    print "  --help          - prints this help screen\n";