# 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 relevance foreach ( '.','..','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 parsing sub _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 style if ($param eq '-F' || $param eq '-f') { $self->{_parameter_next} = $param; } ### VCS style elsif (($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); } # Ignored elsif ($param =~ /^\+librescan$/ && $self->{vcs_style}) { } ### GCC style elsif (($param =~ /^-D([^=]*)=(.*)$/ || $param =~ /^-D([^=]*)()$/) && $self->{gcc_style}) { $self->define($1,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 parameters elsif ($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,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; } ####################################################################### # Accessors sub 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 stringify if (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 functions sub 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 file foreach 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 functions sub 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 return 1; __END__ =pod =head1 NAME Verilog::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 DESCRIPTION Verilog::Getopt provides standardized handling of options similar to Verilog/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 of GCC-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 and search paths to resolve the file. Optional lookup_type is 'module','include',or 'all',to use only module_dirs,incdirs,or both for the lookup. =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 lines for downstream programs that also use Verilog::Getopt. =item $self->parameter ( \@params ) Parses any recognized parameters in the referenced array,removing the standard parameters and returning a array with all unparsed parameters. The below list shows the VCS-like parameters that are supported,and the functions 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) +librescan Ignored -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 others Put in returned list The below list shows the GCC-like parameters that are supported,and the functions 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 others Put 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 behavior loads a hash that is used to fulfill define references. This function may also be called outside parsing to predefine values. An optional third argument specifies parameters to the define,and a fourth argument if true indicates the define was set on the command line and should not be removed by `undefineall. =item $self->define_names_sorted Return 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,useful for creating dependency lists. With argument,adds that file. With list reference 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 when recursing directories,such as for example,".","CVS",and ".svn". =item $self->file_substitute ( $filename ) Removes existing environment variables from the provided filename. Any undefined variables are not substituted nor cause errors. =item $self->incdir () Returns reference to list of include directories. With argument,adds that directory. =item $self->libext () Returns reference to list of library extensions. With argument,adds that extension. =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 that directory. =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. This function 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 disTRIBUTION Verilog-Perl is part of the L<http://www.veripool.org/> free Verilog EDA software tool suite. The latest version is available from CPAN and from L<http://www.veripool.org/verilog-perl>. copyright 2000-2010 by Wilson Snyder. This package is free software; you can redistribute it and/or modify it under the terms of either the GNU Lesser General Public License Version 3 or the Perl Artistic License Version 2.0. =head1 AUTHORS Wilson Snyder <wsnyder@wsnyder.org> =head1 SEE ALSO L<Verilog-Perl>,L<Verilog::Language> = cut
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
