File Coverage

blib/lib/CMS/Joomla.pm

Criterion	Covered	Total	%
statement	45	82	54.8
branch	8	28	28.5
condition	1	6	16.6
subroutine	10	13	76.9
pod	4	4	100.0
total	68	133	51.1

#
# CMS::Joomla - Joomla! CMS configuration and database access Perl module
#
# Copyright (c) 2008, 2011 EPIPE Communications
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#

package CMS::Joomla;

use warnings;
use strict;

use Carp;
use DBI;
use IO::File;

our $VERSION = '0.04';

=head1 NAME

CMS::Joomla - Joomla! CMS configuration and database access Perl module


=head1 SYNOPSIS

Read Joomla! configuration variables:

    use CMS::Joomla;

    my ($joomla) = CMS::Joomla->new("/path/to/joomla/configuration.php");

    print "Site name: " . $joomla->cfg->{'sitename'} . "\n";


Access Joomla! database:

    my ($jdb) = $joomla->dbhandle( { AutoCommit => 1 } );
    my ($sth) = $jdb->prepare("SELECT introtext "
	. "FROM " . $joomla->dbprefix . "content "
	. "WHERE title=?");

    $sth->execute("about");

    while (my ($introtext) = $sth->fetchrow_array) {
      print "$introtext\n";
    }

    ...

=head1 DESCRIPTION

This module provides an interface for reading Joomla! CMS configuration
variables and connecting to the Joomla! database from Perl script.

=head1 CONSTRUCTOR

=head2 new(I)

Creates C object. The I parameter should be a
file name of a valid readable Joomla! F file.
Returns undef in case of error.

=cut

sub new ($$) {
  my $type = shift;
  my $cfgname = shift;
  my $self = {};
  bless $self, $type;
  $self->{'_cfgname'} = $cfgname;
  $self->{'_phptype'} = undef;
  $self->{'cfg'} = $self->_jcfgread($cfgname);
  return defined($self->{'cfg'}) ? $self : undef;
}

=head1 METHODS

=head2 cfg()

Return a reference to a hash containing all Joomla! configuration
variables in this C object.

=cut

sub cfg ($) {
  my $self = shift;

  return $self->{'cfg'};
}

=head2 dbhandle(I)

Returns a C database handle object which is connected to the
corresponding Joomla! database. See L for more information
on how to use the returned database handle. Consecutive calls to
this function will return the same C handle instead of opening
a new connection each time.

I is passed directly to the C handle constructor.

Returns undef in case of error.

=cut

sub dbhandle ($$) {
  my $self = shift;
  my $opt = shift;

  if (!defined($self->{'cfg'}->{'dbtype'})) {
    carp "Joomla! database type is not defined";
    return undef;
  }
  if (!defined($self->{'cfg'}->{'db'})) {
    carp "Joomla! database name is not defined";
    return undef;
  }
  if (!defined($self->{'cfg'}->{'host'})) {
    carp "Joomla! database host is not defined";
    return undef;
  }
  if (!defined($self->{'cfg'}->{'user'})) {
    carp "Joomla! database user is not defined";
    return undef;
  }
  if (!defined($self->{'cfg'}->{'password'})) {
    carp "Joomla! database password is not defined";
    return undef;
  }

  my $dbtype = $self->{'cfg'}->{'dbtype'};

  $dbtype =~ s/mysqli/mysql/;

  return $self->{'_dbhandle'} if defined($self->{'_dbhandle'});

  $self->{'_dbhandle'} = DBI->connect("dbi:$dbtype:"
      . 'database=' . $self->{'cfg'}->{'db'}
      . ';host=' . $self->{'cfg'}->{'host'},
      $self->{'cfg'}->{'user'}, $self->{'cfg'}->{'password'}, $opt);

  return $self->{'_dbhandle'};
}

=head2 dbprefix()

Return a reference to the Joomla! database prefix. This is effectively
a shortcut for C<$joomla-Ecfg-E{'dbprefix'}>.

=cut

sub dbprefix ($) {
  my $self = shift;

  return $self->{'cfg'}->{'dbprefix'};
}


=head1 EXAMPLES

Some functional example scripts are available at:

L


=head1 SEE ALSO

L, L, L


=head1 COPYRIGHT & LICENSE

Copyright (c) 2008, 2011 EPIPE Communications Eepipe at cpan.orgE
L

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

# internal methods follow

sub _probephp ($) {

  # Simple test to see if we have a working PHP command line program.
  # The sub-shell re-direction is there to avoid "php: not found"
  # error messages (which are not relevant as we resort to internal
  # parser in case the PHP command line binary does not exist).

  my ($r) = `(php -r 'echo strrev("raboof") . "\n";') 2> /dev/null`;

 if (defined($r) && $r =~ /foobar/) {
    # have PHP command-line binary
    return 1;
  }
  # no have
  return 0;
}

sub _jcfgread_cmdline ($$) {
  my $self = shift;
  my $cfgname = shift;
  my %cfg;

  return undef unless defined($cfgname);

  my ($php) = '
      require_once("' . $cfgname . '");
      $c = new JConfig();
      foreach ($c as $key => $value) {
        echo "$key: \"$value\"\n";
      }';


  my $r = `php -r '$php'`;

  return undef unless defined($r) && $? == 0;

  while ($r =~ /^(\w+): \"([^\"]*?)\"$/m) {
    $cfg{$1} = $2;
    $r = $';
  }
  return \%cfg;
}

sub _jcfgread_kludge ($$) {
  my $self = shift;
  my $cfgname = shift;
  my %cfg;
  my $str;

  return undef unless defined($cfgname);

  my $fh = IO::File->new($cfgname, '<');

  return undef unless defined($fh);

  $str = join('', $fh->getlines());

  while ($str =~ /^\s*(var|public)\s+\$(\w+)\s+=\s+\'([^\']*?)\'\;/m) {
    $cfg{$2} = $3;
    $str = $';
  }
  return \%cfg;
}

sub _jcfgread ($$) {
  my $self = shift;
  my $cfgname = shift;

  if (!defined($self->{'_phptype'})) {
    $self->{'_phptype'} = $self->_probephp();
  }

  if ($self->{'_phptype'} == 1) {
    # use command-line php binary
    return $self->_jcfgread_cmdline($cfgname);
  } else {
    # phptype is 0 or unknown, use internal parser kludge
    return $self->_jcfgread_kludge($cfgname);
  }
}

1; # End of CMS::Joomla