view release on metacpan or  search on metacpan

inc/Devel/CheckLib.pm  view on Meta::CPAN

    @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) 
        if $args{incpath};
    my $analyze_binary = $args{analyze_binary};

    my @argv = @ARGV;
    push @argv, _parse_line('\s+', 0, $ENV{PERL_MM_OPT}||'');

    # work-a-like for Makefile.PL's LIBS and INC arguments
    # if given as command-line argument, append to %args
    for my $arg (@argv) {
        for my $mm_attr_key (qw(LIBS INC)) {
            if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) {
            # it is tempting to put some \s* into the expression, but the
            # MM command-line parser only accepts LIBS etc. followed by =,
            # so we should not be any more lenient with whitespace than that
                $args{$mm_attr_key} .= " $mm_attr_value";
            }
        }
    }

    # using special form of split to trim whitespace
    if(defined($args{LIBS})) {
        foreach my $arg (split(' ', $args{LIBS})) {
            die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-[lLR]/);
            push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2);
        }
    }
    if(defined($args{INC})) {
        foreach my $arg (split(' ', $args{INC})) {
            die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/);
            push @incpaths, substr($arg, 2);
        }
    }

    my ($cc, $ld) = _findcc($args{debug}, $args{ccflags}, $args{ldflags});
    my @missing;
    my @wrongresult;
    my @wronganalysis;
    my @use_headers;

    # first figure out which headers we can't find ...
    for my $header (@headers) {
        push @use_headers, $header;
        my($ch, $cfile) = File::Temp::tempfile(
            'assertlibXXXXXXXX', SUFFIX => '.c'
        );
        my $ofile = $cfile;
        $ofile =~ s/\.c$/$Config{_o}/;
        print $ch qq{#include <$_>\n} for @use_headers;
        print $ch qq{int main(void) { return 0; }\n};
        close($ch);
        my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe};
        my @sys_cmd;
        # FIXME: re-factor - almost identical code later when linking
        if ( $Config{cc} eq 'cl' ) {                 # Microsoft compiler
            require Win32;
            @sys_cmd = (
                @$cc,
                $cfile,
                "/Fe$exefile",
                (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
		"/link",
		@$ld,
		split(' ', $Config{libs}),
            );
        } elsif($Config{cc} =~ /bcc32(\.exe)?/) {    # Borland
            @sys_cmd = (
                @$cc,
                @$ld,
                (map { "-I$_" } @incpaths),
                "-o$exefile",
                $cfile
            );
        } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ...
            @sys_cmd = (
                @$cc,
                @$ld,
                $cfile,
                (map { "-I$_" } @incpaths),
                "-o", "$exefile"
            );
        }
        warn "# @sys_cmd\n" if $args{debug};
        my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
        push @missing, $header if $rv != 0 || ! -x $exefile;
        _cleanup_exe($exefile);
        unlink $cfile;
    }

    # now do each library in turn with headers
    my($ch, $cfile) = File::Temp::tempfile(
        'assertlibXXXXXXXX', SUFFIX => '.c'
    );
    my $ofile = $cfile;
    $ofile =~ s/\.c$/$Config{_o}/;
    print $ch qq{#include <$_>\n} foreach (@headers);
    print $ch "int main(int argc, char *argv[]) { ".($args{function} || 'return 0;')." }\n";
    close($ch);
    for my $lib ( @libs ) {
        my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe};
        my @sys_cmd;
        if ( $Config{cc} eq 'cl' ) {                 # Microsoft compiler
            require Win32;
            my @libpath = map { 
                q{/libpath:} . Win32::GetShortPathName($_)
            } @libpaths; 
            # this is horribly sensitive to the order of arguments
            @sys_cmd = (
                @$cc,
                $cfile,
                "${lib}.lib",
                "/Fe$exefile", 
                (map { '/I'.Win32::GetShortPathName($_) } @incpaths),
                "/link",
                @$ld,
                split(' ', $Config{libs}),
                (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths),
            );
        } elsif($Config{cc} eq 'CC/DECC') {          # VMS
        } elsif($Config{cc} =~ /bcc32(\.exe)?/) {    # Borland
            @sys_cmd = (
                @$cc,
                @$ld,
                "-o$exefile",
                (map { "-I$_" } @incpaths),
                (map { "-L$_" } @libpaths),
                "-l$lib",
                $cfile);
        } else {                                     # Unix-ish
                                                     # gcc, Sun, AIX (gcc, cc)
            @sys_cmd = (
                @$cc,
                @$ld,
                $cfile,
                "-o", "$exefile",
                (map { "-I$_" } @incpaths),
                (map { "-L$_" } @libpaths),
                "-l$lib",
            );
        }
        warn "# @sys_cmd\n" if $args{debug};
        local $ENV{LD_RUN_PATH} = join(":", @libpaths).":".$ENV{LD_RUN_PATH} unless $^O eq 'MSWin32';
        local $ENV{PATH} = join(";", @libpaths).";".$ENV{PATH} if $^O eq 'MSWin32';
        my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
        if ($rv != 0 || ! -x $exefile) {
            push @missing, $lib;
        }
        else {
            my $absexefile = File::Spec->rel2abs($exefile);
            $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/;
            if (system($absexefile) != 0) {
                push @wrongresult, $lib;
            }
            else {
                if ($analyze_binary) {
                    push @wronganalysis, $lib if !$analyze_binary->($lib, $exefile)
                }
            }
        }
        _cleanup_exe($exefile);
    } 
    unlink $cfile;

    my $miss_string = join( q{, }, map { qq{'$_'} } @missing );
    die("Can't link/include C library $miss_string, aborting.\n") if @missing;
    my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult);
    die("wrong result: $wrong_string\n") if @wrongresult;
    my $analysis_string = join(q{, }, map { qq{'$_'} } @wronganalysis );
    die("wrong analysis: $analysis_string") if @wronganalysis;
}

sub _cleanup_exe {
    my ($exefile) = @_;
    my $ofile = $exefile;
    $ofile =~ s/$Config{_exe}$/$Config{_o}/;
    # List of files to remove
    my @rmfiles;
    push @rmfiles, $exefile, $ofile, "$exefile\.manifest";
    if ( $Config{cc} eq 'cl' ) {
        # MSVC also creates foo.ilk and foo.pdb
        my $ilkfile = $exefile;
        $ilkfile =~ s/$Config{_exe}$/.ilk/;
        my $pdbfile = $exefile;
        $pdbfile =~ s/$Config{_exe}$/.pdb/;
	push @rmfiles, $ilkfile, $pdbfile;
    }
    foreach (@rmfiles) {
	if ( -f $_ ) {
	    unlink $_ or warn "Could not remove $_: $!";
	}
    }
    return
}
    
# return ($cc, $ld)
# where $cc is an array ref of compiler name, compiler flags
# where $ld is an array ref of linker flags
sub _findcc {
    my ($debug, $user_ccflags, $user_ldflags) = @_;
    # Need to use $keep=1 to work with MSWin32 backslashes and quotes
    my $Config_ccflags =  $Config{ccflags};  # use copy so ASPerl will compile
    my @Config_ldflags = ();
    for my $config_val ( @Config{qw(ldflags)} ){
        push @Config_ldflags, $config_val if ( $config_val =~ /\S/ );
    }
    my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||'', $user_ccflags||'');
    my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags, $user_ldflags||'');
    my @paths = split(/$Config{path_sep}/, $ENV{PATH});
    my @cc = split(/\s+/, $Config{cc});
    if (check_compiler ($cc[0], $debug)) {
	return ( [ @cc, @ccflags ], \@ldflags );
    }
    # Find the extension for executables.
    my $exe = $Config{_exe};
    if ($^O eq 'cygwin') {
	$exe = '';
    }
    foreach my $path (@paths) {
	# Look for "$path/$cc[0].exe"
        my $compiler = File::Spec->catfile($path, $cc[0]) . $exe;
	if (check_compiler ($compiler, $debug)) {
	    return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags)
	}
        next if ! $exe;
	# Look for "$path/$cc[0]" without the .exe, if necessary.
        $compiler = File::Spec->catfile($path, $cc[0]);
	if (check_compiler ($compiler, $debug)) {
	    return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags)

 view release on metacpan or  search on metacpan

lib/AAC/Pvoice.pm  view on Meta::CPAN

package AAC::Pvoice;

use strict;
use warnings;

use Wx qw(:everything);
use Wx::Perl::Carp;
use AAC::Pvoice::Bitmap;
use AAC::Pvoice::Input;
use AAC::Pvoice::Row;
use AAC::Pvoice::EditableRow;
use AAC::Pvoice::Panel;
use AAC::Pvoice::Dialog;
use Text::Wrap qw(wrap);

BEGIN {
	use Exporter ();
	use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
	$VERSION     = 0.91;
	@ISA         = qw (Exporter);
	@EXPORT      = qw (MessageBox);
	@EXPORT_OK   = qw ();
	%EXPORT_TAGS = ();
}

sub MessageBox
{
	my ($message, $caption, $style, $parent, $x, $y) = @_;
    $caption ||= 'Message';
	$style   ||= wxOK;
	$x       ||= -1;
	$y       ||= -1;

	$Text::Wrap::columns = 25;
	$message = wrap('','',$message)."\n";
	
    my $width = 0;
    $width = 25 if $style & wxOK;
    $width = 30 if $style & wxYES_NO;
    $width = 60 if $style & wxCANCEL;

	my $p = Wx::Frame->new(undef, -1, 'tmp');
	my $m = Wx::StaticText->new($p, -1, $message, wxDefaultPosition, wxDefaultSize, wxALIGN_CENTRE);
	$m->SetFont(Wx::Font->new(  10,                 # font size
                                wxDECORATIVE,       # font family
                                wxNORMAL,           # style
                                wxNORMAL,           # weight
                                0,                  
                                'Comic Sans MS',    # face name
                                wxFONTENCODING_SYSTEM));

	my $h = $m->GetSize->GetHeight;
	$p->Destroy;

	my $d = AAC::Pvoice::Dialog->new(undef, -1, $caption, [$x,$y], [310,100+$h]);
	
	my $messagectrl = Wx::StaticText->new($d->{panel},
                                          -1,
                                          $message,
                                          wxDefaultPosition,
                                          wxDefaultSize,
                                          wxALIGN_CENTRE);
	$messagectrl->SetBackgroundColour($d->{backgroundcolour});
	$messagectrl->SetFont(Wx::Font->new(10,                 # font size
                                        wxDECORATIVE,       # font family
                                        wxNORMAL,           # style
                                        wxNORMAL,           # weight
                                        0,                  
                                        'Comic Sans MS',    # face name
                                        wxFONTENCODING_SYSTEM));

	$d->Append($messagectrl,1);
    my $ok     = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,25,'OK',    Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxOK);    $d->Close()}];
    my $yes    = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,30,'Yes',   Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxYES);   $d->Close()}];
    my $no     = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,25,'No',    Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxNO);    $d->Close()}];
    my $cancel = [Wx::NewId,AAC::Pvoice::Bitmap->new('',50,60,'Cancel',Wx::Colour->new(255, 230, 230)),sub{$d->SetReturnCode(wxCANCEL);$d->Close()}];
    my $items = [];
    push @$items, $ok     if $style & wxOK;
    push @$items, $yes    if $style & wxYES_NO;
    push @$items, $no     if $style & wxYES_NO;
    push @$items, $cancel if $style & wxCANCEL;
	$d->Append(AAC::Pvoice::Row->new($d->{panel},          # parent
                                     scalar(@$items),      # max
                                     $items,               # items
                                     wxDefaultPosition,    # pos
                                     wxDefaultSize,
                                     $width,
                                     25,
                                     $d->{ITEMSPACING},
                                     $d->{backgroundcolour}),
                0); #selectable
	return $d->ShowModal();
}

=pod

=head1 NAME

AAC::Pvoice - Create GUI software for disabled people

=head1 SYNOPSIS

  use AAC::Pvoice
  # this includes all AAC::Pvoice modules


=head1 DESCRIPTION

AAC::Pvoice is a set of modules to create software for people who can't
use a normal mouse and/or keyboard. To see an application that uses this
set of modules, take a look at pVoice (http://www.pvoice.org, or the
sources on http://opensource.pvoice.org). 

AAC::Pvoice is in fact a wrapper around many wxPerl classes, to make it
easier to create applications like pVoice.


=head1 USAGE

=head2 AAC::Pvoice::MessageBox(message, caption, style, parent, x, y)

This function is similar to Wx::MessageBox. It uses the same parameters as
Wx::MessageBox does. Currently the style parameter doesn't support the
icons that can be set on Wx::MessageBox.

See the individual module's documentation

=head1 BUGS

probably a lot, patches welcome!


=head1 AUTHOR

	Jouke Visser
	jouke@pvoice.org
	http://jouke.pvoice.org

=head1 COPYRIGHT

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

The full text of the license can be found in the
LICENSE file included with this module.


=head1 SEE ALSO

perl(1), Wx, AAC::Pvoice::Panel, AAC::Pvoice::Bitmap, AAC::Pvoice::Row
AAC::Pvoice::EditableRow, AAC::Pvoice::Input

=cut


1; 
__END__

 view release on metacpan or  search on metacpan

lib/ABNF/Generator.pm  view on Meta::CPAN

	my $rx = eval { qr/$tail$/ };
	croak "Bad tail" if $@;
	return $prefix =~ $rx ? $prefix : $prefix . $tail;
}

=pod

=head1 $generator->C<hasCommand>($name)

Return 1 if there is a $name is command, 0 otherwise

=cut

method hasCommand(Str $name) {
	$self->{_grammar}->hasCommand($name);
}

=pod

=head1 FUNCTIONS

=head1 C<_asStrings>($generated)

Return stringification of genereted sequences from C<_generateChain>.

Uses in generate call to stringify chains.

=cut

func _asStrings($generated) {
	given ( $generated->{class} ) {
		when ( "Atom" ) { return [ $generated->{value} ] }

		when ( "Sequence" ) {
			my $value = $generated->{value};
			return [] unless @$value;

			my $begin = _asStrings($value->[0]);

			for ( my $pos = 1; $pos < @$value; $pos++ ) {
				my @new_begin = ();
				my $ends = _asStrings($value->[$pos]);
				next unless @$ends;

				my @ibegin = splice([shuffle(@$begin)], 0, $CHOICE_LIMIT);
				my @iends = splice([shuffle(@$ends)], 0, $CHOICE_LIMIT);
				foreach my $end ( @iends ) {
					foreach my $begin ( @ibegin ) {
						push(@new_begin, $begin . $end);
					}
				}
		
				$begin = \@new_begin;
			}

			return $begin;
		}

		when ( "Choice" ) {
			return [
				map { @{_asStrings($_)} } @{$generated->{value}}
			];
		}

		default { die "Unknown class " . $generated->{class} . Dumper $generated }
	}
}

1;

=pod

=head1 AUTHOR / COPYRIGHT / LICENSE

Copyright (c) 2013 Arseny Krasikov <nyaapa@cpan.org>.

This module is licensed under the same terms as Perl itself.

=cut

 view release on metacpan or  search on metacpan

eg/filelist.pm  view on Meta::CPAN

# -*- perl -*-
# example filelist

# $Id: filelist.pm,v 1.1 2010/11/01 19:04:21 jaw Exp $

package Local::MrMagoo::FileList;
use AC::ISOTime;
use AC::Yenta::Direct;
use JSON;
use strict;

my $YDBFILE = "/data/files.ydb";

sub get_file_list {
    my $config = shift;

    # get files + metadata from yenta
    my $yenta = AC::Yenta::Direct->new( 'files', $YDBFILE );

    # the job config is asking for files that match:
    my $syst  = $config->{system};
    my $tmax  = $config->{end};		# time_t
    my $tmin  = $config->{start};	# time_t

    # the keys in  yenta are of the form: 20100126150139_[...]
    my $start = isotime($tmin);		# 1286819830       => 20101011T175710Z
    $start =~ s/^(\d+)T(\d+).*/$1$2/;	# 20101011T175710Z => 20101011175710


    my @files = grep {
        # does this file match the request?
        ($_->{subsystem}   eq $syst) &&
        ($_->{end_time}    >= $tmin) &&
        ($_->{start_time}  <= $tmax)
    } map {
        # get meta-data on this file. data is json encoded
        my $d = $yenta->get($_);
        $d = $d ? decode_json($d) : {};
        # convert space seperated locations to arrayref
        $d->{location} = [ (split /\s+/, $d->{location}) ];
        $d;
    } $yenta->getrange($start, undef);	# get all files from $start to now


    return \@files;
}


1;

 view release on metacpan or  search on metacpan

lib/AC/Yenta.pm  view on Meta::CPAN

By default, yentas obtain their primary IP address by calling
C<gethostbyname( hostname() )>. If this either does not work on your
systems, or isn't the value you want to use,
you will need to write a custom C<MySelf> class and C<my_network_info>
function.



=head1 CONFIG FILE

various parameters need to be specified in a config file.
if you modify the file, it will be reloaded automagically.

=over 4

=item port

specify the TCP port to use

    port 3503

=item environment

specify the environment or realm to run in, so you can run multiple
independent yenta networks, such as production, staging, and dev.

    environment prod

=item allow

specify networks allowed to connect.

    allow 127.0.0.1
    allow 192.168.10.0/24

=item seedpeer

specify initial peers to contact when starting. the author generally
specifies 2 on the east coast, and 2 on the west coast.

    seedpeer 192.168.10.11:3503
    seedpeer 192.168.10.12:3503

=item secret

specify a secret key used to encrypt data transfered between
yentas in different datacenters.

    secret squeamish-ossifrage

=item syslog

specify a syslog facility for log messages.

    syslog local5

=item debug

enable debugging for a particular section

    debug map

=item map

configure a map (a collection of key-value data). you do not need
to configure the same set of maps on all servers. maps should be
configured similarly on all servers that they are on.

    map users {
	backend	    bdb
        dbfile      /home/acdata/users.ydb
        history     4
    }

=back

=head1 BUGS

Too many to list here.

=head1 SEE ALSO

    AC::Yenta::Client

    Amazon Dynamo - http://www.allthingsdistributed.com/2007/10/amazons_dynamo.html

=head1 AUTHOR

    Jeff Weisberg - http://www.solvemedia.com/

=cut

1;