view release on metacpan or  search on metacpan

lib/Alvis/Document/Type.pm  view on Meta::CPAN

    $ERR_FILE_TYPE
    )=(0..2);
my %ErrMsgs=($ERR_OK=>"",
	     $ERR_DOC=>"No document.",
	     $ERR_FILE_TYPE=>"Unable to instantiate File::Type"
	     );

sub _set_err_state
{
    my $self=shift;
    my $errcode=shift;
    my $errmsg=shift;

    if (!defined($errcode))
    {
        confess("set_err_state() called with an undefined argument.");
    }

    if (exists($ErrMsgs{$errcode}))
    {
        if ($errcode==$ERR_OK)
        {
            $self->{errstr}="";
        }
        else
        {
            $self->{errstr}.=" " . $ErrMsgs{$errcode};
            if (defined($errmsg))
            {
                $self->{errstr}.=" " . $errmsg;
            }
        }
    }
    else
    {
        confess("Internal error: set_err_state() called with an " .
                "unrecognized argument ($errcode).")
    }
}

sub errmsg
{
    my $self=shift;

    return $self->{errstr};
}

#############################################################################
#
#      Methods
#
##############################################################################
 
sub new
{
    my $proto=shift;

    my $class=ref($proto)||$proto;
    my $parent=ref($proto)&&$proto;
    my $self={};
    bless($self,$class);

    $self->_init(@_);

    $self->_set_err_state($ERR_OK);

    $self->{fileType}=File::Type->new();
    if (!defined($self->{fileType}))
    {
	$self->_set_err_state($ERR_FILE_TYPE);
	return undef;
    }

    return $self;
}

sub _init
{
    my $self=shift;

    $self->{defaultType}='text';
    $self->{defaultSubType}='plain';

    if (defined(@_))
    {
        my %args=@_;
        @$self{ keys %args }=values(%args);
    }
}

#
# Returns similarly to MIME ($type,$sub_type), but is broader
#
sub guess
{
    my $self=shift;
    my $text=shift;

    $self->_set_err_state($ERR_OK);  # clean the slate

    if (!defined($text))
    {
	$self->_set_err_state($ERR_DOC);
	return undef;
    }
    
    my ($type,$sub_type);

    # Try File::Type first
    my $mime_type=$self->{fileType}->mime_type($text);
    if (!defined($mime_type))
    {
	$type=$self->{defaultType};
	$sub_type=$self->{defaultSubType};
    }
    else
    {
	($type,$sub_type)=split(/\//,$mime_type,-1);
    }

    # If the result is a generic one, check for our types of interest