ASP4x-Linker

 view release on metacpan or  search on metacpan

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

	close FH or die "close($_[0]): $!";
}

# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).

sub _version ($) {
	my $s = shift || 0;
	   $s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
	   $l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
	(
		defined $_[0]
		and
		! ref $_[0]

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

	if ( $self->tests ) {
		die "tests_recursive will not work if tests are already defined";
	}
	my $dir = shift || 't';
	unless ( -d $dir ) {
		die "tests_recursive dir '$dir' does not exist";
	}
	%test_dir = ();
	require File::Find;
	File::Find::find( \&_wanted_t, $dir );
	$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}

sub write {
	my $self = shift;
	die "&Makefile->write() takes no arguments\n" if @_;

	# Make sure we have a new enough
	require ExtUtils::MakeMaker;

	# MakeMaker can complain about module versions that include

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

	if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
		$args->{SIGN} = 1;
	}
	unless ( $self->is_admin ) {
		delete $args->{SIGN};
	}

	# merge both kinds of requires into prereq_pm
	my $prereq = ($args->{PREREQ_PM} ||= {});
	%$prereq = ( %$prereq,
		map { @$_ }
		map { @$_ }
		grep $_,
		($self->configure_requires, $self->build_requires, $self->requires)
	);

	# Remove any reference to perl, PREREQ_PM doesn't support it
	delete $args->{PREREQ_PM}->{perl};

	# merge both kinds of requires into prereq_pm
	my $subdirs = ($args->{DIR} ||= []);
	if ($self->bundles) {

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

	}

	if ( my $perl_version = $self->perl_version ) {
		eval "use $perl_version; 1"
			or die "ERROR: perl: Version $] is installed, "
			. "but we need version >= $perl_version";
	}

	$args->{INSTALLDIRS} = $self->installdirs;

	my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;

	my $user_preop = delete $args{dist}->{PREOP};
	if (my $preop = $self->admin->preop($user_preop)) {
		foreach my $key ( keys %$preop ) {
			$args{dist}->{$key} = $preop->{$key};
		}
	}

	my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
	$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');

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

		$self->{values}{$key} = shift;
		return $self;
	};
}

foreach my $key ( @resource_keys ) {
	*$key = sub {
		my $self = shift;
		unless ( @_ ) {
			return () unless $self->{values}{resources};
			return map  { $_->[1] }
			       grep { $_->[0] eq $key }
			       @{ $self->{values}{resources} };
		}
		return $self->{values}{resources}{$key} unless @_;
		my $uri = shift or die(
			"Did not provide a value to $key()"
		);
		$self->resources( $key => $uri );
		return 1;
	};

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

	my $self = shift;
	while ( @_ ) {
		my $module  = shift or last;
		my $version = shift || 0;
		push @{ $self->{values}{bundles} }, [ $module, $version ];
	}
	$self->{values}{bundles};
}

# Resource handling
my %lc_resource = map { $_ => 1 } qw{
	homepage
	license
	bugtracker
	repository
};

sub resources {
	my $self = shift;
	while ( @_ ) {
		my $name  = shift or last;

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

		# The user used ->feature like ->features by passing in the second
		# argument as a reference.  Accomodate for that.
		$mods = $_[0];
	} else {
		$mods = \@_;
	}

	my $count = 0;
	push @$features, (
		$name => [
			map {
				ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
			} @$mods
		]
	);

	return @$features;
}

sub features {
	my $self = shift;

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

	# Load the advisory META.yml file
	require YAML::Tiny;
	my @yaml = YAML::Tiny::LoadFile('META.yml');
	my $meta = $yaml[0];

	# Overwrite the non-configure dependency hashs
	delete $meta->{requires};
	delete $meta->{build_requires};
	delete $meta->{recommends};
	if ( exists $val->{requires} ) {
		$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
	}
	if ( exists $val->{build_requires} ) {
		$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
	}

	# Save as the MYMETA.yml file
	YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}

1;

lib/ASP4x/Linker.pm  view on Meta::CPAN

  
  my ($widget) = grep { $_->name eq $name } $s->widgets
    or return;
  
  return $widget;
}# end widget()


sub reset
{
  map { $_->reset } shift->widgets;
}# end reset()


sub uri
{
  my ($s, $args) = @_;
  
  my $vars = $s->vars( $args );
  
  no warnings 'uninitialized';
  my ($uri) = split /\?/, $s->base_href;
  my $context = ASP4::HTTPContext->current;
  my $server = $context->server;
  my $final_querystring = join '&', map { $server->URLEncode($_) . '=' . $server->URLEncode($vars->{$_}) }
                                      grep { defined($vars->{$_}) }
                                        sort keys %$vars;
  
  return $final_querystring ? join '?', ( $uri, $final_querystring ) : $uri;
}# end uri()


sub hidden_fields
{
  my ($s, $args) = @_;
  
  my $vars = $s->vars( $args, 1 );
  
  no warnings 'uninitialized';
  my ($uri) = split /\?/, $s->base_href;
  my $context = ASP4::HTTPContext->current;
  my $server = $context->server;

  my @inputs = map {qq(<input type="hidden" name="@{[ $server->URLEncode( $_ ) ]}" value="@{[ $server->URLEncode( $vars->{$_} ) ]}" />)}
                 keys %$vars;
  return join "\n", @inputs;
}# end hidden_fields()


sub vars
{
  my ($s, $args) = @_;
  
  my @parts = ( );
  no warnings 'uninitialized';
  my ($uri) = split /\?/, $s->base_href;
  
  my $context = ASP4::HTTPContext->current;
  my $server = $context->server;
  my %vars = %{ $context->request->Form };
  map {
    delete($vars{$_})
  } grep { $_ !~ m/\./ } keys %vars;
  
  if( $context->config->web->can('router') )
  {
    if( my $route = eval { $s->_router->route_for( $s->base_href, $ENV{REQUEST_METHOD} ) } )
    {
      map {
        delete($vars{$_});
      } @{$route->{captures}};
    }# end if()
  }# end if()
  
  foreach my $w ( $s->widgets )
  {
    foreach( $w->attrs )
    {
      my $key = $server->URLEncode( $w->name . '.' . $_ );

lib/ASP4x/Linker.pm  view on Meta::CPAN

        $vars{ $key } = $args->{ $w->name }->{ $_ };
      }
      else
      {
        $vars{ $key } = $w->get( $_ );
      }# end if()
    }# end foreach()
  }# end foreach()
  
  # Also add any non-ref values that were passed in as $args:
  map { $vars{$_} = $args->{$_} }
    grep { ! ref($args->{$_}) }
      sort keys %$args;
  
  my $res = \%vars;
  $s->reset();
  return $res;
}# end _prepare_vars()


sub DESTROY { my $s = shift; undef(%$s); }

lib/ASP4x/Linker/Widget.pm  view on Meta::CPAN

    confess "Required param '$_' was not provided"
      unless $args{$_};
  }# end foreach()
  
  my $context = ASP4::HTTPContext->current;
  my $form = $context->request->Form;
  $args{attrs} ||= [ ];
  $args{triggers} ||= { };
  
  $args{vars} = {
    map { $_ => $form->{"$args{name}.$_"} }
      @{$args{attrs}}
  };
  $args{original_vars} = {
    map { $_ => $form->{"$args{name}.$_"} }
      @{$args{attrs}}
  };
  
  return bless \%args, $class;
}# end new()


sub attrs { sort @{ shift->{attrs} } }

sub name { shift->{name} }

lib/ASP4x/Linker/Widget.pm  view on Meta::CPAN

sub set
{
  my ($s, %args) = @_;
  while( my ($attr, $val) = each %args )
  {
    confess "widget '$s->{name}' does not have any attribute named '$attr'"
      unless exists($s->{vars}->{$attr});
    $s->{vars}->{$attr} = $val;
    if( my $triggers = $s->{triggers}->{$attr} )
    {
      map { $_->( $s ) } @$triggers
    }# end if()
  }# end while()
  
#  $val;
  $s;
}# end set()


sub get
{

t/htdocs/index.asp  view on Meta::CPAN

  $linker->add_widget(
    name  => "widgetC",
    attrs => [qw/ size type color /]
  );
  
  $linker->add_widget(
    name  => "widgetD",
    attrs => [qw/ size type color /]
  );
  
  my @result = map {
    my $widget = $_;
    my $res = {
      $widget->name => {
        map { ($_ => $widget->get( $_ )) }
        $widget->attrs
      }
    };
    $res;
  } $linker->widgets;
%><%= JSON::XS->new->utf8->pretty->encode( \@result ) %>