path: root/lib/XXV/MODULES/KEYWORDS.pm

package XXV::MODULES::KEYWORDS;

use strict;
use Encode;
use Tools;

# ------------------
sub module {
# ------------------
    my $self = shift || return error('No object defined!');

    my $args = {
        Name => 'KEYWORDS',
        Prereq => {
            'XML::Simple' => 'Easy API to maintain XML (esp config files)'
        },
        Description => gettext('This module manages keywords and tag within timer and recordings.'),
#       Status => sub{ $self->status(@_) },
        Preferences => {
            active => {
                description => gettext('Activate this service'),
                default     => 'y',
                type        => 'confirm',
                required    => gettext('This is required!'),
            },
        },
        Commands => {
            tkeywords => {
                description => gettext("Search timers 'keywords'"),
                short       => 'tk',
                callback    => sub{ $self->timer_keywords(@_) },
                DenyClass   => 'tlist',
            },
            tsuggestkeywords => {
                hidden      => 'yes',
                callback    => sub{ $self->suggest('timer',@_) },
                DenyClass   => 'tlist',
            },
            rkeywords => {
                description => gettext("Search recordings 'keywords'"),
                short       => 'rk',
                callback    => sub{ $self->recording_keywords(@_) },
                DenyClass   => 'rlist',
            },
            rsuggestkeywords => {
                hidden      => 'yes',
                callback    => sub{ $self->suggest('recording',@_) },
                DenyClass   => 'rlist',
            }
        }
    };
    return $args;
}

# ------------------
sub new {
# ------------------
	my($class, %attr) = @_;
	my $self = {};
	bless($self, $class);

    $self->{charset} = delete $attr{'-charset'};
    if($self->{charset} eq 'UTF-8'){
      eval 'use utf8';
    }

    # paths
    $self->{paths} = delete $attr{'-paths'};

	  # who am I
    $self->{MOD} = $self->module;

    # all configvalues to $self without parents (important for ConfigModule)
    map {
        $self->{$_} = $attr{'-config'}->{$self->{MOD}->{Name}}->{$_};
        $self->{$_} = $self->{MOD}->{Preferences}->{$_}->{default} unless($self->{$_});
    } keys %{$self->{MOD}->{Preferences}};

    # Try to use the Requirments
    map {
        eval "use $_";
        if($@) {
          my $m = (split(/ /, $_))[0];
          return panic("\nCouldn't load perl module: $m\nPlease install this module on your system:\nperl -MCPAN -e 'install $m'");
        }
    } keys %{$self->{MOD}->{Prereq}};

    # read the DB Handle
    $self->{dbh} = delete $attr{'-dbh'};

    $self->{xml} = XML::Simple->new( NumericEscape => 2 )
        || return error("Can't create XML instance!");

    # The Initprocess
    my $erg = $self->_init or return error('Problem to initialize modul!');

    return $self;
}

# ------------------
sub _init {
# ------------------
    my $self = shift || return error('No object defined!');

    unless($self->{dbh}) {
      panic("Session to database is'nt connected");
      return 0;
    }

    my $version = 30; # Must be increment if rows of table changed
    # this tables hasen't handmade user data,
    # therefore old table could dropped if updated rows
    if(!tableUpdated($self->{dbh},'KEYWORDS',$version,1)) {
        return 0;
    }

    # Look for table or create this table
    $self->{dbh}->do(qq|
      CREATE TABLE IF NOT EXISTS KEYWORDS (
          id int(11) NOT NULL auto_increment,
          hash varchar(32) NOT NULL,
          keyword varchar(128) NOT NULL,
          rank tinyint NOT NULL,
          total tinyint NOT NULL,
          source enum('recording', 'timer'),
          PRIMARY KEY  (id),
          UNIQUE KEY  (hash,keyword)
        ) COMMENT = '$version'
    |);



    1;
}

# ------------------
sub insert {
# ------------------
    my $self = shift || return error('No object defined!');
    my $type = shift || return error('No type defined!');
    my $id = shift || return undef;
    my $keywords = shift || return undef;

    return unless($self->{active} eq 'y');

    my $sth = $self->{dbh}->prepare(qq|REPLACE INTO KEYWORDS(hash, keyword, rank, total, source ) VALUES (?,?,?,?,?)|);
    my @words = split(/[,;\r\n]/, $keywords);
    my $total = scalar @words;
    my $rank = $total + 1;
    foreach my $w (@words) {
      $rank --;
      $w =~ s/^\s+//;  # no leading white space
      $w =~ s/\s+$//;  # no trailing white space
      next unless($w);
      if(!$sth->execute($id,$w,$rank,$total,$type)) {
        error sprintf("Couldn't insert keyword!: '%s' !",$w);
        return undef;
      }
    }
   return 1;
}

# ------------------
sub remove {
# ------------------
    my $self = shift  || return error('No object defined!');
    my $type = shift || return error('No type defined!');
    my $hash = shift || return undef;

    return unless($self->{active} eq 'y');

    my $sql = sprintf('DELETE FROM KEYWORDS WHERE hash IN (%s)', join(',' => ('?') x @$hash)); 
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute(@$hash)
        or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
    return 1;
}

# ------------------
sub removesource {
# ------------------
    my $self = shift  || return error('No object defined!');
    my $type = shift || return error('No type defined!');

    return unless($self->{active} eq 'y');

    my $sth = $self->{dbh}->prepare('DELETE FROM KEYWORDS WHERE source = ?');
    $sth->execute($type)
        or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
    return 1;
}

# ------------------
sub suggest {
# ------------------
    my $self = shift  || return error('No object defined!');
    my $type = shift || return error('No type defined!');
    my $console = shift || return error('No console defined!');
    my $config = shift || return error('No config defined!');
    my $search = shift;
    my $params  = shift;

    if($search) {
      my $sth = $self->{dbh}->prepare(
qq|SELECT SQL_CACHE keyword from KEYWORDS 
    WHERE source = ?
      AND keyword LIKE ? 
 GROUP BY keyword 
 LIMIT 25|);
      if(!$sth->execute($type, '%'.$search.'%')) {
        error sprintf("Couldn't execute query: %s.",$sth->errstr);
      } else {
        my $result = $sth->fetchall_arrayref();
        $console->table($result)
            if(ref $console && $result);
      }
    }

}

# ------------------
sub list {
# ------------------
    my $self = shift || return error('No object defined!');
    my $type = shift || return error('No type defined!');
    my $hash = shift;

    return (undef,0,0) unless($self->{active} eq 'y');

    # Get keywords with highest ranking
    my $list = $self->_list($type,$hash);
    return (undef,0,0) unless($list and scalar @$list);
    # Remember highest and lowest ranking for scaling
    my $keywordmax = $list->[0]->[1];
    my $keywordmin = $list->[-1]->[1];
    # sort keyworks by name
    my $keywords;
    @{$keywords} = sort {$a->[0] cmp $b->[0]} @$list;

    return ($keywords,$keywordmax,$keywordmin);
}

# ------------------
sub _list {
# ------------------
    my $self = shift || return error('No object defined!');
    my $type = shift || return error('No type defined!');
    my $hash = shift;
    my $sth;
    if($hash and ref $hash eq 'ARRAY') {
      my $sql = sprintf(qq|SELECT SQL_CACHE keyword,sum(100/total*rank) as pos 
 FROM KEYWORDS 
 WHERE source = ? AND hash IN (%s) 
 GROUP BY keyword 
 ORDER BY pos desc 
 LIMIT 20|, join(',' => ('?') x @$hash)); 
      unshift(@$hash,$type);
      $sth = $self->{dbh}->prepare($sql);
      $sth->execute(@$hash)
          or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
    } else {
      my $sql = qq|SELECT SQL_CACHE keyword,sum(100/total*rank) as pos
 FROM KEYWORDS 
 WHERE source = ?
 GROUP BY keyword 
 ORDER BY pos desc 
 LIMIT 20|; 
      $sth = $self->{dbh}->prepare($sql);
      $sth->execute($type)
          or return error sprintf("Couldn't execute query: %s.",$sth->errstr);
    }
    my $result = $sth->fetchall_arrayref();
    return $result;
}

# ------------------
sub timer_keywords {
# ------------------
    my $self = shift || return error('No object defined!');
    my $console = shift || return error('No console defined!');
    my $config = shift || return error('No config defined!');
    my $text    = shift; 
    my $params  = shift;

    my $tmod = main::getModule('TIMERS');
    unless($text) {
      return $tmod->list($console,$config);
    }

	  my $term;
	  my $search;
    my $query = buildsearch("k.keyword",$text);
    $search = sprintf('AND ( %s ) AND ( t.id = k.hash )', $query->{query});
    foreach(@{$query->{term}}) { push(@{$term},$_); }

    return $tmod->_list($console,$config,$search,$term,$params,', KEYWORDS as k');
}

# ------------------
sub recording_keywords {
# ------------------
    my $self = shift || return error('No object defined!');
    my $console = shift || return error('No console defined!');
    my $config = shift || return error('No config defined!');
    my $text    = shift; 
    my $params  = shift;

    my $rmod = main::getModule('RECORDS');
    unless($text) {
      return $rmod->list($console);
    }

    my $query = buildsearch("k.keyword",$text);
    return $rmod->_search($console,$config,$query->{query}.' ) AND ( r.hash = k.hash ',$query->{term},$params,', KEYWORDS as k');
}

# ------------------
sub parsexml {
# ------------------
    my $self = shift || return error('No object defined!');
    my $aux = shift;

    $aux  =~ s/(\r|\n)//sg;
    if($aux && $aux =~ /^<.*/ ) {
      my $args = eval {  $self->{xml}->XMLin($aux, KeepRoot => 1 ) } ;
      if ($@) {
        if($Tools::VERBOSE >= 4) {
          error sprintf("Can't parse xml data : %s - %s", $@, $aux);
        } elsif($Tools::VERBOSE >= 2) {
          error ("Can't parse xml data");
        }
        return  undef;
      } 
      if(defined $args 
        && defined $args->{'xxv'} ) {
          if($self->{charset} eq 'UTF-8'){
            foreach my $k (keys %{$args->{'xxv'}}) {
              utf8::downgrade($args->{'xxv'}->{$k});
            }
          } else {
            foreach my $k (keys %{$args->{'xxv'}}) {
              $args->{'xxv'}->{$k} = encode($self->{charset},$args->{'xxv'}->{$k});
            }
          }
          return $args->{'xxv'};
      }
    }
    return  undef;
}

# ------------------
sub createxml {
# ------------------
    my $self = shift || return error('No object defined!');
    my $xml = shift;

    my $aux = '';
    if($xml && keys %$xml) {
      $aux = $self->{xml}->XMLout($xml, RootName => 'xxv');
    }
    return $aux; 
}

# ------------------
sub mergexml {
# ------------------
    my $self = shift || return error('No object defined!');
    my $aux = shift;
    my $topic = shift;
    my $value = shift;

    my $xml = $self->parsexml($aux);
    if($value) {
#     utf8::upgrade($value) if(!utf8::is_utf8($value));
      $xml->{$topic} = $value;
    } elsif($xml->{$topic}) {
      delete $xml->{$topic};
    }
    return $self->createxml($xml);
}
1;