vcs.maemo.org Git - maemian/blob - nokia-lintian/lib/scan_script.pl

   1 # -*- perl -*-
   2
   3 # Copyright (C) 1998 Richard Braakman
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, you can find it on the World Wide
  17 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  18 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  19 # MA 02110-1301, USA.
  20
  21 # Functions are defined here to read a shell script and return it as
  22 # a list of tokens.
  23
  24 # We do NOT do history expansion, because it's normally turned off in
  25 # shell scripts.
  26
  27 # Possible tokens:
  28 # literal:
  29 #  <<- << >> && || <> >| >& ;; (( <& >& ( ) < > ; & | -
  30 #
  31 # end of line: EOL
  32
  33 use strict;
  34
  35 sub scan_script {
  36     my $tokenval = '';
  37     my @tokens = ();
  38     my $state = 0; #base
  39     my $reserved_ok = 1;
  40     my $line = 1;
  41
  42     foreach (split(/\n/, $_[0])) {
  43         if ($state == 0) {  # base
  44             s/^\s+//;               # skip leading whitespace
  45             if (m/^\#|^$/) {
  46                 # skip blank lines, skip comments till end of line
  47                 push(@tokens, 'EOL');
  48                 $reserved_ok = 1;
  49                 $line++;
  50                 next;
  51             }
  52
  53             elsif (s/^( <<- | << | >> | <> | >\| | >& )//x) {
  54                 push(@tokens, $1);
  55                 $reserved_ok = 0;
  56                 redo;
  57             }
  58
  59             elsif (s/^( && | \|\| )//x) {
  60                 push(@tokens, $1);
  61                 $reserved_ok = 1;
  62                 redo;
  63             }
  64
  65             elsif (s/^ ;; //x) {
  66                 push(@tokens, ';;');
  67                 $state = 1; # case pattern
  68                 $reserved_ok = 1;
  69                 redo;
  70             }
  71
  72             elsif ($reserved_ok and s/^ \(\( //x) {
  73                 push(@tokens, '((');
  74                 $state = 2; # dparen arithmetic
  75                 redo;
  76                 # XXX parse_arith_cmd
  77             }
  78
  79             elsif (s/^( <& | >& )//x) {
  80                 push(@tokens, $1);
  81                 # hack <& - and >& - cases.
  82                 # No comments or newlines can appear between the <& and -.
  83                 if (s/^ \s* -//x) {
  84                     push(@tokens, '-');
  85                 }
  86                 $reserved_ok = 0;
  87                 redo;
  88             }
  89
  90             elsif (m/^( <\( | >\( )/x) {
  91                 $state = 3; # word
  92                 $reserved_ok = 0;
  93                 redo;
  94             }
  95
  96             elsif (s/^( < | > )//x) {
  97                 push (@tokens, $1);
  98                 $reserved_ok = 0;
  99                 redo;
 100             }
 101
 102             elsif (s/^([();&|])//) {
 103                 push (@tokens, $1);
 104                 $reserved_ok = 1;
 105                 redo;
 106             }
 107
 108             else {
 109                 $state = 3; # word
 110                 redo;
 111             }
 112         }
 113
 114     }
 115
 116     return @tokens;
 117 }
 118