Result:
found more than 109 distributions - search limited to the first 2001 files matching your query
( run in 0.841 )
A1z-HTML5-Template
view release on metacpan or search on metacpan
lib/A1z/HTML5/Template.pm view on Meta::CPAN
);
sub new {
my $class = shift;
my $self = bless { @_ }, $class;
return $self;
}
sub math1
{
my $self = shift;
my ($num1, $num2) = @_;
if ($num1 eq '') { $num1 = '2'; }
if ($num2 eq '') { $num2 = '4'; }
my $out;
my $m = $num1 * $num2;
my $a = $num1 + $num2;
my $s = $num1 - $num2;
my $s1 = $num2 - $num1;
my $d = $num1 / $num2;
my $d1 = $num2 / $num1;
$out .= qq{<div class="math">
<table class="table table-responsive table-bordered table-condensed table-hover">
<thead><tr><td colspan="6">Multiplication</td></tr></thead>
<tr>
<td></td>
<td>$num1</td>
<td>x</td>
<td>$num2</td>
<td>\=</td>
<td>$m</td>
</tr>
<thead><tr><td colspan="6">Addition</td></tr></thead>
<tr> <td></td> <td>$num1 </td> <td>\+</td> <td> $num2</td> <td> \=</td> <td> $a</td> </tr>
<thead><tr><td colspan="6">Subtraction</td></tr></thead>
<tr> <td></td> <td>$num1</td> <td> \-</td> <td> $num2</td> <td> \=</td> <td> $s</td> </tr>
<tr> <td></td> <td>$num2</td> <td> \-</td> <td> $num1</td> <td> \=</td> <td> $s1</td> </tr>
<thead><tr><td colspan="6">Division</td></tr></thead>
<tr> <td></td> <td>$num1</td> <td> \/</td> <td> $num2</td> <td> \=</td> <td> $d </td></tr>
<tr> <td></td> <td>$num2</td> <td> \/</td> <td> $num1</td> <td> \=</td> <td> $d1</td> </tr>
</table>
</div>
};
return qq{\n$out\n};
}
# begin timestable
sub timestable
{
my $self = shift;
my ($num1) = @_;
if ( $num1 eq '' ) { $num1 = '2'; }
my $out;
$out .= qq{<table class="table table-bordered table-condensed table-striped table-hover table-responsive">};
for ('1'..'20')
{
$out .= qq{<tr> <td>$num1</td> <td>x</td> <td>$_</td> <td>=</td> <td>} . $num1 * $_ . qq{</td></tr>} if ($_);
}
$out .= qq{</table>};
return $out;
}
# end timestable
# begin header
sub header
{
my $self = shift;
my @keys;
if (@_) { @keys = @_; }
my $args = scalar(@keys);
my ($key, $key1) = @_;
my %out;
if ($ARGV and $ARGV > 0 and scalar(@keys) > 0)
{
if ($key eq 'utf8')
{
$out{"$key"} = qq{Content-Type: text/html;charset=utf-8\n\n};
}
elsif (!defined $key or $key eq '')
{
$out{"$key"} = qq{Content-Type: text/html;charset=utf-8\n\n};
}
else
{
$out{"$key"} = qq{Content-Type: text/html;charset=utf-8\n\n};
}
}
else
{
return qq{Content-Type: text/html;charset=utf-8\n\n};
}
}
# end header
# begin start html 01
sub start_html
{
my $self = shift;
my @keys;
if (@_) { @keys = @_; }
my $args = scalar @keys;
my ($key, $key1) = @_;
my %out;
if ($args and $args >= 0)
{
# have your own custom header, backwards compatibility
my $out;
$out .= qq{@_ };
return $out;
}
else
{
my $out;
$out .= qq{<!DOCTYPE html>\n<html>\n};
$out .= qq{<head>\n};
return $out;
}
}
# end start_html
sub body_js_css
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $args = scalar (@keys);
my $out;
$out .= qq^
<!--jquery-->
<script src="https://code.jquery.com/jquery-1.12.4.min.js"></script>
<!--bootstrap/jQueryUI-->
<script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.0/js/bootstrap.min.js"></script>
<script src="https://code.jquery.com/ui/1.11.4/jquery-ui.min.js"></script>
<!-- IE10 viewport hack for Surface/desktop Windows 8 bug -->
<script src="https://www.a1z.us/jquery/bootstrap/fixed-top/ie10-viewport-bug-workaround.js"></script>
<script>
// for tabs
\$( function() {
var tabs = \$("#tabs").tabs();
tabs.find( ".ui-tabs-nav" ).sortable({
axis: "x",
stop: function() { tabs.tabs( "refresh" ); }
});
});
// dialog
\$( function() {
\$( "#dialog" ).dialog({
autoOpen: false,
show: {
effect: "blind",
duration: 1000
},
hide: {
effect: "explode",
duration: 1000
}
});
\$( "#opener" ).click(function() {
\$( "#dialog" ).dialog( "open" );
});
});
\$('#menu').menu();
\$('#accordion').accordion();
\$('#accordion1').accordion();
\$('#accordion2').accordion();
\$('#accordion3').accordion();
\$('#tabs').tabs();
</script>
^;
if ( $args )
{
if ( $args >= 0)
{
my $return;
for (@keys )
{
chomp;
if ($_ =~ /.js$/)
{
$return .= qq{<script src="$_"></script>\n};
}
elsif ($_ =~ /.css$/)
{
$return .= qq{<link href="$_" rel="stylesheet" style="text/css">\n};
}
else
{
# do nothing
}
}
return qq{$return}; #
}
else
{
return qq{$out};
}
}
else
{
return qq{<!--229 noParams-->$out}; #
}
}
# start end_html
sub end_html
{
my $self = shift;
my @keys;
if (@_) { @keys = @_; }
my ($key, $key1) = @_;
my $out;
$out .= qq{</html>\n\n};
if ($ARGV and $ARGV > 0 or scalar(@keys) > 0)
{
return qq{@_};
}
else
{
return $out;
}
}
# end end_html
# start head title 02
sub head_title
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $out;
$out .= qq{};
if ($ARGV and $ARGV > 0 or scalar(@keys) > 0)
{
if ($key)
{
return qq{<title>@_</title>\n};
}
else
{
return qq{<title>Template</title>\n};
}
}
else
{
return qq{<title>Package Html5</title>\n}; # this works but does not ask the user
}
}
# end head title
# begin head meta 03
sub head_meta
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $args = scalar @keys;
my $out;
$out .= qq{<meta charset="utf-8">
<meta lang="en">
<meta http-equiv="X-UA-Compatible" content="IE=edge">
<meta name="HandheldFriendly" content="true">
<meta name="viewport" content="width=device-width, initial-scale=1">
};
if ($args)
{
if ($args >= 0)
{
my $return;
for (@keys )
{
chomp;
my ( $meta_name, $meta_cont) = split(/---/, $_, 2);
$return .= qq{<meta name="$meta_name" content="$meta_cont">\n};
}
return qq{$return<!--360-->};
}
else
{
$out .= qq{<meta name="description" content="HTML5 by Business Impact Solutions - bislinks.com"/><!--364-->};
# add default meta if user has not called one of his own
return qq{$out};
}
}
else
{
return qq{$out}; # this works but does not ask the user
}
}
# end head meta 03
# begin body top nav bar
sub body_topnavbar
{
my $self = shift;
my %in;
%in = (
file => "https://www.a1z.us/js/utils/top-nav-bar.js",
name => "Menu",
@_,
);
my $out;
$out .= qq{<!--top nav bar begin-->
<script src="$in{file}"></script>
<script>
fixed_top_navbar('', '', '$in{name}', '', '');
</script>
<!-- top nav bar end-->
};
return qq{$out\n}; # this works but does not ask the user
}
# end body top nav bar
sub head_js_css
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $args = scalar (@keys);
my $out;
$out .= qq{
<!-- Bootstrap/jqueryUI -->
<link href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.0/css/bootstrap.min.css" rel="stylesheet" type="text/css">
<link href="https://www.a1z.us/jquery/bootstrap/fixed-top/navbar-fixed-top.css" rel="stylesheet">
<link href="https://code.jquery.com/ui/1.12.1/themes/smoothness/jquery-ui.css" rel="stylesheet">
<!--HTML5 shim and Respond.js for IE8 support of HTML5 elements and media queries-->
<!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.2/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]-->
};
if ($args)
{
if ($args >= 0)
{
my $return;
for (@keys)
{
chomp;
if ($_ =~ /.js$/)
{
$return .= qq{<!--442--> \n<script src="$_"></script> \n};
}
elsif ($_ =~ /.css$/)
{
$return .= qq{<!--446--> \n<link href="$_" rel="stylesheet" style="text/css"> \n};
}
else
{
# do nothing
return qq{@keys<!--469-->\n};
}
}
return qq{$return<!--473 jQ-->\n};
}
else
{
return qq{$out\n};
}
}
else
{
return qq{$out\n}; # this works but does not ask the user
}
}
# end head js css
# begin end head
sub end_head
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $out;
$out .= qq{</head>};
if ($ARGV and $ARGV > 0 or scalar(@keys) > 0)
{
if (@_)
{
return qq{@_\n};
}
else
{
return qq{$out\n};
}
}
else
{
return qq{$out\n}; # this works but does not ask the user
}
}
# end end head
# begin begin body
sub begin_body
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $out;
$out .= qq{<body>};
if ($ARGV and $ARGV > 0 or scalar(@keys) > 0)
{
if (@_)
{
return qq{@_\n};
}
else
{
return qq{$out\n};
}
}
else
{
return qq{$out\n}; # this works but does not ask the user
}
}
# end begin body
# begin accordion or rather file content. Need to change name of this method
sub body_accordion
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $out;
$out .= qq{<!--begin Content-->
<div id="accordion617" class="accordion">
<h3>Who is it for</h3>
<div>For those who know/uderstand Perl/HTML/jQuery</div>
<h3>What about a bigger number?</h3>
<div>Sure. Use the custom form to get the times table for a number greater than 30?</div>
<h3>How about any number/range?</h3>
<div>Yes, of course! Once again, use the custom form bearing the heading "Or enter your own"</div>
<h3>Can I customize it for own use?</h3>
<div>In that case, you need to purchase the software and/or order a customization</div>
</div>
<!--end Content-->
};
if ($ARGV and $ARGV > 0 or scalar(@keys) > 0)
{
if (@_)
{
return qq{\n@_\n};
}
else
{
return qq{\n$out\n};
}
}
else
{
return qq{\n$out\n}; #
}
}
# end accordion
sub body_article
{
my $self = shift;
my $out;
my %in;
%in =
(
content => "",
type => "article",
header => "Content Header",
@_,
);
if ( !defined $in{content} or $in{content} eq '' )
{
return qq{
No Content
};
}
else
{
return qq{<article class="container"><h2>$in{header}</h2>
$in{content}
</article>
};
}
}
# begin begin body
sub end_body
{
my $self = shift;
my $key = "@_";
my @keys;
if (@_) { @keys = @_; }
my $out;
$out .= qq{\n</body>\n};
if ($ARGV and $ARGV > 0 or scalar(@keys) > 0)
{
if (@_)
{
return qq{@_\n};
}
else
{
return qq{$out\n};
}
}
else
{
return qq{$out\n}; # this works but does not ask the user
}
}
# end end body
# begin content folder to select form
sub body_form
{
my $self = shift;
my $out;
my @keys;
if (@_) { @keys = @_; }
my ($vars, $vals) = ('');
for (@keys)
{
$vars = $_ if ($_ =~ /^vars/);
# $vals not used
$vals = $_ if ($_ =~ /^vals/);
}
my @form_vars = split(/\;/, $vars);
my @form_vals = split(/\;/, $vals);
# get params for hidden fields if given
my @hidden;
if ($form_vars[4] and $form_vars[4] =~ /\,/)
{
@hidden = split(/\,/, $form_vars[4]);
}
else
{
@hidden = ("No", "Vals");
}
# if SELECT ....
my $select;
if ($form_vars[3] and $form_vars[3] =~ /^select/)
{
# get the params for the form
# select,
my ($sel_key, $sel_name, $sel_default, $folder_or_file, $selectLabelText) = split(/\,/, $form_vars[3], 5);
$select .= qq{
<label for="$sel_name">$selectLabelText</label>
<div class="form-group"><!--begin select-->
\t<select name="$sel_name">
\t\t<option selected value="$sel_default">$sel_default</option>
};
#now open file/folder to fill "options"
if ( -f $folder_or_file )
{
# open as file
#$select .= qq{none};
}
elsif (-d $folder_or_file)
{
# open as dir and add all files in it to "options"
opendir(D, "$folder_or_file") or $select .= qq{<div class="error">$!</div>};
my @DIR = readdir(D);
while ( my $file = <each @DIR> )
{
# only if file contains alphabets, numbers, and dashes
next unless $file =~ /[a-zA-Z0-9\-]/;
# comment if you want subfolders also listed
next unless -f "$folder_or_file/$file";
# get rid of . and ..
next if $file =~ /^(\.|\.\.)/;
# do not add hidden files to the options list
next if $file =~ /^\./;
# get the size of th file
my $size = -s "$folder_or_file/$file";
my $original = $size;
$size /= 1024;
#$size /= 1024;
$size = sprintf "%.2f", $size;
$select .= qq{\n\t\t\t<option value="$file">$file [$size kb]</option>} if $file;
}
close D;
}
$select .= qq{\n\t\t</select>\n\t</div>\n};
}
else
{
# no select
$select .= qq{};
}
$out .= qq{<form action="$form_vars[2]" method="$form_vars[1]">};
# add hidden fields/values # from $form_vars[4]
for (@hidden)
{
my ($name, $value) = split(/\-\-\-/, $_, 2) if $_;
$out .= qq{\n\t<input type="hidden" name="$name" value="$value"/>} if $_;
}
# add select
$out .= qq{$select};
$out .= qq{\n\t<button type="submit" class="btn btn-default">Submit</button>\n</form>\n};
return qq{<div class="body_form">$out</div>};
}
# end body_form
sub defaults_begin
{
my $self = shift;
my $out;
$out .= sprintf header(),
start_html(),
head_title("$_[0]"),
head_meta(),
head_meta("$_[1]"),
head_js_css(),
head_js_css("$_[2]"),
end_head(),
begin_body(),
body_topnavbar()
;
return $out;
}
sub defaults_end
{
my $self = shift;
my $out;
$out .= sprintf body_js_css(),
body_js_css("$_[0]"),
end_body(),
end_html()
;
return $out;
}
# HTML
my %HTML;
%HTML = (
-defaultjquery => qq{\n<!-- -defaultjquery-->
<!-- jquery-->
<script src="https://code.jquery.com/jquery-1.12.4.min.js"></script>
<!--bootstrap-->
<script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.0/js/bootstrap.min.js"></script>
<!--blueimp gallery-->
<script src="https://blueimp.github.io/Gallery/js/jquery.blueimp-gallery.min.js"></script>
<!-- jquery ui -->
<script src="https://code.jquery.com/ui/1.11.4/jquery-ui.min.js"></script>
<!-- IE10 viewport hack for Surface/desktop Windows 8 bug -->
<script src="https://www.a1z.us/jquery/bootstrap/fixed-top/ie10-viewport-bug-workaround.js"></script>
<script >
// for tabs
\$( function() {
var tabs = \$( "#tabs" ).tabs();
tabs.find( ".ui-tabs-nav" ).sortable({
axis: "x",
stop: function() { tabs.tabs( "refresh" ); }
});
});
// dialog
\$(function() {
\$( "#dialog" ).dialog({
autoOpen: false,
show: {
effect: "blind",
duration: 1000
},
hide: {
effect: "explode",
duration: 1000
}
});
\$( "#opener" ).click(function() {
\$( "#dialog" ).dialog( "open" );
});
});
\$('#menu').menu();
\$('#accordion').accordion();
\$('#accordion1').accordion();
\$('#accordion2').accordion();
\$('#accordion3').accordion();
\$('accordion617').accordion();
\$('#tabs').tabs();
</script>
},
-default_LastItem => qq{},
);
sub html_bootstrap_css
{
return qq{<!-- Bootstrap/jqueryUI -->
<link href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.0/css/bootstrap.min.css" rel="stylesheet" type="text/css">
<link href="https://www.a1z.us/jquery/bootstrap/fixed-top/navbar-fixed-top.css" rel="stylesheet">
};
}
sub html_jqueryui_css
{
# jquery ui theme jquery-ui.css #1.12.0
return qq{<link href="https://code.jquery.com/ui/1.12.0/themes/smoothness/jquery-ui.css" rel="stylesheet">};
}
sub html_shim_respond
{
return qq{<!-- HTML5 shim and Respond.js for IE8 support of HTML5 elements and media queries -->
<!--[if lt IE 9]>
<script src="https://oss.maxcdn.com/html5shiv/3.7.2/html5shiv.min.js"></script>
<script src="https://oss.maxcdn.com/respond/1.4.2/respond.min.js"></script>
<![endif]-->
};
lib/A1z/HTML5/Template.pm view on Meta::CPAN
sub html_navbar
{
#my $self = shift;
#serverName, pageName, menuName, dropDownLinks
my %in;
%in = (
-nbMenuName => "",
-nbPageName => "",
-nbServer => "",
-nbLinks => "blog-support-help-contact-sale",
@_,
);
return qq{<script src="https://www.a1z.us/js/utils/top-nav-bar.js"></script>
<!--top nav bar begin-->
<script>
//<--
fixed_top_navbar('$in{-nbServer}', '$in{-nbPageName}', '$in{-nbMenuName}', '$in{-nbLinks}');
//-->
lib/A1z/HTML5/Template.pm view on Meta::CPAN
};
}
sub html_bootstrap_js
{
# jquery:3.3.0 ui:1/12/1
return qq{<!-- Bootstrap/jqueryUI -->
<link href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.0/js/bootstrap.min.js" rel="stylesheet" type="text/css">
};
}
sub html_js_css
{
}
sub html_jquery
{
}
sub html_setTitle
{
my $out;
my %in;
%in = (
ta => qq{},
tb => qq{},
tc => qq{},
@_,
);
$out .= qq{<script>
<!-- Begin
function setTitle()
{
var a = "$in{ta}";
var b = "$in{tb}";
var c = "$in{tc}";
var t = new Date();
s = t.getSeconds();
if (s == 10) { document.title = a;}
else if (s == 20) { document.title = b;}
else if (s == 30) { document.title = c;}
else if (s == 40) { document.title = a;}
else if (s == 50) { document.title = b;}
else if (s == 00) { document.title = c;}
setTimeout("setTitle()", 1000);
}
// End -->
</script>
};
return $out;
}
sub html_humanejs_css
{
return qq{<link rel='stylesheet' href='https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/themes/bigbox.css'>
<link rel='stylesheet' href='https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/themes/boldlight.css'>
<link rel='stylesheet' href='https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/themes/jackedup.css'>
<link rel='stylesheet' href='https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/themes/libnotify.css'>
<link rel='stylesheet' href='https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/themes/original.css'>
<link rel='stylesheet' href='https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/themes/flatty.min.css'>
<link href='https://fonts.googleapis.com/css?family=Ubuntu&v2' rel='stylesheet' type='text/css'>
<link href='https://fonts.googleapis.com/css?family=Ubuntu+Mono' rel='stylesheet' type='text/css'>
<link href='https://fonts.googleapis.com/css?family=Cabin+Sketch:700&v2' rel='stylesheet' type='text/css'>
};
lib/A1z/HTML5/Template.pm view on Meta::CPAN
sub html_bootstrap_bluimp
{
return qq{<!-- The Bootstrap Image Gallery lightbox, should be a child element of the document body -->
<div id="blueimp-gallery" class="blueimp-gallery blueimp-gallery-controls" data-use-bootstrap-modal="false">
<!-- The container for the modal slides -->
<div class="slides"></div>
<!-- Controls for the borderless lightbox -->
<h3 class="title"></h3>
<a class="prev">‹</a>
<a class="next">›</a>
<a class="close">×</a>
<a class="play-pause"></a>
<ol class="indicator"></ol>
<!-- The modal dialog, which will be used to wrap the lightbox content -->
<div class="modal fade">
<div class="modal-dialog">
<div class="modal-content">
<div class="modal-header">
<button type="button" class="close" aria-hidden="true">×</button>
<h4 class="modal-title"></h4>
</div>
<div class="modal-body next"></div>
<div class="modal-footer">
<button type="button" class="btn btn-default pull-left prev">
<i class="glyphicon glyphicon-chevron-left"></i>
Previous
</button>
<button type="button" class="btn btn-primary next">
Next
<i class="glyphicon glyphicon-chevron-right"></i>
</button>
</div>
</div>
</div>
</div>
</div>
};
}
# end sub html_bootstrap_bluimp
sub head
{
my $self = shift;
my $out;
my %in = (
-type => "Content-Type: text/html;charset=utf-8\n\n",
-bootstrap => html_bootstrap_css,
-jqueryui => html_jqueryui_css,
-htmlshim => html_shim_respond,
-humanejs => html_humanejs_css,
-title => "A1Z .us",
-cssLinks => "https://code.jquery.com/ui/1.11.4/themes/ui-lightness/jquery-ui.css,https://blueimp.github.io/Gallery/css/blueimp-gallery.min.css,https://www.a1z.us/A1z/HTML5/Template.css",
-cssCode => "",
-mobilemeta => qq{<meta name="HandheldFriendly" content="true">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
},
-charsetmeta => qq{<meta charset="utf-8">},
-usermeta => "",
-titleRotatingText => qq{text1,text2,text3},
@_,
);
# rotating title function and text
my $setTitle;
if ( $in{-titleRotatingText} and $in{-titleRotatingText} =~ /\,/ )
{
my @a;
@a = split(/\,/, $in{-titleRotatingText}, 3);
$setTitle = html_setTitle(ta => "$a[0]", tb => "$a[1]", tc => "$a[2]");
}
else
{
$setTitle = html_setTitle(ta => "Text01", tb => "text02", tc => "text03");
}
# css multiple links/files
my $css; my @css;
if ($in{-cssLinks} )
{
if ( $in{-cssLinks} =~ /\,/ )
{
@css = split(/\,/, $in{-cssLinks});
for (@css)
{
if ($_ =~ /\.css$/)
{
$css .= qq{<link type="text/css" rel="stylesheet" href="$_">\n} ;
}
else
{
$css = '';
}
}
}
}
else
{
$css = qq{};
}
return qq{$in{-type}<!DOCTYPE html>
<html>
<head>
<title>$in{-title}</title>
$in{-charsetmeta}
$in{-mobilemeta}
lib/A1z/HTML5/Template.pm view on Meta::CPAN
sub body
{
my $self = shift;
my $out;
my %in;
%in = (
-h1 => qq{A1Z .us},
-onload => qq{setTitle();},
-nbhead => qq{},
-nbpage => qq{},
-nbmenu => qq{More},
-defaultjquery => qq{$HTML{-defaultjquery}},
-humanejs => qq{<script src="https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/humane.min.js">},
-userjquery => qq{},
-navbar => html_navbar( $in{-nbmenu}, $in{-nbpage}, "", ""),
-content => qq{<div class="content">Content</div>},
-footer => qq{All rights reserved © A1Z .us},
-bootstrapbluimp => html_bootstrap_bluimp,
-nbLinks => qq{contact-help-feedback},
@_,
);
return qq{<body onload="$in{-onload}">
<div id="main" class="container">
<!--top nav bar begin-->
<script src="https://www.a1z.us/js/utils/top-nav-bar.js"></script>
<script >
//<--
fixed_top_navbar('$in{-nbhead}', '$in{-nbpage}', '$in{-nbmenu}', '$in{-nbLinks}');
//-->
</script>
$in{-bootstrapbluimp}
$in{-h1}
$in{-content}
$in{-footer}
</div>
$in{-defaultjquery}
$in{-humanejs}
<script>
//<!--
$in{-userjquery}
//-->
</script>
</body>
</html>
};
}
# end body
lib/A1z/HTML5/Template.pm view on Meta::CPAN
sub open_file
{
my $self =shift;
my %in;
%in =
(
file => "",
output_header => "",
output_format => "",
@_,
);
my $file = "$in{file}" || "$_[0]";
my $output_format = "$in{output_format}" || "$_[1]";
my $output_header = "$in{output_header}" || "$_[2]";
my $out;
my $div4tabs;
my @data;
if (-e -f "$file")
{
open(FILE, "$file") or die "$!";
$out .= qq{\n<!--begin file output-->\n<div class="file_output">\n};
# Step 1
# set the header as per format
if ($output_format eq 'table')
{
$out .= qq{<table class="table table-striped table-bordered table-hover table-condensed table-responsive">
<thead>
<tr><th colspan="2">$output_header</th></tr>
</thead>
<tbody>
};
}
elsif ($output_format eq 'accordion')
{
$out .= qq{<h2>$output_header</h2>\n<div id="accordion2" class="accordion"><!--118-->\n};
}
elsif ($output_format eq 'menu')
{
$out .= qq{<ul class="menu" id="menu">\n<li><a href="/">$output_header</a>\n<ul>};
}
elsif ($output_format eq 'tabs')
{
# special case for tabs since the data needs to be formatted a little differently
$out .= qq{<h2>$output_header</h2>\n<div id="tabs">\n<ul>\n};
my $sl = '0';
while ( my $line = <FILE>)
{
$sl++ if $line;
my ($h1, $div) = ('');
if ($line =~ /\|/)
{
($h1, $div) = split(/\|/, $line, 2);
} # no (\|) # i.e., do not enclose with brackets
elsif ($line =~ /\t+/) {
($h1, $div) = split(/\t+/, $line, 2);
}
elsif ($line =~ /\s+/)
{
($h1, $div) = split(/\s+/, $line, 2);
}
# Keep only those items that have '==' in the beginning
if ( $h1 =~ /^\s+/ or $div =~ /^\s+/ )
{
next unless ($h1 =~ /^\s+==/ or $div =~ /^\s+==/);
$div =~ s!^\s+==!!g;
$h1 =~ s!^\s+==!!g;
}
else
{
next unless ($h1 =~ /^==/ or $div =~ /^==/);
$div =~ s!^==!!g;
$h1 =~ s!^==!!g;
}
$out .= qq{\t<li><a href="#tabs-$sl">$h1</a></li>\n};
$div4tabs .= qq{<div id="tabs-$sl">$div</div>};
}
$out .= qq{</ul>\n};
$out .= $div4tabs;
close FILE;
}
elsif ($output_format eq 'dialog')
{
$out .= qq{<h2>Dialog: <a href="#opener" id="opener" title="Opens the Dialog">$output_header</a></h2>
<div id="dialog">\n};
}
else
{
$out .= qq{\n<h2>$output_header</h2>\n};
}
# End Step 1
# now work on file
my $serial = '0';
while ( my $line = <FILE> )
{
chomp $line;
$serial++ if $line;
my ($h1, $div) = ('');
if ($line) # make sure no output if line is empty
{
$line =~ s! RN !\r\n!g;
# split the file's lines into usable data according to separator used.
if ($line =~ /\|/)
{
($h1, $div) = split(/\|/, $line, 2);
} # no (\|) # i.e., no enclosing with brackets. was the culprit
elsif ($line =~ /\t+/) {
($h1, $div) = split(/\t+/, $line, 2);
}
elsif ($line =~ /\s+/)
{
($h1, $div) = split(/\s+/, $line, 2);
}
# end split the file's line according to match: 3 options: |, \t+, or \s+
}
# Step 2
#Now set the content as per output format
if ($output_format eq 'table')
{
# Keep only those items that have a # in the beginning
if ( $h1 =~ /^\s+/ or $div =~ /^\s+/ )
{
next unless ($h1 =~ /^\s+#/ or $div =~ /^\s+#/);
$div =~ s!^\s+#!!g;
$h1 =~ s!^\s+#!!g;
}
else
{
next unless ($h1 =~ /^#/ or $div =~ /^#/);
$div =~ s!^#!!g;
$h1 =~ s!^#!!g;
}
$out .= qq{\t<tr><td>$h1</td><td>$div</td></tr>\n};
}
elsif ($output_format eq 'accordion')
{
# Keep only those items that have -- in the beginning
if ( $h1 =~ /^\s+/ or $div =~ /^\s+/ )
{
next unless ($h1 =~ /^\s+--/ or $div =~ /^\s+--/);
$div =~ s!^\s+--!!g;
$h1 =~ s!^\s+--!!g;
}
else
{
next unless ($h1 =~ /^--/ or $div =~ /^--/);
$div =~ s!^--!!g;
$h1 =~ s!^--!!g;
}
$out .= qq{\t<h3>$h1</h3>\n\t<div>$div</div>\n} if $line;
}
elsif ($output_format eq 'menu')
{
# the first item will be used as link title and name
# the second item will be used as the actual link
# no extensions added automatically by the script
# an id for each link/li is also provided in case, may be it is not needed
# Remove items with a # in the beginning; Sat Feb 21 18:48:19 2015
next if ($h1 =~ /^#http/ or $div =~ /^#http/);
# Keep only those items that have a 'http' in the beginning
if ( $h1 =~ /^\s+/ or $div =~ /^\s+/ )
{
next unless ($h1 =~ /^\s+http/ or $div =~ /^\s+http/);
#$div =~ s!^\s+http!!g;
#$h1 =~ s!^\s+http!!g;
}
else
{
next unless ($h1 =~ /^http/ or $div =~ /^http/);
#$div =~ s!^http!!g;
#$h1 =~ s!^http!!g;
}
$out .= qq{\t<li id="li-$serial"><a id="a-$serial" href="$div" title="$h1">$h1</a></li>\n};
}
elsif ($output_format eq 'tabs')
{
# Keep only those items that have a == in the beginning
if ( $h1 =~ /^\s+/ or $div =~ /^\s+/ )
{
next unless ($h1 =~ /^\s+==/ or $div =~ /^\s+==/);
$div =~ s!^\s+==!!g;
$h1 =~ s!^\s+==!!g;
}
else
{
next unless ($h1 =~ /^==/ or $div =~ /^==/);
$div =~ s!^==!!g;
$h1 =~ s!^==!!g;
}
# Mismatching fragment identifier. See 1797.
# $div not available here as <FILE> is not open here.
$out .= qq{\t<div id="tabs-$serial"><p>$div</p></div>\n};
}
elsif ($output_format eq 'dialog')
{
# includes everything; So, no filtering.
# But, just remove symbols in both $h1 and $div
$div =~ s!^(==|\#|--)!!g;
$h1 =~ s!^(==|\#|--)!!g;
$out .= qq{\t\t<h4 class="dialog-header">$h1</h4>\n\t\t<div class="dialog-content">$div <hr/></div>\n};
}
else
{
$out .= qq{$h1 $div}; # or $line
}
}
# add an extra item at the end of file output
# Step 3
# set the output ending as per format
if ($output_format eq 'table')
{
$out .= qq{\n</tbody>\n</table>\n\n};
}
elsif ($output_format eq 'accordion')
{
$out .= qq{\n<!--end accordion--></div>\n\n};
}
elsif ($output_format eq 'menu')
{
$out .= qq{</ul></ul>};
}
elsif ($output_format eq 'tabs')
{
$out .= qq{</div><!--end tabs-->\n};
}
elsif ($output_format eq 'dialog')
{
$out .= qq{</div><!--end dialog-->\n};
}
else
{
$out .= qq{\n\n};
}
# end file output wrapper
$out .= qq{</div><!--end file output-->\n};
return $out;
}
else
{
my $out;
$out .= qq{\n<!--begin accord 112-->\n<div id="accordion1460" class="accordion">\n};
while ( my $line = <FILE> )
{
chomp $line;
my ($h1, $div) = ('');
($h1, $div) = split(/\t+/, $line, 2) if $line;
$out .= qq{\t<h3>$h1</h3>\n\t<div>$div</div>\n} if $line;
}
$out .= qq{\t<h3>Powered by</h3>\n\t<div>Perl/CPAN</div>\n};
$out .= qq{</div>\n<!--end accord-->\n};
return $out;
}
close FILE;
}
# end open_file
sub edit_file
{
my $self = shift;
my $out;
my %in;
%in = (
file => "",
error => "",
action => "TemplateAdmin.cgi",
serial => '',
output_type => '',
@_,
);
if (-e -f "$in{file}")
{
open(FILE, "$in{file}") or $in{error} = "unable to open $in{file}";
my @file = <FILE>;
close FILE;
$out .= qq{
<article class="container">
<form action="$in{action}" method="post">
<input type="hidden" name="action" value="write">
};
for (@file)
{
chomp;
next if $_ =~ /^$/;
$in{serial}++ if $_;
my ( $type, $content ) = split(/\|/, $_, 2);
$type =~ s!\s+$!!g;
my $identifiers = substr "$content", 0, 4; # has to be 4 to cover 'http.' Also, assuming no spaces in the beginning (removed by write_file)
# determine output type
if ( $identifiers =~ /^\#/ ) { $in{output_type} = 'Table'; }
elsif ( $identifiers =~ /^\-/ ) { $in{output_type} = 'Accordion'; }
elsif ( $identifiers =~ /^\=/ ) { $in{output_type} = 'Tabs'; }
elsif ( $identifiers =~ /^http/ ) { $in{output_type} = 'Menu'; }
else { $in{output_type} = 'None'; }
# remove all nonmeta characters for web page display
$identifiers =~ s!(\s+|[a-zA-z0-9])!!g; # removes http also.
$content =~ s!\<!<\;!g;
$content =~ s!\>!>\;!g;
$content =~ s! RN !\r\n!g; #
$out .= qq`<div>
<span class="serial">$in{serial} </span>
<span class="type">$type </span>
<span class="identifiers">$identifiers </span>
<span class="type type-$in{output_type}">Type:$in{output_type} </span>
</div>
<div>
<textarea name="ta-$type" id="ta-$type" rows="5" cols="98%" class="type-$in{output_type}">$type , $content</textarea>
</div>
<br/>
`;
}
$out .= qq{<input type='submit' value="Save"></form></article>};
return $out;
}
}
sub write_file
{
my $self = shift;
my $out;
my %in;
%in =
(
file => "",
error => "",
powershell => "C:/WINDOWS/system32/WindowsPowerShell/v1.0/powershell.exe ",
@_,
);
my %vars;
use CGI;
my $q = new CGI;
%vars = $q->Vars();
my $action = $q->param('action');
if ( $action eq 'write')
{
if (-e -f "$in{file}")
{
# First, get file content to backup to another file
open(F, "$in{file}") or $in{error} .= "#1565 Unable to open file for reading. '$!' <br/>";
my @f = <F>;
# save original file content to backup file
open(BAK, ">$in{file},bak.txt") or $in{error} .= "#1570 Unable to create backup file '$in{file},bak.txt' '$!' <br/>";
for (@f)
{
print BAK qq{$_};
}
close BAK;
close F;
# recreate file, thereby deleting original content
open(DEL, ">$in{file}") or $in{error} .= "#1579 Unable to recreate file '$in{file}' '$!' <br/>";
print DEL "File ReCreated";
close DEL;
my %out;
for (keys %vars)
{
chomp $_;
chomp $vars{$_};
next if $_ eq 'action';
my ( $name, $value ) = split(/\,/, $vars{"$_"}, 2);
$name =~ s!(\r\n+|\n+)! RN !g;
$value =~ s!(\r\n+|\n+)! RN !g;
$value =~ s!^\s+!!g;
$out{"$name"} = "$value";
}
# Insert/Add new content
open(FILE, ">$in{file}") or $in{error} .= "#1582 Error writing to file '$in{file}' '$!' <br/>";
for (keys %out)
{
print FILE qq{$_\|$out{$_}\n};
}
close FILE;
if (-e -f "$in{file},bak.txt" and -e -f "$in{file}")
{
return "<div class='success'>Saved</div> <div class='error'>$in{error}</div>";
}
else
{
return "<div>#1605 Error saving file '$in{file}'</div> <div class='error'>$in{error}</div>";
}
}
else
{
return "File not found";
}
}
elsif ( $action eq 'newItem' )
{
return "$action";
}
else
{
return '* ' x 10;
}
}
# end write_file
sub display_gallery_thumbnails
{
my $self = shift;
my $out;
my %in;
%in = (
error => "",
images_dir => "/images/a1z-html5-template/",
thumbs_dir => "/images/a1z-html5-template/thumbs",
images_url => "/images/a1z-html5-template",
thumbs_url => "/thumbs/a1z-html5-template/thumbs",
width => "100",
height => "100",
@_,
);
if (-e -d "$in{images_dir}" and "$in{thumbs_dir}" )
{
opendir(TH, "$in{thumbs_dir}") or $in{error} .= qq{<p>$!</p>};
my @thumbs = readdir(TH);
close TH;
foreach ( @thumbs )
{
if ( $_ and $_ =~ /(.jpg|.gif|.jpeg|.png|.tiff)$/ )
{
$out .= qq{\n<a href="$in{images_url}/$_" title="$_" data-gallery> <img src="$in{thumbs_url}/$_" alt="Image $_" width="$in{width}" height="$in{height}"> </a> \n};
}
}
}
else
{
$in{error} .= qq{<p>Image directory does not exist or is inaccessible. Make sure you provided the correct path.</p>};
$out = $in{error};
}
return $out;
}
# end display gallery thumbnails
lib/A1z/HTML5/Template.pm view on Meta::CPAN
version 0.22
=head1 SYNOPSIS
use A1z::HTML5::Template;
my $h = A1z::HTML5::Template->new();
This directory should be writable by the web server, required to create/hold page content files.
This may also contain your custom JavaScript/CSS libraries.
Works for both Windows and Linux
use lib '/home/user/path/to/app';
or
use lib 'C:/Inetpub/wwwroot/path/to/app';
# for features like 'say'
use 5.10.0;
my $h = A1z::HTML5::Template->new();
Fast, Easy, and Simple: Just Two Lines!
say $h->head( -title => "My Brand Name" );
say $h->body( -content => qq{ Coming Soon });
For More Control/Customization: Not for the lazy!
say $h->header('utf8');
say $h->start_html();
say $h->head_title("My New App");
say $h->head_meta();
Load basic/required JavaScript/CSS libraries
say $h->head_js_css();
Add your own custom JavaScript/CSS files
say $h->head_js_css('/url/to/app/Template.css');
say $h->end_head();
say $h->begin_body();
say qq{<h1>My New App/Website</h1>};
say qq{<main class="container">};
# output file content as menu
say $h->body_accordion( $h->open_file("/home/user/path/to/app/open_file_example.txt", 'menu', 'Menu') );
# as a HTML5 table
say $h->body_accordion( $h->open_file("$sys{cgibase}/open_file_example.txt", 'table', 'Table Header') );
# Simple mathematics
say $h->body_article( header => "Simple Mathematics", content => $h->math1("2", "4") );
# Times Table
say $h->body_article( header => "Times Table", content => $h->timestable("2") );
say qq{</main>};
Required/Default JavaScript libraries.
say $h->body_js_css();
Add your own JavaScript libraries:
say $h->body_js_css("complete-url_or_path-to-js-css-libraries")
say $h->end_body();
say $h->end_html();
=head1 NAME
Fast and Easy Web Apps
"A1z::HTML5::Template" provides customizable HTML5 tags for creating "Fast and Easy Web Apps."
=head2 VERSION
0.22
=head1 Installation
cpan install A1z::HTML5::Template
or
cpanm A1z::HTML5::Template
=head1 METHODS
header start_html head_title head_meta head_js_css end_head begin_body body_js_css body_topnavbar body_accordion end_body end_html
=head2 new
use A1z::HTML5::Template;
my $h = A1z::HTML5::Template->new();
=head2 math1
$h->math1(num1, num2);
$h->body_article( header => "Math", content => $h->math1(num1, num2) );
=head2 timestable
$h->timestable("Number");
=head2 header
Provides HTML Content-Header
$h->header("");
=head2 start_html
Provides doctype html
Default includes utf-8
$h->start_html();
Or, add your own charset to your app:
$h->start_html('DifferentCharset');
=head2 body_js_css
Add/include javascript and css files just above </body> section
Typically, CSS files should/are not be used here.
Default behavior:
$h->body_js_css();
Includes
jquery 1.12.4, jquery ui 1.11.4, bootstrap 3.3.0,
javascript for #dialog function, #menu, #accordion, #tabs
Add your own .js file:
use $h->body_js_css("/path/to/js/file.js");
You can use both to include default .js files and your own custom .js file.
=head2 end_html
Provides </html>
=head2 head_title
Provides <title></title>
$h->head_title("App/Page Title");
=head2 head_meta
Provides <meta ... >. Includes the following by default:
IE=Edge
HandheldFriendly
viewport
$h->head_meta();
Just like body_js_css, you can use both to add default values and your own meta
=head2 body_topnavbar
Provides top nav bar optionally.
By default it is loaded from www.a1z.us which probably be removed in a future version.
So, get a copy from bootstrap 3 and store it on your server.
=head2 head_js_css
provides the ability to add/include .js/.css files in the </head> tag.
$h->head_js_css();
Default includes the following:
bootstrap 3.3.0 .css from maxcdn
navbar-fixed-top.css from www.a1z.us
jquery 1.12.1 smoothness theme from code.jquery.com
Shim and Respond.js from maxcdn
$h->head_js_css("/path/to/.js")
$h->head_js_css("/path/to/.css")
=head2 end_head
Provides </head>
$h->end_head();
=head2 begin_body
provides <body> tag.
$h->begin_body();
=head2 body_accordion
The accordion in 'body_accordion' is misleading. It is not limited to just an accordion but all kinds of content.
C<say $h->body_accordion( $h->open_file("/path/to/app/open_file_example.txt", 'Type', 'Heading') );>
C<say $h->body_accordion( $h->open_file("/path/to/app/open_file_example.txt", "table", "Name and Price");
C<say $h->body_accordion( $h->open_file("/path/to/app/open_file_example.txt", "tabs", "Space Saving Tabs");
=head2 body_article
provides the ability to add content into <main> tags.
$h->body_article( header => "", content => "");
=head2 end_body
provides </body> tag.
$h->end_body();
=head2 body_form
Form, lists items from a directory in a neat drop-down list with each item's file size in KB!
Should be in the exact format like below:
$h->body_form("vars;METHOD;Action.cgi;select,NameForSelectTag,DefaultOptionSelected,AbsPathToDir,TextForSelectLabel;hidN1---hidV1,hidN2---hidV2,hidN3---hidV3");
=head2 defaults_begin
Internal Use Only
Provides defaults for very lightweight template for those in a hurry; Can be used for apps/sites that are under construction!
$h->defaults_begin();
=head2 defaults_end
Internal Use Only.
provides defaults for lightweight or under construction app/website.
$h->defaults_end();
=head1 HTML Hash
For Internal/Future Use
Hash contains -defaultjquery which is used in body.
-defaultjquery includes
jquery 1.12.4 from code.jquery
jquery ui 1.11.4
bootstrap 3.3.0 from maxcdn
blueimp-gallery
ie-10 workaround from a1z.us
functions
tabs, dialog, menu, accordion
=head2 html_bootstrap_css
For Internal/Future Use
Used in $h->head and $h->body internally.
All methods starting with 'html_' are used internally!
Include bootstrap.min.css, #3.3.0 from maxcdn and navbar-fixed-top.css from a1z.us
$h->html_bootstrap_css()
=head2 html_jqueryui_css
For Internal/Future Use
Includes jquery ui theme jquery-ui.css #1.12.0
=head2 html_shim_respond
For Internal/Future Use
html5shiv.min.js #3.7.2
respond.min.js #1.4.2
=head2 html_navbar
For Internal/Future Use
Customizations for top-nav-bar.js from a1z.us
$h->html_navbar(
-nbMenuName => "menuName",
-nbPageName => "pageName",
-nbServer => "serverName",
-nbLinks => "dropDownLinks: URLs separated by a dash, mostly relative URLs. E.g., blog-support-help-contact-sale"
);
=head2 html_bootstrap_js
For Internal/Future Use
bootstrap.min.js, #3.3.0, from maxcdn
=head2 html_setTitle
For Internal/Future Use
setTitle javascript function
Used in body
Includes the C<script> tag pair
C<$h->html_set_title( ta => "Text001", tb => "TExt002", tc => "TeXt003" );>
=head2 html_humanejs_css
For Internal/Future Use
humane-js #3.2.2 cdnjs.cloudflare
fonts.googleapis.com
=head2 html_bootstrap_bluimp
For Internal/Future Use
bootstrap gallery lightbox controls for use immediately after C<body> tag
C<&html_bootstrap_bluimp;>
Used internally in C<$h->body()>
=head2 head
$h->head();
$h-head (
-type => "Content-Type: text/html;charset=utf-8\n\n",
-bootstrap => html_bootstrap_css,
-jqueryui => html_jqueryui_css,
-htmlshim => html_shim_respond,
-humanejs => html_humanejs_css,
-title => "A1Z .us",
-cssLinks => "https://code.jquery.com/ui/1.11.4/themes/ui-lightness/jquery-ui.css,https://blueimp.github.io/Gallery/css/blueimp-gallery.min.css,https://www.a1z.us/A1z/HTML5/Template.css",
-cssCode => "",
-mobilemeta => qq{<meta name="HandheldFriendly" content="true">
<meta name="viewport" content="width=device-width, initial-scale=1.0">
},
-charsetmeta => qq{<meta charset="utf-8">},
-usermeta => "",
-titleRotatingText => qq{text1,text2,text3}
);
=head2 body
$h->body();
$h->body(
-h1 => qq{A1Z .us},
-onload => qq{setTitle();},
-nbhead => qq{},
-nbpage => qq{},
-nbmenu => qq{More},
-defaultjquery => qq{$HTML{-defaultjquery}},
-humanejs => qq{<script src="https://cdnjs.cloudflare.com/ajax/libs/humane-js/3.2.2/humane.min.js">},
-userjquery => qq{},
-navbar => html_navbar( $in{-nbmenu}, $in{-nbpage}, "", ""),
-content => qq{<div class="content">Content</div>},
-footer => qq{All rights reserved © A1Z .us},
-bootstrapbluimp => html_bootstrap_bluimp,
-nbLinks => qq{contact-help-feedback}
);
=head1 open_file
Used for loading all kinds of custom elements for different output formats stored in simple text files.
$h->open_file("/path/to/file", "outputFormat", "outputHeader");
$h->open_file("C:/Inetpub/wwwroot/MyApp/menu.txt", "menu", "Menu");
This is the heart of the App.
=head2 OUTPUT FORMAT OPTIONS:
table, accordion, menu, as is; where "as is" is the default
$h->open_file( file => "abs/path/to/file", output_format => "table", output_header => "Heading" );
=head2 edit_file
Edit your app/page/site. Customize HTML produced by A1z::HTML5::Template.
Creates a form to edit contents of a file.
The contents of this file should be in a special format. See open_file_example.txt.
Data is stored in simple text files in the app's home dir.
We recommend creating a separate file for editing/writing purposes, e.g., "TemplateAdmin.cgi"
use lib '/path/to/app';
use A1z::HTML5::Template;
my $h = A1z::HTML5::Template->new();
say $h->header('utf8');
say $h->start_html();
say $h->head_title("Edit App");
say $h->head_meta();
say $h->head_js_css();
say $h->end_head();
say $h->begin_body();
# Show edit form
say $h->body_article(
header => "Edit page items",
action => "TemplateAdmin.cgi",
content => $h->edit_file( file => "/absolute/path/to/app/open_file_example.txt")
);
# Save Customizations back to the same file.
# include write_file if you submit form to the same file ( TemplateAdmin.cgi )
say $h->body_article(
header => "<a href='$sys{cgiurl}/TemplateAdmin.cgi' title='Refresh to get the latest/saved content'>Refresh</a> ",
content => $h->write_file( file => "/absolute/path/to/app/open_file_example.txt")
);
say $h->body_js_css();
say $h->end_body();
say $h->end_html();
=head2 write_file
See documentation for 'edit_file.'
=head2 display_gallery_thumbnails
my $images = $h->display_gallery_thumbnails(
images_dir => "{images_dir}",
thumbs_dir => "{thumbs_dir}",
images_url => "{images_url}",
thumbs_url => "{thumbs_url}",
width => "100",
height => "100"
);
=head1 BUGS
Please report any bugs or feature requests to C<bug-a1z-html5-template at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=A1z-HTML5-Template>. I will be notified, and then you'll
lib/A1z/HTML5/Template.pm view on Meta::CPAN
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc A1z::HTML5::Template
You can also look for information at:
=over 4
lib/A1z/HTML5/Template.pm view on Meta::CPAN
=back
=head1 ACKNOWLEDGEMENTS
I am greatly indebted to my family for letting me be 'addicted' and 'married' to my computers.
=head1 LICENSE AND COPYRIGHT
Copyright 2018 Sudheer Murthy.
A1z-Html
view release on metacpan or search on metacpan
lib/A1z/Html.pm view on Meta::CPAN
sub NAME { my $self = shift; $NAME = "Web Utilities"; return $NAME; }
our $VERSION = '0.04';
sub new {
my $class = shift;
my $self = bless { @_ }, $class;
return $self;
}
sub welcome {
return qq{Welcome to Web Utilities};
}
1;
__END__
lib/A1z/Html.pm view on Meta::CPAN
version 0.04
=head1 SYNOPSIS
use A1z::Html;
my $h = A1z::Html->new();
my $welcome = A1z::Html->welcome();
print $welcome;
=head1 AUTHOR
Sudheer Murthy <pause@a1z.us>
AAAA-Crypt-DH
view release on metacpan or search on metacpan
inc/Devel/CheckLib.pm view on Meta::CPAN
Devel::CheckLib is a perl module that checks whether a particular C
library and its headers are available.
=head1 SYNOPSIS
use Devel::CheckLib;
check_lib_or_exit( lib => 'jpeg', header => 'jpeglib.h' );
check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] );
# or prompt for path to library and then do this:
check_lib_or_exit( lib => 'jpeg', libpath => $additional_path );
=head1 USING IT IN Makefile.PL or Build.PL
If you want to use this from Makefile.PL or Build.PL, do
not simply copy the module into your distribution as this may cause
inc/Devel/CheckLib.pm view on Meta::CPAN
You pass named parameters to a function, describing to it how to build
and link to the libraries.
It works by trying to compile some code - which defaults to this:
int main(int argc, char *argv[]) { return 0; }
and linking it to the specified libraries. If something pops out the end
which looks executable, it gets executed, and if main() returns 0 we know
that it worked. That tiny program is
built once for each library that you specify, and (without linking) once
inc/Devel/CheckLib.pm view on Meta::CPAN
If you want to check for the presence of particular functions in a
library, or even that those functions return particular results, then
you can pass your own function body for main() thus:
check_lib_or_exit(
function => 'foo();if(libversion() > 5) return 0; else return 1;'
incpath => ...
libpath => ...
lib => ...
header => ...
);
In that case, it will fail to build if either foo() or libversion() don't
exist, and main() will return the wrong value if libversion()'s return
value isn't what you want.
inc/Devel/CheckLib.pm view on Meta::CPAN
returning false instead of dieing, or true otherwise.
=cut
sub check_lib_or_exit {
eval 'assert_lib(@_)';
if($@) {
warn $@;
exit;
}
}
sub check_lib {
eval 'assert_lib(@_)';
return $@ ? 0 : 1;
}
# borrowed from Text::ParseWords
sub _parse_line {
my($delimiter, $keep, $line) = @_;
my($word, @pieces);
no warnings 'uninitialized'; # we will be testing undef strings
while (length($line)) {
# This pattern is optimised to be stack conservative on older perls.
# Do not refactor without being careful and testing it on very long strings.
# See Perl bug #42980 for an example of a stack busting input.
$line =~ s/^
(?:
# double quoted string
(") # $quote
((?>[^\\"]*(?:\\.[^\\"]*)*))" # $quoted
| # --OR--
# singe quoted string
(') # $quote
((?>[^\\']*(?:\\.[^\\']*)*))' # $quoted
| # --OR--
# unquoted string
( # $unquoted
(?:\\.|[^\\"'])*?
)
# followed by
( # $delim
\Z(?!\n) # EOL
| # --OR--
(?-x:$delimiter) # delimiter
| # --OR--
(?!^)(?=["']) # a quote
)
)//xs or return; # extended layout
my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);
return() unless( defined($quote) || length($unquoted) || length($delim));
if ($keep) {
$quoted = "$quote$quoted$quote";
}
else {
$unquoted =~ s/\\(.)/$1/sg;
if (defined $quote) {
$quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
}
}
$word .= substr($line, 0, 0); # leave results tainted
$word .= defined $quote ? $quoted : $unquoted;
if (length($delim)) {
push(@pieces, $word);
push(@pieces, $delim) if ($keep eq 'delimiters');
undef $word;
}
if (!length($line)) {
push(@pieces, $word);
}
}
return(@pieces);
}
sub assert_lib {
my %args = @_;
my (@libs, @libpaths, @headers, @incpaths);
# FIXME: these four just SCREAM "refactor" at me
@libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib})
if $args{lib};
@libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath})
if $args{libpath};
@headers = (ref($args{header}) ? @{$args{header}} : $args{header})
if $args{header};
@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)
}
}
die("Couldn't find your C compiler.\n");
}
sub check_compiler
{
my ($compiler, $debug) = @_;
if (-f $compiler && -x $compiler) {
if ($debug) {
warn("# Compiler seems to be $compiler\n");
}
return 1;
}
return '';
}
# code substantially borrowed from IPC::Run3
sub _quiet_system {
my (@cmd) = @_;
# save handles
local *STDOUT_SAVE;
local *STDERR_SAVE;
open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT";
open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR";
# redirect to nowhere
local *DEV_NULL;
open DEV_NULL, ">" . File::Spec->devnull
or die "CheckLib: $! opening handle to null device";
open STDOUT, ">&" . fileno DEV_NULL
or die "CheckLib: $! redirecting STDOUT to null handle";
open STDERR, ">&" . fileno DEV_NULL
or die "CheckLib: $! redirecting STDERR to null handle";
# run system command
my $rv = system(@cmd);
# restore handles
open STDOUT, ">&" . fileno STDOUT_SAVE
or die "CheckLib: $! restoring STDOUT handle";
open STDERR, ">&" . fileno STDERR_SAVE
or die "CheckLib: $! restoring STDERR handle";
return $rv;
}
=head1 PLATFORMS SUPPORTED
You must have a C compiler installed. We check for C<$Config{cc}>,
inc/Devel/CheckLib.pm view on Meta::CPAN
Feedback is most welcome, including constructive criticism.
Bug reports should be made using L<http://rt.cpan.org/> or by email.
When submitting a bug report, please include the output from running:
perl -V
perl -MDevel::CheckLib -e0
=head1 SEE ALSO
L<Devel::CheckOS>
AAAA-Mail-SpamAssassin
view release on metacpan or search on metacpan
lib/AAAA/Mail/SpamAssassin.pm view on Meta::CPAN
use warnings;
package AAAA::Mail::SpamAssassin;
# git description: v0.001-1-g4fcbc88
BEGIN {
$AAAA::Mail::SpamAssassin::AUTHORITY = 'cpan:SCHWIGON';
}
{
$AAAA::Mail::SpamAssassin::VERSION = '0.002';
}
# ABSTRACT: making Mail::SpamAssassin installable
1;
lib/AAAA/Mail/SpamAssassin.pm view on Meta::CPAN
AAAA::Mail::SpamAssassin - making Mail::SpamAssassin installable
=head1 SYNOPSIS
# in Makefile.PL
requires 'AAAA::Mail::SpamAssassin';
=head1 DESCRIPTION
For some reason dependency resolution via the CPAN toolchains does not
work very well for L<Mail::SpamAssassin>. To install it without manual
AAAAAAAAA
view release on metacpan or search on metacpan
aaa/AAAAAAAAA.pm view on Meta::CPAN
our $VERSION = '1.01';
my @aaaaaaa = ('a'..'z', 'A'..'Z', 0..9);
my %aaaaaaaa_aa_aaaa;
for my $a (0..$#aaaaaaa) {
my $aaaa = sprintf("%06b", $a);
$aaaa =~ s{0}{a}g;
$aaaa =~ s{1}{A}g;
$aaaaaaaa_aa_aaaa{ $aaaaaaa[$a] } = $aaaa;
}
my %aaaa_aa_aaaaaaaa;
@aaaa_aa_aaaaaaaa{values %aaaaaaaa_aa_aaaa} = keys %aaaaaaaa_aa_aaaa;
sub aaaa {
open my $aa, "<", $0 or die "Aaa'a aaaa aaa aaaaaa aaaa aaa aaaaaaaaaaa: $!";
my $aaaa = join "", <$aa>;
$aaaa =~ s{use\s+AAAAAAAAA\b}{}x;
# Aaa aaa aaaaaaa
if( $aaaa =~ /[b-zB-Z0-9]/ ) {
my $aaaaaaaa_aaaa = $aaaa;
aaaaaa(\$aaaa);
eval $aaaaaaaa_aaaa;
}
else {
aaaaaaaa(\$aaaa);
eval $aaaa;
}
exit;
}
sub aaaaaa {
my $aaaa = shift;
$$aaaa =~ s{([a-zA-Z0-9])}{$aaaaaaaa_aa_aaaa{$1}}gx;
open my $aa, ">", $0 or die "Aaa'a aaaa aaa aaaaaa aaaa aaa aaaaaaaaaaa: $!";
print $aa "use AAAAAAAAA";
print $aa $$aaaa;
return;
}
sub aaaaaaaa {
my $aaaa = shift;
$$aaaa =~ s{ ([Aa]{6}) }{$aaaa_aa_aaaaaaaa{$1}}gx;
return;
}
aaaa();
aaa/AAAAAAAAA.pm view on Meta::CPAN
AAAAAAAAA - Aaaaaa aaaaa aa aaaaaa Aaaaa aaaa
=head1 AAAAAAAA
use AAAAAAAAA;
=head1 AAAAAAAAAAA
AAAAAAA AA AAA AAAAAAAAA AAAAA AA AAAAAA AAAAAA, AAAAAAA AA AAAAAA
AAAAAA, AAAAA AAAAAAA AAA! AA AAA AAAA AAAA AAAAAAAA AAAA AA AAAAAA
AAAAA
AAAA AAAA AAAAAA AA AAA!
AAA AAAA AAAA AAA!
AAAAAAA AAAAA AAA!
AAAAA AAAA AAA!
AAAA AAAAA AAA!
AAA AAAAAA "A" AAAA AAA!
AAAAA AAA AAA, AAAAAAA AAA AAAA, AA AAAAAA AAAAAA, AAAA AAAAA AAA!
AAAA, AA AAAAAA AAAAAA, AAAA AAAA(A) AAA!
AAC-Pvoice
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__
ABI
view release on metacpan or search on metacpan
our $VERSION = '1.0';
=head1 SYNOPSIS
my $abi = ABI->new(-file=>"mysequence.abi");
my $seq = $abi->get_sequence(); # To get the sequence
my @trace_a = $abi->get_trace("A"); # Get the raw traces for "A"
my @trace_g = $abi->get_trace("G"); # Get the raw traces for "G"
my @base_calls = $abi->get_base_calls(); # Get the base calls
=head1 DESCRIPTION
An ABI chromatogram file is in binary format. It contain several
information only some of which is required for normal use. This
=head1 CONSTRUCTOR
=head2 new()
Usage : $abi = ABI->new(-file=>"filename");
$abi = ABI->new("filename"); # same thing
=cut
sub new {
my $class = shift;
my $self = {};
bless $self, ref($class) || $class;
$self->_init(@_);
#print "****", $self->{_mac_header}, "\n";
return $self;
}
sub _init {
my ( $self, @args ) = @_;
my ($file) = $self->_rearrange( ["FILE"], @args );
if ( !defined($file) ) {
croak "Can't open the input file\n";
} else {
$self->set_file_handle($file);
}
$self->{_sequence} = "";
$self->{_sequence_corrected} = "";
$self->{_sample} = "";
$self->{A} = [];
$self->{T} = [];
$self->{G} = [];
$self->{C} = [];
$self->{_basecalls} = [];
$self->{_basecalls_corrected} = [];
$self->{_trace_length} = 0;
$self->{_seq_length} = 0;
$self->{_seq_length_corrected} = 0;
$self->{_abs_index} = 26;
$self->{_index} = undef;
$self->{PLOC1} = undef;
$self->{PLOC} = undef;
$self->{_a_start} = undef;
$self->{_g_start} = undef;
$self->{_c_start} = undef;
$self->{_t_start} = undef;
$self->{DATA9} = undef;
$self->{DATA10} = undef;
$self->{DATA11} = undef;
$self->{DATA12} = undef;
$self->{PBAS1} = undef;
$self->{PBAS2} = undef;
$self->{FWO} = undef;
$self->{_mac_header} = 0;
$self->{_maximum_trace} = 0;
if ( $self->_is_abi() ) {
#print "ABI FILE\n";
$self->_set_index();
$self->_set_base_calls();
$self->_set_corrected_base_calls();
$self->_set_seq();
$self->_set_corrected_seq();
$self->_set_traces();
$self->_set_max_trace();
$self->_set_sample_name();
close( $self->{_fh} );
}
return $self;
}
sub set_file_handle {
my $self = shift;
my $path = shift;
my $fh = IO::File->new();
if ( $fh->open("< $path") ) {
binmode($fh);
$self->{_fh} = $fh;
} else {
croak "Could not open $path in ABITrace::set_file_handle\n";
}
}
sub _rearrange {
my ( $self, $order, @param ) = @_;
return unless @param;
return @param unless ( defined( $param[0] ) && $param[0] =~ /^-/ );
for ( my $i = 0 ; $i < @param ; $i += 2 ) {
$param[$i] =~ s/^\-//;
$param[$i] =~ tr/a-z/A-Z/;
}
# Now we'll convert the @params variable into an associative array.
local ($^W) = 0; # prevent "odd number of elements" warning with -w.
my (%param) = @param;
my (@return_array);
# What we intend to do is loop through the @{$order} variable,
# and for each value, we use that as a key into our associative
# array, pushing the value at that key onto our return array.
my ($key);
foreach $key ( @{$order} ) {
my ($value) = $param{$key};
delete $param{$key};
push( @return_array, $value );
}
# print "\n_rearrange() after processing:\n";
# my $i; for ($i=0;$i<@return_array;$i++) { printf "%20s => %s\n", ${$order}[$i], $return_array[$i]; } <STDIN>;
return (@return_array);
}
sub _is_abi {
my $self = shift;
my $fh = $self->{"_fh"};
my $buf;
seek( $fh, 0, 0 );
read( $fh, $buf, 3 );
#my $a = unpack("n*", $buf);
if ( $buf eq "ABI" ) {
return 1;
} else {
seek( $fh, 128, 0 );
read( $fh, $buf, 3 );
if ( $buf eq "ABI" ) {
$self->_set_mac_header();
return 1;
} else {
return 0;
}
}
}
sub _set_mac_header {
my $self = shift;
$self->{_mac_header} = 128;
}
sub _set_index {
my $self = shift;
my $data_counter = 0;
my $pbas_counter = 0;
my $ploc_counter = 0;
my ( $num_records, $buf );
#print $self->{_fh}, "\n";
#print $self->{_mac_header}, "\n";
seek( $self->{_fh}, $self->{_abs_index} + $self->{_mac_header}, 0 );
read( $self->{_fh}, $buf, 4 );
$self->{_index} = unpack( "N", $buf );
#print $self->{_index};
seek( $self->{_fh}, $self->{_abs_index} - 8 + $self->{_mac_header}, 0 );
read( $self->{_fh}, $buf, 4 );
$num_records = unpack( "N", $buf );
for ( my $i = 0 ; $i <= $num_records - 1 ; $i++ ) {
seek( $self->{_fh}, $self->{_index} + ( $i * 28 ), 0 );
read( $self->{_fh}, $buf, 4 );
if ( $buf eq "FWO_" ) {
$self->{FWO} = $self->{_index} + ( $i * 28 ) + 20;
}
if ( $buf eq "DATA" ) {
$data_counter++;
if ( $data_counter == 9 ) {
$self->{DATA9} = $self->{_index} + ( $i * 28 ) + 20;
}
if ( $data_counter == 10 ) {
$self->{DATA10} = $self->{_index} + ( $i * 28 ) + 20;
}
if ( $data_counter == 11 ) {
$self->{DATA11} = $self->{_index} + ( $i * 28 ) + 20;
}
if ( $data_counter == 12 ) {
$self->{DATA12} = $self->{_index} + ( $i * 28 ) + 20;
}
}
if ( $buf eq "PBAS" ) {
$pbas_counter++;
if ( $pbas_counter == 1 ) {
$self->{PBAS1} = $self->{_index} + ( $i * 28 ) + 20;
}
if ( $pbas_counter == 2 ) {
$self->{PBAS2} = $self->{_index} + ( $i * 28 ) + 20;
}
}
if ( $buf eq "PLOC" ) {
$ploc_counter++;
if ( $ploc_counter == 1 ) {
$self->{PLOC1} = $self->{_index} + ( $i * 28 ) + 20;
}
if ( $ploc_counter == 2 ) {
$self->{PLOC} = $self->{_index} + ( $i * 28 ) + 20;
}
}
if ( $buf eq "SMPL" ) {
$self->{SMPL} = $self->{_index} + ( $i * 28 ) + 20;
}
}
seek( $self->{_fh}, $self->{DATA12} - 8, 0 );
read( $self->{_fh}, $buf, 4 );
$self->{_trace_length} = unpack( "N", $buf );
seek( $self->{_fh}, $self->{PBAS2} - 4, 0 );
read( $self->{_fh}, $buf, 4 );
$self->{_seq_length} = unpack( "N", $buf );
seek( $self->{_fh}, $self->{PBAS1} - 4, 0 );
read( $self->{_fh}, $buf, 4 );
$self->{_seq_length_corrected} = unpack( "N", $buf );
$self->{PLOC} = $self->_get_int( $self->{PLOC} ) + $self->{_mac_header};
$self->{PLOC1} = $self->_get_int( $self->{PLOC1} ) + $self->{_mac_header};
$self->{DATA9} = $self->_get_int( $self->{DATA9} ) + $self->{_mac_header};
$self->{DATA10} = $self->_get_int( $self->{DATA10} ) + $self->{_mac_header};
$self->{DATA11} = $self->_get_int( $self->{DATA11} ) + $self->{_mac_header};
$self->{DATA12} = $self->_get_int( $self->{DATA12} ) + $self->{_mac_header};
$self->{PBAS1} = $self->_get_int( $self->{PBAS1} ) + $self->{_mac_header};
$self->{PBAS2} = $self->_get_int( $self->{PBAS2} ) + $self->{_mac_header};
$self->{SMPL} += $self->{_mac_header};
}
sub _set_base_calls {
my $self = shift;
my $buf;
my $length = $self->{_seq_length} * 2;
my $fh = $self->{_fh};
seek( $fh, $self->{PLOC}, 0 );
read( $fh, $buf, $length );
@{ $self->{_basecalls} } = unpack( "n" x $length, $buf );
# print "@{$self->{_basecalls}}" , "\n";
}
sub _set_corrected_base_calls {
my $self = shift;
my $buf;
my $length = $self->{_seq_length_corrected} * 2;
my $fh = $self->{_fh};
seek( $fh, $self->{PLOC1}, 0 );
read( $fh, $buf, $length );
@{ $self->{_basecalls_corrected} } = unpack( "n" x $length, $buf );
}
sub _set_seq {
my $self = shift;
my $buf;
my $length = $self->{_seq_length};
my $fh = $self->{_fh};
seek( $fh, $self->{PBAS2}, 0 );
read( $fh, $buf, $length );
$self->{_sequence} = $buf;
#my @seq = unpack( "C" x $length, $buf);
#print $buf, "\n";
}
sub _set_corrected_seq {
my $self = shift;
my $buf;
my $length = $self->{_seq_length_corrected};
my $fh = $self->{_fh};
seek( $fh, $self->{PBAS1}, 0 );
read( $fh, $buf, $length );
$self->{_sequence_corrected} = $buf;
}
sub _set_traces {
my $self = shift;
my $buf;
my ( @pointers, @A, @G, @C, @T );
my (@datas) =
( $self->{DATA9}, $self->{DATA10}, $self->{DATA11}, $self->{DATA12} );
my $fh = $self->{_fh};
seek( $fh, $self->{FWO}, 0 );
read( $fh, $buf, 4 );
my @order = split( //, $buf );
#print "@order", "\n";
for ( my $i = 0 ; $i < 4 ; $i++ ) {
if ( $order[$i] =~ /A/i ) {
$pointers[0] = $datas[$i];
} elsif ( $order[$i] =~ /C/i ) {
$pointers[1] = $datas[$i];
} elsif ( $order[$i] =~ /G/i ) {
$pointers[2] = $datas[$i];
} elsif ( $order[$i] =~ /T/i ) {
$pointers[3] = $datas[$i];
} else {
croak "Wrong traces\n";
}
}
for ( my $i = 0 ; $i < 4 ; $i++ ) {
seek( $fh, $pointers[$i], 0 );
read( $fh, $buf, $self->{_trace_length} * 2 );
if ( $i == 0 ) {
@A = unpack( "n" x $self->{_trace_length}, $buf );
}
if ( $i == 1 ) {
@C = unpack( "n" x $self->{_trace_length}, $buf );
}
if ( $i == 2 ) {
@G = unpack( "n" x $self->{_trace_length}, $buf );
}
if ( $i == 3 ) {
@T = unpack( "n" x $self->{_trace_length}, $buf );
}
}
@{ $self->{A} } = @A;
@{ $self->{G} } = @G;
@{ $self->{T} } = @T;
@{ $self->{C} } = @C;
}
sub _get_int {
my $self = shift;
my $buf;
my $pos = shift;
my $fh = $self->{_fh};
seek( $fh, $pos, 0 );
read( $fh, $buf, 4 );
return unpack( "N", $buf );
}
sub _set_max_trace {
my $self = shift;
my @A = @{ $self->{A} };
my @T = @{ $self->{T} };
my @G = @{ $self->{G} };
my @C = @{ $self->{C} };
my $max = 0;
for ( my $i = 0 ; $i < @T ; $i++ ) {
if ( $T[$i] > $max ) { $max = $T[$i]; }
if ( $A[$i] > $max ) { $max = $A[$i]; }
if ( $G[$i] > $max ) { $max = $G[$i]; }
if ( $C[$i] > $max ) { $max = $C[$i]; }
}
$self->{_maximum_trace} = $max;
}
sub _set_sample_name {
my $self = shift;
my $buf;
my $fh = $self->{_fh};
seek( $fh, $self->{SMPL}, 0 );
read( $fh, $buf, 1 );
my $length = unpack( "C", $buf );
read( $fh, $buf, $length );
$self->{_sample} = $buf;
}
=head1 METHODS
=head2 get_max_trace()
Title : get_max_trace()
Usage : $max = $abi->get_max_trace();
Function : Returns the maximum trace value of all the traces.
Args : Nothing
Returns : A scalar
=cut
sub get_max_trace {
my $self = shift;
return $self->{_maximum_trace};
}
=head2 get_trace()
Title : get_trace()
Usage : my @a = $abi->get_trace("A");
Function : Returns the raw traces as array.
Args : "A" or "G" or "C" or "T"
Returns : An array
=cut
sub get_trace {
my $self = shift;
my $symbol = shift;
if ( $symbol =~ /A/i ) {
return @{ $self->{A} };
} elsif ( $symbol =~ /G/i ) {
return @{ $self->{G} };
} elsif ( $symbol =~ /C/i ) {
return @{ $self->{C} };
} elsif ( $symbol =~ /T/i ) {
return @{ $self->{T} };
} else {
croak "Illegal symbol\n";
}
}
=head2 get_sequence()
Title : get_sequence()
Usage : my $seq = $abi->get_sequence();
Function : Returns the original unedited sequence as string. If you want to access the edited
sequence use "get_corrected_sequence()" instead.
Args : Nothing
Returns : A scalar
=cut
sub get_sequence {
my $self = shift;
return $self->{_sequence};
}
=head2 get_corrected_sequence()
Title : get_corrected_sequence()
Usage : my $seq = $abi->get_corrected_sequence();
Function : Returns the corrected sequence as string. If you want to access the original
unedited sequence, use "get_sequence()" instead.
Args : Nothing
Returns : A scalar
=cut
sub get_corrected_sequence {
my $self = shift;
return $self->{_sequence_corrected};
}
=head2 get_sequence_length()
Title : get_sequence_length()
Usage : my $seq_length = $abi->get_sequence_length();
Function : Returns the sequence length of the orginal unedited sequence.
Args : Nothing
Returns : A scalar
=cut
sub get_sequence_length {
my $self = shift;
return $self->{_seq_length};
}
=head2 get_corrected_sequence_length()
Title : get_corrected_sequence_length()
Usage : my $seq_length = $abi->get_corrected_sequence_length();
Function : Returns the length of the edited sequence.
Args : Nothing
Returns : A scalar
=cut
sub get_corrected_sequence_length {
my $self = shift;
#print STDERR "**ABI**",$self->{_seq_length_corrected},"\n";
return $self->{_seq_length_corrected};
}
=head2 get_trace_length()
Title : get_trace_length()
Usage : my $trace_length = $abi->get_trace_length();
Function : Returns the trace length
Args : Nothing
Returns : A scalar
=cut
sub get_trace_length {
my $self = shift;
return $self->{_trace_length};
}
=head2 get_base_calls()
Title : get_base_calls()
Usage : my @base_calls = $abi->get_base_calls();
Function : Returns the called bases by the base caller. This method will return the unedited
original basecalls created by the basecaller.
Args : Nothing
Returns : An array
=cut
sub get_base_calls {
my $self = shift;
return @{ $self->{_basecalls} };
}
=head2 get_corrected_base_calls()
Title : get_corrected_base_calls()
Usage : my @base_calls = $abi->get_corrected_base_calls();
Function : If you have edited the trace file you can get the corrected base call
with this method
Args : Nothing
Returns : An array
=cut
sub get_corrected_base_calls {
my $self = shift;
return @{ $self->{_basecalls_corrected} };
}
=head2 get_sample_name()
Title : get_sample_name()
Usage : my $sample = $abi->get_sample_name();
Function : Returns hard coded sample name
Args : Nothing
Returns : A scalar
=cut
sub get_sample_name {
my $self = shift;
return $self->{_sample};
}
=head1 AUTHOR
Malay <malay@bioinformatics.org>
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ABI
You can also look for information at:
=over 4
ABNF-Grammar
view release on metacpan or search on metacpan
lib/ABNF/Generator.pm view on Meta::CPAN
our @EXPORT_OK = qw($CONVERTERS $BASIC_RULES $RECURSION_LIMIT);
Readonly our $CHOICE_LIMIT => 128;
Readonly our $CONVERTERS => {
"hex" => sub { hex($_[0]) },
"bin" => sub { oct($_[0]) },
"decimal" => sub { int($_[0]) },
};
=pod
=head1 ABNF::Generator->C<new>($grammar, $validator?)
lib/ABNF/Generator.pm view on Meta::CPAN
Children classes can get acces for them by $self->{_grammar} and $self->{_validator}
=cut
method new(ABNF::Grammar $grammar, ABNF::Validator $validator?) {
my $class = ref($self) || $self;
croak "Cant create instance of abstract class" if $class eq 'ABNF::Generator';
$self = {
_cache => {},
_grammar => $grammar,
_validator => $validator || ABNF::Validator->new($grammar)
};
bless($self, $class);
$self->_init();
return $self;
}
method _init() {
$self->{handlers} = {
Range => $self->can("_range"),
String => $self->can("_string"),
Literal => $self->can("_literal"),
Repetition => $self->can("_repetition"),
ProseValue => $self->can("_proseValue"),
Reference => $self->can("_reference"),
Group => $self->can("_group"),
Choice => $self->can("_choice"),
Rule => $self->can("_rule"),
};
}
=pod
=head1 $generator->C<_range>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _range($rule, $recursion) {
croak "Range handler is undefined yet";
}
=pod
=head1 $generator->C<_string>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _string($rule, $recursion) {
croak "String handler is undefined yet";
}
=pod
=head1 $generator->C<_literal>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _literal($rule, $recursion) {
croak "Literal handler is undefined yet";
}
=pod
=head1 $generator->C<_repetition>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _repetition($rule, $recursion) {
croak "Repetition handler is undefined yet";
}
=pod
=head1 $generator->C<_reference>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _reference($rule, $recursion) {
croak "Reference handler is undefined yet";
}
=pod
=head1 $generator->C<_group>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _group($rule, $recursion) {
croak "Group handler is undefined yet";
}
=pod
=head1 $generator->C<_choice>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _choice($rule, $recursion) {
croak "Choice handler is undefined yet";
}
=pod
=head1 $generator->C<_rule>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
$recursion is a structure to controle recursion depth.
=cut
method _rule($rule, $recursion) {
croak "Rule handler is undefined yet";
}
=pod
=head1 $generator->C<_generateChain>($rule, $recursion)
lib/ABNF/Generator.pm view on Meta::CPAN
=cut
method _generateChain($rule, $recursion) {
my @result = ();
if ( ref($rule) ) {
croak "Bad rule " . Dumper($rule) unless UNIVERSAL::isa($rule, "HASH");
} elsif ( exists($BASIC_RULES->{$rule}) ) {
$rule = $BASIC_RULES->{$rule};
} else {
$rule = $self->{_grammar}->rule($rule);
}
$self->{handlers}->{ $rule->{class} }
or die "Unknown class " . $rule->{class};
return $self->{handlers}->{ $rule->{class} }->($self, $rule, $recursion);
}
=pod
=head1 $generator->C<generate>($rule, $tail="")
lib/ABNF/Generator.pm view on Meta::CPAN
dies if there is no command like $rule.
=cut
method generate(Str $rule, Str $tail="") {
croak "Unexisted command" unless $self->{_grammar}->hasCommand($rule);
$self->{_cache}->{$rule} ||= [];
unless ( @{$self->{_cache}->{$rule}} ) {
$self->{_cache}->{$rule} = _asStrings( $self->_generateChain($rule, {level => 0}) );
}
my $result = pop($self->{_cache}->{$rule});
my $rx = eval { qr/$tail$/ };
croak "Bad tail" if $@;
return $result =~ $rx ? $result : $result . $tail;
}
=pod
=head1 $generator->C<withoutArguments>($name, $tail="")
lib/ABNF/Generator.pm view on Meta::CPAN
dies if there is no command like $rule.
=cut
method withoutArguments(Str $name, Str $tail="") {
croak "Unexisted command" unless $self->{_grammar}->hasCommand($name);
my ($prefix, $args) = splitRule( $self->{_grammar}->rule($name) );
my $rx = eval { qr/$tail$/ };
croak "Bad tail" if $@;
return $prefix =~ $rx ? $prefix : $prefix . $tail;
}
=pod
=head1 $generator->C<hasCommand>($name)
lib/ABNF/Generator.pm view on Meta::CPAN
Return 1 if there is a $name is command, 0 otherwise
=cut
method hasCommand(Str $name) {
$self->{_grammar}->hasCommand($name);
}
=pod
=head1 FUNCTIONS
lib/ABNF/Generator.pm view on Meta::CPAN
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
AC-DC
view release on metacpan or search on metacpan
lib/AC/ConfigFile/Simple.pm view on Meta::CPAN
use strict;
my $MINSTAT = 15;
my %CONFIG = (
include => \&include_file,
debug => \&parse_debug,
allow => \&parse_allow,
_default => \&parse_keyvalue,
);
sub new {
my $class = shift;
my $file = shift;
my $me = bless {
_laststat => $^T,
_lastconf => $^T,
_configfile => $file,
_files => [ ],
@_,
}, $class;
$me->_read();
return $me;
}
sub check {
my $me = shift;
my $now = $^T;
return if $now - $me->{_laststat} < $MINSTAT;
$me->{_laststat} = $now;
my $changed;
for my $file ( @{$me->{_files}} ){
my $mtime = (stat($file))[9];
$changed = 1 if $mtime > $me->{_lastconf};
}
return unless $changed;
verbose("config file changed. reloading");
$me->{_lastconf} = $now;
eval {
$me->_read();
verbose("installed new config file");
if( my $f = $me->{onreload} ){
$f->();
}
};
if(my $e = $@){
problem("error reading new config file: $e");
return;
}
return 1;
}
sub _read {
my $me = shift;
delete $me->{_pending};
$me->_readfile($me->{_configfile});
$me->{config} = $me->{_pending};
delete $me->{_pending};
}
sub _readfile {
my $me = shift;
my $file = shift;
my $fd;
open($fd, $file) || die "cannot open file '$file': $!";
$me->{fd} = $fd;
push @{$me->{_files}}, $file;
while( defined(my $l = $me->_nextline()) ){
my($key, $rest) = split /\s+/, $l, 2;
$me->handle_config( $key, $rest ) || die "invalid config '$key'\n";
}
close $fd;
}
sub handle_config {
my $me = shift;
my $key = shift;
my $rest = shift;
my $fnc = $CONFIG{$key} || $CONFIG{_default};
return unless $fnc;
$fnc->($me, $key, $rest);
return 1;
}
sub _nextline {
my $me = shift;
my $line;
while(1){
my $fd = $me->{fd};
my $l = <$fd>;
return $line unless defined $l;
chomp $l;
$l =~ s/\#.*$//;
$l =~ s/^\s*//;
$l =~ s/\s+$//;
next if $l =~ s/^\s*$/; #/;
$line .= $l;
if( $line =~ /\\$/ ){
chop $line;
next;
}
return $line;
}
}
################################################################
sub include_file {
my $me = shift;
my $key = shift;
my $file = shift;
$file =~ s/^"(.*)"$/$1/;
if( $file !~ m|^/| ){
# add path from main config file
my($path) = $me->{_configfile} =~ m|(.*)/[^/]+$|;
$file = "$path/$file" if $path;
}
my $fd = $me->{fd};
$me->_readfile($file);
$me->{fd} = $fd;
}
sub parse_keyvalue {
my $me = shift;
my $key = shift;
my $value = shift;
problem("parameter '$key' redefined") if $me->{_pending}{$key};
$me->{_pending}{$key} = $value;
}
sub parse_keyarray {
my $me = shift;
my $key = shift;
my $value = shift;
push @{$me->{_pending}{$key}}, $value;
}
sub parse_allow {
my $me = shift;
my $key = shift;
my $acl = shift;
my($host, $len) = split m|/|, $acl;
$host ||= $acl;
$len ||= 32;
push @{$me->{_pending}{acl}}, [ inet_aton($host), inet_lton($len) ];
}
sub parse_debug {
my $me = shift;
my $key = shift;
my $value = shift;
$me->{_pending}{debug}{$value} = 1;
}
################################################################
sub config {
my $me = shift;
return $me->{config};
}
sub get {
my $me = shift;
my $k = shift;
return $me->{config}{$k};
}
sub check_acl {
my $me = shift;
my $ip = shift; # ascii
my $ipn = inet_aton($ip);
for my $acl ( @{$me->{config}{acl}} ){
my($net, $mask) = @$acl;
return 1 if ($ipn & $mask) eq $net;
}
return 0;
}
1;
AC-MrGamoo
view release on metacpan or search on metacpan
eg/filelist.pm view on Meta::CPAN
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;
AC-Yenta
view release on metacpan or search on metacpan
eg/myself.pm view on Meta::CPAN
use strict;
my $SERVERID;
sub init {
my $class = shift;
my $port = shift; # our tcp port
my $id = shift; # from cmd line
$SERVERID = $id;
unless( $SERVERID ){
(my $h = hostname()) =~ s/\.example.com//; # remove domain
$SERVERID = "yenta/$h";
}
verbose("system persistent-id: $SERVERID");
}
sub my_server_id {
return $SERVERID;
}
1;
ACH-Generator
view release on metacpan or search on metacpan
lib/ACH/Generator.pm view on Meta::CPAN
package ACH::Generator;
$VERSION = '0.01';
use strict;
use warnings;
use ACH;
sub _croak { require Carp; Carp::croak(@_) }
=head1 NAME
ACH::Generator - Generates an ACH formatted file from an ACH perl object
=head1 VERSION
Version: 0.01
May 2006
=head1 DESCRIPTION
ACH::Generator is a simple, generic subclass of ACH used to generate ACH files.
It's intentional use is for testing purposes ONLY. ACH-Generator will allow a
developer to create an ACH formatted file.
=head1 USING ACH-Generator
use ACH::Generator;
my $newACH = new ACH;
my $newACHfile = 'newACHFile.ACH'; # The name of the ACH file to be generated
...
$newACH->generate($newACHfile);
=head1 METHODS
=head2 generate
Generates an ACH file from the data in the ACH object
=cut
# Generate the ACH file
sub ACH::generate {
# Get the file name
my $self = shift;
my $file = shift or _croak "Need an ACH file";
# File data
my $data = "";
# Iterate through the ACH Data
foreach my $item (@{$self->{_achData}}) { # Array of ACH file Sections
my @achSections = map { defined $_ ? $_ : '' } @{$item};
my $sectionValue = 0;
for (my $y=0; $y < @achSections; $y++) { # Array of ACH file Section data
my %hash = map { defined $_ ? $_ : '' } %{$achSections[$y]};
# Use the appropriate file Format size for the appropriate ACH file section
foreach my $hashItem (keys (%hash)) { # Hash containing the ACH field name and value
chomp $hash{$hashItem};
my $dataValue = "";
# Get the section header in the first field, else get the data
if ($y == 0) { $dataValue = $sectionValue = $hash{$hashItem}; }
else {
# Get the field length and data
my $field = ${$self->{_achFormats}{$sectionValue}}[$y];
my ($field_length); while ( my ($key, $value) = each(%$field) ) { $field_length = $value; }
$dataValue = substr($hash{$hashItem}, 0, $field_length);
}
# Store the data in the file data variable
$data .= $dataValue;
}
}
}
# Open the file
if ( open(OUTPUT, ">$file") ) {}
else { print "Error: Couldn't open file $file\n"; die; }
# Print data out to ACH file
print OUTPUT "$data";
# Close the ACH file
close (OUTPUT);
}
=head2 CAVEATS
This package is created for testing purposes only. It shouldn't be used
for production programs or scripts. There are other commercial products
out there that may be a more efficient solution for accomplishing your
goals.
All records in an ACH file must be formatted in the following sequence
of records. IF the file is not formatted in this exact sequence, it
may be rejected.
ACH File Layout:
1 - File Header Record
5 - First Company/Batch Header Record
6 - First Entry Detail Record
7 - First Entry Detail Addenda Record (optional)
|
Multiples of Entry Detail Records
|
6 - Last Entry Detail Record
7 - Last Entry Detail Addenda Record (optional)
8 - First Company/Batch Control Record
|
Multiples of Company/Batches
|
5 - Last Company/Batch Header Record
6 - First Entry Detail Record
7 - First Entry Detail Addenda Record (optional)
|
Multiples of Entry Detail Records
|
6 - Last Entry Detail Record
7 - Last Entry Detail Addenda Record (optional)
8 - Last Company/Batch Control Record
9 - File Control Record
9999...9999 (optional)
=head1 AUTHOR
Author: Christopher Kois
Date: May, 2006
Contact: cpkois@cpan.org
=head1 COPYRIGHTS
The ACH-Generator module is Copyright (c) May, 2006 by Christopher Kois.
http://www.christopherkois.com All rights reserved. You may distribute this
module under the terms of GNU General Public License (GPL).
=head1 SUPPORT/WARRANTY
ACH-Generator is free Open Source software. IT COMES WITHOUT WARRANTY OR SUPPORT OF ANY KIND.
=head1 KNOWN BUGS
This is version 0.01 of ACH::Generator. There are currently no known bugs.
=head1 SEE ALSO
L<ACH>. L<ACH::Parser>
=cut
1;
ACH-Parser
view release on metacpan or search on metacpan
lib/ACH/Parser.pm view on Meta::CPAN
package ACH::Parser;
$VERSION = '0.01';
use strict;
use warnings;
use ACH;
sub _croak { require Carp; Carp::croak(@_) }
=head1 NAME
ACH::Parser - Parse an ACH formatted file to ACH perl object
=head1 VERSION
Version: 0.01
May 2006
=head1 DESCRIPTION
ACH::Parser is a simple, generic ACH file to ACH object parser.
It's intentional use is for testing purposes ONLY. ACH-Parser will
allow a developer to look at the particular fields in an ACH formatted
file.
=head1 USING ACH-Parser
use ACH::Parser;
my $file = 'RETODC0104A.ACH';
my $ach = new ACH;
$ach->parse($file);
=head1 METHODS
=head2 parse
Parses the ACH data into the ACH object
=cut
# Parse the ACH file formatted text into an ACH object
sub ACH::parse {
# Get the file name
my $self = shift;
my $file = shift or _croak "Need an ACH file";
# Open the file
if ( open(INPUT, "$file") ) {}
else { print "Error: Couldn't open file $file\n"; die; }
# Get the file contents
my @data = <INPUT>;
my $dataline = $data[0];
my $pos = 0;
# Loop Through all entries
while ($pos < length($dataline)) {
# Get the correct ACH format array and store all parsed data in a hash
my $desc = substr($dataline, $pos, 1);
my @dataArray = [];
# Make sure file descriptor is valid
if ($desc != 1 and $desc != 5 and $desc != 6 and $desc != 7 and $desc != 8 and $desc != 9) {
die "File Error: Code: $desc\n";
}
# Iterate through the appropriate ACH file format array and parse the data
for (my $x=0; $x < @{$self->{_achFormats}{$desc}}; $x++) {
my $field = ${$self->{_achFormats}{$desc}}[$x];
# Get the field name and length
my ($field_name, $field_length);
while ( my ($key, $value) = each(%$field) ) { $field_name = $key; $field_length = $value; }
# Get the ACH Data from the file
my $part = substr($dataline, $pos, $field_length); chomp $part;
my %hash = ($field_name => $part);
$dataArray[$x] = \%hash;
$pos += $field_length;
}
# Save data to list
@{$self->{_achData}}[scalar @{$self->{_achData}}] = \@dataArray;
}
# Close the Input file
close (INPUT);
}
=head2 CAVEATS
This package is created for testing purposes only. It shouldn't be used
for production programs or scripts. There are other commercial products
out there that may be a more efficient solution for accomplishing your
goals.
All records in an ACH file must be formatted in the following sequence
of records. IF the file is not formatted in this exact sequence, it
may be rejected.
ACH File Layout:
1 - File Header Record
5 - First Company/Batch Header Record
6 - First Entry Detail Record
7 - First Entry Detail Addenda Record (optional)
|
Multiples of Entry Detail Records
|
6 - Last Entry Detail Record
7 - Last Entry Detail Addenda Record (optional)
8 - First Company/Batch Control Record
|
Multiples of Company/Batches
|
5 - Last Company/Batch Header Record
6 - First Entry Detail Record
7 - First Entry Detail Addenda Record (optional)
|
Multiples of Entry Detail Records
|
6 - Last Entry Detail Record
7 - Last Entry Detail Addenda Record (optional)
8 - Last Company/Batch Control Record
9 - File Control Record
9999...9999 (optional)
=head1 AUTHOR
Author: Christopher Kois
Date: May, 2006
Contact: cpkois@cpan.org
=head1 COPYRIGHTS
The ACH-Parser module is Copyright (c) May, 2006 by Christopher Kois.
http://www.christopherkois.com All rights reserved. You may distribute this
module under the terms of GNU General Public License (GPL).
=head1 SUPPORT/WARRANTY
ACH-Parser is free Open Source software. IT COMES WITHOUT WARRANTY OR SUPPORT OF ANY KIND.
=head1 KNOWN BUGS
This is version 0.01 of ACH::Parser. There are currently no known bugs.
=head1 SEE ALSO
L<ACH>. L<ACH::Generator>
=cut
1;
ACH
view release on metacpan or search on metacpan
package ACH;
$VERSION = '0.01'; # Version number
use strict;
use warnings;
=head1 NAME
ACH - ACH perl object
=head1 VERSION
Version: 0.01
May 2006
=head1 DESCRIPTION
ACH is a simple, generic perl object that contains the data necesary to
create an ACH file. It's intentional use is for testing purposes ONLY.
ACH will allow a developer to manipulate specific data fields in an ACH
formatted object.
=head1 USING ACH
my $ACH = new ACH;
=cut
### Variables and functions
## Arrays that store sizes of the various records in the ACH file ##
# File Header Format fields and field sizes
my @fileFormat = ({'File Header Record' => 1}, {'Priority Code' => 2},
{'Immediate Destination' => 10}, {'Immediate Origin' => 10}, {'File Creation Date' => 6},
{'Creation Time' => 4}, {'File ID Modifier' => 1}, {'Record size' => 3}, {'Blocking Factor' => 2},
{'Format Code' => 1}, {'Destination' => 23}, {'Origin' => 23}, {'Reference Code' => 8});
# Batch Record fields and field sizes
my @batchFormat = ({'Batch Header Record' => 1}, {'Service Class Code' => 3},
{'Company Name' => 16}, {'Company Discretionary Data' => 20}, {'Company Identification' => 10},
{'Standard Entry Classes' => 3}, {'Company Entry Description' => 10},
{'Company Descriptive Date' => 6}, {'Effective Entry Date' => 6}, {'Settlement Date' => 3},
{'Originator Status Code' => 1}, {'Originating DFI Identification' => 8}, {'Batch #' => 7});
# Detail Record fields and field sizes
my @detailFormat = ({'Entry Detail Record' => 1}, {'Transaction Code' => 2},
{'Individual Bank ID' => 8}, {'Check Digit' => 1}, {'Bank Acct. Number' => 17}, {'Amount' => 10},
{'Individual ID Number' => 15}, {'Individual Name' => 22}, {'Bank Discretionary Data' => 2},
{'Addenda Record Indicator' => 1}, {'Trace Number' => 15});
# Addenda Format fields and field sizes
my @addendaFormat = ({'Addenda Record' => 1}, {'Addenda Type Code' => 2},
{'Payment Related Information' => 80}, {'Special Addenda Sequence Number' => 4},
{'Entry Detail Sequence Number' => 7});
# Batch Control Format fields and field sizes
my @controlFormat = ({'Batch Control Record' => 1}, {'Service Class Codes' => 3},
{'Entry/Addenda Count' => 6}, {'Entry Hash' => 10}, {'Total Debit Entry Dollar Amount' => 12},
{'Total Credit Entry Dollar Amount' => 12}, {'Company Identification' => 10}, {'Blank' => 19},
{'Blank' => 6}, {'Originating Financial Institution' => 8}, {'Batch Number' => 7});
# File Control fields and field sizes
my @fileControl = ({'File Control Record' => 1}, {'Batch Count' => 6}, {'Block Count' => 6},
{'Entry/Addenda Count' => 8}, {'Entry Hash' => 10}, {'Total Debit Entry Dollar Amount' => 12},
{'Total Credit Entry Dollar Amount' => 12}, {'Reserved/Blank' => 39});
# All of the ACH File Formats
my %achFormats = (1 => \@fileFormat, 5 => \@batchFormat, 6 => \@detailFormat,
7 => \@addendaFormat, 8 => \@controlFormat, 9 => \@fileControl);
##
# ACH data
my @achData;
=head1 METHODS
=head2 new
Creates a new ACH object
=cut
# Create a new ACH object
sub new {
my $class = shift;
my $self = {}; # allocate new hash for object
bless {
_achData => [],
_achFormats => \%achFormats,
}, $class;
}
=head2 printAllData
Prints all the ACH data
=cut
# Print all data from the ACH object
sub printAllData {
my $self = shift;
foreach my $item (@{$self->{_achData}}) { # Array of ACH file Sections
my @achSections = map { defined $_ ? $_ : '' } @{$item};
foreach my $section (@achSections) { # Array of ACH file Section data
my %hash = map { defined $_ ? $_ : '' } %{$section};
foreach my $hashItem (keys (%hash)) { # Hash containing the ACH field name and value
print "$hashItem: $hash{$hashItem}\n";
}
}
}
}
=head2 getData
Returns the ACH data
=cut
# Get data
sub getData {
my $self = shift;
return \@{$self->{_achData}};
}
=head2 CAVEATS
This package is created for testing purposes only. It shouldn't be used
for production programs or scripts. There are other commercial products
out there that may be a more efficient solution for accomplishing your
goals.
All records in an ACH file must be formatted in the following sequence
of records. IF the file is not formatted in this exact sequence, it
may be rejected.
ACH File Layout:
1 - File Header Record
5 - First Company/Batch Header Record
6 - First Entry Detail Record
7 - First Entry Detail Addenda Record (optional)
|
Multiples of Entry Detail Records
|
6 - Last Entry Detail Record
7 - Last Entry Detail Addenda Record (optional)
8 - First Company/Batch Control Record
|
Multiples of Company/Batches
|
5 - Last Company/Batch Header Record
6 - First Entry Detail Record
7 - First Entry Detail Addenda Record (optional)
|
Multiples of Entry Detail Records
|
6 - Last Entry Detail Record
7 - Last Entry Detail Addenda Record (optional)
8 - Last Company/Batch Control Record
9 - File Control Record
9999...9999 (optional)
=head1 AUTHOR
Author: Christopher Kois
Date: May, 2006
Contact: cpkois@cpan.org
=head1 COPYRIGHTS
The ACH module is Copyright (c) May, 2006 by Christopher Kois.
http://www.christopherkois.com All rights reserved. You may distribute
this module under the terms of GNU General Public License (GPL).
=head1 SUPPORT/WARRANTY
ACH is free Open Source software. IT COMES WITHOUT WARRANTY OR SUPPORT OF ANY KIND.
=head1 KNOWN BUGS
This is version 0.01 of ACH. There are currently no known bugs.
=head1 SEE ALSO
L<ACH::Generator>. L<ACH::Parser>
=cut
1;
ACL-Lite
view release on metacpan or search on metacpan
lib/ACL/Lite.pm view on Meta::CPAN
our $VERSION = '0.0004';
=head1 SYNOPSIS
use ACL::Lite;
$acl = ACL::Lite->new(permissions => 'foo,bar');
$acl->check('foo');
if ($ret = $acl->check([qw/baz bar/])) {
print "Check successful with permission $ret\n";
}
unless ($acl->check('baz')) {
print "Permission denied\n";
}
$acl = ACL::Lite->new(uid => 666);
$acl->check('authenticated');
=head1 DESCRIPTION
C<ACL::Lite> is a simple permission checker without any prerequisites.
lib/ACL/Lite.pm view on Meta::CPAN
=back
=cut
sub new {
my ($class, $self, $type, %args);
$class = shift;
%args = @_;
$self = {separator => $args{separator} || ',',
permissions => {},
uid => $args{uid},
volatile => 0};
bless $self, $class;
if (exists $args{permissions}) {
$type = ref($args{permissions});
if ($type eq 'ARRAY') {
for my $perm (@{$args{permissions}}) {
$self->{permissions}->{$perm} = 1;
}
}
elsif ($type eq 'CODE') {
$self->{volatile} = 1;
$self->{sub} = $args{permissions};
}
elsif (defined $args{permissions}) {
my @perms;
for my $perm (split(/$self->{separator}/, $args{permissions})) {
$perm =~ s/^\s+//;
$perm =~ s/\s+$//;
next unless length($perm);
$self->{permissions}->{$perm} = 1;
}
}
}
# add default permissions
if ($self->{uid}) {
$self->{permissions}->{authenticated} = 1;
}
else {
$self->{permissions}->{anonymous} = 1;
}
return $self;
}
=head2 check $permissions, $uid
Checks whether any of the permissions in $permissions is granted.
Returns first permission which grants access.
=cut
sub check {
my ($self, $permissions, $uid) = @_;
my (@check, $user_permissions);
if (ref($permissions) eq 'ARRAY') {
@check = @$permissions;
}
else {
@check = ($permissions);
}
if ($uid && $uid ne $self->{uid}) {
# mismatch on user identifier
return;
}
$user_permissions = $self->permissions;
for my $perm (@check) {
if (exists $user_permissions->{$perm}) {
return $perm;
}
}
return;
}
=head2 permissions
Returns permissions as hash reference:
$perms = $acl->permissions;
Returns permissions as list:
@perms = $acl->permissions;
=cut
sub permissions {
my ($self) = @_;
if ($self->{volatile}) {
$self->{permissions} = $self->{sub}->();
}
if (wantarray) {
return keys %{$self->{permissions}};
}
return $self->{permissions};
}
=head1 CAVEATS
Please anticipate API changes in this early state of development.
lib/ACL/Lite.pm view on Meta::CPAN
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACL::Lite
You can also look for information at:
=over 4
ACL-Regex
view release on metacpan or search on metacpan
examples/postifx-policy-server.pl view on Meta::CPAN
our %redirectmap;
# Param1: Client socket
# Param2: hash_ref
sub parse_postfix_input( $$ ) {
my ($socket,$hashref) = @_;
local $/ = "\r\n";
while( my $line = <$socket> ){
chomp( $line );
$line =~ s/\r//g;
$line =~ s/\n//g;
return if $line =~ /^(\r|\n)*$/;
#print "DEBUG: $line" if $debug;
if( $line =~ /^(\w+?)=(.+)$/ ){
$hashref->{$1} = $2;
}
}
}
sub convert_hashref_to_acl($){
my( $hash_ref ) = @_;
my @a;
for( sort( keys %$hash_ref ) ) {
my $str = "$_=\[$hash_ref->{$_}\]";
push( @a, $str );
}
return( join( " ", @a ) );
}
sub process_client($){
my ($socket) = @_;
# Create some stuff
my $accept_acl = ACL->new->generate_required( 'required.txt' )->parse_acl_from_file( { Filename => "acl.permit.txt" } );
my $reject_acl = ACL->new->generate_required( 'required.txt' )->parse_acl_from_file( { Filename => "acl.reject.txt" } );
ACCEPT: while( my $client = $socket->accept() ){
my $hash_ref = {};
parse_postfix_input( $client, $hash_ref );
my $action = convert_hashref_to_acl( $hash_ref );
print "Action: " . Dumper($action) . "\n";
my ($rc,$regex,$comment) = $reject_acl->match( $action );
print Dumper( $rc ) . Dumper( $regex ) . Dumper( $comment ) . "\n";
if( $rc ){
print $client "action=reject $comment\n\n";
next ACCEPT;
# Match
}
($rc,$regex,$comment) = $accept_acl->match( $action );
print Dumper( $rc ) . Dumper( $regex ) . Dumper( $comment ) . "\n";
if( $rc ){
print $client "action=ok $comment\n\n";
next ACCEPT;
# Match
}
# Handle any redirects
print $client "action=dunno\n\n";
}
}
sub handle_sig_int
{
unlink( $pidfile );
exit(0);
}
#openlog('missed-spam-policy', '', 'mail');
#syslog('info', 'launching in daemon mode') if $ARGV[0] eq 'quiet-quick-start';
#Proc::Daemon::Init if $ARGV[0] eq 'quiet-quick-start';
examples/postifx-policy-server.pl view on Meta::CPAN
open PID, "+>", "$pidfile" or die("Cannot open $pidfile: $!\n");
print PID "$$";
close( PID );
my $server = IO::Socket::INET->new(
LocalPort => $port,
Type => SOCK_STREAM,
Reuse => 1,
Listen => 10
)
or die
"Couldn't be a tcp server on port $default_config->{serverport} : $@\n";
# Generate a number of listener threads
my @threads = ();
for( 1 .. $TC ){
my $thread = threads->create( \&process_client, $server );
push( @threads, $thread );
}
foreach my $thread ( @threads ){
$thread->join();
}
unlink( $pidfile );
closelog;
exit( 0 );
ACME-2026
view release on metacpan or search on metacpan
lib/ACME/2026.pm view on Meta::CPAN
=cut
our $VERSION = '0.01';
our @EXPORT_OK = qw(
plan_new plan_load plan_save
add_item update_item delete_item get_item
add_note complete_item skip_item reopen_item
items stats
);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );
=head1 SYNOPSIS
use ACME::2026 qw(:all);
my $plan = plan_new(
title => '2026',
storage => '2026.json',
autosave => 1,
);
my $id = add_item($plan, 'Run a marathon',
list => 'Health',
due => '2026-10-01',
tags => [qw/fitness endurance/],
priority => 2,
);
complete_item($plan, $id, note => 'Signed up for NYC');
my @open = items($plan, status => 'todo', list => 'Health', sort => 'due');
plan_save($plan);
=head1 DESCRIPTION
ACME::2026 is a tiny functional API for keeping 2026 checklists. It stores
plans as plain Perl hashrefs and can persist them to JSON.
=head1 DATA MODEL
Plan hashref:
{
title => '2026',
items => [ ... ],
next_id => 1,
created_at => '2026-01-01T12:00:00Z',
updated_at => '2026-01-01T12:00:00Z',
storage => '2026.json',
autosave => 1,
}
Item hashref:
{
id => 1,
title => 'Run a marathon',
status => 'todo',
list => 'Health',
tags => ['fitness'],
priority => 2,
due => '2026-10-01',
notes => [ { note => 'Signed up', at => '2026-02-10T09:00:00Z' } ],
created_at => '2026-01-01T12:00:00Z',
updated_at => '2026-02-10T09:00:00Z',
}
Status values are C<todo>, C<done>, or C<skipped>. Dates are ISO 8601 strings
(C<YYYY-MM-DD> or C<YYYY-MM-DDTHH:MM:SSZ>).
=head1 FUNCTIONS
=head2 plan_new
my $plan = plan_new(%opts);
Creates a new plan hashref. Supported options:
title - plan title (default: 2026)
storage - JSON path used by plan_save and autosave
autosave - boolean, save after mutating operations
=head2 plan_load
my $plan = plan_load($path, %opts);
Loads a JSON file from C<$path>. The plan is normalized to ensure required
fields exist. You can override C<title> or C<autosave> with C<%opts>.
=head2 plan_save
plan_save($plan);
plan_save($plan, $path);
Writes the plan as JSON. Uses C<$plan-E<gt>{storage}> if no path is provided.
=head2 add_item
my $id = add_item($plan, $title, %opts);
Adds an item and returns its id. Supported options:
list, tags (arrayref or string), priority, due, note
=head2 update_item
my $item = update_item($plan, $id, %attrs);
Updates a few fields in place: C<title>, C<list>, C<tags>, C<priority>, C<due>.
Use C<add_note> or the status helpers for notes and status changes.
=head2 delete_item
my $item = delete_item($plan, $id);
Removes an item and returns it.
=head2 get_item
my $item = get_item($plan, $id);
Returns the item or C<undef> if it does not exist.
=head2 add_note
add_note($plan, $id, $note);
Appends a note with a timestamp.
=head2 complete_item
complete_item($plan, $id, %opts);
Sets the status to C<done>. If C<note> is supplied, it is added.
=head2 skip_item
skip_item($plan, $id, %opts);
Sets the status to C<skipped>. If C<note> is supplied, it is added.
=head2 reopen_item
reopen_item($plan, $id, %opts);
Sets the status back to C<todo>. If C<note> is supplied, it is added.
=head2 items
my @items = items($plan, %filters);
Filters items with any of:
status, list, tag, tags, priority, min_priority, max_priority,
due_before, due_after, sort
For C<tag> or C<tags>, any matching tag is enough. C<sort> supports:
C<due>, C<priority>, C<created>, C<updated>, or C<title>. Prefix with C<->
for descending order.
=head2 stats
my $stats = stats($plan, %filters);
Returns a hashref with C<total>, C<todo>, C<done>, C<skipped>, and
C<complete_pct>.
=cut
sub plan_new {
my %opts = _normalize_opts(@_);
my $now = _now();
my $plan = {
title => defined $opts{title} ? $opts{title} : '2026',
items => [],
next_id => 1,
created_at => $now,
updated_at => $now,
storage => $opts{storage},
autosave => $opts{autosave} ? 1 : 0,
};
return $plan;
}
sub plan_load {
my ($path, %opts) = @_;
croak 'plan_load requires a path' unless defined $path && length $path;
my $json = _read_file($path);
my $data = eval { JSON::PP->new->decode($json) };
croak "Failed to decode JSON from $path: $@" if $@;
_normalize_plan($data);
$data->{storage} = $path;
$data->{title} = $opts{title} if exists $opts{title};
$data->{autosave} = $opts{autosave} ? 1 : 0 if exists $opts{autosave};
return $data;
}
sub plan_save {
my ($plan, $path) = @_;
_ensure_plan($plan);
$path ||= $plan->{storage};
croak 'plan_save requires a path or plan storage' unless defined $path && length $path;
_normalize_plan($plan);
my $encoder = JSON::PP->new->canonical(1)->pretty(1);
my $json = $encoder->encode($plan);
_write_file_atomic($path, $json);
return 1;
}
sub add_item {
my ($plan, @args) = @_;
_ensure_plan($plan);
my ($title, %opts);
if (@args % 2 == 1) {
$title = shift @args;
%opts = @args;
} else {
%opts = @args;
$title = $opts{title};
}
croak 'add_item requires a title' unless defined $title && length $title;
_reject_unknown('add_item', \%opts, qw(title list tags tag priority due note));
my $now = _now();
my $item = {
id => $plan->{next_id}++,
title => $title,
status => 'todo',
list => defined $opts{list} ? $opts{list} : 'General',
tags => _normalize_tags($opts{tags}, $opts{tag}),
priority => defined $opts{priority} ? $opts{priority} : 3,
due => $opts{due},
notes => [],
created_at => $now,
updated_at => $now,
};
push @{ $plan->{items} }, $item;
if (defined $opts{note}) {
_add_note($plan, $item, $opts{note});
} else {
_touch($plan);
}
_maybe_autosave($plan);
return $item->{id};
}
sub update_item {
my ($plan, $id, %attrs) = @_;
_ensure_plan($plan);
my $item = _find_item($plan, $id);
croak "No item with id $id" unless $item;
_reject_unknown('update_item', \%attrs, qw(title list tags tag priority due));
my $changed = 0;
for my $key (qw(title list priority due)) {
next unless exists $attrs{$key};
$item->{$key} = $attrs{$key};
$changed = 1;
}
if (exists $attrs{tags} || exists $attrs{tag}) {
$item->{tags} = _normalize_tags($attrs{tags}, $attrs{tag});
$changed = 1;
}
return $item unless $changed;
$item->{updated_at} = _now();
_touch($plan);
_maybe_autosave($plan);
return $item;
}
sub delete_item {
my ($plan, $id) = @_;
_ensure_plan($plan);
my $items = $plan->{items};
for my $idx (0 .. $#$items) {
next unless defined $items->[$idx]{id} && $items->[$idx]{id} == $id;
my $item = splice(@$items, $idx, 1);
_touch($plan);
_maybe_autosave($plan);
return $item;
}
return;
}
sub get_item {
my ($plan, $id) = @_;
_ensure_plan($plan);
return _find_item($plan, $id);
}
sub add_note {
my ($plan, $id, $note) = @_;
_ensure_plan($plan);
croak 'add_note requires a note' unless defined $note && length $note;
my $item = _find_item($plan, $id);
croak "No item with id $id" unless $item;
_add_note($plan, $item, $note);
_maybe_autosave($plan);
return $item;
}
sub complete_item {
my ($plan, $id, %opts) = @_;
return _set_status($plan, $id, 'done', %opts);
}
sub skip_item {
my ($plan, $id, %opts) = @_;
return _set_status($plan, $id, 'skipped', %opts);
}
sub reopen_item {
my ($plan, $id, %opts) = @_;
return _set_status($plan, $id, 'todo', %opts);
}
sub items {
my ($plan, %filters) = @_;
_ensure_plan($plan);
my @items = @{ $plan->{items} || [] };
if (defined $filters{status}) {
my $status = _normalize_status($filters{status});
@items = grep { $_->{status} eq $status } @items;
}
if (defined $filters{list}) {
@items = grep { defined $_->{list} && $_->{list} eq $filters{list} } @items;
}
my @tags;
push @tags, $filters{tag} if defined $filters{tag};
if (defined $filters{tags}) {
if (ref $filters{tags} eq 'ARRAY') {
push @tags, @{ $filters{tags} };
} else {
push @tags, $filters{tags};
}
}
if (@tags) {
@items = grep {
my %item_tags = map { $_ => 1 } @{ $_->{tags} || [] };
my $match = 0;
for my $tag (@tags) {
next unless defined $tag && length $tag;
if ($item_tags{$tag}) {
$match = 1;
last;
}
}
$match;
} @items;
}
if (defined $filters{priority}) {
@items = grep { defined $_->{priority} && $_->{priority} == $filters{priority} } @items;
}
if (defined $filters{min_priority}) {
@items = grep { defined $_->{priority} && $_->{priority} >= $filters{min_priority} } @items;
}
if (defined $filters{max_priority}) {
@items = grep { defined $_->{priority} && $_->{priority} <= $filters{max_priority} } @items;
}
if (defined $filters{due_before}) {
@items = grep { defined $_->{due} && $_->{due} le $filters{due_before} } @items;
}
if (defined $filters{due_after}) {
@items = grep { defined $_->{due} && $_->{due} ge $filters{due_after} } @items;
}
if (defined $filters{sort}) {
@items = _sort_items(\@items, $filters{sort});
}
return @items;
}
sub stats {
my ($plan, %filters) = @_;
_ensure_plan($plan);
my @items = items($plan, %filters);
my %stats = (
total => scalar @items,
todo => 0,
done => 0,
skipped => 0,
);
for my $item (@items) {
$stats{ $item->{status} }++ if exists $stats{ $item->{status} };
}
$stats{complete_pct} = $stats{total}
? int(($stats{done} / $stats{total}) * 100 + 0.5)
: 0;
return \%stats;
}
sub _set_status {
my ($plan, $id, $status, %opts) = @_;
_ensure_plan($plan);
_reject_unknown('_set_status', \%opts, qw(note));
my $item = _find_item($plan, $id);
croak "No item with id $id" unless $item;
$item->{status} = _normalize_status($status);
$item->{updated_at} = _now();
if (defined $opts{note}) {
_add_note($plan, $item, $opts{note});
} else {
_touch($plan);
}
_maybe_autosave($plan);
return $item;
}
sub _normalize_opts {
return %{ $_[0] } if @_ == 1 && ref $_[0] eq 'HASH';
return @_;
}
sub _normalize_plan {
my ($plan) = @_;
_ensure_plan($plan);
$plan->{title} = '2026' unless defined $plan->{title} && length $plan->{title};
$plan->{items} = [] unless ref $plan->{items} eq 'ARRAY';
$plan->{autosave} = $plan->{autosave} ? 1 : 0;
my $max_id = 0;
for my $item (@{ $plan->{items} }) {
next unless ref $item eq 'HASH';
$max_id = $item->{id} if defined $item->{id} && $item->{id} > $max_id;
}
$plan->{next_id} = $plan->{next_id} || ($max_id + 1);
my $next_id = $plan->{next_id};
for my $item (@{ $plan->{items} }) {
next unless ref $item eq 'HASH';
if (!defined $item->{id}) {
$item->{id} = $next_id++;
}
$item->{status} = _normalize_status($item->{status});
$item->{tags} = _normalize_tags($item->{tags});
$item->{notes} = _normalize_notes($item->{notes});
$item->{priority} = defined $item->{priority} ? $item->{priority} : 3;
$item->{list} = defined $item->{list} ? $item->{list} : 'General';
$item->{created_at} = _now() unless defined $item->{created_at};
$item->{updated_at} = $item->{created_at} unless defined $item->{updated_at};
}
$plan->{next_id} = $next_id if $next_id > $plan->{next_id};
$plan->{created_at} = _now() unless defined $plan->{created_at};
$plan->{updated_at} = $plan->{created_at} unless defined $plan->{updated_at};
return $plan;
}
sub _normalize_status {
my ($status) = @_;
$status = 'todo' if !defined $status || $status eq '';
return $status if $status eq 'todo' || $status eq 'done' || $status eq 'skipped';
croak "Unknown status '$status'";
}
sub _normalize_tags {
my ($tags, $tag) = @_;
my @tags;
if (defined $tags) {
if (ref $tags eq 'ARRAY') {
@tags = @$tags;
} else {
@tags = ($tags);
}
}
push @tags, $tag if defined $tag;
@tags = grep { defined $_ && length $_ } @tags;
return \@tags;
}
sub _normalize_notes {
my ($notes) = @_;
return [] unless defined $notes;
if (ref $notes eq 'ARRAY') {
my @out;
for my $note (@$notes) {
if (ref $note eq 'HASH') {
push @out, $note;
} else {
push @out, { note => $note };
}
}
return \@out;
}
return [ { note => $notes } ];
}
sub _ensure_plan {
my ($plan) = @_;
croak 'Plan must be a hashref' unless ref $plan eq 'HASH';
}
sub _find_item {
my ($plan, $id) = @_;
return unless defined $id;
for my $item (@{ $plan->{items} || [] }) {
next unless defined $item->{id};
return $item if $item->{id} == $id;
}
return;
}
sub _add_note {
my ($plan, $item, $note) = @_;
return unless defined $note && length $note;
push @{ $item->{notes} }, { note => $note, at => _now() };
$item->{updated_at} = _now();
_touch($plan);
}
sub _touch {
my ($plan) = @_;
$plan->{updated_at} = _now();
}
sub _maybe_autosave {
my ($plan) = @_;
return unless $plan->{autosave};
plan_save($plan);
}
sub _sort_items {
my ($items, $sort) = @_;
return @$items unless defined $sort && length $sort;
my $desc = ($sort =~ s/^-//);
if ($sort eq 'due') {
return sort {
my $ad = defined $a->{due} ? $a->{due} : ($desc ? '0000-00-00' : '9999-12-31');
my $bd = defined $b->{due} ? $b->{due} : ($desc ? '0000-00-00' : '9999-12-31');
my $cmp = $ad cmp $bd;
$desc ? -$cmp : $cmp;
} @$items;
}
if ($sort eq 'priority') {
return sort {
my $ad = defined $a->{priority} ? $a->{priority} : 0;
my $bd = defined $b->{priority} ? $b->{priority} : 0;
my $cmp = $ad <=> $bd;
$desc ? -$cmp : $cmp;
} @$items;
}
if ($sort eq 'created') {
return sort {
my $cmp = ($a->{created_at} || '') cmp ($b->{created_at} || '');
$desc ? -$cmp : $cmp;
} @$items;
}
if ($sort eq 'updated') {
return sort {
my $cmp = ($a->{updated_at} || '') cmp ($b->{updated_at} || '');
$desc ? -$cmp : $cmp;
} @$items;
}
if ($sort eq 'title') {
return sort {
my $cmp = lc($a->{title} || '') cmp lc($b->{title} || '');
$desc ? -$cmp : $cmp;
} @$items;
}
return @$items;
}
sub _reject_unknown {
my ($context, $attrs, @known) = @_;
my %known = map { $_ => 1 } @known;
my @unknown = grep { !$known{$_} } keys %$attrs;
return unless @unknown;
croak "$context does not accept: " . join(', ', sort @unknown);
}
sub _now {
return strftime('%Y-%m-%dT%H:%M:%SZ', gmtime());
}
sub _read_file {
my ($path) = @_;
open my $fh, '<', $path or croak "Unable to read $path: $!";
local $/;
return <$fh>;
}
sub _write_file_atomic {
my ($path, $content) = @_;
my ($fh, $tmp) = tempfile('acme2026-XXXXXX', DIR => _temp_dir($path));
print {$fh} $content or croak "Unable to write $tmp: $!";
close $fh or croak "Unable to close $tmp: $!";
rename $tmp, $path or croak "Unable to move $tmp to $path: $!";
}
sub _temp_dir {
my ($path) = @_;
return '.' unless defined $path && length $path;
if ($path =~ /[\/\\]/) {
$path =~ s/[\/\\][^\/\\]+$//;
return length $path ? $path : '.';
}
return '.';
}
=head1 AUTHOR
Will Willis <wwillis@cpan.org>
lib/ACME/2026.pm view on Meta::CPAN
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACME::2026
You can also look for information at:
=over 4
lib/ACME/2026.pm view on Meta::CPAN
This software is Copyright (c) 2026 by Will Willis <wwillis@cpan.org>.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
=cut
1; # End of ACME::2026
ACME-CPANPLUS-Module-With-Core-PreReq
view release on metacpan or search on metacpan
lib/ACME/CPANPLUS/Module/With/Core/PreReq.pm view on Meta::CPAN
version 0.06
=head1 SYNOPSIS
# erm
cpanp -i ACME::CPANPLUS::Module::With::Core::PreReq
=head1 DESCRIPTION
ACME::CPANPLUS::Module::With::Core::PreReq is a fake module that has a prerequisite of a core module
so I can test something in L<CPANPLUS> and L<CPANPLUS::YACSmoke>
ACME-Dzil-Test-daemon
view release on metacpan or search on metacpan
lib/ACME/Dzil/Test/daemon.pm view on Meta::CPAN
This software is Copyright (c) 2021 by Paul G Webster.
This is free software, licensed under:
The (three-clause) BSD License
ACME-Dzil-Test-daemon2
view release on metacpan or search on metacpan
lib/ACME/Dzil/Test/daemon2.pm view on Meta::CPAN
This software is Copyright (c) 2021 by Paul G Webster.
This is free software, licensed under:
The (three-clause) BSD License
ACME-Error-31337
view release on metacpan or search on metacpan
$VERSION = '0.01';
use Lingua::31337 qw[text231337];
*die_handler = *warn_handler = sub {
return text231337 @_;
};
1;
__END__
ACME::Error::31337 - ACM3::ERRoR b4ck3ND To tR4NSl4T3 erRorS 7O co0l 74Lk
=head1 sYn0PS1S
use ACME::Error::31337;
die "You stink!";
=head1 DEScR1Pt10N
CoNv3R7 y0Ur 3RR0rS 7o 31173 spE3cH.
ACME-Error-Coy
view release on metacpan or search on metacpan
ACME::Error::Coy - Perl extension for blah blah blah
=head1 SYNOPSIS
use ACME::Error Coy;
=head1 DESCRIPTION
Interface to L<Coy> for printing your errors.
ACME-Error-HTML
view release on metacpan or search on metacpan
$VERSION = '0.01';
use HTML::FromText;
*die_handler = *warn_handler = sub {
return text2html "@_",
paras => 1,
bold => 1,
metachars => 0,
urls => 1,
email => 1,
underline => 1,
blockparas => 1,
numbers => 1,
bullets => 1;
};
1;
__END__
ACME::Error::HTML - ACME::Error Backend to Markup Errors with HTML
=head1 SYNOPSIS
use ACME::Error HTML;
warn "blink"; # <p>blink</p>
=head1 DESCRIPTION
Converts your errors to HTML.
ACME-Error-IgpayAtinlay
view release on metacpan or search on metacpan
IgpayAtinlay.pm view on Meta::CPAN
$VERSION = '0.01';
use Lingua::Atinlay::Igpay qw[:all];
*die_handler = *warn_handler = sub {
my @errors = @_;
return enhay2igpayatinlay @errors;
};
1;
__END__
IgpayAtinlay.pm view on Meta::CPAN
ACMEHAY::Errorhay::IgpayAtinlayhay - ACMEHAY::Errorhay Ackendbay otay Onvertcay Errorshay otay Igpay Atinlay
=head1 OPSISSYNAY
usehay ACMEHAY::Errorhay => IgpayAtinlayhay;
arnway "Adbay"; # Adbayhay
=head1 ESCRIPTIONDAY
Onvertscay ouryay errorshay otay Igpay Atinlay.
ACME-Error-Translate
view release on metacpan or search on metacpan
Translate.pm view on Meta::CPAN
$VERSION = '0.01';
use Lingua::Translate;
{
my $translator = undef;
sub import {
my $class = shift;
$translator = Lingua::Translate->new( src => 'en', dest => shift );
}
*die_handler = *warn_handler = sub {
if ( $translator ) {
return map $translator->translate( $_ ), @_;
} else {
return @_;
}
};
}
1;
__END__
Translate.pm view on Meta::CPAN
ACME::Error::Translate - Language Translating Backend for ACME::Error
=head1 SYNOPSIS
use ACME::Error Translate => de;
die "Stop!"; # Anschlag!
=head1 DESCRIPTION
Translates error messages from the default English to the language of your
choice using L<Lingua::Translate>. As long as the backend used by
ACME-Error
view release on metacpan or search on metacpan
lib/ACME/Error.pm view on Meta::CPAN
use vars qw[$VERSION];
$VERSION = '0.03';
sub import {
my $class = shift;
if ( my $style = shift ) {
my $package = qq[ACME::Error::$style];
my $args = join q[', '], @_;
eval qq[use $package '$args'];
die $@ if $@;
my $nested = -1;
{ no strict 'refs';
$SIG{__WARN__} = sub {
local $SIG{__WARN__};
$nested++;
my $handler = $package . q[::warn_handler];
warn &{$handler}(@_) unless $nested;
warn @_ if $nested;
$nested--;
};
$SIG{__DIE__} = sub {
local $SIG{__DIE__};
$nested++;
my $handler = $package . q[::die_handler];
die &{$handler}(@_) unless $nested;
die @_ if $nested;
$nested--;
};
}
# $SIG{__WARN__} = sub {
# my $handler = $package . q[::warn_handler];
# {
# no strict 'refs';
lib/ACME/Error.pm view on Meta::CPAN
# {
# no strict 'refs';
# die &{$handler}, "\n" if exists &{$handler};
# }
# };
}
}
1;
__END__
lib/ACME/Error.pm view on Meta::CPAN
ACME::Error - Never have boring errors again!
=head1 SYNOPSIS
use ACME::Error SHOUT;
warn "Warning"; # WARNING!
=head1 DESCRIPTION
C<ACME::Error> is a front end to Perl error styles. C<$SIG{__WARN__}> and C<$SIG{__DIE__}>
are intercepted. Backends are pluggable. Choose a backend by specifying it when you
ACME-MBHall
view release on metacpan or search on metacpan
lib/ACME/MBHall.pm view on Meta::CPAN
Quick summary of what the module does.
Perhaps a little code snippet.
use ACME::MBHall;
my $foo = ACME::MBHall->new();
...
=head1 EXPORT
A list of functions that can be exported. You can delete this section
if you don't export anything, such as for a purely object-oriented module.
lib/ACME/MBHall.pm view on Meta::CPAN
Returns the sum of the numbers.
=cut
sub sum {
my $sum = 0;
foreach my $value (@_) {
$sum+=$value;
}
return $sum;
}
=head2 function2
=cut
lib/ACME/MBHall.pm view on Meta::CPAN
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACME::MBHall
You can also look for information at:
=over 4
ACME-MSDN-SPUtility
view release on metacpan or search on metacpan
lib/ACME/MSDN/SPUtility.pm view on Meta::CPAN
Checks whether the Taiwan calendar is hidden based on the specified Web site and locale ID.
Checks if the China Gov really Lost Their Brain based on the specified Web site and locale ID.
Checks if Bill-GAY$ and his 'Stuffz' lost thier Balls at Halloween based on the specified Web site and locale ID.
use ACME::MSDN::SPUtility;
my $fool = ACME::MSDN::SPUtility->new( $SPWeb, int $localeId);
say 'Hello, Taiwan!' if not $fool->HideTaiwan;
STDERR->say("I can't speak well if I don't have a brain!") if $fool->HideChina;
say STDERR 'Plz find my balls for me and give it back to me. I lost all of them!' if $fool->HideMicroSoft;
=head1 FUNCTIONS
=head2 new
Get a SPUtility object.
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
#$self->initialize();
return $self;
}
=head2 HideTaiwan
Checks whether the Taiwan calendar is hidden based on the specified Web site and locale ID.
=cut
sub HideTaiwan {
my $self = shift;
my ($spWeb, $localeId) = @_;
print "Taiwan is definitely a Contry already, and should never hide. Is china scared by this?";
return undef;
};
=head2 HideChina
Checks if the China Gov really Lost Their Brain based on the specified Web site and locale ID.
=cut
sub HideChina {
my $self = shift;
my ($spWeb, $localeId) = @_;
print "fsck the dumb China gov";
return 1;
}
=head2 HideMicroSoft
Checks if Bill-GAY$ and his 'Stuffz' lost thier Balls at Halloween based on the specified Web site and locale ID.
=cut
sub HideMicroSoft {
my $self = shift;
my ($spWeb, $localeId) = @_;
print 'Bill-Gay$ and Micro$oft Stuff$ lost their Ballz, did you see them?';
return 1;
}
=head1 AUTHOR
BlueT - Matthew Lien - 練喆明, C<< <BlueT at BlueT.org> >>
lib/ACME/MSDN/SPUtility.pm view on Meta::CPAN
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACME::MSDN::SPUtility
You can also look for information at:
=over 4
ACME-MyFirstModule-SETHS
view release on metacpan or search on metacpan
lib/ACME/MyFirstModule/SETHS.pm view on Meta::CPAN
Quick summary of what the module does.
Perhaps a little code snippet.
use ACME::MyFirstModule::SETHS;
my $foo = ACME::MyFirstModule::SETHS->new();
...
=head1 EXPORT
A list of functions that can be exported. You can delete this section
if you don't export anything, such as for a purely object-oriented module.
lib/ACME/MyFirstModule/SETHS.pm view on Meta::CPAN
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACME::MyFirstModule::SETHS
You can also look for information at:
=over 4
ACME-PM-Voronezh
view release on metacpan or search on metacpan
lib/ACME/PM/Voronezh.pm view on Meta::CPAN
package ACME::PM::Voronezh;
use warnings;
use strict;
=head1 NAME
ACME::PM::Voronezh - Talks by Voronezh.pm
=head1 VERSION
Version 0.02
=cut
our $VERSION = '0.02';
=head1 SYNOPSIS
Welcome to Voronezh.PM!
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACME::PM::Voronezh
You can also look for information at:
=over 4
=item * Voronezh.PM
L<http://voronezh.pm.org/>
=item * Mailing list
L<http://groups.google.com/group/voronezh-pm>
=item * Twitter
L<http://twitter.com/voronezh_pm>
=item * Search CPAN
L<http://search.cpan.org/dist/ACME-PM-Voronezh/>
=back
=head1 AUTHOR
Alexander Nusov, C<< <alexander.nusov+cpan at gmail.com> >>
=head1 ACKNOWLEDGEMENTS
I am grateful to Dmitry Degtyarev C<< <degtyarev.dm at gmail.com> >> who inspired the idea of creating the group.
=head1 LICENSE AND COPYRIGHT
Copyright 2010 Alexander Nusov.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of ACME::PM::Voronezh
( run in 0.841 second using v1.01-cache-2.11-cpan-39bf76dae61 )