#!/usr/bin/perl -w ###################################################################### # # # Code2HTML # # --------- # # # # Code2Html, version 0.5.0, Apr 1999, ppalfrad@cosy.sbg.ac.at # # # # AUTHOR # # Peter Palfrader, computer science student at the # # university of Salzburg/Austria. Written in 1999. # # # # DESCRIPTION # # code2html.pl is a perlscript which converts a program # # source code to HTML by applying a set of regular # # expressions depending on the language the source code is # # written. # # # # LICENSE # # Copyright (c) 1999 by Peter Palfrader. # # Not derived from licensed software. # # # # Permission is granted to anyone to use this software for # # any purpose on any computer system, and to redistribute it # # in any way, subject to the following restrictions: # # # # 1. The author is not responsible for the consequences of # # use of this software, no matter how awful, even if they # # arise from defects in it. # # 2. The origin of this software must not be misrepresented, # # either by explicit claim or by omission. # # 3. Altered versions must be plainly marked as such, and # # must not be misrepresented (by explicit claim or # # omission) as being the original software. # # 3a. It would be nice if I got a copy of your improved # # version sent to ppalfrad@cosy.sbg.ac.at. However this # # is not obligatory. # # 4. This notice must not be removed or altered. # # # # # # # # The regular expressions are not subject to this license. # # They have been taken from NEdit and were then slightly # # modified by me. # # # # I do not know who wrote which patterns, so I list all the # # names found in the NEdit About: # # Simon T. MacDonald, Maurice Leysens, Matt Majka, Alfred # # Smeenk, Alain Fargues, Christopher Conrad, Scott # # Markinson, and Konrad Bernloehr. # # # # I do not know under wich terms these pattens may be used, # # however I think those patterns have been written to be # # used. If you do not agree and come to the conclusion that # # you do not want to use these patterns, please delete them # # from the get_default_database function. # # # ###################################################################### # # # HISTORY # # # # 0.5.0 - Apr 1999 # # * changed find_all_matches__create_taglist__insert_placeholders # # so that it works around a bug in earlier perl versions, in which # # pos() is not set if the return value of m//g is not used. # # * changed a regex in get_config_file # # # # 0.4.1 - Mar 1999 # # * changed JavaScript regexps slightly # # * changed find_all_matches_.. slightly # # # # 0.4.0 - Mar 1999 # # * script no longer needs $' and $` thus beeing faster. $& is still # # needed # # * regexps for perl changed slightly # # * find_all_matches has been completly rewritten. verify is no # # longer needed. taglist is built while searching. # # May take a bit longer now, but otherwhise a bug could not have # # been fixed. # # * changed (fixed?) start of language_def_block pos evaluation # # # # 0.3.3 - Feb 1999 # # * fixed STDIN/STDOUT parameters when passed a - the scrpit though # # options would follow and didn't tread this as a handle for STDIN # # * added -V as shortcut to --version # # # # 0.3.2 - Feb 1999 # # * removed -T from 1st line so activePerl will run the script # # without any modifications # # * changed perl string regexps. run now faster and better # # (and run at all under win) # # * added --replace_tabs # # # # 0.3.1 - Feb 1999 # # * fixed language files bug (lang_mode no longer # # starts langmode) # # * fixed empty html tag bug when reading lang specs # # * added languages: Makefile, Java, JavaScript, Perl # # * added --modes # # # # 0.3.0 - Feb 1999 # # * added linenumbers # # * added and tag in html output # # * fixed crlf switch works now # # # # 0.2.0 - Feb 1999 # # * first official release # # # ###################################################################### use strict; #$\ = "\n"; $/ = "\n"; &main; sub main { my $vernr = "0.5.0"; my $monthshort = "Apr"; my $monthlong = "April"; my $pure_version_message = "\nCode2Html, version $vernr, $monthshort 1999, ppalfrad\@cosy.sbg.ac.at\n\n"; my $version_message = "\n$pure_version_message\n\n"; my $help_message = " $pure_version_message NAME code2html.pl - Converts a program source code to HTML SYNOPSIS code2html.pl language_mode [input_file [output_file]] [-vrhnmV] [--verbose] [--crlf] [--help] [--linenumbers] [--version] [--modes] [-t [NR_OF_SPACES]] [--replace_tabs [NR_OF_SPACES]] [-l FILE] [--language_file FILE] [--dumb_default_lang] DESCRIPTION code2html.pl is a perlscript which converts a program source code to HTML by applying a set of regular expressions depending on the language the source code is written. OPTIONS language_mode Specify the set of regular expressions to use. These have to be defined in a langugage file (see FILES below). To find out which language modes are defined, issue a code2html.pl --modes. This input is treated case-insensitive. input_file Is the file which contains the program source code to be formatted. If not specified or a minus (-) is given, the code will be read from STDIN. output_file Is the file ro write the formatted code to. If not specified or a minus (-) is given, the code will be written to STDOUT. -v, --verbose Prints progress information to STDERR. You will not need this. -r, --crlf Usually the program output is print with a newline (\\n) only as a line delimiter. However if you want to use carrige return/line feed (\\r\\n or crlf) as a line delimiter, so be it. -n, --linenumbers Print out the source code with line numbers. -t, --replace_tabs [SPACE_COUNT] Replace each occurence of a <TAB> character with spaces. The default number of spaces is 4 but this can be changed by an optional argument. -l, --language_file FILE Specify an alternate languages file to take the regular expressions from (see FILES below). -m, --modes Print all defined modes currently defined to STDOUT and exit succesfully. Also prints modes from a given language_file if applicable. --dumb_default_lang Write default language file to STDOUT and exit succesfully. -h, -? --help Print this text and exit succesfully. -V --version Print the program version and exit succesfully. BUGS If the input file contains all 256 possible characters then all character values of 255 will be changed to values of 254. I don't think this is a problem and so I will not try to find a other way to code this stuff. If however this is a problem for you, let me know and I will rethink my strategy. Please report bugs to ppalfrad\@cosy.sbg.ac.at. This program is still in beta so you might find some. Also have a look at my web-site, perhaps a new version is available already: http://www.cosy.sbg.ac.at/~ppalfrad/ FILES file specified by -l or --language_file if any ./code2html.config /etc/code2html.config built in default languages These databases will be searched in that order for the set of regular expressions specified by the language_mode parameter. The first set of regular expression which is found will be taken. The files must have the following structure: Empty lines are ignored. Every line beginning with a pound sign (#) is a comment. Note that a line actually must start with this character (apart from tabs and spaces) in order to be a comment. A language starts with the name of it's section in brackets. Aliases may be defined withing the same brackets seperated by a comma (,). Examples: [c] [c++,cpp,cc] Then the default background and text colours may be set. If not defined they default to #ffffff (white) for the background and #000000 (black) for the text. bgcolor=#ffffff textcolor=#000000 Spaces and Tabs before and after the equals-sign (=) are allowed. The first non whitespace after the = sign until the end of line will then be copied to the bgcolor and the text options in the HTMLs body tag. As a third step the regular expressions must be defined: A line defining this consist of three parts: The html tag to insert at the start of the pattern's occurance, one to insert at the end and the pattern itself. All three parts must be enclosed in double quotes(\") and are seperated by commas (,). If one of those parts contains a double quote, this must be escaped with a backshlash (\\). Example: \"<i>\", \"</i>\", \"\\\".*?\\\"\" This line prints all strings enclosed by double quotes italic. If a line starts with a minus (-) then this pattern is applied to the matched part of the previos line that had no minus in front. So you can highlight for example escape characters in strings. - \"<strong>\", \"</strong>\", \"\\\\.\" If you ever write languages files yourself, I'ld be happy if you could send be them, so I put them on my homepage with full credits of course. Before you do so you might also have a look at my site to check wheter someone has written the file for your language already. web-site: http://www.cosy.sbg.ac.at/~ppalfrad/ AUTHOR Peter Palfrader, computer science student at the university of Salzburg/Austria. Written in $monthlong 1999. LICENSE Copyright (c) 1999 by Peter Palfrader. Not derived from licensed software. Permission is granted to anyone to use this software for any purpose on any computer system, and to redistribute it in any way, subject to the following restrictions: 1. The author is not responsible for the consequences of use of this software, no matter how awful, even if they arise from defects in it. 2. The origin of this software must not be misrepresented, either by explicit claim or by omission. 3. Altered versions must be plainly marked as such, and must not be misrepresented (by explicit claim or omission) as being the original software. 3a. It would be nice if I got a copy of your improved version sent to ppalfrad\@cosy.sbg.ac.at. However this is not obligatory. 4. This notice must not be removed or altered. The regular expressions are not subject to this license. They have been taken from NEdit and were then slightly modified by me. I do not know who wrote which patterns, so I list all the names found in the NEdit About: Simon T. MacDonald, Maurice Leysens, Matt Majka, Alfred Smeenk, Alain Fargues, Christopher Conrad, Scott Markinson, and Konrad Bernloehr. I do not know under wich terms these pattens may be used, however I think those patterns have been written to be used. If you do not agree and come to the conclusion that you do not want to use these patterns, please delete them from the get_default_database function. "; my $short_help = " $pure_version_message NAME code2html.pl - Converts a program source code to HTML SYNOPSIS code2html.pl language_mode [input_file [output_file]] [-vrhnmV] [--verbose] [--crlf] [--help] [--linenumbers] [--version] [--modes] [-t [NR_OF_SPACES]] [--replace_tabs [NR_OF_SPACES]] [-l FILE] [--language_file FILE] [--dumb_default_lang] DESCRIPTION code2html.pl is a perlscript which converts a program source code to HTML by applying a set of regular expressions depending on the language the source code is written. "; my @config_files = ("./code2html.config", "/etc/code2html.config"); my $langmode = ""; # language mode my $verbose = 0; my $infile = ""; my $outfile = ""; my $language_file = ""; my $crlf = 0; my $linenumbers = 0; my $modes = 0; my $tabs = -1; &parse_params($verbose, $langmode, $infile, $outfile, $language_file, $crlf, $linenumbers, $modes, $tabs, $help_message, $version_message, $short_help); my $hidechar = ""; # a character that must not exist in the code and which is used as a placeholder # will be set in $code; my $bgcolor = "#ffffff"; #default value only. will be set in parse_config_part my $textcolor = "#000000"; #default value only. will be set in parse_config_part print STDERR "parsing config file...\n" if ($verbose); my @regexps = &parse_config_part(&get_config_file(\@config_files, $langmode, $language_file, $modes), $bgcolor, $textcolor);print STDERR "loading input file...\n" if ($verbose); my $code = &get_input_file($hidechar, $infile, $tabs); print STDERR "finding all matches, inserting placeholders, creating taglist...\n" if ($verbose); my @taglist = &find_all_matches__create_taglist__insert_placeholders(\@regexps, $code, $hidechar); print STDERR "converting source code to HTML...\n" if ($verbose); $code = &convert_code_2_html($code); print STDERR "replacing placeholders with appropriate HTML tags...\n" if ($verbose); $code = &insert_tags(\@taglist, $code, $hidechar); print STDERR "outputting file...\n" if ($verbose); &put_output($code, $bgcolor, $textcolor, $outfile, $crlf, (($infile eq "-")?"STDIN":$infile), $linenumbers); } ################################################################################ ####################### parse_params ########################################### ################################################################################ sub parse_params { # 0 out : verbose # 1 out : $langmode # 2 out : $infile # 3 out : $outfile # 4 out : $language_file # 5 out : $crlf # 6 out : $linenumbers # 7 out : $modes # 8 out : $tabs # 9 in : $help_message # 10 in : $version_message # 11 in : $short_help my $verbose = 0; my $langmode = ""; my $infile = "-"; my $outfile = "-"; my $language_file = ""; my $crlf = 0; my $linenumbers = 0; my $modes = 0; my $tabs = -1; my $help_message = $_[9]; my $version_message = $_[10]; my $short_help = $_[11]; my $this_one_is_the_language_file = 0; my $tab_value_may_follow = 0; my $paramcount = 0; for (@ARGV) { if ($this_one_is_the_language_file) { $language_file = $_; $this_one_is_the_language_file = 0; } elsif (($tab_value_may_follow)&&(!($_ =~ /[^\d]/))) { $tabs = $_; } else { if ((length($_) > 1) && (substr($_, 0, 1) eq "-")) { if (substr($_, 1, 1) eq "-") { if ($_ eq "--verbose") { $verbose = 1 } elsif ($_ eq "--crlf") { $crlf = 1 } elsif ($_ eq "--linenumbers") { $linenumbers = 1 } elsif ($_ eq "--modes") { $modes = 1; } elsif ($_ eq "--help") { print $help_message; exit 0 } elsif ($_ eq "--version") { print $version_message; exit 0 } elsif ($_ eq "--dumb_default_lang") { print &get_default_database; exit 0 } elsif ($_ eq "--language_file") { $this_one_is_the_language_file = 1; } elsif ($_ eq "--replace_tabs") { $tabs = 4; $tab_value_may_follow = 1} } else { $modes += s/m//g; $verbose += s/v//g; $crlf += s/r//g; $linenumbers += s/n//g; if (s/h//g + s/\?//g) { print $help_message; exit 0 }; if (s/V//g + s/\?//g) { print $version_message; exit 0 }; if (s/l//) { $this_one_is_the_language_file = 1}; if (s/t//) { $tabs = 4; $tab_value_may_follow = 1}; } } else { if ($paramcount == 2) {$paramcount++; $_ =~ /(^.*$)/; $outfile = $1;} # I hate taint mode elsif ($paramcount == 1) {$paramcount++; $infile = $_} elsif ($paramcount == 0) {$paramcount++; $langmode = $_} else { print STDERR "\nToo many parameters.\n\n"; print STDERR $short_help; print STDERR "\n\nrun code2html --help for furhter help\n"; exit 1; } } } }; if ((($this_one_is_the_language_file) || ($langmode eq "")) && (!$modes)) { print STDERR "\nParameters missing.\n\n"; print STDERR $short_help; print STDERR "\n\nrun code2html --help for furhter help\n"; exit 1; } # out : verbose # out : $langmode # out : $infile # out : $outfile # out : $language_file $_[0] = $verbose; $_[1] = $langmode; $_[2] = $infile; $_[3] = $outfile; $_[4] = $language_file; $_[5] = $crlf; $_[6] = $linenumbers; $_[7] = $modes; $_[8] = $tabs; }; ################################################################################ ####################### get_one_config_file #################################### ################################################################################ sub get_one_config_file { #in: filename #in: langmode already meta quoted. #in: modes; #returns config file as string if (!open FILEHANDLE, "<$_[0]") {return ""}; my $result = ""; if ($_[2]) { while (<FILEHANDLE>) { $_ =~ s/\n//g; $_ =~ s/^[ \t]*(.*)[ \t]*/$1/; #remove beginning and trailing spaces / tabs if (substr($_,0,1) eq "[") { print " ".$_."\n"; } }; } else { while (<FILEHANDLE>) { $_ =~ s/^[ \t]*(.*)[ \t]*/$1/; #remove beginning and trailing spaces / tabs last if ($_ =~ m/\[(.*?[, ])?$_[1]([, ].*?)?\]/i); } while (<FILEHANDLE>) { $_ =~ s/\n//g; $_ =~ s/^[ \t]*(.*)[ \t]*/$1/; #remove beginning and trailing spaces / tabs last if (substr($_,0,1) eq "["); #new language mode if (($_ ne "")&&(substr($_, 0, 1) ne "#")) { $_ =~ /(^.*$)/; # untaint input $result .= $1."\n" } }; }; close FILEHANDLE; return $result; }; ################################################################################ ####################### get_config_file ######################################## ################################################################################ sub get_config_file { #in : @config_files #in : $langmode; #in : $language_file; #in : $modes; #returns config file as string #Apply language mode my $result = ""; my $lm = quotemeta($_[1]); my $langfile = $_[2]; my $modes = $_[3]; if ($modes) { print "\n\nDefined language modes:\n"; print "-----------------------\n"; print "(You may use any of the names seperated\n"; print "by commas to refer to a certain mode.)\n\n"; }; if ($langfile ne "") { if ($modes) { print "in specified langfile:\n"; }; $result = &get_one_config_file($langfile, $lm, $modes); }; if ($result eq "") { for (@{$_[0]}) { if ($modes) { print "in file $_:\n"; }; $result = &get_one_config_file($_, $lm, $modes); if ($result ne "") {last;}; }; }; if ($result eq "") { $result = &get_default_database; $result =~ s/\r\n/\n/g; if ($modes) { print "in default database:\n"; my @lines = split(/\n/,$result); for (@lines) { $_ =~ s/\n//g; $_ =~ s/^[ \t]*(.*)[ \t]*/$1/; #remove beginning and trailing spaces / tabs if (substr($_,0,1) eq "[") { print " ".$_."\n"; } }; } else { $result .= "\n\n[\n"; #so it also works if part is at the end $result =~ m/^.*?\[(.*?[, ])?$lm([, ].*?)?\].*?\n(.*?)^[ \t]*\[/smi; if (defined($3)) { $result = $3; $result =~ s/^[ \t]*//mg; $result =~ s/^(#.*)?\n//mg; } else { $result = ""; } }; } if ($modes) { print "-----------------------\n"; print "That's it\n\n\n"; exit; }; if ($result eq "") { print STDERR "Given language mode was not found in config files.\n"; print STDERR "Outputting input file without syntax highlighting.\n"; } return $result; } ################################################################################ ####################### parse_config_part ###################################### ################################################################################ sub parse_config_part { #in: string: config data #in: string: bgcolor #in: string: textcolor #returns @regexps my @regexps = (); while ($_[0] =~ /(^[^\-].*?$)/gms) { my $us = $1; my $after = substr($_[0], pos($_[0])); if ($us =~ /^"/) { my %t = (); my $tmp = ""; my @child = (); $us =~ s/([ \t]*("([^"]|\\")*")[ \t]*,)//m; $tmp = $1; $tmp =~ m/("(.*[^\\])?")/; $tmp = $1; $tmp =~ s/"(.*)"/$1/g; $tmp =~ s/\\"/"/g; $t{"html1"} = $tmp; $us =~ s/([ \t]*("([^"]|\\")*")[ \t]*,)//m; $tmp = $1; $tmp =~ m/("(.*[^\\])?")/; $tmp = $1; $tmp =~ s/"(.*)"/$1/g; $tmp =~ s/\\"/"/g; $t{"html2"} = $tmp; $us =~ s/([ \t]*("([^"]|\\")*")[ \t]*$)//m; $tmp = $1; $tmp =~ m/("(.*[^\\])?")/; $tmp = $1; $tmp =~ s/"(.*)"/$1/g; $tmp =~ s/\\"/"/g; $t{"regex"} = $tmp; if ($after =~ /(^\n\-.*?($|\n[^\-]))/s) { $tmp = $1; $tmp =~ s/^\n//; $tmp =~ s/\n.$//; $tmp =~ s/^-[ \t]*//mg; @child = &parse_config_part($tmp."\n"); }; $t{"childregex"} = \@child; push @regexps, \%t; } else { if ($us =~ s/^bgcolor[ \t]*=[ \t]*//i) { $_[1] = $us; } elsif ($us =~ s/^textcolor[ \t]*=[ \t]*//i) { $_[2] = $us; } }; }; return @regexps; }; ################################################################################ ####################### get_input_file ######################################### ################################################################################ sub get_input_file { # out: hidechar # in : infile; # in : tabs; #returns input file my $code = ""; my $infile = $_[1]; my $tabs = $_[2]; $_[0] = ""; if ($infile eq "-") { while (<STDIN>) { $_ =~ s/\n|\r//g; $code = $code.$_."\n"; }; } else { if (!open(FILEHANDLE, "<$infile")) { print STDERR "Error while opening inputfile.\n"; exit 1; }; while (<FILEHANDLE>) { $_ =~ s/\n|\r//g; $code = $code.$_."\n"; }; close(FILEHANDLE); } if ($tabs != -1) { my $replacewith = ""; for (1..$tabs) # create a string with the correct length { $replacewith .= " "; }; $code =~ s/\t/$replacewith/g; }; #find a character that does not exist in $code foreach $a (0..255) { my $n = quotemeta(chr($a)); if (!($code =~ s/$n/$n/g)) { $_[0] = chr($a); last; }; }; if ($_[0] eq "") # if no character - which does not exist in $code - was found then be brute { $code =~ s/\xff/\xfe/g; $_[0] = "\xff"; } return $code; }; ################################################################################ ####################### find_all_matches__create_taglist__insert_placeholders ## ################################################################################ sub find_all_matches__create_taglist__insert_placeholders { # in: regexps # in/out: code # in : hidechar # returns: @taglist; my @regexps = @{$_[0]}; my @taglist; if (!@regexps) {return @taglist}; #if there are no regexps, then there are not hits. my $code = $_[1]; my $hidechar= $_[2]; my $over_length = length($code)+1; my $index=0; my @regexps_occurence; for (@regexps) { my %t; $t{"index"} = $index; $t{"regex"} = $$_{"regex"}; $t{"html1"} = $$_{"html1"}; $t{"html2"} = $$_{"html2"}; pos($code) = 0; if ($code =~ /$t{"regex"}/gms) { $t{"first_occurence"} = pos($code) - length($&) } else { $t{"first_occurence"} = $over_length; }; push @regexps_occurence, \%t; $index++; }; @regexps_occurence = sort { $$a{"first_occurence"} <=> $$b{"first_occurence"} || $$a{"index"} <=> $$b{"index"} } @regexps_occurence; while (${$regexps_occurence[0]}{"first_occurence"} < $over_length) { my %t; pos($code) = ${$regexps_occurence[0]}{"first_occurence"} + scalar(@taglist); my $dummy = $code =~ /${$regexps_occurence[0]}{"regex"}/gms; my $match = $&; my $matchend = pos($code); my $matchlength = length($match); my $delta_offset = 0; push @taglist, ${$regexps_occurence[0]}{"html1"}; #push beginning html tag my @m = @{ ${ %{$regexps[${$regexps_occurence[0]}{"index"}]} }{"childregex"} }; if (@m) { my @newtaglist = &find_all_matches__create_taglist__insert_placeholders( \@m, $match, $hidechar); $delta_offset = scalar(@newtaglist); push @taglist, @newtaglist; }; $code = substr($code, 0, $matchend-$matchlength) . $hidechar . $match . $hidechar . substr($code, $matchend); push @taglist, ${$regexps_occurence[0]}{"html2"}; #push ending html tag for (@regexps_occurence) { if (${$_}{"first_occurence"} < $matchend+2+$delta_offset - scalar(@taglist)) { pos($code) = $matchend+2+$delta_offset; if ($code =~ /${$_}{"regex"}/gms) { ${$_}{"first_occurence"} = pos($code) - length($&) - scalar(@taglist); } else { ${$_}{"first_occurence"} = $over_length; }; } else { last; } } @regexps_occurence = sort { $$a{"first_occurence"} <=> $$b{"first_occurence"} || $$a{"index"} <=> $$b{"index"} } @regexps_occurence; }; $_[1] = $code; return @taglist; }; ################################################################################ ####################### convert_code_2_html #################################### ################################################################################ sub convert_code_2_html { # in: code # returns: code my $code = $_[0]; $code =~ s/&/&/g; $code =~ s/>/>/g; $code =~ s/</</g; $code =~ s/"/"/g; return $code; }; ################################################################################ ####################### insert_tags ############################################ ################################################################################ sub insert_tags { # in: taglist # in: code # in: hidechar # returns: code my @taglist = @{$_[0]}; my $tmp = $_[1]; my $hidechar = $_[2]; my $newcode = ""; for (@taglist) # go for all tags { # This goes must faster than # $code =~ s/$hidechar/$_/; $tmp =~ m/(^.*?)$hidechar(.*)/s; $newcode .= $1.$_; $tmp = $2; }; return $newcode.$tmp; }; ################################################################################ ####################### put_output ############################################# ################################################################################ sub put_output { #0 in: code #1 in: bgcolor #2 in: textcolor #3 in: outfile; #4 in: crlf #5 in: name_of_input #6 in: linenumbers if ($_[4]) { $_[0] =~ s/\n/\r\n/g; }; if ($_[3] eq "-") { print "<html><head><title>$_[5]
\n";
		if ($_[6])
		{
			my @lines = split(/\n/,$_[0]);
			my $nr = 1;
			for (@lines)
			{
				
				print $nr."  ".$_."\n";
				$nr++;
			}
		} else
		{
			print $_[0];
		}
		print "
\n"; } else { if (!open (FILEHANDLE, ">$_[3]" )) { print STDERR "Error while opening outputfile.\n"; exit 1; }; print FILEHANDLE "$_[5]
\n";
		if ($_[6])
		{
			my @lines = split(/\n/,$_[0]);
			my $nr = 1;
			for (@lines)
			{
				
				print FILEHANDLE $nr."  ".$_."\n";
				$nr++;
			}
		} else
		{
			print FILEHANDLE $_[0];
		}
		print FILEHANDLE "
\n"; close FILEHANDLE; } }; ################################################################################ ####################### get_default_database ################################### ################################################################################ sub get_default_database { # last evaluated value will be returned my $tmp = <", "", "--.*?\$" #String Literals "", "", "\\".*?(\\"|\$)" #Character Literals "", "", "'.'" #Ada Attibutes "", "", "'[a-zA-Z][a-zA-Z_]+\\b" #Numeric Literals "", "", "(((2|8|10|16)#[_0-9a-fA-F]*#)|[0-9.]+)" #Withs Pragmas Use "", "", "\\b(([wW]ith|WITH|[pP]ragma|PRAGMA|[uU]se|USE)[ \\t\\n\\f\\r]+[a-zA-Z0-9_.]+;)+\\b" #Predefined Types "", "", "\\b([bB]oolean|BOOLEAN|[cC]haracter|CHARACTER|[cC]ount|COUNT|[dD]uration|DURATION|[fF]loat|FLOAT|[iI]nteger|INTEGER|[lL]ong_[fF]loat|LONG_FLOAT|[lL]ong_[iI]nteger|LONG_INTEGER|[pP]riority|PRIORITY|[sS]hort_[fF]loat|SHORT_FLOAT|[sS]hort_[iI]nteger|SHORT_INTEGER|[sS]tring|STRING)\\b" #Predefined Subtypes "", "", "\\b([fF]ield|FIELD|[nN]atural|NATURAL|[nN]umber_[bB]ase|NUMBER_BASE|[pP]ositive|POSITIVE|[pP]riority|PRIORITY)\\b" #Reserved Words "", "", "\\b([aA]bort|ABORT|[aA]bs|ABS|[aA]ccept|ACCEPT|[aA]ccess|ACCESS|[aA]nd|AND|[aA]rray|ARRAY|[aA][tT]|[bB]egin|BEGIN|[bB]ody|BODY|[cC]ase|CASE|[cC]onstant|CONSTANT|[dD]eclare|DECLARE|[dD]elay|DELAY|[dD]elta|DELTA|[dD]igits|DIGITS|[dD][oO]|[eE]lse|ELSE|[eE]lsif|ELSIF|[eE]nd|END|[eE]ntry|ENTRY|[eE]xception|EXCEPTION|[eE]xit|EXIT|[fF]or|FOR|[fF]unction|FUNCTION|[gG]eneric|GENERIC|[gG]oto|GOTO|[iI][fF]|[iI][nN]|[iI][sS]|[lL]imited|LIMITED|[lL]oop|LOOP|[mM]od|MOD|[nN]ew|NEW|[nN]ot|NOT|[nN]ull|NULL|[oO][fF]|[oO][rR]|[oO]thers|OTHERS|[oO]ut|OUT|[pP]ackage|PACKAGE|[pP]ragma|PRAGMA|[pP]rivate|PRIVATE|[pP]rocedure|PROCEDURE|[rR]aise|RAISE|[rR]ange|RANGE|[rR]ecord|RECORD|[rR]em|REM|[rR]enames|RENAMES|[rR]eturn|RETURN|[rR]everse|REVERSE|[sS]elect|SELECT|[sS]eparate|SEPARATE|[sS]ubtype|SUBTYPE|[tT]ask|TASK|[tT]erminate|TERMINATE|[tT]hen|THEN|[tT]ype|TYPE|[uU]se|USE|[wW]hen|WHEN|[wW]hile|WHILE|[wW]ith|WITH|[xX]or|XOR)\\b" #Ada 95 Only "", "", "\\b([aA]bstract|ABSTRACT|[tT]agged|TAGGED|[aA]ll|ALL|[pP]rotected|PROTECTED|[aA]liased|ALIASED|[rR]equeue|REQUEUE|[uU]ntil|UNTIL)\\b" #Identifiers "", "", "\\b[a-zA-Z][a-zA-Z0-9_]*\\b" #Dot All "", "", "\\.[aA][lL][lL]\\b" ###################################################################### ################################# C ################################## ###################################################################### [c] bgcolor=#ffffff textcolor=#000000 #comment "", "", "/\\*.*?\\*/" #string "", "", "\\".*?(\\"|\$)" #esc character - "", "", "\\\\." #preprocessor line "", "", "^[ \\t]*#.*?\$" #esc character - "", "", "\\\\(.|\\n)" #comment - "", "", "[^/]/\\*.*?\\*/" #character constant "", "", "'.'" #numeric constant "", "", "\\b((0(x|X)[0-9a-fA-F]*)|(([0-9]+\\.?[0-9]*)|(\\.[0-9]+))((e|E)(\\+|-)?[0-9]+)?)(L|l|UL|ul|u|U|F|f)?\\b" #storage keyword "", "", "\\b(const|extern|auto|register|static|unsigned|signed|volatile|char|double|float|int|long|short|void|typedef|struct|union|enum)\\b" #keyword "", "", "\\b(return|goto|if|else|case|default|switch|break|continue|while|do|for|sizeof)\\b" #braces "", "", "[\\{\\}]" #symbols "", "", "([\\*\\-\\+=:;\%&\\|<>\\(\\)\\[\\]!])" #identifiers "", "", "([a-zA-Z_][a-zA-Z_0-9]*)" ###################################################################### ################################# C ++ ############################### ###################################################################### [c++,cpp,cc] #comment "", "", "/\\*.*?\\*/" #cplus comment "", "", "//.*?\$" #string "", "", "\\".*?(\\"|\$)" #esc character - "", "", "\\\\." #preprocessor line "", "", "^[ \\t]*#.*?\$" #esc character - "", "", "\\\\(.|\\n)" #comment - "", "", "[^/]/\\*.*?\\*/" #cplus comment - "", "", "//.*?\$" #character constant "", "", "'.'" #numeric constant "", "", "\\b((0(x|X)[0-9a-fA-F]*)|(([0-9]+\\.?[0-9]*)|(\\.[0-9]+))((e|E)(\\+|-)?[0-9]+)?)(L|l|UL|ul|u|U|F|f)?\\b" #storage keyword "", "", "\\b(class|typename|typeid|template|friend|virtual|inline|explicit|operator|overload|public|private|protected|const|extern|auto|register|static|mutable|unsigned|signed|volatile|char|double|float|int|long|short|bool|wchar_t|void|typedef|struct|union|enum)\\b" #keyword "", "", "\\b(new|delete|this|return|goto|if|else|case|default|switch|break|continue|while|do|for|catch|throw|sizeof|true|false|namespace|using|dynamic_cast|static_cast|reinterpret_cast)\\b" #braces "", "", "[\\{\\}]" #symbols "", "", "([\\*\\-\\+=:;\%&\\|<>\\(\\)\\[\\]!])" #identifiers "", "", "([a-zA-Z_][a-zA-Z_0-9]*)" ###################################################################### ################################# HTML ############################### ###################################################################### [html] bgcolor=#ffffff textcolor=#000000 #comment "", "", "" #special chars "", "", "\\&[-.a-zA-Z0-9#]*;?" #tag "", "", "<(/|!)?[-.a-zA-Z0-9]*.*?>" #double quote string - "", "", "\\".*?\\"" #single quote string - "", "", "'.*?'" #brackets - "", "", "[<>]" #attribute - "", "", "[^'\\"]*?" ###################################################################### ################################# Java ############################### ###################################################################### [java] #doc comment "", "", "/\\*\\*.*?\\*/" #comment "", "", "/\\*.*?\\*/" #cplus comment "", "", "//.*?\$" #string "", "", "\\".*?(\\"|\$)" #esc character - "", "", "\\\\." #single quoted "", "", "'([^\\\\]|\\\\[^'])*?'" #numeric constant "", "", "\\b((0(x|X)[0-9a-fA-F]*)|(([0-9]+\\.?[0-9]*)|(\\.[0-9]+))((e|E)(\\+|-)?[0-9]+)?)(L|l|UL|ul|u|U|F|f)?\\b" #include "", "", "\\b(import|package)\\b.*?\$" #esc character - "", "", "\\\\(.|\\n)" #comment - "", "", "[^/]/\\*.*?\\*/" #storage keyword "", "", "\\b(abstract|boolean|byte|char|class|double|extends|final|float|int|interface|long|native|private|protected|public|short|static|transient|synchronized|void|volatile|implements)\\b" #keyword "", "", "\\b(break|case|catch|continue|default|do|else|false|finally|for|if|instanceof|new|null|return|super|switch|this|throw|throws|true|try|while)\\b" #braces and parens "", "", "[\\{\\}\\(\\)\\[\\]]" #Identifiers "", "", "\\b[a-zA-Z_][a-zA-Z0-9_]*\\b" #symbols "", "", "([\\*\\-\\+=:;\%&\\|<>!])" ###################################################################### ################################# JavaScript ######################### ###################################################################### [js,javascipt] #comment "", "", "/\\*.*?\\*/" #cplus comment "", "", "//.*?\$" #numeric constant "", "", "\\b((0(x|X)[0-9a-fA-F]*)|(([0-9]+\\.?[0-9]*)|(\\.[0-9]+))((e|E)(\\+|-)?[0-9]+)?)(L|l|UL|ul|u|U|F|f)?\\b" #events "", "", "\\b(onAbort|onBlur|onClick|onChange|onDblClick|onDragDrop|onError|onFocus|onKeyDown|onKeyPress|onLoad|onMouseDown|onMouseMove|onMouseOut|onMouseOver|onMouseUp|onMove|onResize|onSelect|onSubmit|onUnload)\\b" #braces "", "", "[\\{\\}]" #statements "", "", "\\b(break|continue|else|for|if|in|new|return|this|typeof|var|while|with)\\b" #function "", "", "function[\\t ]+([a-zA-Z0-9_]+)[\\t \\(]+.*?[\\n{]" #function args - "", "", "\\(.*?\\)" #function name - "", "", "[\\t ][a-zA-Z0-9_]+" #built in object type "", "", "\\b(anchor|Applet|Area|Array|button|checkbox|Date|document|elements|FileUpload|form|frame|Function|hidden|history|Image|link|location|Math|navigator|Option|password|Plugin|radio|reset|select|string|submit|text|textarea|window)\\b" #string "", "", "\\".*?(\\"|\$)" #Colors - "", "", "(aliceblue|antiquewhite|aqua|aquamarine|azure|beige|bisque|black|blanchedalmond|blue|blueviolet|brown|burlywood|cadetblue|chartreuse|chocolate|coral|cornflowerblue|cornsilk|crimson|cyan|darkblue|darkcyan|darkgoldenrod|darkgray|darkgreen|darkkhaki|darkmagenta|darkolivegreen|darkorange|darkorchid|darkred|darksalmon|darkseagreen|darkslateblue|darkslategray|darkturquoise|darkviolet|deeppink|deepskyblue|dimgray|dodgerblue|firebrick|floralwhite|forestgreen|fuchsia|gainsboro|ghostwhite|gold|goldenrod|gray|green|greenyellow|honeydew|hotpink|indianred|indigo|ivory|khaki|lavender|lavenderblush|lawngreen|lemonchiffon|lightblue|lightcoral|lightcyan|lightgoldenrodyellow|lightgreen|lightgrey|lightpink|lightsalmon|lightseagreen|lightskyblue|lightslategray|lightsteelblue|lightyellow|lime|limegreen|linen|magenta|#008000|mediumaquamarine|mediumblue|mediumorchid|mediumpurple|mediumseagreen|mediumslateblue|mediumspringgreen|mediumturquoise|mediumvioletred|midnightblue|mintcream|mistyrose|moccasin|navajowhite|navy|oldlace|olive|olivedrab|orange|orangered|orchid|palegoldenrod|palegreen|paleturquoise|palevioletred|papayawhip|peachpuff|peru|pink|plum|powderblue|purple|red|rosybrown|royalblue|saddlebrown|salmon|sandybrown|seagreen|seashell|sienna|silver|skyblue|slateblue|slategray|snow|springgreen|steelblue|tan|teal|thistle|tomato|turquoise|violet|wheat|white|whitesmoke|yellow|yellowgreen|#[A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9])" #string "", "", "'.*?('|\$)" #Colors - "", "", "(aliceblue|antiquewhite|aqua|aquamarine|azure|beige|bisque|black|blanchedalmond|blue|blueviolet|brown|burlywood|cadetblue|chartreuse|chocolate|coral|cornflowerblue|cornsilk|crimson|cyan|darkblue|darkcyan|darkgoldenrod|darkgray|darkgreen|darkkhaki|darkmagenta|darkolivegreen|darkorange|darkorchid|darkred|darksalmon|darkseagreen|darkslateblue|darkslategray|darkturquoise|darkviolet|deeppink|deepskyblue|dimgray|dodgerblue|firebrick|floralwhite|forestgreen|fuchsia|gainsboro|ghostwhite|gold|goldenrod|gray|green|greenyellow|honeydew|hotpink|indianred|indigo|ivory|khaki|lavender|lavenderblush|lawngreen|lemonchiffon|lightblue|lightcoral|lightcyan|lightgoldenrodyellow|lightgreen|lightgrey|lightpink|lightsalmon|lightseagreen|lightskyblue|lightslategray|lightsteelblue|lightyellow|lime|limegreen|linen|magenta|#008000|mediumaquamarine|mediumblue|mediumorchid|mediumpurple|mediumseagreen|mediumslateblue|mediumspringgreen|mediumturquoise|mediumvioletred|midnightblue|mintcream|mistyrose|moccasin|navajowhite|navy|oldlace|olive|olivedrab|orange|orangered|orchid|palegoldenrod|palegreen|paleturquoise|palevioletred|papayawhip|peachpuff|peru|pink|plum|powderblue|purple|red|rosybrown|royalblue|saddlebrown|salmon|sandybrown|seagreen|seashell|sienna|silver|skyblue|slateblue|slategray|snow|springgreen|steelblue|tan|teal|thistle|tomato|turquoise|violet|wheat|white|whitesmoke|yellow|yellowgreen|#[A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9][A-Fa-f0-9])" #event capturing "", "", "\\b(captureEvents|releaseEvents|routeEvent|handleEvent)\\b.*?(\\)|\$)" #predefined methods "", "", "\\b(abs|acos|alert|anchor|asin|atan|atan2|back|big|blink|blur|bold|ceil|charAt|clear|clearTimeout|click|close|confirm|cos|escape|eval|exp|fixed|floor|focus|fontcolor|fontsize|forward|getDate|getDay|getHours|getMinutes|getMonth|getSeconds|getTime|getTimezoneOffset|getYear|go|indexOf|isNaN|italics|javaEnabled|join|lastIndexOf|link|log|max|min|open|parse|parseFloat|parseInt|pow|prompt|random|reload|replace|reset|reverse|round|scroll|select|setDate|setHours|setMinutes|setMonth|setSeconds|setTimeout|setTime|setYear|sin|small|sort|split|sqrt|strike|sub|submit|substring|sup|taint|tan|toGMTString|toLocaleString|toLowerCase|toString|toUpperCase|unescape|untaint|UTC|write|writeln)\\b" #properties "", "", "\\b(action|alinkColor|anchors|appCodeName|appName|appVersion|bgColor|border|checked|complete|cookie|defaultChecked|defaultSelected|defaultStatus|defaultValue|description|E|elements|enabledPlugin|encoding|fgColor|filename|forms|frames|hash|height|host|hostname|href|hspace|index|lastModified|length|linkColor|links|LN2|LN10|LOG2E|LOG10E|lowsrc|method|name|opener|options|parent|pathname|PI|port|protocol|prototype|referrer|search|selected|selectedIndex|self|SQRT1_2|SQRT2|src|status|target|text|title|top|type|URL|userAgent|value|vlinkColor|vspace|width|window)\\b" #operators "", "", "([=;->/&|])" ###################################################################### ################################# Makefile ########################### ###################################################################### [make,makefile] #comment "", "", "#.*?\$" #Assignment "", "", "^( *| [ \\t]*)[A-Za-z0-9_+]*[ \\t]*(\\+|:)?=" #Dependency Line "", "", "^ *([A-Za-z0-9./\$(){} _\%+-]|\\n)*::?" #Dependency Target - "", "", "[A-Za-z0-9./\$(){} _\%+-]*" #Dependency continuation - "", "", "\\\\\\n" #comment - "", "", "#.*?\$" #macro - "", "", "\\\$([A-Za-z0-9_]|\\([^)]*\\)|{[^}]*})" #int macro - "", "", "\\\$([<\@*?\%]|\\\$\@)" #Continuation "", "", "\\\\\$" #Macro "", "", "\\\$([A-Za-z0-9_]|\\([^)]*\\)|{[^}]*})" #Internal Macro "", "", "\\\$([<\@*?\%]|\\\$\@)" #Escaped Dollar "", "", "\\\$\\\$" #Include "", "", "^include[ \\t]" ###################################################################### ################################# Pascal ############################# ###################################################################### [pas,pascal] bgcolor=#ffffff textcolor=#000000 #comment1 (* *) "", "", "\\(\\*.*?\\*\\)" #comment1 { } "", "", "\\{.*?\\}" #string "", "", "'.*?('|\$)" #preprocessor line "", "", "^[ \\t]*#.*?\$" #comment1 (* *) - "", "", "\\(\\*.*?\\*\\)" #comment1 { } - "", "", "\\{.*?\\}" #character constant "", "", "'.'" #numeric constant "", "", "\\b((0(x|X)[0-9a-fA-F]*)|[0-9.]+((e|E)(\\+|-)?)?[0-9]*)(L|l|UL|ul|u|U|F|f)?\\b" #storage and ops "", "", "\\b(and|AND|array|const|div|export|file|function|import|in|IN|label|mod|module|nil|not|NOT|only|or|OR|packed|pow|pragma|procedure|program|protected|qualified|record|restricted|set|type|var)\\b" #keywords "", "", "\\b(begin|case|do|downto|else|end|for|goto|if|of|otherwise|then|to|until|while|with)\\b" #symbols "", "", "([\\*\\-\\+=:;<>\\(\\)\\[\\]!]|[^/]/[^/])" #identifiers "", "", "([a-zA-Z_][a-zA-Z_0-9]*)" ###################################################################### ################################# Perl ############################### ###################################################################### [perl] #comment "", "", "#.*?\$" #variables "", "", "[\$\@\%]\\\$?({[^}]*}|[^a-zA-Z0-9_/\\t\\n\\.,\\\\[\\\\{\\\\(]|[0-9]+|[a-zA-Z_][a-zA-Z0-9_]*)?" #string; so this part realy is weird, but it works! "", "", "((\\"\\")|(\\"[^\\"\\\\]\\")|(\\"[^\\"].*?[^\\\\]\\"))" #esc character - "", "", "\\\\." #variables - "", "", "[\$\@\%]\\\$?({[^}]*}|[^a-zA-Z0-9_/\\t\\n\\.,\\\\[\\\\{\\\\(]|[0-9]+|[a-zA-Z_][a-zA-Z0-9_]*)?" #string; so this part realy is weird, but it works! "", "", "(('')|('[^'\\\\]')|('[^'].*?[^\\\\]'))" #esc character - "", "", "\\\\." #subroutine header "", "", "sub[\\t ]+([a-zA-Z0-9_]+)[\\t \\n]*(\\{|\\n)" #subr header coloring - "", "", "[\\t ]([a-zA-Z0-9_]+)" #ignore escaped chars # "", "", "\\\\[#"'\\\$msytq]" #regex matching "", "", "(\\b| )((m|q|qq)?/)(\\\\/|[^/\\n])*(/[gimsox]*)" #regex substitution "", "", "(\\b| )((s|y|tr)/)(\\\\/|[^/\\n])*(/)[^/\\n]*(/[gimsox]*)" #keywords "", "", "\\b(my|local|new|if|until|while|elsif|else|eval|unless|for|foreach|continue|exit|die|last|goto|next|redo|return|local|exec|do|use|require|package|eval|BEGIN|END|eq|ne|not|\\|\\||\\&\\&|and|or)\\b" #library fns "", "", "\\b(abs|accept|alarm|atan2|bind|binmode|bless|caller|chdir|chmod|chomp|chop|chr|chroot|chown|closedir|close|connect|cos|crypt|dbmclose|dbmopen|defined|delete|die|dump|each|endgrent|endhostent|endnetent|endprotoent|endpwent|endservent|eof|exec|exists|exp|fctnl|fileno|flock|fork|format|formline|getc|getgrent|getgrgid|getgrnam|gethostbyaddr|gethostbyname|gethostent|getlogin|getnetbyaddr|getnetbyname|getnetent|getpeername|getpgrp|getppid|getpriority|getprotobyname|getprotobynumber|getprotoent|getpwent|getpwnam|getpwuid|getservbyname|getservbyport|getservent|getsockname|getsockopt|glob|gmtime|grep|hex|import|index|int|ioctl|join|keys|kill|lcfirst|lc|length|link|listen|log|localtime|lstat|map|mkdir|msgctl|msgget|msgrcv|no|oct|opendir|open|ord|pack|pipe|pop|pos|printf|print|push|quotemeta|rand|readdir|read|readlink|recv|ref|rename|reset|reverse|rewinddir|rindex|rmdir|scalar|seekdir|seek|select|semctl|semget|semop|send|setgrent|sethostent|setnetent|setpgrp|setpriority|setprotoent|setpwent|setsockopt|shift|shmctl|shmget|shmread|shmwrite|shutdown|sin|sleep|socket|socketpair|sort|splice|split|sprintf|sqrt|srand|stat|study|substr|symlink|syscall|sysopen|sysread|system|syswrite|telldir|tell|tie|tied|time|times|truncate|uc|ucfirst|umask|undef|unlink|unpack|unshift|untie|utime|values|vec|wait|waitpid|wantarray|warn|write|qw|-[rwxoRWXOezsfdlpSbctugkTBMAC])\\b" #braces and parens "", "", "[\\[\\]\\{\\}\\(\\)]" #<< stuff "", "", "<<([^\\n]*).*?^\\1\$" ###################################################################### EODB };