# See copyright, etc in below POD section.######################################################################package Verilog::Getopt; # package name， 其中Verilog是目录require 5.000; # 需要perl5.0以上require Exporter; # Exporter 使得能够导出各个函数use strict;use vars qw($VERSION $Debug %Skip_Basenames); # 等同于our声明，导出变量use Carp; # package中使用warning或者die类似的功能。use IO::File;use File::Basename;use File::Spec;use Cwd;########################################################################## Configuration Section$VERSION = '3.305';# Basenames we should ignore when recursing directories,# Because they contain large files of no relevanceforeach ( '.', '..', 'CVS', '.svn', '.snapshot', 'blib', ) { $Skip_Basenames{$_} = 1;}###################################################################################################################################################################################################################### 类成员（可以有初值），本质是hash表。成员函数不再其中，凡是package声明的sub函数都是成员函数。# 一般我们推荐将internal的成员（private） 声明成 _member 的形式。这些类成员和后面声明的函数可以同名，# 但是他们是完全不同的东西。一般同名的函数会把返回的值放入这些同名的的成员中（如匿名数组或hash表）# 在perl中哪些变量会声明成类成员呢？ 一般用于configuration变量以及在各个函数中传递（即多个函数使用的# 变量）。 @_ 指明从new参数中给出的值。这样可以给成员赋新值，或者加入新的成员。本例中就是options# 如 $Opt = new Verilog::Getopt(gcc_style=>0)sub new { @_ >= 1 or croak 'usage: Verilog::Getopt->new ({options})'; my $class = shift;# Class (Getopt Element) 类名 $class ||= "Verilog::Getopt"; # 进一步确定类名 my $self = {defines => {},incdir => ['.', ],module_dir => ['.', ],libext => ['.v', ],library => [ ],gcc_style => 1,vcs_style => 1,fileline => 'Command_Line',unparsed => [],define_warnings => 1,depend_files => {},@_}; bless $self, $class; #洗礼成为类 return $self; #返回类指针}######################################################################## Option parsingsub _filedir { my $self = shift; my $path = shift; $path =~ s![/\\][^/\\]*$!! # ~~== my @dirs = File::Spec->splitdir( $path );or $path = "."; return "." if $path eq ''; return $path}sub parameter_file { my $self = shift; my $filename = shift; my $relative = shift; print "*parameter_file $filename\n" if $Debug; my $optdir = "."; if ($relative) { $optdir = $self->_filedir($filename); } my $fh = IO::File->new("<$filename") or die "%Error: ".$self->fileline().": $! $filename\n"; my $hold_fileline = $self->fileline(); while (my $line = $fh->getline()) {chomp $line;$line =~ s/\/\/.*$//;next if $line =~ /^\s*$/;$self->fileline ("$filename:$.");my @p = (split /\s+/,"$line ");$self->_parameter_parse($optdir, @p); } $fh->close(); $self->fileline($hold_fileline);}sub parameter { my $self = shift; # Parse VCS like parameters, and perform standard setup based on it # Return list of leftover parameters @{$self->{unparsed}} = (); $self->_parameter_parse('.', @_); return @{$self->{unparsed}};}sub _parameter_parse { my $self = shift; my $optdir = shift; # Internal: Parse list of VCS like parameters, and perform standard setup based on it foreach my $param (@_) {next if ($param =~ /^\s*$/);print " parameter($param)\n" if $Debug;### GCC & VCS styleif ($param eq '-F' || $param eq '-f') { $self->{_parameter_next} = $param;}### VCS styleelsif (($param eq '-v'|| $param eq '-y') && $self->{vcs_style}) { $self->{_parameter_next} = $param;}elsif ($param =~ /^\+libext\+(.*)$/ && $self->{vcs_style}) { my $ext = $1; foreach (split /\+/, $ext) {$self->libext($_); }}elsif ($param =~ /^\+incdir\+(.*)$/ && $self->{vcs_style}) { $self->incdir($self->_parse_file_arg($optdir, $1));}elsif (($param =~ /^\+define\+([^+=]*)[+=](.*)$/|| $param =~ /^\+define\+(.*?)()$/) && $self->{vcs_style}) { $self->define($1,$2,undef,1);}# Ignoredelsif ($param =~ /^\+librescan$/ && $self->{vcs_style}) {}### GCC styleelsif (($param =~ /^-D([^=]*)=(.*)$/|| $param =~ /^-D([^=]*)()$/) && $self->{gcc_style}) { $self->define($1,$2,undef,1);}elsif (($param =~ /^-U([^=]*)$/) && $self->{gcc_style}) { $self->undef($1);}elsif ($param =~ /^-I(.*)$/ && $self->{gcc_style}) { $self->incdir($self->_parse_file_arg($optdir, $1));}# Second parameterselsif ($self->{_parameter_next}) { my $pn = $self->{_parameter_next}; $self->{_parameter_next} = undef; if ($pn eq '-F') {$self->parameter_file ($self->_parse_file_arg($optdir,$param), 1); } elsif ($pn eq '-f') {$self->parameter_file ($self->_parse_file_arg($optdir,$param), 0); } elsif ($pn eq '-v') {$self->library ($self->_parse_file_arg($optdir,$param)); } elsif ($pn eq '-y') {$self->module_dir ($self->_parse_file_arg($optdir,$param)); } else {die "%Error: ".$self->fileline().": Bad internal next param ".$pn; }}else { # Unknown push @{$self->{unparsed}}, "$param"; # Must quote to convert Getopt to string, bug298} }}sub _parse_file_arg { my $self = shift; my $optdir = shift; my $relfilename = shift; # Parse filename on option line, expanding relative paths in -F's my $filename = $self->file_substitute($relfilename); if ($optdir ne "." && ! File::Spec->file_name_is_absolute($filename)) {$filename = File::Spec->catfile($optdir,$filename); } return $filename;}######################################################################## Accessorssub fileline { my $self = shift; if (@_) { $self->{fileline} = shift; } return ($self->{fileline});}sub incdir { my $self = shift; if (@_) {my $token = shift;print "incdir $token\n" if $Debug;if (ref($token) && ref($token) eq 'ARRAY') { @{$self->{incdir}} = @{$token};} else { push @{$self->{incdir}}, $self->file_abs($token);}$self->file_path_cache_flush(); } return (wantarray ? @{$self->{incdir}} : $self->{incdir});}sub libext { my $self = shift; if (@_) {my $token = shift;print "libext $token\n" if $Debug;if (ref($token) && ref($token) eq 'ARRAY') { @{$self->{libext}} = @{$token};} else { push @{$self->{libext}}, $token;}$self->file_path_cache_flush(); } return (wantarray ? @{$self->{libext}} : $self->{libext});}sub library { my $self = shift; if (@_) {my $token = shift;print "library $token\n" if $Debug;if (ref($token) && ref($token) eq 'ARRAY') { @{$self->{library}} = @{$token};} else { push @{$self->{library}}, $self->file_abs($token);} } return (wantarray ? @{$self->{library}} : $self->{library});}sub module_dir { my $self = shift; if (@_) {my $token = shift;print "module_dir $token\n" if $Debug;if (ref($token) && ref($token) eq 'ARRAY') { @{$self->{module_dir}} = @{$token};} else { push @{$self->{module_dir}}, $self->file_abs($token);}$self->file_path_cache_flush(); } return (wantarray ? @{$self->{module_dir}} : $self->{module_dir});}sub depend_files { my $self = shift; if (@_) {#@_ may be Getopt::Long::Parameters which aren't arrays, will stringifyif (ref($_[0]) && ref($_[0]) eq 'ARRAY') { $self->{depend_files} = {}; foreach my $fn (@{$_[0]}) {$self->{depend_files}{$fn} = 1; }} else { foreach my $fn (@_) {print "depend_files $fn\n" if $Debug;$self->{depend_files}{$fn} = 1; }} } my @list = (sort (keys %{$self->{depend_files}})); return (wantarray ? @list : \@list);}sub get_parameters { my $self = shift; my %args = (gcc_stlyle => $self->{gcc_style},); # Defines my @params = (); foreach my $def ($self->define_names_sorted) {my $defvalue = $self->defvalue($def);$defvalue = "=".($defvalue||"") if (defined $defvalue && $defvalue ne "");if ($args{gcc_style}) { push @params, "-D${def}${defvalue}";} else { push @params, "+define+${def}${defvalue}";} } # Put all libexts on one line, else NC-Verilog will bitch my $exts=""; foreach my $ext ($self->libext()) {$exts = "+libext" if !$exts;$exts .= "+$ext"; } push @params, $exts if $exts; # Includes... foreach my $dir ($self->incdir()) {if ($args{gcc_style}) { push @params, "-I${dir}";} else { push @params, "+incdir+${dir}";} } foreach my $dir ($self->module_dir()) {push @params, "-y", $dir; } foreach my $dir ($self->library()) {push @params, "-v", $dir; } return (@params);}sub write_parameters_file { my $self = shift; my $filename = shift; # Write get_parameters to a file my $fh = IO::File->new(">$filename") or croak "%Error: $! writing $filename,"; my @opts = $self->get_parameters(); print $fh join("\n",@opts); $fh->close;}######################################################################## Utility functionssub remove_duplicates { my $self = ref $_[0] && shift; # return list in same order, with any duplicates removed my @rtn; my %hit; foreach (@_) { push @rtn, $_ unless $hit{$_}++; } return @rtn;}sub file_skip_special { my $self = shift; my $filename = shift; $filename =~ s!.*[/\\]!!; return $Skip_Basenames{$filename};}sub file_abs { my $self = shift; my $filename = shift; # return absolute filename # If the user doesn't want this absolutification, they can just # make their own derived class and override this function. # # We don't absolutify files that don't have any path, # as file_path() will probably be used to resolve them. return $filename; return $filename if ("" eq dirname($filename)); return $filename if File::Spec->file_name_is_absolute($filename); # Cwd::abspath() requires files to exist. Too annoying... $filename = File::Spec->canonpath(File::Spec->catdir(Cwd::getcwd(),$filename)); return $filename;}sub file_substitute { my $self = shift; my $filename = shift; my $out = $filename; while ($filename =~ /\$([A-Za-z_0-9]+)\b/g) {my $var = $1;if (defined $ENV{$var}) { $out =~ s/\$var\b/$ENV{$var}/g;} } $out =~ s!^~!$ENV{HOME}/!; return $out;}sub file_path_cache_flush { my $self = shift; # Clear out a file_path cache, needed if the incdir/module_dirs change $self->{_file_path_cache} = {};}sub file_path { my $self = shift; my $filename = shift; my $lookup_type = shift || 'all'; # return path to given filename using library directories & files, or undef # locations are cached, because -r can be a very slow operation defined $filename or carp "%Error: Undefined filename,"; return $self->{_file_path_cache}{$filename} if defined $self->{_file_path_cache}{$filename}; if (-r $filename && !-d $filename) {$self->{_file_path_cache}{$filename} = $filename;$self->depend_files($filename);return $filename; } # Try expanding environment $filename = $self->file_substitute($filename); if (-r $filename && !-d $filename) {$self->{_file_path_cache}{$filename} = $filename;$self->depend_files($filename);return $filename; } # What paths to use? my @dirlist; if ($lookup_type eq 'module') {@dirlist = $self->module_dir(); } elsif ($lookup_type eq 'include') {@dirlist = $self->incdir(); } else { # all# Might be more obvious if -y had priority, but we'll remain back compatible@dirlist = ($self->incdir(), $self->module_dir()); } # Expand any envvars in incdir/moduledir @dirlist = map {$self->file_substitute($_)} @dirlist; # Check each search path # We use both the incdir and moduledir. This isn't strictly correct, # but it's fairly silly to have to specify both all of the time. my %checked_dir = (); my %checked_file = (); foreach my $dir (@dirlist) {next if $checked_dir{$dir}; $checked_dir{$dir}=1; # -r can be quite slow# Check each postfix added to the fileforeach my $postfix ("", @{$self->{libext}}) { my $found = "$dir/$filename$postfix"; next if $checked_file{$found}; $checked_file{$found}=1; # -r can be quite slow if (-r $found && !-d $found) {$self->{_file_path_cache}{$filename} = $found;$self->depend_files($found);return $found; }} } return $filename;# Let whoever needs it discover it doesn't exist}sub libext_matches { my $self = shift; my $filename = shift; return undef if !$filename; foreach my $postfix (@{$self->{libext}}) {my $re = quotemeta($postfix) . "\{1}quot;;return $filename if ($filename =~ /$re/); } return undef;}sub map_directories { my $self = shift; my $func = shift; # Execute map function on all directories listed in self. {my @newdir = $self->incdir();@newdir = map {&{$func}} @newdir;$self->incdir(\@newdir); } {my @newdir = $self->module_dir();@newdir = map {&{$func}} @newdir;$self->module_dir(\@newdir); }}######################################################################## Getopt functionssub define_names_sorted { my $self = shift; return (sort (keys %{$self->{defines}}));}sub defcmdline { my $self = shift; my $token = shift; my $val = $self->{defines}{$token}; if (ref $val) {return $val->[2]; } else {return undef; }}sub defparams { my $self = shift; my $token = shift; my $val = $self->{defines}{$token}; if (!defined $val) {return undef; } elsif (ref $val && defined $val->[1]) {return $val->[1]; # Has parameters hash, return param list or undef } else {return 0; }}sub defvalue { my $self = shift; my $token = shift; my $val = $self->{defines}{$token}; (defined $val) or carp "%Warning: ".$self->fileline().": No definition for $token,"; if (ref $val) {return $val->[0]; # Has parameters, return just value } else {return $val; }}sub defvalue_nowarn { my $self = shift; my $token = shift; my $val = $self->{defines}{$token}; if (ref $val) {return $val->[0]; # Has parameters, return just value } else {return $val; }}sub define { my $self = shift; if (@_) {my $token = shift;my $value = shift;my $params = shift;my $cmdline = shift;print "Define $token ".($params||'')."= $value\n" if $Debug;my $oldval = $self->{defines}{$token};my $oldparams;if (ref $oldval eq 'ARRAY') { ($oldval, $oldparams) = @{$oldval};}if (defined $oldval && (($oldval ne $value)|| (($oldparams||'') ne ($params||''))) && $self->{define_warnings}) { warn "%Warning: ".$self->fileline().": Redefining `$token\n";}if ($params || $cmdline) { $self->{defines}{$token} = [$value, $params, $cmdline];} else { $self->{defines}{$token} = $value;} }}sub undef { my $self = shift; my $token = shift; my $oldval = $self->{defines}{$token}; # We no longer warn about undefing something that doesn't exist, as other compilers don't #(defined $oldval or !$self->{define_warnings}) #or carp "%Warning: ".$self->fileline().": No definition to undef for $token,"; delete $self->{defines}{$token};}sub undefineall { my $self = shift; foreach my $def (keys %{$self->{defines}}) {if (!$self->defcmdline($def)) { delete $self->{defines}{$def};} }}sub remove_defines { my $self = shift; my $sym = shift; my $val = "x"; while (defined $val) {last if $sym eq $val;(my $xsym = $sym) =~ s/^\`//;$val = $self->defvalue_nowarn($xsym); #Undef if not found$sym = $val if defined $val; } return $sym;}######################################################################### Package return1;__END__=pod=head1 NAMEVerilog::Getopt - Get Verilog command line options=head1 SYNOPSIS use Verilog::Getopt; my $opt = new Verilog::Getopt; $opt->parameter (qw( +incdir+standard_include_directory )); @ARGV = $opt->parameter (@ARGV); ... print "Path to foo.v is ", $opt->file_path('foo.v');=head1 DESCRIPTIONVerilog::Getopt provides standardized handling of options similar toVerilog/VCS and cc/GCC.=over 4=item $opt = Verilog::Getopt->new ( I<opts> )Create a new Getopt. If gcc_style=>0 is passed as a parameter, parsing ofGCC-like parameters is disabled. If vcs_style=>0 is passed as a parameter,parsing of VCS-like parameters is disabled.=item $self->file_path ( I<filename>, [I<lookup_type>] )Returns a new path to the filename, using the library directories andsearch paths to resolve the file. Optional lookup_type is 'module','include', or 'all', to use only module_dirs, incdirs, or both for thelookup.=item $self->get_parameters ( )Returns a list of parameters that when passed through $self->parameter()should result in the same state. Often this is used to form command linesfor downstream programs that also use Verilog::Getopt.=item $self->parameter ( \@params )Parses any recognized parameters in the referenced array, removing thestandard parameters and returning a array with all unparsed parameters.The below list shows the VCS-like parameters that are supported, and thefunctions that are called: +libext+I<ext>+I<ext>...libext (I<ext>) +incdir+I<dir>incdir (I<dir>) +define+I<var>[+=]I<value>define (I<var>,I<value>) +define+I<var>define (I<var>,undef) +librescanIgnored -F I<file>Parse parameters in file relatively -f I<file>Parse parameters in file -v I<file>library (I<file>) -y I<dir>module_dir (I<dir>) all othersPut in returned listThe below list shows the GCC-like parameters that are supported, and thefunctions that are called: -DI<var>=I<value>define (I<var>,I<value>) -DI<var>define (I<var>,undef) -UI<var>undefine (I<var>) -II<dir>incdir (I<dir>) -F I<file>Parse parameters in file relatively -f I<file>Parse parameters in file all othersPut in returned list=item $self->write_parameters_file ( I<filename> )Write the output from get_parameters to the specified file.=back=head1 ACCESSORS=over 4=item $self->define ( $token, $value )This method is called when a define is recognized. The default behaviorloads a hash that is used to fulfill define references. This function mayalso be called outside parsing to predefine values.An optional third argument specifies parameters to the define, and a fourthargument if true indicates the define was set on the command line andshould not be removed by `undefineall.=item $self->define_names_sortedReturn sorted list of all define names that currently exist.=item $self->defparams ( $token )This method returns the parameter list of the define. This will be defined,but false, if the define does not have arguments.=item $self->defvalue ( $token )This method returns the value of a given define, or prints a warning.=item $self->defvalue_nowarn ( $token )This method returns the value of a given define, or undef.=item $self->depend_files ()Returns reference to list of filenames referenced with file_path, usefulfor creating dependency lists. With argument, adds that file. With listreference argument, sets the list to the argument.=item $self->file_abs ( $filename )Using the incdir and libext lists, convert the specified module or filename("foo") to a absolute filename ("include/dir/foo.v").=item $self->file_skip_special ( $filename )Return true if the filename is one that generally should be ignored whenrecursing directories, such as for example, ".", "CVS", and ".svn".=item $self->file_substitute ( $filename )Removes existing environment variables from the provided filename. Anyundefined variables are not substituted nor cause errors.=item $self->incdir ()Returns reference to list of include directories. With argument, adds thatdirectory.=item $self->libext ()Returns reference to list of library extensions. With argument, adds thatextension.=item $self->libext_matches (I<filename>)Returns true if the passed filename matches the libext.=item $self->library ()Returns reference to list of libraries. With argument, adds that library.=item $self->module_dir ()Returns reference to list of module directories. With argument, adds thatdirectory.=item $self->remove_defines ( $token )Return string with any definitions in the token removed.=item $self->undef ( $token )Deletes a hash element that is used to fulfill define references. Thisfunction may also be called outside parsing to erase a predefined value.=item $self->undefineall ()Deletes all non-command line definitions, for implementing `undefineall.=back=head1 DISTRIBUTIONVerilog-Perl is part of the L<http://www.veripool.org/> free Verilog EDAsoftware tool suite. The latest version is available from CPAN and fromL<http://www.veripool.org/verilog-perl>.Copyright 2000-2010 by Wilson Snyder. This package is free software; youcan redistribute it and/or modify it under the terms of either the GNULesser General Public License Version 3 or the Perl Artistic License Version 2.0.=head1 AUTHORSWilson Snyder <wsnyder@wsnyder.org>=head1 SEE ALSOL<Verilog-Perl>,L<Verilog::Language>=cut
