Attachment #67571 for issue #108891

View | Details | Raw Unified | Return to issue 108891
Collapse All | Expand All




:
    eval 'exec perl -S $0 ${1+"$@"}'
        if 0;
#*************************************************************************
#
# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
# 
# Copyright 2008, 2010 by Sun Microsystems, Inc.
#
# OpenOffice.org - a multi-platform office productivity suite
#
# $RCSfile: api-to-idl.pl,v $
#
# $Revision: 1.3 $
#
# This file is part of OpenOffice.org.
#
# OpenOffice.org is free software: you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License version 3
# only, as published by the Free Software Foundation.
#
# OpenOffice.org is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Lesser General Public License version 3 for more details
# (a copy is included in the LICENSE file that accompanied this code).
#
# You should have received a copy of the GNU Lesser General Public License
# version 3 along with OpenOffice.org.  If not, see
# <http://www.openoffice.org/license.html>
# for a copy of the LGPLv3 License.
#
#*************************************************************************

sub usage() {
    print "Usage: api-to-idl.pl source.api destination_path\n";
    print;
    print "This tool converts oovbaapi *.api files into *.idl's.\n";
    exit 1;
}

my $src = shift;
my $dest = shift;

if ( !defined( $src ) || !defined( $dest ) || $src eq "-h" || $src eq "--help" ) {
    usage();
}

# Parsing functions
my $state = "";
my $source = "";
my $name = "";
my $value = "";

my %result;

# Process element start event
sub start_element($) {
    my ($el) = @_;

    @element_attr = split( /\s+/, $el );
    my $element = $element_attr[0];

    if ( $element eq "element" ) {
        if ( $element_attr[1] =~ /type="?([^"]*)"?/ && $1 eq "constant" ) {
            $state = "constant";
            $source = "";
            $name = "";
            $value = "";
        }
    }
    elsif ( $state eq "constant" && $element eq "source" ) {
        $state = "source";
        if ( $element_attr[1] =~ /id="?([^"]*)"?/ ) {
            chomp( $source = $1 );
        }
    }
    elsif ( $state eq "source" && $element eq "name" ) {
        $state = "name";
    }
    elsif ( $state eq "source" && $element eq "value" ) {
        $state = "value";
    }
}

# Process element end event
sub end_element($) {
    my ($element) = @_;

    if ( $state eq "name" && $element eq "name" ) {
        $state = "source";
    }
    elsif ( $state eq "value" && $element eq "value" ) {
        $state = "source";
    }
    elsif ( $state ne "" && $element eq "element" ) {
        $state = "";
        
        my @destination = split( /\./, $source );
        my $module = shift( @destination );
        my $type = shift( @destination );

        $module =~ tr/[A-Z]/[a-z]/;

        $result{$module} = {} unless exists $result{$module};
        $result{$module}{$type} = [] unless exists $result{$module}{$type};

        push( @{$result{$module}{$type}},
              { "name" => $name, "value" => $value } );
    }
}

# Process characters
sub characters($) {
    my ($data) = @_;
    
    if ( $state eq "name" ) {
        chomp( $name = $data );
    }
    elsif ( $state eq "value" ) {
        chomp( $value = $data );
    }
}

# Create idls from the parsed data
sub generate_idls($) {
    my ($path) = @_;
    
    foreach $module ( keys %result ) {
        foreach $type ( keys %{$result{$module}} ) {
            my $fname = $path . "/" . $type . ".idl";
            if ( uc($module) eq "ADODB" || uc($module) eq "DAO" ) {
                $fname = $path . "/" . uc($module) . "_" . $type . ".idl";
            }
            open( IDL, ">$fname" ) || die "Cannot write $fname.";
            
            if( $module eq "vba" ) {
		print IDL "module ooo { module $module {\n";
	    }
	    else {
            	print IDL "module ooo { module vba { module $module {\n";
            }

            print IDL "    constants $type {\n";
            foreach $constant ( @{$result{$module}{$type}} ) {
                print IDL "        const long $constant->{'name'} = $constant->{'value'};\n";
            }
            if( $module eq "vba" ) {
		print IDL "    };\n}; };\n";
	    }
	    else {
            	print IDL "    };\n}; }; };\n";
            }

            close( IDL );
        }
    }
}

# Parse the input
open( IN, "<$src" ) || die "Cannot open $src.";

my $in_comment = 0;
my $line = "";
while (<IN>) {
    # ignore comments
    s/<!--[^>]*-->//g;
    if ( /<!--/ ) {
        $in_comment = 1;
        s/<!--.*//;
    }
    elsif ( /-->/ && $in_comment ) {
        $in_comment = 0;
        s/.*-->//;
    }
    elsif ( $in_comment ) {
        next;
    }
    # ignore empty lines
    chomp;
    s/^\s*//;
    s/\s*$//;
    next if ( $_ eq "" );

    # take care of lines where element continues
    if ( $line ne "" ) {
	$line .= " " . $_;
    }
    else {
	$line = $_;
    }
    next if ( !/>$/ );

    # the actual parsing
    my @starts = split( /</, $line );
    $line = "";
    foreach $start ( @starts ) {
        next if ( $start eq "" );

        @ends = split( />/, $start );
        my $element = $ends[0];
        my $data = $ends[1];

        # start or end element
        if ( $element =~ /^\/(.*)/ ) {
            end_element( $1 );
        }
        else {
            start_element( $element );
        }

        # the data
        characters( $data );
    }
}
close( IN );

# Generate the output
generate_idls($dest);

Return to issue 108891

Lines 1-216 Link Here

(-)./old/oovbaapi/genconstidl/api-to-idl.pl (-216 / +219 lines)
1	:	1	:
2	eval 'exec perl -S $0 ${1+"$@"}'	2	eval 'exec perl -S $0 ${1+"$@"}'
3	if 0;	3	if 0;
4	#*************************************************************************	4	#*************************************************************************
5	#	5	#
6	# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.	6	# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
7	#	7	#
8	# Copyright 2008 by Sun Microsystems, Inc.	8	# Copyright 2008, 2010 by Sun Microsystems, Inc.
9	#	9	#
10	# OpenOffice.org - a multi-platform office productivity suite	10	# OpenOffice.org - a multi-platform office productivity suite
11	#	11	#
12	# $RCSfile: api-to-idl.pl,v $	12	# $RCSfile: api-to-idl.pl,v $
13	#	13	#
14	# $Revision: 1.3 $	14	# $Revision: 1.3 $
15	#	15	#
16	# This file is part of OpenOffice.org.	16	# This file is part of OpenOffice.org.
17	#	17	#
18	# OpenOffice.org is free software: you can redistribute it and/or modify	18	# OpenOffice.org is free software: you can redistribute it and/or modify
19	# it under the terms of the GNU Lesser General Public License version 3	19	# it under the terms of the GNU Lesser General Public License version 3
20	# only, as published by the Free Software Foundation.	20	# only, as published by the Free Software Foundation.
21	#	21	#
22	# OpenOffice.org is distributed in the hope that it will be useful,	22	# OpenOffice.org is distributed in the hope that it will be useful,
23	# but WITHOUT ANY WARRANTY; without even the implied warranty of	23	# but WITHOUT ANY WARRANTY; without even the implied warranty of
24	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the	24	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25	# GNU Lesser General Public License version 3 for more details	25	# GNU Lesser General Public License version 3 for more details
26	# (a copy is included in the LICENSE file that accompanied this code).	26	# (a copy is included in the LICENSE file that accompanied this code).
27	#	27	#
28	# You should have received a copy of the GNU Lesser General Public License	28	# You should have received a copy of the GNU Lesser General Public License
29	# version 3 along with OpenOffice.org. If not, see	29	# version 3 along with OpenOffice.org. If not, see
30	# <http://www.openoffice.org/license.html>	30	# <http://www.openoffice.org/license.html>
31	# for a copy of the LGPLv3 License.	31	# for a copy of the LGPLv3 License.
32	#	32	#
33	#*************************************************************************	33	#*************************************************************************
34		34
35	sub usage() {	35	sub usage() {
36	print "Usage: api-to-idl.pl source.api destination_path\n";	36	print "Usage: api-to-idl.pl source.api destination_path\n";
37	print;	37	print;
38	print "This tool converts oovbaapi .api files into .idl's.\n";	38	print "This tool converts oovbaapi .api files into .idl's.\n";
39	exit 1;	39	exit 1;
40	}	40	}
41		41
42	my $src = shift;	42	my $src = shift;
43	my $dest = shift;	43	my $dest = shift;
44		44
45	if ( !defined( $src ) \|\| !defined( $dest ) \|\| $src eq "-h" \|\| $src eq "--help" ) {	45	if ( !defined( $src ) \|\| !defined( $dest ) \|\| $src eq "-h" \|\| $src eq "--help" ) {
46	usage();	46	usage();
47	}	47	}
48		48
49	# Parsing functions	49	# Parsing functions
50	my $state = "";	50	my $state = "";
51	my $source = "";	51	my $source = "";
52	my $name = "";	52	my $name = "";
53	my $value = "";	53	my $value = "";
54		54
55	my %result;	55	my %result;
56		56
57	# Process element start event	57	# Process element start event
58	sub start_element($) {	58	sub start_element($) {
59	my ($el) = @_;	59	my ($el) = @_;
60		60
61	@element_attr = split( /\s+/, $el );	61	@element_attr = split( /\s+/, $el );
62	my $element = $element_attr[0];	62	my $element = $element_attr[0];
63		63
64	if ( $element eq "element" ) {	64	if ( $element eq "element" ) {
65	if ( $element_attr[1] =~ /type="?([^"]*)"?/ && $1 eq "constant" ) {	65	if ( $element_attr[1] =~ /type="?([^"]*)"?/ && $1 eq "constant" ) {
66	$state = "constant";	66	$state = "constant";
67	$source = "";	67	$source = "";
68	$name = "";	68	$name = "";
69	$value = "";	69	$value = "";
70	}	70	}
71	}	71	}
72	elsif ( $state eq "constant" && $element eq "source" ) {	72	elsif ( $state eq "constant" && $element eq "source" ) {
73	$state = "source";	73	$state = "source";
74	if ( $element_attr[1] =~ /id="?([^"]*)"?/ ) {	74	if ( $element_attr[1] =~ /id="?([^"]*)"?/ ) {
75	chomp( $source = $1 );	75	chomp( $source = $1 );
76	}	76	}
77	}	77	}
78	elsif ( $state eq "source" && $element eq "name" ) {	78	elsif ( $state eq "source" && $element eq "name" ) {
79	$state = "name";	79	$state = "name";
80	}	80	}
81	elsif ( $state eq "source" && $element eq "value" ) {	81	elsif ( $state eq "source" && $element eq "value" ) {
82	$state = "value";	82	$state = "value";
83	}	83	}
84	}	84	}
85		85
86	# Process element end event	86	# Process element end event
87	sub end_element($) {	87	sub end_element($) {
88	my ($element) = @_;	88	my ($element) = @_;
89		89
90	if ( $state eq "name" && $element eq "name" ) {	90	if ( $state eq "name" && $element eq "name" ) {
91	$state = "source";	91	$state = "source";
92	}	92	}
93	elsif ( $state eq "value" && $element eq "value" ) {	93	elsif ( $state eq "value" && $element eq "value" ) {
94	$state = "source";	94	$state = "source";
95	}	95	}
96	elsif ( $state ne "" && $element eq "element" ) {	96	elsif ( $state ne "" && $element eq "element" ) {
97	$state = "";	97	$state = "";
98		98
99	my @destination = split( /\./, $source );	99	my @destination = split( /\./, $source );
100	my $module = shift( @destination );	100	my $module = shift( @destination );
101	my $type = shift( @destination );	101	my $type = shift( @destination );
102		102
103	$module =~ tr/[A-Z]/[a-z]/;	103	$module =~ tr/[A-Z]/[a-z]/;
104		104
105	$result{$module} = {} unless exists $result{$module};	105	$result{$module} = {} unless exists $result{$module};
106	$result{$module}{$type} = [] unless exists $result{$module}{$type};	106	$result{$module}{$type} = [] unless exists $result{$module}{$type};
107		107
108	push( @{$result{$module}{$type}},	108	push( @{$result{$module}{$type}},
109	{ "name" => $name, "value" => $value } );	109	{ "name" => $name, "value" => $value } );
110	}	110	}
111	}	111	}
112		112
113	# Process characters	113	# Process characters
114	sub characters($) {	114	sub characters($) {
115	my ($data) = @_;	115	my ($data) = @_;
116		116
117	if ( $state eq "name" ) {	117	if ( $state eq "name" ) {
118	chomp( $name = $data );	118	chomp( $name = $data );
119	}	119	}
120	elsif ( $state eq "value" ) {	120	elsif ( $state eq "value" ) {
121	chomp( $value = $data );	121	chomp( $value = $data );
122	}	122	}
123	}	123	}
124		124
125	# Create idls from the parsed data	125	# Create idls from the parsed data
126	sub generate_idls($) {	126	sub generate_idls($) {
127	my ($path) = @_;	127	my ($path) = @_;
128		128
129	foreach $module ( keys %result ) {	129	foreach $module ( keys %result ) {
130	foreach $type ( keys %{$result{$module}} ) {	130	foreach $type ( keys %{$result{$module}} ) {
131	my $fname = $path . "/" . $type . ".idl";	131	my $fname = $path . "/" . $type . ".idl";
132	open( IDL, ">$fname" ) \|\| die "Cannot write $fname.";	132	if ( uc($module) eq "ADODB" \|\| uc($module) eq "DAO" ) {
133		133	$fname = $path . "/" . uc($module) . "_" . $type . ".idl";
134	if( $module eq "vba" ) {	134	}
135	print IDL "module ooo { module $module {\n";	135	open( IDL, ">$fname" ) \|\| die "Cannot write $fname.";
136	}	136
137	else {	137	if( $module eq "vba" ) {
138	print IDL "module ooo { module vba { module $module {\n";	138	print IDL "module ooo { module $module {\n";
139	}	139	}
140		140	else {
141	print IDL " constants $type {\n";	141	print IDL "module ooo { module vba { module $module {\n";
142	foreach $constant ( @{$result{$module}{$type}} ) {	142	}
143	print IDL " const long $constant->{'name'} = $constant->{'value'};\n";	143
144	}	144	print IDL " constants $type {\n";
145	if( $module eq "vba" ) {	145	foreach $constant ( @{$result{$module}{$type}} ) {
146	print IDL " };\n}; };\n";	146	print IDL " const long $constant->{'name'} = $constant->{'value'};\n";
147	}	147	}
148	else {	148	if( $module eq "vba" ) {
149	print IDL " };\n}; }; };\n";	149	print IDL " };\n}; };\n";
150	}	150	}
151		151	else {
152	close( IDL );	152	print IDL " };\n}; }; };\n";
153	}	153	}
154	}	154
155	}	155	close( IDL );
156		156	}
157	# Parse the input	157	}
158	open( IN, "<$src" ) \|\| die "Cannot open $src.";	158	}
159		159
160	my $in_comment = 0;	160	# Parse the input
161	my $line = "";	161	open( IN, "<$src" ) \|\| die "Cannot open $src.";
162	while (<IN>) {	162
163	# ignore comments	163	my $in_comment = 0;
164	s/<!--[^>]*-->//g;	164	my $line = "";
165	if ( /<!--/ ) {	165	while (<IN>) {
166	$in_comment = 1;	166	# ignore comments
167	s/<!--.*//;	167	s/<!--[^>]*-->//g;
168	}	168	if ( /<!--/ ) {
169	elsif ( /-->/ && $in_comment ) {	169	$in_comment = 1;
170	$in_comment = 0;	170	s/<!--.*//;
171	s/.*-->//;	171	}
172	}	172	elsif ( /-->/ && $in_comment ) {
173	elsif ( $in_comment ) {	173	$in_comment = 0;
174	next;	174	s/.*-->//;
175	}	175	}
176	# ignore empty lines	176	elsif ( $in_comment ) {
177	chomp;	177	next;
178	s/^\s*//;	178	}
179	s/\s*$//;	179	# ignore empty lines
180	next if ( $_ eq "" );	180	chomp;
181		181	s/^\s*//;
182	# take care of lines where element continues	182	s/\s*$//;
183	if ( $line ne "" ) {	183	next if ( $_ eq "" );
184	$line .= " " . $_;	184
185	}	185	# take care of lines where element continues
186	else {	186	if ( $line ne "" ) {
187	$line = $_;	187	$line .= " " . $_;
188	}	188	}
189	next if ( !/>$/ );	189	else {
190		190	$line = $_;
191	# the actual parsing	191	}
192	my @starts = split( /</, $line );	192	next if ( !/>$/ );
193	$line = "";	193
194	foreach $start ( @starts ) {	194	# the actual parsing
195	next if ( $start eq "" );	195	my @starts = split( /</, $line );
196		196	$line = "";
197	@ends = split( />/, $start );	197	foreach $start ( @starts ) {
198	my $element = $ends[0];	198	next if ( $start eq "" );
199	my $data = $ends[1];	199
200		200	@ends = split( />/, $start );
201	# start or end element	201	my $element = $ends[0];
202	if ( $element =~ /^\/(.*)/ ) {	202	my $data = $ends[1];
203	end_element( $1 );	203
204	}	204	# start or end element
205	else {	205	if ( $element =~ /^\/(.*)/ ) {
206	start_element( $element );	206	end_element( $1 );
207	}	207	}
208		208	else {
209	# the data	209	start_element( $element );
210	characters( $data );	210	}
211	}	211
212	}	212	# the data
213	close( IN );	213	characters( $data );
214		214	}
215	# Generate the output	215	}
216	generate_idls($dest);	216	close( IN );
		217
		218	# Generate the output
		219	generate_idls($dest);