"Fossies" - the Fresh Open Source Software Archive

Member "darktable-2.6.3/tools/introspection/scanner.pm" (20 Oct 2019, 14479 Bytes) of package /linux/misc/darktable-2.6.3.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "scanner.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 2.6.3_vs_3.0.0.rc0.

    1 #  This file is part of darktable,
    2 #  copyright (c) 2013-2014 tobias ellinghaus.
    3 #
    4 #  darktable is free software: you can redistribute it and/or modify
    5 #  it under the terms of the GNU General Public License as published by
    6 #  the Free Software Foundation, either version 3 of the License, or
    7 #  (at your option) any later version.
    8 #
    9 #  darktable is distributed in the hope that it will be useful,
   10 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
   11 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12 #  GNU General Public License for more details.
   13 #
   14 #  You should have received a copy of the GNU General Public License
   15 #  along with darktable.  If not, see <http://www.gnu.org/licenses/>.
   16 
   17 package scanner;
   18 
   19 use strict;
   20 use warnings;
   21 
   22 use Exporter;
   23 our @ISA = 'Exporter';
   24 our @EXPORT = qw( @token @comments
   25                   $P_LINENO $P_FILENAME $P_TYPE $P_VALUE
   26                   $T_NONE $T_IDENT $T_KEYWORD $T_INTEGER_LITERAL $T_OPERATOR
   27                   $K_UNSIGNED $K_SIGNED $K_GBOOLEAN $K_CHAR $K_UCHAR $K_SHORT $K_USHORT $K_INT $K_UINT $K_LONG $K_ULONG $K_FLOAT $K_DOUBLE $K_COMPLEX $K_TYPEDEF $K_STRUCT $K_UNION $K_CONST $K_VOLATILE $K_STATIC $K_ENUM $K_VOID $K_DT_MODULE_INTROSPECTION
   28                   $O_ASTERISK $O_AMPERSAND $O_SEMICOLON $O_COMMA $O_COLON $O_SLASH $O_LEFTROUND $O_RIGHTROUND $O_LEFTCURLY $O_RIGHTCURLY $O_LEFTSQUARE $O_RIGHTSQUARE $O_EQUAL
   29                   read_file get_token look_ahead token2string
   30                   isid isinteger issemicolon istypedef isstruct isunion isenum isleftcurly isrightcurly isleftround isrightround isleftsquare isrightsquare 
   31                   iscomma isasterisk isequal isconst isvolatile isdtmoduleintrospection
   32                 );
   33 
   34 
   35 ################# the scanner #################
   36 
   37 my %history; # we don't like cyclic includes
   38 
   39 my $lineno = 1;
   40 my $file;
   41 our $folder = "";
   42 my @tokens;
   43 our @token;
   44 our @comments;
   45 
   46 my @code;
   47 
   48 # parser layout
   49 our $P_LINENO = 0;
   50 our $P_FILENAME = 1;
   51 our $P_TYPE = 2;
   52 our $P_VALUE = 3;
   53 
   54 my $i = 0;
   55 # token types
   56 our $T_NONE = $i++;
   57 our $T_IDENT = $i++;
   58 our $T_KEYWORD = $i++;
   59 our $T_INTEGER_LITERAL = $i++;
   60 our $T_OPERATOR = $i++;
   61 
   62 $i = 0;
   63 # keywords
   64 my  @K_readable;
   65 our $K_UNSIGNED = $i++; push(@K_readable, 'unsigned');
   66 our $K_SIGNED = $i++; push(@K_readable, 'signed');
   67 our $K_GBOOLEAN = $i++; push(@K_readable, 'gboolean');
   68 our $K_CHAR = $i++; push(@K_readable, 'char');
   69 our $K_UCHAR = $i++; push(@K_readable, 'uchar');
   70 our $K_SHORT = $i++; push(@K_readable, 'short');
   71 our $K_USHORT = $i++; push(@K_readable, 'ushort');
   72 our $K_INT = $i++; push(@K_readable, 'int');
   73 our $K_UINT = $i++; push(@K_readable, 'uint');
   74 our $K_LONG = $i++; push(@K_readable, 'long');
   75 our $K_ULONG = $i++; push(@K_readable, 'ulong');
   76 our $K_FLOAT = $i++; push(@K_readable, 'float');
   77 our $K_DOUBLE = $i++; push(@K_readable, 'double');
   78 our $K_COMPLEX = $i++; push(@K_readable, 'complex');
   79 our $K_TYPEDEF = $i++; push(@K_readable, 'typedef');
   80 our $K_STRUCT = $i++; push(@K_readable, 'struct');
   81 our $K_UNION = $i++; push(@K_readable, 'union');
   82 our $K_CONST = $i++; push(@K_readable, 'const');
   83 our $K_VOLATILE = $i++; push(@K_readable, 'volatile');
   84 our $K_STATIC = $i++; push(@K_readable, 'static');
   85 our $K_ENUM = $i++; push(@K_readable, 'enum');
   86 our $K_VOID = $i++; push(@K_readable, 'void');
   87 our $K_DT_MODULE_INTROSPECTION = $i++; push(@K_readable, 'DT_MODULE_INTROSPECTION');
   88 my  @keywords = (
   89       ['unsigned', $K_UNSIGNED],
   90       ['signed', $K_SIGNED],
   91       ['gboolean', $K_GBOOLEAN],
   92       ['char', $K_CHAR],
   93       ['gchar', $K_CHAR],
   94       ['int8_t', $K_CHAR],
   95       ['short', $K_SHORT],
   96       ['int16_t', $K_SHORT],
   97       ['uint16_t', $K_USHORT],
   98       ['int', $K_INT],
   99       ['gint', $K_INT],
  100       ['uint', $K_UINT],
  101       ['uint32_t', $K_UINT],
  102       ['int32_t', $K_INT],
  103       ['long', $K_LONG],
  104       ['float', $K_FLOAT],
  105       ['double', $K_DOUBLE],
  106       ['complex', $K_COMPLEX],
  107       ['typedef', $K_TYPEDEF],
  108       ['struct', $K_STRUCT],
  109       ['union', $K_UNION],
  110       ['const', $K_CONST],
  111       ['volatile', $K_VOLATILE],
  112       ['static', $K_STATIC],
  113       ['enum', $K_ENUM],
  114       ['void', $K_VOID],
  115       ['DT_MODULE_INTROSPECTION', $K_DT_MODULE_INTROSPECTION]
  116 );
  117 
  118 $i = 0;
  119 # operators
  120 my  @O_readable;
  121 our $O_ASTERISK = $i++; push(@O_readable, '*');
  122 our $O_AMPERSAND = $i++; push(@O_readable, '&');
  123 our $O_SEMICOLON = $i++; push(@O_readable, ';');
  124 our $O_COMMA = $i++; push(@O_readable, ',');
  125 our $O_COLON = $i++; push(@O_readable, ':');
  126 our $O_SLASH = $i++; push(@O_readable, '/');
  127 our $O_LEFTROUND = $i++; push(@O_readable, '(');
  128 our $O_RIGHTROUND = $i++; push(@O_readable, ')');
  129 our $O_LEFTCURLY = $i++; push(@O_readable, '{');
  130 our $O_RIGHTCURLY = $i++; push(@O_readable, '}');
  131 our $O_LEFTSQUARE = $i++; push(@O_readable, '[');
  132 our $O_RIGHTSQUARE = $i++; push(@O_readable, ']');
  133 our $O_EQUAL = $i++; push(@O_readable, '=');
  134 our $O_PLUS = $i++; push(@O_readable, '+');
  135 our $O_MINUS = $i++; push(@O_readable, '-');
  136 our $O_LESS = $i++; push(@O_readable, '<');
  137 our $O_LESSLESS = $i++; push(@O_readable, '<<');
  138 our $O_GREATER = $i++; push(@O_readable, '>');
  139 our $O_GREATERGREATER = $i++; push(@O_readable, '>>');
  140 our $O_PERCENT = $i++; push(@O_readable, '%');
  141 our $O_CIRCUMFLEX = $i++; push(@O_readable, '^');
  142 
  143 sub read_file
  144 {
  145   $file = shift;
  146 
  147   return if(defined($history{$file}));
  148   $history{$file} = 1;
  149 
  150   open(IN, "<$file") or return;
  151   $lineno = 1;
  152   my @tmp = <IN>;
  153   close(IN);
  154   my $result = join('', @tmp);
  155   unshift(@code, split(//, $result));
  156 }
  157 
  158 # TODO: support something else than decimal numbers, i.e., octal and hex
  159 sub read_number
  160 {
  161   my $c = shift(@code);
  162   my @buf;
  163   while($c =~ /[0-9]/)
  164   {
  165     push(@buf, $c);
  166     $c = shift(@code);
  167   }
  168   unshift(@code, $c);
  169   return join('', @buf);
  170 }
  171 
  172 sub read_string
  173 {
  174   my $c = shift(@code);
  175   my @buf;
  176   while(defined($c) && $c =~ /[a-zA-Z_0-9]/)
  177   {
  178     push(@buf, $c);
  179     $c = shift(@code);
  180   }
  181   unshift(@code, $c);
  182   return join('', @buf);
  183 }
  184 
  185 sub handle_comment
  186 {
  187   my $_lineno = $lineno;
  188   shift(@code);
  189   my $c = $code[0];
  190   my @buf;
  191   if($c eq '/')
  192   {
  193     # a comment of the form '//'. this goes till the end of the line
  194     while(defined($c) && $c ne "\n")
  195     {
  196       push(@buf, $c);
  197       $c = shift(@code);
  198     }
  199     unshift(@code, $c);
  200     $lineno++;
  201   }
  202   elsif($c eq '*')
  203   {
  204     # a comment of the form '/*'. this goes till we find '*/'
  205     while(defined($c) && ($c ne '*' || $code[0] ne '/'))
  206     {
  207       $lineno++ if($c eq "\n");
  208       push(@buf, $c);
  209       $c = shift(@code);
  210     }
  211     push(@buf, $c);
  212   }
  213   else
  214   {
  215     # can't happen
  216     print STDERR "comment error\n";
  217   }
  218   my $comment = join('', @buf);
  219 
  220   push(@{$comments[$_lineno]{raw}}, $comment);
  221 }
  222 
  223 sub handle_include
  224 {
  225   my $c = ' ';
  226   $c = shift(@code) while($c eq ' ');
  227   my $end;
  228   if($c eq '"') { $end = '"'; }
  229 #   elsif($c eq '<') { $end = '>'; }
  230   else
  231   {
  232     unshift(@code, $c);
  233     return;
  234   }
  235   $c = shift(@code);
  236   my @buf;
  237   while(defined($c) && $c ne $end)
  238   {
  239     if($c eq "\n") # no idea how to handle this, just ignore it
  240     {
  241       unshift(@code, $c);
  242       ++$lineno;
  243       return;
  244     }
  245     push(@buf, $c);
  246     $c = shift(@code);
  247   }
  248   unshift(@code, $c);
  249   return if(!defined($c));
  250 
  251   my $filename = join('', @buf);
  252 
  253   if($filename =~ /^iop|^common/)
  254   {
  255     # add the current filename and lineno to the code stream so we
  256     # can reset these when the included file is scanned
  257     # note that all entries in @code coming from the files are single characters,
  258     # so we can safely add longer strings
  259     unshift(@code, 'undo_include', $file, $lineno);
  260     read_file($folder.$filename);
  261   }
  262 }
  263 
  264 sub handle_define
  265 {
  266   # just read until the end of the line
  267   my $c = ' ';
  268   $c = shift(@code) while(defined($code[0]) && $c ne "\n");
  269   unshift(@code, $c);
  270 }
  271 
  272 sub handle_preprocessor
  273 {
  274   my $string = read_string();
  275   if($string eq "include") { handle_include(); }
  276   elsif($string eq "define") { handle_define(); }
  277   unshift(@code, ' ');
  278 }
  279 
  280 sub read_token
  281 {
  282   for(; defined($code[0]); shift(@code))
  283   {
  284     my $c = $code[0];
  285     if($c eq "\n") { ++$lineno;}
  286     elsif($c eq " " || $c eq "\t") { next; }
  287     elsif($c eq "#") { shift(@code); handle_preprocessor(); next; }
  288     elsif($c eq "undo_include") { shift(@code); $file = shift(@code); $lineno = shift(@code); }
  289     elsif($c eq "&") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_AMPERSAND); }
  290     elsif($c eq "*") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_ASTERISK); }
  291     elsif($c eq "/" && ($code[1] eq "/" || $code[1] eq "*" ))
  292     {
  293       handle_comment();
  294       next;
  295     }
  296     elsif($c eq ";") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_SEMICOLON); }
  297     elsif($c eq ",") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_COMMA); }
  298     elsif($c eq "(") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_LEFTROUND); }
  299     elsif($c eq ")") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_RIGHTROUND); }
  300     elsif($c eq "{") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_LEFTCURLY); }
  301     elsif($c eq "}") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_RIGHTCURLY); }
  302     elsif($c eq "[") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_LEFTSQUARE); }
  303     elsif($c eq "]") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_RIGHTSQUARE); }
  304     elsif($c eq ":") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_COLON); }
  305     elsif($c eq "=") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_EQUAL); }
  306     elsif($c eq "+") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_PLUS); }
  307     elsif($c eq "-") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_MINUS); }
  308     elsif($c eq "<")
  309     {
  310       shift(@code);
  311       if($code[0] eq "<")
  312       {
  313         shift(@code);
  314         return ($lineno, $file, $T_OPERATOR, $O_LESSLESS);
  315       }
  316       else
  317       {
  318         return ($lineno, $file, $T_OPERATOR, $O_LESS);
  319       }
  320     }
  321     elsif($c eq ">")
  322     {
  323       shift(@code);
  324       if($code[0] eq ">")
  325       {
  326         shift(@code);
  327         return ($lineno, $file, $T_OPERATOR, $O_GREATERGREATER);
  328       }
  329       else
  330       {
  331         return ($lineno, $file, $T_OPERATOR, $O_GREATER);
  332       }
  333     }
  334     elsif($c eq "%") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_PERCENT); }
  335     elsif($c eq "^") { shift(@code); return ($lineno, $file, $T_OPERATOR, $O_CIRCUMFLEX); }
  336     elsif($c =~ /^[0-9]$/)
  337     {
  338       my $number = read_number();
  339       return ($lineno, $file, $T_INTEGER_LITERAL, $number);
  340     }
  341     elsif($c =~ /^[a-zA-Z_]$/)
  342     {
  343       my $string = read_string();
  344       foreach(@keywords)
  345       {
  346         my @entry = @{$_};
  347         if($string eq $entry[0])
  348         {
  349           return ($lineno, $file, $T_KEYWORD, $entry[1]);
  350         }
  351       }
  352       return ($lineno, $file, $T_IDENT, "$string");
  353     }
  354     else {
  355       # we don't care that we can't understand every input symbol, we just read over them until we reach something we know.
  356       # everything we see from there on should be handled by the scanner/parser
  357       # print STDERR "scanner error: ".$c."\n";
  358     }
  359   }
  360   return ($lineno, $file, $T_NONE, 0);
  361 }
  362 
  363 sub get_token
  364 {
  365   my $n_tokens = @tokens;
  366   return read_token() if($n_tokens == 0);
  367   return @{shift(@tokens)};
  368 }
  369 
  370 sub look_ahead
  371 {
  372   my $steps = shift;
  373   my $n_tokens = @tokens;
  374 
  375   return $tokens[$steps-1] if($n_tokens >= $steps);
  376 
  377   my @token;
  378   for(my $i = $n_tokens; $i < $steps; ++$i )
  379   {
  380     @token = read_token();
  381     return @token if($token[$P_TYPE] == $T_NONE);              # Can't look ahead that far.
  382     push(@tokens, [@token]);
  383   }
  384   return @token;
  385 }
  386 
  387 sub token2string
  388 {
  389   my $token = shift;
  390   my $result;
  391 
  392   if   ($token[$P_TYPE] == $T_NONE)            { $result = '<EMPTY TOKEN>'; }
  393   elsif($token[$P_TYPE] == $T_IDENT)           { $result = $token[$P_VALUE]; }
  394   elsif($token[$P_TYPE] == $T_KEYWORD)         { $result = $K_readable[$token[$P_VALUE]]; }
  395   elsif($token[$P_TYPE] == $T_INTEGER_LITERAL) { $result = $token[$P_VALUE]; }
  396   elsif($token[$P_TYPE] == $T_OPERATOR)        { $result = $O_readable[$token[$P_VALUE]]; }
  397   else                                         { $result = '<UNKNOWN TOKEN TYPE>'; }
  398 
  399   return $result;
  400 }
  401 
  402 sub issemicolon { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_SEMICOLON); }
  403 sub isleftcurly { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_LEFTCURLY); }
  404 sub isrightcurly { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_RIGHTCURLY); }
  405 sub isleftround { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_LEFTROUND); }
  406 sub isrightround { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_RIGHTROUND); }
  407 sub isleftsquare { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_LEFTSQUARE); }
  408 sub isrightsquare { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_RIGHTSQUARE); }
  409 sub iscomma { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_COMMA); }
  410 sub isasterisk { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_ASTERISK); }
  411 sub isequal { my $token = shift; return ($token[$P_TYPE] == $T_OPERATOR && $token[$P_VALUE] == $O_EQUAL); }
  412 sub isid { my $token = shift; return ($token[$P_TYPE] == $T_IDENT); }
  413 sub isinteger { my $token = shift; return ($token[$P_TYPE] == $T_INTEGER_LITERAL); }
  414 sub istypedef { my $token = shift; return ($token[$P_TYPE] == $T_KEYWORD && $token[$P_VALUE] == $K_TYPEDEF); }
  415 sub isstruct { my $token = shift; return ($token[$P_TYPE] == $T_KEYWORD && $token[$P_VALUE] == $K_STRUCT); }
  416 sub isunion { my $token = shift; return ($token[$P_TYPE] == $T_KEYWORD && $token[$P_VALUE] == $K_UNION); }
  417 sub isenum { my $token = shift; return ($token[$P_TYPE] == $T_KEYWORD && $token[$P_VALUE] == $K_ENUM); }
  418 sub isconst { my $token = shift; return ($token[$P_TYPE] == $T_KEYWORD && $token[$P_VALUE] == $K_CONST); }
  419 sub isvolatile { my $token = shift; return ($token[$P_TYPE] == $T_KEYWORD && $token[$P_VALUE] == $K_VOLATILE); }
  420 sub isdtmoduleintrospection { my $token = shift; return ($token[$P_TYPE] == $T_KEYWORD && $token[$P_VALUE] == $K_DT_MODULE_INTROSPECTION); }
  421 
  422 1;
  423 
  424 # modelines: These editor modelines have been set for all relevant files by tools/update_modelines.sh
  425 # vim: shiftwidth=2 expandtab tabstop=2 cindent
  426 # kate: tab-indents: off; indent-width 2; replace-tabs on; indent-mode cstyle; remove-trailing-space on;