# -*- Mode: Perl -*- 
#
# Snippet.pm 
# Copyright (C) 1997-1998 Federico Di Gregorio.
#
# This module is part of the Definitive Type Manager package.   
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTIBILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.

=head1 NAME

DTM::Snippet - Object-Oriented management of catalog snippets.

=cut

package DTM::Snippet;

require 5.004;
use strict;
use Carp;
use vars qw();


=head1 DESCRIPTION

The B<Snippet> package provides an easy perl interface to the
various fonts managed by the Definitive Type Manager system.
Other libraries offer the same type of facilities for other
languages (e.g., C). Fonts here really means I<information>
I<about the fonts>, in the form of catalog snippet. 
A better description of catalogs and snippets can be found
in the I<Definitive Font Manager Guide>.

=cut

=head1 METHODS

=head2 new

I<new> simply returns an newly allocated empty snippet.

    $snippet = new DTM::Snippet(%init);

The init hash is used to init the main attributes of the
snippet. If the method is called throught another snippet
the new one is a copy of the former.

=cut

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = {};
    my %init = (@_);

    # init, if required
    build_from_string($self, $this->dump_to_string())
	if $this ne $class;
    set_attrs($self, undef, %init) if (%init);
	
    # bless and returns new object
    bless $self, $class;
}

# DESTROY just kills the snippet
sub DESTROY {
    my $self = shift;
    # nothing to do at now
}


=head2 dump_to_string

I<dump_to_string> simply puts the snippet in textual form,
ready to be printed or saved to a file.

    $string = $snippet->dump_to_string();

=cut

sub dump_to_string {
    my $this = shift;
    my @lines;

    while (my ($name, $spec) = each %{$this}) {
	while (my ($key, $value) = each %{$spec}) {
	    if ($name =~ /main/) {
		@lines = (@lines, "$key: $value") unless $key =~ /ID/;
	    }
	    else {
		@lines = (@lines, "$name.$key: $value") unless $key =~ /ID/;
	    }
	}
    }

    @lines = sort @lines;
    return "Font $this->{main}->{ID}\n" . 
	join("\n", @lines) . "\nEndFont\n";
}


=head2 build_from_string

Builds a snippet from a string. Returns a reference to the newly
created snippet.

    $snippet = $snippet->build_from_string($string);

=cut

sub build_from_string {
    my ($this, $string) = (@_);
    my @lines = split('\n', $string);

    foreach my $line (@lines) {
	if ($line =~ /Font (.*)/) {
	    $this->{main}->{ID} = "$1";
	}
	elsif ($line =~ /(.*)\.(.*)\s*:\s*(.*)/) {
	    $this->{$1}->{$2} = "$3";
	}
	elsif ($line =~ /(.*)\s*:\s*(.*)/) {
	    $this->{main}->{$1} = "$2";
	}
    }
    return $this;
}


=head2 set_attr set_attrs

I<set_attr> sets an snippet attribute. An attribute can have a
class or not. If the attribute doesn't have a class simply
pass undef to it. I<set_attrs> takes an array of attributes and 
values of the same class.

    $snippet->set_attr($attr, $value, $class);
    $snippet->set_attrs($class, @attrs);

=cut

sub set_attr {
    my ($this, $attr, $value, $class) = (@_);

    $class = 'main' unless $class;
    $this->{$class}->{$attr} = $value;
}

sub set_attrs {
    my ($this, $class, %attrs) = (@_);
    
    $class = 'main' unless $class;
    while  (my ($attr, $value) = each %attrs) {
	$this->{$class}->{$attr} = $value;
    }
}    


=head2 get_attr get_attrs

I<get_attr> returns an snippet attribute. An attribute can have a
class or not. If the attribute doesn't have a class simply
pass undef to it. I<get_attrs> returns an hash built from all
the attributes in the given class.

    $value = $snippet->get_attr($attr, $class);
    %attrs = $snippet->get_attrs($class);

=cut

sub get_attr {
    my ($this, $attr, $class) = (@_);
    
    $class = 'main' unless $class;
    return $this->{$class}->{$attr};
}

sub get_attrs {
    my ($this, $class) = (@_);
    
    $class = 'main' unless $class;
    return (%{$this->{$class}});
}


=head2 del_attr

I<del_attr> removes an attribute from the snippet. Make caution when
using that, because some attributes are mandatory and a snippet is no
more valid without them.

    $snippet->del_attr($attr, $class);

=cut 

sub del_attr {
    my ($this, $attr, $class) = (@_);

    $class = 'main' unless $class;
    delete $this->{$class}->{$attr};
}


=head1 AUTHOR

Federico Di Gregorio <fog@debian.org>

=cut

1;