File Coverage

blib/lib/uSAC/MIME.pm
Criterion Covered Total %
statement 70 75 93.3
branch 10 18 55.5
condition 5 8 62.5
subroutine 11 11 100.0
pod 7 8 87.5
total 103 120 85.8


line stmt bran cond sub pod time code
1             package uSAC::MIME;
2 1     1   148875 use strict;
  1         2  
  1         36  
3 1     1   5 use warnings;
  1         2  
  1         32  
4 1     1   496 use version; our $VERSION=version->declare("v0.2");
  1         2165  
  1         6  
5              
6             #Private storage for the internal database
7             my $default_mime_to_ext;
8              
9             sub load_from_handle {
10 1     1 1 3 my ($self, $fh)=@_;
11 1         57 for(<$fh>){
12 94         150 tr/;//d;
13 94         188 s/^\s+//;
14 94 50       188 next if /^\s*#/;
15 94 100       195 next if /^\s*$/;
16 87 50       223 next if /{|}/;
17              
18 87         342 my @fields=split /\s+/;
19             #first field is the mime type, remaining are extensions
20 87         174 for my $ext (@fields[1..$#fields]){
21 105         190 $self->add($ext=>$fields[0]);
22             }
23             }
24             }
25              
26             sub save_to_handle {
27 1     1 1 11 my ($self, $fh)=@_;
28 1         7 my @keys= sort keys $self->%*;
29 1         3 my $output="";
30 1         5 for(@keys){
31 0         0 $output.= "$_ ".$self->{$_}."\n";
32             }
33 1         183 print $fh $output;
34             }
35              
36             sub new {
37 1   50 1 1 111 my $package=shift//__PACKAGE__;
38 1         4 my %additional=@_;
39 1         53 my $self={$default_mime_to_ext->%*};
40 1         6 bless $self, $package;
41              
42 1         4 for(keys %additional){
43 0         0 $self->add($_, $additional{$_});
44             }
45 1         4 $self;
46             }
47              
48             sub new_empty {
49 2   50 2 1 364 my $package=shift//__PACKAGE__;
50 2         7 my %additional=@_;
51 2         5 my $self={};
52              
53 2         7 bless $self, $package;
54 2         8 for(keys %additional){
55 1         7 $self->add($_, $additional{$_});
56             }
57 2         21 $self;
58             }
59              
60             sub new_from_file {
61             #ignore any line with only one word, or { or }
62 1   50 1 0 1620 my $package=shift//__PACKAGE__;
63 1         2 my $path=shift;
64 1         2 my $self={};
65 1         3 bless $self, $package;
66 1         989 my $res=open my $fh, "<" ,$path;
67 1 50       10 unless($res){
68 1         106 warn "could not read file: $path";
69             }
70             else {
71 0         0 $self->load_from_handle($fh);
72             }
73 1         14 $self;
74            
75             }
76              
77              
78             sub index{
79 5     5 1 17 my $db=shift;
80 5         10 my @tmp;
81             my @tmp2;
82 5         64 for my $mime (keys $db->%*){
83 314         440 for($db->{$mime}){
84 314         689 my $exts=[split " "];
85 314         469 push @tmp, map {$_,$mime} @$exts;
  425         867  
86 314         632 push @tmp2, $mime, $exts
87              
88             }
89             }
90             #first hash is forward map from extention to mime type
91             #second hash is reverse map from mime to to array or extension
92 5 50       28 if(wantarray){
93 5         417 return ({@tmp},{@tmp2});
94             }
95             else {
96 0         0 return {@tmp};
97             }
98             }
99              
100              
101             #add an ext=>mime mapping. need to reindex after
102             #returns
103             sub add {
104 108     108 1 2963 my ($db,$ext,$mime)=@_;
105 108   100     291 my $exts_string=$db->{$mime}//"";
106 108 50       835 unless($exts_string=~/\b$ext\b/){
107 108         210 my @items=split " ", $exts_string;
108 108         178 push @items, $ext;
109 108         291 $db->{$mime}=join " ", @items;
110             }
111 108         243 $db;
112             }
113              
114              
115             sub rem {
116 1     1 1 342 my ($db,$ext,$mime)=@_;
117 1         3 my $exts_string=$db->{$mime};
118 1 50       5 return unless defined $exts_string;
119 1 50       28 if($exts_string=~s/\b$ext\b//){
120 1         3 $exts_string=~s/ +/ /;
121 1 50       4 if($exts_string eq " "){
122 0         0 delete $db->{mime};
123             }
124             else {
125 1         4 $db->{$mime}=$exts_string;
126             }
127             }
128             $db
129 1         4 }
130              
131             #After this unit is compiled, initalise the default map with data from DATA file handle.
132             #This is then used in the new constructor
133              
134             UNITCHECK{
135             #Force loading of defaults
136             my $dummy=uSAC::MIME->new_empty;
137             $dummy->load_from_handle(\*DATA);
138             $default_mime_to_ext={$dummy->%*};
139             }
140              
141             1;
142              
143              
144             __DATA__