Ambrosia

 view release on metacpan or  search on metacpan

Example/README  view on Meta::CPAN

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Enter the path for perl's lib [empty for done]: /home/Ambrosia/myperllib/CPAN/perl5lib/lib/perl5
Enter the path for perl's lib [empty for done]: /home/Ambrosia/myperllib/CPAN/perl5lib/lib/perl5/i386-freebsd-64int
Enter the path for perl's lib [empty for done]: /home/Ambrosia/Project/lib
Enter the path for perl's lib [empty for done]:
Enter the path to dojo toolkit:/home/Ambrosia/DOJO/dojo-release-1.7.2
Choose the database [m(MySQL)|p(PostgresQL)]: m
Enter the schema of database [Music]:MusicDB
Enter the host location of database [localhost]:
Enter the port for connection to database or enter 's' for use UNIX socket [3306]:
Enter the username of database [root]:
Enter user's password []:
Enter the charset of database [utf8]:
Enter the settings for connecting to the database as a string [database=MusicDB;host=localhost;port=3306]:
 
Then follow the instructions.
 
For access to created application you must use
    login => 'god',
    password => 'fv,hjpbz'
 
You can change it in the PATH_TO_PROJECT/Music/Config/Music.conf

Makefile.PL  view on Meta::CPAN

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
chomp(my $DB_USER = `whoami`);
my $DB_PASSWORD = '';
 
my ($opt, $usage) = describe_options(
    'Makefile.PL %o ',
    [ 'schema|s=s',   "the schema that use for test", { default => $DB_SCHEMA }],
    [ 'host|h=s',     "the host to connect to", { default => $DB_HOST }],
    [ 'port|p=i',     "the port to connect to", { default => $DB_PORT } ],
    [ 'socket|S',     "use socket insted port to connect to"],
    [ 'user|U=s',     "the user to connect to", { default => $DB_USER } ],
    [ 'password|P=s', "the password to connect to", { default => $DB_PASSWORD } ],
    [],
    [ 'help',       "print usage message and exit" ],
);
 
print($usage->text), exit if $opt->help;
 
if ( open(my $fh, '>', './t/db.params') )
{
    my $schema = $opt->schema;
    my $host = $opt->host;
    my $port = $opt->socket ? '' : 'port          => ' . $opt->port . ',';
    my $user = $opt->user;
    my $password = $opt->password;
 
    print $fh <<EOB;
return {
    DBI => [
        {
            engine_name   => 'mysql',
            source_name   => 'Client',
            catalog       => undef,
            schema        => '$schema',
            host          => '$host',
            $port
            user          => '$user',
            password      => '$password',
            additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
            additional_action => sub { my \$dbh = shift; \$dbh->do('SET NAMES utf8')},
        },
    ]
};
EOB
    close $fh;
}
 

README  view on Meta::CPAN

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
 
INSTALLATION
 
    perl Makefile.PL
    make
    make test
    make install
 
Tests that need access to the database use the username "root" with empty password to authorize.
 
And in the database you must have the schema "test".
The database used for tests must be MySql.
 
You can change username and password. This user must have permission to create tables in the schema "test".
    perl Makefile.PL -U USER_NAME -P PASSWORD
 
Run
    perl Makefile.PL --help
for see other parameters.

benchmark/Ambrosia/DataProvider.b  view on Meta::CPAN

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
 
my $confDS = {
    DBI => [
        {
            engine_name   => 'mysql',
            source_name   => 'Employee',
            user          => 'root',
            password      => '',
            engine_params => 'database=test;host=localhost;',
            additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
            additional_action => sub { my $dbh = shift; $dbh->do('SET NAMES utf8')},
        },
    ]
};
 
instance Ambrosia::DataProvider(test => $confDS);
Ambrosia::DataProvider::assign 'test';

benchmark/Ambrosia/EntityDataModel.b  view on Meta::CPAN

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
my $confDS = {
    DBI => [
        {
            engine_name   => 'mysql',
            source_name   => 'Employee',
            catalog       => undef,#optional
            schema        => 'test',
            host          => 'localhost',#optional
            port          => 3306,#optional
            user          => 'root',
            password      => '',
#            engine_params => 'database=test;host=localhost;',
            additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
            additional_action => sub { my $dbh = shift; $dbh->do('SET NAMES utf8')},
        },
    ]
};
 
instance Ambrosia::DataProvider(test => $confDS);
Ambrosia::DataProvider::assign 'test';

benchmark/Ambrosia/QL.b  view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
 
my $confDS = {
    DBI => [
        {
            engine_name   => 'mysql',
            source_name   => 'Client',
            user          => 'root',
            password      => '',
            engine_params => 'database=test;host=localhost;',
            additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
            additional_action => sub { my $dbh = shift; $dbh->do('SET NAMES utf8')},
        },
    ]
};
 
instance Ambrosia::DataProvider(test => $confDS);
Ambrosia::DataProvider::assign 'test';

lib/Ambrosia/Addons/Accessor.pm  view on Meta::CPAN

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
    my $self = shift;
    my $login = shift;
    my $passwd = shift;
    my $level = shift;
 
    unless ( $level )
    {#Authorization is not required
        return new Ambrosia::Addons::Accessor::Result()->SET_PERMIT;
    }
 
    #If no username or password then prohibit
    return new Ambrosia::Addons::Accessor::Result()->SET_DENIED unless $login && $passwd;
 
    #check username and password
    return $self->check_password($login, $passwd, $level);
}
 
sub exit :Abstract
{
}
 
sub remember_authorize_info :Abstract
{
}
 
sub check_password
{
    my $self = shift;
    my $login = shift || '';
    my $passwd = shift || '';
    my $level = shift;
 
    unless ( $self->user = $self->authorize->get($login, $level) )
    {
        return new Ambrosia::Addons::Accessor::Result()->SET_DENIED;
    }

lib/Ambrosia/DataProvider.pm  view on Meta::CPAN

150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
=head1 SYNOPSIS
 
    use Ambrosia::DataProvider;
    my $confDS = {
        DBI => [
            {
                engine_name   => 'DB::mysql',
                source_name  => 'Employee',
                engine_params => 'database=EmployeeDB;host=localhost;',
                user         => 'test',
                password     => 'test',
                additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
                additional_action => sub { my $dbh = shift; $dbh->do('SET NAMES utf8')},
            },
            #........
        ],
        IO => [
            {
                engine_name => 'IO::CGI',
                source_name => 'cgi',
                engine_params => {

lib/Ambrosia/DataProvider/DBIDriver.pm  view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
class abstract
{
    extends => [qw/Ambrosia::DataProvider::BaseDriver/],
    private => [qw/
        user
        password
        engine_params
        additional_params
        additional_action
        __sth
    /]
};
 
sub _init
{
    my $self = shift;

lib/Ambrosia/DataProvider/DBIDriver.pm  view on Meta::CPAN

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
}
 
sub open_connection
{
    my $self = shift;
 
    $self->close_connection;
 
    $self->_handler = DBI->connect (
            $self->_connection_params(),
            $self->user, $self->password,
            ($self->additional_params || {})
        )
        or throw Ambrosia::core::Exception(DBI->errstr);
 
    if ( defined $self->additional_action && ref $self->additional_action eq 'CODE' )
    {
        $self->additional_action->($self->_handler);
    }
    $self->begin_transaction();
    return $self->_handler;

share/Managers/buildConfig.pm  view on Meta::CPAN

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
    }->{$dbEngineName} || '';
print "Enter the port for connection to database or enter 's' for use UNIX socket [$dbPort]:";
$dbPort = readln() || $dbPort;
$dbPort = '' if 's' eq lc($dbPort);
 
### enter user ###
my $dbUser;
print "Enter the username of database [root]:";
$dbUser = readln() || 'root';
 
### enter password ###
my $dbPassword;
print "Enter user's password []:";
$dbPassword = readln() || '';
 
### enter password ###
my $dbCharset = lc($charset);
$dbCharset =~ s/[^a-z0-9]//sg;
print "Enter the charset of database [$dbCharset]:";
$dbCharset = readln() || $dbCharset;
 
### enter password ###
my $dbEngineParams = "database=$dbSchema;host=$dbHost" . ($dbPort ? ";port=$dbPort" : '');
print "Enter the settings for connecting to the database as a string [$dbEngineParams]:";
$dbEngineParams = readln() || 'undef';
 
### write config to file ###
if ( open(my $fh, '>', $projectName . '.conf') )
{
    my $template = join '', <Managers::buildConfig::DATA>;
    print $fh proces_template($template,
        NAME    => $projectName,

share/Managers/buildConfig.pm  view on Meta::CPAN

294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
data_source => {
    DBI => [
        {
            engine_name   => '##DB_ENGINE##',
            source_name   => '##NAME##',
            catalog       => undef,#optional
            schema        => '##DB_SCHEMA##',
            host          => '##DB_HOST##',#optional
            ##DB_PORT##
            user          => '##DB_USER##',
            password      => '##DB_PASSWORD##',
            ##DB_ENGINE_PARAMS##
            additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
            additional_action => sub { my $dbh = shift; $dbh->do('SET NAMES ##DB_CHARSET##')},
        },
    ]
},
 
data_source_info => {
    DBI => { ##NAME## => {charset => '##DB_CHARSET##'} }
},

share/Managers/buildXml.pm  view on Meta::CPAN

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
              config => {} };
push @$schema_list, $schema;
 
my $ds = getDataSource($type, $source_name);
 
$schema->{config} = {
    db_engine   => $ds->{engine_name},
    db_source   => $source_name,
    db_params   => $ds->{engine_params},
    db_user     => $ds->{user},
    db_password => $ds->{password},
    db_charset  => (config->data_source_info->{$type}->{$source_name}->{charset} || 'utf8'),
};
 
my $tables = table_info($driver);
my %hTables = ();
 
my %foreign_keys = ();
foreach ( @{foreign_key_info($driver)} )
{
    push @{$foreign_keys{$_->{pktable_name}}}, {

share/Templates/Common/Accessor.xsl  view on Meta::CPAN

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
{
    my $self = shift;
    session->deleteItem( $self->get_access_key_name() );
    session->addItem( $self->get_access_key_name() => '' );
}
 
sub remember_authorize_info
{
    my $self = shift;
    my $login = shift;
    my $password = shift;
 
    if ( $login &amp;&amp; $password )
    {
        my $crypt_password = crypt($password, $login . $password . $$ . time);
        session->addItem( $self->get_access_key_name() =>
                          {login => $login, password => $crypt_password} );
        return 1;
    }
    return 0;
}
 
1;
</xsl:template>
 
</xsl:stylesheet>

share/Templates/Common/Authorize.xsl  view on Meta::CPAN

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
sub get
{
    my $self = shift;
    my $login = shift;
    my $level = shift;
 
    if ( $login eq config->login )
    {
        return new <xsl:value-of select="$RealAppName" />::Entity::<xsl:value-of select="$RealAppName" />SysUser(
            Password => config->password,
            Levels => [keys %{config->ACCESS_LEVELS->{config->ID}->{LEVELS}}]);
    }
 
    return new Ambrosia::core::Nil;
}
 
1;
</xsl:template>
 
</xsl:stylesheet>

share/Templates/Common/Config.xsl  view on Meta::CPAN

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
    },
 
    data_source => {
        <xsl:for-each select="/atns:Application/atns:DataSource/atns:Type">
        <xsl:value-of select="@Name" /> => [<xsl:for-each select="atns:Source">{
            source_name   => $DS_NAME_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>,
            engine_name   => $DS_ENGINE_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>,
            <xsl:if test="boolean(@Catalog)">catalog       => $DS_CATALOG_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>,</xsl:if>
            schema        => $DS_SCHEMA_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>,
            user          => $DS_USER_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>,
            password      => $DS_PASSWORD_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>,
            engine_params => $DS_PARAMS_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>,
            additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
            additional_action => sub { my $dbh = shift; $dbh->do("SET NAMES $DS_CHARSET_<xsl:value-of select="../@Name"/>_<xsl:value-of select="@Name"/>")},
        },</xsl:for-each>],</xsl:for-each>
    },
 
#delete this block if your application don't use remoute services or change it
    service_conf => {
        'SOAP::Lite' => [
                {

share/Templates/Common/Config.xsl  view on Meta::CPAN

190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
                    __timeout => undef,
                    #__on_error #you can use `on_error(sub{})` method of Ambrosia::RPC::Service::SOAP::Lite
                },
            ],
    },
 
    NUMBER_PER_PAGE => 20,
 
<xsl:if test="/atns:Application/@Authorization!='NO'">
    login => 'god',
    password => 'fv,hjpbz',
 
    ACCESS_LEVELS => {
        <xsl:value-of select="$UcAppName"/> => {
            LABEL => '<xsl:value-of select="@Label"/>',
            LEVELS => {<xsl:for-each select="./atns:Entitys/atns:Entity"><xsl:variable name="type" select="translate(@Type, $vLowercaseChars_CONST, $vUppercaseChars_CONST)"/>
<xsl:if test="$type='TABLE'">
                $EDIT_<xsl:value-of select="@Name"/> => 'Edit <xsl:value-of select="@Label" />',</xsl:if><xsl:if test="$type!='ABSTRACT' and $type!='BIND'">
                $VIEW_<xsl:value-of select="@Name"/> => 'View <xsl:value-of select="@Label" />',
</xsl:if></xsl:for-each>
            }

share/Templates/Common/HandlerModule.xsl  view on Meta::CPAN

171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
    Context->abort_session();
}
 
<xsl:if test="/atns:Application/@Authorization!='NO'">
sub check_access
{
    my $mng = shift;
    my $val = session()->getItem(<xsl:value-of select="$RealAppName" />::Accessor::get_access_key_name()) || {};
    my $result = accessor()->authenticate(
            Context->param('login')
                ? (Context->param('login'), Context->param('password'))
                : ($val->{login}, $val->{password}),
            $mng->{access}
        );
 
    if ( $result->IS_REDIRECT )
    {
        Context->redirect(
                -must_revalidate  => 1,
                -max_age  => 0,
                -no_cache => 1,
                -no_store => 1,

share/Templates/Templates/XSLT+DOJO/authorize.xsl  view on Meta::CPAN

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
                                </xsl:attribute>
                        </input>
                </td>
        </tr>
        <tr>
                <td>Password</td>
                <td>
                        <xsl:variable name="value">,value:"<xsl:value-of select="./SysUser/@pswd"/>"</xsl:variable>
                        <input data-dojo-type="dijit.form.ValidationTextBox">
                        <xsl:attribute name="data-dojo-props">
                                <xsl:value-of select="concat('id:&quot;id_Password&quot;,name:&quot;password&quot;,type:&quot;password&quot;,trim:true,maxLength:&quot;32&quot;,promptMessage:&quot;Password&quot;',$value)"/>
                        </xsl:attribute>
                  </input>
                </td>
        </tr>
</table>
</xsl:template>
</xsl:stylesheet>
 
</xslt:template>

share/Templates/db2xml.xsl  view on Meta::CPAN

94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
                                <xsl:value-of select="@catalog" />
                        </xsl:attribute>
                        </xsl:if>
                        <xsl:attribute name="Schema">
                                <xsl:value-of select="@schema" />
                        </xsl:attribute>
                        <xsl:attribute name="User">
                                <xsl:value-of select="config/@db_user" />
                        </xsl:attribute>
                        <xsl:attribute name="Password">
                                <xsl:value-of select="config/@db_password" />
                        </xsl:attribute>
                        <xsl:attribute name="Charset">
                                <xsl:value-of select="config/@db_charset" />
                        </xsl:attribute>
                        <xsl:attribute name="Params">
                                <xsl:value-of select="config/@db_params" />
                        </xsl:attribute>
                </Source>
        </Type>
</xsl:template>

t/db.params  view on Meta::CPAN

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
return {
    DBI => [
        {
            engine_name   => 'mysql',
            source_name   => 'Client',
            catalog       => undef,
            schema        => 'test',
            host          => 'localhost',
            port          => 3306,
            user          => 'nick',
            password      => '',
            additional_params => { AutoCommit => 0, RaiseError => 1, LongTruncOk => 1 },
            additional_action => sub { my $dbh = shift; $dbh->do('SET NAMES utf8')},
        },
    ]
};



( run in 0.362 second using v1.01-cache-2.11-cpan-94b05bcf43c )