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

package uSAC::MIME;
use strict;
use warnings;
use version; our $VERSION=version->declare("v0.2.1");

#Private storage for the internal database
my $default_mime_to_ext;

sub load_from_handle {
	my ($self, $fh)=@_;
	for(<$fh>){
		tr/;//d;
		s/^\s+//;
		next if /^\s*#/;
		next if /^\s*$/;
		next if /{|}/;

		my @fields=split /\s+/;
		#first field is the mime type, remaining are extensions
		for my $ext (@fields[1..$#fields]){
			$self->add($ext=>$fields[0]);
		}
	}
}

sub save_to_handle {
	my ($self, $fh)=@_;
	my @keys= sort keys $self->%*;
	my $output="";
	for(@keys){
		$output.= "$_ ".$self->{$_}."\n";
	}
	print $fh $output;
}

sub new {
	my $package=shift//__PACKAGE__;
	my %additional=@_;
	my $self={$default_mime_to_ext->%*};
	bless $self, $package;

	for(keys %additional){
		$self->add($_, $additional{$_});
	}
	$self;
}

sub new_empty {
	my $package=shift//__PACKAGE__;
	my %additional=@_;
	my $self={};

	bless $self, $package;
	for(keys %additional){
		$self->add($_, $additional{$_});
	}
	$self;
}

sub new_from_file {
	#ignore any line with only one word, or   { or }
	my $package=shift//__PACKAGE__;
	my $path=shift;
	my $self={};
	bless $self, $package;
	my $res=open my $fh, "<" ,$path;
	unless($res){
		warn "could not read file: $path";
	}
	else {
		$self->load_from_handle($fh);
	}
	$self;

}


sub index{
	my $db=shift;
	my @tmp;
	my @tmp2;
	for my $mime (keys $db->%*){
		for($db->{$mime}){
			my $exts=[split " "];
			push @tmp, map {$_,$mime} @$exts;
			push @tmp2, $mime, $exts

		}
	}
	#first hash is forward map from extention to mime type
	#second hash is reverse map from mime to to array or extension
	if(wantarray){
		return ({@tmp},{@tmp2});
	}
	else {
		return {@tmp};
	}
}


#add an ext=>mime mapping. need to reindex after
#returns
sub add {
	my ($db,$ext,$mime)=@_;
	my $exts_string=$db->{$mime}//"";
	unless($exts_string=~/\b$ext\b/){
		my @items=split " ", $exts_string;
		push @items, $ext;
		$db->{$mime}=join " ", @items;
	}
	$db;
}


sub rem {
	my ($db,$ext,$mime)=@_;
	my $exts_string=$db->{$mime};
	return unless defined $exts_string;
	if($exts_string=~s/\b$ext\b//){
		$exts_string=~s/ +/ /;
		if($exts_string eq " "){
			delete $db->{mime};
		}
		else {
			$db->{$mime}=$exts_string;
		}
	}
	$db
}

#After this unit is compiled, initalise the default map with data from DATA file handle.
#This is then used in the new constructor

UNITCHECK{
	#Force loading of defaults
	my $dummy=uSAC::MIME->new_empty;
	$dummy->load_from_handle(\*DATA);
	$default_mime_to_ext={$dummy->%*};
}

1;


__DATA__