File Coverage

blib/lib/File/Samba.pm

Criterion	Covered	Total	%
statement	92	148	62.1
branch	34	50	68.0
condition	9	21	42.8
subroutine	10	15	66.6
pod	11	11	100.0
total	156	245	63.6

package File::Samba;

use strict;
use warnings;
use Carp qw(cluck croak confess);
use Data::Dump qw(dump);

require Exporter;

our @ISA = qw(Exporter);

#
# We all for several exports
#
our $VERSION = '0.03';
our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
#
# Exported Functions by request
#
@EXPORT_OK = qw(
version
keys
value
listShares
deleteShare
createShare
sectionParameter
globalParameter
load
save
);  # symbols to export on request

=head1 Object Methods

=head2 new([config file])

Optionally a file can be specifided in the constructor to load the file
on creation.

Returns a new Samba Object

=cut

sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    $self->{_global} = {};
    $self->{_section} = {};
    $self->{_version} = 2;
    eval
    {
			while()
			{
	    	chomp;
      	next if /^#/;
	    	my ($st,$vers,$cmd) = split(/:/);
      	if($cmd && $vers && $st)
      	{
          chomp($cmd);
          $self->{_VALID}->{$st}->{"v$vers"}->{$cmd} = "1";
      	}
      	last if /__END__/;
			}
    };

    bless ($self, $class);
    if(@_)
    {
        $self->load(shift);
    }

    return $self;
}

=head2 version([version])

Set or get the version of this smb.conf your want to edit
the load method tries to determine the smb.conf version based on the keys
it find

Params:
	[Optional] the version number
Returns:
	the current version (either 2 or 3)
Example:
	if($obj->version == 3)
	{
		# do Samba 3 options
	}

=cut

sub version
{
    my $self = shift;
    if (@_)
    {
        my $ver = shift;
        croak "Samba version 2 or 3 only " if($ver < 2 || $ver > 3);
        $self->{_version} = $ver;
        # do we strip out bad values? NOPE
    }
    return $self->{_version};
}

=head2 keys(section)

Get a list of key for a given section, use 'global' for the globl section

Params:
	section to list
Returns:
	a sorted list of section keys
Example:
	my @keys = $smb->keys('some section');

=cut

sub keys
{
    my $self = shift;
    my $section = shift;
    if($section eq "global")
    {
        return sort(CORE::keys(%{$self->{_global}}));
    }
    else
    {
        return sort(CORE::keys(%{$self->{_section}->{$section}}));
    }
}

=head2 value(section,key)

Get the value associated with a key in a given section (READ ONLY)

Params:
	section to list
	key to read
Returns:
	the value associated with the key/section combination or undef if the key/section
	does nto exists
Example:
	my $value = $smb->keys('some section','some key');

=cut

sub value
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    if($section eq "global")
    {
        return $self->{_global}->{$key};
    }
    else
    {
        return $self->{_section}->{$section}->{$key};
    }
}

=head2 listShares()

Get a list of shares defined in the smb.conf file EXCLUDING the global section

Params:
	none
Returns:
	a sorted list of section names
Example:
	my @list = $smb->listShares;

=cut

sub listShares
{
    my $self = shift;
    my @list = CORE::keys(%{$self->{_section}});
    return sort(@list);
}

=head2 deleteShare(share name)

Delete a given share, this method can't delete the global section

Params:
	the share to delete
Returns:
	none
Example:
	$smb->deleteShare('some share');

=cut


sub deleteShare
{
    my $self = shift;
    my $share = shift;
    delete $self->{_section}->{$share};
}

=head2 createShare(share name)

Create a share with a given name

Params:
	the share to create
Returns:
	none
Example:
	$smb->createShare('some share');
Exceptions:
	If you try to create a share called global, the method will croak

=cut

sub createShare
{
    my $self = shift;
    my $share = shift;
    if($share eq 'global')
    {
	croak("You can't create a share called global");
    }
    $self->{_section}->{$share} = {} unless exists $self->{_section}->{$share};
}

=head2 sectionParameter(section,key,[value])

Get or set a key in a given section, if value is not sepecifed this methods performs
a lookup, otherwise it performs an edit

Params:
	the section you wish to modify/view
	the key to view
	the value to set
Returns:
	the value set or read
Example:
	$smb->sectionParameter('homes','guest ok','yes');
Exceptions:
	The key you pass in for a 'Set' operrtion will be checked against a list of valid
	key names, based on the smb.conf version. Setting an invalid key will result if croak

=cut


sub sectionParameter
{
    my $self = shift;
    my $section = shift;
    my $param = shift;
    if(@_)
    {
        my $value = shift;
        my $version = $self->{_version};
        if($self->{_VALID}->{section}->{"v$version"}->{$param})
        {
            $self->{_section}->{$section}->{$param} = $value;
        }
        else
        {
            croak("Invalid section key \"$param\" for samba version $version");
        }
    }
    return $self->{_section}->{$section}->{$param};
}

=head2 globalParameter(key,[value])

Get or set a key in the global section, if value is not sepecifed this methods performs
a lookup, otherwise it performs an edit

Params:
	the key to view
	the value to set
Returns:
	the value set or read
Example:
	$smb->globalParameter('homes','guest ok','yes');
Exceptions:
	The key you pass in for a 'Set' operrtion will be checked against a list of valid
	key names, based on the smb.conf version. Setting an invalid key will result if croak

=cut

sub globalParameter
{
    my $self = shift;
    my $param = shift;
    if(@_)
    {
        my $value = shift;
        my $version = $self->{_version};
        if($self->{_VALID}->{global}->{"v$version"}->{$param} || $self->{_VALID}->{section}->{"v$version"}->{$param})
        {
            $self->{_global}->{$param} = $value;
        }
        else
        {
            croak("Invalid key \"$param\" for samba version $version");
        }
    }
    return $self->{_global}->{$param};
}

=head2 load(filename)

Read a smb.conf file from disk, and parse it. The version will be identified as best as possible
but may not be correct, you should use version method after calling load to make sure the version
detected correctly

Params:
	the smb.conf file to load
Returns:
	none
Example:
	$smb->load('/etc/samba/smbconf');
Exceptions:
	If the file does not exist croak

=cut


sub load
{
    my $self = shift;
    my $file = shift;
    cluck("No such file $file") unless -e $file;
    # Load the file and run
    open(FH,$file);
    my $isGlobal;
    my $lastSection;
    # guess version 2 we need a good wy to see if version 3
    my $lastDetVersion = 2;
    while()
    {
        chomp;
        next if /^;|^#/;
        next if /^\s+$/;
        next if length($_) <= 1;
        s/\t//;
        s/\n//;
        s/^\s+//;
        s/\s+$//;
        next if /^;/;
        if(/\[global\]/i)
        {
            $isGlobal = 1;
        }
        elsif(/\[(\w+)\]/)
        {
            $isGlobal = 0;
            $lastSection = $1;
        }
        else
        {
            my($key,$value) = split('=',$_,2);
            $key =~ s/\s+$//;
            $value =~ s/^\s+//;
            if($isGlobal)
            {
                $self->{_global}->{$key}=$value;
                my ($v2,$v3);
                $v2 = $self->{_VALID}->{global}->{v2}->{$key};
                $v3 = $self->{_VALID}->{global}->{v3}->{$key};
                if($v3 && !$v2)
                {
                    $self->{_version} = 3;
                }
            }
            else
            {
                if($self->{_section}->{$lastSection})
                {
                    $self->{_section}->{$lastSection}->{$key} = $value;
                }
                else
                {
                    $self->{_section}->{$lastSection} = {};
                    $self->{_section}->{$lastSection}->{$key} = $value;
                }
            }
        }
    }
    close(FH);
    #print "[Global] \n",dump($self->{_global});
    #print "\n[Sections] \n",dump($self->{_section});
    #print "\n[Version] \n",$self->{_version};
}

=head2 save(filename)

Save the current inmemory smb.conf file

Params:
	the file to save to
Returns:
	none
Example:
	$smb->save('/home/test.conf');

=cut


sub save
{
    my $self = shift;
    my $outputFile = shift;
    # Save it now !!
    open(WH,">$outputFile");
    # Ok write Header
    print WH "################################################################################\n";
    print WH "#                      Generate By File::Samba $VERSION                            #\n";
    print WH "# This is the main Samba configuration file. You should read the               #\n";
    print WH "# smb.conf(5) manual page in order to understand the options listed            #\n";
    print WH "# here.                                                                        #\n";
    print WH "# Any line which starts with a ; (semi-colon) or a # (hash)                    #\n";
    print WH "# is a comment and is ignored. In this example we will use a #                 #\n";
    print WH "# for commentry and a ; for parts of the config file that you                  #\n";
    print WH "# may wish to enable                                                           #\n";
    print WH "#                                                                              #\n";
    print WH "# NOTE: Whenever you modify this file you should run the command \"testparm\"    #\n";
    print WH "# to check that you have not made any basic syntactic errors.                  #\n";
    print WH "################################################################################\n";
    print WH ";========================= Global Settings =====================================\n";
    # write global section
    print WH "[global]\n";
    foreach my $key ($self->keys('global'))
    {
        print WH "\t$key = ",$self->{_global}->{$key},"\n";
    }
    print WH "\n";
    print WH ";=========================== Share Settings =====================================\n";
    my @sList = $self->listShares;
    foreach my $skey (@sList)
    {
        print WH "[$skey]\n";
        if($skey eq "homes" || $skey eq "printers" )
        {
            print WH "\t;special shares for samba see smb.conf(5)\n";
        }
        my @skList = $self->keys($skey);
        foreach my $subK (@skList)
        {
            print WH "\t$subK = ",$self->{_section}->{$skey}->{$subK},"\n";
        }
        print WH "\n";
    }
    close(WH);
}

1;
__DATA__