source: repository/lib/Metabrik/File/Type.pm

Last change on this file was 866:f6ad8c136b19, checked in by GomoR <gomor@…>, 8 months ago
  • update: copyright 2017
File size: 4.5 KB
Line 
1#
2# $Id$
3#
4# file::type Brik
5#
6package Metabrik::File::Type;
7use strict;
8use warnings;
9
10use base qw(Metabrik::System::Package);
11
12sub brik_properties {
13   return {
14      revision => '$Revision$',
15      tags => [ qw(unstable) ],
16      author => 'GomoR <GomoR[at]metabrik.org>',
17      license => 'http://opensource.org/licenses/BSD-3-Clause',
18      commands => {
19         install => [ ], # Inherited
20         get_mime_type => [ qw(file|file_list) ],
21         get_magic_type => [ qw(file|file_list) ],
22         is_mime_type => [ qw(file|file_list mime_type) ],
23         is_magic_type => [ qw(file|file_list mime_type) ],
24         get_types => [ qw(file|file_list) ],
25      },
26      require_modules => {
27         'File::LibMagic' => [ ],
28      },
29      need_packages => {
30         ubuntu => [ qw(libmagic-dev) ],
31         debian => [ qw(libmagic-dev) ],
32      },
33   };
34}
35
36sub get_mime_type {
37   my $self = shift;
38   my ($files) = @_;
39
40   $self->brik_help_run_undef_arg('get_mime_type', $files) or return;
41   my $ref = $self->brik_help_run_invalid_arg('get_mime_type', $files, 'ARRAY', 'SCALAR')
42      or return;
43
44   my $magic = File::LibMagic->new;
45
46   if ($ref eq 'ARRAY') {
47      my $types = {};
48      for my $file (@$files) {
49         my $type = $self->get_mime_type($file) or next;
50         $types->{$file} = $type;
51      }
52
53      return $types;
54   }
55   else {
56      $self->brik_help_run_file_not_found('get_mime_type', $files) or return;
57      my $info = $magic->info_from_filename($files);
58
59      return $info->{mime_type};
60   }
61
62   # Error
63   return;
64}
65
66sub get_magic_type {
67   my $self = shift;
68   my ($files) = @_;
69
70   $self->brik_help_run_undef_arg('get_magic_type', $files) or return;
71   my $ref = $self->brik_help_run_invalid_arg('get_magic_type', $files, 'ARRAY', 'SCALAR')
72      or return;
73
74   my $magic = File::LibMagic->new;
75
76   if ($ref eq 'ARRAY') {
77      my $types = {};
78      for my $file (@$files) {
79         my $type = $self->get_magic_type($file) or next;
80         $types->{$file} = $type;
81      }
82      return $types;
83   }
84   else {
85      $self->brik_help_run_file_not_found('get_magic_type', $files) or return;
86      my $info = $magic->info_from_filename($files);
87      return $info->{description};
88   }
89
90   # Error
91   return;
92}
93
94sub is_mime_type {
95   my $self = shift;
96   my ($files, $mime_type) = @_;
97
98   $self->brik_help_run_undef_arg('is_mime_type', $files) or return;
99   my $ref = $self->brik_help_run_invalid_arg('is_mime_type', $files, 'ARRAY', 'SCALAR')
100      or return;
101
102   my $types = {};
103   if ($ref eq 'ARRAY') {
104      $self->brik_help_run_empty_array_arg('is_mime_type', $files) or return;
105      for my $file (@$files) {
106         my $res = $self->is_mime_type($file, $mime_type) or next;
107         $types->{$files} = $res;
108      }
109   }
110   else {
111      my $type = $self->get_mime_type($files, $mime_type) or return;
112      if ($type eq $mime_type) {
113         $types->{$files} = 1;
114      }
115      else {
116         $types->{$files} = 0;
117      }
118   }
119
120   return $ref eq 'ARRAY' ? $types : $types->{$files};
121}
122
123sub is_magic_type {
124   my $self = shift;
125   my ($files, $magic_type) = @_;
126
127   $self->brik_help_run_undef_arg('is_magic_type', $files) or return;
128   my $ref = $self->brik_help_run_invalid_arg('is_magic_type', $files, 'ARRAY', 'SCALAR')
129      or return;
130
131   my $types = {};
132   if ($ref eq 'ARRAY') {
133      $self->brik_help_run_empty_array_arg('is_magic_type', $files) or return;
134      for my $file (@$files) {
135         my $res = $self->is_magic_type($file, $magic_type) or next;
136         $types->{$files} = $res;
137      }
138   }
139   else {
140      my $type = $self->get_magic_type($files, $magic_type) or return;
141      if ($type eq $magic_type) {
142         $types->{$files} = 1;
143      }
144      else {
145         $types->{$files} = 0;
146      }
147   }
148
149   return $ref eq 'ARRAY' ? $types : $types->{$files};
150}
151
152sub get_types {
153   my $self = shift;
154   my ($files) = @_;
155
156   $self->brik_help_run_undef_arg('get_types', $files) or return;
157   my $ref = $self->brik_help_run_invalid_arg('get_types', $files, 'ARRAY', 'SCALAR')
158      or return;
159
160   my $mime = $self->get_mime_type($files) or return;
161   my $magic = $self->get_magic_type($files) or return;
162
163   return {
164      mime => $mime,
165      magic => $magic,
166   };
167}
168
1691;
170
171__END__
172
173=head1 NAME
174
175Metabrik::File::Type - file::type Brik
176
177=head1 COPYRIGHT AND LICENSE
178
179Copyright (c) 2014-2017, Patrice E<lt>GomoRE<gt> Auffret
180
181You may distribute this module under the terms of The BSD 3-Clause License.
182See LICENSE file in the source distribution archive.
183
184=head1 AUTHOR
185
186Patrice E<lt>GomoRE<gt> Auffret
187
188=cut
Note: See TracBrowser for help on using the repository browser.