view release on metacpan or  search on metacpan

script/rsybak  view on Meta::CPAN

#        my $sum = $args{program_summary} // $meta->{summary};
#        last unless $sum;
#        push @help, $progname, " - ", $sum, "\n\n";
#    }
#
#    my $clidocdata;
#
#    push @help, "Usage:\n";
#    {
#        for (sort {
#            ($common_opts->{$a}{order} // 99) <=>

script/rsybak  view on Meta::CPAN

#            per_arg_yaml => $args{per_arg_yaml},
#            (ggls_res => $args{ggls_res}) x defined($args{ggls_res}),
#        );
#        die [500, "gen_cli_doc_data_from_meta failed: ".
#                 "$res->[0] - $res->[1]"] unless $res->[0] == 200;
#        $clidocdata = $res->[2];
#        my $usage = $clidocdata->{usage_line};
#        $usage =~ s/\[\[prog\]\]/$progname/;
#        push @help, "  $usage\n";
#    }
#
#    {

script/rsybak  view on Meta::CPAN

#            }
#        }
#    }
#
#    {
#        last unless @{ $clidocdata->{examples} };
#        push @help, "\nExamples:\n";
#        my $i = 0;
#        my $egs = $clidocdata->{examples};
#        for my $eg (@$egs) {
#            $i++;
#            my $cmdline = $eg->{cmdline};
#            $cmdline =~ s/\[\[prog\]\]/$progname/;
#            push @help, "\n" if $eg->{summary} && $i > 1;

script/rsybak  view on Meta::CPAN

#    }
#
#    {
#        require Data::Dmp;
#
#        my $opts = $clidocdata->{opts};
#        last unless keys %$opts;
#
#        my %options_by_cat; 
#        for my $optkey (keys %$opts) {
#            for my $cat (@{ $opts->{$optkey}{categories} }) {
#                push @{ $options_by_cat{$cat} }, $optkey;
#            }
#        }
#
#        my $cats_spec = $clidocdata->{option_categories};
#        for my $cat (sort {
#            ($cats_spec->{$a}{order} // 50) <=> ($cats_spec->{$b}{order} // 50)
#                || $a cmp $b }
#                         keys %options_by_cat) {
#            my @opts = sort {length($b)<=>length($a)}

script/rsybak  view on Meta::CPAN

#        );
#    };
#    $ggls_res->[0] == 200 or return $ggls_res;
#
#    my $args_prop = $meta->{args} // {};
#    my $clidocdata = {
#        option_categories => {},
#        example_categories => {},
#    };
#
#    {

script/rsybak  view on Meta::CPAN

#            }
#            $args[-1] .= " ..." if $arg_spec->{greedy};
#            delete $args_prop{$arg};
#        }
#        unshift @args, "[options]" if keys(%args_prop) || keys(%$common_opts); 
#        $clidocdata->{usage_line} = "[[prog]]".
#            (@args ? " ".join(" ", @args) : "");
#    }
#
#    my %opts;
#    {

script/rsybak  view on Meta::CPAN

#                }
#
#                {
#                    local $arg_spec->{tags} = ['category0:main']
#                        if !$arg_spec->{tags} || !@{$arg_spec->{tags}};
#                    _add_category_from_spec($clidocdata->{option_categories},
#                                            $opt, $arg_spec, "options", 1);
#                }
#                _add_default_from_arg_spec($opt, $arg_spec);
#
#            } else {

script/rsybak  view on Meta::CPAN

#                    description =>
#                        $rimeta->langprop({lang=>$lang}, 'description'),
#                    (default => $spec->{default}) x !!(exists($spec->{default}) && !$show_neg),
#                };
#
#                _add_category_from_spec($clidocdata->{option_categories},
#                                        $opt, $spec, "options", 1);
#
#            }
#
#            $opts{$optkey} = $opt;

script/rsybak  view on Meta::CPAN

#                next OPT1;
#            }
#        }
#
#    }
#    $clidocdata->{opts} = \%opts;
#
#    my @examples;
#    {
#        my $examples = $meta->{examples} // [];
#        my $has_cats = _has_cats($examples);

script/rsybak  view on Meta::CPAN

#                cmdline      => $cmdline,
#                summary      => $rimeta->langprop({lang=>$lang}, 'summary'),
#                description  => $rimeta->langprop({lang=>$lang}, 'description'),
#                example_spec => $eg,
#            };
#            _add_category_from_spec($clidocdata->{example_categories},
#                                    $egdata, $eg, "examples", $has_cats);
#            push @examples, $egdata;
#        }
#    }
#    $clidocdata->{examples} = \@examples;
#
#    [200, "OK", $clidocdata];
#}
#
#1;
#
#__END__

 view release on metacpan or  search on metacpan

lib/FlatFile/DataStore.pm  view on Meta::CPAN

    my $sref = $self->read_bytes( $fh, $seekpos, $len ); 
    my $preamble = $self->new_preamble( { string => $$sref } );

    $seekpos    += $len;
    $len         = $preamble->reclen;
    my $recdata  = $self->read_bytes( $fh, $seekpos, $len ); 

    my $record = $self->new_record( {
        preamble => $preamble,
        data     => $recdata,  # scalar ref
        } );

    return $record;
}

 view release on metacpan or  search on metacpan

lib/Flow/To/JXML.pm  view on Meta::CPAN

our $VERSION = '0.1';
sub flow {
    my $self = shift;
    my $xfl  = $self->{_xml_flow};
    $xfl->startTag("flow");
    $xfl->_get_writer->cdata(JSON->new->utf8->pretty(1)->encode(\@_));
    $xfl->endTag("flow");
    return $self->Flow::flow(@_)

}

sub ctl_flow {
    my $self = shift;
    my $xfl  = $self->{_xml_flow};
    $xfl->startTag("ctl_flow");
    $xfl->_get_writer->cdata(encode_json(\@_));
    $xfl->endTag("ctl_flow");
    return $self->Flow::ctl_flow(@_)

}

 view release on metacpan or  search on metacpan

t/data/base/conf/web.xml  view on Meta::CPAN

        <extension>mbox</extension>
        <mime-type>application/mbox</mime-type>
    </mime-mapping>
    <mime-mapping>
        <extension>mc1</extension>
        <mime-type>application/vnd.medcalcdata</mime-type>
    </mime-mapping>
    <mime-mapping>
        <extension>mcd</extension>
        <mime-type>application/vnd.mcd</mime-type>
    </mime-mapping>

 view release on metacpan or  search on metacpan

t/41c-filehandles.t  view on Meta::CPAN

    }
}

my @pids = ();
my @data = (@INC,%INC,%!,0..19)[0..19];
my (@pdata, @cdata);
for (my $i=0; $i<4; $i++) {
    push @pids, 
    fork { 
	sub => \&compute_checksums_in_child, 
	child_fh => "in,out" 

t/41c-filehandles.t  view on Meta::CPAN

}
Forks::Super::write_stdin($_,"__END__\n") for @pids;
waitall;

foreach (@pids) {
    push @cdata, Forks::Super::read_stdout($_);
}
ok(@pdata == @cdata,                                              ### 1 ###
   "Master/slave produced ".scalar @pdata."/".scalar @cdata." lines")
 or do {
     no warnings 'uninitialized';
     print STDERR "\@pdata: @pdata[0..19]\n";
     print STDERR "--------------\n\@cdata: ",
         join ' ', map { $_ || '"undef"' . "\n" } @cdata[0..19], "\n";
};

@pdata = sort grep defined,@pdata;
@cdata = sort grep defined,@cdata;
my $pc_equal = 1;
for (my $i=0; $i<@pdata; $i++) {
    if (!defined($pdata[$i]) || !defined($cdata[$i])
	    || $pdata[$i] ne $cdata[$i]) {
	$pc_equal=0 
    }
}
ok($pc_equal, "master/slave produced same data"); ### 22 ###

 view release on metacpan or  search on metacpan

lib/Frontier/RPC2.pm  view on Meta::CPAN

	Frontier::RPC2::die($expat, "wanted \`param' tag, got \`$tag'\n")
	    if ($tag ne 'param');
	push @{ $expat->{'rpc_state'} }, 'want_param_name_or_value';
    } elsif ($state eq 'want_param_name_or_value') {
	if ($tag eq 'value') {
	    $expat->{'may_get_cdata'} = 1;
	    $expat->{'rpc_text'} = "";
	    push @{ $expat->{'rpc_state'} }, 'value';
	} elsif ($tag eq 'name') {
	    push @{ $expat->{'rpc_state'} }, 'param_name';
	} else {	    

lib/Frontier/RPC2.pm  view on Meta::CPAN

	Frontier::RPC2::die($expat, "wanted parameter name data, got tag \`$tag'\n");
    } elsif ($state eq 'want_value') {
	Frontier::RPC2::die($expat, "wanted \`value' tag, got \`$tag'\n")
	    if ($tag ne 'value');
	$expat->{'rpc_text'} = "";
	$expat->{'may_get_cdata'} = 1;
	push @{ $expat->{'rpc_state'} }, 'value';
    } elsif ($state eq 'value') {
	$expat->{'may_get_cdata'} = 0;
	if ($tag eq 'array') {
	    push @{ $expat->{'rpc_container'} }, [];
	    push @{ $expat->{'rpc_state'} }, 'want_data';
	} elsif ($tag eq 'struct') {
	    push @{ $expat->{'rpc_container'} }, {};
	    push @{ $expat->{'rpc_member_name'} }, undef;
	    push @{ $expat->{'rpc_state'} }, 'struct';
	} elsif ($scalars{$tag}) {
	    $expat->{'rpc_text'} = "";
	    push @{ $expat->{'rpc_state'} }, 'cdata';
	} else {
	    Frontier::RPC2::die($expat, "wanted a data type, got \`$tag'\n");
	}
    } elsif ($state eq 'want_data') {
	Frontier::RPC2::die($expat, "wanted \`data', got \`$tag'\n")

lib/Frontier/RPC2.pm  view on Meta::CPAN

	push @{ $expat->{'rpc_state'} }, 'array';
    } elsif ($state eq 'array') {
	Frontier::RPC2::die($expat, "wanted \`value' tag, got \`$tag'\n")
	    if ($tag ne 'value');
	$expat->{'rpc_text'} = "";
	$expat->{'may_get_cdata'} = 1;
	push @{ $expat->{'rpc_state'} }, 'value';
    } elsif ($state eq 'struct') {
	Frontier::RPC2::die($expat, "wanted \`member' tag, got \`$tag'\n")
	    if ($tag ne 'member');
	push @{ $expat->{'rpc_state'} }, 'want_member_name';

lib/Frontier/RPC2.pm  view on Meta::CPAN

	    if ($tag ne 'name');
	push @{ $expat->{'rpc_state'} }, 'member_name';
	$expat->{'rpc_text'} = "";
    } elsif ($state eq 'member_name') {
	Frontier::RPC2::die($expat, "wanted data, got tag \`$tag'\n");
    } elsif ($state eq 'cdata') {
	Frontier::RPC2::die($expat, "wanted data, got tag \`$tag'\n");
    } else {
	Frontier::RPC2::die($expat, "internal error, unknown state \`$state'\n");
    }
}

lib/Frontier/RPC2.pm  view on Meta::CPAN

sub end {
    my $expat = shift; my $tag = shift;

    my $state = pop @{ $expat->{'rpc_state'} };

    if ($state eq 'cdata') {
	my $value = $expat->{'rpc_text'};
	if ($tag eq 'base64') {
	    $value = Frontier::RPC2::Base64->new($value);
	} elsif ($tag eq 'boolean') {
	    $value = Frontier::RPC2::Boolean->new($value);

lib/Frontier/RPC2.pm  view on Meta::CPAN

	pop @{ $expat->{'rpc_member_name'} };
    } elsif ($state eq 'array') {
	$expat->{'rpc_value'} = pop @{ $expat->{'rpc_container'} };
    } elsif ($state eq 'value') {
	# the rpc_text is a string if no type tags were given
	if ($expat->{'may_get_cdata'}) {
	    $expat->{'may_get_cdata'} = 0;
	    if ($expat->{'use_objects'}) {
		$expat->{'rpc_value'}
		= Frontier::RPC2::String->new($expat->{'rpc_text'});
	    } else {
		$expat->{'rpc_value'} = $expat->{'rpc_text'};

 view release on metacpan or  search on metacpan

lib/Fry/Lib/CDBI/Tags.pm  view on Meta::CPAN

		$class->has_triple_table(%has_arg);

		#define triple_table hash
		my %triple_obj = (one_table=>$class->tb,many_table=>$many_table, second_table=>$second_table);
		%triple_obj = (%triple_obj,%has_arg);
		$class->mk_cdata_global(_triple_table=>\%triple_obj);

		#$class->set_columns;
		$c2->columns(TEMP=>$manycol);

		#subs:repeat for each many_col

 view release on metacpan or  search on metacpan

share/pci.ids  view on Meta::CPAN

	1021  TC902x Gigabit Ethernet
	1023  IP1000 Family Gigabit Ethernet
		1043 8180  NX1101
13f1  Oce' - Technologies B.V.
13f2  Ford Microelectronics Inc
13f3  Mcdata Corporation
13f4  Troika Networks, Inc.
	1401  Zentai Fibre Channel Adapter
13f5  Kansai Electric Co. Ltd
13f6  C-Media Electronics Inc
	0011  CMI8738

 view release on metacpan or  search on metacpan

conf/MobyServices/text_xml_renderer.pm  view on Meta::CPAN

sub render {
    my ($DOM, $htmldir,$imgdir) = @_;
    my $content;
    $content = &getStringContent($DOM);
    $content =~ s/<!\[cdata\[/&lt;[CDATA[/ig;
    $content =~ s/<([^>]+)>/&lt;$1&gt;/g; # mask '>' and '<' in tags
    return ("<pre>$content</pre>");# the 0 indicates that we have only rendered the top-level XML of this object
}
sub getStringContent {
    my ($ROOT) = @_;

 view release on metacpan or  search on metacpan

sbin/build-gcc-builtins-package.pl  view on Meta::CPAN

# Inside the .pm output we have 2 lists to add: exported subs
# and pod of each of this exported sub
my $list_of_sub_names = "";
my $list_of_exported_subs = "";
my $exported_subs_descriptions = "";
# you can use $afuncdata->{'xs-signature-without-identifiers'} to have identifiers included
for my $afuncname (sort keys %funcs){
	my $afuncdata = $funcs{$afuncname};
	$list_of_sub_names .= $afuncdata->{'xs-name'}.' ';
	$list_of_exported_subs .= '=item * C<'.$afuncdata->{'xs-signature-without-identifiers'}.">\n\n";
	$exported_subs_descriptions .=<<EOP;
=head2 C<$afuncdata->{'xs-signature-without-identifiers'}>

$afuncdata->{'description'}

EOP
}

######################################################

sbin/build-gcc-builtins-package.pl  view on Meta::CPAN

	my @files = glob($tfile);
	unlink @files;
}

for my $afuncname (sort keys %funcs){
	my $afuncdata = $funcs{$afuncname};
	my $tfile = File::Spec->catfile($TDIR, $tidx++.'-'.$afuncdata->{'xs-name'}.'.t');
	if( ! open($FH, '>', $tfile) ){ die "error, failed to open output XS file '$tfile' for writing: $!" }
	my $tcon = $T_CONTENTS;
	$tcon =~ s/<%\s*test_func_run\s*%>/$afuncdata->{'test_func_run'}/;
	$tcon =~ s/<%\s*test_func_is_ok\s*%>/$afuncdata->{'test_func_is_ok'}/;
	print $FH $tcon;
	close $FH;
	print "$0 : done, test file written to '$tfile'.\n";
}

sbin/build-gcc-builtins-package.pl  view on Meta::CPAN

######################################################
################## Write XS output ###################
if( ! open($FH, '>', $XS_outfile) ){ die "error, failed to open output XS file '$XS_outfile' for writing: $!" }
print $FH $XS_CONTENTS;
for my $afuncname (sort keys %funcs){
	my $afuncdata = $funcs{$afuncname};
	print $FH "\n".$afuncdata->{'xs-code'}."\n"
}
close $FH;
print "$0 : done, ".scalar(keys %funcs)." builtin functions written to '$XS_outfile'.\n";

######################################################

 view release on metacpan or  search on metacpan

SVG.pm  view on Meta::CPAN

	       id=>$id,
	       x=>$x,
	       y=>$y + $font_obj->{height} - GD::SVG::TEXT_KLUDGE,
	       %$formatting,
	       fill      => $color,
	      )->cdata($text);
  return $result;
}

sub stringUp {
  my ($self,$font_obj,$x,$y,$text,$color_index) = @_;

SVG.pm  view on Meta::CPAN

    $img->text(
	       id=>$id,
	       %$formatting,
	       'transform' => "translate($x,$y) rotate(-90)",
	       fill      => $color,
	      )->cdata($text);
}

sub char {
  my ($self,@rest) = @_;
  $self->string(@rest);

 view release on metacpan or  search on metacpan

doc/Read.html  view on Meta::CPAN

	</UL>

	<LI><A HREF="#private methods">Private methods</A></LI>
	<UL>

		<LI><A HREF="#_getobjassocdata">_getObjAssocData</A></LI>
	</UL>

</UL>
<!-- INDEX END -->

doc/Read.html  view on Meta::CPAN

              Map-specific fields.</PRE>
<P>
<HR>
<H1><A NAME="private methods">Private methods</A></H1>
<P>
<H2><A NAME="_getobjassocdata">_getObjAssocData</A></H2>
<PRE>
  Function  : get (read) data from and associated with the Object table/object.
  Arguments : Scalar containing an Object.id and a reference to a hash which 
              will be populated with the data.
  Returns   : N/A

 view release on metacpan or  search on metacpan

lib/Geo/E00.pm  view on Meta::CPAN

  $e00->open($file);

  $e00data = $e00->parse();

  $arcdata = $e00data->{arc};

  print "Arcpoint";
  foreach $arc (@$arcdata) {
	print $arc->{npoints},"\n";
  }

=head1 STRUCTURES

lib/Geo/E00.pm  view on Meta::CPAN

   $io = new Geo::E00;

   $io->open($file);

   $e00data = $io->parse();
   $arcdata = $e00data->{arc};
   $cntdata = $e00data->{cnt};

   print "Arcpoint";
   foreach $arc (@$arcdata) {
	print $arc->{npoints},"\n";
	print $arc->{LENGTH},"\n";
   }

   print "Arcpoint longitude (x) - latitude (y)";
   foreach $arc (@$arcdata) {
	foreach $ll (@{$arc->{coord}}) {
		print "Longitude $ll->{x}\n";
		print "Latitude  $ll->{y}\n";
	}
   }

 view release on metacpan or  search on metacpan

examples/iland  view on Meta::CPAN

    "L1", 100, LAYER_MODE_NORMAL_LEGACY
  );
  $newimage->insert_layer($layer, 0, -1);
  my $newdrawable = $newimage->get_active_drawable;
  my $dest = Gimp::PixelRgn->new($newdrawable, 0, 0, $width, $height, 1, 1);
  my $srcdata = $src->get_rect($drawable->bounds);
  my $destdata = $srcdata->zeroes;
  $destdata->slice(3) .= 255 if $alpha;
  my $quant = ($srcdata->slice("($component)")->max / $delta)->floor->sclr;
  goto FINISH if $quant <= 0; # nothing to do
  my $destmv = $destdata->mv(0,-1); # x y rgb
  Gimp::Progress->init("Rendering...");
  my $relord = $width / 255;
  $newdrawable->fill(FILL_FOREGROUND);
  $delta = 1 if $delta < 1;
  for my $x (0..$width-1) {
    my $col = $srcdata->slice("($component),($x)");
    my $exceed_floor = ($col > $floor);
    my $r = $col->where($exceed_floor); # nvals
    my $destx = ($width - $r * $relord + ($x / $elevation))->long; # nvals
    #Apply elevation following the x offset in original picture
    my $remain_s = zeroes(long, 3, $quant, $r->dim(0)); # xyr quant nvals

 view release on metacpan or  search on metacpan

t/google-tutorial.pl  view on Meta::CPAN

);

{
  print "[Heaviest 10 children]\n";
  my $aref = $bq->selectall_arrayref(
    query => "SELECT TOP(title, 10) as title, COUNT(*) as revision_count FROM [publicdata:samples.wikipedia] WHERE wp_namespace = 0"
  );
  foreach my $ref (@$aref) {
    print join("\t", @$ref), "\n";
  }
}

{
  print "[A popular myth debunked!]\n";
  my $aref = $bq->selectall_arrayref(
    query => 'SELECT word FROM publicdata:samples.shakespeare WHERE word="huzzah"'
  );
  foreach my $ref (@$aref) {
    print join("\t", @$ref), "\n";
  }
}

{
  print "[How many works of Shakespeare are there?]\n";
  my $aref = $bq->selectall_arrayref(
    query => "SELECT corpus FROM publicdata:samples.shakespeare GROUP BY corpus"
  );
  foreach my $ref (@$aref) {
    print join("\t", @$ref), "\n";
  }
}

{
  print "[How many works of Shakespeare are there?]\n";
  my $aref = $bq->selectall_arrayref(
    query => "SELECT corpus, sum(word_count) AS wordcount FROM publicdata:samples.shakespeare GROUP BY corpus ORDER BY wordcount DESC"
  );
  foreach my $ref (@$aref) {
    print join("\t", @$ref), "\n";
  }
}

 view release on metacpan or  search on metacpan

lib/Graph/ChartSVG.pm  view on Meta::CPAN

                            'writing-mode'   => 'lr',
                            'text-anchor' => $set->{ anchor } || $layer->anchor
                        },
                        transform => "matrix(1,0,0,-1," . ( $X ) . "," . ( $Y ) . ") rotate($text_angle)"
                    );
                    $txt->tspan( dy => "0" )->cdata( $set->{ text } );

                }
            }
            elsif ( exists $layer->{ type } && $layer->{ type } eq 'line' )
            {

lib/Graph/ChartSVG.pm  view on Meta::CPAN

                        style => \%style,
# transform => " rotate( " . $self->grid->x->label->rotation . "," . ( $self->border->left - $self->grid->debord->left - $self->grid->x->label->space - $x_offset ) . "," . ( $self->border->bottom + $val - $y_offset ) . " ) ",
                        transform => " rotate( " . $self->grid->x->label->rotation . "," . ( $self->border->left - $self->grid->debord->left - $self->grid->x->label->space - $x_offset ) . "," . ( $self->border->bottom + $val - $y_offset ) . " ) ",

                    );
                    $txt->tspan( dy => "0" )->cdata( $self->grid->x->label->text->[$text_indx] );
                }

##########################################
# second x label ( right side )
##########################################

lib/Graph/ChartSVG.pm  view on Meta::CPAN

                        y => $self->border->top - $self->border->bottom + $val + ( $self->grid->x->label2->size * 0.3 ) - $y_offset,

                        style     => \%style,
                        transform => " rotate( " . $self->grid->x->label2->rotation . "," . ( $self->border->left + $self->grid->debord->right + $self->grid->x->label2->space + $x_offset + $self->active_size->[0] ) . "," . ( $self->border->bottom + $...
                    );
                    $txt->tspan( dy => "0" )->cdata( $self->grid->x->label2->text->[$text_indx] );
                }
            }
        }

####################################

lib/Graph/ChartSVG.pm  view on Meta::CPAN

                        x         => $self->border->left + $val - $x_offset,
                        y         => $y_offset,
                        style     => \%style,
                        transform => " rotate( " . $self->grid->y->label->rotation . "," . ( $self->border->left + $val - $x_offset ) . ", " . $y_offset . " ) ",
                    );
                    $txt->tspan( dy => "0" )->cdata( $self->grid->y->label->text->[$nbr] );

                }

                if ( defined $self->grid->y->label2 && defined $self->grid->y->label2->text->[$nbr] )
                {

lib/Graph/ChartSVG.pm  view on Meta::CPAN

                        x         => $x_offset,
                        y         => $y_offset,
                        style     => \%style,
                        transform => " rotate( " . $self->grid->y->label2->rotation . "," . ( $x_offset ) . ", " . $y_offset . " ) ",
                    );
                    $txt->tspan( dy => "0" )->cdata( $self->grid->y->label2->text->[$nbr] );
                }
            }
        }
    }

 view release on metacpan or  search on metacpan

lib/GraphViz/XML.pm  view on Meta::CPAN

    my $label  = $root->gi;
    my $colour = 'blue';
    my $shape  = 'ellipse';

    if ( $root->is_pcdata ) {
        $label = $root->text;
        $label =~ s|^\s+||;
        $label =~ s|\s+$||;
        $colour = 'black';
    } else {

 view release on metacpan or  search on metacpan

Template.pm  view on Meta::CPAN

    while( $body =~ 
	   /(<([\w-]+)>(.*?)<\/\2> |
	     <\*(.*?)\*> |
	     (<!\[\[CDATA\[.*\]\]>)
	     )/gsx ){
	my ($match, $sym, $val, $cmd, $cdata) = ($1,$2,$3,$4,$5);
	my $len = length($match);
	my $pre = substr($body, $last, pos($body)-$len-$last);
	$text .= $pre;
	$last = pos($body);
	if( $sym ){
	    my $sub = $self->parse_data_body($val, $env);
	    extend_data($sym, $sub, \%hash);
	}
	elsif( $cdata ){
	    $cdata =~ s/^<!\[\[CDATA\[//;
	    $cdata =~ s/\]\]>$//;
	    $text .= $cdata;
	}
	else{
	    my ($key, $aux) = 
		$cmd =~ /\s*([\w:.-]+)\s*(.*)/;
	    my $val = $self->eval_var($key, $aux, $env);

 view release on metacpan or  search on metacpan

lib/HTML/AutoTag.pm  view on Meta::CPAN

            $attr_str .= ' ' . Tie::Hash::Attribute::_key( $key ) . '="' . Tie::Hash::Attribute::_val( $attr->{$key} ) . '"';
        }
    }

    # emtpy tag
    unless (defined $args{cdata}) {
        return ( $INDENT x $LEVEL )
            . "<$args{tag}"
            . ( defined( $attr_str ) ? $attr_str : scalar( %$attr ) )
            . " />$NEWLINE"
        ;
    }

    my $cdata;
    my $no_post_indent;
    if (ref($args{cdata}) eq 'ARRAY') {

        if (ref($args{cdata}[0]) eq 'HASH') {

            $LEVEL++;
            $cdata = $NEWLINE;
            for (0 .. $#{ $args{cdata} }) {
                $cdata .= $self->tag( %{ $args{cdata}[$_] } );
            }
            $LEVEL--;

        } else {
            my $str = '';
            for (@{ $args{cdata} }) {
                $str .= $self->tag( tag => $args{tag}, attr => $attr, cdata => $_);
            }
            return $str;
        }

    } elsif (ref($args{cdata}) eq 'HASH') {
        $LEVEL++;
        $cdata = $NEWLINE . $self->tag( %{ $args{cdata} } );
        $LEVEL--;

    } else {
        $cdata = $ENCODE ? HTML::Entities::encode_entities( $args{cdata}, $ENCODES ) : $args{cdata};
        $no_post_indent = 1;
    }

    return ( $INDENT x $LEVEL )
        . "<$args{tag}" . ( defined( $attr_str ) ? $attr_str : scalar( %$attr ) )
        . ">$cdata"
        . ( $no_post_indent ? '' : ( $INDENT x $LEVEL ) )
        . "</$args{tag}>$NEWLINE"
    ;
}

lib/HTML/AutoTag.pm  view on Meta::CPAN

  my @data = qw( one two three four five six seven eight );

  print $auto->tag(
      tag   => 'ol', 
      attr  => {qw( reversed reversed )},
      cdata => [
          map { tag => 'li', attr => \%attr, cdata => $_ }, @data
      ]
  );

=head1 DESCRIPTION

lib/HTML/AutoTag.pm  view on Meta::CPAN

The name of the tag. String.

  tag => 'table'

=item * C<cdata>

The value inbetween the tag. Types allowed are:

=over 12

=item * scalar - the string to be wrapped in tags

  cdata => 'hello world'

=item * hash ref - another tag with its own cdata and attributes

  cdata => { tag => 'td', attr => {}, cdata => 'value' }

=item * AoH - multiple tags as hash references.

  cdata => [
      { tag => 'td', attr => {}, cdata => 'value1' }
      { tag => 'td', attr => {}, cdata => 'value2' }
  ]

=back

=item * C<attr>

lib/HTML/AutoTag.pm  view on Meta::CPAN

  my %tr_attr = ( class => [qw(odd even)] );
  
  print $auto->tag(
      tag => 'table',
      attr => { class => 'spreadsheet' },
      cdata => [
          {
              tag => 'tr',
              attr => \%tr_attr,
              cdata => {
                  tag => 'td',
                  attr => { style => { color => [qw(red green)] } },
                  cdata => [qw(one two three four five six)],
              },
          },
          {
              tag => 'tr',
              attr => \%tr_attr,
              cdata => {
                  tag => 'td',
                  attr => { style => { color => [qw(green red)] } },
                  cdata => [qw(seven eight nine ten eleven twelve)],
              },
          },
          {
              tag => 'tr',
              attr => \%tr_attr,
              cdata => {
                  tag => 'td',
                  attr => { style => { color => [qw(red green)] } },
                  cdata => [qw(thirteen fourteen fifteen sixteen seventeen eighteen)],
              },
          },
      ]
  );

lib/HTML/AutoTag.pm  view on Meta::CPAN

  my $auto = HTML::AutoTag->new( indent => "    " );

  print $auto->tag(
      tag   => 'select',
      attr  => { name => 'widgets', size => 3, multiple => 'multiple' },
      cdata => [
          { tag => 'option', cdata => 'foo', attr => { value => 1, } },
          { tag => 'option', cdata => 'bar', attr => { value => 2, selected => 'selected' } },
          { tag => 'option', cdata => 'baz', attr => { value => 3, selected => 'selected' } },
      ]
  );

Or in a more programatic way:

lib/HTML/AutoTag.pm  view on Meta::CPAN

  my %attr = ( value => [ map $_->[0], @options ], selected => $selected );

  print $auto->tag(
      tag   => 'select',
      attr  => { name => 'widgets', size => scalar @options, multiple => 'multiple' },
      cdata => [ map { tag => 'option', attr => \%attr, cdata => $_->[1] }, @options ],
  );

See tests in C<t/> from the distribution or github for more examples:
L<https://github.com/jeffa/HTML-AutoTag/tree/master/t>

 view release on metacpan or  search on metacpan

Bare.pm  view on Meta::CPAN

    if( ref( $oba ) eq 'HASH' ) { $posa = $oba->{'_pos'} || 0; }
    if( ref( $obb ) eq 'HASH' ) { $posb = $obb->{'_pos'} || 0; }
    return $posa <=> $posb;
  } keys %$objs;
  
  if( $objs->{'_cdata'} ) {
    my $val = $objs->{'value'};
    $val =~ s/^(\s*\n)+//;
    $val =~ s/\s+$//;
    $val =~ s/&/&amp;/g;
    $val =~ s/</&lt;/g;
    $objs->{'value'} = $val;
    #$html = "$less![CDATA[<div class='node'><div class='cdata'>$val</div></div>]]$more";
    $cd0 = "$less![CDATA[<div class='node'><div class='cdata'>";
    $cd1 = "</div></div>]]$more";
  }
  for my $i ( @dex ) {
    my $obj  = $objs->{ $i } || '';
    my $type = ref( $obj );

Bare.pm  view on Meta::CPAN

    }
    else {
      if( $i eq 'comment' ) { $html .= "$less!--" . $obj . "--$more" . "<br>\n"; }
      elsif( $i eq 'value' ) {
        if( $level > 1 ) {
          if( $obj && $obj =~ /[<>&;]/ && ! $objs->{'_cdata'} ) { $html .= "$less![CDATA[$obj]]$more"; }
          else { $html .= $obj if( $obj =~ /\S/ ); }
        }
      }
      elsif( $i =~ /^_/ ) {}
      else { $html .= "$less$tn0$i$tn1$more$obj$less/$tn0$i$tn1$more"; }

 view release on metacpan or  search on metacpan

CMTemplate.pm  view on Meta::CPAN

    my $contents = shift;

    # NOP: Just eat the tag
}

sub __process_cdata__ {
    my $self = shift;
    $self->__debug__(\@_);
    my ($cdata) = @_;

    # If we are in a TPL node, then we should just add the text to the current
    # text in that node.  Otherwise, something went wrong.  We should always
    # be prepared to receive text when it comes.
    my $node = $self->__top_TPL__( 'text' );
    $node->text( $node->text . $cdata );
    $self->__debug__( "New CDATA length: " . length( $node->text ) );
}

# This function takes a chunk of text and decides what to do with it.  It works
# in a similar fashion to expat, which will take text until you quit giving it
# to it.  It simply looks for tags and data in between.  When a complete tag is
# found, it passes the information off to a function to have it processed.
# When cdata is found (character data) it dumps it out.  Note that there is
# no guarantee that the cdata will come back all at once.  This function does
# not do any output buffering on cdata.  If it isn't in a tag, it gives you
# everything that it currently has, whether it is the entire set of text
# or not.
sub __process_block__ {
    my $self = shift;
    $self->__debug__(\@_);

CMTemplate.pm  view on Meta::CPAN

    # This function only looks for tokens and keeps track of whether or not
    # it is inside of a tag.  Once a complete tag has been found, it will
    # send the name of that tag and all remaining text inside of it to the
    # appropriate function.
    # If it reaches the end of a buffer and is not inside of a tag, it
    # accumulates all text and sends it out to the cdata function.

    # Append to the buffer and continue where we left off.
    $self->{strbuf} .= $str;

    # Note that if we are already inside of a tag, we search from a few

CMTemplate.pm  view on Meta::CPAN

            if ($pos > -1) {
                # Found the start tag.  Change state and get out.
                $self->{parserintag} = 1;
                $self->{tagstart} = $pos;
                if ($pos > $curpos) {
                    $self->__process_cdata__( 
                        substr( $self->{strbuf}, $curpos, $pos - $curpos )
                        );
                    $curpos = $pos;
                }
                # exhausted our buffer to this point.

CMTemplate.pm  view on Meta::CPAN

                    );
                # If nothing like a tag was found, set the position to be
                # the character after the end of the buffer.  Otherwise,
                # use the position of the tag character.
                $fpos = ($fpos > -1) ? $fpos : $self->{buflen};
                $self->__process_cdata__(
                    substr( $self->{strbuf}, $curpos, $fpos - $curpos )
                    );
                $curpos = $fpos;
                $self->{bufstart} = $curpos;
            }

 view release on metacpan or  search on metacpan

lib/HTML/DOM.pm  view on Meta::CPAN

		# option is that  a  parser  for  innerHTML  doesn’t  know
		# whether the nodes will be inserted in a <pre>.
		no_space_compacting $tb 1;

		$tb->handler(text => "text",         # so we can get line
		    "self, text, is_cdata, offset"); # numbers for scripts
		$tb->handler(start => "start",
		  "self, tagname, attr, attrseq, offset, tokenpos");
		$tb->handler((declaration=>)x2,'self,tagname,tokens,text');

		$tb->{_HTML_DOM_tweakall} = $tb->{'_tweak_*'};

lib/HTML/DOM.pm  view on Meta::CPAN

		    sub { $doc_elem->end(@_) },
		   'tagname, text'
		  ],
		  text_h => [ 
		    sub { $doc_elem->text(@_) },
		   'text, is_cdata'
		  ],
		 );

		$p->unbroken_text(1); # push_content, which is called by
		                     # H:TB:text, won't concatenate two

 view release on metacpan or  search on metacpan

t/01_basic.t  view on Meta::CPAN

like($Res, qr{26:<!--defang_SCRIPT--><!-- alert\('XSS'\); --><!--/defang_SCRIPT-->}, "IE conditional downlevel-revealed comment body");
like($Res, qr{27:<!--${CommentStartText}\[endif\]${CommentEndText}-->}, "IE conditional downlevel-revealed comment end");
like($Res, qr{27a:<!--${CommentStartText}\[if gte IE 4\]${CommentEndText}--><!--${DefangString}foo-->}, "IE conditional defang content");

# Some XML tests
# Refer http://www.w3schools.com/XML/xml_cdata.asp for information on CDATA
like($Res, qr{28:<!--${DefangString}XML ID=I--><!--${DefangString}X--><!--${DefangString}C-->}, "Defang unknown xml and other opening tags");
like($Res, qr{29:<!--${CommentStartText}\[CDATA\[<IMG SRC="javas]]${CommentEndText}-->}, "Comment out single-line cdata section");
like($Res, qr{30:<!--${CommentStartText}\[CDATA\[cript:alert\('XSS'\);">}, "Comment out multi-line cdata section start");
like($Res, qr{31:]]${CommentEndText}-->}, "Comment out multi-line cdata section end");
like($Res, qr{32:<!--/${DefangString}C--><!--/${DefangString}X--><!--/${DefangString}xml-->}, "Defang unknown xml and other closing tags");
# Make sure xss:xss tag comes after each import in the original html for the below checks
# HTML::Defang.pm tended to dump all HTML output without defanging if a '<?' tag was closed by just '>'
like($Res, qr{33:<!--\?import namespace="xss" implementation="http://ha.ckers.org/xss.htc"-->}, "Defang <?import tag");
like($Res, qr{34:<!--${DefangString}xss:xss-->XSS<!--/${DefangString}xss:xss-->}, "Defang xss:xss");

 view release on metacpan or  search on metacpan

t/defer.t  view on Meta::CPAN

    ok $css->preload_script, 'preload script exists';

    my $link = $css->link_html('test');

    ok my $cdata = $css->preload_script->slurp_raw, 'got script content';


    my $html = $css->deferred_link_html('test');


    is $html, '<link rel="preload" as="style" href="/foo.css" onload="this.onload=null;this.rel=\'stylesheet\'"><noscript>' . $link . '</noscript><script>' . $cdata . '</script>',
        'deferred_link_html';

};

subtest "deferred_link_html with inline disabled, simple mode" => sub {

 view release on metacpan or  search on metacpan

EscapeEvil.pm  view on Meta::CPAN

    $self->output( ( $self->{allow_comment} ) ? $comment : &_escape($comment) );
}

sub text {

    my ( $self, $text, $is_cdata ) = @_;
    $text = &_escape($text);
    $text = &_unescape_entities($text) if $self->{allow_entity_reference};
    $text = &_unescape($text)
      if $is_cdata
      && $self->{_current_tag} eq "script"
      && $self->{allow_script};
    $text = &_unescape($text)
      if $is_cdata && $self->{_current_tag} eq "style" && $self->{allow_style};
    $self->SUPER::text( $text, $is_cdata );
}

sub output {

    my ( $self, $content ) = @_;

 view release on metacpan or  search on metacpan

lib/HTML/ExtractText.pm  view on Meta::CPAN

                $chunk =~ s/\s+$//;
                $chunk =~ s/\s+/ /g;
            }
        }
        # CDATA or raw text.
        elsif ( $type eq 'cdata' || $type eq 'raw' ) {
            $chunk = $node->[1];
        }
        # Nested tag.
        elsif ( $type eq 'tag' ) {
           no warnings 'recursion';

 view release on metacpan or  search on metacpan

lib/HTML/FormsDj.pm  view on Meta::CPAN

  return sprintf qq(<tr id="%s"><td class="%s tdlabel">%s</td><td class="%s tdinput">%s</td></tr>\n),
    $id, $class, $label, $class, $input;
}

sub _table {
  my($this, $id, $cdata, $legend) = @_;
  my $html = sprintf qq(<table id="%s">), $id;
  if ($legend) {
    $html .= sprintf qq(<thead><tr><td colspan="2">%s</td></tr></thead>\n), $legend;
  }
  $html .= sprintf qq(<tbody>%s</tbody></table>\n), $cdata;
  return $html;
}

sub _normalize_field {
  my($this, $field) = @_;

lib/HTML/FormsDj.pm  view on Meta::CPAN

  return;
}


sub _fieldset {
  my($this, $class, $id, $legend, $cdata) = @_;
  return sprintf qq(<fieldset class="%s" id="%s"><legend>%s</legend>\n%s\n</fieldset>\n),
    $class, $id, $legend, $cdata;
}

sub _p_field {
  my($this, $field) = @_;
  return $this->_p(

lib/HTML/FormsDj.pm  view on Meta::CPAN

		   $this->_message($field->{message}, $field->{id} . '_message')
		  );
}

sub _p {
  my ($this, $class, $id, $cdata) = @_;
  return sprintf qq(<p class="%s" id="%s">%s</p>\n), $class, $id, $cdata;
}

sub _label {
  my ($this, $id, $name) = @_;
  return sprintf qq(\n  <label for="%s">%s</label>), $id, $name;

lib/HTML/FormsDj.pm  view on Meta::CPAN

  }
  return $html;
}

sub _b {
  my($this, $cdata) = @_;
  return sprintf qq(<strong>%s</strong>), $cdata;
}

sub _gen_csrf_token {
  my($this) = @_;
  $this->{sha}->add(rand(10));

 view release on metacpan or  search on metacpan

lib/HTML/Gumbo.pm  view on Meta::CPAN

            my ($tag, $attrs) = @_;
        }
        elsif ( $event eq 'end' ) {
            my ($tag) = @_;
        }
        elsif ( $event eq /^(text|space|cdata|comment)$/ ) {
            my ($text) = @_;
        }
        else {
            die "Unknown event";
        }

 view release on metacpan or  search on metacpan

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

    } # LOOP

  ## END
} # _reset_insertion_mode

  my $parse_rcdata = sub ($$$$) {
    my ($self, $insert, $open_tables, $parse_refs) = @_;

    ## Step 1
    my $start_tag_name = $token->{tag_name};
    

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

    ## Step 3, 4
    $self->{insertion_mode} |= IN_CDATA_RCDATA_IM;

    
    $token = $self->_get_next_token;
  }; # $parse_rcdata

  my $script_start_tag = sub ($$$) {
    my ($self, $insert, $open_tables) = @_;
    
    ## Step 1

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

          } else {
            
          }

          ## NOTE: There is a "as if in head" code clone.
          $parse_rcdata->($self, $insert, $open_tables, 1); # RCDATA

          ## NOTE: At this point the stack of open elements contain
          ## the |head| element (index == -2) and the |script| element
          ## (index == -1).  In the "after head" insertion mode the
          ## |head| element is inserted only for the purpose of

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

            push @{$self->{open_elements}},
                [$self->{head_element}, $el_category->{head}];
          } else {
            
          }
          $parse_rcdata->($self, $insert, $open_tables, 0); # RAWTEXT
          splice @{$self->{open_elements}}, -2, 1, () # <head>
              if ($self->{insertion_mode} & IM_MASK) == AFTER_HEAD_IM;
          next B;
        } elsif ($token->{tag_name} eq 'noscript') {
              if ($self->{insertion_mode} == IN_HEAD_IM) {

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

          
          next B;
        } elsif ($token->{tag_name} eq 'style') {
          
          ## NOTE: This is a "as if in head" code clone.
          $parse_rcdata->($self, $insert, $open_tables, 0); # RAWTEXT
          $open_tables->[-1]->[2] = 0 if @$open_tables; # ~node inserted
          next B;
        } elsif ($token->{tag_name} eq 'script') {
          
          ## NOTE: This is a "as if in head" code clone.

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

          $token = $self->_get_next_token;
          next B;
        } elsif ($token->{tag_name} eq 'noframes') {
          
          ## NOTE: As if in head.
          $parse_rcdata->($self, $insert, $open_tables, 0); # RAWTEXT
          next B;

          ## NOTE: |<!DOCTYPE HTML><frameset></frameset></html><noframes></noframes>|
          ## has no parse error.
        } else {

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

        $script_start_tag->($self, $insert, $open_tables);
        next B;
      } elsif ($token->{tag_name} eq 'style') {
        
        ## NOTE: This is an "as if in head" code clone
        $parse_rcdata->($self, $insert, $open_tables, 0); # RAWTEXT
        next B;
      } elsif ({
         base => 1, command => 1, link => 1, basefont => 1, bgsound => 1,
       }->{$token->{tag_name}}) {
        

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

        $token = $self->_get_next_token;
        next B;
      } elsif ($token->{tag_name} eq 'title') {
        
        ## NOTE: This is an "as if in head" code clone
        $parse_rcdata->($self, $insert, $open_tables, 1); # RCDATA
        next B;
        
      } elsif ($token->{tag_name} eq 'body') {
        ## "In body" insertion mode, "body" start tag token.
        $self->{parse_error}->(level => $self->{level}->{must}, type => 'in body', text => 'body', token => $token);

lib/HTML/HTML5/Parser/TagSoupParser.pm  view on Meta::CPAN

          delete $self->{frameset_ok};
        } else {
          
        }
        ## NOTE: There is an "as if in body" code clone.
        $parse_rcdata->($self, $insert, $open_tables, 0); # RAWTEXT
        next B;
      } elsif ($token->{tag_name} eq 'isindex') {
        $self->{parse_error}->(level => $self->{level}->{must}, type => 'isindex', token => $token);
        
        if (defined $self->{form_element}) {