view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
abstract: make <> open files regardless of leading/trailing whitespace and/or control characters such as |, >, amd <.
license: ~
author:
- David Nicol <davidnico@cpan.org>
generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
view all matches for this distribution
view release on metacpan or search on metacpan
examples/generate_fid_hash.pl view on Meta::CPAN
#----------
my $sql = qq{select
f.fieldName,
f.fieldID,
decode(FOption, 1, 'Required ', 2, 'Optional ', 3, 'System RO', '*Unknown*'),
decode(datatype, 0, 'AR_DATA_TYPE_NULL', 1, 'AR_DATA_TYPE_KEYWORD', 2, 'AR_DATA_TYPE_INTEGER', 3, 'AR_DATA_TYPE_REAL', 4, 'AR_DATA_TYPE_CHAR', 5, 'AR_DATA_TYPE_DIARY', 6, 'AR_DATA_TYPE_ENUM', 7, 'AR_DATA_TYPE_TIME', 8, 'AR_DATA_TYPE_BITMASK', 9, 'AR_...
c.maxlength
from arschema a
join field f
on f.schemaid = a.schemaid and datatype < 30 and f.fieldID != 15
left outer join field_char c
on c.schemaid = f.schemaid and c.fieldid = f.fieldID
where a.name = '$form'
order by 1};
examples/generate_fid_hash.pl view on Meta::CPAN
# Construct the hash
my $fid_hash = "# Label/FID hash for form '$form'\n\%fid = (\n";
foreach my $row (@{ $m->{rows} })
{
$fid_hash .= sprintf(" '%s'%s=> %10d,\t\t# %s type=%s %d\n", $row->[0], ' ' x ($max_len + 1 - length($row->[0])), $row->[1], $row->[2], $row->[3], $row->[4]);
}
$fid_hash .= " );\n";
$CLIP->Set($fid_hash);
print "$fid_hash\nFormatted data copied to clipboard\n";
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ARSObject.pm view on Meta::CPAN
if (ref($s->{-schgen})
|| ($s->{-schgen} && ($s->{-schgen} >1))
|| (!-e $s->vfname('-meta'))
) {
#
# Data types:
# 'integer','real','char','enum','time','decimal'
# 'diary','attach','currency'
# 'trim','control','table','column','page','page_holder'
#
my ($vfs, $vfu);
lib/ARSObject.pm view on Meta::CPAN
my $st =$s->dbi()->column_info('',$sch||$s->{-sqlschema}||'', $tbl||'','%');
@{$st->fetchall_arrayref({})}
}
sub dbitypespc { # DBI column type spec
my ($s, $d) =@_;
($d->{'TYPE_NAME'} ||'unknown')
.($d->{'COLUMN_SIZE'}
? ' (' .join(',', map {defined($d->{$_}) ? $d->{$_} : ()
} 'COLUMN_SIZE', 'DECIMAL_DIGITS') .')'
lib/ARSObject.pm view on Meta::CPAN
elsif (!$dbt->{$tbl}) {
push @sql, 'CREATE TABLE ' .join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $tbl)
." (\n"
.join("\n, "
, map { $s->{'-meta-sql'}->{$tbl}->{-cols}->{$_}->{'TYPE_NAME'}
? '"' .$_ .'" ' .$s->dbitypespc($s->{'-meta-sql'}->{$tbl}->{-cols}->{$_})
.(($s->{'-meta-sql'}->{$tbl}->{-cols}->{$_}->{fieldId}||'') eq '1'
? " PRIMARY KEY"
: $s->{'-meta-sql'}->{$tbl}->{-cols}->{$_}->{IS_PK}
? " UNIQUE"
: '')
lib/ARSObject.pm view on Meta::CPAN
foreach my $col (sort keys %{$s->{'-meta-sql'}->{$tbl}->{-cols}}) {
my $cl =lc($col);
my $cm =$s->{'-meta-sql'}->{$tbl}->{-cols}->{$col};
next if !$cm->{'TYPE_NAME'};
if (!$dbc->{$cl}) {
push @addc, '"' .$col .'" ' .$s->dbitypespc($cm)
}
elsif (($dbc->{$cl}->{'TYPE_NAME'} ne $cm->{'TYPE_NAME'})
|| ($cm->{'TYPE_NAME'} ne 'datetime'
? (($dbc->{$cl}->{'COLUMN_SIZE'}||0) < ($cm->{'COLUMN_SIZE'}||0))
|| (($dbc->{$cl}->{'DECIMAL_DIGITS'}||0) ne ($cm->{'DECIMAL_DIGITS'}||0))
: 0 )
) {
push @altc, '"' .$col .'" ' .$s->dbitypespc($cm)
}
else {
$cm->{COLUMN_SIZE_DB} =$dbc->{$cl}->{'COLUMN_SIZE'}
if ($cm->{COLUMN_SIZE_DB}||0) ne ($dbc->{$cl}->{'COLUMN_SIZE'}||0);
$cm->{DECIMAL_DIGITS_DB} =$dbc->{$cl}->{'DECIMAL_DIGITS'}
lib/ARSObject.pm view on Meta::CPAN
sub cgiselect { # CGI selection field composition
# -onchange=>1 reloads form
my ($s, %a) =@_;
my $cs =$a{-onchange} && (length($a{-onchange}) ==1);
($cs
? '<input type="hidden" name="' .$a{-name} .'__C_" value="" />'
: '')
.$s->{-cgi}->popup_menu(%a
, $a{-labels} && !$a{-values}
? (-values => do{use locale; [sort {$a{-labels}->{$a} cmp $a{-labels}->{$b}} keys %{$a{-labels}}]})
: ()
lib/ARSObject.pm view on Meta::CPAN
, ($a{-strict} && !$s->{-cgi}->param("${n}__O_")
? (-readonly=>1) # ,-hidefocus=>0, -disabled=>0
: ())
)
.($s->{-cgi}->param("${n}__O_")
? ("<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
."<input type=\"hidden\" name=\"${n}__P_\" value=\"" .(defined($v) ? $s->{-cgi}->escapeHTML($v) : '') ."\"$ac$as />\n"
."<br />\n"
."<select name=\"${n}__L_\" title=\"select value\" size=\"10\""
."$ac$as"
." ondblclick=\"{${n}__S_.focus(); ${n}__S_.click(); return(true)}\""
." onkeypress=\"" .($s->{-cgi}->user_agent('MSIE') ? &$fs(1) : &$fs(2))
lib/ARSObject.pm view on Meta::CPAN
: defined($a{-labels}->{$_})
? (length($a{-labels}->{$_}) > $aw ? substr($a{-labels}->{$_},0,$aw) .'...' : $a{-labels}->{$_})
: '') ."</option>\n"
} @{&$av()})
."</select>\n"
."<input type=\"submit\" name=\"${n}__S_\" value=\"<\" title=\"set\"$ac$as />"
.$s->{-cgi}->button(-value=>'...', -title=>'find', -onClick=>&$fs(3))
."<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
."</div>\n"
."<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__L_.focus()}</script>"
)
: ("<input type=\"submit\" name=\"${n}__O_\" value=\"...\" title=\"open\"$ac$as />"
.($s->{-cgi}->param("${n}__C_") ||$s->{-cgi}->param("${n}__X_")
? "<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__O_.focus()}</script>"
: ''
))
)
lib/ARSObject.pm view on Meta::CPAN
next if !defined($a{$k});
my $n =$k =~/^-(.+)/ ? ucfirst($1) .':' : $k;
$a{-data} .=$n .' ' .$a{$k} ."\cM\cJ";
}
$a{-data} .="MIME-Version: 1.0\cM\cJ";
$a{-data} .='Content-type: ' .($a{-html} ? 'text/html' : 'text/plain')
.'; charset=' .($a{-charset}||$s->charset())
."\cM\cJ";
$a{-data} .='Content-Transfer-Encoding: ' .($a{-encoding} ||'8bit') ."\cM\cJ";
$a{-data} .="\cM\cJ";
$a{-data} .=$a{-html} ||$a{-text} ||'';
lib/ARSObject.pm view on Meta::CPAN
next if exists($f->{-widget}) && !defined($f->{-widget});
next if !$f->{-namecgi};
my $u =cfpused($s, $f);
next if $u && !($f->{-hidden} ||((ref($f->{-values}) eq 'ARRAY') && !scalar(@{$f->{-values}})));
print defined(cfpvp($s, $f))
? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="'
.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
.'" />' ."\n"
: ''
, !$u
? ( defined($s->{-cgi}->param($f->{-namecgi}))
? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
.$s->{-cgi}->escapeHTML($s->{-cgi}->param($f->{-namecgi}))
.'" />' ."\n"
: '')
: defined(cfpvv($s, $f))
? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
.$s->{-cgi}->escapeHTML(cfpvv($s, $f))
.'" />' ."\n"
: '';
}
print ref($cfld0) ? &{$cfld0}($s) : $cfld0;
lib/ARSObject.pm view on Meta::CPAN
? ''
: ref($f->{-widget0}) eq 'CODE'
? &{$f->{-widget0}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
: $f->{-widget0})
. (!($f->{-action} || $f->{-preact}) && $f->{-namecgi} && defined(cfpvp($s, $f))
? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="'
.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
.'" />'
: ''
)
. (!ref($f->{-widget}) && exists($f->{-widget})
view all matches for this distribution
view release on metacpan or search on metacpan
ARS/OOform.pm view on Meta::CPAN
my $fv = ARS::ars_GetField($self->{'connection'}->{'ctrl'},
$self->{'form'},
$f{$_});
$connection->tryCatch();
$t{$_} = $fv->{'dataType'};
print "\tdatatype: $t{$_}\n" if $self->{'connection'}->{'.debug'};
if ($fv->{'dataType'} eq "enum") {
if (ref($fv->{'limit'}->{'enumLimits'}) eq "ARRAY") {
my $i = 0;
$enums{$_} = { map { $i++, $_ } @{$fv->{'limit'}->{'enumLimits'}} };
ARS/OOform.pm view on Meta::CPAN
$enums{$_} = { map { $_->{itemNumber}, $_->{itemName} } @{$fv->{'limit'}->{'enumLimits'}->{customList}} };
}
}
}
$self->{'fieldtypes'} = \%t;
$self->{'fieldEnumValues'} = \%enums;
return $b;
}
sub DESTROY {
ARS/OOform.pm view on Meta::CPAN
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->getFieldType(-field => name, -id => id)\none of the parameters must be specified.");
}
if(defined($name) && !defined($this->{'fieldtypes'}->{$name})) {
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81001,
"field '$name' not in view: ".$this->{'vui'}."\n"
);
}
#print "getFieldType($name, $id)\n" if $this->{'connection'}->{'.debug'};
return $this->{'fieldtypes'}->{$name} if defined($name);
# they didnt give us a name, but instead gave us an id. look up the
# name and return the type.
if(defined($id)) {
my $n = $this->getFieldName(-id => $id);
return $this->{'fieldtypes'}->{$n};
}
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81003,
"couldn't determine dataType for field.");
ARS/OOform.pm view on Meta::CPAN
$_);
$this->{'connection'}->tryCatch();
}
}
# merge(-type => mergeType, -values => { field1 => value1, ... })
sub merge {
my ($this) = shift;
my ($type, $vals) =
ARS::rearrange([TYPE,[VALUE,VALUES]],@_);
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->merge(-type => mergeType, -values => { field1 => value1, ... })\ntype and values parameters are required.")
unless(defined($type) && defined($vals));
$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
81000,
"usage: form->merge(-type => mergeType, -values => { field1 => value1, ... })\nvalues parameter must be HASH ref.")
unless ref($vals) eq "HASH";
my (%realmap);
# as we work thru each value, we need to perform translations for
ARS/OOform.pm view on Meta::CPAN
-value => $vals->{$_});
#print "[form->merge] realval for $_ = $rv\n";
$realmap{$this->getFieldID($_)} = $rv;
}
print "merge/type=$type\n" if $this->{'connection'}->{'.debug'};
my ($rv) = ARS::ars_MergeEntry($this->{'connection'}->{'ctrl'},
$this->{'form'},
$type,
%realmap);
$this->{'connection'}->tryCatch();
ARS/OOform.pm view on Meta::CPAN
unless (defined($f));
return $v unless defined $v;
my ($t) = $this->getFieldType($f);
print "value2internal($f, $v) type=$t\n"
if $this->{'connection'}->{'.debug'};
# translate an text value into an enumeration number if this
# field is an enumeration field and we havent been passed a number
# to begin with.
ARS/OOform.pm view on Meta::CPAN
$f = $this->getFieldName(-id => $id) unless defined($f);
my ($t) = $this->getFieldType($f);
print "internal2value($f, $v) type=$t\n"
if $this->{'connection'}->{'.debug'};
# translate an enumeration value into a text value
if($t eq "enum") {
ARS/OOform.pm view on Meta::CPAN
push @fieldlist, $this->getFieldID($_);
}
}
# what we want to do is: retrieve all of the values, but for
# certain datatypes (attachments) we want to insert
# an object instead of the field value. for enum types,
# we want to decode the value.
#print "("; print $this->{'form'}; print ", $eid, @fieldlist)\n";
my @v;
view all matches for this distribution
view release on metacpan or search on metacpan
applications/archive.pl view on Meta::CPAN
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub checkTableDBI {
my ($dbh, $database, $table, $op, $msg_type, $msg_text) = @_;
print "-> <$database.$table>, <$op>, <$msg_type>, <$msg_text>\n" if ($debug);
my ($Table, $Op, $Msg_type, $Msg_text) = '';
my $rv = 1;
my $sql = "check table $table";
my $sth = $dbh->prepare($sql) or $rv = errorTrapDBI("dbh->prepare: $sql", $debug);
$rv = $sth->execute() or $rv = errorTrapDBI("sth->execute: $sql", $debug) if $rv;
if ( $rv ) {
while (my $ref = $sth->fetchrow_hashref()) {
$Table = $ref->{Table};
$Op = $ref->{Op};
$Msg_type = $ref->{Msg_type};
$Msg_text = $ref->{Msg_text};
print "<- <$Table>, <$Op>, <$Msg_type>, <$Msg_text>\n" if ($debug);
}
$sth->finish() or $rv = errorTrapDBI("sth->finish", $debug);
$rv = ($rv and "$database.$table" eq $Table and $op eq $Op and $msg_type eq $Msg_type and $msg_text eq $Msg_text) ? 1 : 0;
}
return ($rv);
}
view all matches for this distribution
view release on metacpan or search on metacpan
=head2 warn LIST
C<warn> (or more specifically, the __WARN__ signal) has been re-routed to
output to the browser.
FYI: When implemented, this tweak led to the removal of the prototypes
Matt placed on his subs.
=head2 Warn LIST
C<Warn> is an alias for the ASP::Print method described below. The
Optimized and debugged.
=item Version 0.77
Overloaded warn() and subsequently removed prototypes.
Exported $ScriptingNamespace object.
Added methods escape(), unescape(), escapeHTML(), unescapeHTML().
Thanks to Bill Odom for pointing these out!
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
inc/Module/Install/Metadata.pm view on Meta::CPAN
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
inc/Module/Install/Metadata.pm view on Meta::CPAN
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
inc/Module/Install/Metadata.pm view on Meta::CPAN
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
inc/Module/Install/Metadata.pm view on Meta::CPAN
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
inc/Module/Install/Metadata.pm view on Meta::CPAN
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
image_width => '90',
image_border => '0',
image_wrap => ' ',
href_target => ' target="_blank"',
images_url => '',
html_type => ' /',
fix_amp => 1,
line_break => '1',
code_class => '',
code_extra => '',
code_download => '^Download above code^',
sub settings_prep {
$AUBBC{href_target} = $AUBBC{href_target} ? ' target="_blank"' : '';
$AUBBC{image_wrap} = $AUBBC{image_wrap} ? ' ' : '';
$AUBBC{image_border} = $AUBBC{image_border} ? '1' : '0';
$AUBBC{html_type} = $AUBBC{html_type} eq 'xhtml' || $AUBBC{html_type} eq ' /' ? ' /' : '';
}
sub settings {
my ($self,%s_hash) = @_;
foreach (keys %s_hash) {
$txt =~ s/\000[/[[/g;
$txt =~ s/\000]/]]/g;
$txt =~ s/\{/{/g;
$txt =~ s/\}/}/g;
$txt =~ s/%/%/g;
$txt =~ s/(?<!>)\n/<br$AUBBC{html_type}>\n/g;
if ($AUBBC{highlight}) {
warn 'ENTER block highlight' if $DEBUG_AUBBC;
$txt =~ s/\z/<br$AUBBC{html_type}>/ if $txt !~ m/<br$AUBBC{html_type}>\z/;
$txt =~ s/(<<(?:')?(\w+)(?:')?;(?s)[^\2]+\b\2\b)/<span$AUBBC{highlight_class1}>$1<\/span>/g;
$txt =~ s/(?<![\&\$])(\#.*?(?:<br$AUBBC{html_type}>))/<span$AUBBC{highlight_class2}>$1<\/span>/g;
$txt =~ s/(\bsub\b(?:\s+))(\w+)/$1<span$AUBBC{highlight_class8}>$2<\/span>/g;
$txt =~ s/(\w+(?:\->)?(?:\w+)?((?:.+?)?)(?:;)?)/<span$AUBBC{highlight_class9}>$1<\/span>/g;
$txt =~ s/((?:&)\w+;)/<span$AUBBC{highlight_class9}>$1<\/span>/g;
$txt =~ s/('(?s).*?(?<!\)')/<span$AUBBC{highlight_class3}>$1<\/span>/g;
$txt =~ s/("(?s).*?(?<!\)")/<span$AUBBC{highlight_class4}>$1<\/span>/g;
}
sub code_tag {
my ($code,$name) = @_;
if (check_access('code')) {
$name = "# $name:<br$AUBBC{html_type}>\n" if $name;
return "$name<div$AUBBC{code_class}".&code_download."><code>\n".
$AUBBC{highlight_function}->($code).
"\n</code></div>".$AUBBC{code_extra}.$do_f[9];
}
else {
sub make_image {
my ($align,$src,$width,$height,$alt) = @_;
my $img = "<img$align src=\"$src\"";
$img .= " width=\"$width\"" if $width;
$img .= " height=\"$height\"" if $height;
return $img." alt=\"$alt\" border=\"$AUBBC{image_border}\"$AUBBC{html_type}>";
}
sub make_link {
my ($link,$name,$javas,$targ) = @_;
my $linkd = "<a href=\"$link\"";
: $msg =~ s/\[email\]([\w\.\-\&\+]+\@[\w\.\-]+)\[\/email\]/link_check("mailto:$1",$1,'','')/ge;
$msg =~ s/\[color=([\w#]+)\](?s)(.+?)\[\/color\]/<span style="color:$1;">$2<\/span>/g;
1 while $msg =~
s/\[quote=([\w\s]+)\](?s)(.+?)\[\/quote\]/<div$AUBBC{quote_class}><small><strong>$1:<\/strong><\/small><br$AUBBC{html_type}>
$2<\/div>$AUBBC{quote_extra}/g;
1 while $msg =~
s/\[quote\](?s)(.+?)\[\/quote\]/<div$AUBBC{quote_class}>$1<\/div>$AUBBC{quote_extra}/g;
$msg =~ s/\[(left|right|center)\](?s)(.+?)\[\/\1\]/<div style=\"text-align: $1;\">$2<\/div>/g;
$msg =~ s/\[li=(\d+)\](?s)(.+?)\[\/li\]/<li value="$1">$2<\/li>/g;
$msg =~ s/\[u\](?s)(.+?)\[\/u\]/<span style="text-decoration: underline;">$1<\/span>/g;
$msg =~ s/\[strike\](?s)(.+?)\[\/strike\]/<span style="text-decoration: line-through;">$1<\/span>/g;
$msg =~ s/\[([bh]r)\]/<$1$AUBBC{html_type}>/g;
$msg =~ s/\[list\](?s)(.+?)\[\/list\]/fix_list($1)/ge;
1 while $msg =~
s/\[(blockquote|big|h[123456]|[ou]l|li|em|pre|s(?:mall|trong|u[bp])|[bip])\](?s)(.+?)\[\/\1\]/<$1>$2<\/$1>/g;
}
sub fix_list {
my $list = shift;
if ($list =~ m/\[\*/) {
$list =~ s/<br$AUBBC{html_type}>//g;
my $type = 'ul';
$type = 'ol' if $list =~ s/\[\*=(\d+)\]/\[\*\]$1\|/g;
my @clean = split('\[\*\]', $list);
$list = "<$type>\n";
foreach (@clean) {
if ($_ && $_ =~ s/\A(\d+)\|(?s)(.+?)/$2/) {
$list .= "<li value=\"$1\">$_<\/li>\n" if $_ !~ m/\A\r?\n?\z/;
} elsif ($_ && $_ !~ m/\A\s+|\d+\|\r?\n?\z/) {
$list .= "<li>$_<\/li>\n";
}
}
$list .= "<\/$type>";
}
return $list;
}
sub fix_image {
}
sub js_print {
my $self = shift;
print <<JS;
Content-type: text/javascript
/*
AUBBC v$VERSION
JS
print <<'JS';
Fully supports dynamic view in XHTML.
*/
function MyEmCode (type, content) {
var returner = false;
if (type == 4) {
var farray= new Array(content.length,1);
for(farray[1];farray[1]<farray[0];farray[1]++) { returner+=String.fromCharCode(content[farray[1]].charCodeAt(0)^content[farray[1]-1]);farray[1]++; }
} else if (type == 3) {
for (i = 0; i < content.length; i++) { returner+=String.fromCharCode(content[i]); }
} else if (type == 2) { returner=content; }
if (returner) { window.location='mailto:'+returner; }
}
function MyCodePrint (input) {
if (input && document.getElementById(input)) {
my ($self,%NewTag) = @_;
warn 'ENTER add_build_tag' if $DEBUG_AUBBC;
$NewTag{function2} = $NewTag{function} || 'undefined!';
$NewTag{function} = check_subroutine($NewTag{function},'')
if $NewTag{type} ne '4';
$self->aubbc_error("Usage: add_build_tag - function 'Undefined subroutine' => $NewTag{function2}")
if ! $NewTag{function};
if ($NewTag{function}) {
$NewTag{pattern} = 'l' if $NewTag{type} eq '3' || $NewTag{type} eq '4';
if ($NewTag{type} && $NewTag{name} =~ m/\A[\w\-]+\z/ && $NewTag{pattern} =~ m/\A[lns_:\-,]+|all\z/) {
if ($NewTag{pattern} eq 'all') {
$NewTag{pattern} = '^\[|\]';
}
else {
@pat_split = split /\,/, $NewTag{pattern};
$NewTag{pattern} = '';
$NewTag{pattern} .= $is_pat{$_} || '' foreach @pat_split;
}
$Build_AUBBC{$NewTag{name}} = [$NewTag{pattern}, $NewTag{type}, $NewTag{function}];
$NewTag{level} ||= 0;
$NewTag{error} ||= $BAD_MESSAGE;
$Tag_SecLVL{$NewTag{name}} = {level => $NewTag{level}, text => $NewTag{error},};
$do_f[5] = 1 if !$do_f[5];
warn 'Added Build_AUBBC Tag '.$Build_AUBBC{$NewTag{name}} if $DEBUG_AUBBC && $Build_AUBBC{$NewTag{name}};
}
}
}
sub remove_build_tag {
my ($self,$name,$type) = @_;
warn 'ENTER remove_build_tag' if $DEBUG_AUBBC;
delete $Build_AUBBC{$name} if exists $Build_AUBBC{$name} && !$type; # clear one
%Build_AUBBC = () if $type && !$name; # clear all
}
sub do_unicode{
warn 'ENTER do_unicode' if $DEBUG_AUBBC;
$msg =~ s/\[utf:\/\/(\#?\w+)\]/&$1;/g;
$text =~ s/\)/)/g;
$text =~ s/\(/(/g;
$text =~ s/\\/\/g;
$text =~ s/\|/|/g;
! $option && $AUBBC{line_break} eq '2'
? $text =~ s/\n/<br$AUBBC{html_type}>/g
: $text =~ s/\n/<br$AUBBC{html_type}>\n/g if !$option && $AUBBC{line_break} eq '1';
return $text;
}
}
sub html_to_text {
http://aubbc.googlecode.com/
Development Notes: Highlighting functions list and tags/commands for more
language highlighters. Ideas make some new tags like [perl] or have a command in the code
tag like [code]perl:print 'perl';[/code] with a default highlighting method if
a command was not used. Then highlighting of many types of code could be allowed
even markup like HTML.
Notes: This code has a lot of settings and works good
with most default settings see the POD and example files
in the archive for usage.
Most sites that use these tags show a list of them and/or easy way to insert the tags to the form field by the user.
The [c] or code tags can highlight Perl code, highlighting the Perl code with CSS in HTML/XHTML,
and in the examples folder the tag_list.cgi file has a CSS code you could work from and now a setting to change to a costume highlighter function.
This module addresses many security issues the BBcode tags may have mainly cross site script also known as XSS.
Each message is escaped before it gets returned if script_escape is Enabled and checked for many types of security problems before that tag converts to HTML/XHTML.
The script_escape setting and method also converts the ' sign so the text can be stored in a SQL back-end.
Most of the free web portals use the | sign as the delimiter for the flat file database, the script_escape setting and method also converts that sign so the structure of the database is retained.
Allows easy conversion to HTML and XHTML, existing tags will convert to the HTML type set.
If there isn't a popular tag available this module provides a method to "Build your own tags" custom tags can help link to parts of the current web page, other web pages and add other HTML elements.
=cut
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AVLTree.pm view on Meta::CPAN
Description : Creates a new AVL tree object.
The objects hold by the tree are implicitly defined
by the provided callback.
Returntype : AVLTreePtr or undef if unable to instantiate
Exceptions : None
Caller : General
Status : Unstable, interface might change to accomodate suitable defaults,
e.g. numbers
lib/AVLTree.pm view on Meta::CPAN
printf "Item with id %d found\nData: %s\n", $id, $result->{data};
} else { print "Item with id $id not found\n"; }
Description : Query if an item exists in the tree.
Returntype : The item, if found, as stored in the tree or undef
if the item was not found or the query was not provided
or it was undefined.
Exceptions : None
Caller : General
Status : Unstable
lib/AVLTree.pm view on Meta::CPAN
croak "Unable to insert 10" unless $ok;
Description : Insert an item in the tree, use the provided, upon tree construction,
comparison function to determine the position of the item in the tree
Returntype : Bool, true if the item was successfully installed, false otherwise
Exceptions : None
Caller : General
Status : Unstable
=head2 C<remove>
lib/AVLTree.pm view on Meta::CPAN
Example : my $ok = $tree->remove({ id => 10 });
croak "Unable to remove 10" unless $ok;
Description : Remove an item from the tree.
Returntype : Bool, true if the item was successfully installed, false otherwise
Exceptions : None
Caller : General
Status : Unstable
=head2 C<size>
lib/AVLTree.pm view on Meta::CPAN
Example : print "Size of the tree is: %d\n", $tree->size();
Description : Returns the size of the tree (number of nodes)
Returntype : Int, the size of the tree
Exceptions : None
Caller : General
Status : Unstable
lib/AVLTree.pm view on Meta::CPAN
Example : my $item = $tree->first;
Description : Returns the first element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
lib/AVLTree.pm view on Meta::CPAN
Example : my $item = $tree->last;
Description : Returns the last element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
lib/AVLTree.pm view on Meta::CPAN
print $item, "\n";
while($item = $tree->next) { print $item, "\n"; }
Description : Returns the next element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
lib/AVLTree.pm view on Meta::CPAN
print $item, "\n";
while($item = $tree->prev) { print $item, "\n"; }
Description : Returns the previous element as specified by the order defined by the tree.
Returntype : The item, if found, as stored in the tree or undef
if the tree is empty.
Exceptions : None
Caller : General
Status : Unstable
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/ARN.pm view on Meta::CPAN
=head2 resource_id
The resource identifier. This part of the ARN can be the name or ID of the resource or a resource path.
For example, user/Bob for an IAM user or instance/i-1234567890abcdef0 for an EC2 instance. Some resource
identifiers include a parent resource (sub-resource-type/parent-resource/sub-resource) or a qualifier such
as a version (resource-type:resource-name:qualifier).
=head1 NOTES
=over
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/CLIWrapper.pm view on Meta::CPAN
my @v;
$k =~ s/_/-/g;
$k = '--'.$k;
my $type = ref $v;
if (! $type) {
if ($k eq '--output-file') {
# aws s3api get-object takes a single arg for output file path
return $v;
} else {
push @v, $v;
}
} elsif ($type eq 'ARRAY') {
push @v, map { ref($_) ? encode_json(_compat_kv($_)) : $_ } @$v;
} elsif ($type eq 'HASH') {
push @v, encode_json(_compat_kv($v));
} elsif ($type eq 'AWS::CLIWrapper::Boolean') {
if ($$v == 1) {
return ($k);
} else {
return ();
}
lib/AWS/CLIWrapper.pm view on Meta::CPAN
# >= 0.14.0 : Key, Values, Value, Name
# < 0.14.0 : key, values, value, name
sub _compat_kv_uc {
my $v = shift;
my $type = ref $v;
if ($type && $type eq 'HASH') {
for my $hk (keys %$v) {
if ($hk =~ /^(?:key|name|values|value)$/) {
$v->{ucfirst($hk)} = delete $v->{$hk};
}
}
lib/AWS/CLIWrapper.pm view on Meta::CPAN
return $v;
}
# sub _compat_kv_lc {
# my $v = shift;
# my $type = ref $v;
# if ($type && $type eq 'HASH') {
# for my $hk (keys %$v) {
# if ($hk =~ /^(?:Key|Name|Values|Values)$/) {
# $v->{lc($hk)} = delete $v->{$hk};
# }
# }
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Metadata.pm view on Meta::CPAN
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
inc/Module/Install/Metadata.pm view on Meta::CPAN
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/Lambda/Quick.pm view on Meta::CPAN
Each Lambda function we create gets its own method, which is where
AWS specifies what HTTP method it accepts (C<GET>,C<POST>,C<PUT>,
etc.) and how it decides who can access it.
This module always sets the type of method to C<ANY> (i.e. we always
call the lambda function and let it figure out what it wants to accept
or not.)
We setup the C<NONE> authentication, meaning anyone can call the API
over the internet - i.e. it's configured as a public API.
view all matches for this distribution
view release on metacpan or search on metacpan
author/perl-stripper/perl-stripper/handler.pl view on Meta::CPAN
my $code = do { local $/; my $body = $req->body; <$body> };
my $stripped = $stripper->strip($code);
my $res = $req->new_response(200);
$res->content_type('text/plain');
$res->body($stripped);
return $res->finalize;
};
my $func = AWS::Lambda::PSGI->wrap($app);
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AWS/S3.pm view on Meta::CPAN
isa => 'Bool',
default => sub { 0 },
);
sub request {
my ( $s, $type, %args ) = @_;
my $class = "AWS::S3::Request::$type";
load_class( $class );
return $class->new( %args, s3 => $s, type => $type );
} # end request()
sub owner {
my $s = shift;
my $type = 'ListAllMyBuckets';
my $request = $s->request( $type );
my $response = $request->request();
# Linode/Akamai E3 endpoints do not include the `xmlns` in
# ListAllMyBuckets, so use the localname to work with or
# without a declared XML namespace.
lib/AWS/S3.pm view on Meta::CPAN
} # end owner()
sub buckets {
my ( $s ) = @_;
my $type = 'ListAllMyBuckets';
my $request = $s->request( $type );
my $response = $request->request();
# Linode/Akamai E3 endpoints do not include the `xmlns` in
# ListAllMyBuckets, so use the localname to work with or
# without a declared XML namespace.
lib/AWS/S3.pm view on Meta::CPAN
} # end bucket()
sub add_bucket {
my ( $s, %args ) = @_;
my $type = 'CreateBucket';
my $request = $s->request(
$type,
bucket => $args{name},
(
$args{location} ? ( location => $args{location} )
: $s->region ? ( location => $s->region )
: ()
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution
view release on metacpan or search on metacpan
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"type" : "git",
"url" : "git://github.com/sankita11/AWS-SQS-Simple.git",
"web" : "https://github.com/sankita11/AWS-SQS-Simple"
}
},
"version" : "0.02"
view all matches for this distribution
view release on metacpan or search on metacpan
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
view all matches for this distribution