← Back to branch summary

~ubuntu-branches/ubuntu/hoary/acheck/hoary

« back to all changes in this revision

Viewing changes to FileType.pm

  • Committer: Bazaar Package Importer
  • Author(s): Nicolas Bertolissio
  • Date: 2003-10-05 13:17:22 UTC
  • Revision ID: james.westby@ubuntu.com-20031005131722-da58jpjclwut7whs
Tags: 0.4
* add pause after warning if aspell cannot be used in interactive mode
  thanks to Martin Quinson for reporting this bug
* make menu easier to translated
* fix missing i18n for hint comment output
* add Polish localisation
  thanks to Arkadiusz Lipiec for providing it
* Standards-version: 3.6.1
* change maintainer's address to Debian's one

Show diffs side-by-side

added added

removed removed

Lines of Context:
FileType.pm
 
1
package ACheck::FileType;
 
2
 
 
3
 
 
4
use strict;
 
5
use Exporter;
 
6
use locale;
 
7
use File::Spec::Functions qw(rel2abs splitpath splitdir);
 
8
use ACheck::Common;
 
9
 
 
10
use vars  qw(@ISA @EXPORT);
 
11
 
 
12
@ISA    = qw(Exporter);
 
13
@EXPORT = qw(
 
14
        file_type
 
15
        );
 
16
 
 
17
my %FILE_TYPES = (                                              # filetypes
 
18
        '\.wml(\.\w+)?$'        => "wml",
 
19
        '\.po(\.\w+)?$'         => "po",
 
20
        '\.te?xt(\.\w+)?$'      => "text"
 
21
        );
 
22
 
 
23
 
 
24
# file_type
 
25
#
 
26
# find file type
 
27
#
 
28
# input:
 
29
#   filename
 
30
#   array reference of file lines
 
31
# return:
 
32
#   file type
 
33
sub file_type ($$) {
 
34
        my $filename    = shift || "-";                         # filename
 
35
        my $lines       = shift;                                # array of lines
 
36
 
 
37
        debug 1;
 
38
        debug 2, "filename:     ".($filename || "STDIN")."\n";
 
39
 
 
40
        my $type;                                       # file type
 
41
        my $file   =  "";                               # file name
 
42
        my $dir    =  "";                               # directory
 
43
        my @dirs   = ("");                              # path
 
44
 
 
45
        unless ($filename eq "-") {
 
46
                $filename = rel2abs($filename) unless $filename eq "-";
 
47
                (undef, $dir, $file) = splitpath($filename);
 
48
                @dirs = splitdir($dir);
 
49
        }
 
50
 
 
51
        #
 
52
        # file name tests
 
53
        #
 
54
        if ($dirs[-1] eq "debian" &&
 
55
            $file     eq "control"  ) {
 
56
                $type = "debian-control";
 
57
        }
 
58
 
 
59
        if ($type) {
 
60
                debug 3, "filetype:     $type\n";
 
61
                return $type;
 
62
        }
 
63
 
 
64
 
 
65
        #
 
66
        # file extension tests
 
67
        #
 
68
        foreach (keys %FILE_TYPES) {
 
69
                next unless $file =~ /$_/;
 
70
                $type = $FILE_TYPES{$_};
 
71
                last;
 
72
        }
 
73
 
 
74
        if ($type) {
 
75
                debug 3, "filetype:     $type\n";
 
76
                return $type;
 
77
        }
 
78
 
 
79
 
 
80
        #
 
81
        # content tests
 
82
        #
 
83
        if      ($$lines[0] =~ /^--- \w+/    &&         # unified diff tests
 
84
                 $$lines[1] =~ /^\+\+\+ \w+/ &&
 
85
                 $$lines[2] =~ /^@@ /       ) {
 
86
                $type   = "udiff-wml" if $$lines[0] =~ /^\-\-\- \w+\.wml\b/;
 
87
                $type   = "udiff-wml" if $$lines[1] =~ /^\+\+\+ \w+\.wml\b/;
 
88
                $type ||= "udiff";
 
89
        } elsif ($$lines[0] =~ /^#use wml\b/) {
 
90
                $type = "wml";
 
91
        } else {                                        # otherwise try to guess from file lines
 
92
                my $i;
 
93
                for ($i = 0; $i < @{ $lines }; $i++) {
 
94
                        last unless $$lines[$i] =~ /^#/;
 
95
                }
 
96
                if      ($i == @{ $lines }) {
 
97
                } elsif ($$lines[$i  ] =~ /^msgid ""$/ &&
 
98
                         $$lines[$i+1] =~ /^msgstr "/    ) {
 
99
                        $type = "po";
 
100
                } elsif ($$lines[$i  ] =~ /^Description: /) {
 
101
                        $type = "ddts";
 
102
                }
 
103
        }
 
104
 
 
105
        $type ||= "text";                               # default to text
 
106
 
 
107
        debug 3, "filetype:     $type\n";
 
108
 
 
109
        return $type;
 
110
}
 
111
 
 
112
1;