Next refresh should show more results. ( run in 1.448 )
view release on metacpan or search on metacpan
lib/A1z/HTML5/Template.pm view on Meta::CPAN
{
# 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
lib/A1z/HTML5/Template.pm view on Meta::CPAN
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]-->
};
}
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}');
//-->
</script>
<!-- top nav bar end-->
};
}
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'>
};
}
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);
lib/A1z/HTML5/Template.pm view on Meta::CPAN
}
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')
lib/A1z/HTML5/Template.pm view on Meta::CPAN
$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 => '',
@_,
);
lib/A1z/HTML5/Template.pm view on Meta::CPAN
=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.
lib/A1z/HTML5/Template.pm view on Meta::CPAN
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
lib/A1z/HTML5/Template.pm view on Meta::CPAN
);
=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
automatically be notified of progress on your bug as I make changes.
=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
=item * RT: CPAN's request tracker (report bugs here)
L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=A1z-HTML5-Template>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/A1z-HTML5-Template>
=item * CPAN Ratings
L<https://cpanratings.perl.org/d/A1z-HTML5-Template>
=item * Search CPAN
L<https://metacpan.org/release/A1z-HTML5-Template>
=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.
This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:
L<http://www.perlfoundation.org/artistic_license_2_0>
Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.
If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
=head1 AUTHOR
Sudheer Murthy <pause@a1z.us>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 by Sudheer Murthy.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
#line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.17';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
view all matches for this distribution
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.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ABNF/Validator.pm view on Meta::CPAN
use base qw(Exporter);
our @EXPORT_OK = qw(Validator);
Readonly my $ARGUMENTS_RULES => "generic_arguments_rule_for_";
Readonly my $CLASS_MAP => {
Choice => \&_choice,
Group => \&_group,
Range => \&_range,
Reference => \&_reference,
Repetition => \&_repetition,
Rule => \&_rule,
String => \&_string,
Literal => \&_literal,
ProseValue => \&_proseValue
};
=pod
=head1 ABNF::Validator->C<new>($grammar)
Creates a new B<ABNF::Validator> object.
$grammar isa B<ABNF::Grammar>.
=cut
method new(ABNF::Grammar $grammar) {
my $class = ref($self) || $self;
$self = { _grammar => $grammar };
bless($self, $class);
$self->_init();
return $self;
}
method _init() {
my $commands = $self->{_grammar}->commands();
$self->{_commandsPattern} = do {
my $pattern = join(" | ", @$commands);
qr/\A (?: $pattern ) \Z/ix;
};
$self->{_rules} = _value([
values($self->{_grammar}->rules()),
values($BASIC_RULES)
]);
$self->{_regexps} = do {
use Regexp::Grammars;
my %res = ();
foreach my $token ( @$commands ) {
# command
my $str = "
#<logfile: /dev/null>
^ <" . _fixRulename($token) . "> \$
$self->{_rules}
";
$res{$token} = qr{$str }ixs;
# arguments
my $value = $self->{_grammar}->rule($token);
my $name = _fixRulename($ARGUMENTS_RULES . $token);
my $rule = {class => "Rule", name => $name};
my $val = (splitRule($value))[-1];
if ( $value->{value} != $val ) {
$rule->{value} = $val;
my $converted = _value($rule);
$res{$name} = qr{
^ <$name> $
$converted
$self->{_rules}
}xis;
}
}
\%res;
};
}
func _value($val, $dent = 0) {
if ( UNIVERSAL::isa($val, 'ARRAY') ) {
return join('', map { _value($_ , $dent) } @$val);
} elsif ( UNIVERSAL::isa($val, 'HASH') && exists($CLASS_MAP->{ $val->{class} }) ) {
return $CLASS_MAP->{ $val->{class} }->($val, $dent);
} else {
croak "Unknown substance " . Dumper($val);
}
}
func _choice($val, $dent) {
return "(?: " . join(' | ', map { _value($_ , $dent + 1) } @{$val->{value}}) . ")";
}
func _group($val, $dent) {
return '(?: ' . _value($val->{value}, $dent + 1) . ' )';
}
func _reference($val, $dent) {
return "<" . _fixRulename($val->{name}) . ">";
}
func _repetition($val, $dent) {
no warnings 'uninitialized';
my %maxMin = (
# max min
"1 0" => '?',
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AC/DC/Debug.pm view on Meta::CPAN
# -*- perl -*-
# Copyright (c) 2009 AdCopy
# Author: Jeff Weisberg
# Created: 2009-Mar-27 11:40 (EDT)
# Function: debugging + log msgs
#
# $Id$
package AC::DC::Debug;
use AC::Daemon;
use strict;
my $config;
my $debugall;
sub init {
shift;
$debugall = shift;
$config = shift;
}
sub _tagged_debug {
my $tag = shift;
my $msg = shift;
if( $config && $config->{config} ){
return unless $config->{config}{debug}{$tag} || $config->{config}{debug}{all} || $debugall;
}else{
return unless $debugall;
}
debugmsg( "$tag - $msg" );
}
sub import {
my $class = shift;
my $tag = shift; # use AC::DC::Debug 'tag';
my $caller = caller;
no strict;
if( $tag ){
# export a curried debug (with the specified tag) to the caller
*{$caller . '::debug'} = sub { _tagged_debug($tag, @_) };
}
for my $f qw(verbose problem fatal){
no strict;
*{$caller . '::' . $f} = $class->can($f);
}
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AC/MrGamoo.pm view on Meta::CPAN
AC::MrGamoo - Map/Reduce Framework
=head1 SYNOPSIS
use AC::MrGamoo::D;
use strict;
my $m = AC::MrGamoo::D->new( );
$m->daemon( $configfile, {
argv => \@ARGV,
foreground => $OPT{f},
debugall => $OPT{d},
port => $OPT{p},
} );
exit;
=head1 CONFIG FILE
various parameters need to be specified in a config file.
if you modify the file, it will be reloaded automagically.
=over 4
=item port
specify the TCP port to use
port 3504
=item environment
specify the environment or realm to run in, so you can run multiple
independent map/reduce networks, such as production, staging, and dev.
environment prod
=item allow
specify networks allowed to connect.
allow 127.0.0.1
allow 192.168.10.0/24
=item seedpeer
specify initial peers to contact when starting. the author generally
specifies 2 on the east coast, and 2 on the west coast.
seedpeer 192.168.10.11:3503
seedpeer 192.168.10.12:3503
=item secret
specify a secret key used to encrypt data transfered between
systems in different datacenters.
secret squeamish-ossifrage
=item syslog
specify a syslog facility for log messages.
syslog local5
=item basedir
local directory to store files
basedir /home/data
=item debug
enable debugging for a particular section
debug job
=back
=head1 BUGS
Too many to list here.
=head1 SEE ALSO
AC::MrGamoo::Client
=head1 AUTHOR
Jeff Weisberg - http://www.solvemedia.com/
=cut
1;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AC/Yenta.pm view on Meta::CPAN
our $VERSION = 1.1;
=head1 NAME
AC::Yenta - eventually-consistent distributed key/value data store. et al.
=head1 SYNOPSIS
use AC::Yenta::D;
use strict;
my $y = AC::Yenta::D->new( );
$y->daemon( $configfile, {
argv => \@ARGV,
foreground => $OPT{f},
debugall => $OPT{d},
port => $OPT{p},
} );
exit;
=head1 USAGE
Copy + Paste from the example code into your own code.
Copy + Paste from the example config into your own config.
Send in bug report.
=head1 YIDDISH-ENGLISH GLOSSARY
Kibitz - Gossip. Casual information exchange with ones peers.
Yenta - 1. An old woman who kibitzes with other yentas.
2. Software which kibitzes with other yentas.
=head1 DESCRIPTION
=head2 Peers
All of the running yentas are peers. There is no master server.
New nodes can be added or removed on the fly with no configuration.
=head2 Kibitzing
Each yenta kibitzes (gossips) with the other yentas in the network
to exchange status information, distribute key-value data, and
detect and correct inconsistent data.
=head2 Eventual Consistency
Key-value data is versioned with timestamps. By default, newest wins.
Maps can be configured to keep and return multiple versions and client
code can use other conflict resolution mechanisms.
Lost, missing or otherwise inconsistent data is detected
by kibitzing merkle tree hash values.
=head2 Topological awareness
Yentas can take network topology into account when tranferring
data around to minimize long-distance transfers. You will need to
write a custom C<MySelf> class with a C<my_datacenter> function.
=head2 Multiple Network Interfaces / NAT
Yentas can take advantage of multiple network interfaces with
different IP addresses (eg. a private internal network + a public network),
or multiple addresses (eg. a private addresses and a public address)
and various NAT configurations.
You will need to write a custom C<MySelf> class and C<my_network_info>
function.
=head2 Network Information
By default, yentas obtain their primary IP address by calling
C<gethostbyname( hostname() )>. If this either does not work on your
systems, or isn't the value you want to use,
you will need to write a custom C<MySelf> class and C<my_network_info>
function.
=head1 CONFIG FILE
various parameters need to be specified in a config file.
if you modify the file, it will be reloaded automagically.
=over 4
=item port
specify the TCP port to use
port 3503
=item environment
specify the environment or realm to run in, so you can run multiple
independent yenta networks, such as production, staging, and dev.
environment prod
=item allow
specify networks allowed to connect.
allow 127.0.0.1
allow 192.168.10.0/24
=item seedpeer
specify initial peers to contact when starting. the author generally
specifies 2 on the east coast, and 2 on the west coast.
seedpeer 192.168.10.11:3503
seedpeer 192.168.10.12:3503
=item secret
specify a secret key used to encrypt data transfered between
yentas in different datacenters.
secret squeamish-ossifrage
=item syslog
specify a syslog facility for log messages.
syslog local5
=item debug
enable debugging for a particular section
debug map
=item map
configure a map (a collection of key-value data). you do not need
to configure the same set of maps on all servers. maps should be
configured similarly on all servers that they are on.
map users {
backend bdb
dbfile /home/acdata/users.ydb
history 4
}
=back
=head1 BUGS
Too many to list here.
=head1 SEE ALSO
AC::Yenta::Client
Amazon Dynamo - http://www.allthingsdistributed.com/2007/10/amazons_dynamo.html
=head1 AUTHOR
Jeff Weisberg - http://www.solvemedia.com/
=cut
1;
view all matches for this distribution
view release on metacpan or search on metacpan
examples/postifx-policy-server.pl view on Meta::CPAN
#!/usr/bin/perl
#
use IO::Socket;
use threads;
use Proc::Daemon;
use Sys::Syslog qw( :DEFAULT setlogsock);
use Data::Dumper;
use lib( "./" );
use ACL;
# Global config settings
my $TC = 1;
my $debug = 1;
my $port = 12345;
our $pidfile = "/var/run/postfix-policy-server.pid";
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';
# Attempt to parse in the redirect config
$SIG{INT} = \&handle_sig_int;
# Ignore client disconnects
$SIG{PIPE} = "IGNORE";
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 );
view all matches for this distribution
view release on metacpan or search on metacpan
Version change log for ACME-Dzil-Test-daemon
0.001 2021-12-16 19:34:59 GMT
- The first thing you changed!
- Test entry
view all matches for this distribution
view release on metacpan or search on metacpan
Version change log for ACME-Dzil-Test-daemon2
0.001 2021-12-16 19:51:37 GMT
- The first thing you changed!
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ACME/MyFirstModule/SETHS.pm view on Meta::CPAN
Please report any bugs or feature requests to C<bug-acme-myfirstmodule-seths at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=ACME-MyFirstModule-SETHS>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=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
=item * RT: CPAN's request tracker (report bugs here)
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ACME-MyFirstModule-SETHS>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/ACME-MyFirstModule-SETHS>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/ACME-MyFirstModule-SETHS>
=item * Search CPAN
L<http://search.cpan.org/dist/ACME-MyFirstModule-SETHS/>
=back
=head1 ACKNOWLEDGEMENTS
=head1 LICENSE AND COPYRIGHT
Copyright 2015 Seth Surchin.
This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:
L<http://www.perlfoundation.org/artistic_license_2_0>
Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.
If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
=cut
1; # End of ACME::MyFirstModule::SETHS
view all matches for this distribution
view release on metacpan or search on metacpan
lib/ACME/THEDANIEL/Utils.pm view on Meta::CPAN
=head1 BUGS
Please report any bugs or feature requests to C<bug-acme-thedaniel-utils at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=ACME-THEDANIEL-Utils>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc ACME::THEDANIEL::Utils
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker (report bugs here)
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=ACME-THEDANIEL-Utils>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/ACME-THEDANIEL-Utils>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/ACME-THEDANIEL-Utils>
=item * Search CPAN
L<http://search.cpan.org/dist/ACME-THEDANIEL-Utils/>
=back
=head1 ACKNOWLEDGEMENTS
Intermediate Perl, 2nd Edition.
=head1 LICENSE AND COPYRIGHT
Copyright 2017 Daniel jones.
This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:
L<http://www.perlfoundation.org/artistic_license_2_0>
Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.
If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.
This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.
This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
=cut
1; # End of ACME::THEDANIEL::Utils
view all matches for this distribution
view release on metacpan or search on metacpan
inc/Module/Install/Fetch.pm view on Meta::CPAN
#line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
for changes, use:
perl ppport.h --nochanges
You can specify a different C<diff> program or options, using
the C<--diff> option:
perl ppport.h --diff='diff -C 10'
This would output context diffs with 10 lines of context.
If you want to create patched copies of your files instead, use:
perl ppport.h --copy=.new
To display portability information for the C<newSVpvn> function,
use:
perl ppport.h --api-info=newSVpvn
Since the argument to C<--api-info> can be a regular expression,
you can use
perl ppport.h --api-info=/_nomg$/
to display portability information for all C<_nomg> functions or
perl ppport.h --api-info=/./
to display information for all known API elements.
=head1 BUGS
If this version of F<ppport.h> is causing failure during
the compilation of this module, please check if newer versions
of either this module or C<Devel::PPPort> are available on CPAN
before sending a bug report.
If F<ppport.h> was generated using the latest version of
C<Devel::PPPort> and is causing failure of this module, please
file a bug report here: L<https://github.com/mhx/Devel-PPPort/issues/>
Please include the following information:
=over 4
=item 1.
The complete output from running "perl -V"
=item 2.
This file.
=item 3.
The name and version of the module you were trying to build.
=item 4.
A full log of the build that failed.
=item 5.
Any other information that you think could be relevant.
=back
For the latest version of this code, please get the C<Devel::PPPort>
module from CPAN.
=head1 COPYRIGHT
Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
Version 2.x, Copyright (C) 2001, Paul Marquess.
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
See L<Devel::PPPort>.
=cut
use strict;
# Disable broken TRIE-optimization
BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
my $VERSION = 3.35;
my %opt = (
quiet => 0,
diag => 1,
hints => 1,
changes => 1,
cplusplus => 0,
filter => 1,
strip => 0,
version => 0,
);
my($ppport) = $0 =~ /([\w.]+)$/;
my $LF = '(?:\r\n|[\r\n])'; # line feed
my $HS = "[ \t]"; # horizontal whitespace
# Never use C comments in this file!
my $ccs = '/'.'*';
my $cce = '*'.'/';
my $rccs = quotemeta $ccs;
my $rcce = quotemeta $cce;
eval {
require Getopt::Long;
Getopt::Long::GetOptions(\%opt, qw(
help quiet diag! filter! hints! changes! cplusplus strip version
patch=s copy=s diff=s compat-version=s
magic_getarylen|||
magic_getdebugvar|||
magic_getdefelem|||
magic_getnkeys|||
magic_getpack|||
magic_getpos|||
magic_getsig|||
magic_getsubstr|||
magic_gettaint|||
magic_getuvar|||
magic_getvec|||
magic_get|||
magic_killbackrefs|||
magic_methcall1|||
magic_methcall|||v
magic_methpack|||
magic_nextpack|||
magic_regdata_cnt|||
magic_regdatum_get|||
magic_regdatum_set|||
magic_scalarpack|||
magic_set_all_env|||
magic_setarylen|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdebugvar|||
magic_setdefelem|||
magic_setenv|||
magic_sethint|||
magic_setisa|||
magic_setlvref|||
magic_setmglob|||
magic_setnkeys|||
magic_setpack|||
magic_setpos|||
magic_setregexp|||
magic_setsig|||
magic_setsubstr|||
magic_settaint|||
magic_setutf8|||
magic_setuvar|||
magic_setvec|||
magic_set|||
magic_sizepack|||
magic_wipepack|||
make_matcher|||
make_trie|||
malloc_good_size|||n
malloced_size|||n
malloc||5.007002|n
markstack_grow||5.021001|
matcher_matches_sv|||
maybe_multimagic_gv|||
mayberelocate|||
measure_struct|||
memEQs|5.009005||p
memEQ|5.004000||p
memNEs|5.009005||p
memNE|5.004000||p
mem_collxfrm|||
mem_log_alloc|||n
mem_log_common|||n
mem_log_free|||n
mem_log_realloc|||n
mess_alloc|||
mess_nocontext|||vn
mess_sv||5.013001|
mess||5.006000|v
mfree||5.007002|n
mg_clear|||
mg_copy|||
mg_dup|||
mg_find_mglob|||
mg_findext|5.013008||pn
mg_find|||n
mg_free_type||5.013006|
mg_free|||
mg_get|||
mg_length||5.005000|
mg_localize|||
mg_magical|||n
mg_set|||
mg_size||5.005000|
mini_mktime||5.007002|n
minus_v|||
missingterm|||
mode_from_discipline|||
modkids|||
more_bodies|||
more_sv|||
moreswitches|||
move_proto_attr|||
mro_clean_isarev|||
mro_gather_and_rename|||
mro_get_from_name||5.010001|
mro_get_linear_isa_dfs|||
mro_get_linear_isa||5.009005|
mro_get_private_data||5.010001|
mro_isa_changed_in|||
mro_meta_dup|||
mro_meta_init|||
mro_method_changed_in||5.009005|
mro_package_moved|||
mro_register||5.010001|
mro_set_mro||5.010001|
mro_set_private_data||5.010001|
mul128|||
mulexp10|||n
multideref_stringify|||
my_atof2||5.007002|
my_atof||5.006000|
my_attrs|||
my_bcopy||5.004050|n
my_bytes_to_utf8|||n
my_bzero|||n
my_chsize|||
my_clearenv|||
my_cxt_index|||
my_cxt_init|||
my_dirfd||5.009005|n
my_exit_jump|||
my_exit|||
my_failure_exit||5.004000|
my_fflush_all||5.006000|
newLOGOP|||
newLOOPEX|||
newLOOPOP|||
newMETHOP_internal|||
newMETHOP_named||5.021005|
newMETHOP||5.021005|
newMYSUB||5.017004|
newNULLLIST|||
newOP|||
newPADNAMELIST||5.021007|n
newPADNAMEouter||5.021007|n
newPADNAMEpvn||5.021007|n
newPADOP|||
newPMOP|||
newPROG|||
newPVOP|||
newRANGE|||
newRV_inc|5.004000||p
newRV_noinc|5.004000||p
newRV|||
newSLICEOP|||
newSTATEOP|||
newSTUB|||
newSUB|||
newSVOP|||
newSVREF|||
newSV_type|5.009005||p
newSVavdefelem|||
newSVhek||5.009003|
newSViv|||
newSVnv|||
newSVpadname||5.017004|
newSVpv_share||5.013006|
newSVpvf_nocontext|||vn
newSVpvf||5.004000|v
newSVpvn_flags|5.010001||p
newSVpvn_share|5.007001||p
newSVpvn_utf8|5.010001||p
newSVpvn|5.004050||p
newSVpvs_flags|5.010001||p
newSVpvs_share|5.009003||p
newSVpvs|5.009003||p
newSVpv|||
newSVrv|||
newSVsv|||
newSVuv|5.006000||p
newSV|||
newUNOP_AUX||5.021007|
newUNOP|||
newWHENOP||5.009003|
newWHILEOP||5.013007|
newXS_deffile|||
newXS_flags||5.009004|
newXS_len_flags|||
newXSproto||5.006000|
newXS||5.006000|
new_collate||5.006000|
new_constant|||
new_ctype||5.006000|
new_he|||
new_logop|||
new_numeric||5.006000|
new_stackinfo||5.005000|
new_version||5.009000|
new_warnings_bitfield|||
next_symbol|||
nextargv|||
nextchar|||
ninstr|||n
no_bareword_allowed|||
no_fh_allowed|||
no_op|||
noperl_die|||vn
not_a_number|||
not_incrementable|||
nothreadhook||5.008000|
nuke_stacks|||
num_overflow|||n
oopsAV|||
oopsHV|||
op_append_elem||5.013006|
op_append_list||5.013006|
op_clear|||
op_contextualize||5.013006|
op_convert_list||5.021006|
op_dump||5.006000|
op_free|||
op_integerize|||
op_linklist||5.013006|
op_lvalue_flags|||
op_lvalue||5.013007|
op_null||5.007002|
op_parent|||n
op_prepend_elem||5.013006|
op_refcnt_dec|||
op_refcnt_inc|||
op_refcnt_lock||5.009002|
op_refcnt_unlock||5.009002|
op_relocate_sv|||
op_scope||5.013007|
op_sibling_splice||5.021002|n
op_std_init|||
op_unscope|||
open_script|||
openn_cleanup|||
openn_setup|||
opmethod_stash|||
opslab_force_free|||
opslab_free_nopad|||
opslab_free|||
output_or_return_posix_warnings|||
pMY_CXT_|5.007003||p
pMY_CXT|5.007003||p
pTHX_|5.006000||p
pTHX|5.006000||p
packWARN|5.007003||p
pack_cat||5.007003|
pack_rec|||
package_version|||
package|||
packlist||5.008001|
upg_version||5.009005|
usage|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
utf8_hop||5.006000|n
utf8_length||5.007001|
utf8_mg_len_cache_update|||
utf8_mg_pos_cache_update|||
utf8_to_bytes||5.006001|
utf8_to_uvchr_buf||5.015009|
utf8_to_uvchr||5.007001|
utf8_to_uvuni_buf||5.015009|
utf8_to_uvuni||5.007001|
utf8n_to_uvchr||5.007001|
utf8n_to_uvuni||5.007001|
utilize|||
uvchr_to_utf8_flags||5.007003|
uvchr_to_utf8||5.007001|
uvoffuni_to_utf8_flags||5.019004|
uvuni_to_utf8_flags||5.007003|
uvuni_to_utf8||5.007001|
valid_utf8_to_uvchr||5.015009|
valid_utf8_to_uvuni||5.015009|
validate_proto|||
validate_suid|||
varname|||
vcmp||5.009000|
vcroak||5.006000|
vdeb||5.007003|
vform||5.006000|
visit|||
vivify_defelem|||
vivify_ref|||
vload_module|5.006000||p
vmess||5.006000|
vnewSVpvf|5.006000|5.004000|p
vnormal||5.009002|
vnumify||5.009000|
vstringify||5.009000|
vverify||5.009003|
vwarner||5.006000|
vwarn||5.006000|
wait4pid|||
warn_nocontext|||vn
warn_sv||5.013001|
warner_nocontext|||vn
warner|5.006000|5.004000|pv
warn|||v
was_lvalue_sub|||
watch|||
whichsig_pvn||5.015004|
whichsig_pv||5.015004|
whichsig_sv||5.015004|
whichsig|||
win32_croak_not_implemented|||n
with_queued_errors|||
wrap_op_checker||5.015008|
write_to_stderr|||
xs_boot_epilog|||
xs_handshake|||vn
xs_version_bootcheck|||
yyerror_pvn|||
yyerror_pv|||
yyerror|||
yylex|||
yyparse|||
yyunlex|||
yywarn|||
);
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
}
exit 0;
}
# Scan for possible replacement candidates
my(%replace, %need, %hints, %warnings, %depends);
my $replace = 0;
my($hint, $define, $function);
sub find_api
{
my $code = shift;
$code =~ s{
/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
| "[^"\\]*(?:\\.[^"\\]*)*"
| '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
grep { exists $API{$_} } $code =~ /(\w+)/mg;
}
while (<DATA>) {
if ($hint) {
my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
if (m{^\s*\*\s(.*?)\s*$}) {
for (@{$hint->[1]}) {
$h->{$_} ||= ''; # suppress warning with older perls
$h->{$_} .= "$1\n";
}
}
else { undef $hint }
}
$hint = [$1, [split /,?\s+/, $2]]
if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
if ($define) {
if ($define->[1] =~ /\\$/) {
$define->[1] .= $_;
}
else {
if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
my @n = find_api($define->[1]);
push @{$depends{$define->[0]}}, @n if @n
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AFS/Command/BOS.pm view on Meta::CPAN
use AFS::Command::Base;
use AFS::Object;
use AFS::Object::BosServer;
use AFS::Object::Instance;
our @ISA = qw(AFS::Command::Base);
our $VERSION = '1.99';
sub getdate {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "getdate";
my $directory = $args{dir} || '/usr/afs/bin';
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
chomp;
next unless m:File $directory/(\S+) dated ([^,]+),:;
my $file = AFS::Object->new
(
file => $1,
date => $2,
);
if ( /\.BAK dated ([^,]+),/ ) {
$file->_setAttribute( bak => $1 );
}
if ( /\.OLD dated ([^,\.]+)/ ) {
$file->_setAttribute( old => $1 );
}
$result->_addFile($file);
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getlog {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "getlog";
my $redirect = undef;
my $redirectname = undef;
if ( $args{redirect} ) {
$redirectname = delete $args{redirect};
$redirect = IO::File->new(">$redirectname") || do {
$self->_Carp("Unable to write to $redirectname: $ERRNO");
return;
};
}
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
my $log = "";
while ( defined($_ = $self->{handle}->getline()) ) {
next if /^Fetching log file/;
if ( $redirect ) {
$redirect->print($_);
} else {
$log .= $_;
}
}
if ( $redirect ) {
$redirect->close()|| do {
$self->_Carp("Unable to close $redirectname: $ERRNO");
$errors++
};
$result->_setAttribute( log => $redirectname );
} else {
$result->_setAttribute( log => $log );
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub getrestart {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "getrestart";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
$errors++ unless $self->_exec_cmds();
while ( defined($_ = $self->{handle}->getline()) ) {
if ( /restarts at (.*)/ || /restarts (never)/ ) {
$result->_setAttribute( restart => $1 );
} elsif ( /binaries at (.*)/ || /binaries (never)/ ) {
$result->_setAttribute( binaries => $1 );
}
}
$errors++ unless $self->_reap_cmds();
$errors++ unless $self->_restore_stderr();
return if $errors;
return $result;
}
sub listhosts {
my $self = shift;
my (%args) = @_;
my $result = AFS::Object::BosServer->new();
$self->{operation} = "listhosts";
return unless $self->_parse_arguments(%args);
return unless $self->_save_stderr();
my $errors = 0;
view all matches for this distribution
view release on metacpan or search on metacpan
examples/xstat_cm_test view on Meta::CPAN
printf "\t%10d afs_MemCacheStoreProc\n", $data->{afs_MemCacheStoreProc};
printf "\t%10d afs_GetNfsClientPag\n", $data->{afs_GetNfsClientPag};
printf "\t%10d afs_FindNfsClientPag\n", $data->{afs_FindNfsClientPag};
printf "\t%10d afs_PutNfsClientPag\n", $data->{afs_PutNfsClientPag};
printf "\t%10d afs_nfsclient_reqhandler\n", $data->{afs_nfsclient_reqhandler};
printf "\t%10d afs_nfsclient_GC\n", $data->{afs_nfsclient_GC};
printf "\t%10d afs_nfsclient_hold\n", $data->{afs_nfsclient_hold};
printf "\t%10d afs_nfsclient_stats\n", $data->{afs_nfsclient_stats};
printf "\t%10d afs_nfsclient_sysname\n", $data->{afs_nfsclient_sysname};
printf "\t%10d afs_rfs_dispatch\n", $data->{afs_rfs_dispatch};
printf "\t%10d afs_nfs2afscall\n", $data->{Nfs2AfsCall};
printf "\t%10d afs_sun_xuntext\n", $data->{afs_sun_xuntext};
printf "\t%10d osi_Active\n", $data->{osi_Active};
printf "\t%10d osi_FlushPages\n", $data->{osi_FlushPages};
printf "\t%10d osi_FlushText\n", $data->{osi_FlushText};
printf "\t%10d osi_CallProc\n", $data->{osi_CallProc};
printf "\t%10d osi_CancelProc\n", $data->{osi_CancelProc};
printf "\t%10d osi_Invisible\n", $data->{osi_Invisible};
printf "\t%10d osi_Time\n", $data->{osi_Time};
printf "\t%10d osi_Alloc\n", $data->{osi_Alloc};
printf "\t%10d osi_SetTime\n", $data->{osi_SetTime};
printf "\t%10d osi_Dump\n", $data->{osi_Dump};
printf "\t%10d osi_Free\n", $data->{osi_Free};
printf "\t%10d osi_UFSOpen\n", $data->{osi_UFSOpen};
printf "\t%10d osi_Close\n", $data->{osi_Close};
printf "\t%10d osi_Stat\n", $data->{osi_Stat};
printf "\t%10d osi_Truncate\n", $data->{osi_Truncate};
printf "\t%10d osi_Read\n", $data->{osi_Read};
printf "\t%10d osi_Write\n", $data->{osi_Write};
printf "\t%10d osi_MapStrategy\n", $data->{osi_MapStrategy};
printf "\t%10d osi_AllocLargeSpace\n", $data->{osi_AllocLargeSpace};
printf "\t%10d osi_FreeLargeSpace\n", $data->{osi_FreeLargeSpace};
printf "\t%10d osi_AllocSmallSpace\n", $data->{osi_AllocSmallSpace};
printf "\t%10d osi_FreeSmallSpace\n", $data->{osi_FreeSmallSpace};
printf "\t%10d osi_CloseToTheEdge\n", $data->{osi_CloseToTheEdge};
printf "\t%10d osi_xgreedy\n", $data->{osi_xgreedy};
printf "\t%10d osi_FreeSocket\n", $data->{osi_FreeSocket};
printf "\t%10d osi_NewSocket\n", $data->{osi_NewSocket};
printf "\t%10d osi_NetSend\n", $data->{osi_NetSend};
printf "\t%10d WaitHack\n", $data->{WaitHack};
printf "\t%10d osi_CancelWait\n", $data->{osi_CancelWait};
printf "\t%10d osi_Wakeup\n", $data->{osi_Wakeup};
printf "\t%10d osi_Wait\n", $data->{osi_Wait};
printf "\t%10d dirp_Read\n", $data->{dirp_Read};
printf "\t%10d dirp_Cpy\n", $data->{dirp_Cpy};
printf "\t%10d dirp_Eq\n", $data->{dirp_Eq};
printf "\t%10d dirp_Write\n", $data->{dirp_Write};
printf "\t%10d dirp_Zap\n", $data->{dirp_Zap};
printf "\t%10d afs_ioctl\n", $data->{afs_ioctl};
printf "\t%10d handleIoctl\n", $data->{HandleIoctl};
printf "\t%10d afs_xioctl\n", $data->{afs_xioctl};
printf "\t%10d afs_pioctl\n", $data->{afs_pioctl};
printf "\t%10d HandlePioctl\n", $data->{HandlePioctl};
printf "\t%10d PGetVolumeStatus\n", $data->{PGetVolumeStatus};
printf "\t%10d PSetVolumeStatus\n", $data->{PSetVolumeStatus};
printf "\t%10d PFlush\n", $data->{PFlush};
printf "\t%10d PFlushVolumeData\n", $data->{PFlushVolumeData};
printf "\t%10d PNewStatMount\n", $data->{PNewStatMount};
printf "\t%10d PGetTokens\n", $data->{PGetTokens};
printf "\t%10d PSetTokens\n", $data->{PSetTokens};
printf "\t%10d PUnlog\n", $data->{PUnlog};
printf "\t%10d PCheckServers\n", $data->{PCheckServers};
printf "\t%10d PCheckAuth\n", $data->{PCheckAuth};
printf "\t%10d PCheckVolNames\n", $data->{PCheckVolNames};
printf "\t%10d PFindVolume\n", $data->{PFindVolume};
printf "\t%10d Prefetch\n", $data->{Prefetch};
printf "\t%10d PGetCacheSize\n", $data->{PGetCacheSize};
printf "\t%10d PSetCacheSize\n", $data->{PSetCacheSize};
printf "\t%10d PSetSysName\n", $data->{PSetSysName};
printf "\t%10d PExportAfs\n", $data->{PExportAfs};
printf "\t%10d HandleClientContext\n", $data->{HandleClientContext};
printf "\t%10d PViceAccess\n", $data->{PViceAccess};
printf "\t%10d PRemoveCallBack\n", $data->{PRemoveCallBack};
printf "\t%10d PRemoveMount\n", $data->{PRemoveMount};
printf "\t%10d PSetVolumeStatus\n", $data->{PSetVolumeStatus};
printf "\t%10d PListCells\n", $data->{PListCells};
printf "\t%10d PNewCell\n", $data->{PNewCell};
printf "\t%10d PGetUserCell\n", $data->{PGetUserCell};
printf "\t%10d PGetCellStatus\n", $data->{PGetCellStatus};
printf "\t%10d PSetCellStatus\n", $data->{PSetCellStatus};
printf "\t%10d PVenusLogging\n", $data->{PVenusLogging};
printf "\t%10d PGetAcl\n", $data->{PGetAcl};
printf "\t%10d PGetFID\n", $data->{PGetFID};
printf "\t%10d PSetAcl\n", $data->{PSetAcl};
printf "\t%10d PGetFileCell\n", $data->{PGetFileCell};
printf "\t%10d PGetWSCell\n", $data->{PGetWSCell};
printf "\t%10d PGetSPrefs\n", $data->{PGetSPrefs};
printf "\t%10d PSetSPrefs\n", $data->{PSetSPrefs};
printf "\t%10d afs_ResetAccessCache\n", $data->{afs_ResetAccessCache};
printf "\t%10d afs_FindUser\n", $data->{afs_FindUser};
printf "\t%10d afs_GetUser\n", $data->{afs_GetUser};
printf "\t%10d afs_GCUserData\n", $data->{afs_GCUserData};
printf "\t%10d afs_PutUser\n", $data->{afs_PutUser};
printf "\t%10d afs_SetPrimary\n", $data->{afs_SetPrimary};
printf "\t%10d afs_ResetUserConns\n", $data->{afs_ResetUserConns};
printf "\t%10d afs_RemoveUserConns\n", $data->{RemoveUserConns};
printf "\t%10d afs_ResourceInit\n", $data->{afs_ResourceInit};
printf "\t%10d afs_GetCell\n", $data->{afs_GetCell};
printf "\t%10d afs_GetCellByIndex\n", $data->{afs_GetCellByIndex};
printf "\t%10d afs_GetCellByName\n", $data->{afs_GetCellByName};
if (exists $data->{afs_GetRealCellByIndex}) {
printf "\t%10d afs_GetRealCellByIndex\n", $data->{afs_GetRealCellByIndex};
}
printf "\t%10d afs_NewCell\n", $data->{afs_NewCell};
printf "\t%10d CheckVLDB\n", $data->{CheckVLDB};
printf "\t%10d afs_GetVolume\n", $data->{afs_GetVolume};
printf "\t%10d afs_PutVolume\n", $data->{afs_PutVolume};
printf "\t%10d afs_GetVolumeByName\n", $data->{afs_GetVolumeByName};
printf "\t%10d afs_random\n", $data->{afs_random};
printf "\t%10d InstallVolumeEntry\n", $data->{InstallVolumeEntry};
printf "\t%10d InstallVolumeInfo\n", $data->{InstallVolumeInfo};
printf "\t%10d afs_ResetVolumeInfo\n", $data->{afs_ResetVolumeInfo};
printf "\t%10d afs_FindServer\n", $data->{afs_FindServer};
printf "\t%10d afs_GetServer\n", $data->{afs_GetServer};
printf "\t%10d afs_SortServers\n", $data->{afs_SortServers};
printf "\t%10d afs_CheckServers\n", $data->{afs_CheckServers};
printf "\t%10d ServerDown\n", $data->{ServerDown};
printf "\t%10d afs_Conn\n", $data->{afs_Conn};
printf "\t%10d afs_PutConn\n", $data->{afs_PutConn};
printf "\t%10d afs_ConnByHost\n", $data->{afs_ConnByHost};
printf "\t%10d afs_ConnByMHosts\n", $data->{afs_ConnByMHosts};
view all matches for this distribution
view release on metacpan or search on metacpan
lib/AFS/PAG.pm view on Meta::CPAN
# Perl bindings for the PAG functions in libkafs.
#
# This is the Perl boostrap file for the AFS::PAG module, nearly all of which
# is implemented in XS. For the actual source, see PAG.xs. This file
# contains the bootstrap and export code and the documentation.
#
# Written by Russ Allbery <rra@cpan.org>
# Copyright 2013
# The Board of Trustees of the Leland Stanford Junior University
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
# DEALINGS IN THE SOFTWARE.
package AFS::PAG;
use 5.008;
use strict;
use warnings;
use base qw(DynaLoader);
use Exporter qw(import);
our (@EXPORT_OK, $VERSION);
# Set all import-related variables in a BEGIN block for robustness.
BEGIN {
@EXPORT_OK = qw(hasafs haspag setpag unlog);
$VERSION = '1.02';
}
# Load the binary module.
bootstrap AFS::PAG $VERSION;
1;
__END__
=for stopwords
Allbery AFS PAG libkafs libkopenafs Kerberos aklog UID kdestroy
=head1 NAME
AFS::PAG - Perl bindings for AFS PAG manipulation
=head1 SYNOPSIS
use AFS::PAG qw(hasafs setpag unlog);
if (hasafs()) {
setpag();
system('aklog') == 0
or die "cannot get tokens\n";
do_afs_things();
unlog();
}
=head1 DESCRIPTION
AFS is a distributed file system allowing cross-platform sharing of files
among multiple computers. It associates client credentials (called AFS
tokens) with a Process Authentication Group, or PAG. AFS::PAG makes
available in Perl the PAG manipulation functions provided by the libkafs
or libkopenafs libraries.
With the functions provided by this module, a Perl program can detect
whether AFS is available on the local system (hasafs()) and whether it is
currently running inside a PAG (haspag()). It can also create a new PAG
and put the current process in it (setpag()) and remove any AFS tokens in
the current PAG (unlog()).
Note that this module doesn't provide a direct way to obtain new AFS
tokens. Programs that need AFS tokens should normally obtain Kerberos
tickets (via whatever means) and then run the program B<aklog>, which
comes with most AFS distributions. This program will create AFS tokens
from the current Kerberos ticket cache and store them in the current PAG.
To isolate those credentials from the rest of the system, call setpag()
before running B<aklog>.
=head1 FUNCTIONS
This module provides the following functions, none of which are exported
by default:
=over 4
=item hasafs()
Returns true if the local host is running an AFS client and false
otherwise.
=item haspag()
Returns true if the current process is running inside a PAG and false
otherwise. AFS tokens obtained outside of a PAG are visible to any
process on the system outside of a PAG running as the same UID. AFS
tokens obtained inside a PAG are visible to any process in the same PAG,
regardless of UID.
=item setpag()
Creates a new, empty PAG and put the current process in it. This should
normally be called before obtaining new AFS tokens to isolate those tokens
from other processes on the system. Returns true on success and throws
an exception on failure.
=item unlog()
Deletes all AFS tokens in the current PAG, similar to the action of
B<kdestroy> on a Kerberos ticket cache. Returns true on success and
throws an exception on failure.
=back
=head1 DIAGNOSTICS
=over 4
=item PAG creation failed: %s
setpag() failed. The end of the error message will be a translation of
the system call error number.
=item Token deletion failed: %s
unlog() failed. The end of the error message will be a translation of
the system call error number.
=back
=head1 RESTRICTIONS
This module currently doesn't provide the k_pioctl() or pioctl() function
to make lower-level AFS system calls. It also doesn't provide the libkafs
functions to obtain AFS tokens from Kerberos tickets directly without using
an external ticket cache. This prevents use of internal Kerberos ticket
caches (such as memory caches), since the Kerberos tickets used to generate
AFS tokens have to be visible to an external B<aklog> program.
=head1 AUTHOR
Russ Allbery <rra@cpan.org>
=head1 SEE ALSO
aklog(1)
The current version of this module is always available from its web site
at L<http://www.eyrie.org/~eagle/software/afs-pag/>.
=cut
view all matches for this distribution