App-SD

 view release on metacpan or  search on metacpan

inc/Module/Install/ExtraTests.pm  view on Meta::CPAN

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
  return;
}
 
{
  no warnings qw(once);
  package # The newline tells PAUSE, "DO NOT INDEXING!"
  MY;
  sub test_via_harness {
    my $self = shift;
 
    return $self->SUPER::test_via_harness(@_)
      unless $use_extratests;
 
    my ($perl, $tests) = @_;
    my $a_str = -d 'xt/author'  ? 'xt/author'  : '';
    my $r_str = -d 'xt/release' ? 'xt/release' : '';
    my $s_str = -d 'xt/smoke'   ? 'xt/smoke'   : '';
    my $is_author = $Module::Install::AUTHOR ? 1 : 0;
 
    return qq{\t$perl "-Iinc" "-MModule::Install::ExtraTests" }
         . qq{"-e" "Module::Install::ExtraTests::__harness('Test::Harness', $is_author, '$a_str', '$r_str', '$s_str', \$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n};
  }
 
  sub dist_test {
    my ($self, @args) = @_;
 
    return $self->SUPER::dist_test(@args)
      unless $use_extratests;
 
    my $text = $self->SUPER::dist_test(@args);
    my @lines = split /\n/, $text;
    $_ =~ s/ (\S*MAKE\S* test )/ RELEASE_TESTING=1 $1 / for grep { m/ test / } @lines;
    return join "\n", @lines;
  }
}
 
sub __harness {
  my $harness_class = shift;
  my $is_author     = shift;
  my $author_tests  = shift;

lib/App/SD/CLI/Command/Attachment/Create.pm  view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
    my $self = shift;
 
    $self->print_usage if $self->has_arg('h');
 
    my $content = $self->get_content(type => 'attachment');
 
    die "Aborted.\n"
        if length($content) == 0;
 
    $self->set_prop(content => $content);
    $self->SUPER::run(@_);
};
 
__PACKAGE__->meta->make_immutable;
no Any::Moose;
 
1;

lib/App/SD/CLI/Command/Browser.pm  view on Meta::CPAN

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
extends 'https://metacpan.org/pod/App::SD::CLI::Command::Server">App::SD::CLI::Command::Server';
 
override run => sub {
    my $self = shift;
    $self->print_usage if $self->has_arg('h');
 
    $self->server->with_browser(1);
 
    Prophet::CLI->end_pager();
    print "Browser will be opened after server has been started.\n";
    $self->SUPER::run();
};
 
__PACKAGE__->meta->make_immutable;
no Any::Moose;
1;

lib/App/SD/CLI/Command/Clone.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
extends 'https://metacpan.org/pod/Prophet::CLI::Command::Clone">Prophet::CLI::Command::Clone';
with 'https://metacpan.org/pod/App::SD::CLI::NewReplicaCommand">App::SD::CLI::NewReplicaCommand';
 
sub ARG_TRANSLATIONS {
    shift->SUPER::ARG_TRANSLATIONS(),
    # this arg is used in the new_replica_wizard sub
    n => 'non-interactive',
};
 
sub usage_msg {
    my $self = shift;
    my $cmd = $self->cli->get_script_name;
 
    return <<"END_USAGE";
usage: ${cmd}clone --from <url> [--as <alias>] [--non-interactive] | --local

lib/App/SD/CLI/Command/Clone.pm  view on Meta::CPAN

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
    --local                - Probe the local network for mDNS-advertised
                             replicas and list them.
END_USAGE
}
 
override run => sub {
    my $self = shift;
 
    # clone dies if the target replica already exists, so no need
    # to worry about not running the wizard if the clone doesn't run
    $self->SUPER::run();
 
    Prophet::CLI->end_pager();
 
    # Prompt for SD setup (specifically email address for changes) after the
    # clone, but *don't* immediately edit the database's settings, since a
    # cloned database should have already been setup previously.
    $self->new_replica_wizard( edit_settings => 0 );
};
 
__PACKAGE__->meta->make_immutable;

lib/App/SD/CLI/Command/Init.pm  view on Meta::CPAN

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
    return <<"END_USAGE";
usage: ${cmd}init [--non-interactive]
 
Options:
    -n | --non-interactive - Don't prompt to edit settings or specify email
                             address for new database
END_USAGE
}
 
sub ARG_TRANSLATIONS {
    shift->SUPER::ARG_TRANSLATIONS(),
    n => 'non-interactive',
};
 
override run => sub {
    my $self = shift;
 
    $self->SUPER::run();
 
    Prophet::CLI->end_pager();
 
    $self->new_replica_wizard();
};
 
__PACKAGE__->meta->make_immutable;
no Any::Moose;
 
1;

lib/App/SD/CLI/Command/Server.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
extends 'https://metacpan.org/pod/Prophet::CLI::Command::Server">Prophet::CLI::Command::Server';
 
sub run {
    my $self = shift;
    $self->server->read_only(1) unless ($self->has_arg('writable'));
 
    $self->SUPER::run();
}
 
1;

lib/App/SD/CLI/Command/Ticket/Attachment/Create.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
extends 'https://metacpan.org/pod/App::SD::CLI::Command::Attachment::Create">App::SD::CLI::Command::Attachment::Create';
 
sub ARG_TRANSLATIONS { shift->SUPER::ARG_TRANSLATIONS(),  f => 'file'  };
 
sub usage_msg {
    my $self = shift;
    my ($cmd, $type_and_subcmd) = $self->get_cmd_and_subcmd_names;
 
    return <<"END_USAGE";
usage: ${cmd}${type_and_subcmd} <record-id> [--file <filename>]
END_USAGE
}
 
# override args to feed in that ticket's uuid as an argument to the comment
sub run {
    my $self = shift;
 
    $self->print_usage if $self->has_arg('h');
 
    $self->require_uuid;
 
    $self->set_prop(ticket => $self->uuid);
    $self->SUPER::run(@_);
};
 
__PACKAGE__->meta->make_immutable;
no Any::Moose;
 
1;

lib/App/SD/CLI/Command/Ticket/Comment/Create.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
extends 'https://metacpan.org/pod/Prophet::CLI::Command::Create">Prophet::CLI::Command::Create';
with 'https://metacpan.org/pod/App::SD::CLI::Model::TicketComment">App::SD::CLI::Model::TicketComment';
with 'https://metacpan.org/pod/App::SD::CLI::Command">App::SD::CLI::Command';
 
sub ARG_TRANSLATIONS { shift->SUPER::ARG_TRANSLATIONS(),  f => 'file', m => 'content'  };
 
sub usage_msg {
    my $self = shift;
    my ($cmd, $type_and_subcmd) = $self->get_cmd_and_subcmd_names;
 
    return <<"END_USAGE";
usage: ${cmd}${type_and_subcmd} <ticket-id> [--edit]
       ${cmd}${type_and_subcmd} <ticket-id> -- content="message here"
END_USAGE
}

lib/App/SD/CLI/Command/Ticket/Comment/Create.pm  view on Meta::CPAN

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
    $self->require_uuid;
 
    my $content = $self->get_content(type => 'comment', default_edit => 1);
 
    die "Aborted.\n"
        if length($content) == 0;
 
    $self->set_prop(ticket => $self->uuid);
    $self->set_prop(content => $content);
    $self->SUPER::run(@_);
}
 
__PACKAGE__->meta->make_immutable;
no Any::Moose;
 
1;

lib/App/SD/CLI/Command/Ticket/Create.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
use Params::Validate qw/validate/;
extends 'https://metacpan.org/pod/Prophet::CLI::Command::Create">Prophet::CLI::Command::Create';
with 'https://metacpan.org/pod/App::SD::CLI::Model::Ticket">App::SD::CLI::Model::Ticket';
with 'https://metacpan.org/pod/App::SD::CLI::Command">App::SD::CLI::Command';
with 'https://metacpan.org/pod/Prophet::CLI::TextEditorCommand">Prophet::CLI::TextEditorCommand';
 
sub ARG_TRANSLATIONS { shift->SUPER::ARG_TRANSLATIONS(),  e => 'edit'  };
 
# use actual valid ticket props in the help message, and make note of the
# interactive editing mode
override usage_msg => sub {
    my $self = shift;
    my $cmd = $self->cli->get_script_name;
 
    my @primary_commands = @{ $self->context->primary_commands };
 
    # if primary commands was only length 1, the type was not specified

lib/App/SD/CLI/Command/Ticket/Search.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
extends 'https://metacpan.org/pod/Prophet::CLI::Command::Search">Prophet::CLI::Command::Search';
with 'https://metacpan.org/pod/App::SD::CLI::Command">App::SD::CLI::Command';
 
sub ARG_TRANSLATIONS { shift->SUPER::ARG_TRANSLATIONS(),  s => 'sort', g => 'group'  };
 
override usage_msg => sub {
    my $self = shift;
    my $script = $self->cli->get_script_name;
 
    my @primary_commands = @{ $self->context->primary_commands };
 
    # if primary commands was only length 1, the type was not specified
    # and we should indicate that a type is expected
    push @primary_commands, '<record-type>' if @primary_commands <= 1;

lib/App/SD/CLI/Command/Ticket/Search.pm  view on Meta::CPAN

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
                        (
                            map { { label => $_, records => $group_hash{$_} } }
                              keys %group_hash
                        )
                    ];
                }
                return $groups;
            }
        );
    }
    $self->SUPER::run(@_);
};
 
# implicit status != closed
override default_match => sub {
    my $self   = shift;
    my $ticket = shift;
 
    return 1 if $ticket->has_active_status();
    return 0;
};

lib/App/SD/CLI/Command/Ticket/Show.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
extends 'https://metacpan.org/pod/Prophet::CLI::Command::Show">Prophet::CLI::Command::Show';
with 'https://metacpan.org/pod/App::SD::CLI::Command">App::SD::CLI::Command';
with 'https://metacpan.org/pod/App::SD::CLI::Model::Ticket">App::SD::CLI::Model::Ticket';
 
sub ARG_TRANSLATIONS {
    shift->SUPER::ARG_TRANSLATIONS(),
        a => 'all-props',
        s => 'skip-history',
        h => 'with-history',
        b => 'batch';
}
 
sub by_creation_date {
    ($a->can('created') ? $a->created : $a->prop('created') )
    cmp
    ($b->can('created') ? $b->created : $b->prop('created') )

lib/App/SD/CLI/Command/Ticket/Update.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
use Params::Validate qw/validate/;
 
extends 'https://metacpan.org/pod/Prophet::CLI::Command::Update">Prophet::CLI::Command::Update';
with 'https://metacpan.org/pod/App::SD::CLI::Model::Ticket">App::SD::CLI::Model::Ticket';
with 'https://metacpan.org/pod/App::SD::CLI::Command">App::SD::CLI::Command';
with 'https://metacpan.org/pod/Prophet::CLI::TextEditorCommand">Prophet::CLI::TextEditorCommand';
 
sub ARG_TRANSLATIONS { shift->SUPER::ARG_TRANSLATIONS(),  a => 'all-props'  };
 
sub usage_msg {
    my $self = shift;
    my $cmd = $self->cli->get_script_name;
    my @primary_commands = @{ $self->context->primary_commands };
 
    # if primary commands was only length 1, the type was not specified
    # and we should indicate that a type is expected
    push @primary_commands, '<record-type>' if @primary_commands <= 1;

lib/App/SD/Config.pm  view on Meta::CPAN

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
        if ( $content !~ /\[/ ) {
 
            $self->convert_ancient_config_file($file);
        }
 
    }
 
    Prophet::CLI->start_pager();
 
    # Do a regular load.
    $self->SUPER::load(@_);
};
 
### XXX BACKCOMPAT ONLY! We eventually want to kill this hash, modifier and
### the following methods.
 
# None of these need to have values mucked with at all, just the keys
# migrated from old to new.
our %KEYS_CONVERSION_TABLE = (
    'email_address' => 'user.email-address',
    'default_group_ticket_list' => 'ticket.default-group',

lib/App/SD/ForeignReplica.pm  view on Meta::CPAN

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
            resolver_class     => { optional => 1 },
            resdb              => { optional => 1 },
            conflict_callback  => { optional => 1 },
            reporting_callback => { optional => 1 }
        }
    );
 
    my $changeset = $args{'changeset'};
    return if $self->last_changeset_from_source(
        $changeset->original_source_uuid) >= $changeset->original_sequence_no;
    $self->SUPER::integrate_changeset(%args);
}
 
=head2 integrate_change $change $changeset
 
Given a change (and the changeset it's part of), this routine will load
the push encoder for the foreign replica's type and call integrate_change
on it.
 
To avoid publishing prophet-private data, It skips any change with a record type
that record_type starts with '__'.

lib/App/SD/Model/Attachment.pm  view on Meta::CPAN

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
sub create {
    my $self = shift;
    my %args = validate( @_,  {props => 1});
 
 
    return (0,"You can't create an attachment without specifying a 'ticket' uuid") unless ($args{'props'}->{'ticket'});
 
    $args{'props'}->{'content_type'} ||=  'text/plain'; # XXX TODO use real mime typing;
     
 
    $self->SUPER::create(%args);
}
 
__PACKAGE__->meta->make_immutable;
no Any::Moose;
 
1;

lib/App/SD/Model/Comment.pm  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
extends 'https://metacpan.org/pod/App::SD::Record">App::SD::Record';
 
use constant collection_class => 'App::SD::Collection::Comment';
has '+type' => ( default => 'comment');
 
 
sub _default_summary_format { '%s,$uuid | %s,content'}
 
sub declared_props { return ('content', shift->SUPER::declared_props(@_)) }
 
sub canonicalize_props {
    my $self = shift;
    my $props = shift;
    $self->SUPER::canonicalize_props($props);
 
    unless ($props->{content}) {
        delete $props->{$_} for keys %$props;
    }
}
 
 
#has SVK::Model::Ticket;
 
__PACKAGE__->register_reference( ticket => 'App::SD::Model::Ticket');

lib/App/SD/Server.pm  view on Meta::CPAN

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
sub database_bonjour_name {
    my $self = shift;
    my $name = $self->app_handle->setting( label => 'project_name' )->get->[0];
    my $uuid = $self->handle->db_uuid;
    return "$name ($uuid)";
 
}
 
 
sub css {
    return shift->SUPER::css(@_), "/static/sd/css/main.css";
}
 
sub js {
    return shift->SUPER::js(@_);
}
 
# open up a browser after the server has been started (basically a
# hook for the browser command)
sub after_setup_listener {
    my $self = shift;
 
    local $SIG{CHLD}; # allow browser to be run with system()
 
    if ( $self->with_browser ) {



( run in 0.466 second using v1.01-cache-2.11-cpan-ec4f86ec37b )