view release on metacpan or  search on metacpan

lib/JSON/Karabiner/Manipulator.pm  view on Meta::CPAN

package JSON::Karabiner::Manipulator ;
$JSON::Karabiner::Manipulator::VERSION = '0.018';
use strict;
use warnings;
use Carp;
use Exporter;
our @EXPORT = qw'new_manipulator add_action add_description add_condition add_parameter add_key_code
  add_key_code add_any add_optional_modifiers add_mandatory_modifiers add_simultaneous add_simultaneous_options add_consumer_key_code add_pointing_button add_shell_command add_select_input_source add_set_variable add_mouse_key add_modifiers
  add_identifier add_description add_value add_bundle_identifiers add_file_path add_input_source add_keyboard_types add_variable add_description _dump_json _fake_write_file write_file set_filename set_title set_rule_name set_save_dir';

sub import {
  strict->import;
  warnings->import;
  goto &Exporter::import
}

sub new_manipulator {
  my @caller = caller(0);
  my $called_directly = $caller[0] eq 'main' ? 1 : 0;
  if ($main::current_manip && $called_directly) {
    write_file($main::file_title_written);
  }
  my $class = 'JSON::Karabiner::Manipulator';

  # trash the first arg if this is using the old school OO interface
  shift if $_[0] && $_[0] =~ /^JSON::Karabiner::Manipulator$/;

  my @kb_obj_args = @_;

  # derive the filename from the called script
  { no warnings 'once';
    if (!$main::save_to_file_name && $called_directly) {

      my $program_name = $0;
      $program_name =~ s/^.*[\/\\]//;
      $program_name =~ s/\..*$//;
      $program_name = "$program_name.json";
      push @kb_obj_args, $program_name;
      $main::save_to_file_name = $program_name;
    } else {
      push @kb_obj_args, $main::save_to_file_name if $main::save_to_file_name;
    }

    if ($called_directly) {
      unshift @kb_obj_args, $main::rule_name if $main::rule_name;
      my $save_to_dir = $main::save_to_dir;
      if ($save_to_dir) {
        push @kb_obj_args, { mod_file_dir => $save_to_dir };
      }
    }
  }


  my $self = {
    actions => {},
    _disable_validity_tests => 0,
    _kb_obj_args => \@kb_obj_args,
    _fake_write_flag => 0,
  };
  bless $self, $class;
  {
    no warnings 'once';
    $main::current_manip = $self;
  }
  return $self;
}

sub set_filename {
  my $fn = shift;
  croak 'You must pass a file name' unless $fn;

  if ($fn !~ /\.json$/) {